Sobre a originalidade e o método da bissecção em Lisp

Sobre a originalidade, a publicação de livros e o método da bissecção em Lisp

Quando comecei a aprender Lisp também li o Structure and Interpretation of Computer Programs

Structure and Interpretation of Computer Programs
Structure and Interpretation of Computer Programs

Este livro é muito inspirador não śo para quem programa em Scheme, um dialecto de Lisp, mas também para qualquer outra linguagem de programação. E claro, de tão bom que é fácil aparecerem obras derivadas de qualidade inferior.

Um dos exemplos do livro Programação em scheme introdução à programação utilizando múltiplos paradigmas (PSIPUMP) de J. P. Martins e M. Cravo é o método da bissecção. Aí, pg. 128 1ª ed, é chamado de metodo-intervalo. Ora na sua forma mais simples pode ser implementado na forma

(defun bisection-1 (f a b &optional tol)
 (when (null tol)
   (setq tol 0.00001))
 (let*
     ((m (+ a (/ (- b a) 2.0))) ;; passar para função externa
      (fm (funcall f m))
      (fa (funcall f a)))
   (cond ((< (- b a) tol) m)   ;; passar para função externa
         (t
         (cond ((> (* fa fm) 0.0)
                (bisection-1 f m b tol))
               (t (bisection-1 f a m tol)))))))
Como se verá esta versão é a mais eficiente das quatro que vou construir. Como é fácil de ver o método depende da construção de sucessivos pontos médios do intervalo e de, em cada aproximação, de verificar se a aproximação obtida está já dentro da precisão que se quer. O ponto médio é calculado através de (m (+ a (/ (- b a) 2.0))) e a condição através de (< (- b a) tol). Qualquer uma destas operações pode ser definida à custa de duas funções externas tornando a implementação do método da bissecção mais modular. A saber, respectivamente,
(defun mean (a b)
  (+ a (/ (- b a) 2.0)))

(defun good-enough (a b eps)
  (cond ((< (abs (- b a)) eps)
         t)
        (t
         nil)))
O cálculo do ponto médio é feito de modo a evitar problemas de overflow, coisa que não acontece em PSIPUMP. Assim podemos escrever o método da bissecção na forma (versão 2)
(defun good-enough (a b eps)
  (cond ((< (abs (- b a)) eps)
         t)
        (t
         nil)))

(defun mean (a b)
  (+ a (/ (- b a) 2.0)))

(defun bisection-2 (f a b tol)
  (let* ((m (mean a b))
         (fm (funcall f m))
         (fa (funcall f a)))
    (cond ((good-enough a b tol)
           m)
          (t
           (cond ((> (* fa fm) 0.0)
                  (bisection-2 f m b tol))
                 (t (bisection-2 f a m tol)))))))
Outras das versões possíveis de construir é a de definir os procedimentos good-enough e mean como procedimentos locais dentro de bisection, o que dá:
(defun bisection-3 (f a b tol)
  (labels ((good-enough (a b eps)
             (cond ((< (abs (- b a)) eps)
                    t)
                   (t
                    nil)))
           (mean (a b)
             (+ a (/ (- b a) 2.0))))
    (let* ((m (mean a b))
           (fm (funcall f m))
           (fa (funcall f a)))
      (cond ((good-enough a b tol)
             m)
            (t
             (cond ((> (* fa fm) 0.0)
                    (bisection-3 f m b tol))
                   (t (bisection-3 f a m tol))))))))
mas perde-se parte da modularidade.

Outra ainda, evitar-se a azelhice (versão 4) confirmando em cada passo que a função tem valores de sinais contrários em cada extremo do intervalo.

(defun bisection-4 (f a b tol)
  (labels ((good-enough (a b eps)
             (cond ((< (abs (- b a)) eps)
                    t)
                   (t
                    nil)))
           (mean (a b)
             (+ a (/ (- b a) 2.0))))
    (let* ((m (mean a b))
           (fm (funcall f m))
           (fa (funcall f a))
           (fb (funcall f b))) ;; confirmação extra
      (when (< (* fa fb) 0.0)  ;; dos sinais de f em a e b
        (cond ((good-enough a b tol)
               m)
              (t
               (cond ((> (* fa fm) 0.0)
                      (bisection-4 f m b tol))
                     (t (bisection-4 f a m tol)))))))))
A pergunta que podemos fazer a seguir é a seguinte: qual das quatro variações é a mais eficiente, mais rápida, que consome menos recursos? Ora isto pode ser investigado usando o slime-profile1 e a função
(defun profile-bis (nmax)
  (dotimes (n nmax)
    (dolist
        (bisection '(bisection-1 bisection-2
                     bisection-3 bisection-4 bisection-5))
      (funcall bisection (lambda (x) (- 2 (* x x))) 1 2
               (expt 10 -6))))
  "Done...")
Os resultados são estes que falam por si (por ordem crescente de eficiencia):
                                                               Cons
                             %      %                          Per     Total     Total
Function                    Time   Cons    Calls  Sec/Call     Call    Time      Cons
-----------------------------------------------------------------------------------------
PROFILE-BIS::BISECTION-4:  32.64   50.00  1050000  0.000020    1128    20.593  1184400000
PROFILE-BIS::BISECTION-3:  30.22   50.00  1050000  0.000018    1128    19.069  1184400000
PROFILE-BIS::BISECTION-5:  14.32    0.00  1050000  0.000009       0     9.033           0
PROFILE-BIS::BISECTION-2:  12.40    0.00  1050000  0.000007       0     7.820           0
PROFILE-BIS::BISECTION-1:  10.42    0.00  1050000  0.000006       0     6.576           0
-----------------------------------------------------------------------------------------
TOTAL:                    100.00  100.00  5250000                      63.092  2368800000
Estimated monitoring overhead:  0.00 seconds
Estimated total monitoring overhead:  0.00 seconds
Já me esquecia a função bisection-5 é a função bisection-2 com a correcção da azelhice.
(defun bisection-5 (f a b tol)
  (let* ((m (mean a b))
         (fm (funcall f m))
         (fa (funcall f a))
         (fb (funcall f b)))
    (when (< (* fa fb) 0.0)
      (cond ((good-enough a b tol)
             m)
            (t
             (cond ((> (* fa fm) 0.0)
                    (bisection-5 f m b tol))
                   (t (bisection-5 f a m tol))))))))

Pacote com todas as funções

(defpackage :profile-bis
  (:use :cl)
  (:export #:profile-bis))

(in-package :profile-bis)

;;1

(defun bisection-1 (f a b tol)
  (let*
      ((m (+ a (/ (- b a) 2.0)))
       (fm (funcall f m))
       (fa (funcall f a)))
    (cond ((< (- b a) tol) m)
          (t
           (cond ((> (* fa fm) 0.0)
                  (bisection-1 f m b tol))
                 (t (bisection-1 f a m tol)))))))

;;2

(defun good-enough (a b eps)
  (cond ((< (abs (- b a)) eps)
         t)
        (t
         nil)))

(defun mean (a b)
  (+ a (/ (- b a) 2.0)))

(defun bisection-2 (f a b tol)
  (let* ((m (mean a b))
         (fm (funcall f m))
         (fa (funcall f a)))
    (cond ((good-enough a b tol)
           m)
          (t
           (cond ((> (* fa fm) 0.0)
                  (bisection-2 f m b tol))
                 (t (bisection-2 f a m tol)))))))

;;3

(defun bisection-3 (f a b tol)
  (labels ((good-enough (a b eps)
             (cond ((< (abs (- b a)) eps)
                    t)
                   (t
                    nil)))
           (mean (a b)
             (+ a (/ (- b a) 2.0))))
    (let* ((m (mean a b))
           (fm (funcall f m))
           (fa (funcall f a)))
      (cond ((good-enough a b tol)
             m)
            (t
             (cond ((> (* fa fm) 0.0)
                    (bisection-3 f m b tol))
                   (t (bisection-3 f a m tol))))))))

;;4

(defun bisection-4 (f a b tol)
  (labels ((good-enough (a b eps)
             (cond ((< (abs (- b a)) eps)
                    t)
                   (t
                    nil)))
           (mean (a b)
             (+ a (/ (- b a) 2.0))))
    (let* ((m (mean a b))
           (fm (funcall f m))
           (fa (funcall f a))
           (fb (funcall f b)))
      (when (< (* fa fb) 0.0)
        (cond ((good-enough a b tol)
               m)
              (t
               (cond ((> (* fa fm) 0.0)
                      (bisection-4 f m b tol))
                     (t (bisection-4 f a m tol)))))))))

;;5

(defun bisection-5 (f a b tol)
  (let* ((m (mean a b))
         (fm (funcall f m))
         (fa (funcall f a))
         (fb (funcall f b)))
    (when (< (* fa fb) 0.0)
      (cond ((good-enough a b tol)
             m)
            (t
             (cond ((> (* fa fm) 0.0)
                    (bisection-5 f m b tol))
                   (t (bisection-5 f a m tol))))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun profile-bis (nmax)
  (dotimes (n nmax)
    (dolist
        (bisection '(bisection-1 bisection-2
                     bisection-3 bisection-4
                     bisection-5))
      (funcall bisection (lambda (x) (- 2 (* x x))) 1 2
               (expt 10 -6))))
  "Done...")

(profile-bis 50000)

1. SLIME: The Superior Lisp Interaction Mode for Emacs

Palavras chave/keywords: lisp, scheme, slime, matemática, bissecção,

Criado/Created: NaN

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


Voltar à página inicial.


GNU/Emacs Creative Commons License

(c) Tiago Charters de Azevedo