воскресенье, 28 февраля 2010 г.

Потоки (Streams)

Вчера прочитал главу SICP, посвященную потокам (streams). Возникло острое желание переписать примеры на Common Lisp (CL). Тема очень интересна сама по себе. Еще подстегивало то, что некоторые активисты упорно пропагандируют идею оторванности CL от функциональной парадигмы (ФП), как бы это абсурдно ни звучало. Но когда я приступил к переписыванию кода на CL, мое первое обманчивое впечатление было таким, что потоки будет реализовать труднее, чем в Схеме. Например, в CL нет аналога схемовского DEFINE, который бы позволил определять переменные рекурсивно. Но, к счастью, все разрешилось удачным образом. Как и должно было быть, выручили макросы, могучая сила CL. Они же мне позволили в свое время добавить очень простой и удобный синтаксический сахар для монад по типу нотации do, о чем я писал ранее.

Итак, все начинается с ленивости. Для этого определяются конструкции DELAY и FORCE, но прежде нужна вспомогательная функция MEMO, которая возвращает функцию без аргументов, результат которой кешируется:

(defun memo (fun)
  (let ((already-run? nil)
        (result nil))
    #'(lambda ()
        (if (not already-run?)
            (progn
              (setf result (funcall fun))
              (setf already-run? t)
              result)
            result))))

Тут все по книге SICP, только там функция называлась MEMO-PROC.

Дальше определяем конструкции DELAY и FORCE, причем DELAY должен быть непременно макросом, чтобы он мог упрятать свой аргумент в лямбду, сделав его тем самым ленивым:

(defmacro delay (exp)
  `(memo #'(lambda() ,exp)))

(defun force (delayed-exp)
  (funcall delayed-exp))

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

(defmacro cons-stream (a b)
  `(cons ,a (delay ,b)))

(defun stream-car (stream)
  (car stream))

(defun stream-cdr (stream)
  (force (cdr stream)))

(defun stream-null (stream)
  (null stream))

(defparameter *empty-stream* nil)

Функция STREAM-CDR раскрывает ленивую CDR-часть потока, если она не была до того уже раскрыта. Как помним, на нижнем уровне за это отвечает функция MEMO, которая встраивается при создании каждой пары. В общем, это все уже описано в SICP. Поэтому останавливаться не буду.

Следующая функция STREAM-REF аналогична AREF, но работает уже с потоками.

(defun stream-ref (stream n)
  (loop for i from 0 to n
     for s = stream then (stream-cdr s)
     finally (return (stream-car s))))

Несмотря на присутствие в реализации совсем нефункционального LOOP, функция является чистой.

Далее идут отображения для потоков. Вполне в духе ФП.

(defun stream-map (fun stream)
  (if (stream-null stream) stream
      (cons-stream (funcall fun (stream-car stream))
                   (stream-map fun (stream-cdr stream)))))

(defun stream-map2 (fun s1 s2)
  (cond
    ((stream-null s1) s1)
    ((stream-null s2) s2)
    (t (cons-stream (funcall fun (stream-car s1) (stream-car s2))
                    (stream-map2 fun (stream-cdr s1) (stream-cdr s2))))))

Далее понадобится функция фильтрации потока. Я поменял имя STREAM-FILTER на более идиоматическое. К тому же задействовал LOOP. При этом функция остается чистой.

(defun stream-remove-if-not (test stream)
  (loop for s = stream then (stream-cdr s)
     when (stream-null s) do (return s)
     when (funcall test (stream-car s)) do
       (return
         (cons-stream (stream-car s)
                      (stream-remove-if-not test (stream-cdr s))))))

Чтобы опробовать новые возможности в деле, понадобятся еще итератор и функция вывода:

(defun stream-iter (fun stream)
  (loop for s = stream then (stream-cdr s)
       while (not (stream-null s))
       do (funcall fun (stream-car s))))

(defun print-stream (stream)
  (stream-iter #'(lambda (x) (format t "~%~a" x)) stream))

Теперь, можно немного поиграться, чтобы убедиться в работоспособности базовых конструкций:

CL-USER> (print-stream (cons-stream 1 (cons-stream 2 (cons-stream 3 nil))))

1
2
3
NIL

Подходим к главному препятствию. В схеме мы могли легко определить поток рекурсивно. Например, поток единиц задавался бы так:

(define ones (cons-stream 1 ones))  ;; Scheme!

Несмотря на кажущуюся простоту выражения, компилятор выполняет много работы. Придется это повторить. Я лишь покажу конечный результат. Аналогом на CL будет следующее определение:

(defparameter *ones*
  (recurrent-let ((ones (cons-stream 1 ones)))
    ones))

Здесь RECURRENT-LET похож на LET с одной переменной. Отличие заключается в том, что к самой переменной можно обращаться внутри определения. То есть, определение может быть рекурсивным.

Сам макрос RECURRENT-LET достаточно прост:

(defmacro recurrent-let (((name value)) &body body)
  (let ((x (gensym)))
    `(let ((,x (cons nil nil)))
       (symbol-macrolet ((,name (force (car ,x))))
         (setf (car ,x) (delay ,value))
         ,@body))))

Вот, во что будет раскрыта внутренняя часть определения параметра *ONES*:

(LET ((#:G764 (CONS NIL NIL)))
  (SYMBOL-MACROLET ((ONES (FORCE (CAR #:G764))))
    (SETF (CAR #:G764) (DELAY (CONS-STREAM 1 ONES)))
    ONES))

Мы создаем некий объект с одним полем. Это поле содержит ленивое значение переменной. Любое (рекурсивное) обращение к переменной мы трактуем как попытку немедленно вычислить ее значение, если оно еще не вычислено. Трюк работает, потому что мы успеваем присвоить полю объекта ленивое значение прежде первого обращения к этой переменной. Это гарантирует использованный макрос DELAY.

Стоит заметить, что данное представление бесконечного потока единиц на самом деле занимает очень мало памяти, поскольку поток ссылается на самого себя.

Если присмотреться к определению макроса, то можно увидеть, что внутри определения рекурсивной переменной мы можем использовать еще один RECURRENT-LET, а также любую другую конструкцию, включая LET, FLET и LABELS. Это открывает путь к вложенным и более сложным взаимно-рекурсивным определениям, что и будет продемонстрировано далее.

В соответствии с SICP определим вспомогательные функции:

(defun add-streams (stream1 stream2)
  (stream-map2 #'+ stream1 stream2))

(defun scale-stream (stream factor)
  (stream-map #'(lambda (x) (* x factor)) stream))

Далее определим поток целых чисел:

(defun integers-starting-from (n)
  (cons-stream n (integers-starting-from (+ n 1))))

(defparameter *integers-alpha*
  (integers-starting-from 1))

Этот же самый поток мы можем определить иначе:

(defparameter *integers*
  (recurrent-let
      ((integers (cons-stream 1 (add-streams *ones* integers))))
     integers))

Естественно, без определения потока чисел Фибоначчи мое сообщение можно было бы считать неполным:

(defparameter *fibs*
  (recurrent-let
      ((fibs (cons-stream 0
                          (cons-stream 1
                                       (add-streams (stream-cdr fibs)
                                                    fibs)))))
    fibs))

Теперь можем узнать, каким будет 1001-ое число Фибоначчи:

CL-USER> (stream-ref *fibs* 1001)
70330367711422815821835254877183549770181269836358732742604905087154537118196933579742249494562611733487750449241765991088186363265450223647106012053374121273867339111198139373125598767690091902245245323403501

Как и следовало ожидать, ответ был немедленным.

Следуя SICP, далее приведу пример определения потока простых чисел. Но прежде мне понадобятся две простые утилиты.

(defun square (n) (* n n))
(defun divisible-p (x y) (= (mod x y) 0))

Сам поток определен ниже. Это также пример взаимно-рекурсивного определения.

(defparameter *primes*
  (recurrent-let
      ((primes
        (flet ((prime-p (n)
                 (labels ((iter (ps)
                            (cond ((> (square (stream-car ps)) n) t)
                                  ((divisible-p n (stream-car ps)) nil)
                                  (t (iter (stream-cdr ps))))))
                   (iter primes))))
          (cons-stream
           2
           (stream-remove-if-not #'prime-p (integers-starting-from 3))))))
    primes))

Еще один пример — решатель дифференциальных уравнений. Сначала определяем интеграл, где интегрируемая функция передается лениво:

(defun integral (delayed-integrand initial-value dt)
  (recurrent-let
      ((int (cons-stream initial-value
                         (let ((integrand (force delayed-integrand)))
                           (add-streams (scale-stream integrand dt)
                                        int)))))
    int))

Теперь сам решатель:

(defun solve (f y0 dt)
  (recurrent-let
      ((y (recurrent-let
              ((dy (stream-map f y)))
            (integral (delay dy) y0 dt))))
    y))

Можем проверить как и в SICP:

CL-USER> (stream-ref (solve #'(lambda (y) y) 1 0.001) 1000)
2.7169204

Как видим, примеры достаточно легко ложатся на CL, хотя и выглядят несколько иначе. При этом они вполне соответствуют духу ФП. Разве что, использование LOOP несколько необычно для этой области, но это прекрасный пример сочетания разных подходов к программированию. Основа остается несомненно функциональной. Неужели после этого может кто-то по-прежнему утверждать, что CL не является языком функционального программирования?

7 комментариев:

  1. >Аналогом на CL будет следующее определение

    А форма lables не спасает?

    ОтветитьУдалить
  2. > А форма lables не спасает?

    Нет, такая форма служит для определения рекурсивных функций, а здесь имеем переменные, определенные рекурсивно. В этом заключается существенная разница, даже на уровне деталей реализации. Да иначе бы потоки не были так эффективны.

    ОтветитьУдалить
  3. В дополнение. В книге The Haskell School of Expression есть прекрасная иллюстрация того, как все меняется, если мы заменяем рекурсивное определение переменной на рекурсивную функцию, даже с пустым списком параметров. Программа начинает безудержно потреблять память, потому что потоки начинают плодится. Поэтому нужна именно переменная.

    ОтветитьУдалить
  4. Только сейчас заметил. Можно обойтись без создания cons-пары в определении макроса RECURRENT-LET. Обычная ссылка на переменную будет работать. Самое интересное, что этот прием я уже использовал, но как-то подзабыл о нем...

    ОтветитьУдалить
  5. Если кому интересно, то ниже новая версия макроса RECURRENT-LET (только требуется форматирование). Может объявлять несколько взаимно-рекурсивных переменных. Оптимизирована. Можно использовать не только для задания потоков, но и для самых разных вещей. Например, для задания дифференциальных уравнений без явного указания зависимости между переменными!


    (defmacro recurrent-let (decls &body body)
    (labels
    ((make-infos (decls)
    (loop for decl in decls collect
    (destructuring-bind (name value) decl
    (list :name name :value value :gen (gensym)))))
    (gen-let (info)
    `(,(getf info :gen) nil))
    (gen-symbol-macrolet (info)
    `(,(getf info :name) (force ,(getf info :gen))))
    (gen-setf (info)
    `(setf ,(getf info :gen) (delay ,(getf info :value))))
    (gen-lets (infos)
    (loop for info in infos collect (gen-let info)))
    (gen-symbol-macrolets (infos)
    (loop for info in infos collect (gen-symbol-macrolet info)))
    (gen-setfs (infos)
    (loop for info in infos collect (gen-setf info))))
    (let ((infos (make-infos decls)))
    `(let (,@(gen-lets infos))
    (symbol-macrolet (,@(gen-symbol-macrolets infos))
    ,@(gen-setfs infos)
    ,@body)))))

    ОтветитьУдалить
  6. Извините за делитанство, но я занимался тем же. А именно читал SICP и пробовал примеры в CL. И поток для чисел Фибоначчи я определял так:
    (defparameter *fibs* (cons-stream 0
    (cons-stream 1
    (add-streams (stream-cdr *fibs*)
    *fibs*))))
    Соответвенно
    (dotimes (i 100) (format t "~S " (stream-ref *fibs* i)))
    считается быстро если delay с мемоизацией и медленно если без. Пробовал в clisp, ecl, sbcl. sbcl выдает варнинги на *fibs*, что в принципе логично. Если переписать чтоб не было "ссылок вперед":
    (defvar *fibs*)
    (setq *fibs* (cons-stream 0 .....
    то варнингов нет. Вы не могли бы объяснить смысл вашего макроса? Тем более, как я вижу у вас идея лежащая в его основе получила развитие. Я сравнил то, что в результате находиться в *fibs*, как мне показалось там одно и тоже что в вашем варианте что в моем. Разъясните пожалуйста, блуждаю в 3 соснах.

    ОтветитьУдалить
  7. > Вы не могли бы объяснить смысл вашего макроса?

    Макрос трактует переменные как отложенные значения. Поэтому при их определении используется delay: (setf x (delay ...)). Но тогда при обращении к такой переменной x нам нужно избавиться от этого delay. Поэтому внутри всех выражений каждое вхождение переменной x заменяется на (force x). Такая замена достигается через symbol-macrolet.

    Получаем следующее. Сначала переменные определяем как отложенные (еще невычисленные) значения, т.е. фактически через заготовки будущих значений. Потом все запускается при первом же обращении внутри тела recurrent-let к какой-нибудь переменной, которая на самом деле будет заменена макролетом на вызов force. Тут возможна бесконечная рекурсия. Поэтому надо быть осторожным.

    Уже потом я узнал, что в лиспе есть конструкция letrec, которая делает то же или почти то же самое :)

    ОтветитьУдалить