1; Fichier kak.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;;; SUR UN PROBLEME DE PIERRE CARTIER 21; Produit k a k ou sommes k a k des racines d'un polynome 22; Nous traitons ici le cas des resolvantes symetriques lorsque la fonction 23; resolvante est une somme ou un produit. 24;======================================================================== 25; INTERFACE 26 27(in-package :maxima) 28(macsyma-module kak) 29 30(mdefprop $somrac 31 ((lambda ()) ((mlist) $listei $k) 32 ((mprog) (($operation)) (($somrac_init) $listei $k))) 33 mexpr) 34(add2lnc '(($somrac) $listei $k) $functions) 35 36(mdefprop $prodrac 37 ((lambda ()) ((mlist) $listei $k) 38 ((mprog) (($operation)) (($prodkak) $listei $k))) 39 mexpr) 40(add2lnc '(($prodrac) $listei $k) $functions) 41 42 43; ON RAMENE LES FORME MONOMIALES DE MEME LONGUEUR AVEC LE VRAI 44; ORDRE DES LONGUEURS DECROISSANT 45;************************************************************************** 46; DECLARATIONS AU COMPILATEUR 47(progn 48 (defvar listpi) 49 (defvar listei) 50 (defvar k) 51 (defvar coe) 52 (defvar $somrac)) 53;$somrac_init 54; SOMME KAK EN PASSANT PAR LES FONCTIONS PUISSANCES 55; $p_rac 56;Tail merging being done: ($som_Pipj (|1-| i) ..........) 57; Tail merging being done: ($Pi2mon pui (|1-| var) ....) 58; SOMME KAK EN PASSANT PAR LES ELEMENTAIRES 59; $e_rac 60; CREATION DES PARTION DE LONGEUR ET DE POIDS DONNES 61; PRODUIT KAK 62; $prodkak 63; CALCUL D'UN COEFFICIENT BINOMIAL 64; ECRIVAIN 65;** FTOC. WARNING: 66; Franz Lisp declaration 'localf' is currently untranslated 67(progn) 68;********************************************************************** 69; SOMME K A K DES RACINES D'UN POLYNOME P 70 71(defun $somrac_init (listei k) 72 (cond 73 ((equal '$puissances $somrac) ($p_rac listei k)) 74 (t ($e_rac listei k)))) 75 76; DECOMPOSITION DES FORMES MONOMIALES CONSTITUANT 77; CHAQUE FONCTION PUISSANCE DU NOUVEL ALPHABET EN FONCTION DES FONCTIONS 78; PUISSANCE DES RACINES DE P 79;compatible avec (macsyma) et p_sym23 21 et 22. 80;consideration des constantes 81;de l=1 a bin(n,k) : 82; sl(anciennes racines)=fct(sigmai(anciennes racines); i=1 a n) 83; avec changement de base 84; Sl(nouvelles racines)=Fct(si(anciennes racines)) 85; SIGMAl(nouvelles racines)=FCT( Sl(nouvelles racines)) 86; plus rapide que som en temps mais pas en espace 87; listei=((mlist) e1 ... en) 88 89(defun $p_rac (listei k) 90 (setq listei (cdr listei)) 91 (let ((n (list-length listei))) 92 (cond 93 ((< n k) 94 " impossible ") 95 (t 96 (meval (list '($bidon2) )) 97 (let* ((binnk (binomial n k)) 98 (listpi (cdr (meval (list '($ele2pui) binnk 99 (cons '(mlist)(cons n listei)))))) 100 (listpi (cons binnk ($som_pipj n binnk nil)))) 101 ;; je n'ai pas besoin de faire meval ici puisque le fichier 102 ;; est forcement charge' 103 (pui2polynome '$y listpi)))))) 104; (listei (cdr (pui2ele binnk listpi '$girard)))) 105 ; ($fin (1- binnk) 106 ; -1 (list '(mexpt) '$y binnk) listei))))) 107;__________________________________________________________________________ 108; recherche des Fonctions puissances Pi en fonction des pj 109(defun $som_pipj (n i nxlistpi) 110 (if (eql 0 i) nxlistpi 111 ($som_pipj n 112 (1- i) 113 (cons ($p_reduit ($init_pi2mon n i (min k i))) 114 nxlistpi)))) 115;__________________________________________________________________________ 116;Recherche de l'expressiond'un Pi dans la base des formes monomiales sur S[A] 117;*** depart 118(defun $init_pi2mon (n i infki) 119 (if (eql i infki) 120 ($pi2mon n i infki nil 121 (binomial (- n i) 122 (- k i))) 123 ($pi2mon n i infki nil 1))) 124;*** recherche des fonctions monomiales en fonction de leur longueur, var, 125;On les range au fur et a mesure dans sym 126(defun $pi2mon (n pui var sym coe) 127 (if (eql 0 var) sym 128 ($pi2mon n pui 129 (1- var) 130 (nconc sym ($init_monlgfix pui var (cons nil nil))) 131 (div (* coe (- n (1- var))) (- k (1- var)))))) 132 133;*** recherche des formes monomiales de S[A], representant Pi (i=pui) 134; et ayant leur longueur egale a var. 135(defun $init_monlgfix (pui var slvarh) 136 ($monlgfix pui 137 (1- var) 138 (1- var) 139 slvarh (cons 1 nil) (maxote pui var)) 140 (mapl #'(lambda (ppart) 141 (rplaca ppart 142 (cons var 143 (cons ($mult_sym coe (caar ppart)) 144 (cdar ppart))))) 145 (cdr slvarh))) 146;************************************************************************* 147; PAR LES FONCTIONS SYMETRIQUES ELEMENTAIRES ei 148; DU POLYNOME DE DEPART 149;compatible avec e_sym26.l (macsyma) 150; consideration des constantes 151;de l=1 a bin(n,k) : 152; sl(anciennes racines)=fct(sigmai(anciennes racines); i=1 a n) 153; avec changement de base 154; Sl(nouvelles racines)=Fct(si(anciennes racines)) 155; SIGMAl(nouvelles racines)=FCT( Sl(nouvelles racines)) 156; plus rapide que som en temps mais pas en espace 157(progn) 158;listei=(e1,...,en)=((mlist) e1 ... en) 159(defun $e_rac (listei k) 160 (let ((n (1- (list-length listei)))) 161 (if (< n k) 162 " impossible " 163 (if (meval (list '($bidon))); permet de charger le fichier elem ou pas. 164 (let* ((binnk (binomial n k)) 165 (listei (cons n (cdr listei)))) 166 (pui2polynome '$y (cons binnk ($rac2 binnk nil n)))))))) 167 168;__________________________________________________________________________ 169; Recherche des Pi (i=1 a binnk) en fonction ds ej (j=1 a n) 170(defun $rac2 (l nxlistpi n) 171 (if (eql 0 l) nxlistpi 172 ($rac2 (1- l) 173 (cons ($init_piej l (min k l) n) nxlistpi ) 174 n))) 175;__________________________________________________________________________ 176; recherche d'un Pi dans la base des ej de S[A] 177;*** depart 178(defun $init_piej (l infkl n) 179 (if (eql l infkl) 180 ($piej l infkl 0 (binomial (- n l) (- k l)) n ) 181 ($piej l infkl 0 1 n))) 182;*** recherche par les monomiales de S[A], rentrant dans la decomposition 183; de Pi et ayant meme longueur. Que l'on decompose en fonction des ej et que 184; l'on range longueur apres longueur (longueur = var) dans Pi. 185; i=pui 186(defun $piej (pui var $pi coe n) 187 (if (eql 0 var) $pi 188 ($piej pui 189 (1- var) 190 ($add_sym $pi 191 ($mult_sym coe ($piej_lgfix pui var (cons nil nil) n))) 192 (div (* coe (- n (1- var))) (- k (1- var))) 193 n ))) 194 195;*** recherche des formes monomiales a longueur fixe var 196 197(defun $piej_lgfix (pui var slvarh n) 198 ($monlgfix pui 199 (1- var) 200 (1- var) 201 slvarh (cons 1 nil) (maxote pui var)) 202 ($reduit (min pui n) ; varm 203 (mapl #'(lambda (ppart) 204 (rplaca ppart (cons var (car ppart)))) 205 (cdr slvarh)))) 206;********************************************************************* 207; Calcul des formes monomiales et de leur coefficient intervenant dans Pi 208; a longueur fixe et donc aussi a poids i fixe. 209 210; la fonction maxote est commune a : treillis.lsp , resolvante.lsp, kak.lsp 211; voir dans util.lsp. Elle donne ici 212; le maximun que l'on peut retirer pour avoir p dans E(l,var)(croissance) 213 214 215 216;recherche proprement dite (non recursive terminale) 217(defun $monlgfix (pui rvar ote slvar poule maxote) 218 (cond 219 ((> 0 rvar) 220 (rplacd slvar (list (cons (car poule) (reverse (cdr poule)))))) 221 (t 222 ($monlgfix ote 223 (1- rvar) 224 (max (1- rvar) 225 (- (* 2 ote) 226 pui)) 227 slvar ($met pui ote poule) (maxote ote rvar)) 228 (and (< ote maxote) 229 ($monlgfix pui rvar 230 (1+ ote) 231 (last slvar) poule maxote))))) 232 233(defun $met (pui ote poule) 234 (let ((nxcoe ($mult_sym (car poule) (binomial pui ote))) 235 (nxpui (- pui ote))) 236 (if (eq (caddr poule) nxpui) 237 (list* nxcoe 238 (1+ (cadr poule)) 239 (cddr poule)) 240 (list* nxcoe 1 nxpui (cdr poule))))) 241;----------------------------------------------------------------------- 242;----------------------------------------------------------------------- 243; PRODUIT K A K 244; listei = ((mlist) e1 .en) 245; sans p0 246(defun $prodkak (listei k) 247 (setq listei (cdr listei)) 248 (let ((n (list-length listei))) 249 (cond 250 ((< n k) 251 " impossible ") 252 (t 253 (meval (list '($bidon2))) 254 (let* ((binnk (binomial n k)) 255 (listpi 256 (cdr (meval (list '($ele2pui) (mult binnk k) 257 (cons '(mlist) (cons n listei))))))) 258 (pui2polynome '$y 259 (cons binnk ($listpui binnk nil k)))))))) 260 261; liste des fonctions puissances dans l'alphabet des racines du polynome 262; cherche. 263(defun $listpui (i listpui k) 264 (if (eql 0 i) listpui 265 ($listpui 266 (1- i) 267 (cons ($p_reduit (list (list k 1 i k))) listpui) 268 k))) 269