LINUX.ORG.RU

[clisp] запустите скрипт у себя


0

0

Скрипт вычисляет значения функции Аккермана, используя кэширование. Кэш вначале инициализируется, а потом происходит выполнение (ниже код).

Скрипт:

;; кэш для функции Аккермана
(defvar *akk-cache* nil)

;; счетчик рекурсивных вызовов (должен быть обнулен перед вызовом функции akk или akk-cache)
(defvar *akk-recursive-calls-counter* 0)


(defun print-akk-cache ()
  (print *akk-cache*))

(defun print-akk-calls-counter ()
  (format t "~a~%" *akk-recursive-calls-counter*))


;; эта функция инициализирует кэш указанным размером
(defun init-akk-cache (m n)
  (setf *akk-cache* nil)
  (setf *akk-cache* (make-list m))
  (let ((cache-row (make-list n :initial-element 0)))
    (dotimes (i m)
      (setf (nth i *akk-cache*) (copy-list cache-row))))
  (return-from init-akk-cache t))


;; установка значения в кэше
(defun set-akk-cache-value (m n value)
  (setf (nth n (nth m *akk-cache*)) value)
  (return-from set-akk-cache-value t))


;; получение значения из кэша					
(defun get-akk-cache-value (m n)
  (if (or (> m (length *akk-cache*)) (> n (length (nth 0 *akk-cache*))))
      (format t "FUCK!~%"))
  (let ((result (nth n (nth m *akk-cache*))))
    (return-from get-akk-cache-value result)))


;; функция Аккермана без использования кэширования
(defun akk (m n)
  (incf *akk-recursive-calls-counter*)
  (cond ((= m 0) (+ n 1))
	((= n 0) (akk (- m 1) 1))
	(t (akk (- m 1) (akk m (- n 1))))))


;; функция Аккермана с использованием кэширования
(defun akk-cache (m n)
  (incf *akk-recursive-calls-counter*)
  (if (/= (get-akk-cache-value m n) 0)
      (return-from akk-cache (get-akk-cache-value m n))
      (let ((value (cond ((= m 0) (+ n 1))
			 ((= n 0) (akk-cache (- m 1) 1))
			 (t (akk-cache (- m 1) (akk-cache m (- n 1)))))))
	(set-akk-cache-value m n value)
	(return-from akk-cache value))))

;;
(defun akk-with-calls-counting ()
  (loop for m from 0 to 3 do
       (loop for n from 0 to 14 do
	    (setf *akk-recursive-calls-counter* 0)
	    (format t "(~2a ~2a) ~12a [~a]~%" m n (akk m n) *akk-recursive-calls-counter*))))

(defun akk-cache-with-calls-counting ()
  (loop for m from 0 to 3 do
       (loop for n from 0 to 14 do
	    (setf *akk-recursive-calls-counter* 0)
	    (format t "(~2a ~2a) ~12a [~a]~%" m n (akk-cache m n) *akk-recursive-calls-counter*))))

Я работаю в Emacs/Inferior Lisp, поэтому привожу коды для запуска:

(init-akk-cache 10 1000000)
(akk-cache-with-calls-counting)

Я дошел до (3 14), дальше у меня шло переполнение стека (я 4 * не считал). Если возможно, посчитайте, пожалуйста, например, не от 0 до 3 и от 0 до 14, как сейчас, а от 0 до 5 и от 0 до 20, например. Если будет переполнение стека, то нужно увеличить размер кэша, например, на 10х10000000 и так далее.

Мой компьютер не позволяет мне такое сделать, буду очень благодарен, если поможете.

★★

И, кстати, если найдете недочеты в коде, с удовольствием выслушаю.

bk_ ★★
() автор топика

Короче, я не смотрел на код. Лень. Но хочу предупредить, что clisp без компиляции рекурсию не раскрывает. Поэтому у тебя и переполнение. Попробуй скомпилировать в байт-код и попробуй снова.

Zubok ★★★★★
()

4гб для рекурсии мало
имхо надо развернуть самому, и все
или найти посчитанную таблицу

gavv
()
Ответ на: комментарий от Zubok

> Но хочу предупредить, что clisp без компиляции рекурсию не раскрывает.

Можно подумать, для функции Аккермана он это сможет при компиляцией сделать ;)

archimag ★★★
()
Ответ на: комментарий от gavv

>имхо надо развернуть самому, и все

или найти посчитанную таблицу


Во-во, поищи табличку в инете, где аккерман «свёрнут» по
Акк(0, *), Акк(1, *), Акк(2, *), Акк(3, *), Акк(4, *)

И считать даже без рекурсии будет моментально, и поймёшь, на сколько-же бешеным темпом она дальше скачет

yyk ★★★★★
()
Ответ на: комментарий от archimag

>Можно подумать, для функции Аккермана он это сможет при компиляцией сделать ;)

Да, согласен. Вложенную рекурсию не сможет. Я сильно поторопился со своей репликой, что, однако, не меняет ее актуальности в жизни. :)

ТС-у: надо поробовать тогда развернуть функцию Аккермана в цикл самостоятельно. Только готового алгоритма я не знаю, да и задачка не такая уж простая для тех, кто этим специально не занимался. Вот документик есть, кстати:

http://citeseer.ist.psu.edu/cache/papers/cs/6518/http:zSzzSzwww.dur.ac.ukzSz~...

Zubok ★★★★★
()
Ответ на: комментарий от Zubok

>задачка не такая уж простая
считать по две строчки по m, а n брать достаточно большим, чтобы на (5 20) хватило :)

gavv
()

Что, не печатает? ;)

anonymous
()
Ответ на: комментарий от gavv

>считать по две строчки по m, а n брать достаточно большим, чтобы на (5 20) хватило :)

о (5 0) даже и речи не идёт... 4,2 - предел

yyk ★★★★★
()
Ответ на: комментарий от yyk

Хех, да понятно, что таблицы есть. Я ее видел, да. Но ведь ТС не написал, зачем он все-таки считает. Может, он машину изнасиловать хочет или «точки расставляет», сравнивая производительность реализаций или языков. :)

Zubok ★★★★★
()

В качестве программистского этюда: кеширование функции Аккермана с использованием монады продолжения. Что касается скорости, то, наверное, далеко не оптимально. Все таки создается много лямбд. Зато какая красота с отложенными вычислениями и легкостью задания самой фукнции! Сугубо для развлечения и эстетического наслаждения :)

(defun make-key (m n)
  (cons m n))

(defmacro cont-unit (a)
  ;; return в монаде продолжения: 
  ;;   return a 
  `#'(lambda (c) (funcall c ,a)))

(defmacro cont-let! (((x e)) m)
  ;; bind в монаде продолжения:
  ;;   e >= (\x -> m)
  `#'(lambda (c) (funcall ,e #'(lambda (,x) (funcall ,m c)))))

(defun ackermann (m n)
  (let ((cache (make-hash-table :test #'equalp))
        (calcs nil))
    (labels
        ((fix (m n x)
           ;; вход: x - вычисление в монаде продолжения как функция m, n
           ;; выход: кешированное вычисление в монаде продолжения
           (let ((key (make-key m n)))
             #'(lambda (c)
                 (let ((a (gethash key cache)))
                   (cond 
                     ((null a)
                      ;; значение не найдено в кеше - откладываем на потом
                      ;;(format t "delay: ack (~d, ~d)~%" m n)
                      (push #'(lambda ()
                                (funcall x
                                         #'(lambda (a)
                                             ;; значение а вычислено для m и n!
                                             ;;(format t "calc: ack (~d, ~d) = ~d~%" m n a)
                                             (setf (gethash key cache) a)
                                             (funcall c a))))
                            calcs))
                     (t
                      ;; значение а найдено в кеше для m и n!
                      ;;(format t "found: ack (~d, ~d) = ~d~%" m n a)
                      ;; продолжаем, игнорируя x
                      (funcall c a)))))))
         (fix-ack (m n)
           ;; кешированное вычисление функции аккерманна в монаде продолжения
           (fix m n (ack m n)))
         (ack (m n)
           ;; вычисление функции аккерманна в монаде продолжения
           (cond
             ((zerop m)
              (cont-unit (1+ n)))
             ((and (zerop n) (> m 0))
              (fix-ack (1- m) 1))
             ((and (> m 0) (> n 0))
              (cont-let! ((x (fix-ack m (1- n))))
                 (fix-ack (1- m) x)))
             (t
              (error "ACKERMANN -- invalid arguments: ~d, ~d " m n)))))
      (funcall (ack m n)
               #'(lambda (a)
                   (format t "result: ack (~d, ~d) = ~d~%" m n a)))
      (loop while (not (null calcs))
           do (let ((f (car calcs)))
                (setf calcs (cdr calcs))
                (funcall f))))))
dave ★★★★★
()
Ответ на: комментарий от dave

Вообще-то, не такая уж и игрушка получилась. Я удалил за ненадобностью отложенные вычисления. Код стал чище. Функция работает при m=3 и n=18, тогда как кеширование в-лоб съело бы весь стек даже при m=3 и n=15, а затем выпало бы с исключением в осадок :)

CL-USER>(ackermann 3 18)
2097149

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

Еще профит в том, что теперь я стал лучше понимать как работает TCO. Оказывается, оптимизация работает даже в большем числе случаев, чем я полагал прежде.

(defun make-key (m n)
  (cons m n))

(defmacro cont-unit (a)
  ;; return в монаде продолжения: 
  ;;   return a 
  `#'(lambda (c) (funcall c ,a)))

(defmacro cont-let! (((x e)) m)
  ;; bind в монаде продолжения:
  ;;   e >>= (\x -> m)
  `#'(lambda (c) (funcall ,e #'(lambda (,x) (funcall ,m c)))))

(defun ackermann (m n)
  (let ((cache (make-hash-table :test #'equalp)))
    (labels
        ((fix (m n x)
           ;; вход: x - вычисление в монаде продолжения как функция m, n
           ;; выход: кешированное вычисление в монаде продолжения
           (let ((key (make-key m n)))
             #'(lambda (c)
                 (let ((a (gethash key cache)))
                   (cond 
                     ((null a)
                      ;; значение не найдено в кеше - придется вычислить x
                      ;;(format t "not-found: ack (~d, ~d)~%" m n)
                      (funcall x
                               #'(lambda (a)
                                   ;; значение а вычислено для m и n!
                                   ;;(format t "calc: ack (~d, ~d) = ~d~%" m n a)
                                   (setf (gethash key cache) a)
                                   (funcall c a))))
                     (t
                      ;; значение а найдено в кеше для m и n!
                      ;;(format t "found: ack (~d, ~d) = ~d~%" m n a)
                      ;; продолжаем, игнорируя x
                      (funcall c a)))))))
         (fix-ack (m n)
           ;; кешированное вычисление функции аккерманна в монаде продолжения
           (fix m n (ack m n)))
         (ack (m n)
           ;; вычисление функции аккерманна в монаде продолжения
           (cond
             ((zerop m)
              (cont-unit (1+ n)))
             ((and (zerop n) (> m 0))
              (fix-ack (1- m) 1))
             ((and (> m 0) (> n 0))
              (cont-let! ((x (fix-ack m (1- n))))
                 (fix-ack (1- m) x)))
             (t
              (error "ACKERMANN -- invalid arguments: ~d, ~d " m n)))))
      (let ((result nil))
        (funcall (ack m n)
                 #'(lambda (a)
                     ;;(format t "result: ack (~d, ~d) = ~d~%" m n a)
                     (setf result a)))
        result))))
dave ★★★★★
()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.