Abstração Funcional

Como já foi mencionado, um dos aspectos mais marcantes do paradigma funcional é a abstração através de procedimentos nas chamadas funções de alta ordem. Uma das grandes vantagens destas é que podem encapsular a estrutura de controle do fluxo de execução de forma genérica, reduzindo ao máximo a repetição de código.

A repetição instiga a abstração.

Potenciação Rápida

Por exemplo, ao procurar abstrair a otimização dos procedimentos de exponenciação inteira e da multiplicação egípcia, podemos destacar suas partes comuns. Ao fazê-lo, é possível imaginar que estamos calculando um tipo de "potência" para uma operação básica (onde a potenciação aditiva equivale à multiplicação e a potenciação multiplicativa equivale à exponenciação) em que acumulamos o resultado de consecutivas aplicações dessa operação entre uma base e o resultado acumulado até então. A otimização emerge de alguma propriedade da operação que permite torná-la "mais potente" através de alguma transformação em sua base.

(define (pow power operation basis neutral succession)
  (let iter ((b basis) (n power) (acc neutral))
    (cond ((= n 0) acc)
          ((even? n) (iter (succession b) (halve n) acc))
          (else (iter b (- n 1) (operation b acc))))))

;; PS:
(define (halve x) (ash x -1))
(define (double x) (ash x 1))
(define (square x) (* x x))
(define (maybe-car lst alt)
  (if (null? lst) alt
      (car lst)))

O procedimento pow recebe todos os parâmetros necessários para computar a potência, inclusive outros procedimentos que são chamados durante a sua execução. Entretanto, seria interessante encapsular algumas dessas informações em uma dada operação potencializada, que por conta própria efetuaria a computação para qualquer base e expoente desejados. Essa tarefa pode ser cumprida por um closure - um tipo de procedimento que "se lembra" do escopo onde foi definido. Segue abaixo o exemplo de uma função que utiliza pow mas não calcula nada e apenas retorna um closure contendo a operação potencializada.

(define (empower operation neutral . opts-succ)
  (let ((succession (maybe-car opts-succ (lambda (x) (operation x x)))))
    (lambda (basis power)
      (pow power operation basis neutral succession))))

(define times (empower + 0))

(define (mul b n)
  (if (< n 0)
      (times (- b) (- n))
      (times b n)))

(define (^ b n)
  (let ((raise (empower * 1)))
    (if (< n 0)
        (raise (/ 1 b) (- n))
        (raise b n))))

(define (fibonacci n)
  (let ((fn (cadr (pow ;; n-esima potencia
                       (abs n)
                       ;; da transformacao
                       (lambda (coefs fibs)
                         (let ((p (car coefs)) (q (cadr coefs))
                               (a (car fibs)) (b (cadr fibs)))
                           (list (+ (* b q) (* a (+ q p)))
                                 (+ (* b p) (* a q)))))
                       ;; a partir de uma base
                       '(0 1)
                       ;; acumulada sobre
                       '(1 0)
                       ;; onde a quadratura da base que
                       ;; regula a potencia da operacao eh
                       (lambda (coefs)
                         (let ((p (car coefs)) (q (cadr coefs)))
                           (list (+ (square q) (square p))
                                 (+ (square q) (* 2 (* p q))))))))))
    ;; "negafibonacci"
    (if (and (< n 0)
             (even? n))
        (- fn)
        fn)))

;; fibonacci matricial
(define (fibona n) ;; n > 0
  (define (mul-matrix-2x2 A B)
    (let ((a11 (caar A)) (a12 (cadar A))
          (a21 (caadr A)) (a22 (cadadr A))
          (b11 (caar B)) (b12 (cadar B))
          (b21 (caadr B)) (b22 (cadadr B)))
      (list (list (+ (* a11 b11) (* a12 b21))
                  (+ (* a11 b12) (* a12 b22)))
            (list (+ (* a21 b11) (* a22 b21))
                  (+ (* a21 b12) (* a22 b22))))))
  (let ((nth-transform (empower mul-matrix-2x2
                                '((1 0)
                                  (0 1)))))
    (caar
      (nth-transform '((1 1)
                       (1 0))
                     (- n 1)))))

;; forma fechada
(define phi (/ (+ 1 (sqrt 5)) 2)) ;; numero de ouro
(define fi (- 1 phi)) ;; complemento de phi
(define (fibonac n)
  (round (/ (- (^ phi n) (^ fi n))
            (sqrt 5))))

Compare o tempo de execução de fibo com fibonacci ou fibona para calcular o milionésimo (n = 1000000) número da sequência. Depois, faça o mesmo para fibonac.

Pontos Fixos

Vejamos agora um procedimento que não define um algoritmo para computar um valor, mas sim um método numérico para aproximar a raíz quadrada de um número:

;; metodo babilonico
(define (sqrt x)
  (define (try guess)
    (if (good-enough? guess) guess
        (try (improve guess))))

  (define (improve guess)
    (average guess (/ x guess)))

  (define (good-enough? guess)
    (< (abs (- (square guess) x)) tolerance))

  (try 1.0))

;; PS:
(define tolerance 1e-15)
(define (average a b) (/ (+ a b) 2))
(define (square x) (* x x))

Com um procedimento semelhante é possível aproximar uma solução da equação transcedental \( cos(x) = x \).

(define (fixcos)
  (define (retry old new)
    (if (approx? new old) new
        (retry new (cos new))))

  (define (approx? a b)
    (< (abs (- a b)) tolerance))

  (retry 0.0 (cos 0.0)))

(define x (fixcos)) ;; solucao

Um método "manual" para achar esse valor envolve uma calculadora científica e a seguinte sequência de botões:

[1] [=] [COS] [ANS] [=] [=] [=] ...

Tendo isso em mente, tente implementar um procedimento (fixpoint f x) que generalize ambos os métodos apresentados.

Nota-se uma ideia em comum: procuramos um ponto fixo ou ponto invariante k de uma função f(x) tal que \( f(k) = k \). Assim, supondo um valor intermediário c onde \( f(c) \approx k \), temos que \( f(f(...f(c)...)) = f^n(f(c)) = f^n(k) = k \), onde aplicamos f até que não haja mais variação (com uma certa tolerância) no resultado.

(define (fixpoint f x . opts-tol)
  (let* ((tolerance (maybe-car opts-tol 1e-9))
         (approx? (lambda (a b) (< (abs (- a b)) tolerance))))
    (let try ((old x) (new (f x)))
      (if (approx? old new) new
          (try new (f new))))))

(fixpoint cos 0)

(define (phi-rat tol)
  (fixpoint
    (lambda (rat)
      (let ((fcurr (numerator rat))
            (fprev (denominator rat)))
        (/ (+ fcurr fprev) fcurr)))
    1/1
    tol))
(define phi (exact->inexact (phi-rat 1e-15))) ;; => 102334155/63245986 = fib(40)/fib(39)

(define (average-damp f)
  (lambda (x) (average (f x) x)))

(define (sqrt x)
  (fixpoint (average-damp (lambda (y) (/ x y))) 1.0))

(define (root f x . opts-tol) ;; metodo de Newton
  (let* ((dx (maybe-car opts-tol 1e-8))
         (df (deriv f dx)))
    (fixpoint (lambda (x) (- x (/ (f x) (df x)))) x dx)))

(define (deriv f dx)
  (lambda (x) (/ (- (f (+ x dx)) (f x)) dx)))

(define (sqrt x)
  (root (lambda (y) (- x (square y))) 1.0))

(define pi (root sin 3))

(define phi (root (lambda (x) (+ (square x) (- x) -1)) 1.0 1e-11))

O Cálculo Lambda de Alonzo Church generaliza a noção de ponto fixo para funções, possibilitando a computação de procedimentos recursivos. Vejamos um exemplo partindo do algoritmo fatorial:

(define (fac n)
  (define f fac)
  (if (= n 0) 1 (* n (f (- n 1)))))

(define (facto n)
  (define f facto)
  (define (aux n)
    (if (= n 0) 1 (* n (f (- n 1)))))
  (aux n))

(define (factor n)
  (define (aux f n)
    (if (= n 0) 1 (* n (f (- n 1)))))
  (aux factor n))

(define (factori n)
  (define (aux f)
    (lambda (n)
      (if (= n 0) 1 (* n (f (- n 1))))))
  ((aux factori) n))

(define (factoria n)
  (define (aux f)
    (lambda (n)
      (if (= n 0) 1 (* n (f (- n 1))))))
  (define (rec f)
    (lambda (n)
      ((aux (f f)) n)))
  (let ((fact (rec rec)))
    (fact n)))

Perceba que a estrutura e o uso do procedimento rec podem ser facilmente generalizados na função de alta ordem ilustrada abaixo. Esse procedimento também é conhecido como Operador Y.

(define (fix f)
  (define (g x)
    (lambda (arg)
      ((f (x x)) arg)))
  (g g))

(define fact
  (fix (lambda (f)
         (lambda (n)
           (if (= n 0) 1 (* n (f (- n 1))))))))

Imagine o processo como uma iteração sobre uma função f que inicialmente não sabe calcular fatoriais: a cada passo f é substituída por uma versão melhorada dela mesma [1]. Podemos representar o estado atual de f como um conjunto de duplas (x,y), onde f associa uma entrada x à saída y.

Fe(x) = {}
F0(x) = { (0,1) }
F1(x) = { (0,1), (1,1) }
F2(x) = { (0,1), (1,1), (2,2) }
F3(x) = { (0,1), (1,1), (2,2), (3,6) }
F4(x) = { (0,1), (1,1), (2,2), (3,6), (4,24) }
F5(x) = { (0,1), (1,1), (2,2), (3,6), (4,24), (5,120) }
...
Fn(x) = fact(x), para x <= n

Na prática, basta aplicar o modelo de substituição para computar a função recursivamente:

(define curryed-fac
  (lambda (f)
    (lambda (n) (if (= n 0) 1 (* n (f (- n 1)))))))
...
(define fact (fix curryed-fac))
;; substituindo fix(f=curryed-fac)
(define fact
  (define (g x)
    (lambda (arg) ((curryed-fac (x x)) arg)))
  (g g))
;; substituindo g(x=g)
(define fact
  (lambda (arg) ((curryed-fac (g g)) arg)))
...
(fact 5)
;; substituindo fact(arg=5)
((curryed-fact (g g)) 5)
;; substituindo g(x=g)
((curryed-fact (lambda (arg) ((curryed-fac (g g)) arg))) 5)
;; perceba que o lambda eh exatamente a definicao de fact
((curryed-fact fact) 5)
;; substituindo curryed-fact(f=fact)
((lambda (n) (if (= n 0) 1 (* n (fact (- n 1))))) 5)
;; substituindo lambda(n=5)
(* 5 (fact 4))
...