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

Allez hop, je suis en forme! Pour rigoler, une version avec mémoization (sale, en impératif, tout ça tout ça !)

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
52
53
54
55
56
57
58
59
60
61
62
63
type tree = subtree list
and subtree = { tag : int;
		son : tree}

let memo = ref (Array.make_matrix 0 0 None)

let init_memo n = 
  memo := Array.make_matrix (n + 1) (n + 1) None

let extract_memo n cut = 
  !memo.(n).(cut)

let insert_memo n cut l = 
  !memo.(n).(cut) <- Some l

let rec build_tree n cut =
  if (cut = 0) then []
  else 
    match extract_memo n cut with
      | None -> 
	 let sub_tree = build_sub_tree n cut in
	 let res = sub_tree :: (build_tree n (cut - 1)) in
	 insert_memo n cut res;
	 res
      | Some r -> r
and build_sub_tree n cut =
    if n = cut then
      {tag = cut; son = []}
    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 count = ref 0

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

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

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

(*let _ = print_tree [] t
let _ = print_int !count
*)

Toujours sur la même bécane, la génération de l'arbre prend 0,26 secondes pour n = .... 1000

Après la question qui se pose c'est : qu'est ce que veut dire "déterminer" dans le défi de base.

Allez, il est 2h du mat par chez moi, je file au lit

[dividee]

Une amélioration de la solution Prolog de Trap D:
les partitions ne sont pas représentées sous forme classique mais sous forme d'un tableau de taille N qui donne le nombre de N, le nombre de N-1, ... jusqu'au nombre de 1 dans la partition. Pas de doublons, donc plus besoin de faire un tri et de les supprimer. L'idée est de résoudre l'équation X1*N + X2*(N-1) + ... +XN*1 = N.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
nbdecomp(N, L) :-
	decomposition(N,X),
	length(X,L).

decomposition(N, L) :-
	bagof(L1, somme(N,N,L1), L).

somme(0, 0, []):- !.
somme(_, 0, _) :- !, fail.
somme(N, M, [N1 | LN]) :-
	Max is N // M,
	between(0, Max, N1),
	N2 is N - M*N1,
	MM is M-1,
	somme(N2, MM, LN).

Avec la version de Trap D, je ne pouvais aller que jusque N=15 avant de remplir le stack; avec cette version je monte jusqu'à 32 et elle est nettement plus rapide.

[dividee]

Et finalement, l'algorithme "naïf" en Prolog. Je pensais que ça allait être plus compliqué à implémenter que dans les langages fonctionnels, mais il n'en est rien! Je trouve même qu'il est plus simple. Le non-déterminisme de Prolog fait merveille ici pour éviter de se coltiner des opérations sur les listes (concat, map,...).

Code :

1
2
3
4
5
6
7
8
9
10
11
12
nbsums(N,L) :- bagof(P,sums(N,P),B), length(B,L).

sums(N,P) :- sumrec(N,N,P).

sumrec(0, _, []) :- !.
sumrec(N, M, P) :-
             between(1,M,I),
             P = [I|R],
             NN is N-I,
             MM is min(I,N-I),
             sumrec(NN,MM,R).

Avec cette version, je monte jusque N=37. Pas de quoi concurrencer les langages fonctionnels mais la simplicité est exemplaire...

edit: N=37, c'est avec un stack de 4MB. En le poussant à 128 MB (le maximum semble-t-il dans SWI-Prolog), je monte à N=57. Cela prend environ 12 secondes pour obtenir la réponse.

[Jedai]

Envoyé par alex_pi

Toujours sur la même bécane, la génération de l'arbre prend 0,26 secondes pour n = .... 1000

Après la question qui se pose c'est : qu'est ce que veut dire "déterminer" dans le défi de base.

Bonne question... Qui démontre bien que tu as conscience que ta solution ne fait pas tout à fait la même chose que les autres (on s'en doute vu la vitesse !). En réalité ce que tu fais, c'est figer l'arbre des appels de fonctions nécessaire pour générer les possibilités. Le parcours nécessaire par la suite pour réellement énumérer les possibilités prend toujours pas mal de temps... En témoigne le fait que si j'affiche ton arbre, ton programme prend 3 fois plus de temps que mon programme avec itérateur (dans les deux cas en redirigeant la sortie vers nul).

Dans ce second message plutôt qu'un véritable arbre, tu fais un DAG (Directed Acyclic Graph), en fait cette compression correspond à ce qui se passe réellement dans les versions mémoizé des codes fonctionnels, sauf que dans leur cas, le sous parcours aussi est mémoizé, pas avec ton système.

Ton code a cependant le bénéfice de faire apparaître certaines symétries cachées du modèle, et d'offrir une représentation compressée de la solution. Au fait, on peut en faire une version purement fonctionnelle, et ne souffrant pas des petits défauts de ta variable globale pour la mémoization par exemple :

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
{-# -fbang-patterns -funbox-strict-fields #-}
module Main where
import Data.Array
import Data.List
import System

data Tree = Branch !Int [Tree]
          deriving Show

sums n = a ! (n,n)
    where
      a = array ( (0,0), (n, n) ) $ ( (0,0), [] ) : populateList
      populateList = [((k,l), [Branch x $ a!(k-x, min (k-x) x)| x<-[1..l] ])
                      | k<-[1..n], l<-[1..k]]

pathsM f lot = aux f lot []
    where
      aux f [] path = f path
      aux f lob ppath = mapM_ (\(Branch i lob') -> aux f lob' (i:ppath)) lob

foldPaths f r lot = aux f lot r []
    where
      aux f [] v path = f v path
      aux f lob pv ppath = 
          foldl' (\a (Branch i lob') -> aux f lob' a (i:ppath)) pv lob

main = print . foldPaths (\a _ -> a + 1) 0 . sums . read . (!!0) =<< getArgs
-- main = pathsM print . sums . read . (!!0) =<< getArgs

(pathsM n'est pas vraiment nécessaire, si ce n'est pour l'affichage, et foldPaths n'est pas indispensable non plus, on pourrait mesurer la taille avec pathsM et une IORef, mais c'est plus propre ainsi je trouve)

--
Jedaï

Envoyé par Jedai

Bonne question... Qui démontre bien que tu as conscience que ta solution ne fait pas tout à fait la même chose que les autres (on s'en doute vu la vitesse !).

Ca dépend ce que l'on entend par "faire la même chose que les autres" Si toutes les solutions faisaient rigoureusement la même chose, ça n'aurait aucun sens de comparer ! Les autres retournent une représentations de chacune des suite de nombre possibles, moi aussi. Ca peut se voir en constatant que pour chaque suite de nombre répondant à la contrainte "la somme vaut n et ils sont rangés par ordre décroissant", il existe (une unique) feuille telle que le parcours depuis la racine vers cette feuille est étiqueté par cette liste, et inversement, que pour toute feuille, le chemin depuis la racine est étiqueté par une liste validant cette contrainte.
Et si ce qui vous chagrine, c'est que je n'affiche pas le nombre de feuille :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
type tree = subtree list
and subtree = { tag : int;
		son : tree}

let memo = ref (Array.make_matrix 0 0 None)

let init_memo n = 
  memo := Array.make_matrix (n + 1) (n + 1) None

let extract_memo n cut = 
  !memo.(n).(cut)

let insert_memo n cut l = 
  !memo.(n).(cut) <- Some l

let rec build_tree n cut =
  if (cut = 0) then ([],0)
  else 
    match extract_memo n cut with
      | None -> 
	 let sub_tree, count = build_sub_tree n cut in
	 let tail, count' = build_tree n (cut - 1) in
	 let res = ((sub_tree :: tail), count + count') in
	 insert_memo n cut res;
	 res
      | Some r -> r
and build_sub_tree n cut =
    if n = cut then
      ({tag = cut; son = []}, 1)
    else
      let n' = n - cut in
      let t, count = build_tree n' (min cut n') in 
	({ tag = cut;
	  son = t }, count)

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 count = ref 0

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

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

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

let _ = print_int nbr

(*let _ = print_tree [] t
let _ = print_int !count
*)

En réalité ce que tu fais, c'est figer l'arbre des appels de fonctions nécessaire pour générer les possibilités. Le parcours nécessaire par la suite pour réellement énumérer les possibilités prend toujours pas mal de temps... En témoigne le fait que si j'affiche ton arbre, ton programme prend 3 fois plus de temps que mon programme avec itérateur (dans les deux cas en redirigeant la sortie vers nul).

Moui fin là je tiens à préciser que le printer est *particulièrement* naif !

Dans ce second message plutôt qu'un véritable arbre, tu fais un DAG (Directed Acyclic Graph)

Précision que vu que c'est une structure fonctionnelle pure, du point de vue du programme acceptant le résultat, ça peut parfaitement être vu comme un arbre on ne peut plus classique !

[Jedai]

Envoyé par alex_pi

Précision que vu que c'est une structure fonctionnelle pure, du point de vue du programme acceptant le résultat, ça peut parfaitement être vu comme un arbre on ne peut plus classique !

Effectivement, mais pour l'occupation en mémoire c'est important de distinguer les deux cas.

Je sais que l'ensemble des solutions est compris dans ton arbre, mais une fois dit ça, je peux affirmer que même sans l'exécuter la définition de ma fonction récursive "contient" l'intégralité des possibilités, et son occupation mémoire est encore moindre que ton arbre... L'argument est légèrement spécieux.
Par ailleurs tu dis que le printer est naïf ? L'est-il tant que ça ? Comment l'améliorerais-tu ? (personnellement j'utiliserais bien un zipper, mais je pense pas que ça améliore les performances, ça devrait simplement permettre de créer un itérateur sur l'arbre)
Ton dernier programme calcule effectivement le nombre de solutions, mais il ne le fait pas de la même façon que les autres programmes, c'est à dire en comptant une par une chacune des possibilités, autrement dit, je suis à peu près sûr, que le code suivant est plus rapide encore :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
module Main where
import Data.Array
import System

countsums n = a!(n,n)
    where
      a = array ((0,0),(n,n)) $ ((0,0),1) : countList
      countList = 
          [( (k,l), foldl (\c x -> c + (a!(k-x, min (k-x) x))) 0 [1..l])
               | k<-[1..n], l<-[1..k]]

main = print . countsums . read . (!!0) =<< getArgs

Puisqu'il n'a pas à se préoccuper de construire un arbre qu'il n'utilise pas vraiment (sinon implicitement).

--
Jedaï

Je sais que l'ensemble des solutions est compris dans ton arbre, mais une fois dit ça, je peux affirmer que même sans l'exécuter la définition de ma fonction récursive "contient" l'intégralité des possibilités, et son occupation mémoire est encore moindre que ton arbre... L'argument est légèrement spécieux.

Euh, disons que j'ai une représentation physique des listes demandées, alors que la fermeture de ta fonction non. Et puis de toutes façons, pour stocker les 1024150064776551375119256307915896842122498030313150910234889093895 (rien que ça... quelqu'un a la formule d'ailleurs ? Ca doit pas être bien compliqué, mais j'arrive pas à mettre le doigt dessus) listes résultant de la décomposistion de 4000, j'étais bien obligé d'optimiser un peu :-p Mais encore une fois, j'insiste sur le fait que je suis conscient que le sujet du défi était très vague et que j'en ai "abusé". A charge de revanche sur le prochain ;-)

Par ailleurs tu dis que le printer est naïf ? L'est-il tant que ça ?

Bah typiquement, au lieu de faire mumuze avec des liste, je pourrais avoir un string_buffer, pour ne pas réécrire les débuts à chaque fois. Mais le but n'était pas là :-)

[strate]

Quelques remarques :

(1) Le problème est suffisamment simple pour qu'il soit possible d'énumérer les solutions plutôt que de les chercher. Concrètement ça veut dire qu'il est possible d'écrire un programme qui ne contient pas de test du type if(somme == n).

L'idée est la suivante : on génère les solutions s = s_1..s_i..s_k de longueur k, strictement décroissantes (s_(i+1) <= si). Si on a déjà généré la partie s_1..s_(i-1), on peut déterminer les valeurs minimales et maximales que peut prendre s_i pour obtenir une solution, et chaque de ces valeurs contribue à une solution. Je vous laisse poser les équations.

L'algorithme consiste donc tout simplement, pour chaque valeur de k, à parcourir les valeurs entre min et max, puis à avancer à l'élément suivant. Il est optimal dans le sens où le travail effectué est exactement proportionnel au nombre de solutions.

(2) Si on veut comparer des performances, il faut comparer des choses comparables. Je serais tenté de rajouter à l'énoncé que le programme doit stocker les solutions sous une forme telle que tableau, liste chaînée ou arbre, avec la contrainte que l'affichage d'une solution doit se faire en temps linéaire par rapport à la taille de la solution (sinon ça veut dire qu'une partie du travail est fait lors de l'affichage, et donc pas compté dans les performances mesurées).

(3) Petite remarque sur l'énoncé : les solutions qu'on recherche sont des multiensembles, pas des ensembles (l'ensemble {1, 1, 1} est le même que l'ensemble {1}).

[gorgonite]

et bienvenue,

et as-tu quelque chose à proposer pour apporter une solution "utilisable" et si possible élégante ?

[dividee]

Envoyé par strate

(1) Le problème est suffisamment simple pour qu'il soit possible d'énumérer les solutions plutôt que de les chercher. Concrètement ça veut dire qu'il est possible d'écrire un programme qui ne contient pas de test du type if(somme == n).

L'idée est la suivante : on génère les solutions s = s_1..s_i..s_k de longueur k, strictement décroissantes (s_(i+1) <= si). Si on a déjà généré la partie s_1..s_(i-1), on peut déterminer les valeurs minimales et maximales que peut prendre s_i pour obtenir une solution, et chaque de ces valeurs contribue à une solution. Je vous laisse poser les équations.

L'algorithme consiste donc tout simplement, pour chaque valeur de k, à parcourir les valeurs entre min et max, puis à avancer à l'élément suivant. Il est optimal dans le sens où le travail effectué est exactement proportionnel au nombre de solutions.

Je ne vois pas très bien en quoi cela différe de l'algorithme "naïf" utilisé depuis le début de ce thread, même si c'en est certainement la description la plus claire. Il s'agit bien d'une énumération et pas d'une recherche puisque toutes les branches du calcul retournent une solution. C'est particulièrement évident en regardant le code des programmes qui utilisent les "list comprehensions".

Je crois qu'il serait plus précis de dire que le travail effectué est proportionnel au nombres de noeuds de l'arbre généré par cette méthode. Seules les feuilles de cet arbre sont des solutions. Je ne sais pas si cela a une influence sur la complexité asymptotique (à confirmer), mais cela permet d'expliquer que les programmes qui mémorisent les sous-arbres déjà générés sont plus rapides parce qu'ils évitent de reparcourir les noeuds internes de ces sous-arbres (ils "remontent" les solutions ou morceaux de solutions dans l'arbre).

edit: J'aurais plutôt du dire: Ils fusionnent les sous-arbres menant à des queues de solution communes et remontent les queues de solutions au niveau des racines de ces sous-arbres.

[strate]

Envoyé par dividee

Je ne vois pas très bien en quoi cela différe de l'algorithme "naïf" utilisé depuis le début de ce thread, même si c'en est certainement la description la plus claire.

Maintenant que tu le dis, oui effectivement certains des algorithmes décrits sont de ce type. Je n'avais que survolé le thread et vu surtout les algorithmes où on génére toutes les possibilités puis on élimine celles qui ne conviennent pas. Mais c'est vrai aussi que c'est pas plus mal de comprendre pourquoi ça marche en accompagnant le code d'une description intuitive.

Remarque que coté performances, c'est encore le programme en C de type génération et test qui reste numéro 1

[gorgonite]

Envoyé par strate

Remarque que coté performances, c'est encore le programme en C de type génération et test qui reste numéro 1

ce n'est pas le C++ qui est le meilleur pour le moment ?

Envoyé par gorgonite

ce n'est pas le C++ qui est le meilleur pour le moment ?

Mais pourquoi personne n'aime mon code :'(

[gorgonite]

Envoyé par alex_pi

Mais pourquoi personne n'aime mon code :'(

quel est le rapport ?

la version C++ de millie est la plus rapide pour le moment... c'est tout

Envoyé par gorgonite

quel est le rapport ?

la version C++ de millie est la plus rapide pour le moment... c'est tout

Le rapport est justement que ma version avec mémoization est plusieurs ordre de grandeur plus rapide :-) (complexité completement différente en faite je pense, mais j'ai pas calculé)

[gorgonite]

Envoyé par alex_pi

Le rapport est justement que ma version avec mémoization est plusieurs ordre de grandeur plus rapide :-) (complexité completement différente en faite je pense, mais j'ai pas calculé)

as-tu vérifié l'algo qu'il a utilisé ? http://www.developpez.net/forums/sho...0&postcount=55

parce que lui non plus ne stocke pas toutes les solutions...

Envoyé par gorgonite

as-tu vérifié l'algo qu'il a utilisé ? http://www.developpez.net/forums/sho...0&postcount=55

parce que lui non plus ne stocke pas toutes les solutions...

Test fait, pour n = 100, millie 0.147, moi 0.007, et pour n = 500, millie 26,5, moi 0,133. Et c'est là que j'ai tilté, en me rappelant que poru n = 500, on dépasse largement les 2^32 solution... Etrange qu'il arrive à les énumérer en moins d'une minute ;-)

Donc en creusant un peu, la solution de millie ne marche pas. Pour n = 8, il n'affiche ni [4, 3, 1] ni [3, 3, 1, 1]. Et pour n = 100, il retourne 122072 solution alors qu'il y en a 2300165032574323995027.

[gorgonite]

Envoyé par alex_pi

Donc en creusant un peu, la solution de millie ne marche pas. Pour n = 8, il n'affiche ni [4, 3, 1] ni [3, 3, 1, 1]. Et pour n = 100, il retourne 122072 solution alors qu'il y en a 2300165032574323995027.

tiens bizarre que ça n'ait pas buggé avant n=8


je vais vérifier... exact, ça plante aussi à n=7

[millie]

J'ai dû faire une mise à jour foireuse l'autre fois. Je regarderai ça ce soir.

[Jean-Marc.Bourguet]

Avant de lire vos propositions, la mienne (en C++)

Code C++ :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
#include <stdlib.h>
#include <ctype.h>
#include <iostream>
#include <ostream>
#include <vector>
#include <algorithm>
 
#ifdef COUNT_ONLY
long solutions = 0;
#endif
 
void consume(std::vector<long> const& tab)
{
#ifdef COUNT_ONLY
    ++solutions;
#else
    std::cout << tab[0];
    for (std::vector<long>::size_type i = 1; i < tab.size(); ++i)
    {
        std::cout << ", " << tab[i];
    }
    std::cout << '\n';
#endif
}
 
void generate(long val)
{    
    std::vector<long> result;
    long remainder = val;
    long last = val;
    result.reserve(val);
    do {
        while (remainder != 0) {
            last = std::min(last, remainder);
            result.push_back(last);
            remainder -= last;
        }
        consume(result);
        remainder = 0;
        do {
            last = result.back();
            result.pop_back();
            remainder += last;
        } while (last == 1 && !result.empty());
        --last;
    } while (last != 0);
}
 
int main(int argc, char** argv)
{
    if (argc != 2) {
        std::cerr << "Usage: " << argv[0] << " num\n";
        return EXIT_FAILURE;
    }
    char* endptr;
    long val = strtol(argv[1], &endptr, 0);
    while (isspace(*endptr))
        ++endptr;
    if (argv[1] == '\0' || *endptr != '\0' || val < 1) {
        std::cerr << "Bad number: " << argv[1] << '\n';
        return EXIT_FAILURE;
    }
 
    generate(val);
#ifdef COUNT_ONLY
    std::cout << solutions << " solutions\n";
#endif
}