0's e 1's Stern-Brocot

... outra implementação

Depois da a implementação da árvore de Stern-Brocot em LISP, uma conversa com um colega revelou outra forma de a construir. A saber, usar símbolos. A sugestão incluía usar L e R e uma ordenação lexicográfica: L<R, mas 0's e 1's servem perfeitamente para o efeito. Construir qualquer coisa do género

0: (0,1)
1: (0,01,1)
2: (0,010,01,011,1)
...

onde o nível (k+1) obtém-se intercalando, entre cada duas sequências de (k), a concatenação das mesmas, começando pela maior com 0 inicial.

A ideia é a mesma da implementação anterior. Começa-se pela construção do mediante

(defun mediant (lst1 lst2)
  (cond ((and (= 0 (car lst2))
              (> (length lst2) (length lst1)))
         (append lst2 lst1))
        (t
         (append lst1 lst2))))

;; Example
> (mediant '(0) '(1))
(0 1)

Depois,

(defun mediant-list (01-lst)
  (cond ((cadr 01-lst)
         (append (list (car 01-lst)
                       (mediant (car 01-lst) (cadr 01-lst)))
                 (mediant-list (cdr 01-lst))))
        (t
         01-lst)))

;; Example
> (mediant-list '((0) (1)))
((0) (0 1) (1))
> (mediant-list '((0) (0 1) (1)))
((0) (0 1 0) (0 1) (0 1 1) (1))

ou mais completamente

> (mediant-list
 (mediant-list
  (mediant-list '((0) (1)))))
((0) (0 1 0 0) (0 1 0) (0 1 0 0 1) (0 1) (0 1 1 0 1) (0 1 1) (0 1 1 1) (1))

E finalmente

(defun stern-brocot (01-list n)
  (nest #'mediant-list 01-list n))

;; Example
> (stern-brocot '((0) (1)) 5)
((0) (0 1 0 0 0 0) (0 1 0 0 0) (0 1 0 0 0 0 1 0 0) (0 1 0 0)
 (0 1 0 0 0 1 0 0 1 0 0) (0 1 0 0 0 1 0) (0 1 0 0 0 1 0 0 1 0) (0 1 0)
 (0 1 0 0 1 0 1 0 0 1 0) (0 1 0 0 1 0 1 0) (0 1 0 0 1 0 1 0 0 1 0 0 1)
 (0 1 0 0 1) (0 1 0 0 1 0 1 0 1 0 0 1) (0 1 0 0 1 0 1) (0 1 0 0 1 0 1 0 1)
 (0 1) (0 1 1 0 1 0 1 0 1) (0 1 1 0 1 0 1) (0 1 1 0 1 0 1 0 1 1 0 1)
 (0 1 1 0 1) (0 1 1 0 1 0 1 1 0 1 1 0 1) (0 1 1 0 1 0 1 1)
 (0 1 1 0 1 0 1 1 0 1 1) (0 1 1) (0 1 1 1 0 1 1 0 1 1) (0 1 1 1 0 1 1)
 (0 1 1 1 0 1 1 0 1 1 1) (0 1 1 1) (0 1 1 1 1 0 1 1 1) (0 1 1 1 1)
 (0 1 1 1 1 1) (1))

usando para a composição

(defun nest (function arg n)
  (cond ((= n 0)
         arg)
        (t
         (nest function (funcall function arg) (- n 1)))))

Claro que posso sempre voltar aos racionais ;)

(defun back-to-rationals (01-lst)
  (mapcar (lambda (x)(/ (sum x)
                        (length x))) 01-lst))

;; Example
(back-to-rationals (stern-brocot '((0) (1)) 5))
(0 1/6 1/5 2/9 1/4 3/11 2/7 3/10 1/3 4/11 3/8 5/13 2/5 5/12 3/7 4/9 1/2 5/9 4/7
 7/12 3/5 8/13 5/8 7/11 2/3 7/10 5/7 8/11 3/4 7/9 4/5 5/6 1)

usando a função auxiliar

(defun sum (lst)
  (cond (lst
         (+ (car lst)
            (sum (cdr lst))))
        (t
         0)))

;; ore using reduce

(defun sum(lst)
  (reduce #'+ lst))

Palavras chave/keywords: Stern-Brocot, LISP, hack

Criado/Created: 27-01-2016 [09:18]

Última actualização/Last updated: 10-10-2022 [14:47]

Voltar à página inicial.