Précédent   Forum du club des développeurs et IT Pro > Autres langages > Langages fonctionnels
Langages fonctionnels Forum d'entraide sur la programmation en langages fonctionnels : Lisp, Scheme, Caml, Haskell, Erlang, Oz, Anubis, ...
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse
 
Outils de la discussion
Publicité
'
Vieux 12/04/2009, 23h39   #121
Garulfo
Inactif
 
Inscription : juillet 2005
Messages : 1 958
Détails du profil
Informations personnelles :
Âge : 47

Informations forums :
Inscription : juillet 2005
Messages : 1 958
Points : 2 209
Points : 2 209
Citation:
Envoyé par InOCamlWeTrust Voir le message
[...]
Autre conseil : ne suis pas les "conseils" de Knuth. Ses algorithmes sont inutilement compliqués. On peut faire tout aussi mieux sans pile ni impérativité.
Knuth n'est effectivement pas un modèle à suivre. Il écrit du code illisible, sans conception, complètement incompréhensible, mais qui marche du premier coup ou presque -_- En tout cas, il est une exception
Garulfo est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 13/04/2009, 13h06   #122
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
Je parlais plus des algorithmes en eux-mêmes que des codes. Knuth possède une façon de raisonner quasi-exclusivement tournée vers l'impérativité, et programme selon des dogmes qui aujourd'hui sont faux : gestion de pile à la main parce que c'est soi-disant plus rapide, tableaux dans tous les sens, méthode de la sentinelle qui n'est quasiment jamais applicable, etc...

Pour ses codes, je suis d'accord, ils sont tout simplement affreux. Mais je ne suis pas sûr qu'ils aient marché du premier coup lorsqu'il les a écrits !

Cependant, si il y a une chose a retenir des publications de Knuth sur le sujet, c'est la borne supérieure pour la hauteur d'un AVL : c'est très intéressant pour connaître la taille maximale, à l'octet près, de la pile. C'est nécessaire lorsque l'on doit programmer des fonctions que l'on ne peut faire sans gestion de pile explicite, même en style fonctionnel, comme la comparaison de deux AVL.
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 13/04/2009, 16h13   #123
SpiceGuid
Rédacteur
 
Avatar de SpiceGuid
 
Homme Damien Guichard
Inscription : juin 2007
Messages : 1 512
Détails du profil
Informations personnelles :
Nom : Homme Damien Guichard
Localisation : France, Loire (Rhône Alpes)

Informations forums :
Inscription : juin 2007
Messages : 1 512
Points : 2 495
Points : 2 495
C'est pareil du côté de Niklaus Wirth (Algorithms and Data Structures), pas utilisable car le code est trop impératif pour du Caml.

Citation:
ce ne sont pas des AVL : la grande caractéristique des AVL est qu'il n'est pas nécessaire de stocker la hauteur, mais juste l'équilibrage (gauche, équilibré ou droit). En effet, la différence de hauteur entre les deux jambes étant d'au plus un, cette information suffit.
La grande caractéristique d'un AVL c'est qu'il n'est jamais plus profond qu'un arbre de Fibonacci.
On peut éventuellement coder l'équilibrage sur 2 bits (et même placer cette information dans les bits de poids faible du pointeur puisque tout pointeur 32bits est un multiple de 4). J'ai opté pour une solution différente, à savoir utiliser set_left et set_right de façon à ne pas calculer la hauteur des arbres vides. À mon avis ça rend le code plus lisible, c'est important pour une rubrique "code source".

Pour ce qui est de la performance :
  • je ne vois pas l'intérêt à comparer une implantation impérative avec une implantation fonctionnelle
  • je n'ai pas d'autre implantation impérative pour faire une comparaison
  • quel échantilon suis-je sensé tester ? une insertion de clés randomisées ? dans ce cas un ABR est plus performant qu'un AVL. donc on teste un cas qu'en fait on éviterait en pratique. une insertion de clés croissantes ? dans ce cas un arbre de Braun est plus performant qu'un AVL. alors quel échantillon ?
  • je ne me sens en concurrence ni avec les implantations en C ou en Haskell, ni avec les implémentations en Caml qui n'existent pas (arbres de Braun) ou que personne n'a jamais vu (même sous forme compilée)
gorgonite m'a déjà demandé de faire des tests de performance sur mon arbre de Braun. Ça ne sert à rien si on ne me dit ni contre quelle implantation impérative ni avec quel échantillon.
Il faut arrêter l'exigence kafkaienne des benchs que je devrais faire contre du code qui n'a rien à voir ou contre le code que vous gardez pour vous.

Citation:
Il est, malheureusement, très rare de voir une librairie complète contenant une véritable implantation efficace de cette merveilleuse structure de données.
Vu l'orientation 'pure' de la stdlib, OCaml-Reins et OCaml batteries la pénurie d'implantations impératives est là pour durer.

Citation:
Le gros avantage des AVL réside dans leur performance : il est donc inutile d'en implanter si on peut avoir mieux avec autre chose.
On peut forcément avoir mieux avec autre chose quand l'ordre d'insertion n'est pas favorable aux AVL. L'optimisation ne peut que bouger la limite au delà de laquelle l'AVL n'est plus le meilleur choix même si c'est un très bon choix sur un très large spectre.

Citation:
les fonctions sur AVL ne sont d'aucune utilité si elles ne sont pas accompagnées d'une fonction de suppression d'élément (c'est en fait LA fonction difficile à implanter)
Il me manque plus que la suppression. Je ne peux pas prendre en compte tes conseils d'implantation si je n'ai pas la garantie qu'ils ne rendront pas encore plus difficile l'équilibrage dans les opérations ensemblistes union / intersection / différence. L'opération d'union a une importance particulière, elle permet une insertion groupée bien plus rapide qu'élément par élément.
__________________
Du même auteur: le cours OCaml, le dernier article publié, le projet, le blog dvp et le jeu vidéo.
Avant de poser une question je lis les règles du forum.
SpiceGuid est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 14/04/2009, 22h11   #124
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
A tes commentaires je vois que, malgré ta vraie volonté de bien faire et surtout de progresser, tu manques cruellement d'expérience.

Je vais essayer de répondre en plusieurs points.


1- J'ai rien compris quand tu parles de set_left ou set_right.

Bien-sûr qu'il ne faut pas calculer la hauteur (qui est une opération en Thêta(log n) dans ce cas, par opposition aux arbres binaires normaux) ! Mais la SEULE information dont tu as besoin est l'équilibrage : mettre la hauteur, c'est tout simplement ajouter de la complexité à des algorithmes qui n'en ont pas besoin (car à chaque rééquilibrage il faudra faire attention à mettre à jour la donnée). Mettre à jour un équilibrage, c'est 1000 fois plus simple.

De plus, n'oublie pas que les gens regardent le code avant de l'utiliser (c'est mon cas) : si tu tombes sur des gens qui s'y connaissent (et il y en a un paquet) et qui tombent sur des AVL stockant la hauteur à chaque noeud, je peux te garantir qu'ils ne chercheront pas à aller plus loin. Pourquoi ? Tout simplement parce que stocker une hauteur quand tu as besoin de stocker 3 valeurs au plus, c'est stocker des données inutiles, et ça ne jette pas beaucoup de crédit sur le développeur...


2- Concernant la performance
Ne fait surtout pas l'impasse sur les tests de performance. Si une librairie AVL (je précise bien AVL) n'est pas performante, ou si il existe un gros gap par rapport, par exemple, à une fonctionnalité équivalente de la librairie standard, tu peux être sûr que personne ne l'utilisera. Personne n'utilisera une librairie AVL tout simplement parce que c'est des AVL et que ça fait joli. On utilise des AVL parce qu'il s'agit de la structure de données entièrement dynamique (donc hors tables de hachage) la plus performante dans le cas général. C'est pas pour rien si on va l'utiliser jusques dans les OS comme Solaris !

Pour procéder, je te conseille de commencer par tester ton implantation (impérative) contre l'implantation de la librairie standard (entièrement fonctionnelle, donc en principe beaucoup plus lente). Si tu ne gagnes rien en termes de performances (utilise des données TRES grandes, jusqu'à bourrer toute ta mémoire, mais sans arriver au swap), alors ton code est intrinsèquement lent et mauvais.

Sinon, si ton code est plus rapide, je te conseille d'en implanter une version entièrement fonctionnelle. Si elle est plus rapide, c'est bon, sinon, il faudra que tu travailles jusqu'à être plus rapide que la librairie standard (il le faut, sinon ça sert à rien !). Tu pourras alors répercuter les modifications sur la version impérative : tu devrais alors beaucoup gagner en vitesse.

Les tests doivent être de toutes natures : aléatoires, éléments répétés (pour voir si ils sont dupliqués ou non), en ordre croissant ou pas, ensembles vides... enfin tout, quoi ! Et pour insérer des éléments croissants (ou décroissants), je connais une structure imbattable : la liste ! Pour ce qui est des autres arbres cités, je pense que si on les coupait on ferait un joli feu de bois !

Garde à l'esprit que personne n'utilisera une librairie AVL si elle n'est pas plus rapide que ce qui existe déjà.


3- Il te manque ENCORE la suppression. Crois-moi, c'est beaucoup plus délicat que l'insertion. Une fonction de validation te sera d'un grand secours.

D'autant plus que sans cette fonction, on ne peut rien faire.

L'autre fonction difficile (très courte quand elle est bien écrite, mais délicate) est la comparaison de deux ensembles. L'union, l'intersection etc... devraient prendre moins de temps qu'ouvrir une canette de Coca.
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/04/2009, 17h44   #125
SpiceGuid
Rédacteur
 
Avatar de SpiceGuid
 
Homme Damien Guichard
Inscription : juin 2007
Messages : 1 512
Détails du profil
Informations personnelles :
Nom : Homme Damien Guichard
Localisation : France, Loire (Rhône Alpes)

Informations forums :
Inscription : juin 2007
Messages : 1 512
Points : 2 495
Points : 2 495
Au point où j'en suis je vais me contenter d'une version correcte.
On verra plus tard pour les perfs.

Est-ce que ce code te paraît correct
(moyennant les fonctions d'équilibrage appropriées)
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
module MakeBase (Ord: Ordered)
=
struct

  type key = Ord.ordered
  type 'a tree =
    'a node option
  and 'a node =
    {
    mutable left: 'a tree; mutable right: 'a tree; mutable height: int;
    key: key; mutable item: 'a;
    }

  (* mutable *)
    
  let balance n =
    n (* but balanced *)

  let insert k x t =
    let result = ref true in
    let rec loop t =
      match t with 
      | None ->
          {left = None; right = None; height = 1; key = k; item = x}
      | Some n -> 
          if Ord.compare k n.key < 0 then
            (n.left <- Some (loop n.left); balance n)
          else if Ord.compare k n.key > 0 then
            (n.right <- Some (loop n.right); balance n)
          else begin
            n.item <- x; result := false; n
          end
    in Some (loop t), !result    

  let rec remove_min t =
    match t.left with
    | None   -> t,t.right
    | Some n -> let m,l = remove_min n in t.left <- l; m,Some (balance t)

  let rec remove k = function
    | None ->
        None
    | Some n -> 
        if Ord.compare k n.key < 0 then
          (n.left <- remove k n.left; Some (balance n))
        else if Ord.compare k n.key > 0 then
          (n.right <- remove k n.right; Some (balance n))
        else
          match n.left,n.right with
          | None,t | t,None -> t
          | l,Some t ->
              let m,r = remove_min t in
              m.left <- l; m.right <- r;
              Some (balance m)

  (* immutable *)
        
  let balanced l k x r =
    Some {left = l; right = r; height = 1; key = k; item = x}
    (* but balanced *)

  let rec add k x = function
    | None ->
        Some {left = None; right = None; height = 1; key = k; item = x}
    | Some n -> 
        if Ord.compare k n.key < 0 then
          balanced (add k x n.left) n.key n.item n.right
        else if Ord.compare k n.key > 0 then
          balanced n.left n.key n.item (add k x n.right)
        else
          Some {n with item = x}
          
  let rec delete_min t = 
    match t.left with
    | None   -> t.key,t.item,t.right
    | Some n -> let k,x,l = delete_min n in k,x,balanced l t.key t.item t.right
    
  let rec delete k = function
    | None ->
        None
    | Some n -> 
        if Ord.compare k n.key < 0 then
          balanced (delete k n.left) n.key n.item n.right
        else if Ord.compare k n.key > 0 then
          balanced n.left n.key n.item (delete k n.right)
        else
          match n.left,n.right with
          | None,t | t,None -> t
          | l,Some t ->
              let k,x,r = delete_min t
              in  balanced l k x r

end
Citation:
L'union, l'intersection etc... devraient prendre moins de temps qu'ouvrir une canette de Coca.
C'est tant mieux. Tu vas pouvoir m'expliquer pourquoi tout ce que je n'ai pas compris. Par exemple pourquoi le union de Set.Make ne fait qu'un seul split tandis que le union de Implementing Sets Efficiently in a Functional Language en fait deux ?
__________________
Du même auteur: le cours OCaml, le dernier article publié, le projet, le blog dvp et le jeu vidéo.
Avant de poser une question je lis les règles du forum.
SpiceGuid est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/04/2009, 23h13   #126
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
Je suis réellement désolé SpiceGuid, mais ce que tu as fait n'a réellement rien à voir avec des AVL, même si je n'en conteste absolument pas la cohérence et le fait que le code soit juste. Je me demande même si on parle bien de la même chose.

Les AVL sont caractérisés par le fait que sous-arbre droit et gauche sont de hauteur différant d'au plus un, de sorte que l'on conserve la donnée d'équilibrage au niveau des noeuds. Pas la hauteur, car ça sert à rien. L'insertion et suppression demandent de faire des rotations en cascade suivant les positions et équilibres des noeuds courants N et de ceux aux niveaux N-1 et N-2. Je ne reconnais pas vraiment ces opérations dans ton code.

Pour ce qui est de l'algorithme de suppression, je confirme qu'il est beaucoup plus long et difficile que ce que tu as fait. Au passage, si je retourne sur la Linux de mon vieil ordinateur, je pourrais te faire suivre ce que j'avais fait à l'époque, tant en C qu'en OCaml.

Enfin, concernant l'union et ses copains, une simple itération sur les éléments du premier AVL composée avec l'insertion dans le deuxième arbre suffit à avoir des résultats corrects. Il existe peut-être, pour les AVL, des algorithmes plus fins, mais j'aimerais bien savoir si en termes de complexité temporelle, donc asymptotique, on y gagne vraiment, du fait des nombreuses rotations que l'on doit opérer pour maintenir la structure équilibrée. Naïvement, on est en O(n log m), ce qui me laisse penser qu'il s'agit d'une complexité déjà optimale étant donné que la structure finale DOIT ETRE un arbre ed tri... donc qu'il s'agit, indirectement, d'un algorithme de pseudo-tri.
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/04/2009, 19h22   #127
SpiceGuid
Rédacteur
 
Avatar de SpiceGuid
 
Homme Damien Guichard
Inscription : juin 2007
Messages : 1 512
Détails du profil
Informations personnelles :
Nom : Homme Damien Guichard
Localisation : France, Loire (Rhône Alpes)

Informations forums :
Inscription : juin 2007
Messages : 1 512
Points : 2 495
Points : 2 495
Citation:
Les AVL sont caractérisés par le fait que sous-arbre droit et gauche sont de hauteur différant d'au plus un
Nous parlons bien de la même chose.
C'est juste que c'est mon style qui perturbe tes repères.
Les algos sont exactement les mêmes que pour un arbre non-équilibré, il suffit simplement d'ajouter un appel à une fonction d'équilibrage.
La suppression ne présente aucune difficulté particulière, c'est l'algo habituel pour un arbre binaire.
C'est pareil dans OCaml-Reins, dans les tutoriels en Java et partout ailleurs où l'on cherche la lisibilité maximale.
http://prevert.upmf-grenoble.fr/Prog...arbresAVL.html


Les opérations ensemblistes rapides sont codées à l'aide de l'opération de fission (voir mon code merge/divide du post #79).
Et elles sont vraiment plus rapides que la version naive.
L'union rapide est particulièrement utile puisqu'elle permet d'accélérer l'insertion par lot.
Quand tu dois fusionner deux ensembles triés cette opération n'est pas un tri (c'est le principe à la base du tri-fusion).
__________________
Du même auteur: le cours OCaml, le dernier article publié, le projet, le blog dvp et le jeu vidéo.
Avant de poser une question je lis les règles du forum.
SpiceGuid est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 17/04/2009, 10h56   #128
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
Tu as raison pour l'union : ce n'est pas un algorithme de tri.

Par contre, je ne comprends pas ton raisonnement en ce qui concerne les AVL. Où effectues-tu les opérations d'équilibrage et de rotation des sous-arbres ?

Je continue à dire, parce que je l'ai vu de nombreuses fois, parce que je l'ai pratiqué et parce que j'ai vu beaucoup de biblitohèques sans cette fonction, que la suppression est de loin plus délicate que l'insertion. Même Knuth, dont le style de programmation est contestable mais dont le travail sur la question en termes de résultats et d'algorithmes est remarquable, la qualifie de complexe. Tu ne peux pas la coder en deux coups de cuillère à pot.
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 17/04/2009, 14h34   #129
SpiceGuid
Rédacteur
 
Avatar de SpiceGuid
 
Homme Damien Guichard
Inscription : juin 2007
Messages : 1 512
Détails du profil
Informations personnelles :
Nom : Homme Damien Guichard
Localisation : France, Loire (Rhône Alpes)

Informations forums :
Inscription : juin 2007
Messages : 1 512
Points : 2 495
Points : 2 495
L'astuce c'est d'utiliser un constructeur "équilibré".

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
  let balance n =
    match n.left,n.right with
    | None,None -> 0
    | Some t,None -> t.height 
    | None,Some t -> - t.height
    | Some a,Some b -> a.height - b.height
    
  let node l k x r =    
    Some {
    left = l; right = r; key = k; item = x;
    height = match l,r with
           | None,None -> 1
           | Some t,None | None,Some t -> t.height + 1 
           | Some a,Some b -> max a.height b.height + 1 }
  
  let rotated l k x r =
    let rotated_left a =
      match a.right with
      | Some b when balance a < 0 ->
        (* double left rotation *)
        node (node a.left a.key a.item b.left) b.key b.item (node b.right k x r)
      | _ ->
        (* simple left rotation *)
        node a.left a.key a.item (node a.right k x r)
    and rotated_right c =
      match c.left with
      | Some b when balance c > 0 ->
        (* double right rotation *)
        node (node l k x b.left) b.key b.item (node b.right c.key c.item c.right)
      | _ ->
        (* simple right rotation *)
        node (node l k x c.left) c.key c.item c.right
    in
    match l,r with
    | Some a,None when a.height > 1 -> rotated_left a
    | None,Some c when c.height > 1 -> rotated_right c
    | Some a,Some c when a.height > c.height + 1 -> rotated_left a
    | Some a,Some c when c.height > a.height + 1 -> rotated_right c
    | _,_ -> node l k x r
rotated l k x r crée un nouveau noeud avec les sous-arbres l,r la clé k et l'élément x.
Les "1" désignent le différentiel maximal de hauteur entre les sous-arbres l et r.


Après c'est exactement le même code que pour un arbre binaire quelconque.
Sauf que tu remplace tous les constructeurs par rotated, ça suffit pour équilibrer ton arbre, du bas vers le haut.

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
  let rec add k x = function
    | None ->
        Some {left = None; height = 1; right = None; key = k; item = x}
    | Some n -> 
        if Ord.compare k n.key < 0 then
          rotated (add k x n.left) n.key n.item n.right
        else if Ord.compare k n.key > 0 then
          rotated n.left n.key n.item (add k x n.right)
        else
          Some {n with item = x}
          
  let rec delete_min t = 
    match t.left with
    | None   -> t.key,t.item,t.right
    | Some n -> let k,x,l = delete_min n in k,x,rotated l t.key t.item t.right
    
  let rec delete k = function
    | None ->
        None
    | Some n -> 
        if Ord.compare k n.key < 0 then
          rotated (delete k n.left) n.key n.item n.right
        else if Ord.compare k n.key > 0 then
          rotated n.left n.key n.item (delete k n.right)
        else
          match n.left,n.right with
          | None,t | t,None -> t
          | l,Some t ->
              let k,x,r = delete_min t
              in  rotated l k x r
C'est exactement ce que fait la stdlib, sauf que Xavier Leroy a remplacé 1 par 2 pour le différentiel maximal de hauteur. Dans OCaml-Reins c'est un AVL 'généralisé' où le différentiel de hauteur a une valeur fixe quelconque.
__________________
Du même auteur: le cours OCaml, le dernier article publié, le projet, le blog dvp et le jeu vidéo.
Avant de poser une question je lis les règles du forum.
SpiceGuid est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 18/04/2009, 13h04   #130
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
C'est un peu plus clair comme ça, même si je ne suis pas allé vérifier chaque ligne de code.

Cependant, quel avantage à mettre 2 à la place de 1 ?
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 18/04/2009, 15h58   #131
SpiceGuid
Rédacteur
 
Avatar de SpiceGuid
 
Homme Damien Guichard
Inscription : juin 2007
Messages : 1 512
Détails du profil
Informations personnelles :
Nom : Homme Damien Guichard
Localisation : France, Loire (Rhône Alpes)

Informations forums :
Inscription : juin 2007
Messages : 1 512
Points : 2 495
Points : 2 495


http://caml.inria.fr/pub/ml-archives...e0a88c.en.html

Une autre astuce (utilisée par OCaml-Reins) c'est d'ajouter un variant Leaf pour les feuilles, du coup il y a moins de Empty à tester, ça soulage le GC.
Code :
1
2
3
4
  type ('k,'v) tree = 
      | Empty
      | Leaf of 'k * 'v
      | Node of ('k,'v) tree * 'k * 'v * ('k,'v) tree * int
La dernière astuce utilisée par OCaml-Reins c'est la défonctorisation de la comparaison.
Code :
  let add x t = add Ord.compare x t
De cette façon Ord.compare n'est accédée qu'une seule fois (l'appel dans un 'foncteur' est légèrement plus coûteux que l'appel direct).

Si tu n'as pas utilisé ces deux dernières astuces dans ton code alors il te reste encore un peu de marge de progression en performances.
__________________
Du même auteur: le cours OCaml, le dernier article publié, le projet, le blog dvp et le jeu vidéo.
Avant de poser une question je lis les règles du forum.
SpiceGuid est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 19/04/2009, 11h27   #132
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
Moi je retiens de l'article cité plus haut...

Light experimentation suggested that imbalance <= 2 is globally more
efficient than imbalance <= 1


J'essaye de retrouver mon code, alors, car je veux en être convaincu.
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 19/04/2009, 17h42   #133
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
Citation:
Envoyé par SpiceGuid Voir le message


http://caml.inria.fr/pub/ml-archives...e0a88c.en.html

Une autre astuce (utilisée par OCaml-Reins) c'est d'ajouter un variant Leaf pour les feuilles, du coup il y a moins de Empty à tester, ça soulage le GC.
Code :
1
2
3
4
  type ('k,'v) tree = 
      | Empty
      | Leaf of 'k * 'v
      | Node of ('k,'v) tree * 'k * 'v * ('k,'v) tree * int
La dernière astuce utilisée par OCaml-Reins c'est la défonctorisation de la comparaison.
Code :
  let add x t = add Ord.compare x t
De cette façon Ord.compare n'est accédée qu'une seule fois (l'appel dans un 'foncteur' est légèrement plus coûteux que l'appel direct).

Si tu n'as pas utilisé ces deux dernières astuces dans ton code alors il te reste encore un peu de marge de progression en performances.
Je n'ai pas à les utiliser. Je t'avouerais que je n'avais même pas pensé à utiliser de 'a option pour les feuilles et les noeuds. J'ai l'impression que cela ajoute de la lourdeur plus qu'autre chose.

Je donne ici l'implantation que j'avais faite à l'époque, il y a 3 ou 4 ans environ. Je l'ai conservée intacte. Entre autres, il y a tout plein de commentaires plus passionnants les uns que les autres, une licence de la mort-qui-tue, et un style mêlant encore Anglais et Français. Il y a même une fote de conjuguèson.

Le code marche toujours.

Je viens de le tester sur OCaml 3.09.02 en bytecode et ça marche. Le test consistait en l'insertion des entiers 1 à 5 000 000 dans un Set de int, en ordre croissant.

Set standard OCaml : 1 minute 42 secondes
Set AVL fonctionnel : 1 minute 10 secondes
Set AVL impératif : 1 minute 1 seconde

J'attire l'attention sur le fait que les résultats de la version impérative sont peut-être, comparativement aux versions fonctionnelles, en deçà de ce que l'on serait en mesure d'attendre. Le fait vient de l'état de la mémoire au moment des tests des versions fonctionnelles de la librairie standard et de la librairie AVL. La mémoire était, en effet, complètement vide, et le GC majeur n'a certainement pas dû se déclencher très souvent.

@SpiceGuid : cette implantation peut déjà te servir de base pour des tests.

Voilà.

Toutes les remarques sont les bienvenues.
Fichiers attachés
Type de fichier : gz AVL.tar.gz (27,0 Ko, 4 affichages)
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 20/04/2009, 19h17   #134
SpiceGuid
Rédacteur
 
Avatar de SpiceGuid
 
Homme Damien Guichard
Inscription : juin 2007
Messages : 1 512
Détails du profil
Informations personnelles :
Nom : Homme Damien Guichard
Localisation : France, Loire (Rhône Alpes)

Informations forums :
Inscription : juin 2007
Messages : 1 512
Points : 2 495
Points : 2 495
Beaucoup de warnings dans ton code.


J'ai testé mon code (uniquement l'insertion): les arbres générés sont corrects et équilibrés.
Mais les benchs sont décevants.
Pourtant avant de les faire j'avais ajouté une optimisation inspirée par ton code: l'équilibrage est court-circuité quand le sous-arbre modifié ne change pas de hauteur.
Avec ça j'espérais dépasser la stdlib mais apparemment la performance dépend de bien d'autres facteurs que l'algorithmique pure.

La 1ière colonne est le temps en secondes pour l'insertion de 5 millions d'entiers décroissants.
La 2nd colonne est le temps en secondes pour l'insertion de 5 millions d'entiers Random.bits.
Chaque test est précédé d'un Gc.full_major().

En bytecode (linux x86, ocaml 3.10) :

Code :
1
2
3
4
5
6
Map.Make            51.135196  81.877118
fAVLMap.Make        26.701668  61.451841
impAVLMap.Make      27.893743  28.505782
AvlTreeMap.Pure     58.855679  190.751921
AvlTreeMap.Mutable  41.026564  49.199075
En code natif (linux x86, ocaml 3.10) :

Code :
1
2
3
4
5
6
Map.Make            3.872241   35.946246
fAVLMap.Make        3.808237   34.574161
impAVLMap.Make      6.25239    6.276393
AvlTreeMap.Pure     13.124819  111.454965
AvlTreeMap.Mutable  13.032813  16.529033

Conclusion:
  • les résultats sont très variables en fonction du profil d'échantillon
  • mon implémentation est mauvaise, et pourtant je n'ai "foiré" nulle part
  • celle de InOCamlWeTrust est la meilleure dans quasiment toutes les configurations

D'une manière générale je trouve que la performance est difficilement prédictible.
Par exemple, en randomisé, ma version fonctionnelle met 111.4 contre 16.5s en impératif, alors que les structures de données et l'algo sont exactement les mêmes. D'ailleurs en entiers décroissants le temps est le même dans les deux cas. Difficile à expliquer. Même chose avec impAVLMap.Make, plus lent que Map.Make sur les entiers décroissants mais plus rapide avec les randomisés, pourquoi ? Mystère.
Ce bench ne me conforte pas dans l'idée de faire des implantations mixtes qui partageraient un maximum de code et d'optimisations. C'était pourtant une idee élégante. Dommage.


Le code du test :

Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
module IntMap = Map.Make(struct type t = int let compare = (-) end)

let rec repeat n f init =
  if n = 0 then init
  else repeat (n-1) f (f n init);;
  
let main size =
  Gc.full_major();  
  let start = Sys.time() in
  let map = IntMap.empty in
  ignore(repeat size (fun n m -> IntMap.add n () m) map);
  print_int size; print_string " decr inserted in ";
  print_float (Sys.time() -. start); print_newline ();
  Gc.full_major();  
  let start = Sys.time() in
  let map = IntMap.empty in
  ignore(repeat size (fun n m -> IntMap.add (Random.bits()) () m) map);
  print_int size; print_string " randoms inserted in ";
  print_float (Sys.time() -. start); print_newline ()
  ;;

main 5000000;;

Autres benchs :
  • les performances de mon arbre de Braun sont encore plus médiocres
  • j'ai essayé (sur mon implantation) ∆h = 2 au lieu de ∆h = 1, les temps sont sensiblement les mêmes (jamais dans le bon sens). j'ai également essayé avec 5000 éléments pour voir si c'est une bonne idée sur de plus petits échantillons, sans aucun succès, au mieux les performances ne se dégradent pas beaucoup mais je n'ai pas réussi à trouver un cas où elles s'améliorent.
__________________
Du même auteur: le cours OCaml, le dernier article publié, le projet, le blog dvp et le jeu vidéo.
Avant de poser une question je lis les règles du forum.
SpiceGuid est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 20/04/2009, 23h39   #135
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
J'ai développé le code, à l'époque, avec OCaml 3.07. La compilation effectuée avec ma 3.09 dimanche montrait que l'ajout du nouveau warning E dans la distribution faisait apparaître de nombreux warning ne servant à rien. L'option -A est utilisée, donc il est possible que bon nombre de warning inutiles soient lancés à la compilation, surtout si ils ont été ajoutés aux dernières versions. En tous cas, sur la 3.09.02, ça compile sans warning.

Pour ce qui est des tests, ma remarque allait dans le sens du commentaire de SpiceGuid.

A mon avis, il serait intéressant d'étudier ce qui se passe dans le cas croissant ou décroissant. Par contre, pour le random, les résultats sont parfaitement prédictibles. Ce qui est intéressant également est la différence de performance délirante en natif de la version décroissant, entre fonctionnel pur et impératif. Peut-être est-ce un signe que le compilateur optimise mieux de tous petits codes fonctionnels que de gros tas d'instructions effectuées les unes après les autres... mais c'est juste une piste de réflexion.

En ce qui concerne l'implantation, j'espère t'avoir convaincu qu'implanter une structure AVL réellement performante est une tâche pas si facile que ça.

P.S. : j'ai la même en C, au cas où ça intéresserait quelqu'un.
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 29/04/2009, 22h30   #136
SpiceGuid
Rédacteur
 
Avatar de SpiceGuid
 
Homme Damien Guichard
Inscription : juin 2007
Messages : 1 512
Détails du profil
Informations personnelles :
Nom : Homme Damien Guichard
Localisation : France, Loire (Rhône Alpes)

Informations forums :
Inscription : juin 2007
Messages : 1 512
Points : 2 495
Points : 2 495
Après avoir tatonné pendant plusieurs heures (bench puis recodage, en boucle) j'ai finalement réussi à dépasser Map.Make. Ça m'a pris pas mal de temps parce que j'ai suivi toutes les fausses pistes imaginables. Par exemple j'ai essayé de suivre le conseil de John Harrop (ajouter un variant Leaf pour les feuilles) mais ça n'a pas eu d'effet bénéfique en code natif, bien au contraire. J'ai été bien inspiré d'avoir deux benchs (je dirais même qu'il en faudrait encore plus) parce qu'un code qui améliore un bench le fait assez souvent au détriment de l'autre.

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
  type ('a,'b) tree =
    | Empty
    | Node of ('a,'b) tree * 'a * 'b * ('a,'b) tree * int
        
  let height = function
    | Empty  -> 0 
    | Node (_,_,_,_,h) -> h

  let node l k x r = 
    let lh = height l and rh = height r in
    Node(l,k,x,r,if lh > rh then lh + 1 else rh + 1)        

  let node3 ll lk lx lr k x rl rk rx rr =
    let lh = max (height ll) (height lr) + 1 in
    let rh = max (height rl) (height rr) + 1 in
    Node(Node(ll,lk,lx,lr,lh),k,x,Node(rl,rk,rx,rr,rh),max lh rh + 1) 
  
  let balanced l k x r =
    let lh = match l with Empty -> 0 | Node (_,_,_,_,h) -> h in
    let rh = match r with Empty -> 0 | Node (_,_,_,_,h) -> h in
    if lh > rh + 1 then
      let Node(ll,lk,lx,lr,lh) = l in
      if height ll >= height lr then node ll lk lx (node lr k x r)
      else
      let Node(cl,ck,cx,cr,_) = lr in
      node3 ll lk lx cl ck cx cr k x r
    else if rh > lh + 1 then
      let Node(rl,rk,rx,rr,rh) = r in
      if height rr >= height rl then node (node l k x rl) rk rx rr  
      else
      let Node(cl,ck,cx,cr,_) = rl in
      node3 l k x cl ck cx cr rk rx rr
    else
      Node(l,k,x,r,if lh > rh then lh + 1 else rh + 1) 
        
  let rec add cmp k x = function
    | Empty ->
        Node(Empty,k,x,Empty,1)
    | Node(l,a,b,r,h) -> 
        match cmp k a with 
        | c when c < 0 ->
            let left = add cmp k x l in
            if height left = height l then Node(left,a,b,r,h)
            else balanced left a b r
        | c when c > 0 ->
            let right = add cmp k x r in
            if height right = height r then Node(l,a,b,right,h)
            else balanced l a b right
        | _ -> Node(l,a,x,r,h)
Le bench en bytecode :
Code :
1
2
3
stdlib  51.135196  81.877118
IOCWT   26.701668  61.451841
Spice   37.702356  71.768484
Le bench en code natif :
Code :
1
2
3
stdlib  3.872241   35.946246
IOCWT   3.808237   34.574161
Spice   3.724232   32.386024

Maintenant que j'ai un peu plus confiance dans mes perfs brutes je vais pouvoir retourner à des considérations un peu plus algorithmiques.

Par exemple ni Reins ni la Extlib n'ont le filtrage rapide des structures arborescentes.
L'idée de base ça serait le code ci-dessous (où j'ai omis delete_min vu que je l'ai déjà posté) et de l'adapter pour les arbres équilibrés.

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
  type ('a,'b) tree =
    ('a,'b) node option
  and ('a,'b) node =
    {
    left: ('a,'b) tree; right: ('a,'b) tree;
    key: 'a; item: 'b;
    }

  let concat ta tb =
    if ta = None then tb else 
    match tb with
    | None -> ta
    | Some n ->
	let m,t = delete_min n in
        Some {left = ta; key = m.key; item = m.item; right = t}
       
  let rec filter f = function
    | None -> None
    | Some n ->
        if f n.key n.item then
          Some {
          left = filter f n.left;
          right = filter f n.right;
          key = n.key; item = n.item;
          }
        else        
          concat (filter f n.left) (filter f n.right)
edit

Voici comment procéder pour équilibrer.
Code :
1
2
3
4
5
6
7
8
9
10
11
  let rec filter f = function
    | None -> None
    | Some n ->
        if f n.key n.item then
          Some {
          left = filter f n.left;
          right = filter f n.right;
          key = n.key; item = n.item;
          }
        else        
          concat (filter f n.left) (filter f n.right)
C'est le noeud coloré en rouge qui n'est pas équilibré parce qu'on ne connait rien de la hauteur du fils gauche et du fils droit.

Ce qu'on fait c'est qu'on remplace par un appel à un constructeur join qui créera le même noeud mais cette fois de manière équilibrante :
Code :
1
2
3
4
5
6
7
  let rec filter f = function
    | None -> None
    | Some n ->
        if f n.key n.item then
          Some (join (filter f n.left) n (filter f n.right))
        else        
          concat (filter f n.left) (filter f n.right)
Même chose pour concat, il nous en faut une version équilibrante.

Ce genre de constructeurs équilibrés a été introduit par Stephen Adams dans Implementing Sets Efficiently in a Functional Language.

Leur code ci-dessous est inspiré de la source de Set.Make et adapté pour un container associatif implanté à l'aide d'enregistrements.
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
  let rec join l n r =
    match l,r with
    | None,_ -> add n.key n.item r
    | _,None -> add n.key n.item l
    | Some nl,Some nr ->
        if nl.height > nr.height + 1 then
          balanced nl.left nl (Some (join nl.right n r))
        else if nr.height > nl.height + 1 then
          balanced (Some (join l n nr.left)) nr nr.right
        else
          node l n r

  let concat ta tb =
    match ta,tb with
    | None,t | t,None -> t
    | _,Some b ->
        let m,t = delete_min b in
        Some (join ta m t)
Où :
  • add est l'insertion ordinaire dans un AVL
  • node et balanced sont des constructeurs pour les AVL (voir le code de l'AVL en début de message)
__________________
Du même auteur: le cours OCaml, le dernier article publié, le projet, le blog dvp et le jeu vidéo.
Avant de poser une question je lis les règles du forum.
SpiceGuid est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 30/04/2009, 21h38   #137
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
Si j'en crois une remarque que tu avais faite précédemment, utiliser la fonction de comparaison par l'intermédiaire d'un foncteur est plus lent, même si je n'ai pas fait de test. Qu'en est-il de ton code avec cette façon de faire ? Je serais intéressé de voir la différence, car je n'ai aucune idée d'ordre de gandeur en tête.
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 01/05/2009, 17h37   #138
SpiceGuid
Rédacteur
 
Avatar de SpiceGuid
 
Homme Damien Guichard
Inscription : juin 2007
Messages : 1 512
Détails du profil
Informations personnelles :
Nom : Homme Damien Guichard
Localisation : France, Loire (Rhône Alpes)

Informations forums :
Inscription : juin 2007
Messages : 1 512
Points : 2 495
Points : 2 495
Pour être clair, ce que j'appelle "défonctorisé" c'est à la façon OCaml-Reins (une implantation défonctorisée), pas à la façon ExtLib (une interface défonctorisée).

Plus concrêtement, au lieu de faire ceci :

Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
module MakePure (Ord: Ordered)
=
struct

  type key = Ord.ordered

  type 'a tree =
    | Empty
    | Node of 'a tree * key * 'a * 'a tree * int

  let rec add k x = function ...

end
Je fais cela (qui ne change pas l'interface) :

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
module MakeBase
=
struct

  type ('a,'b) tree =
    | Empty
    | Node of ('a,'b) tree * 'a * 'b * ('a,'b) tree * int
        
  let rec add cmp k x = function ...

end

module MakePure (Ord: Ordered)
=
struct
  
    include MakeBase
     
    type key = Ord.ordered
    type 'a map = (key,'a) tree

    let add k x t = add Ord.compare k x t 
   
end
Résultats en code natif :
Code :
1
2
sans MakeBase  3.728233  33.658103
avec MakeBase  3.636226  33.474091
J'ai fait plusieurs essais pour confirmer, la version défonctorisée est toujours un pouillème plus rapide mais ça ne peut pas faire la différence entre un bon et un mauvais AVL.

Il n'y a qu'un seul moyen de faire un bon AVL, c'est de tout de suite tester l'équilibrage et de ne faire du pattern matching que s'il y a une rotation. Mon code initial, comme celui d'OCaml-Reins, mélangeait le pattern matching et la comparaison de hauteur. C'est dévastateur pour la performance. Il m'a fallu trop de tentatives pour comprendre que la déficience venait du réflexe conditionné qui consiste à filtrer avant toute autre chose.
L'AVL d'OCaml-Reins aggrave son cas :
  • en ajoutant un variant Leaf pour les feuilles, le pattern matching inutile est encore plus lourd
  • en passant partout des paires clé/valeurs de façon à coder son AVLMap exactement comme son AVLSet, trop de création de paires inutiles ça se paye

John Harrop dit avoir un AVL 30% plus rapide, je n'y crois pas fort :
  • soit il a benché en bytecode et alors ça ne veut rien dire pour le code natif
  • soit il n'a qu'un seul bench et il y a le piège qui consiste à tester/optimiser sur un échantillon particulier au détriment des autres

Il est clair pour moi que stocker la hauteur est une source (mineure) d'inefficacité, je ne le fais que parce que :
  • c'est plus systématique et donc moins difficile à coder
  • c'est réutilisable sur d'autres opérations que l'insertion et la suppression
  • le bench montre qu'avec OCaml ça ne fait pas une différence énorme
Ceci dit je ne conteste pas qu'en C la différence puisse être beaucoup plus sensible. Plus un code est optimisé plus les petites optimisations deviennent plus significatives.
__________________
Du même auteur: le cours OCaml, le dernier article publié, le projet, le blog dvp et le jeu vidéo.
Avant de poser une question je lis les règles du forum.
SpiceGuid est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/05/2009, 17h05   #139
InOCamlWeTrust
Membre Expert
 
Avatar de InOCamlWeTrust
 
Inscription : septembre 2006
Messages : 1 036
Détails du profil
Informations forums :
Inscription : septembre 2006
Messages : 1 036
Points : 1 129
Points : 1 129
Citation:
Envoyé par SpiceGuid Voir le message
Il n'y a qu'un seul moyen de faire un bon AVL, c'est de tout de suite tester l'équilibrage et de ne faire du pattern matching que s'il y a une rotation.
Cf. code IOCWT, qui suit l'algorithme originel au pied de la lettre.

Je pense sincèrement qu'en termes d'AVL, on a tout inventé il y a très longtemps déjà. Tu ne fais là que confirmer ce que l'on sait déjà depuis longtemps : rien, mis à part la table de hachage, ne peut battre un vrai AVL.
__________________
When Colt produced the first practical repeating handgun, it gave rise to the saying God created men, but Colt made them equal.
InOCamlWeTrust est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 13/08/2009, 17h10   #140
jvjulien
Invité régulier
 
Inscription : novembre 2004
Messages : 8
Détails du profil
Informations forums :
Inscription : novembre 2004
Messages : 8
Points : 6
Points : 6
Par défaut Sudoku

voici une utilisation du moteur d'inférence en DrScheme

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
#lang scheme/base

(require (planet williams/inference/inference))
;(require "../inference.ss")
(require (lib "list.ss" "srfi" "1"))
(require scheme/mpair)
(provide (all-defined-out))

(define-ruleset sudoku-rules)

;; If there is a board and no cells, initialize the system.
(define-rule (initialize sudoku-rules)
  (board ?board)
  (no (cell . ?))
  ==>
  (printf "initialize:~n")
  (print-board ?board)
  (do ((row 0 (+ row 1)))
    ((= row 9) (void))
    (assert `(digit ,row))
    (do ((column 0 (+ column 1)))
      ((= column 9) (void))
      (let ((value (vector-ref (vector-ref ?board row) column))
            (box (+ (* (quotient row 3) 3)
                    (quotient column 3))))
        (if (eqv? value '_)
            (assert `(cell ,row ,column ,box (1 2 3 4 5 6 7 8 9)))
            (assert `(cell ,row ,column ,box ,value)))))))

;; If all of the cells are numbered, we've succeeded.
(define-rule (rule-1 sudoku-rules)
  (all (cell ?row ?column ?box (?value (number? ?value))))
  (board ?board)
  ==>
  (stop-inference ?board))

;; If a cell has no possible values. we've failed.
(define-rule (rule-2 sudoku-rules)
  (cell ?row ?column ?box (?value (eq? ?value '())))
  ==>
  (fail))

;; If we have a single possible value in a cell,
;;   use it to number the cell.
(define-rule (rule-3 sudoku-rules)
  (?cell <- (cell ?row ?column ?box
                  (?value ;(and (list? ?value) (= (length ?value) 1))
                   (and (pair? ?value) (null? (cdr ?value)))
                   )))
  (board ?board)
  ==>
  (vector-set! (vector-ref ?board ?row) ?column (car ?value))
  (replace ?cell `(cell ,?row ,?column ,?box ,(car ?value))))

;; If a cell is numbered and it conflicts with another numbered cell,
;;   fail.
;(define-rule (rule-4 sudoku-rules)
;    (cell ?row ?column ?box (?value (number? ?value)))
;    (or (cell ?row (?column-1 (not (= ?column-1 ?column))) ?box-1
;              (?value-1 (and (number? ?value-1) (= ?value-1 ?value))))
;        (cell (?row-1 (not (= ?row-1 ?row))) ?column ?box-1
;              (?value-1 (and (number? ?value-1) (= ?value-1 ?value))))
;        (cell ?row-1 ?column-1 (?box (or (not (= ?row-1 ?row))
;                                         (not (= ?column-1 ?column))))
;              (?value-1 (and (number? ?value-1) (= ?value-1 ?value)))))
;  ==>
;    (fail))

(define-rule (rule-4a sudoku-rules)
  (cell ?row ?column ?box (?value (number? ?value)))
  (cell ?row (?column-1 (not (= ?column-1 ?column))) ?box-1
        (?value-1 (and (number? ?value-1) (= ?value-1 ?value))))
  ==>
  (fail))

(define-rule (rule-4b sudoku-rules)
  (cell ?row ?column ?box (?value (number? ?value)))
  (cell (?row-1 (not (= ?row-1 ?row))) ?column ?box-1
        (?value-1 (and (number? ?value-1) (= ?value-1 ?value))))
  ==>
  (fail))

(define-rule (rule-4c sudoku-rules)
  (cell ?row ?column ?box  (?value (number? ?value)))
  (cell ?row-1 ?column-1 (?box (or (not (= ?row-1 ?row))
                                   (not (= ?column-1 ?column))))
        (?value-1 (and (number? ?value-1) (= ?value-1 ?value))))
  ==>
  (fail))

;; If a cell is numbered, remove that number from other cell in the
;; same row, column, or box.
;(define-rule (rule-5 sudoku-rules)
;  (cell ?row ?column ?box
;        (?value (number? ?value)))
;  (or (?cell-1 <- (cell (?row-1 (= ?row-1 ?row))
;                        (?column-1 (not (= ?column-1 ?column)))
;                        ?box-1
;                        (?value-1 (and (pair? ?value-1)
;                                       (memv ?value ?value-1)))))
;      (?cell-1 <- (cell (?row-1 (not (= ?row-1 ?row)))
;                        (?column-1 (= ?column-1 ?column))
;                        ?box-1
;                        (?value-1 (and (pair? ?value-1)
;                                       (memv ?value ?value-1)))))
;      (?cell-1 <- (cell ?row-1
;                        ?column-1
;                        (?box-1 (and (= ?box-1 ?box))
;                                     (or (not (= ?row-1 ?row))
;                                         (not (= ?column-1 ?column)))))
;                        (?value-1 (and (pair? ?value-1)
;                                       (memv ?value ?value-1))))))
;  ==>
;  (replace ?cell-1 `(cell ,?row-1 ,?column-1 ,?box-1
;                          ,(delete ?value ?value-1))))
  
(define-rule (rule-5a sudoku-rules)
  (cell ?row ?column ?box
        (?value (number? ?value)))
  (?cell-1 <- (cell ?row
                    (?column-1 (not (= ?column-1 ?column)))
                    ?box-1
                    (?value-1 (and (pair? ?value-1)
                                   (memv ?value ?value-1)))))
  ==>
  (replace ?cell-1 `(cell ,?row ,?column-1 ,?box-1
                          ,(delete ?value ?value-1))))  

(define-rule (rule-5b sudoku-rules)
  (cell ?row ?column ?box
        (?value (number? ?value)))
  (?cell-1 <- (cell (?row-1 (not (= ?row-1 ?row)))
                    ?column
                    ?box-1
                    (?value-1 (and (pair? ?value-1)
                                   (memv ?value ?value-1)))))
  ==>
  (replace ?cell-1 `(cell ,?row-1 ,?column ,?box-1
                          ,(delete ?value ?value-1))))

(define-rule (rule-5c sudoku-rules)
  (cell ?row ?column ?box
        (?value (number? ?value)))
  (?cell-1 <- (cell ?row-1
                    ?column-1
                    (?box (or (not (= ?row-1 ?row))
                              (not (= ?column-1 ?column))))
                    (?value-1 (and (pair? ?value-1)
                                   (memv ?value ?value-1)))))
  ==>
  (replace ?cell-1 `(cell ,?row-1 ,?column-1 ,?box
                          ,(delete ?value ?value-1))))

;; If there is a value that only occurs once as a possibility  in any
;; row, column, or box, then make it the only possible value.
(define-rule (rule-6a sudoku-rules)
  (digit ?digit)
  (?cell <- (cell ?row ?column ?box (?value (and (pair? ?value)
                                                 (memv ?digit ?value)))))
  (no (cell ?row (?column-1 (not (= ?column-1 ?column))) ?
            (?value-1 (or (and (number? ?value-1)
                               (= ?value-1 ?digit))
                          (and (pair? ?value-1)
                               (memv ?digit ?value-1))))))
  ==>
  (replace ?cell `(cell ,?row ,?column ,?box ,(list ?digit))))

(define-rule (rule-6b sudoku-rules)
  (digit ?digit)
  (?cell <- (cell ?row ?column ?box (?value (and (pair? ?value)
                                                 (memv ?digit ?value)))))
  (no (cell (?row-1 (not (= ?row-1 ?row))) ?column ?
            (?value-1 (or (and (number? ?value-1)
                               (= ?value-1 ?digit))
                          (and (pair? ?value-1)
                               (memv ?digit ?value-1))))))
  ==>
  (replace ?cell `(cell ,?row ,?column ,?box ,(list ?digit))))

(define-rule (rule-6c sudoku-rules)
  (digit ?digit)
  (?cell <- (cell ?row ?column ?box (?value (and (pair? ?value)
                                                 (memv ?digit ?value)))))
  (no (cell ?row-1 ?column-1 (?box (or (not (= ?row-1 ?row))
                                       (not (= ?column-1 ?column))))
            (?value-1 (or (and (number? ?value-1)
                               (= ?value-1 ?digit))
                          (and (pair? ?value-1)
                               (memv ?digit ?value-1))))))
  ==>
  (replace ?cell `(cell ,?row ,?column ,?box ,(list ?digit))))

;; If the above rules don't find a solution (or fail), then create a
;; child inference to search using the shorted list of possibilities.
(define-rule (search sudoku-rules #:priority -100)
  (board ?board)
  (cell ?row ?column ?box (?value (and (pair? ?value)
                                       (> (length ?value) 1)))
        )
  (no (cell ? ? ? (?value-1 (and (pair? ?value-1)
                                 (< (length ?value-1)
                                    (length ?value))))))
  ==>
  (printf "search: row = ~a, column = ~a, box = ~a, values = ~a~n"
          ?row ?column ?box ?value)
  (for-each
   (lambda (value)
     (let ((new-board (copy-board ?board)))
       (vector-set! (vector-ref new-board ?row) ?column value)
       (let ((result
              (with-new-child-inference-environment
               (activate sudoku-rules)
               (assert `(board ,new-board))
               (let ((result (start-inference)))
                 (printf "Rules fired = ~a~n" (current-inference-rules-fired))
                 result))))
         (when (vector? result)
           (stop-inference result)))))
   ?value)
  (fail))

(define (copy-board board)
  (let ((new-board (make-vector 9)))
    (do ((row 0 (+ row 1)))
      ((= row 9) new-board)
      (let ((board-row (vector-ref board row))
            (new-row (make-vector 9)))
        (do ((column 0 (+ column 1)))
          ((= column 9) (void))
          (vector-set! new-row column
                       (vector-ref board-row column)))
        (vector-set! new-board row new-row)))))

(define (print-board board)
  (do ((row 0 (+ row 1)))
    ((= row 9) (void))
    (do ((column 0 (+ column 1)))
      ((= column 9) (void))
      (let ((value (vector-ref (vector-ref board row) column)))
        (printf "~a " value)))
    (printf "~n")))

(define (sudoku-solver board)
  (printf "Initial Board~n")
  (print-board board)
  (with-new-inference-environment
   (activate sudoku-rules)
   (graph-rule-network)
   ;(current-inference-strategy 'breadth)
   ;(current-inference-trace #t)
   (assert `(board ,board))
   (let ((result (start-inference)))
     (cond ((eq? result '#:fail)
            (printf "Problem cannot be solved!~n"))
           ((not result)
            (printf "No solution found!~n")
            (let* ((board (cdr (assq '?board (mcdr (mcar (query '(board ?board))))))))
              (print-board board)))
           (else
            (printf "Solution found!~n")
            (print-board result))))
   (printf "Rules fired = ~a~n" (current-inference-rules-fired))
   ))

(define _ '_)

(printf "Trivial - Already Solved~n")
(sudoku-solver (vector (vector 1 2 3 4 5 6 7 8 9)
                       (vector 4 5 6 7 8 9 1 2 3)
                       (vector 7 8 9 1 2 3 4 5 6)
                       (vector 2 3 4 5 6 7 8 9 1)
                       (vector 5 6 7 8 9 1 2 3 4)
                       (vector 8 9 1 2 3 4 5 6 7)
                       (vector 3 4 5 6 7 8 9 1 2)
                       (vector 6 7 8 9 1 2 3 4 5)
                       (vector 9 1 2 3 4 5 6 7 8)))

(printf "~nTrivial - One open cell~n")
(sudoku-solver (vector (vector _ 2 3 4 5 6 7 8 9)
                       (vector 4 5 6 7 8 9 1 2 3)
                       (vector 7 8 9 1 2 3 4 5 6)
                       (vector 2 3 4 5 6 7 8 9 1)
                       (vector 5 6 7 8 9 1 2 3 4)
                       (vector 8 9 1 2 3 4 5 6 7)
                       (vector 3 4 5 6 7 8 9 1 2)
                       (vector 6 7 8 9 1 2 3 4 5)
                       (vector 9 1 2 3 4 5 6 7 8)))

(printf "~nEasy~n")
(sudoku-solver (vector (vector 7 8 1 6 _ 2 9 _ 5)
                       (vector 9 _ 2 7 1 _ _ _ _)
                       (vector _ _ 6 8 _ _ _ 1 2)
                       (vector 2 _ _ 3 _ _ 8 5 1)
                       (vector _ 7 3 5 _ _ _ _ 4)
                       (vector _ _ 8 _ _ 9 3 6 _)
                       (vector 1 9 _ _ _ 7 _ 8 _)
                       (vector 8 6 7 _ _ 3 4 _ 9)
                       (vector _ _ 5 _ _ _ 1 _ _)))

(printf "~nMedium~n")
(sudoku-solver (vector (vector _ 8 _ _ _ _ _ _ _)
                       (vector _ 4 7 8 _ 9 _ _ 1)
                       (vector _ _ 1 4 5 _ _ 2 _)
                       (vector 8 1 6 7 _ _ 5 _ _)
                       (vector 9 _ _ _ _ 1 _ _ _)
                       (vector _ _ _ 5 6 _ _ _ _)
                       (vector _ _ _ _ _ 8 _ 5 3)
                       (vector _ _ _ _ _ _ _ 8 _)
                       (vector _ _ _ 3 1 _ _ 4 6)))

(printf "~nHard~n")
(sudoku-solver (vector (vector _ 1 9 _ _ _ _ _ _)
                       (vector _ _ 8 _ _ 3 _ 5 _)
                       (vector _ 7 _ 6 _ _ _ 8 _)
                       (vector _ _ 1 _ _ 6 8 _ 9)
                       (vector 8 _ _ _ 4 _ _ _ 7)
                       (vector 9 4 _ _ _ _ _ 1 _)
                       (vector _ _ _ _ _ 2 _ _ _)
                       (vector _ _ _ _ 8 _ 5 6 1)
                       (vector _ _ 3 7 _ _ _ 9 _)))
jvjulien est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse
Outils de la discussion

Navigation rapide


Fuseau horaire GMT +2. Il est actuellement 07h44.


 
 
 
 
Partenaires

Hébergement Web