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