share/sym/treillis.lisp

   1 ; treillis.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 ;               ALGORITHMES SUR LES PARTITIONS
  21 ;============================================================================
  22 ;                        INTERFACE
  23
  24 (in-package :maxima)
  25 (macsyma-module treillis)
  26
  27 (mdefprop $treillis
  28     ((lambda ()) ((mlist) $poids)
  29      ((mprog) (($operation)) (($treillis_init) $poids)))
  30     mexpr)
  31 (add2lnc '(($treillis) $poids) $functions)
  32 (mdefprop $lgtreillis
  33     ((lambda ()) ((mlist) $poids $longueur)
  34      ((mprog) (($operation)) (($lgtreillis_init) $poids $longueur)))
  35     mexpr)
  36 (add2lnc '(($lgtreillis) $poids $longueur) $functions)
  37
  38 (mdefprop $ltreillis
  39     ((lambda ()) ((mlist) $poids $longueur)
  40      ((mprog) (($operation)) (($ltreillis_init) $poids $longueur)))
  41     mexpr)
  42 (add2lnc '(($ltreillis) $poids $longueur) $functions)
  43
  44 ;==========================================================================
  45 ;              TREILLIS DES PARTITIONS DE POIDS n
  46 ;                   dans l'ordre lexicographique
  47 (defun $treillis_init (n)
  48   (macsy_list (treillis n)))
  49
  50 (defun treillis (n)
  51   (let ((ltreillis (cons nil nil)))
  52     (treillis2 n 0 ltreillis nil)
  53     (cdr ltreillis)))
  54
  55 ; p(i+1)^m=max(0,2pi-p(i+1))
  56 ; p(i+1)^M = pi-1
  57 (defun treillis2 (pui ote ltreillis poule)
  58   (cond
  59     ((eql 0 pui) (rplacd ltreillis (list (reverse poule))))
  60     (t (treillis2 ote
  61            (max 0
  62                  (- (* 2 ote)
  63                            pui))
  64            ltreillis
  65            (cons (- pui ote)
  66                  poule))
  67        (let ((ote (1+ ote)))
  68          (and (< ote pui)
  69               (treillis2 pui ote (last ltreillis) poule))))))
  70 ;=========================================================================
  71 ;              TREILLIS DES PARTITIONS DE POIDS ET LONGUEUR FIXE
  72 ;                   dans l'ordre lexicographique
  73
  74 (defun $lgtreillis_init (p l)
  75     (macsy_list (lgtreillis p l)))
  76
  77 (defun lgtreillis (poids longueur)
  78   (let ((lpart (cons nil nil)))
  79        (lgtreillis2 poids
  80                     (- longueur 1)
  81                     (- longueur 1)
  82                     (maxote poids longueur) nil lpart)
  83     (cdr lpart)))
  84
  85 (defun lgtreillis2 (poids rlongueur ote maxote partition lpart)
  86   (cond ((minusp rlongueur)
  87          (rplacd lpart (list (reverse partition))))
  88        (t (lgtreillis2 ote
  89                       (- rlongueur 1)
  90                       (max (- rlongueur 1)  (- (* 2 ote) poids))
  91                       (maxote ote rlongueur)
  92                       (cons (- poids ote)
  93                             partition)
  94                       lpart)
  95             (and (< ote maxote)
  96                  (lgtreillis2 poids
  97                          rlongueur
  98                          (1+ ote)
  99                          maxote
 100                          partition
 101                          (last lpart))))))
 102
 103 ; la fonction maxote est commune a : treillis.lsp , resolvante.lsp, kak.lsp
 104 ; voir dans util.lsp
 105
 106 ;-----------------------------------------------------------------------
 107 ; PARTITIONS DE POIDS FIXE ET DE LONGUEUR BORNEE
 108
 109 (defun $ltreillis_init (p l)
 110     (macsy_list (ltreillis p l)))
 111
 112 (defun ltreillis (poids longueur)
 113   (let ((lpart (cons nil nil)))
 114     (ltreillis2 poids
 115                (- longueur 1)
 116         0 (maxote poids longueur) nil lpart)
 117     (cdr lpart)))
 118
 119 (defun ltreillis2 (poids rlongueur ote maxote partition lpart)
 120   (cond ((minusp rlongueur)
 121          (rplacd lpart (list (reverse partition))))
 122         (t (ltreillis2   ote
 123                          (- rlongueur 1)
 124                          (max 0 (- (* 2 ote) poids))
 125                          (maxote ote rlongueur)
 126                          (cons (- poids ote) partition)
 127                          lpart)
 128             (and (< ote maxote)
 129                    (ltreillis2 poids
 130                          rlongueur
 131                          (1+ ote)
 132                          maxote
 133                          partition
 134                          (last lpart))))))
 135
 136
 137
 138