Rendre une insertion dans un tas terminale-récursive

**prgasp77** · 15/12/2009, 12h12

Bonjour, j'ai défini un type tas et une fonction d'insertion :

Code OCaml :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
type 'a heap = [`EMPTY | `LEEF of 'a | `NODE of 'a heap * 'a * 'a heap]
val (==)
val (>>)
val (>>=)
val (<<)
val (<<=)
 
let rec insert item = function
| `EMPTY -> `LEEF item
| `LEEF n when n > item -> `NODE (`LEEF item,n,`EMPTY)
| `LEEF n -> `NODE (`LEEF n, item,`EMPTY)
| `NODE (left,n,right) when n < item -> insert n (`NODE (left,item,right))
| `NODE (left,n,right) when left >> right -> `NODE (left,n,insert item right)
| `NODE (left,n,right) t -> `NODE (insert item left,n,right)

(À une erreur de copie manuelle près.)

L'algorithme fonctionne ... mais n'est pas terminal-récursif (uniquement à cause de la dernière clause je crois). Quelqu'un voir une solution ?
Merci.

**Cacophrene** · 15/12/2009, 13h07

Bonjour !

D'abord un détail : en anglais c'est `LEAF plutôt que `LEEF pour les feuilles. Pourquoi veux-tu rendre cette implémentation tail-rec ? Tu manipules de grandes quantités de données qui font qu'en l'état actuel, tu obtiens un débordement de pile ? Attention de façon générale tous les algos n'ont pas une version tail-rec et celle-ci n'est pas toujours aussi limpide que la version non tail-rec...

Pour rendre l'algo tail rec, il faut que les appels récursifs à insert ne soient pas suivis d'un autre calcul. Donc effectivement c'est l'insertion à droite ou à gauche qui pose problème. Essaie de voir si tu peux modifier l'implémentation de `NODE, peut-être en utilisant un type record mutable (je n'ai pas testé).

Cordialement,
Cacophrène

**prgasp77** · 15/12/2009, 13h52

Mon anglais laisse à désirer ... j'étais persuadé d'entendre leef

Pourquoi rendre mon algo tail-rec ? Par simple exercice. Je te remercie de tes conseils, mais à vrai dire (et toujours par exercice), je ne souhaite pas modifier mon type tas, sauf si la modification le rendait plus fonctionnel (au sens de langage fonctionnel).

Au fait, certains de tes messages sur d'autres forums m'ont bien aidé ... merci.

**SpiceGuid** · 15/12/2009, 15h24

tu n'as pas besoin de variants polymorphes et tu ne dois pas les utiliser quand tu n'en as pas besoin
tu ne dois pas utiliser when quand tu peux faire le test avec if car when empêche ocaml de vérifier que ton filtrage est exhaustif
il n'y pas de vraie motivation ici pour le tail-rec, si ton tas est équilibré tu devrais pouvoir insérer environ 1 milliard d'éléments avec seulement 30 niveaux environ
si tu déborde la pile c'est que ton tas est dégénéré et donc que tu dois changer d'algo/TAD
ton tas ne servira à rien du tout si tu n'as pas remove_min

Envoyé par Eprgasp77

je ne souhaite pas modifier mon type tas, sauf si la modification le rendait plus fonctionnel (au sens de langage fonctionnel)

C'est un choix discutable.
Par exemple il n'est pas possible d'implanter efficacement remove (retirer une clé quelconque) et decrease_key (remplacer une clé par une clé plus petite) en restant purement fonctionnel.

**LLB** · 15/12/2009, 17h38

Envoyé par SpiceGuid

tu n'as pas besoin de variants polymorphes et tu ne dois pas les utiliser quand tu n'en as pas besoin

Je ne suis pas d'accord - j'utilise les variants de temps en temps, même lorsqu'il ne sont pas indispensables, simplement parce qu'ils simplifient le code. Dans l'exemple qu'il donne, on n'en sait rien si les variants sont indispensables ou non (il manque le contexte). C'est probablement mieux d'utiliser un type somme ici (mais ce n'est pas une règle absolue).

Envoyé par SpiceGuid

tu ne dois pas utiliser when quand tu peux faire le test avec if car when empêche ocaml de vérifier que ton filtrage est exhaustif

Je ne suis pas d'accord : dans l'exemple donné, Caml se rend parfaitement compte que le filtrage est exhaustif.

Envoyé par SpiceGuid

il n'y pas de vraie motivation ici pour le tail-rec, si ton tas est équilibré tu devrais pouvoir insérer environ 1 milliard d'éléments avec seulement 30 niveaux environ

Vouloir apprendre est une motivation largement suffisante pour justifier sa question.

Envoyé par SpiceGuid

ton tas ne servira à rien du tout si tu n'as pas remove_min

J'imagine que son code n'est pas complet.

Envoyé par SpiceGuid

Par exemple il n'est pas possible d'implanter efficacement remove (retirer une clé quelconque) et decrease_key (remplacer une clé par une clé plus petite) en restant purement fonctionnel.

Une implémentation en log(n) me semble acceptable.

Pour passer la fonction en récursif terminal, il y a toujours la solution d'utiliser des continuations (continuation passing style). Ce n'est pas le plus performant, mais c'est une solution générique. Et c'est quelque chose de bien à connaître et à comprendre (mais pas forcément à utiliser).

**Cacophrene** · 15/12/2009, 19h03

Bonjour !

Envoyé par LLB

Je ne suis pas d'accord - j'utilise les variants de temps en temps, même lorsqu'il ne sont pas indispensables, simplement parce qu'ils simplifient le code. Dans l'exemple qu'il donne, on n'en sait rien si les variants sont indispensables ou non (il manque le contexte). C'est probablement mieux d'utiliser un type somme ici (mais ce n'est pas une règle absolue).

Je suis assez d'accord avec ça. Je me sers quasi uniquement des variants dès qu'il y a des modules qui doivent faire du filtrage sur des unions définies dans d'autres modules (pour éviter les trucs du genre Foo.Bar.FooBar.BarFoo.Example), ou pour des fonctions génériques comme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
let full_iter f = function
  | [] -> ()
  | x :: t -> let () = f (`FST x) in
    let rec loop = function
      | [] -> ()
      | [x] -> f (`LST x)
      | x :: t -> f (`MID x); loop t
    in loop t

Par contre pour un usage interne à un module je préfère de très loin les types sommes. Et puis le comportement en matière de typage n'est pas le même...

Envoyé par LLB

Je ne suis pas d'accord : dans l'exemple donné, Caml se rend parfaitement compte que le filtrage est exhaustif.

Je crois que SpiceGuid parlait du cas général.

Un cas idiot qui fait râler inutilement OCaml (avertissement P) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
let classify = function
    | 0 -> `Nil
    | n when n > 0 -> `Pos
    | n when n < 0 -> `Neg

Cordialement,
Cacophrène

**SpiceGuid** · 15/12/2009, 19h13

Envoyé par LLB

Dans l'exemple qu'il donne, on n'en sait rien si les variants sont indispensables ou non (il manque le contexte).

Trois constructeurs pour un arbre binaire ça ne te paraît pas largement suffisant ?
(quand il va implanter l'union de deux tas le nombre de cas augmentera avec le carré du nombre de constructeurs)

Envoyé par LLB

je ne suis pas d'accord : dans l'exemple donné, Caml se rend parfaitement compte que le filtrage est exhaustif.

Ok.

Envoyé par LLB

Envoyé par SpiceGuid

Par exemple il n'est pas possible d'implanter efficacement remove (retirer une clé quelconque) et decrease_key (remplacer une clé par une clé plus petite) en restant purement fonctionnel.

Une implémentation en log(n) me semble acceptable.

J'ai dis remove, pas remove_min

C'est impossible en purement fonctionnel. On parle de tas binaire, pas d'un arbre de recherche, on ne peut pas savoir dans lequel des deux sous-arbre est la clé. En style impératif pour faire decrease_key on a un lien vers la clé à modifier et celle-ci possède un lien parent qui permet de faire percoler la clé jusqu'à la bonne position. Pour remove on fait percoler jusqu'à la racine puis on fait un remove_min.
(voir tas binomial dans la FAQ algo)

**gasche** · 16/12/2009, 10h54

Au cas où quelqu'un se demanderait quelle est cette "version par continuation" que tout le monde semble connaître :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
let insert2 item = 
  let rec insert item k = function
    | `EMPTY -> k (`LEEF item)
    | `LEEF n when n > item -> k (`NODE (`LEEF item,n,`EMPTY))
    | `LEEF n -> k (`NODE (`LEEF n, item,`EMPTY))
    | `NODE (left,n,right) when n < item -> 
        insert n k (`NODE (left,item,right))
    | `NODE (left,n,right) when left >> right ->
        insert item (fun result -> k (`NODE (left,n,result))) right
    | `NODE (left,n,right) ->
        insert item (fun result -> k (`NODE (result,n,right))) left
  in insert item (fun tree -> tree)

(Le code n'est pas très beau, car j'ai esssayé de modifier au minimum le code de départ; un petit nettoyage serait certainement bienvenu)

**Cacophrene** · 16/12/2009, 12h40

Envoyé par bluestorm

Au cas où quelqu'un se demanderait quelle est cette "version par continuation" que tout le monde semble connaître

Un problème de copier/coller ?

Cordialement,
Cacophrène

**gasche** · 16/12/2009, 13h24

Merci, c'est corrigé (j'avais mis le code de l'OP à la place de la version par continuations). Pour faire bonne figure je rajoute la version avec continuations réifiées :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
let insert3 item =
  let rec insert item k = function
    | `EMPTY -> eval (`LEEF item) k
    | `LEEF n when n > item -> eval (`NODE (`LEEF item,n,`EMPTY)) k
    | `LEEF n -> eval (`NODE (`LEEF n, item,`EMPTY)) k
    | `NODE (left,n,right) when n < item -> 
        insert n k (`NODE (left,item,right))
    | `NODE (left,n,right) when left >> right ->
        insert item (`LEFT_NODE (left, n) :: k) right
    | `NODE (left,n,right) ->
        insert item (`RIGHT_NODE (n, right) :: k) left
  and eval tree k =
    let eval result = function
      | `LEFT_NODE (left, n) -> `NODE (left, n, result)
      | `RIGHT_NODE (n, right) -> `NODE (result, n, right) in
    List.fold_left eval tree k
  in insert item []

**prgasp77** · 04/01/2010, 14h19

Bonjour, bonne année, et merci à tous pour votre implication.

Pour commencer, il est tout à fait possible de faire un remove_min fonctionnel (voir à la fin) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
(** {2 Définition} *)
(** Définition d'un tas *)
type 'a t =
  | Empty
  | Node of 'a t * 'a * 'a t
 
(** Comparaison de deux tas *)
let rec compare t1 t2 =
  match t1,t2 with
  | Empty        , Empty        -> 0
  | Empty        , _             -> -1
  | Node (Empty,n,Empty)       , Node (Empty,k,Empty)       -> Pervasives.compare n k
  | Node (Empty,n,Empty)       , Node (_,k,_) -> Pervasives.compare n k
  | Node (_,n,_) , Node (_,k,_) -> Pervasives.compare n k
  | _                             -> -(compare t2 t1)
 
(** Opérateurs *)
let (== ) t1 t2 = compare t1 t2 = 0
let (>> ) t1 t2 = compare t1 t2 > 0
let (>>=) t1 t2 = t1 >> t2 || t1 == t2
let (<< ) t1 t2 = not (t2 >>= t1)
let (<<=) t1 t2 = not (t2 >> t1)
 
(** {2 Opération sur un tas} *)
 
(** Insérer un objet dans un tas *)
let rec push item heap =
  match heap with
  | Empty                                -> Node (Empty,item,Empty)
  | Node (Empty,n,Empty) when n > item   -> Node (Node (Empty,item,Empty),n,Empty)
  | Node (Empty,n,Empty)                -> Node (Node (Empty,n,Empty),item,Empty)
  | Node (hpl,n,hpr) when n < item      -> push n (Node (hpl,item,hpr))
  | Node (hpl,n,hpr) when hpl >> hpr    -> Node (hpl,n,push item hpr)
  | Node (hpl,n,hpr)                      -> Node (push item hpl,n,hpr)
 
(** Tête du tas *)
let head = function
  | Empty                -> raise (Invalid_argument "Heap.head")
  | Node (_,n,_)         -> n
 
(** Queue du tas *)
let rec pop = function
  | Empty                               -> Empty
  | Node (Empty,_,Empty)                -> Empty
  | Node (hpl,_,hpr) when hpl >> hpr    -> Node(pop hpl,head hpl,hpr)
  | Node (_,n,hpr) when hpr == Empty    -> Empty
  | Node (hpl,_,hpr)                    -> Node(hpl,head hpr,pop hpr)
 
(** {2 Interactivité avec les listes} *)
(** Transforme un tas en liste *)
let to_list heap =
  let rec f hpl hpr acc =
    match hpl,hpr with
    | Empty,Empty                                          -> acc
    | Empty,Node (Empty,n,Empty)                           -> n::acc
    | Empty,Node (hprl,n,hprr)                             -> f hprl hprr (n::acc)
    | Node (Empty,n,Empty),Node (Empty,k,Empty) when n > k -> f Empty hpr (n::acc)
    | Node (Empty,_,Empty),Node (Empty,k,Empty)            -> f Empty hpl (k::acc)
    | Node (Empty,n,Empty),_ when hpl >> hpr               -> f Empty hpr (n::acc)
    | Node (Empty,_,Empty),Node (hprl,k,hprr)               -> f Empty hpl (k::acc)
    | _ when hpl >> hpr                                    -> f (pop hpl) hpr ((head hpl)::acc)
    | _                                                    -> f hpr (pop hpl) ((head hpr)::acc)
  in
  f heap Empty []
 
(** Transforme une liste en tas trié *)
let of_list lst =
  let rec f lst acc =
    match lst with
    | []     -> acc
    | hd::tl -> f tl (push hd acc)
  in
  f lst Empty
 
(** Trie une liste via heap sort *)
let list_sort l = to_list (of_list l)
 
(** Suppression du plus petit élément *)
let remove_min heap =
  match to_list heap with
  | [] -> Empty
  | _::lst -> of_list lst

C'est pas opti opti, mais ça marche bien et c'est fonctionnel. J'ai pris en compte vos exemples de méthodes par continuation, et j'y penserai. J'aime bien le principe.

N'hésitez pas à faire d'autres commentaires.

**SpiceGuid** · 04/01/2010, 17h08

Ton tas est un tas-maximum.
Cependant ton insertion n'est pas l'insertion standard dans un tas binaire.

Je n'aime pas trop ta fonction compare parce qu'elle compare des arbres au lieu de comparer des clés.
Tu n'as besoin que de savoir comparer des clés, tout ce qui concerne l'arbre est l'affaire du filtrage. Je t'ai réécris l'insertion pour aller dans ce sens, en n'utilisant que du filtrage et de la comparaison de clés.

Code OCaml :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
let cmp = Pervasives.compare 

let singleton x = Node (Empty,x,Empty)

let rec push x = function
  | Empty ->
      singleton x
  | Node (l,n,r) when cmp n x < 0 ->
      push n (Node (l,x,r))
  | Node (Empty,n,t) | Node (t,n,Empty) ->
      Node(singleton x,n,t)
  | Node ((Node (_,nl,_) as l),n,(Node (_,nr,_) as r)) ->
      if cmp nl nr < 0 then Node (push x l,n,r)
      else Node (l,n,push x r)

L'algo standard d'insertion dans un tas binaire :

Code OCaml :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
let rec add x = function
  | Empty ->
      Node (Empty,x,Empty)
  | Node (l,n,r) ->
      if compare x n > 0 then Node(add n r,x,l) 
      else Node(add x r,n,l)

Cet algo d'insertion garantie que le tas est quasi-complet, le tien ne garantie même pas que le tas est équilibré.

Il existe une variante (appelée arbre tournoi) qui elle ne garantie pas que le tas est équilibré. Cette variante est intéressante parce qu'elle garantie que le parcours infixe restitue les clés dans leur ordre d'insertion.

Code OCaml :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
let rec add x = function
  | Empty ->
      Node (Empty,x,Empty)
  | Node (l,n,r) as h ->
      if compare x n > 0 then Node(h,x,Empty) 
      else Node (l,n,add x r)

Ton algo d'insertion cumule les inconvénients de ces deux variantes sans en avoir aucun avantage.

Je n'ai pas regardé tes autres routines parce que tes opérateurs de comparaison me font mal aux yeux. Je pense que tu devrais tout reprendre, dans un style plus directe et avec des algos plus classiques.

Rendre une insertion dans un tas terminale-récursive

Caml

Discussions similaires

Partager

Partager