Ряд Фибоначчи

Давеча рекламировал свои обобщенные последовательности (Generic Sequences), а какие могут быть последовательности без ряда Фибоначчи? Это что-то вроде обязательного ритуала. Опустим здесь тот факт, что я создал эту библиотеку для вполне практической задачи, когда мне понадобилось быстро и эффективно сравнивать деревья, а там ленивые последовательности дюже полезны.

Итак, ниже приведена рабоче-крестьянская версия, которая выдает ленивую бесконечную последовательности ряда Фибоначчи через то, что я назвал Sequence Comprehension:

(defparameter *fibs-1*
  (with-seq/cc
    (do ((a 1 b)
         (b 1 (+ a b)))
        (nil)
      (yield/cc a))))

Очень просто, не правда ли?

Теперь каноническая версия через поток:

(defparameter *fibs-2*
  (reclet 
      ((fibs (seq->stream
              (seq-cons
               1 (seq-cons
                  1 (seq-map
                     (lambda (x)
                       (+ (first x) (second x)))
                     (seq-zip
                      (delay-seq fibs)
                      (delay-seq (seq-cdr fibs)))))))))
    fibs))

Проверка:

? (seq->list (seq-take 20 *fibs-1*))
(1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765)

? (seq->list (seq-take 20 *fibs-2*))
(1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765)

Дополнение.

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

(defparameter *fibs-3*
  (make-seq
   (labels ((traverse (a b)
              (enum-cons a (traverse b (+ a b)))))
     (traverse 1 1))))

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

И если вам по какой-то причине не нравятся комбинаторы, то результат можно получить с помощью известного макроса iter, для которого я добавил конструкцию in-seq:

? (iter (for i from 1 to 20)
        (for x in-seq *fibs-3*)
        (collect x))
(1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765) 

Обобщенные последовательности

Рекламирую свою новую библиотеку Generic Sequences [1] для Common Lisp. Она вводит обобщенные последовательности похожие на обычные списки Common Lisp, ленивые последовательности clojure, списки Haskell, а также похожие на итераторы, которые можно встретить в таких языках программирования как C#, F#, Java и Scala. С помощью комбинаторов легко создавать обобщенные последовательности, и их легко итерировать с помощью макроса ITER.

Более того, есть так называемое Sequence Comprehension, основанное на продолжениях из пакета CL-CONT. Это что-то похожее на синтаксис Sequence Expression из F# и конструкцию Yield из C#, где мы можем определить ленивую последовательность очень простым и декларативным способом.

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

Есть небольшая документация [2] в формате PDF.

[1] https://github.com/dsorokin/generic-sequences

[2] https://github.com/dsorokin/generic-sequences/blob/master/doc/generic-sequences-manual.pdf

Глубоко-вложенные вычисления

Тема возникла из моих ответов на вопросы, заданные другим человеком на форумах. Речь пойдет о рекурсивных вычислениях, когда глубина вложенности выше предельно допустимой для стека вызовов. Я покажу, как такая задача может быть решена на Common Lisp. Сразу отмечу, что это возможно не всегда, но в большинстве случаев работает.

В основе лежит та же самая идея, что используется в F# Async. Мы просто переводим наши рекурсивные функции на язык продолжений.  Пугаться здесь не стоит, сами мы этого делать не станем. За нас все самое сложное и рутинное сделают WITH-CALL/CC и его специальная версия для функций DEFUN/CC из пакета CL-CONT. Ниже везде предполагается, что пакет CL-CONT импортирован.

Но прежде определимся с исходной задачей. Ниже приведены функции, которые вылетают со Stack Overflow.

(defun compute (x)
  (cond ((zerop x) 0)
        (t (+ (compute (1- x))
              1))))


(defun run ()
  (compute 10000000)) ;; Stack Overflow

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

Перепишем функции через продолжения. Функцию COMPUTE определим через DEFUN/CC. Т.е. она будет возвращать не обычное значение, а вычисление, которое еще нужно запустить. В F# это примерно означало бы то, что функция COMPUTE возвращала бы некоторое значение типа Async<'a>.

(defun/cc compute/cc (x)
  (cond ((zerop x) 0)
        (t (+ (compute/cc (1- x))
              1))))

Таким образом мы должны преобразовать всякую функцию, вложенность которой может быть огромной. Вызывать их можно из DEFUN/CC и WITH-CALL/CC:

(defun run/cc ()
  (with-call/cc (compute/cc 10000000)))

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

Увы, не все лисп-машины хорошо оптимизируют хвостовые вызовы. Для CLozure CL и LispWorks Personal мы по-прежнему получим Stack Overflow. К счастью есть выход - использовать трамплин.

Внутри вычисления DEFUN/CC нам доступно продолжение. Если глубина стека вызовов стала большой, то мы можем запомнить продолжение и раскрутить в обратную сторону стек, возвращая управление некоторому внешнему циклу. Внутри этого цикла мы будем проверять, а нет ли у нас очередного продолжения для, так сказать, продления вычисления. Если есть, то запускаем это продолжение. Фокус состоит в том, что при запуске продолжения стек вызовов уже очищен, что нам и требуется.

Сначала определим утилиты трамплина:

(defparameter *cont* nil)


(defun/cc trampoline-push/cc ()
  (call/cc 
   (lambda (k)
     (push k *cont*))))


(defmacro trampoline/cc (expr)
  (let ((result (gensym)))
    `(progn
       (trampoline-push/cc)
       (let ((,result ,expr))
         (trampoline-push/cc)
         ,result))))


(defmacro with-trampoline/cc (&body body)
  (let ((result (gensym)))
    `(let ((,result nil))
       (with-call/cc
         (trampoline-push/cc)
         ,@body)
       (loop while *cont*
          do (let ((cont (pop *cont*)))
               (setf ,result (funcall cont))))
       ,result)))

Утилита TRAMPOLINE-PUSH/CC кладет продолжение вычисления в ячейку *CONT* и возвращает управление внешнему циклу из WITH-TRAMPOLINE/CC, откуда все должно быть запущено. Макрос TRAMPOLINE/СС оборачивает заданное выражение, где трамплин вызывается до и после вычисления выражения.

Мы можем использовать трамплин часто, но это неэффективно. Пусть он вызывается на каждой сотой итерации:

(defun/cc smart-compute/cc (x)
  (cond ((zerop x) 0)
        ((zerop (mod x 100))  
         ;; on every 100th iteration use the trampoline
         (+ (trampoline/cc (smart-compute/cc (1- x)))
            1))
        (t 
         (+ (smart-compute/cc (1- x))
            1))))


 ;; No Stack Overflow
 (defun smart-run/cc ()
  (with-trampoline/cc (smart-compute/cc 10000000)))

Это работает даже для CLISP, где нет никакой оптимизации хвостового вызова. Мы успешно имитирует рекурсивный вызов с глубиной вложенности десять миллионов!

Первые впечатления о CAPI из LispWorks

Сегодня впервые использовал CAPI для создания каркаса будущего редактора диаграмм. Остался очень довольным. Местами не похоже на Windows Forms, WPF/Silverlight, Swing, SWT, но разобраться можно. Работает, что отрадно.

Еще очень радует среда LispWorks. Сейчас в проекте 250 килобайт кода на лиспе. Секунда или две после внесения изменений – и я уже вижу обновленное окошко моего редактора. Помню, как я мучился в ожидании, когда почти ту же самую задачу реализовывал на Scala с помощью IntelliJ Idea. Приходилось ждать целую вечность!

Потоки (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 не является языком функционального программирования?

Монада моделирования. Часть вторая. Первые шаги в Common Lisp.

Это продолжение первой части, в которой подробно описывалась на языке F# монада, которую я назвал монадой моделирования. С помощью нее легко определять динамические системы на основе дифференциальных уравнений, а затем моделировать такие системы. Причем системы могут быть стохастическими, т.е. могут быть использованы случайные функции при построении дифференциальных уравнений. Более того, с помощью этой монады мы можем строить гибридные системы, где некоторые части модели могут быть описаны явно с помощью итерационных процессов и конечных автоматов. На этом моменте далее я остановлюсь подробнее.

В общем, это все уже работает на F#, хотя и медленно. Рабочее название соответствующей библиотеки для F# – Aivika. Теперь я перенес базовую часть на Common Lisp, назвав новую библиотеку Salika. Соответствующий монадический макрос назвал как WITH-DYNAMICS-MONAD. Этот макрос полностью соответствует интерфейсу монадических макросов из пакета cl-monad-macros, о котором я писал в своем блоге ранее. Вкратце, такие макросы добавляют удобный синтаксический сахар по типу нотации do из хаскеля.

Возьмем простую динамическую систему, описанную на языке MapSim:

A = integ (-F, 100);
B = integ (F - G, 0);
C = integ (G, 0);

F = ka * A;
G = kb * B;

ka = 1;
kb = 1;

Функция integ задает интеграл. В первом параметре функции определяется производная по времени. Во втором – начальное значение интеграла. Интегрирование происходит на промежутке starttime <= t <= stoptime с шагом dt. Здесь A(t), B(t) и C(t) – интегралы. Их еще иногда называют в системной динамике резервуарами. Функции F(t) и G(t) называют дополнительными. В системе также заданы константы ka и kb.

В первой ссылке есть пример того, как эту систему можно задать на языке F#. Там получается достаточно близко к математической нотации. Во многом благодаря тому, что для типа монады моделирования легко определить арифметические операции и стандартные функции типа синуса и косинуса. Такой подход можно встретить, например, в книге “The Haskell School of Expression” автора Paul Hudak. В случае же Common Lisp я предпочитаю использовать монадические макросы напрямую, поскольку это порождает в целом более эффективный код. Думаю, что наглядность при этом страдает несильно.

Итак, такую систему мы можем описать на Common Lisp следующим образом.

(defun create-process ()
  (let* ((ka 1d0)
         (kb 1d0))
    (let* ((integ-a (make-instance 'integ-stock :initial-value 100d0))
           (integ-b (make-instance 'integ-stock :initial-value 0d0))
           (integ-c (make-instance 'integ-stock :initial-value 0d0)))
      (let* ((f (with-dynamics-monad
                  (let! ((a (current-value integ-a)))
                    (unit (* ka a)))))
             (g (with-dynamics-monad
                  (let! ((b (current-value integ-b)))
                    (unit (* kb b))))))
        (setf (outflow integ-a) f)
        (setf (inflow integ-b) f)
        (setf (outflow integ-b) g)
        (setf (inflow integ-c) g)
        (current-value integ-a)))))

Единственный момент – в примере возвращается лишь интеграл A, но как часть всей системы. Здесь монаду можно увидеть в том, как задаются динамические процессы для переменных F и G. Внутри макроса WITH-DYNAMICS-MONAD макроc LET! эквивалентен стрелке из нотации do, а макрос UNIT – функции return для монады. Получается, что F и G возвращают монады. Более того, выражение (current-value integ-a) – тоже монада. Это представления динамических процессов.

Такую систему достаточно просто промоделировать. Нижеследующая функция запускает соответствующую имитацию и возвращает значения интеграла A в основных узлах интегрирования, как это принято в методах Эйлера и Рунге-Кутта.

(defun run-process ()
  (with-dynamics-monad
    (run! (create-process) (make-specs :start-time 0.0 :stop-time 10.0 :method 'runge-kutta-4 :dt 0.1)))))

Среда лиспа проинтегрирует модель методом Рунге-Кутта четвертого порядка, начиная от точки 0 и заканчивая точкой 10 с основным шагом интегрирования 0,1.

SALIKA> (run-process)
(100.0d0 90.48374986516933d0 81.8730898966253d0 74.08184186894766d0
         67.03202849220888d0 60.65309299043932d0 54.88119294695767d0
         49.658561349146126d0 44.932928437803035d0 40.65699857475723d0
         36.787976893068794d0 33.28714099238066d0 30.119453392811955d0
         27.253210868708226d0 24.65972715266909d0 22.313045834254343d0
         ...)

Такие дифференциальные уравнения задаются достаточно декларативно, т.е. мы пишем, что мы хотим вычислить, при этом почти ничего не говорим о том, как вычислить. Разве что упоминаем о порядке зависимости переменных и интегралов друг от друга, но это цена языка программирования с энергичной моделью вычислений.

Тем не менее, во время интегрирования таких уравнений внутри используется сугубо императивная функция мемоизации MEMO-PROCESS. Она аналогична функции memo из F#-вской библиотеки. Обе эти функции принимают динамический процесс, т.е. некоторое значение в монаде моделирования, и возвращают процесс-двойник, который кеширует все значения первого процесса в узлах интегрирования, причем вычисления происходят строго последовательно по узлам. Это открывает путь к построению гибридных моделей, поскольку мы здесь знаем, что первый, т.е. кешируемый процесс будет вычисляться в строго определенном порядке (если нет других ссылок на него). Такой процесс мы можем реализовать как итерационный. Это еще одна вещь наряду с недетерминизмом, которую будет трудно или почти невозможно воспроизвести в хаскеле.

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

Это все прекрасно, но у моего метода есть большой недостаток. Монада моделирования работает медленно, очень медленно. Например, MapSim компилирует симуляцию в эффективный байт-код, который выполняется гораздо быстрее. Или, быть может, просто MapSim быстр? Но монада моделирования позволяет достаточно просто и легко строить очень сложные гибридные модели. И пока я не определился в своем отношении к изобретению. Просто игрушка для ума или серьезная и полезная вещь?

Версия для F# достаточно зрелая и многое умеет, включая стохастику. Версия для Common Lisp реализует пока лишь интегралы и мемоизацию, причем нет оптимизации по типам. Может быть, потом выложу результаты в свободный доступ. Хотя мне кажется, что описанное в обеих частях достаточно легко воспроизвести, поскольку первая часть содержит полное описание монады моделирования на языке F#.

Алгебраические типы данных в Common Lisp

В продолжение функциональной темы. В ходе беседы у меня возникла идея того, как можно создавать и обрабатывать так называемые алгебраические типы данных (algebraic data types - ADT) вроде таких

data TaggedType a = NoneValue
                  | SingleValue a
                  | DoubleValue (a, a)

Здесь NoneValue, SingleValue и DoubleValue являются также конструкторами данных. Компилятор хаскеля по такому определению автоматически создает одноименные функции. Мы их тоже создадим. Будем делать все через списки. Первым элементом списка будет идти символическое имя конструктора, т.е. тег. Затем в списке будут идти данные. Это позволит нам различать значения.

(defun none-value ()
  (list 'none-value))

(defun single-value (a)
  (list 'single-value a))

 (defun double-value (a1 a2)
  (list 'double-value a1 a2))

Как видим, все очень просто. Теперь мы можем вручную устроить сопоставление с образцом (pattern-matching).

(defun test-tagged-type (v)
  (ecase (car v)
    (none-value (format t "NoneValue "))
    (single-value (format t "SingleValue ~A" (cadr v)))
    (double-value (format t "DoubleValue (~A, ~A)" (cadr v) (caddr v)))))

Писать каждый раз такой код – дело утомительное и ненужное. Поэтому я придумал вспомогательные утилиты.

Макрос DEFINE-ADT позволяет автоматически генерировать конструктор данных для ADT. Получается та же самая функция, создающая такой же список.

(defmacro define-adt (name &rest args)
  `(defun ,name (,@args)
     (list ',name ,@args)))

Следующий макрос позволяет более наглядно сопоставлять с образцом. Его имя похоже на имена стандартных макросов CASE, CCASE и ECASE. Приставка ADT указывает, что работа идет с алгебраическими типами данных.

(defmacro adt-case (value &body cs)
  (let* ((t-defined nil)
         (ps (loop for c in cs collect
                  (cond
                    ((eql (car c) 't)
                     (setf t-defined t)
                     (append '(t) (cdr c)))
                    (t
                     (when t-defined
                       (error "The T clause can be only the last in the form."))
                     (destructuring-bind ((name &rest args) &body body) c
                       (adt-pattern value name args body)))))))
    (if t-defined
        `(case (car ,value) ,@ps)
        `(ecase (car ,value) ,@ps))))

(defun adt-pattern (value name args body)
  `(,name
    ,(if (null args)
         `(progn ,@body)
         `(destructuring-bind (,@args) (cdr ,value) ,@body))))

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

(define-adt none-value)
(define-adt single-value a)
(define-adt double-value a1 a2)

(defun test-tagged-type (v)
  (adt-case v
    ((none-value) (format t "NoneValue"))
    ((single-value a) (format t "SingleValue ~a" a))
    ((double-value a1 a2) (format t "DoubleValue (~a, ~a)" a1 a2))))

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

(defun test-tagged-type-2 (v)
  (adt-case v
    ((none-value) (format t "NoneValue"))
    (t (format t "Not NoneValue"))))

И, наконец, приведу функцию, которая берет значение типа TaggedType и возвращает либо NIL, либо новую CONS-пару.

(defun tagged-type->cons (v)
  (adt-case v
    ((none-value) nil)
    ((single-value a) (list a))
    ((double-value a1 a2) (cons a1 a2))))

Пример использования:

CL-USER> (tagged-type->cons (double-value 1 2))
(1 . 2)

Монадические макросы для Common Lisp

Изобрел монадические макросы для Common Lisp и оформил их в виде пакета cl-monad-macros. На мой взгляд, получилась довольно интересная вещь, основным достоинством которой является высокая эффективность генерируемого кода. Здесь было бы интересно посостязаться с хаскелевскими компиляторами. Потом поместил объявление на comp.lang.lisp.

Основная идея состоит в том, что мы задаем монадические макросы типа WITH-MONAD, которые внутри себя через MACROLET определяют унифицированные макросы UNIT, FUNCALL!, LET! и PROGN!. Макрос UNIT – это хасклевская функция return, FUNCALL! – это bind с обратным порядком параметров (=<<), LET! – альтернатива стрелке, а PROGN! – замена хаскелевского then (>>). Причем LET! по виду похож на стандартный LET*, а PROGN! – на стандартный PROGN. Более того, в случае монады Identity (макрос WITH-IDENTITY-MONAD) макрос LET! совпадает с LET*, PROGN! – с PROGN, FUNCALL! – c FUNCALL, а UNIT становится эквивалентным обычной функции IDENTITY. Все это позволяет писать код в единой нотации – меняем только монадические макросы типа WITH-MONAD.

Например, макрос WITH-LIST-MONAD задает монаду List. Следующая функция возвращает все возможные перестановки заданного списка.

(defun perms (xs)
  (with-list-monad
      (if (null xs)
          (unit nil)
          (let! ((y xs)
                 (ys (perms (remove y xs :count 1))))
                (unit (cons y ys))))))

Функцию можно протестировать:

CL-USER> (perms '(1 2 3))
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

По своей сути LET!  – это обобщенный случай List Comprehension. PROGN! создает последовательность вычислений. Самое интересное, что реализация всех этих макросов в общем случае проста как топор. За это отвечает монадический макрос WITH-MONAD.

Пакет cl-monad-macros предоставляет также готовые монадические макросы для монад Identity, List, Maybe, Reader, State и Writer. Последняя монада несколько отличается от канона, но суть та же. Такие специализированные макросы порождают намного более эффективный код для своих монад, чем обобщенный макрос WITH-MONAD.

Были сложности с монадными трансформерами. Для них, кстати, отдельные макросы – необходимость. В пакете есть макросы для трансформеров Reader, State и Writer. Это параметризуемые монадические макросы, где параметром является другой монадический макрос. Довольно мощная абстракция, которая позволяет комбинировать несколько монад в одной.

Если пытаться использовать монадические макросы для транформеров непосредственно в коде, то легко загнать лисповский компилятор в ступор. Дело в том, что эти макросы при раскрытии создают множество вложенных MACROLET-ов. У компиляторов от этого сносит голову напрочь. Но пока мне такая кодо-генерация представляется единственно возможной для трансформеров, если делать именно через макросы, а не generic-функции. Но, к счастью, есть простое решение. Назвал его упрощением (редукцией) монадических макросов. С обычными же непараметризуемыми макросами типа WITH-MONAD и WITH-LIST-MONAD все нормально.

Теперь вот думаю дополнить монадические макросы вспомогательными макросами. Нужны аналоги хаскелевских полиморфных функций типа fmap, sequence, join и т.д. Еще нужно что-то придумать для циклов. В хаскеле этого уже нет, но зато есть в F#.

Это все собираюсь использовать для симуляции моделей системной динамики. Обнаружил, что динамический процесс может быть определен как вариация монады Reader. Что важно, это позволяет задавать задачи моделирования декларативно, т.е. на высоком уровне абстракции. Я уже написал такую библиотеку на F#, но меня не устраивает ее скорость – слишком много накладных расходов, связанных с монадами. Надеюсь, что лисповская реализация на основе придуманных мною монадических макросов будет быстрее, во многом благодаря особой технике генерации кода для монады Reader. Там получается, что FUNCALL и LAMBDA чередуются друг с другом, то есть их можно сократить, но об этом написано уже у меня в документации к пакету cl-monad-macros.