share/sym/operations.lisp

   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