share/sym/ecrivain.lisp

   1 ; ecrivain.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 (in-package :maxima)
  20 (macsyma-module ecrivain)
  21
  22 (mdefprop $distri_ecrit
  23     ((lambda nil)
  24      ((mlist) $distribue $lvar)
  25      ((mprog) (($operation)) (($distri_ecrit_init) $distribue $lvar)))
  26     mexpr)
  27 (add2lnc '(($distri_ecrit) $distribue $lvar) $functions)
  28
  29 (defun $distri_ecrit_init ($distribue $lvar)
  30  (if (null (cdr $distribue)) 0
  31   (if (equal 'mlist (caar $distribue))
  32       ($ecrivain_sym (mapcar 'cdr (cdr $distribue)) (cdr $lvar))
  33       ($ecrivain_sym $distribue $lvar))))
  34
  35 (defun $ecrivain_sym (ppart lvar)
  36   (cond
  37     ((null ppart) 0)
  38     ((null (cdr ppart)) (ecrit_mon (cdar ppart) lvar (caar ppart)))
  39     (t ($fadd_sym
  40              (mapcar #'(lambda (tpart)
  41                          (ecrit_mon (cdr tpart) lvar (car tpart)))
  42                       ppart)))))
  43
  44 (defun ecrit_mon (part lvar coe)
  45   (cond
  46     ((null part) coe)
  47     (t ($mult_sym coe ($fmult_sym (mapcar '$exp_sym lvar part))))))