← Back to branch summary

~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to share/sym/schur.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2006-10-18 14:52:42 UTC
  • mto: (1.1.5 upstream)
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20061018145242-vzyrm5hmxr8kiosf
Import upstream version 5.10.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
share/sym/schur.lisp
24
24
;----------------------------------------------------------------------------
25
25
;            PASSAGE DES FORMES MONOMIALES AUX FONCTIONS DE SCHUR
26
26
 
27
 
(in-package "MAXIMA")
 
27
(in-package :maxima)
28
28
(macsyma-module schur)
29
29
 
30
30
(mdefprop $mon2schur
257
257
 
258
258
(defun good_tab0 (l lcont ltas)
259
259
  (let ((l1 nil) (rep nil) (relais nil))
260
 
       (if (eql 1 (list-length l))
261
 
           (mapcar 'list (good_line (car l) lcont ltas))
262
 
           (setq l1 (good_line (car l) lcont ltas))
263
 
               ;(print "tete des tableaux possibles " L1)
264
 
           (do nil 
265
 
               ((null l1))
266
 
               (setq relais
267
 
                     (good_tab0 (cdr l) (car l1) (new_tas0 (car  l1) ltas)))
268
 
                ;(print " car L1 future tete "(car L1) " et relais "relais) 
269
 
               (if (not relais) (setq l1 (cdr l1))
270
 
                   (setq rep (nconc rep (insert_tete (car l1) relais)) 
271
 
                         l1 (cdr l1))))
272
 
           rep)))
 
260
       (cond
 
261
         ((eql 1 (list-length l))
 
262
          (mapcar 'list (good_line (car l) lcont ltas)))
 
263
         (t
 
264
          (setq l1 (good_line (car l) lcont ltas))
 
265
          ;; (print "tete des tableaux possibles " L1)
 
266
          (do nil 
 
267
              ((null l1))
 
268
            (setq relais
 
269
                  (good_tab0 (cdr l) (car l1) (new_tas0 (car  l1) ltas)))
 
270
            ;; (print " car L1 future tete "(car L1) " et relais "relais) 
 
271
            (if (not relais) (setq l1 (cdr l1))
 
272
                (setq rep (nconc rep (insert_tete (car l1) relais)) 
 
273
                      l1 (cdr l1))))
 
274
          rep))))
273
275
 
274
276
;L liste de listes : retourne la meme liste ou les listes ont ete modifiees
275
277
; par insertion de i en tete
293
295
(defun good_line0 (taille lcontrainte ltas)
294
296
  (let ((i 0) (lotas (list-length ltas)) (avanti nil) (rep nil))
295
297
          ; (print "taille = "taille "  Ltas" Ltas "GREP "rep)
296
 
       (if (or (null lcontrainte) (zerop taille)) nil
297
 
           (setq i (1+ (car lcontrainte)))
298
 
           (do nil 
299
 
              ((< lotas i))
300
 
              (if (zerop (nth (1- i) ltas))
301
 
                  (setq i (1+ i))
302
 
                  (setq rep
303
 
                        (append rep
304
 
                                (insert_tete 
305
 
                                    i
306
 
                                    (good_line0 (1- taille)
307
 
                                                (cdr lcontrainte)
308
 
                                                (append
309
 
                                                     (make-list (1- i)
310
 
                                                                :initial-element 0)
311
 
                                                     (list (1- (nth (1- i) ltas)))
312
 
                                                     (lastn ltas (- lotas i))
313
 
                                                  ))))
314
 
                            i (1+ i)
315
 
                            avanti t)))
316
 
        (if avanti rep nil))))
 
298
       (unless (or (null lcontrainte) (zerop taille))
 
299
         (setq i (1+ (car lcontrainte)))
 
300
         (do nil 
 
301
             ((< lotas i))
 
302
           (if (zerop (nth (1- i) ltas))
 
303
               (setq i (1+ i))
 
304
               (setq rep
 
305
                     (append rep
 
306
                             (insert_tete 
 
307
                              i
 
308
                              (good_line0 (1- taille)
 
309
                                          (cdr lcontrainte)
 
310
                                          (append
 
311
                                           (make-list (1- i)
 
312
                                                      :initial-element 0)
 
313
                                           (list (1- (nth (1- i) ltas)))
 
314
                                           (lastn ltas (- lotas i))
 
315
                                           ))))
 
316
                     i (1+ i)
 
317
                     avanti t)))
 
318
         (if avanti rep nil))))
317
319
 
318
320
(defun good_length (taille l)
319
321
  (if (null l) nil