samedi, mars 17, 2007

Calcul symbolique en Scheme

Il y a quelques semaines, j'ai commencé à lire "Structure and Interpretation of Computer Program" (ci-après référé comme SICP) de Harold Habelson et Gerald Jay & Julie Sussman du MIT. Ça n'avance pas très vite car c'est extrêmement dense. Il faut du temps pour lire et relire et pour faire les exercices. Pour ce faire, j'ai installé Guile comme interpréteur Scheme sur ma station de travail principale. J'utilise Kate comme éditeur. C'est pas ce qu'il y a de mieux mais ça fait la job.
Lisant le chapitre 2 de SICP, la section 2.3.2 a vraiment capté mon attention (en tant que physicien de formation): Elle porte sur le calcul symbolique. Je n'avais jamais utilisé un langage qui permettait ceci sauf peut-être le langage interne de Mathematica (dont l'ancêtre a été écrit en Lisp dont Scheme est un dialecte). Pour m'assurer de bien comprendre, j'ai fait l'exercice 2.56. J'ai par la suite tenté de l'étendre pour faire la dérivation de la fonction sinus. Initialement j'avais écris:

    ;Definition for sine

(define (sine? x)
(and (pair? x) (eq? (car x) 'sin)))

(define (sine-argument angle) (car angle))

(define (make-sine angle)
(cond ((=number? angle 'pi) 0)
((=number? angle 0) 0)
(else (cons 'sin angle))))

(define (make-cosine angle)
(cond ((=number? angle 'pi ) 1)
((=number? angle 0) 1)
(else (cons 'cos angle))))


mais sine-argument retournait toujours (x) au lieu de x. Ce qui faisait planter deriv un peu plus loin. Après avoir fouillé pas mal, et lu et relu une obscure note de bas de page. J'ai trouvé le bobo: car retourne toujours un élément unique entouré de parenthèses. Pour retourné un élément unique sans parenthèses, il faut utiliser list-ref.
On aura:

(car '(a b)) -> (a)
(list-ref '(a b) 0) -> a


Une fois cette modification faite, on obtient la solution pour 2.56 plus le cas pour la fonction sinus:

(define (variable? x) (symbol? x))

(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))

(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a2)) (+ a1 a2))
(else (list '+ a1 a2))))

(define (=number? exp num)
(and (number? exp) (= exp num)))

(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list '* m1 m2))))

(define (sum? x)
(and (pair? x) (eq? (car x) '+)))

(define (addend s) (cadr s))

(define (augend s) (caddr s))

(define (product? x)
(and (pair? x) (eq? (car x) '*)))

(define (multiplier p) (cadr p))

(define (multiplicand p) (caddr p))

; definitions for exponentiation

(define (make-exponentiation base exponent)
(cond ((=number? exponent 0) 1)
((=number? exponent 1) base)
(else (list '** base exponent))))

(define (base exponentiation) (cadr exponentiation))

(define (exponent exponentiation) (caddr exponentiation))

(define (exponentiation? x)
(and (pair? x) (eq? (car x) '**)))

;definitions for sine

(define (sine? x)
(and (pair? x) (eq? (car x) 'sin)))

;Here, car doesn't work but list-ref works(define (sine-argument angle) (list-ref angle 1))


(define (make-sine angle)
(cond ((=number? angle 'pi) 0)
((=number? angle 0) 0)
(else (cons 'sin angle))))

(define (make-cosine angle)
(cond ((=number? angle 'pi ) 1)
((=number? angle 0) 1)
(else (cons 'cos angle))))

(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
((exponentiation? exp)
(make-product
(make-product (exponent exp)
(make-exponentiation (base exp)
(make-sum (exponent exp) -1)))
(deriv (base exp) var)))
((sine? exp)
make-product (deriv (sine-argument exp) var)
(make-cosine (sine-argument exp)) )
(else
(error "unknown expression type -- DERIV" exp))))



Je vais essayer d'étendre encore plus ce programme dès que j'en aurai le temps. À suivre...

Aucun commentaire: