Início Arquivo AdNauseum Lisp Octave Fotos Notas

diale.org

John Scofield and the Piety Street Band / That's Enough

ç

Etiquetas: John Scofield, guitar

A gentleman entered a pastry-cook's shop ...

A gentleman entered a pastry-cook's shop and ordered a cake; but he soon brought it back and asked for a glass of liqueur instead. He drank it and began to leave without having paid. The proprietor detained him. "You've not paid for the liqueur." "But I gave you the cake in exchange for it." "You didn't pay for that either." "But I hadn't eaten it". — from Freud (1905).

Ref.: Jokes and their Relation to the Cognitive Unconscious, Marvin Minsk: ftp://publications.ai.mit.edu/classic-hits/minsky/jokes.cognitive

Etiquetas: jokes, freud, Minsky

Compiling a Realtime Kernel in Debian 5.0/Lenny

Here it is my motivation for compiling a realtime kernel!

$ apt-get install kernel-package libncurses5-dev fakeroot wget bzip2 build-essential zlib1g-dev

$ mkdir ~/kernel
$ cd ~/kernel

$ wget http://www.kernel.org/pub/linux/kernel/v2.6/linux-2.6.33.5.tar.bz2
$ wget http://www.kernel.org/pub/linux/kernel/projects/rt/patch-2.6.33.5-rt23.bz2

$ tar xvjf linux-2.6.33.5.tar.bz2
$ ln -s linux-2.6.33.5 linux
$ cd linux
$ bzcat ../patch-2.6.33.5-rt23.bz2 | patch -p1

$ make oldconfig

$ export CONCURRENCY_LEVEL=2

$ make-kpkg clean
$ time fakeroot make-kpkg --initrd kernel_image kernel_headers

$ cd ..
$ su
$ dpkg -i linux-headers-*.deb linux-image-*.deb

$ cd /boot/
$ update-initramfs -c -k 2.6.33.5-rt23 

Ref.: http://is.gd/domBL

ç

Etiquetas: debian, lenny, kernel,

Ainda, e outra vez, a verdade

Depois de ter escrito 'A verdade, nada mais do que a verdade' fiquei sempre com a ideia de escrever a dita máquina como um conjunto de procedimentos em Lisp. Assim, aqui estão eles. O operador print

(defun P (s)
  s)

a negação

(defun neg (s)
  )

e a norma

(defun N (s)
  (list s s))

Vejamos alguns exemplos para ver como funcionam. O procedimento P retorna o seu input

> (P '(a b c d))
(a b c d)

e

> (N '(a b c d))
((a b c d) (a b c d))

o procedimento neg retorna sempre nil, a impossibilidade de se fazer qualquer coisa.

Como

> (neg (P (function N)))
 nil

a não printabilidade da norma de P, i.e., (neg (P (function N))), é expressa por

> (neg (P (N  (neg (P #'N)))))
nil

Etiquetas: Lisp, Goedel

Sobre a elegância de expressões escritas em LISP

A medida, de uma expressão simbólica em LISP é o número de caracteres utilizados para a escrever; representa-se por . Por exemplo, o tamanho da expressão (car '(a b)) é dado por

> (length "(car '(a b)))")

13

Vamos definir a complexidade de uma expressão , como o número de caracteres da expressão mais pequena que a tem como valor. Vamos denotar este número por . Assim, como,

> (quote a)

a

vem que

Dada uma expressão denote-se por a expressão mínima cujo valor é , i.e., o seu tamanho é a complexidade de , ou seja, .

Vamos dizer que uma expressão é elegante se é a expressão mais pequena que tem o seu valor. Assim o tamanho de uma expressão elegante é igual à complexidade do seu valor.

Alguns exemplos de expressões elegantes são: o átomo t ou, ainda, qualquer número, i.e., a expressão 2 tem valor 2. O átomo t, que é uma expressão, tem valor t, e logo H(t)=|t|=1. t é uma expressão elegante.

O proximo passo é traduzir a construção de Chaitin em Common Lisp.

Ref:

• http://www.umcs.maine.edu/~chaitin/unknowable/ch5.html
• http://en.wikipedia.org/wiki/Berry_paradox
• http://en.wikipedia.org/wiki/Richard%27s_paradox

Preciso de mais referências para continuar...

Etiquetas: LISP, Goedel, beleza

Números pseudo-aleatórios em LISP

Uma das formas de gerar números com uma distribuição uniforme num intervalo é usando o método de congruências lineares¹. Vejamos então como implementar um gerador de números pseudo-aleatórios que gera números inteiros entre 0 e m com uma distribuição uniforme .

A ideia é gerar uma sucessão de números com a forma onde² Ao valor de dá-se o nome de semente porque é o primeiro termo da sucessão e é usado como input para o termo seguinte. Note-se que para um mesmo obtém-se sempre o mesmo .

A sucessão de números assim obtida tem período e o intervalo de variação dos valores da sucessão pode ser ajustado ao intervalo através de

A maneira mais directa é escrever

(defun rand (a c m x)
  (mod (+ (* a x) c) m))

e obtém-se

> (rand 24298 99991 199017 0)

99991

Esta não é a maneira preferível de obter um número aleatório. Queremos obter um número simplesmente fazendo (rand), mas para isso, temos de ter uma maneira de guardar os sucessivos termos da sucessão de modo a que sirvam de sementes para os termos seguintes. Assim vamos definir a variável

(defvar *r-seed* 0)

que inicializa a sucessão de sementes (ou dos próprios números pseudo-aleatórios). Esta é uma variável global e por isso está enquadrada por *. Definimos um substituto para a função anterior como

(defun rand1 ()
  (let ((a 24298)
        (c 99991)
        (m 199017))
    (cond ((<= *r-seed*  199017)
           (setf *r-seed* (mod (+ (* a *r-seed*) c) m)))
          (t
           (setf *r-seed* 0)))))

onde agora os parâmetros a, c e m são locais e estão definidos dentro da função. Assim

> (rand1)

99991

A função rand1 é simples de perceber. Depois de inicializar as quantidades a, c e m verifica se *r-seed* é menor ou igual a 199017, se sim altera o valor de *r-seed* para o novo termo da sucessão através de

(setf *r-seed* (mod (+ (* a *r-seed*) c) m))

se não

(setf *r-seed* 0)

De modo a gerar números aleatórios entre define-se a função

(defun rand (&optional alpha beta)
  (let ((m 199017))
    (cond ((not (and alpha beta))
           (float (/ (rand1) m)))
          (t
           (+ (* (float (/ (rand1) m)) (- beta alpha)) alpha)))))

com dois argumentos opcionais alpha e beta; se não forem dados (rand) gera números com uma distribuição uniforme no intervalo :

> (rand)

0.55237997

> (rand 0 2)

1.1378727

Ref:

1. D. Knuth, TAOCP

2. Master Library da TI Programable 58/59

Etiquetas: LISP, números pseudo-aleatórios

Flores e palmeira

Ref: Script em Emacs Lisp para gerar fotografias com efeito Lomo

ç

Etiquetas: Lomo, lomografias, Emacs lisp

Fotografias com efeito Lomo

Tenho uma Lomo (uma LC-A) já há alguns 9 anos.

Fotografia original.	Transformação Lomo.
Fotografia original.	Transformação Lomo.
Fotografia original.	Transformação Lomo.

Gosto dos efeitos descontraídos que se obtêm quando se usam as regras

1. Take your camera everywhere you go
2. Use it any time – day and night
3. Lomography is not an interference in your life, but part of it
4. Try the shot from the hip
5. Approach the objects of your lomographic desire as close as possible
6. Don’t think (william firebrace)
7. Be fast
8. You don’t have to know beforehand what you captured on film
9. Afterwards either
10. Don't worry about any rules

mas tinha pena em não obter o mesmo efeito usando um máquina digital. Ora, para variar, a função em Emacs Lisp usando o ImageMagick que produz esse efeito é este

(defun lomo (source-dir img-file)
  (let ((img-file-lomo (concat source-dir "lomo-" img-file )))
    (shell-command 
     (format "cp %s %s"
             (concat source-dir img-file)
             (concat source-dir (concat "lomo-"img-file))))
    (shell-command 
     (format "convert -resize 1024x768 %s %s" 
           img-file-lomo img-file-lomo))
  (shell-command 
   (format "convert -unsharp 1 %s %s"
           img-file-lomo img-file-lomo))
  (shell-command 
   (format "cp %s %s" 
           img-file-lomo (concat img-file-lomo "-resized")))
  (shell-command 
   (format "convert -contrast -contrast %s %s"
           img-file-lomo  img-file-lomo))
  (shell-command 
    (format "convert -modulate 100,150 %s %s"
           img-file-lomo img-file-lomo))
  (shell-command 
   (format "composite -compose overlay %s %s %s"
           (concat source-dir "mask.png")
           img-file-lomo img-file-lomo))
  (shell-command 
   (format "composite -compose multiply %s-resized %s %s"
           img-file-lomo
           img-file-lomo
           img-file-lomo))
  (shell-command 
   (format "rm %s-resized" img-file-lomo))))

baseado neste.

Etiquetas: Lomo, Lisp, Emacs, ImageMagick

Bob Berg / Mike Stern Band - Chromazone

Etiquetas: Bob Berg, Mike Stern, Chromazone

Máquinas, mentes e Goedel

Gödel's theorem seems to me to prove that Mechanism is false, that is, that minds cannot be explained as machines. So also has it seemed to many other people: almost every mathematical logician I have put the matter to has confessed to similar thoughts, but has felt reluctant to commit himself definitely until he could see the whole argument set out, with all objections fully stated and properly met. This I attempt to do. - J. R. Lucas

Nota: Os sublinhados são meus.

Ref: Minds, Machines and Gödel, J. R. Lucas

Etiquetas: Goedel, J. R. Lucas

Placa ondulada

Exemplo de motivação, para a aula de hoje, para o cálculo de aproximações numéricas de integrais definidos.

A figura mostra o gráfico da função que modela uma placa ondulada obtida da deformação de uma placa de lado maior L.

Quer saber-se qual o comprimento L da placa original de modo a que a placa ondulada tenha as dimensões da figura. O valor de L pode ser obtido através do cálculo do integral

onde Ora acontece que este integral com esta escolha da função f é um integral elíptico que não pode ser expresso em termos de funções elementares (por funções elementares entendem-se as seguintes: polinómios, funções racionais, sin, cos, e^x, ln x, ...), a única forma de obter uma aproximação ao valor de L é usando um método numérico. Isso mesmo pode ser feito usando a instrução trapz em GNU/Octave

> x=linspace(0,6,10000);
  trapz(x,sqrt(1+9*cos(3*x).^2))
ans =  13.171

que calcula uma aproximação ao valor do integral dividindo o intervalo de integração, neste caso, em 10000 sub-intervalos e aproximando o valor de L através da soma das áreas dos trapézios formados com os extremos de cada sub-intervalo e as suas imagens.

A instrução seguinte mostra a convergência das sucessivas aproximações para o valor exacto onde a primeira coluna é o número de sub-intervalos considerados:

> for i=1:6; x=linspace(0,6,10^i);z(i)=trapz(x,sqrt(1+9*cos(3*x).^2));end;
> [10.^[1:6]' z']
ans =

                    10      13.4567198483149
                   100      13.1730277692198
                  1000      13.1711968984003
                 10000      13.1711789419263
                100000      13.1711787626897
               1000000      13.1711787608981

Etiquetas: Placa ondulada, matemática, GNU/Octave

Implementação do LISP de John McCarthy, de 1960

Hoje tive tempo para acabar a implementação do LISP de 1960 de John McCarthy (Recursive Functions of Symbolic Expressions and Their Computation by Machine, Part I, Communications of the ACM 3:4, April 1960, pp. 184-195) em LTK. O código está aqui.

Implementação do LISP de 1960 de John McCarthy em LTK. A imagem mostra uma das funções descrita no artigo.

Etiquetas: LISP, John McCarthy, original paper, LTK

Autómato celular 1D em LTK (act.)

Aqui fica a nova versão do mesmo.

Screenshot da janela de LTK da evolução da regra 30.

(defun ca-run-ltk()
  (labels ((make-square (l x y)
             (let ((xx (+ x l))
                   (yy (+ y l)))
               (list xx yy 
                     (+ xx l) yy
                     (+ xx l) (+ yy l)
                     xx (+ yy l)))))
  (with-ltk ()
    (wm-title *tk* "Cellular automata")
    (let* ((f (make-instance 'frame))
           (f-values (make-instance 'frame))
           (tag-rule (make-instance 'label :master f-values :text "CA-rule: "))
           (c (make-instance 'canvas 
                             :background :white
                             :width 1000
                             :height 500))
           (ca-rule (make-instance 'text 
                                  :master f-values
                                  :width 4
                                  :height 1
                                  :background :white))
           (ca-with (make-instance 'text 
                                   :master f-values
                                   :width 4
                                   :height 1
                                   :background :white))
           (ca-iter (make-instance 'text 
                                   :master f-values
                                   :width 4
                                   :height 1
                                   :background :white))
           (b-clear (make-instance 'button
                              :text "Clear"
                              :master f
                              :width 4
                              :height 1
                              :command (lambda () (clear c))))
           (b-run (make-instance 'button
                              :text "Run"
                              :master f
                              :width 4
                              :height 1
                              :command (lambda () 
                                         (let* ((board-dim 200)
                                                (nca-rule (parse-integer (text ca-rule)))
                                                (n-iter 96)
                                                (l 5)
                                                (all-lst (ca-run (make-board board-dim)
                                                                 (nth-ca-rule nca-rule)
                                                                 n-iter))
                                                (ny (length (car all-lst)))
                                                (nx (length all-lst))
                                        
                                                (squares
                                                 (do ((j 0 (+ j 1)))
                                                     ((= j nx))
                                                   (do ((i 0 (+ i 1)))
                                                       ((= i ny))
                                                     (cond ((= 1 (car (nthcdr i (car (nthcdr j all-lst)))))
                                                            (create-polygon c (make-square l (* i l) (* j l))))
                                                           (t
                                                            nil)))))))))))
      (pack c :side :top :expand nil)
      (pack f-values :side :left :expand nil :fill :none)      
      (pack tag-rule :side :left :expand t :fill :both)
      (pack ca-rule :side :left :expand t :fill :both)
      (pack f :side :right :expand t :fill :both)
      (pack b-run :side :right)
      (pack b-clear :side :right)))))

E o package:ca-ltk.lisp

Etiquetas: ltk, lisp, autómato celular 1D

Lisp machine

Está quase pronta....

Etiquetas: LISP, TLK, JMC

Autómato celular 1D em LTK

Depois de escrever esta entrada fiquei com a sensação de que o código precisava de uma representação mais apelativa para o resultado final em vez de uma lista cheia de zeros e uns (ver fim da página do link anterior).

Depois procurar uma maneira eficiente de fazer a coisa e porque as referências que encontrei eram todas em OpenGL, onde os manuais não são fáceis de digerir, resolvi implementar a representação gráfica em tk/tcl, nomeadamente em ltk — LTK - The Lisp Toolkit

Screenshot da janela de LTK da evolução da regra 30.

Ao contrário dos manuais do OpenGL em que se usa CL, o manual do LTK está muito bem escrito. Com o código e o LTK faz-se

(defun ca-show (all-lst l)
  (with-ltk ()
    (let* ((c (make-instance 'canvas :background :white))
           (lst (car all-lst))
           (ny (length (car all-lst)))
           (nx (length all-lst))
           (squares
            (do ((j 0 (+ j 1)))
                ((= j nx))
             (do ((i 0 (+ i 1)))
                 ((= i ny))
               (cond ((= 1 (car (nthcdr i (car (nthcdr j all-lst)))))
                      (create-polygon c (square l (* i l) (* j l))))
                     (t
                      nil)))))
           (line-x 
            (do ((i 1 (+ i 1)))
                ((= i  (+ 2 nx)))
              (create-line c (list l (* i l) (* l (+ 1 ny)) (* i l)))))
           (line-y
            (do ((j 1 (+ j 1)))
                ((= j (+ 2 ny)))
              (create-line c (list (* j l) l (* j l) (* l (+ 1 nx)))))))
      (pack c :expand nil :fill :both)
     )))


(defun square (l x y)
  (let ((xx (+ x l))
        (yy (+ y l)))
    (list xx yy 
          (+ xx l) yy
          (+ xx l) (+ yy l)
          xx (+ yy l))))

e com um simples (ca-show (ca-run xboard xrules 50) 5) obtém-se a figura inicial.

Etiquetas: ltk, lisp, autómato celular 1D

Autómato celular em 1D

Depois de implementar um autómato celular em 2D resolvi agora fazer o mesmo para um em 1D. A abordagem é diferente, mais no espírito deste texto.

Um autómato celular é definido por uma lista de células que tomam valores discretos, neste caso 0 ou 1,

(0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0)

e uma regra de evolução que especifica como se transformam os estados de cada célula de acordo com os estados das células vizinhas. Esta lista é construída com

(defun make-board (m)
  (concatenate 'list
               nil
               (zeros (floor (/ m 2.0))) 
               '(1)
               (zeros (floor (/ m 2.0)))))

Toma-se, neste exemplo, como vizinhos de uma dada célula as células imediatamente antes e depois dessa célula. As regras de evolução são definidas através da lista ((c1 c2 c3) new_state) ... (c1 c2 c3) new_state)). A regra 30 é dada por

(((0 0 0) 0) ((0 0 1) 1) ((0 1 0) 1) ((0 1 1) 1) ((1 0 0) 1) ((1 0 1) 0) ((1 1 0) 0) ((1 1 1) 0))

A especificação dos vizinhos determina o número de autómatos celulares com três vizinhos, i.e., 256. Logo cada regra de evolução é determinada pela representação em base 2 de um número entre 0 e 255. Isso é feito através de

(defun to-bin (x)
  (cond ((= 0 x)
         0)
        (t
         (let* ((q (floor (/ x 2.)))
                (r (- x (* 2 q))))
           (cond ((= q 0)
           '(1))
                 (t
                  (cons r (to-bin q))))))))

Claro que (to-bin 30) dá (0 1 1 1 1) e como temos 8 possibilidades de estados para três células precisamos de uma codificação em 8 bits, i.e., usando

(defun zeros (n)
  (cond ((= n 0) nil)
        (t
         (cons '0 (zeros (- n 1))))))

(defun length-to-bin (n x)
  (cond ((= n 0)
         0)
        (t
         (append (to-bin x) (zeros (- n (length (to-bin x))))))))

através de (length-to-bin 8 30) para dar (0 1 1 1 1 0 0 0). Não é difícil obter-se a representação em qualquer base b com

(defun dec-to-b (x b)
  (cond ((= x 0)
         0)
        (t
         (let* ((q (floor (/ x (* b 1.0))))
                (r (- x (* b q))))
           (cond ((= q 0)
                  1)
                 (t
                  (cons r (dec-to-b q b))))))))

Voltando então ao tópico principal.

Como a regra de evolução é dada na forma

(((0 0 0) 0) ((0 0 1) 1) ((0 1 0) 1) ((0 1 1) 1) ((1 0 0) 1) ((1 0 1) 0) ((1 1 0) 0) ((1 1 1) 0))

a maneira mais simples de a aplicar é converter o estado do autómato, por exemplo,

(0 0 1 0 0)

em

((0 0 1) (0 1 0) (1 0 0))

Ora isso é feito usando as seguintes funções

(defun nest-car (lst n)
  "?anti-cdr?"
  (cond (lst
         (let ((m (- n 1)))
           (cond ((= m 0)
                  (list (car lst)))
                 (t
                  (cons (car lst) (nest-car (cdr lst) (- n 1)))))))
        (t nil)))

(defun partition1 (lst n m)
  (cond ((<= m (length lst))
         (cond (lst
                (cons (nest-car lst n) (partition1 (nthcdr m lst) n m)))
               (t nil)))
        (t nil)))

(defun partition (lst n m)
  (mapcan #'(lambda (x) (and (= n (length x)) (list x)))
          (partition1 lst n m)))

que fazem a partição¹ de (0 0 1 0 0) em ((0 0 1) (0 1 0) (1 0 0)), i.e., em grupos de 3 com um off-set de 1, através de (partition '(0 0 1 0 0) 3 1).

Com tudo o que já definimos vejamos então como construir a regra a que corresponde um número n

(defun nth-ca-rule (n)
  (labels ((3-tuple (bin-n 3tuple)
             (cond (3tuple
                   (cons
                    (list  (car 3tuple) (car bin-n)) 
                    (3-tuple (cdr bin-n) (cdr 3tuple)))))))
    (let* ((bin-x (to-bin n))
           (bin-n  (length-to-bin 8 n)))
      (3-tuple bin-n '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))))))

Assim dado a lista de regras de evolução verifica-se se alguma é aplicável ao primeiro elemento da lista particionada ((0 0 1) (0 1 0) (1 0 0)), se sim aplica-se a regra correspondente, através de

(defun ca-apply-car (3tuple rules)
  (cond ((equal 3tuple (caar rules))
         (cadar rules))
        (t
         (ca-apply-car 3tuple (cdr rules)))))

e o mesmo para o resto da lista

(defun ca-apply (board rules)
  (let ((first-cell (list (car board)))
        (last-cell (list (car (reverse board)))))
    (concatenate 'list first-cell
          (mapcar #'(lambda (x) 
                      (ca-apply-car x rules)) (partition board 3 1))
          last-cell)))

Falta só, para acabar, construir um iterador, que produz os sucessivos passos por aplicação da regra de evolução

(defun ca-run (board rules n)
  (cond ((= n 0)
         nil)
        (t
         (cons board (ca-run (ca-apply board rules) rules (- n 1))))))

Vejamos então um exemplo completo

> (setq xboard (make-board 30))

(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)

> (setq xrules (nth-ca-rule 30))

(((0 0 0) 0) ((0 0 1) 1) ((0 1 0) 1) ((0 1 1) 1) ((1 0 0) 1) ((1 0 1) 0)
 ((1 1 0) 0) ((1 1 1) 0))

> (setq xpar-board (partition xboard 3 1))


((0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0)
 (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 1) (0 1 0) (1 0 0) (0 0 0) (0 0 0)
 (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0) (0 0 0)
 (0 0 0) (0 0 0))

e 15 iterações dão

> (ca-run xboard xrules 15)

((0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
 (0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
 (0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0)
 (0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0)
 (0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0)
 (0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0)
 (0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0)
 (0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0)
 (0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0)
 (0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0)
 (0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0)
 (0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 1 1 0 0 0 0)
 (0 0 0 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 0)
 (0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 1 0 1 1 1 0 0)
 (0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 0 1 0))

1. É semelhante ao comando com o mesmo nome do Mathematica.

Etiquetas: lisp, ca, autómato celular, 1d

The whole world of programming

Ver mais em LISP de JMC.

Etiquetas: Lisp, Alan Kay

Expressões no LISP de 1960

Já anteriormente tinha construído alguns exemplos de funções "meio esquisitas", que quando se têm como argumento dão-se como resultado. Vejamos então, usando o LISP de 1960 de John McCarthy (JMC), os mesmos exemplos:

1. Função identidade, (f f) dá f.

> (eval. '((label ident (lambda (x) x))
         y)
         '((y ident)))

ident

ou

> (eval. '((lambda (x) x) '((lambda (x) x))) '())

((lambda (x) x))

2. função diag definida por (label diag (lambda (x) (list x (list 'quote x))))

2.1 aplicada a 'list

> (eval. '(
          (label diag (lambda (x) (list x (list 'quote x))))
          y)
        '((y list)))

(list (quote list))

e

> (eval. 
    (eval. '(
          (label diag (lambda (x) (list x (list 'quote x))))
          y)
        '((y list))) '())

(list)

2.2 (diag 'diag)

> (eval. '((label diag (lambda (x) (list x (list 'quote x))))
         y)
       '((y diag)))

(diag (quote diag))

ou ainda

> (eval. (eval. '((label diag (lambda (x) (list x (list 'quote x))))
         diag) '()) '())

((label diag (lambda (x) (list x (list (quote quote) x)))) (quote (label diag (lambda (x) (list x (list (quote quote) x))))))

e, ainda ainda,

> (eval. (eval. '((lambda (x) (list x (list 'quote x)))
         '(lambda (x) (list x (list 'quote x)))) '()) '())

((lambda (x) (list x (list (quote quote) x))) (quote (lambda (x) (list x (list (quote quote) x)))))

E um exemplo extra do artigo original do JMC

> (eval. '((label ff (lambda (x)
                     (cond ((atom x) x)
                           ('t (ff (car x))))))
         y)
       '((y ((a b) (c d)))))

a

Etiquetas: LISP, John McCarthy

Profile Lisp programs with SLIME

Há sempre duas maneiras diferentes de fazer a mesma coisa, em particular, o cálculo da sucessão de Fibonacci pode ser feita: da maneira ingénua

(defun fib (n)
  (cond ((= n 0) 0)
        ((= n 1) 1)
        (t (+ (fib (- n 1))
              (fib (- n 2))))))

e da inteligente

(defun fib-lin (n)
  (labels ((fib-iter (a b count)
             (cond ((eq count 0)
                    b)
                   (t
                    (fib-iter (+ a b) a (- count 1))))))
  (fib-iter 1 0 n)))

Podemos calcular os 10 primeiros termos através de, e da maneira inteligente,

> (loop for i from 1 to 10 collect
      (list i (fib-lin i)))

((1 1) (2 1) (3 2) (4 3) (5 5) (6 8) (7 13) (8 21) (9 34) (10 55))

Vejamos então analisar o comportamento de fib e fib-lin usando o slime-profile. Não há dúvida que fib-lin é bastante mais eficiente, não se sente nenhum sobressalto,

> (fib-lin 300)

222232244629420445529739893461909967206666939096499764990979600

enquanto o mesmo não acontece para

> (fib 10)

55

A função fib-lin tem um crescecimento tipo n enquanto fib tem um crescimento do tipo (fib n). Usando o slime-profile-report dá:

                                               Cons
             %      %                          Per      Total     Total
Function    Time   Cons    Calls  Sec/Call     Call     Time      Cons
--------------------------------------------------------------------------
FIB-LIN:   53.79  100.00        1  0.003997    18144     0.004       18144
FIB:       46.21    0.00      177  0.000019        0     0.003           0
--------------------------------------------------------------------------

Note-se a diferença!

Já agora a sucessão de Lucas é dada por

(defun lucas-lin (n)
  (labels ((fib-iter (a b count)
             (cond ((eq count 0)
                    b)
                   (t
                    (fib-iter (+ a b) a (- count 1))))))
  (fib-iter 1 2 n)))

Claro que a primeira forma é a natural tendo em conta a definição dos números de Fibonacci no entanto a eficiência desse procedimento é catastrófica, isto porque, por exemplo para o cálculo de (fib 5) temos

                                        +---------------------- (fib 5) -----------------------------+
                                        |                                                            |
                      +-------------- (fib 4) -----------+                                 +------ (fib 3) -----+  
                      |                                  |                                 |                    |
            +------ (fib 3) -----+                +--- (fib 2) ---+                 +--- (fib 2) ---+         (fib 1)
            |                    |                |               |                 |               |
     +--- (fib 2) ---+         (fib 1)          (fib 1)         (fib 0)           (fib 1)         (fib 0)
     |               |
   (fib 1)         (fib 0)

e por isso temos de calcular (fib 2) 3 vezes. Na realidade o número de operações para o cálculo de (fib n) é da ordem de (fib n), para n suficientemente grande. Em vez de pensarmos, por agora, numa forma definida por recorrência para o calculo de (fib n) vejamos uma forma imperativa do algoritmo.

(defun fib-iter (n)
  (let ((a 1) (b 1) (c 1))
    (do ((i 2 (+ i 1)))
    ((> i n))
      (setq a b
            b c
            c (+ a b)))
    c))
 

Na forma anterior apenas uma soma éfectuada em cada iteração do ciclo do, e, assim, para valores grandes de n, o número de operações é da ordem de n.

Note-se que a expressão

(defun fib-lin (n)
  (labels ((fib-iter (a b count)
             (cond ((eq count 0)
                    b)
                   (t
                    (fib-iter (+ a b) a (- count 1))))))
  (fib-iter 1 0 n)))

faz isso mesmo mas usa uma função interna fib-iter com argumentos extra para contar, como faz o ciclo do, as operações efectuadas; e é uma forma bastante mais elucidativa que mostra como escrever um ciclo iterativo através de uma expressão definida por recorrência.

Etiquetas: Lisp, Fibonacci, SLIME, profile

Lisp de John McCarthy em CL

Interpretador do LISP de John McCarthy em Common Lisp. Tem como operadores primitivos quote, atom, eq, car, cdr, cons e cond.

(defun not. (x)
  (cond (x '())
        ('t 't)))

(defun null. (x)
  (eq x '()))

(defun and. (x y)
  (cond (x (cond (y't) ('t '())))
        ('t '())))

(defun pair. (x y)
  (cond ((and. (null. x) (null. y)) '())
        ((and. (not. (atom x)) (not. (atom y)))
         (cons (list (car x) (car y))
               (pair. (cdr x) (cdr y))))))

(defun append. (x y)
  (cond ((null. x) y)
        ('t (cons (car x) (append. (cdr x) y)))))

(defun assoc. (x y)
  (cond ((eq (caar y) x) (cadar y))
        ('t (assoc. x (cdr y)))))

(defun eval. (e a)
  (cond
    ((atom e) (assoc. e a))
    ((atom (car e))
     (cond
       ((eq (car e) 'quote) (cadr e))
       ((eq (car e) 'atom)  (atom   (eval. (cadr e) a)))
       ((eq (car e) 'eq)    (eq     (eval. (cadr e) a)
                                    (eval. (caddr e) a)))
       ((eq (car e) 'car)   (car    (eval. (cadr e) a)))
       ((eq (car e) 'cdr)   (cdr    (eval. (cadr e) a)))
       ((eq (car e) 'cons)  (cons   (eval. (cadr e) a)
                                    (eval. (caddr e) a)))
       ((eq (car e) 'cond)  (evcon. (cdr e) a))
       ('t (eval. (cons (assoc. (car e) a)
                         (cdr e))
                  a))))
   ((eq (caar e) 'label)
    (eval. (cons (caddar e) (cdr e))
           (cons (list (cadar e) (car e)) a)))
   ((eq (caar e) 'lambda)
    (eval. (caddar e)
           (append. (pair. (cadar e) (evlis. (cdr e) a))
                    a)))))

(defun evcon. (c a)
  (cond ((eval. (caar c) a)
         (eval. (cadar c) a))
        ('t (evcon. (cdr c) a))))

(defun evlis. (m a)
  (cond ((null. m) '())
        ('t (cons (eval. (car m) a)
            (evlis. (cdr m) a)))))

(defun apply. (f a)
  (eval. (cons f (appq. a)) '()))


(defun appq. (m)
  (cond ((null m) '())
        (t
         (cons (list 'quote (car m)) (appq. (cdr m))))))

As referências são:

• Recursive Functions of Symbolic Expressions and Their Computation by Machine, Part I, John McCarthy (artigo original)
• The Roots of Lisp, Paul Graham

Etiquetas: LISP, John McCarthy