share/sym/lecteur.lisp

   1 ;; Fichier lecteur.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 (in-package :maxima)
  21 (macsyma-module lecteur)
  22
  23 (progn (defvar d) (defvar lvar))
  24 ;---------------------------------------------------------------------------
  25 ;               LE LECTEUR DANS  k[y1, ... ,yn][x1, ... ,xp]
  26 ;                rendant la forme distribuee du polynome pol
  27 ; constante = [constante, 0, ...,0] avec p exposants nuls
  28 ;---------------------------------------------------------------------------
  29 (defun $distri_lect ($pol $lvar)
  30    (if (meval (list '($is) (list '(mequal) $pol 0))) (cons '(mlist)  nil)
  31   (cons '(mlist)
  32         (mapcar #'(lambda (mon) (cons '(mlist) mon))
  33                 (distri_lect $pol (cdr $lvar))))))
  34
  35 ; lvar =(x1 x2 .... xp) les yi inconnus
  36 ; on prend uniquement le cdr pour trier car le car est le coefficient
  37 ; on ordonne dans l'ordre lexicographique decroissant.
  38
  39 (defun distri_lect ($pol lvar)
  40   (somme_coef
  41       (sort (exposants ($expand $pol) lvar) #'lex_mon :key #'cdr)))
  42
  43 (defun somme_coef (pol_dist)
  44   (and pol_dist
  45        (somme_coef2 (caar pol_dist) ; le coefficient initial
  46                     (cdar pol_dist) ; le monome initial
  47                     pol_dist))
  48        pol_dist)
  49
  50 (defun somme_coef2 (c m pol_dist)
  51   (cond
  52     ((null (cdr pol_dist)) (rplaca (car pol_dist) c))
  53     (t (let ((c2 (caar (cdr pol_dist))) (m2 (cdar (cdr pol_dist))))
  54          (cond
  55            ((equal m m2)
  56             (somme_coef2 ($add_sym c c2) m
  57                 (rplacd pol_dist (cddr pol_dist))))
  58            (t (rplaca (car pol_dist) c)
  59               (somme_coef2 c2 m2 (cdr pol_dist))))))))
  60
  61 (defun exposants (pol lvar)
  62   (if (and (listp pol) (equal 'mplus (caar pol)))
  63       (mapcar 'expomon (cdr pol)) (list (expomon pol))))
  64 ;---------------------------------------------------------------------------
  65 ; lecture d'un mono^me :
  66 ; Soit un mono^me dans k[x1,...,xn] ou` k est e'ventuellement un anneau
  67 ; de polyno^mes sur un corps. On construit une plist 'var_coe :
  68 ; si c'est un e'le'ment du corps on le met a l'indicateur : coe
  69 ; si c'est un variable on met l'exposant avec comme indicateur la variable.
  70 ; Ensuite cre'e' la liste des valeurs lie'es aux variables xi dans la pliste
  71 ; et on fait le produit des autres valeurs de cette plist.
  72 ; Si on a une constante C sur k on la represente par [C,0,0,...,0] (n ze'ros).
  73 ;----------------------------------------------------------------------------
  74 (defun expomon (mon)
  75   (cond
  76     ((numberp mon)                     ; on a une cste de k uniquement
  77      (and (not (zerop mon)) (cons mon (make-list (length lvar)
  78                                                  :initial-element 0))))
  79     (t
  80      (cond
  81        ((and (listp mon) (equal 'mtimes (caar mon)))
  82         (cond
  83           ((not (or (and (listp (cadr mon))
  84                          (equal 'mexpt (caar (cadr mon))))
  85                     (member (cadr mon) lvar :test #'equal)))
  86            ;; le coefficient, eventuellement rationnel, est different de 1
  87            (mapc 'lvarexpo (cddr mon))
  88            (setf (get 'var_expo 'coe) (cadr mon)))
  89           (t
  90            ;; le coefficient est e'gal a 1
  91            (mapc 'lvarexpo (cdr mon))
  92            (setf (get 'var_expo 'coe) 1))))
  93        ;; on a ((mexpt) x 4) ou x:
  94        (t (lvarexpo mon) (setf (get 'var_expo 'coe) 1)))
  95      ;; maintenant toutes les donnees sont dans la plist
  96      ;; reste a bien recoller les morceaux
  97      (let ((ncoe (cadr (flet ((franz.remprop
  98                                   (sym indic &aux
  99                                        (result
 100                                         (third
 101                                          (multiple-value-list
 102                                           (get-properties
 103                                            (symbol-plist sym)
 104                                            (list indic))))))
 105                                 "equivalent to Franz Lisp 'remprop'."
 106                                 (remprop sym indic) result))
 107                          (franz.remprop 'var_expo 'coe))))
 108            (exposant (expomon2 lvar)))
 109        ;; on n'a retire que les exposants des xi et le coefficient
 110        ;; numerique de la plist, reste les yi et leur exposants
 111        ;; a remettre en coefficients.
 112        (cons (recupcoef (symbol-plist 'var_expo) ncoe) exposant)))))
 113
 114 (defun recupcoef (plist coef)
 115   (if (null plist) coef
 116       (let ((yi (car plist)))
 117         (recupcoef (cddr plist)
 118             ($mult_sym
 119                 ($exp_sym yi
 120                     (cadr (flet ((franz.remprop
 121                                     (sym indic &aux
 122                                      (result
 123                                       (third
 124                                        (multiple-value-list
 125                                         (get-properties
 126                                          (symbol-plist sym) (list indic))))))
 127                                     "equivalent to Franz Lisp 'remprop'."
 128                                     (remprop sym indic) result))
 129                            (franz.remprop 'var_expo yi))))
 130                 coef)))))
 131
 132 ; Representation MACSYMA, mmon, de x**i :
 133 ;  x            si i=1
 134 ; ((mexpt) x i) sinon
 135 ; on veut recuperer (x i) et mettre la valeur i pour l'indicateur x
 136 ; dans la plist var_expo.
 137
 138 (defun lvarexpo (mmon)
 139   (if (atom mmon) (setf (get 'var_expo mmon) 1)
 140       (setf (get 'var_expo (cadr mmon)) (caddr mmon))))
 141 ; recuperation de la liste des exposants associee aux variables de lvar :
 142
 143 (defun expomon2 (lvar)
 144   (mapcar #'(lambda (var)
 145              (chercheexpo
 146                 (cdr (flet ((franz.remprop
 147                             (sym indic &aux
 148                                  (result (third
 149                                           (multiple-value-list
 150                                            (get-properties
 151                                             (symbol-plist sym)
 152                                             (list indic))))))
 153                             "equivalent to Franz Lisp 'remprop'."
 154                             (remprop sym indic) result))
 155                    (franz.remprop 'var_expo var)))))
 156           lvar))
 157
 158 (defun chercheexpo (expo) (if (null expo) 0 (car expo)))
 159 ; en lelisp il faudrait prendre expo