share/sym/arite.lisp

   1 ;; Fichier arite.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 arite)
  22
  23
  24 ; cette fonction permet de passer d'une fonction puissance d'une
  25 ; resolvante en p variables
  26 ; a une fonction puissance en n variables gra^ce au the'ore`me de l'arite'
  27 ; il faut rajouter un coefficient binomial a chaque partition
  28 ; On suppose que les fonctions puissances sont DONNEES SUR LA BASE
  29 ; DES FORMES MONOMIALES DE MANIERE PARTITIONNEE DANS LA LISTE $puissances
  30
  31
  32 (mdefprop $arite
  33     ((lambda ()) ((mlist) $degre $arite $puissances)
  34      ((mprog) (($operation)) ((arite_init) $degre $arite $puissances)))
  35     mexpr)
  36 (add2lnc '(($arite) $degre $arite $puissances) $functions)
  37
  38 ; Ici le remplacement se re'alise physiquement
  39
  40 (mdefprop $arite_physique
  41     ((lambda ()) ((mlist) $degre $arite $puissances)
  42      ((mprog) (($operation)) ((arite_physique_init) $degre $arite $puissances)))
  43     mexpr)
  44 (add2lnc '(($arite_physique) $degre $arite $puissances) $functions)
  45
  46
  47 (defun arite_init (degre arite $puissances)
  48     (cons '(mlist)
  49           (mapcar #'(lambda ($pui)
  50                             (cons '(mlist)
  51                             (n_complete_pui degre arite $pui)))
  52                   (cdr $puissances))))
  53
  54
  55 (defun arite_physique_init (degre arite $puissances)
  56     (mapc #'(lambda ($pui) (complete_pui_physique degre arite $pui))
  57           (cdr $puissances))
  58      $puissances)
  59
  60 (defun complete_pui_physique (n p $puissance_resolvante)
  61    (mapc #'(lambda ($part)
  62         ; la longueur de la partition n'est pas en tete : (lg coeff . I)
  63              (let ((lg (longueur (cddr $part))))
  64                 (rplaca  (cdr $part)
  65                          (* (cadr $part)
  66                                   (binomial (- n lg)
  67                                             (- p lg))))))
  68           (cdr $puissance_resolvante)))
  69 ; Ceci seulement pour des coefficients non numeriques :
  70 ;                       ($mult_sym (car part)
  71  ;                                 (binomial (- n lg)
  72   ;                                          (- p lg))))))
  73
  74
  75
  76 ; il serait astucieux d'utiliser les rplaca. Pour cela il faut
  77 ; garder en memoire bin(n-lg,p-lg), et le retirer de $puif apres
  78 ; avoir evalue' en les fonction puissance. Ainsi on perdrait en temps
  79 ; mais on gagnerai toute la longueur de $puif en espace.
  80 ; attention, il existe une fonction complete_pui dans resolvante
  81
  82 (defun n_complete_pui (n p $puissance_resolvante)
  83      (mapcar #'(lambda ($part) ; part=(part)(1) comme representation
  84                        (let ((lg (longueur (cddr $part))))
  85                             (list* '(mlist)
  86                                    ($mult_sym (cadr $part)
  87                                               (binomial (- n lg)
  88                                                         (- p lg)))
  89                                    (cddr $part))))
  90                 (cdr $puissance_resolvante)))