1; Fichier operations.lsp 2 3; *************************************************************** 4; * MODULE SYM * 5; * MANIPULATIONS DE FONCTIONS SYMETRIQUES * 6; * (version01: Commonlisp pour Maxima) * 7; * * 8; * ---------------------- * 9; * Annick VALIBOUZE * 10; * GDR MEDICIS * 11; * (Mathe'matiques Effectives, De'veloppements Informatiques, * 12; * Calculs et Ingenierie, Syste`mes) * 13; * LITP (Equipe Calcul Formel) * 14; * Universite' Paris 6, * 15; * 4 place Jussieu, 75252 Paris cedex 05. * 16; * e-mail : avb@sysal.ibp.fr * 17; *************************************************************** 18 19;========================================================================= 20; OPERATIONS 21;========================================================================= 22 23(in-package :maxima) 24(macsyma-module operations) 25 26(progn (defvar $oper) (defvar prefixe)) 27; Aucune fonction n'est locale 28 29;_________________________________________________________________________ 30; Les operations avec rat 31(defun $ratmult (a b) (meval (list '($rat) (list '(mtimes) a b)))) 32(defun $ratadd (a b) (meval (list '($rat) (list '(mplus) a b)))) 33(defun $ratfmult (ll) 34 (meval (list '($rat) (cons '(mtimes) ll)))) 35 36(defun $ratfadd (l) 37 (meval (list '($rat) (cons '(mplus) l)))) 38(defun $ratdivi (a b) (meval (list '($rat) (list '(mquotient) a b)))) 39(defun $ratexp (x n) (meval (list '($rat) (list '(mexpt) x n)))) 40(defun $ratmoins (a) (meval (list '($rat) (list '(mminus) a)))) 41;_________________________________________________________________________ 42; Les operations pour expand 43(defun $expandmult (a b) 44 (meval (list '($expand) (list '(mtimes) a b)))) 45(defun $expandadd (a b) (meval (list '($expand) (list '(mplus) a b)))) 46 47(defun $expandfmult (ll) 48 (meval (list '($expand) (cons '(mtimes) ll)))) 49(defun $expandfadd (l) 50 (meval (list '($expand) (cons '(mplus) l)))) 51(defun $expanddivi (a b) 52 (meval (list '($expand) (list '(mquotient) a b)))) 53(defun $expandexp (x n) (meval (list '($expand) (list '(mexpt) x n)))) 54(defun $expandmoins (a) (meval (list '($expand) (list '(mminus) a)))) 55;_________________________________________________________________________ 56; Les operations avec ratsimp 57(defun $ratsimpmult (a b) 58 (meval (list '($ratsimp) (list '(mtimes) a b)))) 59(defun $ratsimpadd (a b) 60 (meval (list '($ratsimp) (list '(mplus) a b)))) 61(defun $ratsimpfmult (ll) 62 (meval (list '($ratsimp) (cons '(mtimes) ll)))) 63(defun $ratsimpfadd (l) 64 (meval (list '($ratsimp) (cons '(mplus) l)))) 65(defun $ratsimpdivi (a b) 66 (meval (list '($ratsimp) (list '(mquotient) a b)))) 67(defun $ratsimpexp (x n) 68 (meval (list '($ratsimp) (list '(mexpt) x n)))) 69(defun $ratsimpmoins (a) 70 (meval (list '($ratsimp) (list '(mminus) a)))) 71;_________________________________________________________________________ 72; Les operations avec meval 73(defun $mevalmoins (a) (meval (list '(mminus) a))) 74(defun $mevalmult (a b) (meval (list '(mtimes) a b))) 75(defun $mevaladd (a b) (meval (list '(mplus) a b))) 76(defun $mevalfmult (ll) 77 (meval (cons '(mtimes) ll))) 78(defun $mevalfadd (l) 79 (meval (cons '(mplus) l))) 80(defun $mevaldivi (x y) (meval (list '(mquotient) x y))) 81(defun $mevalexp (x n) (meval (list '(mexpt) x n))) 82;------------------------------------------------------------------------ 83; INITIALISATION 84(setq prefixe 'depart) 85;------------------------------------------------------------------------ 86; CETTE FONCTION PERMET DE CHANGER LE CORPS DES FONCTIONS DY TYPE 87; $operateur_sym 88; SELON LE CHOIX DU MODE OPERATOIR DEMANDE PAR L'UTILISATEUR 89;------------------------------------------------------------------------ 90; supposons que $oper = $rat 91; on met dans $moins $mult ... la lambda de $ratmoins $ratmult ... 92; creation de la liste ($ratmoins $ratmult ... $ratfmult) 93 94(defun $operation () 95 (cond 96 ((equal $oper prefixe)) 97 (t (mapc #'(lambda (corps nom_oper) 98 (setf (symbol-function nom_oper) corps)) 99 (mapcar #'(lambda (suffixe) 100 (symbol-function 101 (flet ((franz.concat (&rest args) 102 "equivalent to Franz Lisp 'concat'." 103 (values 104 (intern 105 (format nil "~{~A~}" args))))) 106 (franz.concat $oper suffixe)))) 107 '(moins mult add divi exp fadd fmult)) 108 '($moins_sym $mult_sym $add_sym $divi_sym $exp_sym 109 $fadd_sym $fmult_sym)) 110 (setq prefixe $oper)))) 111 112;------------------------------------------------------------------------ 113; LE PREMIER APPEL 114;; ($operation) 115 116