Menu
▾
▴
[Maxima-commits] CVS: maxima/share/sym util.lisp,1.1.1.1,1.2 schur.lisp,1.1.1.1,1.2 resolv1.lisp,1.1.1.1,1.2 pui.lisp,1.1.1.1,1.2 permut.lisp,1.1.1.1,1.2 operations.lisp,1.1.1.1,1.2 multmon.lisp,1.1.1.1,1.2 lecteur.lisp,1.1.1.1,1.2 kak.lisp,1.1.1.1,1.2 elem.lisp,1.1.1.1,1.2 direct.lisp,1.1.1.1,1.2
|
From: Wolfgang J. <wje...@us...> - 2004-11-24 23:47:42
|
Update of /cvsroot/maxima/maxima/share/sym In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24533 Modified Files: util.lisp schur.lisp resolv1.lisp pui.lisp permut.lisp operations.lisp multmon.lisp lecteur.lisp kak.lisp elem.lisp direct.lisp Log Message: Trivial fixes, in particular: Rewrite IFs with more than one else-form; eliminate spurious closing parentheses. Index: util.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/util.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- util.lisp 8 May 2000 06:09:44 -0000 1.1.1.1 +++ util.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -67,10 +67,12 @@ (cond ((equal (tmon t1) (tmon t2)) (chcoeterm t1 ($add_sym (tcoe t1) (tcoe t2))) - (if (and (numberp (tcoe t1)) - (zerop (tcoe t1)) ) - (somme (cdr l1) (cdr l2) pr) - (somme2 (cdr l2) l1 pr) l1)) + (cond + ((and (numberp (tcoe t1)) + (zerop (tcoe t1))) + (somme (cdr l1) (cdr l2) pr)) + (t + (somme2 (cdr l2) l1 pr) l1))) ((funcall pr t1 t2) (somme2 l2 l1 pr) l1) (t (somme2 l1 l2 pr) l2)))))) @@ -138,7 +140,7 @@ (defun $degre (mon) (if (or (constantp mon) (null mon)) 0 (+ (* (car mon) (cadr mon)) - ($degre (cddr mon)))))) + ($degre (cddr mon))))) ;--------------------------------------------------------------------------- ; TESTE SI ON A AFFAIRE A UNE CONSTANTE APRES LE LECTEUR @@ -291,7 +293,7 @@ ((> e1 e2) (throw 'trouve t)) (t (throw 'trouve nil))))) - m1 m2))))) + m1 m2)))) ;*************************************************************************** ; INTERFACE @@ -598,15 +600,18 @@ (defun permut (l) (let ((i 0) (reponse nil) (relais nil)(a nil)) - (if (<= (list-length l) 1) - (list l) (setq relais (permut (cdr l)) a (car l)) - (do ((i i (1+ i))) - ((eql i (list-length l)) (un_de_chaque (vire_nil reponse))) - (setq reponse - (append reponse - (append (mapcar #'(lambda (z) + (cond + ((<= (list-length l) 1) + (list l)) + (t + (setq relais (permut (cdr l)) a (car l)) + (do ((i i (1+ i))) + ((eql i (list-length l)) (un_de_chaque (vire_nil reponse))) + (setq reponse + (append reponse + (append (mapcar #'(lambda (z) (insertion a z i)) - relais)))))))) + relais))))))))) ; ex : ( permut '(1 1 2 2 3 3)) donne la liste des 90 positions concerne'es Index: schur.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/schur.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- schur.lisp 8 May 2000 06:09:44 -0000 1.1.1.1 +++ schur.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -257,19 +257,21 @@ (defun good_tab0 (l lcont ltas) (let ((l1 nil) (rep nil) (relais nil)) - (if (eql 1 (list-length l)) - (mapcar 'list (good_line (car l) lcont ltas)) - (setq l1 (good_line (car l) lcont ltas)) - ;(print "tete des tableaux possibles " L1) - (do nil - ((null l1)) - (setq relais - (good_tab0 (cdr l) (car l1) (new_tas0 (car l1) ltas))) - ;(print " car L1 future tete "(car L1) " et relais "relais) - (if (not relais) (setq l1 (cdr l1)) - (setq rep (nconc rep (insert_tete (car l1) relais)) - l1 (cdr l1)))) - rep))) + (cond + ((eql 1 (list-length l)) + (mapcar 'list (good_line (car l) lcont ltas))) + (t + (setq l1 (good_line (car l) lcont ltas)) + ;; (print "tete des tableaux possibles " L1) + (do nil + ((null l1)) + (setq relais + (good_tab0 (cdr l) (car l1) (new_tas0 (car l1) ltas))) + ;; (print " car L1 future tete "(car L1) " et relais "relais) + (if (not relais) (setq l1 (cdr l1)) + (setq rep (nconc rep (insert_tete (car l1) relais)) + l1 (cdr l1)))) + rep)))) ;L liste de listes : retourne la meme liste ou les listes ont ete modifiees ; par insertion de i en tete @@ -293,27 +295,27 @@ (defun good_line0 (taille lcontrainte ltas) (let ((i 0) (lotas (list-length ltas)) (avanti nil) (rep nil)) ; (print "taille = "taille " Ltas" Ltas "GREP "rep) - (if (or (null lcontrainte) (zerop taille)) nil - (setq i (1+ (car lcontrainte))) - (do nil - ((< lotas i)) - (if (zerop (nth (1- i) ltas)) - (setq i (1+ i)) - (setq rep - (append rep - (insert_tete - i - (good_line0 (1- taille) - (cdr lcontrainte) - (append - (make-list (1- i) - :initial-element 0) - (list (1- (nth (1- i) ltas))) - (lastn ltas (- lotas i)) - )))) - i (1+ i) - avanti t))) - (if avanti rep nil)))) + (unless (or (null lcontrainte) (zerop taille)) + (setq i (1+ (car lcontrainte))) + (do nil + ((< lotas i)) + (if (zerop (nth (1- i) ltas)) + (setq i (1+ i)) + (setq rep + (append rep + (insert_tete + i + (good_line0 (1- taille) + (cdr lcontrainte) + (append + (make-list (1- i) + :initial-element 0) + (list (1- (nth (1- i) ltas))) + (lastn ltas (- lotas i)) + )))) + i (1+ i) + avanti t))) + (if avanti rep nil)))) (defun good_length (taille l) (if (null l) nil Index: resolv1.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/resolv1.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- resolv1.lisp 8 May 2000 06:09:44 -0000 1.1.1.1 +++ resolv1.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -58,7 +58,7 @@ (defun resolvante ($pol $var $fonction_resolvante $list_var) (cond ((equal '$cayley $resolvante) (print " resolvante de Cayley ") - (load "resolcayley.lsp") + ;; (load "resolcayley.lisp") (meval (list '($SUBSTITUTE) (cons '(mlist) (mapcar #'(lambda (val $ei) Index: pui.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/pui.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- pui.lisp 8 May 2000 06:09:44 -0000 1.1.1.1 +++ pui.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -251,9 +251,12 @@ (list (cons ($divi_sym ($mult_sym coef coe) m) partf))))) ; On va eventuellement modifier physiquement part (defun p_fact (part m) - (if (eql 1 m) (cddr part) - (rplaca (cdr part) (1- m)) - part)) + (cond + ((eql 1 m) + (cddr part)) + (t + (rplaca (cdr part) (1- m)) + part))) ;--------------------------------------------------------------------------- ; PRODUIT D'UNE FORME MONOMIALE parf PAR ; LA FONCTION PUISSANCE DE POIDS puim. Index: permut.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/permut.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- permut.lisp 8 May 2000 06:09:44 -0000 1.1.1.1 +++ permut.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -86,16 +86,19 @@ ;retourne la liste de toutes les permutations de L (voir ex plus bas ) (defun permut (l) (let ((i 0) (reponse nil) (relais nil)) - (if (<= (list-length l) 1) - (list l) (setq relais (permut (cdr l)) a (car l)) - (do ((i i - (1+ i))) - ((eql i (list-length l)) (un_de_chaque (vire_nil reponse))) - (setq reponse - (append reponse - (append (mapcar #'(lambda (z) + (cond + ((<= (list-length l) 1) + (list l)) + (t + (setq relais (permut (cdr l)) a (car l)) + (do ((i i + (1+ i))) + ((eql i (list-length l)) (un_de_chaque (vire_nil reponse))) + (setq reponse + (append reponse + (append (mapcar #'(lambda (z) (insertion a z i)) - relais)))))))) + relais))))))))) ; ex : ( permut '(1 1 2 2 3 3)) donne la liste des 90 positions concerne'es Index: operations.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/operations.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- operations.lisp 8 May 2000 06:09:43 -0000 1.1.1.1 +++ operations.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -31,7 +31,7 @@ (defun $ratmult (a b) (meval (list '($rat) (list '(mtimes) a b)))) (defun $ratadd (a b) (meval (list '($rat) (list '(mplus) a b)))) (defun $ratfmult (ll) - (meval (list '($rat) (cons '(mtimes) ll)))))) + (meval (list '($rat) (cons '(mtimes) ll)))) (defun $ratfadd (l) (meval (list '($rat) (cons '(mplus) l)))) @@ -47,7 +47,7 @@ (defun $expandfmult (ll) (meval (list '($expand) (cons '(mtimes) ll)))) (defun $expandfadd (l) - (meval (list '($expand) (cons '(mplus) l)))))) + (meval (list '($expand) (cons '(mplus) l)))) (defun $expanddivi (a b) (meval (list '($expand) (list '(mquotient) a b)))) (defun $expandexp (x n) (meval (list '($expand) (list '(mexpt) x n)))) @@ -76,7 +76,7 @@ (defun $mevalfmult (ll) (meval (cons '(mtimes) ll))) (defun $mevalfadd (l) - (meval (cons '(mplus) l))))) + (meval (cons '(mplus) l))) (defun $mevaldivi (x y) (meval (list '(mquotient) x y))) (defun $mevalexp (x n) (meval (list '(mexpt) x n))) ;------------------------------------------------------------------------ @@ -94,9 +94,9 @@ (defun $operation () (cond ((equal $oper prefixe)) - (t (mapc '(lambda (corps nom_oper) + (t (mapc #'(lambda (corps nom_oper) (setf (symbol-function nom_oper) corps)) - (mapcar '(lambda (suffixe) + (mapcar #'(lambda (suffixe) (symbol-function (flet ((franz.concat (&rest args) "equivalent to Franz Lisp 'concat'." @@ -111,5 +111,5 @@ ;------------------------------------------------------------------------ ; LE PREMIER APPEL -($operation) +;; ($operation) Index: multmon.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/multmon.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- multmon.lisp 8 May 2000 06:09:43 -0000 1.1.1.1 +++ multmon.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -165,23 +165,25 @@ ; si le cardinal le permet, on va pouvoir rajouter des zeros (defun parti_som (i j ri rk) - (if (null j) - (flet ((franz.attach (newelt oldlist) - "equivalent to Franz Lisp 'attach'." - (progn - (rplacd oldlist (cons (car oldlist) (cdr oldlist))) - (rplaca oldlist newelt)))) - (franz.attach - (somme_coe (nconc (reverse i) ri) - (append (make-list (list-length i) :initial-element 0) rk)) - terparts)) - (and (or (not ri) - (< (car i) (car ri)) - (not (< (car rk) (car j)))) - (parti_som (cdr i) (cdr j) (cons (car i) ri) - (cons (car j) rk))) - (and (not (< (list-length (cdr i)) (list-length j))) - (parti_som (cdr i) j (cons (car i) ri) (cons 0 rk))))) + (cond + ((null j) + (flet ((franz.attach (newelt oldlist) + "equivalent to Franz Lisp 'attach'." + (progn + (rplacd oldlist (cons (car oldlist) (cdr oldlist))) + (rplaca oldlist newelt)))) + (franz.attach + (somme_coe (nconc (reverse i) ri) + (append (make-list (list-length i) :initial-element 0) rk)) + terparts))) + (t + (and (or (not ri) + (< (car i) (car ri)) + (not (< (car rk) (car j)))) + (parti_som (cdr i) (cdr j) (cons (car i) ri) + (cons (car j) rk))) + (and (not (< (list-length (cdr i)) (list-length j))) + (parti_som (cdr i) j (cons (car i) ri) (cons 0 rk)))))) (defun somme_coe (i k) Index: lecteur.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/lecteur.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- lecteur.lisp 8 May 2000 06:09:43 -0000 1.1.1.1 +++ lecteur.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -72,26 +72,29 @@ ; Si on a une constante C sur k on la represente par [C,0,0,...,0] (n ze'ros). ;---------------------------------------------------------------------------- (defun expomon (mon) - (if (numberp mon) ; on a une cste de k uniquement - (and (not (zerop mon)) (cons mon (make-list (length lvar) - :initial-element 0))) - (cond - ((and (listp mon) (equal 'mtimes (caar mon))) - (if (not (or (and (listp (cadr mon)) - (equal 'mexpt (caar (cadr mon)))) - (member (cadr mon) lvar :test #'equal))) - ; le coefficient, eventuellement rationnel, est different de 1 - (progn - (mapc 'lvarexpo (cddr mon)) - (setf (get 'var_expo 'coe) (cadr mon))) - ; le coefficient est e'gal a 1 - (mapc 'lvarexpo (cdr mon)) - (setf (get 'var_expo 'coe) 1))) - ; on a ((mexpt) x 4) ou x: - (t (lvarexpo mon) (setf (get 'var_expo 'coe) 1))) -; maintenant toutes les donnees sont dans la plist -; reste a bien recoller les morceaux - (let ((ncoe (cadr (flet ((franz.remprop + (cond + ((numberp mon) ; on a une cste de k uniquement + (and (not (zerop mon)) (cons mon (make-list (length lvar) + :initial-element 0)))) + (t + (cond + ((and (listp mon) (equal 'mtimes (caar mon))) + (cond + ((not (or (and (listp (cadr mon)) + (equal 'mexpt (caar (cadr mon)))) + (member (cadr mon) lvar :test #'equal))) + ;; le coefficient, eventuellement rationnel, est different de 1 + (mapc 'lvarexpo (cddr mon)) + (setf (get 'var_expo 'coe) (cadr mon))) + (t + ;; le coefficient est e'gal a 1 + (mapc 'lvarexpo (cdr mon)) + (setf (get 'var_expo 'coe) 1)))) + ;; on a ((mexpt) x 4) ou x: + (t (lvarexpo mon) (setf (get 'var_expo 'coe) 1))) + ;; maintenant toutes les donnees sont dans la plist + ;; reste a bien recoller les morceaux + (let ((ncoe (cadr (flet ((franz.remprop (sym indic &aux (result (third @@ -99,14 +102,14 @@ (get-properties (symbol-plist sym) (list indic)))))) - "equivalent to Franz Lisp 'remprop'." - (remprop sym indic) result)) + "equivalent to Franz Lisp 'remprop'." + (remprop sym indic) result)) (franz.remprop 'var_expo 'coe)))) - (exposant (expomon2 lvar))) -; on n'a retire que les exposants des xi et le coefficient -; numerique de la plist, reste les yi et leur exposants -; a remettre en coefficients. - (cons (recupcoef (symbol-plist 'var_expo) ncoe) exposant)))) + (exposant (expomon2 lvar))) + ;; on n'a retire que les exposants des xi et le coefficient + ;; numerique de la plist, reste les yi et leur exposants + ;; a remettre en coefficients. + (cons (recupcoef (symbol-plist 'var_expo) ncoe) exposant))))) (defun recupcoef (plist coef) (if (null plist) coef Index: kak.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/kak.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- kak.lisp 8 May 2000 06:09:43 -0000 1.1.1.1 +++ kak.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -89,16 +89,18 @@ (defun $p_rac (listei k) (setq listei (cdr listei)) (let ((n (list-length listei))) - (if (< n k) - " impossible " - (meval (list '($bidon2) )) - (let* ((binnk (binomial n k)) - (listpi (cdr (meval (list '($ele2pui) binnk - (cons '(mlist)(cons n listei)))))) - (listpi (cons binnk ($som_pipj n binnk nil)))) -; je n'ai pas besoin de faire meval ici puisque le fichier est forcement -; charge' - (pui2polynome '$y listpi))))) + (cond + ((< n k) + " impossible ") + (t + (meval (list '($bidon2) )) + (let* ((binnk (binomial n k)) + (listpi (cdr (meval (list '($ele2pui) binnk + (cons '(mlist)(cons n listei)))))) + (listpi (cons binnk ($som_pipj n binnk nil)))) + ;; je n'ai pas besoin de faire meval ici puisque le fichier + ;; est forcement charge' + (pui2polynome '$y listpi)))))) ; (listei (cdr (pui2ele binnk listpi '$girard)))) ; ($fin (1- binnk) ; -1 (list '(mexpt) '$y binnk) listei))))) @@ -213,18 +215,21 @@ ;recherche proprement dite (non recursive terminale) (defun $monlgfix (pui rvar ote slvar poule maxote) - (if (> 0 rvar) - (rplacd slvar (list (cons (car poule) (reverse (cdr poule))))) - ($monlgfix ote - (1- rvar) - (max (1- rvar) - (- (* 2 ote) - pui)) - slvar ($met pui ote poule) (maxote ote rvar)) - (and (< ote maxote) - ($monlgfix pui rvar - (1+ ote) - (last slvar) poule maxote)))) + (cond + ((> 0 rvar) + (rplacd slvar (list (cons (car poule) (reverse (cdr poule)))))) + (t + ($monlgfix ote + (1- rvar) + (max (1- rvar) + (- (* 2 ote) + pui)) + slvar ($met pui ote poule) (maxote ote rvar)) + (and (< ote maxote) + ($monlgfix pui rvar + (1+ ote) + (last slvar) poule maxote))))) + (defun $met (pui ote poule) (let ((nxcoe ($mult_sym (car poule) (binomial pui ote))) (nxpui (- pui ote))) @@ -241,15 +246,17 @@ (defun $prodkak (listei k) (setq listei (cdr listei)) (let ((n (list-length listei))) - (if (< n k) - " impossible " - (meval (list '($bidon2))) - (let* ((binnk (binomial n k)) - (listpi - (cdr (meval (list '($ele2pui) (mult binnk k) + (cond + ((< n k) + " impossible ") + (t + (meval (list '($bidon2))) + (let* ((binnk (binomial n k)) + (listpi + (cdr (meval (list '($ele2pui) (mult binnk k) (cons '(mlist) (cons n listei))))))) - (pui2polynome '$y - (cons binnk ($listpui binnk nil k))))))) + (pui2polynome '$y + (cons binnk ($listpui binnk nil k)))))))) ; liste des fonctions puissances dans l'alphabet des racines du polynome ; cherche. Index: elem.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/elem.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- elem.lisp 8 May 2000 06:09:43 -0000 1.1.1.1 +++ elem.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -223,11 +223,12 @@ (1- puiounb)) puiounb)) i))) - (if test - (progn - (setq nb1 (car (last j))) - (nbutlast (nbutlast j))) - (setq nb1 0) j)))) + (cond + (test + (setq nb1 (car (last j))) + (nbutlast (nbutlast j))) + (t + (setq nb1 0) j))))) ;--------------------------------------------------------------------------- ; REECRITURE DE I ; Developpement de ei*J ou i= lgI = nb1 + lgJ Index: direct.lisp =================================================================== RCS file: /cvsroot/maxima/maxima/share/sym/direct.lisp,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- direct.lisp 8 May 2000 06:09:43 -0000 1.1.1.1 +++ direct.lisp 24 Nov 2004 23:47:23 -0000 1.2 @@ -119,7 +119,7 @@ (list '(mequal) $pol $pol2))) (throw 'trouve t))) list$pol) - nil)))) + nil))) ;========================================================================== ; CALCUL DE L'ORBITE DU POLYNOME P SOUS S_d1xS_d2x...xS_dp ;-------------------------------------------------------------------------- |
