Итак, разбор задач. Прежде всего отмечу, что на Factor программу можно писать довольно произвольным образом — хоть все слова в одну строку, но при этом все слова обязательно должны быть разделены пробелами, поддаваться искушению пропустить пробел между скобкой и чем-то еще нельзя.

162A - Пятиугольные числа

Почти точно такая же задача, как 130A - Шестиугольные числа с раунда про Befunge. Чтение и вывод данных делается в точности как в примере, а кроме них, используются только базовые операции со стеком.

USING: io kernel math math.parser ;

readln string>number
dup 3 * 1 - * 2 /
number>string print

Factor отличается отлично развитой системой встроенных библиотек, которые избавляют программиста от решения очень и очень многих рутинных задач. Поэтому после первой тривиальной задачи шли несколько штук, которые решались "в одну строку" — разумеется, после нахождения подходящей библиотеки.

162B - Двоичная запись

Существует несколько способов решить ее, самый короткий — использовать функцию >bin из библиотеки math.parser, которая делает в точности то, что нужно.

USING: io kernel math math.parser ;

readln string>number 2 >base print

162C - Разложение на множители

Вот здесь я, судя по результатам, промахнулась со сложностью, D и E оказались проще. На самом деле здесь очень выручает еще одна библиотечная функция, factors из math.primes.factors, которая, собственно, и выполняет все разложение на множители и даже возвращает их в нужном порядке как последовательность. Вторая строка преобразует последовательность чисел в последовательность строк (комбинатор map применяет к каждому элементу последовательности операции, заданные в квадратных скобках). Наконец, join конкатенирует элементы последовательности, вставляя между ними знак умножения.

USING: io kernel math math.parser math.primes.factors sequences ;

readln string>number factors 
[ number>string ] map
"*" join print ;

162D - Уберите цифры

Еще одна задача с множеством подходов — например, выделять не-цифры регулярным выражением и конкатенировать их; авторское решение использовало слово replace:

USING: math math.parser peg peg.parsers peg.search io kernel ;

readln 'integer' [ drop "" ] action replace print

162E - HQ9+

Вот это уж точно задача на регулярные выражения! Слово matches? проверяет, подходит ли заданная строка под заданное регулярное выражение, и кладет на стек булевский результат. Слово if проверяет значение этого результата и в зависимости от него выводит YES или NO.

USING: io kernel regexp ;

readln R/ \S*[HQ9]\S*/ matches?
[ "YES" ]
[ "NO" ]
if
print

162F - Нули в факториале

Количество нулей в хвосте факториала числа определяется количеством пятерок, на которые этот факториал делится (двоек для них точно хватит). А оно считается по формуле n / 5 + n / 25 + n / 125 + ... + n / 390625. Обратите внимание на то, что деление должно быть целочисленным (или результат должен округляться вниз), иначе дробные части могут просуммироваться и дать несколько лишних нулей.

Авторское решение содержало элементы предпросчета (чтобы избавиться от цикла вычисления степеней 5) и именованную переменную n (чтобы не возиться с запоминанием того, что в каком порядке хранится в стеке):

USING: io formatting kernel locals math math.parser math.functions sequences ;
IN: trailing-zeros

:: trailing-zeros ( -- )
   readln string>number :> n
   { 5 25 125 625 3125 15625 78125 390625 }
   0
   [ n swap / truncate + ] reduce
   "%d" printf ;

trailing-zeros

162G - Недесятичная сумма

Эта задача оказалась самой сложной в контесте, что немало меня удивило. Решалась она почти так же, как пример "42", с единственной модификацией: после количества чисел считывалось основание системы счисления (и для удобства записывалось в именованную переменную), а в теле цикла reduce строка переводилась в число не словом string>number, а словом base>. Наконец, для вывода суммы нужно было использовать обратное слово >base.

USING: io kernel locals math math.parser sequences unicode.case ;
IN: basesum

:: basesum ( -- )
   readln string>number iota
   readln string>number :> base
   0
   [ drop readln base base> + ] reduce
   base >base >upper print ;

basesum 

Update. В документации сказано, что функции >base и base> работают для оснований до 16; на самом деле они работают и для больших оснований, но теперь сложность этой задачи удивляет меня гораздо меньше.

162H - Чередование регистров

В этой задаче мне наконец-то понадобился настоящий цикл while! В первых квадратных скобках задается условие продолжения цикла, во вторых — тело цикла. Я использовала его для того, чтобы нарезать строку кусочками по два символа (слово cut), перевести каждый из них в title case (слово >title: первая буква в верхнем регистре, остальные — в нижнем) и вывести в результат без перевода строки (printf). К остатку строки длиной 1 или 2 символа применялась та же процедура.

USING: io formatting kernel math sequences unicode.case ;

readln
[ dup length 2 > ]
[ 2 cut swap >title "%s" printf ]
while
>title print

162I - Суффиксно-простые числа

Вторая по сложности задача, основанная на последовательности A024785 из OEIS. Проверку простоты можно возложить на библиотечное слово prime?, поэтому основная часть решения — еще один while-цикл, отщипывающий от строки по одному символу слева и проверяющий результат на простоту. Отмечу, что значение переменной answer будет изменяться после присвоения ей первоначального значения, поэтому при присвоении нужно добавлять восклицательный знак после названия переменной.

USING: io formatting locals kernel math math.parser math.primes sequences unicode.case ;
IN: truncatable-primes

:: trancatable ( str -- )
   "YES" :> answer!
   str
   [ dup length 0 > ]
   [ dup string>number prime? [ "NO" answer! ] unless
     1 cut swap drop
   ]
   while
   drop
   answer print ;

readln
trancatable

162J - Скобки

Судя по количеству сданных решений, я неправильно оценила эту задачу как самую сложную. Мое решение использовало счетчик скобок, остающихся открытыми, и изменяло его в зависимости от того, какой символ встречался следующим.

USING: io formatting locals kernel math sequences unicode.case ;
IN: balanced-brackets 

:: balanced ( str -- )
   0 :> counter!
   1 :> ok!
   str
   [ dup length 0 > ]
   [ 1 cut swap
     "(" = [ counter 1 + counter! ] [ counter 1 - counter! ] if
     counter 0 < [ 0 ok! ] when
   ]
   while
   drop
   ok 0 =
   [ "NO" ]
   [ counter 0 > [ "NO" ] [ "YES" ] if ]
   if
   print ;

readln
balanced