partitions.scm

  1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2 ;;; (DS math partitions)              ;;;
  3 ;;; (c) Olivier Pirson --- DragonSoft ;;;
  4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5 (define-module (DS math partitions))
  6 (define-public DS-math-partitions-VERSION "2006 June 7")

  8 ;;; On appelle composition d'un naturel n
  9 ;;;   une suite de naturels > 0 dont la somme vaut n

 11 ;;; On appelle partition d'un naturel n
 12 ;;;   une composition de n, abstraction faite de l'ordre des termes
 13 ;;;
 14 ;;; Exemples : Partition  de 0 : partition vide
 15 ;;;            Partition  de 1 : 1
 16 ;;;            Partitions de 2 : 2
 17 ;;;                              1 + 1
 18 ;;;            Partitions de 3 : 3
 19 ;;;                              2 + 1
 20 ;;;                              1 + 1 + 1
 21 ;;;            Partitions de 4 : 4
 22 ;;;                              3 + 1
 23 ;;;                              2 + 2
 24 ;;;                              2 + 1 + 1
 25 ;;;                              1 + 1 + 1 + 1
 26 ;;;            Partitions de 5 : 5
 27 ;;;                              4 + 1
 28 ;;;                              3 + 2
 29 ;;;                              3 + 1 + 1
 30 ;;;                              2 + 2 + 1
 31 ;;;                              2 + 1 + 1 + 1
 32 ;;;                              1 + 1 + 1 + 1 + 1

 34 ;;; Pour tout naturel n :
 35 ;;;   C(n)   := nombre de compositions de n = 2^(n-1)
 36 ;;;   P(n)   := nombre de partitions de n
 37 ;;;   P_k(n) := nombre de partitions de n qui contient exactement k termes
 38 ;;;
 39 ;;;   n |  C(n) | P(n) | P_0(n) | P_1(n) | P_2(n) | P_3(n) | P_4(n) | P_5(n) | P_6(n) | ... | P_n(n) | P_(n+1)(n)
 40 ;;; --------------------------------------------------------------------------------------------------------------
 41 ;;;   0 |     1 |    1 |      1 |        |        |        |        |        |        |     |      1 |          0
 42 ;;;   1 |     1 |    1 |      0 |      1 |        |        |        |        |        |     |      1 |          0
 43 ;;;   2 |     2 |    2 |      0 |      1 |      1 |        |        |        |        |     |      1 |          0
 44 ;;;   3 |     4 |    3 |      0 |      1 |      1 |      1 |        |        |        |     |      1 |          0
 45 ;;;   4 |     8 |    5 |      0 |      1 |      2 |      1 |      1 |        |        |     |      1 |          0
 46 ;;;   5 |    16 |    7 |      0 |      1 |      2 |      2 |      1 |      1 |        |     |      1 |          0
 47 ;;;   6 |    32 |   11 |      0 |      1 |      3 |      3 |      2 |      1 |      1 |     |      1 |          0
 48 ;;;   7 |    64 |   15 |      0 |      1 |      3 |      4 |      3 |      2 |      1 |     |      1 |          0
 49 ;;;   8 |   128 |   22 |      0 |      1 |      4 |      5 |      5 |      3 |      2 |     |      1 |          0
 50 ;;;   9 |   256 |   30 |      0 |      1 |      4 |      7 |      6 |      5 |      3 |     |      1 |          0
 51 ;;;  10 |   512 |   42 |      0 |      1 |      5 |      8 |      9 |      7 |      5 |     |      1 |          0
 52 ;;; ... |       |      |        |        |        |        |        |        |        |     |        |
 53 ;;;   n |2^(n-1)|      |      0 |      1 |        |        |        |        |        |     |      1 |          0



 57 ;;;;;;;;;;;;;;;;;
 58 ;;; Fonctions ;;;
 59 ;;;;;;;;;;;;;;;;;
 60 ;;; Renvoie une liste contenant toutes les partitions de n ("ordre décroissant")
 61 ;;; pre: n exact natural
 62 ;;; result: liste de liste d'exact natural > 0
 63 ;;;         ou si n = 0, liste ayant pour seul élément '()
 64 ;;; O(...)
 65 (define-public (partitions n)
 66   (if (zero? n)
 67       (list '())
 68       (let ((p (list n 0))  ; partition en construction (ordre inverse) se terminant par 0
 69             (l '()))        ; liste des partitions (dans l'ordre)
 70         (set! n 0)  ; ce qu'il manque à la somme des termes de p
 71         (while (not (negative? (car p)))
 72                ;; inv: ce qu'il manque à la somme des termes de p
 73                (while (> n (car p))
 74                       ;; Il manque des termes pour p et le dernier convient
 75                       (set! n (- n (car p)))
 76                       (set! p (cons (car p) p)))
 77                (if (positive? n)
 78                    (begin  ;; Il manque le terme n pour p
 79                      (set! p (cons n p))
 80                      (set! n 0)))
 81                ;; p forme une partition
 82                (set! l (append! l (list (cdr (reverse p)))))
 83                (while (= 1 (car p))
 84                       ;; Remonte dans les termes de p jusqu'à trouver un terme > 1
 85                       (set! p (cdr p))
 86                       (set! n (1+ n)))
 87                ;; Décrémente le dernier terme de p
 88                (set! n (1+ n))
 89                (set-car! p (1- (car p))))
 90         l)))

 92 ;;; Renvoie C(n), le nombre de compositions de n
 93 ;;; pre: n exact natural
 94 ;;; result: exact natural
 95 ;;; O(...)
 96 (define-public (partitions-C n)
 97   (if (zero? n)
 98       1
 99       (integer-expt 2 (1- n))))

101 ;;; Renvoie P(n), le nombre de partitions de n
102 ;;; pre: n exact natural
103 ;;; result: exact natural
104 ;;; O(...)
105 (define-public (partitions-P n)
106   (if (zero? n)
107       1
108       (let ((p (list n 0))  ; partition en construction (ordre inverse) se terminant par 0
109             (nb 0))         ; nombre de partitions
110         (set! n 0)  ; ce qu'il manque à la somme des termes de p
111         (while (not (negative? (car p)))
112                ;; inv: ce qu'il manque à la somme des termes de p
113                (while (> n (car p))
114                       ;; Il manque des termes pour p et le dernier convient
115                       (set! n (- n (car p)))
116                       (set! p (cons (car p) p)))
117                (if (positive? n)
118                    (begin  ;; Il manque le terme n pour p
119                      (set! p (cons n p))
120                      (set! n 0)))
121                ;; p forme une partition
122                (set! nb (1+ nb))
123                (while (= 1 (car p))
124                       ;; Remonte dans les termes de p jusqu'à trouver un terme > 1
125                       (set! p (cdr p))
126                       (set! n (1+ n)))
127                ;; Décrémente le dernier terme de p
128                (set! n (1+ n))
129                (set-car! p (1- (car p))))
130         nb)))

132 ;;; Renvoie P_k(n), le nombre de partitions de n qui contient exactement k termes
133 ;;; pre: n exact natural
134 ;;;      k exact natural
135 ;;; result: exact natural
136 ;;; O(...)
137 (define-public (partitions-Pk n k)
138   (if (zero? n)
139       (if (zero? k)
140           1
141           0)
142       (let ((p (list n 0))  ; partition en construction (ordre inverse) se terminant par 0
143             (len 1)         ; nombre de termes de p
144             (nb 0))         ; nombre de partitions
145         (set! n 0)  ; ce qu'il manque à la somme des termes de p
146         (while (not (negative? (car p)))
147                ;; inv: ce qu'il manque à la somme des termes de p
148                (while (> n (car p))
149                       ;; Il manque des termes pour p et le dernier convient
150                       (set! n (- n (car p)))
151                       (set! p (cons (car p) p))
152                       (set! len (1+ len)))
153                (if (positive? n)
154                    (begin  ;; Il manque le terme n pour p
155                      (set! p (cons n p))
156                      (set! n 0)
157                      (set! len (1+ len))))
158                ;; p forme une partition
159                (if (= len k)
160                    (set! nb (1+ nb)))
161                (while (= 1 (car p))
162                       ;; Remonte dans les termes de p jusqu'à trouver un terme > 1
163                       (set! p (cdr p))
164                       (set! n (1+ n))
165                       (set! len (1- len)))
166                ;; Décrémente le dernier terme de p
167                (set! n (1+ n))
168                (set-car! p (1- (car p))))
169         nb)))

171 ;;; Renvoie P(n | termes pairs),
172 ;;;   le nombre de partitions de n pour lesquelles tous les termes sont pairs
173 ;;; pre: n exact natural
174 ;;; result: exact natural
175 ;;; O(...)
176 (define-public (partitions-P-even n)
177   (if (or (odd? n) (zero? n))
178       (if (zero? n)
179           1
180           0)
181       (let ((p (list n 0))  ; partition en construction (ordre inverse) se terminant par 0
182             (nb 0))         ; nombre de partitions
183         (set! n 0)
184         (while (not (negative? (car p)))
185                ;; inv: ce qu'il manque à la somme des termes de p
186                (while (> n (car p))
187                       ;; Il manque des termes pour p et le dernier convient
188                       (set! n (- n (car p)))
189                       (set! p (cons (car p) p)))
190                (if (positive? n)
191                    (begin ;; Il manque le terme n pour p
192                      (set! p (cons n p))
193                      (set! n 0)))
194                ;; p forme une partition
195                (set! nb (1+ nb))
196                (while (= 2 (car p))
197                       ;; Remonte dans les termes de p jusqu'à trouver un terme > 2
198                       (set! p (cdr p))
199                       (set! n (+ n 2)))
200                ;; Décrémente le dernier terme de p
201                (set! n (+ n 2))
202                (set-car! p (- (car p) 2)))
203         nb)))

205 ;;; Renvoie P(n | termes impairs),
206 ;;;   le nombre de partitions de n pour lesquelles tous les termes sont impairs
207 ;;;   = P(n | termes distincts)
208 ;;; pre: n exact natural
209 ;;; result: exact natural
210 ;;; O(...)
211 (define-public (partitions-P-odd n)
212   (if (zero? n)
213       1
214       (let ((p (list (if (odd? n)  ; partition en construction (ordre inverse) se terminant par 0
215                          n
216                          (1- n))
217                      0))
218             (nb 0))                ; nombre de partitions
219         (set! n (if (odd? n)
220                     0
221                     1))
222         (while (not (negative? (car p)))
223                ;; inv: ce qu'il manque à la somme des termes de p
224                (while (> n (car p))
225                       ;; Il manque des termes pour p et le dernier convient
226                       (set! n (- n (car p)))
227                       (set! p (cons (car p) p)))
228                (if (odd? n)
229                    ;; Il manque le terme n pour p
230                    (set! p (cons n p))
231                    (if (positive? n)
232                        ;; Il manque les termes (n-1) et 1 pour p
233                        (set! p (cons 1 (cons (1- n) p)))))
234                (set! n 0)
235                ;; p forme une partition
236                (set! nb (1+ nb))
237                (while (= 1 (car p))
238                       ;; Remonte dans les termes de p jusqu'à trouver un terme > 1
239                       (set! p (cdr p))
240                       (set! n (1+ n)))
241                ;; Décrémente le dernier terme de p
242                (set! n (+ n 2))
243                (set-car! p (- (car p) 2)))
244         nb)))