Page code source, mettez vos sources ici !

[gasche]

Code haskell :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
import Data.List (mapAccumL, sortBy)
import System.Random (RandomGen, split, randoms)
import Data.Ord (Ordering)
import Data.Function (on)

-- compare two real numbers as infinite sequences of booleans
real_cmp :: [Bool] -> [Bool] -> Ordering
real_cmp (True:_) (False:_) = LT
real_cmp (False:_) (True:_) = GT
real_cmp (_:xs) (_:ys) = real_cmp xs ys

-- weight each element with a random real number
weight_list :: RandomGen g => g -> [a] -> [([Bool], a)]
weight_list g = snd . mapAccumL weight g
                where weight g x =
                                 let (g1, g2) = split g in
                                 (g1, (randoms g2, x))

-- shuffle by sorting on weights
shuffle :: RandomGen g => g -> [a] -> [a]
shuffle g = map snd . sort_on_weights . weight_list g
        where sort_on_weights = sortBy (real_cmp `on` fst)

Note : ça ne suffit pas pour briller en société, j'ai été démasqué par mon utilisation des underscore_plus_lisibles.

[SpiceGuid]

Et qu'est-ce qu'elle fait la gendarmerie Haskell quand un véhicule grille un real_cmp [] [] ?

[gasche]

Comme le précise le commentaire, on considère comme réels les séquences *infinies* de booléens. C'est ce que fait la fonction "randoms" (que personne n'est censée connaître et que d'ailleurs j'avais déjà oubliée) : à partir d'un générateur de nombre aléatoire, elle génère un flux infini d'objets tirés au hasard (ici des booléens).

Hop:

Code ocaml :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
type 'a stream = Cons of 'a * 'a stream lazy_t

let rec real_number () =
  Cons (Random.bool (), lazy (real_number ()))

let rec compare_real a b = match a, b with
| Cons (true, _), Cons (false, _) -> 1
| Cons (false, _), Cons (true, _) -> -1
| Cons (_, lazy a'), Cons (_, lazy b') ->
    compare_real a' b'

let shuffle list =
  List.map snd
    (List.sort (fun (ra, _) (rb, _) -> compare_real ra rb)
       (List.map (fun x -> real_number (), x) list))

[SpiceGuid]

Merci, c'est plus clair comme ça, c'est une co-récursion sur une co-donnée, on ne lui demande pas d'être bien fondée, on lui demande d'être productive.

La gendarmerie te souhaites bonne route

[SpiceGuid]

Il s'agit d'un TAD qui ressemble fort à un arbre binaire ordonné sauf qu'en plus il fait aussi "annuaire inversé". C'est-à-dire que le domaine d'arrivée est lui aussi totalement ordonné et peut faire office de domaine de départ.

On pourrait implanter ce TAD à l'aide d'un quadtree mais alors chaque feuille aurait 4 sous-arbres vides ce qui consomme trop de mémoire, surtout en ces temps où le 64bits devient à la mode.
On pourrait aussi implanter ce TAD à l'aide de deux arbres binaires, un pour chaque direction, mais alors on dupliquerait les données.

Dans un cas on a "trop" de structure, dans l'autre on a "trop" de données.
On va trouver le compromis idéal.
Qui consistera à alterner les niveaux, un niveau pour le domaine de départ, un niveau pour le domaine d'arrivée, puis à nouveau un niveau pour le domaine de départ,...

Code OCaml :

1
2
3
4
(* dictionnaire réversible à 2 niveaux *)
type ('a, 'b) rev_map =
  | Nil 
  | Node of ('b, 'a) rev_map * 'a * 'b * ('b, 'a) rev_map

On voit bien l'alternance des niveaux, un sous-arbres n'est pas de type ('a, 'b) rev_map mais de type ('b, 'a) rev_map (on appelle ça un type récursif non-régulier).

Grâce à ce type récursif non-régulier il est facile d'exprimer l'insertion et l'appartenance :

Code OCaml :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
(* insertion *)
let rec insert : 'a 'b . 'a -> 'b -> ('a, 'b) rev_map -> ('a, 'b) rev_map =
  fun x y -> function 
  | Nil -> Node(Nil,x,y,Nil) 
  | Node (l,u,v,r) ->
      if x < u then Node (insert y x l,u,v,r)
      else Node (l,u,v,insert y x r)

(* appartenance *)  
let rec member : 'a 'b . 'a -> 'b -> ('a, 'b) rev_map -> bool =
  fun x y -> function 
  | Nil -> false
  | Node (l,u,v,r) -> member y x (if x < u then l else r)

Les requêtes possibles sont de deux sortes puisqu'on peut choisir l'un ou l'autre des deux domaines pour la clé de recherche.

On commence par une fonction utilitaire qui permet de traverser les niveaux non-discriminants.

Code OCaml :

1
2
3
4
5
6
let interleave f w acc = function    
  | Nil ->
      acc
  | Node (l,u,v,r) ->
      f w [] l @ f w (if v = w then u::acc else acc) r

On peut alors demander la liste des éléments x associés à une clé y, ou bien la liste des éléments y associés à une clé x.

Code OCaml :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(* liste des éléments x associés à une clé y *)
let rec find_all_x y acc = function    
  | Nil -> acc
  | Node (l,u,v,r) ->
      if y < u then interleave find_all_x y acc l
      else if y > u then interleave find_all_x y acc r
      else interleave find_all_x y (v::acc) r
let find_all_x y =
  interleave find_all_x y []

(* liste des éléments y associés à une clé x *)
let rec find_all_y x acc = function    
  | Nil -> acc
  | Node (l,u,v,r) ->
      if x < u then interleave find_all_y x acc l
      else if x > u then interleave find_all_y x acc r
      else interleave find_all_y x (v::acc) r
let find_all_y x =
  find_all_y x []

Enfin, on peut compter le nombre d'éléments situés dans le 'rectangle' (xmin,xmax,ymin,ymax).

Code OCaml :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(* nombre d'éléments situés dans un rectangle *)
let rec count_inside :
  'a 'b . int -> 'a -> 'a -> 'b -> 'b -> ('a, 'b) rev_map -> int =
  fun acc xmin xmax ymin ymax -> function
  | Nil ->
      acc
  | Node (l,u,v,r) ->
      if u < xmin then
        count_inside acc ymin ymax xmin xmax r
      else if u > xmax then
        count_inside acc ymin ymax xmin xmax l
      else
        (if ymin < v && v < ymax then acc+1 else acc) +
        count_inside 0 ymin ymax xmin xmax l +
        count_inside 0 ymin ymax xmin xmax r 
let count_inside xmin xmax ymin ymax rmap =
  count_inside 0 xmin xmax ymin ymax rmap

Edit:

• Le code a été corrigé suivant les indications de bluestorm, il nécessite OCaml 3.12+
• Je n'ai pas trop cherché à faire plus intéressant que simplement compter le nombre d'habitants d'un rectangle, le problème le plus évident c'est que j'ai du mal à accumuler les paires (u,v) parce que leur type est tantôt ('a,'b) et tantôt ('b,'a). Si quelqu'un a une idée lumineuse je corrigerai le code en conséquence.
• Il ne me paraît pas impossible d'utiliser ce TAD pour déterminer le plus proche voisin d'un point (x,y) (Nearest neighbour search), les gens du forum algo sont plus qualifiés que moi pour le faire, malheureusement il y a la barrière du langage...

[gasche]

C'est une structure diabolique. C'est dingue ce qu'on peut faire avec les types non-réguliers.

Pour ton problème de typage, c'est lié à l'inférence des fonctions récursives. Il faut forcer la récursivité polymorphe en mettant une annotation (possible seulement depuis 3.12) :

Code :

let insert : 'a 'b . 'a -> 'b -> ('a, 'b) rev_map -> ('a, 'b) rev_map = ...

Avant 3.12 on doit pouvoir s'en tirer avec un enregistrement polymorphe ou un module récursif.

[SpiceGuid]

Merci. J'ai corrigé mon code selon tes indications et j'ai ajouté 1 ou 2 idées d'extensions non triviales.

[gasche]

SpiceGuid > on parle de toi sur StackOverflow ! :-'

J'ai mis en ligne une version un peu nettoyée de ton code :
http://hpaste.org/45805/bimap_as_a_nonregular_recursi

J'ai retiré les accumulateurs tail-rec parce que je n'arrivais pas à garantir l'ordre en les utilisant (avec ton code, la valeur du nœud est placée en premier dans l'accumulateur, puis les valeurs de droite, puis celles de gauche, alors que je voudrais un retour ordonné). De toute façon, je pense que pour une structure aussi bizarre à premier abord il vaut mieux favoriser la lisibilité plutôt que l'efficacité, au moins pour une première présentation.

PS : pour la fonction "rectangle" je pense que tu pourrais commencer par implémenter une fonction qui renvoie le rectangle sous la forme de cette même structure de donnée, c'est à dire qui se contente d'"élager" les bords. Je ne sais pas si c'est évident (peut-être qu'il faut faire des fusions ?).

[SpiceGuid]

Pour ce qui est de la structure de données je t'encourage à chercher du côté du Kd-Tree.
C'est généralisable à plus de 2 dimensions :

Code OCaml :

1
2
3
4
(* Kd-Tree en 3D *)
type ('a, 'b, 'c) kd_tree =
  | Nil 
  | Node of ('b, 'c, 'a) kd_tree * 'a * 'b * 'c * ('b, 'c, 'a) kd_tree

Pour ce qui est de la fonction "rectangle" je n'ai pas trouvé plus simple que la répétition brutale pour séparer le cas (u,v)::acc du cas (v,u)::acc :

Code OCaml :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
let rec rectangle_to_list_x acc xmin xmax ymin ymax = function
  | Nil ->
      acc
  | Node (l,u,v,r) ->
      if u < xmin then
        rectangle_to_list_y acc ymin ymax xmin xmax r
      else if u > xmax then
        rectangle_to_list_y acc ymin ymax xmin xmax l
      else
        rectangle_to_list_y [] ymin ymax xmin xmax l @
        rectangle_to_list_y [] ymin ymax xmin xmax r @
        (if ymin < v && v < ymax then (u,v)::acc else acc)
and rectangle_to_list_y acc xmin xmax ymin ymax = function
  | Nil ->
      acc
  | Node (l,u,v,r) ->
      if u < xmin then
        rectangle_to_list_x acc ymin ymax xmin xmax r
      else if u > xmax then
        rectangle_to_list_x acc ymin ymax xmin xmax l
      else
        rectangle_to_list_x [] ymin ymax xmin xmax l @
        rectangle_to_list_x [] ymin ymax xmin xmax r @
        (if ymin < v && v < ymax then (v,u)::acc else acc)
        
let rectangle_to_list xmin xmax ymin ymax rmap =
  rectangle_to_list_x [] xmin xmax ymin ymax rmap

[gasche]

Tu pourrais t'inspirer des fonctions suivantes (qui me semble être comme rectangle, mais sans bornes) :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
let elements_x, elements_y =
  let rec elements 
    : 'a 'b . ('a -> 'b -> 'c) -> ('b -> 'a -> 'c)
       -> ('a, 'b) rev_map -> 'c list
    = fun kx ky -> function
    | Nil -> []
    | Node (l, u, v, r) ->
      elements ky kx l @ [kx u v] @ elements ky kx r
  in
  let kkey x y = (x,y) in
  let kval y x = (x,y) in
  (fun t -> elements kkey kval t),
  (fun t -> elements kval kkey t)

Sinon il y a une erreur dans mon code : je prétends que la sortie de find_all est ordonnée, mais en fait ce n'est pas vrai parce qu'on n'a pas de garantie sur l'ordre des valeurs qui ont la même clé (actuellement ils sont rangés par ordre d'insertion). J'ai donc modifié insert ainsi :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
let rec insert
  : 'a 'b . 'a -> 'b -> ('a, 'b) rev_map -> ('a, 'b) rev_map
  = fun x y -> function 
    | Nil -> Node (Nil, x, y, Nil)
    | Node (l, u, v, r) ->
      let l', v', r' =
        if x < u then
          insert y x l, v, r
        else if x > u then
          l, v, insert y x r
        else
          (* ensure in the x=u case that values are ordered: the                                                                      
             one on the node must be smaller than the ones on                                                                         
             the right with the same key *)
          l, (min v y), insert (max v y) x r in
      Node (l', u, v', r')

(Du coup on a un cas d'arrêt supplémentaire dans "member" mais j'ai eu la flemme de coder ça)

Version complète : http://hpaste.org/45831/bimap_as_a_nonregular_recursi

[SpiceGuid]

Envoyé par bluestorm

Tu pourrais t'inspirer des fonctions suivantes (qui me semble être comme rectangle, mais sans bornes)

tu as eu l'idée lumineuse que j'espérais, malheureusement je ne peux pas modifier le code dans mon message original (parce que, pour une raison que j'ignore, je n'y ai pas de bouton Editer)

Code OCaml 3.12 :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
let rec rectangle_to_list :
  'a 'b . 
  'c list -> ('a -> 'b -> 'c) -> ('b -> 'a -> 'c) ->
  'a -> 'a -> 'b -> 'b -> ('a, 'b) rev_map -> 'c list
  = 
  fun acc ku kv xmin xmax ymin ymax -> function
  | Nil ->
      acc
  | Node (l,u,v,r) ->
      if u < xmin then
        rectangle_to_list acc kv ku ymin ymax xmin xmax r
      else if u > xmax then
        rectangle_to_list acc kv ku ymin ymax xmin xmax l
      else
        rectangle_to_list [] kv ku ymin ymax xmin xmax l @
        rectangle_to_list [] kv ku ymin ymax xmin xmax r @
        (if ymin < v && v < ymax then ku u v::acc else acc)

let rectangle_to_list xmin xmax ymin ymax rmap =
  rectangle_to_list [] (fun u v -> u,v) (fun v u -> u,v) xmin xmax ymin ymax rmap

[gorgonite]

Envoyé par SpiceGuid

malheureusement je ne peux pas modifier le code dans mon message original (parce que, pour une raison que j'ignore, je n'y ai pas de bouton Editer)

tu ne suis pas tellement
après un certain temps, les messages ne sont plus éditables afin d'éviter qu'un membre se mette à saboter ses contributions une fois le problème résolu

[gasche]

Un petit code d'exemple pour montrer comment faire un "make_matrix" généralisé en dimension arbitraire à la sauce "functional unparsing" (Olivier Danvy).

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
let make_matrix x y f =
  Array.init x (fun i -> Array.init y (fun j -> f i j))

(* k : continuation (morally, "the following dimensions")
   f : the case-creating function (eg. f in make_matrix) *)
let dim x k =
  fun f -> Array.init x (fun i -> k (f i))

(* dim 1 $ dim 2 $ .. *)
let ($) d1 d2 k = d1 (d2 k)

(* to close a sequence of dims, pass 'id' as final continuation *)
let id x = x
let make dims f = dims id f

let make_matrix_2 x y f = make (dim x $ dim y) f

let test = make (dim 2 $ dim 2 $ dim 1 $ dim 3) (fun i j k l -> (i,l))

[SpiceGuid]

Souvent, par facilité, pour coder un environnment on utilise une simple liste d'association d'un string vers un élément.
Pour faire un peu mieux on peut désigner les variables par leur indice De Bruijn et demander List.nth. Ici je propose une solution similaire, on désigne toujours les variables par leur indice De Bruijn mais cette fois on demande l'élément de rang correspondant dans un arbre de braun.

Code OCaml :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
module Environment =
   struct
      type 'a env =
         | Leaf
         | Node of 'a env * 'a * 'a env
      exception
         Empty
      let empty =
         Leaf
      let rec push x = function
         | Leaf -> Node(Leaf,x,Leaf) 
         | Node(l,y,r) -> Node(push y r,x,l)             
      let top = function
         | Leaf -> raise Empty
         | Node(_,x,_) -> x             
      let rec top_pop = function
         | Leaf -> raise Empty
         | Node(Leaf,x,_) -> x,Leaf     
         | Node(l,x,r) ->
            let t,p = top_pop l
            in  x,Node(r,t,p)             
      let rec nth n = function           
         | Leaf -> raise Empty
         | Node(l,x,r) ->
            if n = 0 then x
            else if n mod 2 = 0 then nth (n/2) l            
            else nth (n/2 - 1) r
   end

edit: non, je n'ai pas fait de bench

[gasche]

C'est moins spécialisé mais j'avais essayé, pour un petit interprète de bytecode, d'utiliser un Map.Make(Int) comme environnement, et malgré la meilleure complexité théorique c'était sensiblement moins bon qu'une liste en pratique; je pense que ça venait du fait que la plupart des variables étaient en fait sur de "petits" indices (mais ça fait combien ? Je dirais inférieur à 5) et que la complexité en plus n'était donc pas rentabilisée.

[TropMDR]

Envoyé par SpiceGuid

edit: non, je n'ai pas fait de bench

Et la preuve en Coq ? :-)

[SpiceGuid]

Et oui, il y a forcément un nombre d'éléments en dessous duquel un algo avancé fait moins bien que l'algo naïf. Le contournement habituel consiste à trouver le point où ça bascule (par exemple environ une trentaine de digits pour la multiplication Karatsuba) et à passer à l'algo avancé seulement quand on le dépasse.

Mais le cas qui nous occupe, c'est trop dynamique, il n'y a pas de solution toute prête qui me vienne immédiatement à l'esprit. En plus ça dépend de la fréquence d'accès à la variable. Car l'insertion/suppression est plus coûteuse dans un Map.Make(Int) qu'en tête d'une liste. C'est l'accès aléatoire qui est plus rapide, mais seulement à partir d'un certain entier. En pratique je suppose que les accès à une variable sont d'autant plus fréquents que son indice de Bruijn est petit, ça rend la liste d'autant plus difficile à battre.

[SpiceGuid]

Un Skew max-heap est un tas-maximum.

Code OCaml :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(* skew max-heap *)

type 'a skew =
   | Empty
   | Skew of 'a skew * 'a * 'a skew 

let rec join ha hb =
   match ha,hb with
   | Empty,h | h,Empty -> 
      h
   | Skew(la,na,ra),Skew(lb,nb,rb) ->
      if na > nb then Skew(la,na,join ra hb) 
      else Skew(join ha lb,nb,rb)

let insert h n =
   join h (Skew(Empty,n,Empty))
      	      
let remove_max l n r =
   join l r,n

La fonction remove_max ne déclenche pas d'exception et ne renvoie pas de type option.