Défi N°1 : Génération des ensembles de nombre dont la somme est identique

[Garulfo]

Salut, j'ai pris mon temps pour donner une solution en scheme.
Ça fait un moment que je n'étais pas vraiment passé par là et je n'avais pas vu que vous aviez commencé.
Menfinbon.
Voici sans optimisation, avec un code simple.
C'est la technique de tous je crois.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
(define (n-est-egale-a-m? m) (lambda (n) (= n m)))

(define est-1? (n-est-egale-a-m? 1))
(define est-0? (n-est-egale-a-m? 0))
(define (1- n) (- n 1))

(define (creer-liste-de-1-a m)
  (define (creer-liste-de-1-a-it n l) 
    (if (est-1? n)
        (cons 1 l)
        (creer-liste-de-1-a-it (1- n) (cons n l))
        )
    )
  (creer-liste-de-1-a-it m '())
  )

(define (union-des-listes-de l)
  (foldl append '() l)
  )

(define (decomposition_n_m n m) 
  (if (est-0? n)
      '()
      (let* ((liste-1-min-n-m (creer-liste-de-1-a (min n m)))
             (creer-decomposition-partiel 
              (lambda (x) (let ((decomposition_n-x_x (decomposition_n_m (- n x) x))
                                )
                            (if (null? decomposition_n-x_x) 
                                `((,x))
                                (map  (lambda (l) (cons x l)) decomposition_n-x_x)
                                )
                            )
                )
              )
             )   
        (union-des-listes-de (map creer-decomposition-partiel liste-1-min-n-m))
        )
      )
  )

(define (decomposition n)
  (decomposition_n_m n n)
  )

Si vous vouliez des explications je me tiens à votre disposition.
Dans les optimisations simples: les listes « infinies » pour conserver les valeurs des calculs temporaires et le retour de plusieurs paramètres pour éviter les constructions destructions de listes (je pense surtout au créateur union-des-listes-de). Mais j'ai pas essayé encore.

[Garulfo]

Voici une version compilable avec Bigloo

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
(module decomposition-d-un-entier
   (main main)
   )

(define (n-est-egale-a-m? m) (lambda (n) (= n m)))

(define est-1? (n-est-egale-a-m? 1))
(define est-0? (n-est-egale-a-m? 0))
(define (1- n) (- n 1))

(define (creer-liste-de-1-a m)
  (define (creer-liste-de-1-a-it n l) 
    (if (est-1? n)
        (cons 1 l)
        (creer-liste-de-1-a-it (1- n) (cons n l))
        )
    )
  (creer-liste-de-1-a-it m '())
  )

(define (union-des-listes-de l)
  (apply append l)
  )

(define (decomposition_n_m n m) 
  (if (est-0? n)
      '()
      (let* ((liste-1-min-n-m (creer-liste-de-1-a (min n m)))
             (creer-decomposition-partiel 
              (lambda (x) (let ((decomposition_n-x_x (decomposition_n_m (- n x) x))
                                )
                            (if (null? decomposition_n-x_x) 
                                `((,x))
                                (map  (lambda (l) (cons x l)) decomposition_n-x_x)
                                )
                            )
                )
              )
             )   
        (union-des-listes-de (map creer-decomposition-partiel liste-1-min-n-m))
        )
      )
  )

(define (decomposition n)
  (decomposition_n_m n n)
  )

(define (main argv)
  (decomposition (string->number (cadr argv)))
  )

si certains veulent faire des benchmarks. -_-
Avec mon PowerBook G4 et l'optimisation O3, j'obtiens 51s de user time pour 64.

[gorgonite]

j'ai un petit problème avec ce programme...


voilà la ligne avec laquelle je compile avec succès

Code :

 bigloo -O3 sums.scm  -o sums.exe

mais quand je lance

Code :

./sums.exe 234

rien ne s'affiche... ce serait bien d'afficher le nombre de solutions pour être sûr que tout marche


pour les performances
+ 21 => 6ms
+ 54 => 3s
+ 70 => 51s

[gorgonite]

bon allez, pour ne pas laisser ocaml derrière haskell, voici une petite version avec l'algorithme simpliste plus une petite mémorisation des résultats

Attention : je n'ai pas encore partagé les listes intermédiaires pour éviter la duplication en mémoire...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
let rec build_list n m = if n>m then [] else n::(build_list (n+1) m);;
let min a b = if a<b then a else b;;

let sums n memoire =
	let rec sumrec n m =
		match n with
			0 -> [[]]
			|n -> 
				let intervalle = build_list 1 (min m n) in
				List.concat (
					List.map (fun i -> 
								List.map (fun l -> i::l) 
										(let ni = n-i in
										if memoire.(ni).(i) = [] then let tmp = sumrec (ni) i in memoire.(ni).(i) <- tmp ; tmp else memoire.(ni).(i) )
							) intervalle
				)
	in
	sumrec n n
;;

let rec print_list l =
	match l with
		[] -> ()
		|a::q -> Printf.printf "%d " a ; print_list q
;;

let rec print lst = 
	match lst with
		[] -> ()
		|a::q -> Printf.printf "[ " ; print_list a ; Printf.printf "] \n" ; print q
;;


let construct_memoire n =
	Array.make_matrix (n+1) (n+1) []
;;

let main () =
	let n = int_of_string Sys.argv.(1) in
	let res = sums n (construct_memoire n) in
(*	print res ; *)
	Printf.printf "%d\n" (List.length res) 
;;

main ();;

les performances :
+ n=21 => 2ms
+ n=54 => 657s
+ n=70 => 9s
stack overflow à n=75
bizarre... d'après les données renvoyées par statm, cela consommerait seulement 6Mo de mémoire, et selon top je prendrais 280Mo (plus réaliste)


pour comparaison, la "même" méthode en haskell par Jedai avait les performances suivantes :
+ 3ms pour 21
+ 450ms pour 54
+ 5,6s pour 70



il est vrai que ocamlopt optimise bien, mais je ne lui ai pas rajouté d'options... car je ne sais pas lesquelles prendre ; alors que le ghc optimise avec pas mal d'options

[Jedai]

J'ai rajouté ton programme dans mes benchs, ça donne déjà un rang plus réaliste à OCaml. Par contre ça serait bien si à l'avenir tu utilisais des espaces plutôt que des tabulations, parce qu'elles prennent une place folle sur le forum, du coup ton code devient difficile à lire (il s'étale horizontalement...). Si tu utilisais des espaces, tu pourrais avoir plutôt un truc comme :

Code OCaml :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
let rec build_list n m = if n>m then [] else n::(build_list (n+1) m);;
let min a b = if a<b then a else b;;

let sums n memoire =
  let rec sumrec n m =
    match n with
	0 -> [[]]
      | n -> 
	  let intervalle = build_list 1 (min m n) in
	    List.concat (
	      List.map (fun i -> 
		List.map (fun l -> i::l) 
		  (let ni = n-i in
		     if memoire.(ni).(i) = [] 
		     then let tmp = sumrec (ni) i in 
			    begin
			      memoire.(ni).(i) <- tmp ; 
			      tmp 
			    end
		     else memoire.(ni).(i) )
	      ) intervalle
	    )
  in
    sumrec n n
;;

let rec print_list l =
  match l with
      [] -> ()
    | a::q -> Printf.printf "%d " a ; print_list q
;;

let rec print lst = 
  match lst with
      [] -> ()
    | a::q -> Printf.printf "[ " ; print_list a ; Printf.printf "] \n" ; print q
;;


let construct_memoire n =
  Array.make_matrix (n+1) (n+1) []
;;

let main () =
  let n = int_of_string Sys.argv.(1) in
  let res = sums n (construct_memoire n) in
    (* print res ; *)
    Printf.printf "%d\n" (List.length res) 
;;

main ();;

--
Jedaï

[gorgonite]

Envoyé par Jedai

Par contre ça serait bien si à l'avenir tu utilisais des espaces plutôt que des tabulations, parce qu'elles prennent une place folle sur le forum, du coup ton code devient difficile à lire (il s'étale horizontalement...). Si tu utilisais des espaces, tu pourrais avoir plutôt un truc comme :

zut sous vim, chaque tab ne prend que la place que je souhaite pourtant....


faudra que j'essaie d'y penser

[Garulfo]

Envoyé par gorgonite

[...]
mais quand je lance

Code :

./sums.exe 234

rien ne s'affiche... ce serait bien d'afficher le nombre de solutions pour être sûr que tout marche

Je n'affiche effectivement pas ^_^
J'ai fait ça pour ne pas avoir à rediriger la sortie.
Dans Dr Scheme, on lit cependant les résultats de retour des fonctions. En exécution avec Bigloo il ne les produit pas par contre. Je t'assure que tout marche. Mais sinon voici le changement que tu peux faire pour afficher

Code :

1
2
3
(define (main argv)
  (write (decomposition (string->number (cadr argv))))
  )

au lieu de

Code :

1
2
3
(define (main argv)
  (decomposition (string->number (cadr argv)))
  )

[Garulfo]

Envoyé par gorgonite

zut sous vim, chaque tab ne prend que la place que je souhaite pourtant....

Ajoute

Code :

set expandtab

dans ton ~/.vimrc

[gorgonite]

Envoyé par Garulfo

Ajoute

Code :

set expandtab

dans ton ~/.vimrc

je sais, mais cela prend plus de place...

[Jedai]

Envoyé par gorgonite

je sais, mais cela prend plus de place...

Je ne vois pas bien pourquoi ? Tu dois pouvoir configurer combien d'espace va représenter une tabulation non ?

Sinon j'ai une autre solution pour toi : utilise emacs !

--
Jedaï

[gorgonite]

si je remplace une tabulation par 2 ou 3 espaces... le fichier du code source sera plus gros

Envoyé par Jedai

Sinon j'ai une autre solution pour toi : utilise emacs !

en fait, j'utilise emacs + tuareg pour ocaml... mais ça fait 6 mois que je ne code presque pas, alors j'avais oublié

[LLB]

C'est malin !

Utilise alors :
C-x h M-x untabify
avant de poster ton code source.

Pour ma part, quand je me fiche de la taille du fichier, je préfère avoir :
(setq-default indent-tabs-mode nil)
pour ne pas avoir de caractère tabulation (je trouve ça bien au final vu les problèmes qu'elles posent... d'ailleurs F# les interdit en mode #light).

[Garulfo]

Envoyé par gorgonite

je sais, mais cela prend plus de place...

Euh non... pas forcément.
TU veux combien d'espace pour une tabulation ?

Code :

set tabstop=4

[Jedai]

Envoyé par gorgonite

si je remplace une tabulation par 2 ou 3 espaces... le fichier du code source sera plus gros

Oui évidemment vu dans ce sens là....

Envoyé par gorgonite

en fait, j'utilise emacs + tuareg pour ocaml... mais ça fait 6 mois que je ne code presque pas, alors j'avais oublié

Franchement Emacs c'est comme le vélo, ça s'oublie pas, et puis emacs a un excellent mode Haskell, très pratique, comme tuareg à vrai dire.

--
Jedaï

[gorgonite]

Envoyé par Jedai

et puis emacs a un excellent mode Haskell, très pratique, comme tuareg à vrai dire.

cool... un lien ?

[Jedai]

Haskell mode for Emacs, très pratique, permet de charger son module dans GHCi ou Hugs automatiquement, excellent système d'indentation (ce qui a son importance en Haskell) et autres gadgets (type des fonctions standard automatiquement affiché dans le mini-buffer, après chargement du module dans un interpréteur, vous pouvez avoir la même chose pour n'importe quelle fonction, retrouver la définition d'un symbole, etc...).

--
Jedaï

[Garulfo]

Dans la partie HS, j'étais un grand fan de Emacs avant. Sauf qu'un jour j'ai eu à utiliser des serveurs qui ne possédait que VI (et oui ça arrive)... depuis je n'utilise plus que celui-ci. Le seul truc qui me manque de Emacs, c'est son dialecte Lisp ^_^

[dividee]

Voici une version (compilable) en Oz. Elle est lazy et utilise la mémorisation des résultats intermédiaires. C'est pas très joli (comparée à du Haskell p.e.) mais relativement efficace (2 secondes environ pour sums 64; 6 ou 7 secondes pour sums 75).
C'est un langage intéressant; dommage qu'il soit si verbeux et que la librairie standard soit si pauvre...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
functor
import
   Application
   Open
define
   
   fun {Concat Ls}
      {List.foldR Ls List.append nil}
   end
   
   fun {Sums N}
      SumRec Mem in
      fun lazy {SumRec N M}
	 if N == 0 then [nil]
	 else 
	    {Concat
	     {List.map
	      {List.number 1 M 1}
	      fun {$ I}
		 {List.map
		  {Array.get {Array.get Mem N-I} {Min I N-I}}
	       fun {$ L} I|L end}
	      end}}
	 end
      end
      
      Mem = {Array.new 0 N nil}
      for I in 0..N do A in
	 A = {Array.new 0 I nil}
	 {Array.put Mem I A}
	 for J in 0..I do
	    {Array.put A J {SumRec I J}}
	 end
      end
      {Array.get {Array.get Mem N} N}
   end

   Out = {New Open.file init(name:stdout)}
   {Out write(vs:
	   {IntToString
	    {Length
	     {Sums
	      {StringToInt {Application.getArgs plain}.1}}}}
	     )}
   {Application.exit 0}
end

Voici une version purement fonctionnelle (sauf pour le décompte des feuilles, qui n'est là que pour l'exemple) en OCaml, sans mémoization ou quoi que ce soit. Je n'ai pas non plus mis de pretyprinter, mais ce n'est pas bien compliqué. Sur mon pentium M 1,2GHz, compilé avec ocamlopt, pour 40 (résultat 37338), ça prend 0,16 secondes. Pour 60, on monte à 3,87, et pour 70, je swap comme une brute, et je n'ai pas envie de continuer :-)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
type tree = subtree list
and subtree = { tag : int;
		son : tree}

let count =  ref 0


let rec build_tree n cut acc =
  if (cut = 0) then acc
  else 
    let sub_tree = build_sub_tree n cut in
    build_tree n (cut - 1) (sub_tree::acc)
and build_sub_tree n cut =
    if n = cut then begin
      incr count;
      {tag = cut; son = []}
    end else
      let n' = n - cut in
	{ tag = cut;
	  son = build_tree n' (min cut n') [] }

let build_all_tree n = build_tree n n []

let _ = build_all_tree (int_of_string Sys.argv.(1))

let _ = print_int !count

Pour ceux qui comme Saint Thomas ne croient que ce qu'ils voient, la version avec pretty-printer...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
type tree = subtree list
and subtree = { tag : int;
		son : tree}

let count =  ref 0


let rec build_tree n cut acc =
  if (cut = 0) then acc
  else 
    let sub_tree = build_sub_tree n cut in
    build_tree n (cut - 1) (sub_tree::acc)
and build_sub_tree n cut =
    if n = cut then begin
      incr count;
      {tag = cut; son = []}
    end else
      let n' = n - cut in
	{ tag = cut;
	  son = build_tree n' (min cut n') [] }

let build_all_tree n = build_tree n n []

let print_list l = 
  let rec print_interieure fst = function
      [] -> ()
    | t::q ->
	if not fst then print_string ", ";
	print_int t;
	print_interieure false q in
  print_string "[";
  print_interieure true l;
  print_string "]\n"

let rec print_subtree l st = 
  if st.son = [] then print_list (st.tag :: l) 
  else print_tree (st.tag :: l) st.son
and print_tree l = function
  | [] -> ()
  | st :: q -> print_subtree l st; print_tree l q

let t = build_all_tree (int_of_string Sys.argv.(1))

let _ = print_tree [] t

let _ = print_int !count