Page code source, mettez vos sources ici !

**gorgonite** · 19/01/2007, 17h52

Vous avez des codes sources dans les langages fonctionnels ?
Vous pensez que ces codes sources peuvent aider d'autres personnes ?
Vous souhaitez partager vos codes avec des internautes ?

Dans ce cas, participez à l'enrichissement des pages de codes sources de developpez.com et postez à la suite

Pour chaque proposition, merci d'expliquer en quelques mots ce que fait le code, s'il nécessite des bibliothèques ou des options particulières.

**Strab** · 23/01/2007, 23h14

Voici quelques fonctions de traitement des graphes que j'avais fait il y a quelques années pour un exercice scolaire. Cela offre une alternative intéressante je trouve à l'implémentation des graphes utilisée dans le tutoriel de millie (cf forum cours et tutoriels). Je ne sais pas si elle est meilleure ou quoi, je n'ai jamais cherché à savoir, je l'avais juste trouvée jolie à ce moment là

Je donne tout le source tel quel. Il y a quelques fonctions inutiles, c'est sûrement parce qu'on avait pas le droit à grand chose dans le cadre de l'exercice. Chaque fonction est précédée d'un cartouche expliquant précisément ce qu'elle fait. C'est du Caml Light

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
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
type ’a graphe = { sommets : ’a list ; succ : ’a −> ’a list };;

(* Interface appartient
type : ’a −> ’a list −> bool
arg : a = élément à rechercher
        l = liste de recherche
post : true si a appartient à l, false sinon *)
let rec appartient a l = match l with
   |[] −> false
   |t::q −> if a=t then true else appartient a q
;;


(* Interface miroir
type : ’a list −> ’a list
arg : l = liste à inverser
post : liste éléments de l dans l’odre inverse de celui de l *)
let miroir l =
   let rec aux l acc = match l with
     |[] −> acc
     |t::q −> aux q (t::acc)
   in aux l []
;;


(* Interface parcours
type : ’a graphe −> ’a −> ’a list
arg : graphe = graphe à parcourir
        x = sommet de départ
pre : x est un sommet de graphe
post : liste des sommets de g rencontrés lors de son parcours en profondeur à partir de son premier
 sommet. elle est dans l’odre où les sommets sont rencontrés *)
let parcours graphe x =
   (* aux fait le travail de parcours en s’aidant de deux paramètres supplémentaires : *)
   (* les successeurs de x et les sommets déjà parcourus *)
   (* les sommets sont ajoutés dès leur rencontre : résultat à l’envers *)
   let rec aux graphe x succ_x result_temp = match succ_x with
     |[] −> result_temp
     |t::q −> if appartient t result_temp (* t a−t−il été déjà visité ? *)
       then    (* on passe à la suite *)
         aux graphe x q result_temp
       else    (* on parcours les successeurs de t avant de continuer avec ceux de x *)
         aux graphe x q (aux graphe t (graphe.succ t) (t::result_temp))
   in miroir (aux graphe x (graphe.succ x) [x])
;;


(* Interface recherche
type : ’a graphe −> ’a −> ’a −> ’a list −> ’a list −> ’a list −> bool * ’a list * ’a list
arg : graphe
        a = sommet où commence la recherche
        b = sommet recherché
        succ_a = successeurs de a
        visites = sommets déjà visités au moment de cet appel
        temp = miroir du chemin parcouru pour rechercher arrivee
pre : a et les éléments de succ_a sont des sommets de graphe
post : triplet contenant :
         * un booléen vrai si il existe un chemin de graphe entre a et b
         * le miroir de ce chemin si il existe, celui du dernier essayé sinon
         * la liste des sommets visités *)
let rec recherche graphe a b succ_a temp visites = match succ_a with
     |[] −> false,temp,visites
     |t::q −> if t=b then true,t::temp,visites    (* on est arrivé *)
       else if appartient t visites (* sommes−nous déjà passés ici ? *)
       then      (* on passe à la suite *)
         recherche graphe a b q temp visites
       else      (* on essaye en passant par t... *)
         let trouve,temp’,visites’ = recherche graphe t b (graphe.succ t) (t::temp) (t::visites) in
         if trouve
         then trouve,temp’,visites’ (* ... et ça a marché *)
         else recherche graphe a b q temp visites’ (* ... en vain : on passe à la suite *)
;;


(* Interface circuit
type : ’a graphe −> ’a −> ’a list
arg : graphe = graphe où est recherché le circuit
        x = sommet que doit contenir le circuit recherché
pre : x est un sommet de graphe
post : un circuit (donc orienté) de graphe passant par x si il existe, la liste vide sinon *)
let circuit graphe x =
   let (trouve,chemin,_) = recherche graphe x x (graphe.succ x) [x] [x] in
     if trouve then miroir chemin else []
;;


(* Interface pred
type : ’a graphe −> ’a −> ’a list
arg : graphe
        x = sommet dont on veut les prédécesseurs
        sommets susceptibles d’être des prédécesseurs de x
pre : les éléments de sommets et x sont des sommets de graphe
post : liste des prédécesseurs de x *)
let rec pred graphe x sommets = match sommets with
   |[] −> []
   |t::q −> if t=x then pred graphe x q
             else if appartient x (graphe.succ t) then t::(pred graphe x q)
             else pred graphe x q
;;


(* Interface desoriente
type : ’a graphe −> ’a graphe
arg : graphe
post : renvoie graphe modifié de manière à ne plus tenir compte de l’orientation des arcs *)
let desoriente graphe =
   (* aux calcule la fonction succ associée au graphe désorienté *)
   let rec aux graphe sommets = match sommets with
     |[] −> (function x −> failwith "sommet inconnu")
     |t::q −> function
         |x when (x=t) −> (graphe.succ t)@(pred graphe t graphe.sommets)
         |x −> (aux graphe q) x
   in let succ’ = aux graphe graphe.sommets
   in { sommets = graphe.sommets ; succ = succ’ }
;;


type ’a precedent = Rien | P of ’a;;


(* Interface cycle
type : ’a graphe −> ’a −> ’a list
arg : graphe = graphe où est recherché le cycle
        x = sommet que doit contenir le cycle recherché
pre : x est un sommet de graphe
post : un cycle de graphe passant par x si il existe, la liste vide sinon *)
let cycle graphe x =
   let back t prec l = match prec with
     |Rien −> true
     |P(x) −> (t <> x) || appartient t l
   in let rec recherche2 graphe a b succ_a prec temp visites = match succ_a with
     |[] −> false,temp,visites
     |t::q −> if (t=b) && (back t prec q) (* On de doit pas revenir en arrière *)
       then true,t::temp,visites    (* on est arrivé *)
       else if appartient t visites (* sommes−nous déjà passés ici ? *)
       then      (* on passe à la suite *)
         recherche2 graphe a b q prec temp visites
       else      (* on essaye en passant par t... *)
         let trouve,temp’,visites’ = recherche2 graphe t b (graphe.succ t) (P a) (t::temp) (t::visites)
in
         if trouve
         then trouve,temp’,visites’ (* ... et ça a marché *)
         else recherche2 graphe a b q prec temp visites’ (* ... en vain : on passe à la suite *)
   in let graphe’ = desoriente graphe in
   let (trouve,chemin,_) = recherche2 graphe’ x x (graphe’.succ x) Rien [x] [x] in
     if trouve then miroir chemin else []
;;


(* Interface chemin
type : ’a graphe −> ’a −> ’a −> ’a list
arg : graphe = graphe où le chemin est recherché
        a = extremité initiale du chemin recherché
        b = extrémité finale du chemin recherché
pre : a est un sommet de graphe
post : un chemin de graphe entre a et b si il existe, la liste vide sinon *)
let chemin graphe a b =
   let (trouve,reponse,_) = recherche graphe a b (graphe.succ a) [a] [a] in
     if trouve then miroir reponse else []
;;


type ’a graphevalue = { sommets : ’a list ; succ : ’a −> (’a * int) list };;


(* Interface retire
type : ’a −> ’a list −> ’a list
arg : a = élément à retirer
        l = liste à modifier
post : l privée de la première occurence de a si elle existe (l sinon) *)
let rec retire a l = match l with
   | [] −> []
   |t::q−> if a=t then q else t::(retire a q)
;;


(* Interface inf
type : int −> int −> bool
arg : a b
post : true si a < b, false sinon, en considérant que −1 = l’infini *)
let inf a b = (a <> −1) && ( (b = −1) || (a < b) );;


(* Interface distmin
type : ’a list −> (’a * int) list −> ’a * int
arg : sbar = liste de sommets
        distances = liste de couples (sommet, distance)
pre : sbar et distances sont non vides
post : plus petit couple de distances (en ordonnant les couples par rapport à leur second élément) dont
 le premier élément appartient à sbar
raises : si sbar ou distances est vide *)
let rec distmin sbar distances =
   (* aux garde le plus petit couple trouvé en paramètre *)
   let rec aux sbar distances mintmp = match distances with
     | [] −> mintmp
     |(i,pi_i)::q −> let (j,pi_j) = mintmp in
          if (inf pi_i pi_j) && (appartient i sbar)
          then aux sbar q (i,pi_i) (* on a trouvé plus petit : on garde *)
          else aux sbar q mintmp
   in match distances with (* on cherche un premier mintmp avant d’appeler aux *)
     | [] −> failwith "distmin : l’un des arguments est vide"
     |(i,pi_i)::q −> if appartient i sbar
       then aux sbar q (i,pi_i)
       else distmin sbar q
;;


(* Interface longueur_arc
type : (’a * int) list −> ’a −> ’a −> int
arg : succ_i = successeurs de i
        i = extrêmité initiale de l’arc recherché
        j = son extrêmité finale
post : valeur de l’arc (i,j) si il existe, −1 sinon (représente l’infini) *)
let rec longueur_arc succ_i i j = if i=j then 0 else
   match succ_i with
     | []       −> −1
     |(t,d)::q −> if j=t then d else longueur_arc q i j
;;


(* Interface min2
type : int −> int −> int
arg : a b
pre : a est positif ou infini (égal à −1), b est positif
post : retourne le minimum des deux entiers en tenant compte de la possible infinitude de a *)
let min2 a b =
   if a < 0 then b else min a b
;;


(* Interface update
type : ’a graphevalue −> ’a list −> ’a −> int −> (’a * int) list −> (’a * int) list
arg : graphe
        sbar = liste de sommets
        j = sommet dont on veut mettre à jour les successeurs
        pi_j = distance de x0 à j (valeur définitive)
        distances = liste des couples (sommet, distance de sommet à x0)
pre : j est un sommet de graphe, pi_j non infini (différent de −1), distances contient les couples de
tous les sommets de graphe
post : pour chaque sommet i de sbar successeur de j, met à jour le couple correspondant si le chemin
 passant par j est plus court que l’actuel, ne modifie rien pour les autres *)
let rec update graphe sbar j pi_j distances = match distances with
   |[] −> []
   |(i,pi_i)::q −> let lji = longueur_arc (graphe.succ j) j i in
      if (lji > 0) && (appartient i sbar)             (* successeur de j dans sbar ? *)
      then (i,min2 pi_i (pi_j + lji))::(update graphe sbar j pi_j q)
      else (i,pi_i)::(update graphe sbar j pi_j q)    (* on ne modifie pas à i *)
;;


(* Interface init_dist
type : ’a −> ’a list −> (’a * int) list −> (’a * int) list
arg : x = sommet initial des chemins calculés
        sommets (du graphe)
        succ_x = successeurs de x
post : liste des couples (s, valeur de l’arc (x0,s)), cette valeur étant infinie si l’arc n’existe pas *)
let rec init_dist x sommets succ_x = match sommets with
   | [] −> []
   |t::q −> (t, longueur_arc succ_x x t)::(init_dist x q succ_x)
;;


(* Interface pluscourtschemins
type : ’a graphevalue −> ’a −> (’a * int) list
arg : graphe (valué)
        x = sommet de départ
pre : x est un sommet de graphe
post : liste des couples (s,l) où l est la plus petite des longueurs des chemins de x au sommet s.
        Utilise l’algorithme de Dijkstra *)
let pluscourtschemins graphe x =
   let rec aux graphe sbar distances =     (* on n’a pas besoin de x pour continuer *)
     let (j,pi_j) = distmin sbar distances in
       if (pi_j < 0) then distances (* si l’infini est la valeur minimum, on a fini *)
       else
         let sbar’ = retire j sbar in match sbar’ with
            | [] −> distances
            | _ −> aux graphe sbar’ (update graphe sbar’ j pi_j distances)
   in aux graphe (retire x (graphe.sommets)) (init_dist x graphe.sommets (graphe.succ x))
;;

**remya** · 19/05/2007, 10h36

Bonjour à tous,
Voici mon premier code en Camllight concernant le traitement d'images numériques. Ce programme calcul le produit de convolution d'une matrice u (image) et d'une matrice h (noyau) la matrice u étant de taille quelconque et la matrice h étant de taille impaire x impaire
Il ne nécéssite ni bibliothèque ni options particulieres.

Il se décompose en trois sous fonctions.

la premiere est la suivante; elle permet de calculer u*h (produit de convolution) au point (x y)

Code :

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

1
2
3
4
5
6
7
8
9
10
let convol_simpl_imp_imp h u x y = 
  let m = vect_length h and n = vect_length h.(0) in
    let a= ref 0 in     
      for i = -((m-1)/2) to ((m-1)/2) do
        for j = -((n-1)/2) to ((n-1)/2) do
          a := (  !a+  (  (  h.(i + ((m-1)/2)).(j + ((n-1)/2))   )*(u.(x+i).(y+j)) ) )
          done;
            done; 
(!a)
;;

on récupère la taille de h :

Code :

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

let m = vect_length h and n = vect_length h.(0) in

puis on applique la formule de convolution sur un espace discret (dans le cas simple ou la fonction représenté par u est à support borné.)

Code :

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

1
2
3
      for i = -((m-1)/2) to ((m-1)/2) do
        for j = -((n-1)/2) to ((n-1)/2) do
          a := (  !a+  (  (  h.(i + ((m-1)/2)).(j + ((n-1)/2))   )*(u.(x+i).(y+j)) ) )

On doit désormait appliquer cette fonction en chaque point de la matrice u; ainsi pour ne pas "déborder" on doit "grossir" la matrice u avant de lui appliquer h.
C'est à cela que sert la fonction suivante:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
let grossir_imp_imp u h  =

let k = vect_length u and l = vect_length u.(0) in 
let m = vect_length h and n = vect_length h.(0) in 
  let u_sec = make_vect (k+m-1) [|0;0|] in
    for i = 0 to (k+ m -2) do
      u_sec.(i)<-( make_vect (l+n-1) 0) done; 

for i = (m/2) to ((m/2)+k-1) do
  for j = (n/2) to ((n/2)+l-1) do 
    u_sec.(i).(j)<-(u.(i-(m/2)).(j-(n/2)))
  done; 
done;
u_sec ;;

la méthode est la suivante: on récupère la taille de u et celle de h :

Code :

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

1
2
let k = vect_length u and l = vect_length u.(0) in 
let m = vect_length h and n = vect_length h.(0) in

On crée la matrice de taille suffisante pour que h s'applique en tout points de u :

Code :

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

1
2
3
  let u_sec = make_vect (k+m-1) [|0;0|] in
    for i = 0 to (k+ m -2) do
      u_sec.(i)<-( make_vect (l+n-1) 0) done;

à se stade u_sec est une matrice pleine de 0 de la taille souhaitée. on place u en son centre.

Code :

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

1
2
3
4
5
for i = (m/2) to ((m/2)+k-1) do
  for j = (n/2) to ((n/2)+l-1) do 
    u_sec.(i).(j)<-(u.(i-(m/2)).(j-(n/2)))
  done; 
done;

On peut désormais appliquer h en tout points de u :

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
let convol_imp_imp h u = 
  let k = vect_length u and l = vect_length u.(0) in 
  let m = vect_length h and n = vect_length h.(0) in 

let u_sec = make_vect (k+m-1) [|0;0|] in
    for i = 0 to (k+ m -2) do
      u_sec.(i)<-( make_vect (l+n-1) 0) done; 

  let u_tres = ( grossir_imp_imp u h ) in
    
for i = (m/2) to ((m/2)+k-1) do
  for j = (n/2) to ((n/2)+l-1) do 
        u_sec.(i).(j)<-(convol_simpl_imp_imp h  u_tres i j ) 
      done;
    done;
u_sec ;;

à ce stade :
pour u = [|[|1;1;1|];[|2;2;2|]|] et h = [|[|0;-1;1|]|]
losrqu'on exécute grossir_imp_imp u h on obtient [|[|0; 1; 1; 1; 0|]; [|0; 2; 2; 2; 0|]|]
lorsqu'on exécute convol_imp_imp h u on obtient [|[|0; 0; 0; -1; 0|]; [|0; 0; 0; -2; 0|]|]

On peut cependant faire la même fonction qui rend le même résultat sans ajouter les zeros sur les contours:

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
let convol_nodark_imp_imp h u = 
 let k = vect_length u and l = vect_length u.(0) in 
  let m = vect_length h and n = vect_length h.(0) in

    let u_sec = make_vect k [|0;0|] in
      for i = 0 to (k-1) do
        u_sec.(i)<-(make_vect (l) 0) done;

    let u_tres = convol_imp_imp h u in 

      for i = (m/2) to ((m/2)+k-1) do
      for j = (n/2) to ((n/2)+l-1) do 
        u_sec.(i-(m/2)).(j-(n/2))<-u_tres.(i).(j) 
      done;
      done; 
u_sec ;;

il suffit en effet de recopier le résultat "utile" (ie le centre) de "convol_imp_imp h u " dans une matrice de la taille de u ... (il faut seulement décaler les indices dans le for.)

Voilà peut-être que ça servira à quelqu'un un jour ^^
Rémy.

**InOCamlWeTrust** · 19/05/2007, 13h48

Indente le code s'il te plaît et pense à la balise .

**SpiceGuid** · 03/06/2007, 19h04

Mes codes sources sont tous en Objective Caml 3.08 ou plus.

Je commence par quelques fonctions utilitaires pour les listes:

make génère une liste de n éléments à partir de l'élément a et en appliquant n-1 fois la fonction u:

Code :

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

1
2
3
let rec make u a n =
  if n=1 then a
  else let b=make u a (n-1) in u n b::b;;

exemple, générer les 10 premiers entiers:

Code :

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

make (fun _ l -> List.hd l + 1) [0] 10;;

autre exemple qui génére les 10 premiers nombres de fibonacci:

Code :

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

make (fun _ l -> List.nth l 0 + List.nth l 1) [1;0] 10;;

un dernier exemple qui génére les 10 premiers factoriels:

Code :

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

make (fun n l -> n * List.hd l) [1;0] 10;;

La fonction pair_list génère toutes les paires possibles formées à partir d'une liste l:

Code :

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

1
2
3
4
let rec pair_list l =
  match l with
  | []  -> []
  | a::l -> (List.map (fun b -> a,b) l) @ pair_list l;;

Enfin la fonction exists_commutative teste l'existence de deux éléments de la liste l qui vérifient le prédicat 2-aire commutatif cond:

Code :

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

1
2
3
4
5
6
let exists_commutative cond l =
  let rec loop l = 
    match l with
    | []   -> false
    | a::l -> (List.exists (cond a) l) or loop l   
  in loop l;;

**SpiceGuid** · 03/06/2007, 19h35

Je continue avec un algorithme rapide de calcul de PI en goutte-à-goutte, toujours en Objective-Caml.

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
let add  = Big_int.add_big_int
and sub  = Big_int.sub_big_int
and succ = Big_int.succ_big_int
and pred = Big_int.pred_big_int
and mult = Big_int.mult_big_int
and div  = Big_int.div_big_int
and add_int  = Big_int.add_int_big_int
and mult_int = Big_int.mult_int_big_int
and big_int  = Big_int.big_int_of_int
and int_of   = Big_int.int_of_big_int
;;

let pi () =
  let rec g q r t i =
    let i3 = mult_int 3 i in
    let u = mult_int 3 (mult (succ i3) (add_int 2 i3))
    and y = int_of (div (add (mult q (add_int (-12) (mult_int 27 i))) (mult_int 5 r)) (mult_int 5 t)) 
    in begin
      print_int y;
      flush stdout;
      g
      (mult_int 10 (mult q (mult i (pred (add i i)))))
      (mult_int 10 (mult u (sub (add (mult q (add_int (-2) (mult_int 5 i))) r) (mult_int y t))))
      (mult t u)
      (succ i);
      ()
    end
  in g (big_int 1) (big_int 180) (big_int 60) (big_int 2);; 

pi ();;

À compiler avec:

Code :

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

ocamlopt -unsafe -o pi.exe nums.cmxa pi.ml

Sinon dans l'interpréteur il vous faudra d'abord entrer cette commande:

Code :

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

#load "nums.cma";;

Les plus connaisseurs pourront encore accélérer l'algorithme à l'aide de la bibliothèque numerix de Michel Quercia.

**DavidDeharbe** · 28/04/2008, 19h25

Problème simple, illustrant l'utilisation des fonctions standard d'entrées et sorties.

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
83
84
85
86
87
88
(*
  monopoly.ml

  Source: Adapté d'un problème posé lors de la première phase des
  Olympiades Brésiliennes d'Informatique 2006, niveau Programmation 1.

  Description: Le monopoly est un des jeux les plus populaires au
  monde. Lors d'une partie, les joueurs peuvent acheter, vendre ou
  louer des propriétés.  Trois amis (Daniel, Etienne et François)
  veulent jouer au Monopoly, mais les billets ont été cachés par la
  petite soeur de Daniel. Ils tiennent leur comptes sur une feuille de
  papier. Écrivez un programme pour calculer le montant final du
  compte de chaque joueur.

  Entrée: L'entrée est lue du dispositif standard et est composé d'un
  jeu de test.  Un jeu de test est constitué par une première ligne
  qui contient deux nombres entiers, I e N.  I représente le montant
  initial de chaque joueur.  N représente le nombre d'opérations.
  Après cette première ligne, suivent N lignes; chacune de ces lignes
  décrit une opération et possède une des trois formes suivantes
  Achat: La lettre A, suivie de la lettre initiale d'un des joueurs J,
  et d'un nombre entier X, qui représente la valeur payée par le
  joueur J pour cet achat.  Vente: La lettre V, suivie de la lettre
  initiale d'un des joueurs J, et d'un nombre entier X, qui représente
  la valeur reçue par le joueur J pour cette vente.  Loyer: La lettre
  L, suivie de la lettre initiale d'un des joueurs J qui perçoit le
  loyer, suivie de la lettre initiale d'un des joueurs, qui paye le
  loyer, et d'un nombre entier X, qui représente le montant du loyer.
  Toutes les valeurs intermédiaires sont dans l'intervalle
  [0;1_000_000]

  Sortie: Le programme doit imprimer sur le dispositif standard de
  sortie le montant de chaque joueur à la fin de la partie.

  Exemple d'entrée:

10000 5
A D 5000
A E 3000
L D F 1000
V E 4000
L F E 1000

  Sortie correspondante:
6000 10000 10000

*)

let update_values (values : int * int * int) (j : char) (amount: int) =
  match values, j with
      (d, e, f), 'D' -> (d + amount, e, f)
    | (d, e, f), 'E' -> (d, e + amount, f)
    | (d, e, f), 'F' -> (d, e, f + amount)

let print_values =
  function (d, e, f) ->
    print_string 
      ((string_of_int d) ^ " " ^ 
	 (string_of_int e) ^ " " ^ 
	 (string_of_int f)  ^ "\n")

let rec process (values: int * int * int) (n : int) =
  if n = 0 then
    print_values values
  else
    Scanf.bscanf Scanf.Scanning.stdib "%c "
      (fun action ->
	 match action with
	     'A' ->
	       Scanf.bscanf Scanf.Scanning.stdib "%c %i\n"
		 (fun player amount ->
		    process (update_values values player (~- amount)) (n - 1))
	   | 'V' ->
	       Scanf.bscanf Scanf.Scanning.stdib "%c %i\n"
		 (fun player amount ->
		    process (update_values values player amount) (n - 1))
	   | 'L' ->
	       Scanf.bscanf Scanf.Scanning.stdib "%c %c %i\n"
		 (fun receives pays amount ->
		    process (update_values 
			       (update_values values receives amount) 
			       pays (~- amount)) (n - 1)))
		   
let _ =
  Scanf.bscanf Scanf.Scanning.stdib "%i %i\n" 
    (fun value operacoes -> 
       process (value, value, value) operacoes)

**SpiceGuid** · 30/05/2008, 23h02

Un de nos gentils membres a demandé s'il pouvait accéder au n-ième élément d'une liste comme avec un tableau (en temps constant).

La réponse est négative, toutefois à l'aide d'une VList on peut accéder au n-ième élément d'une liste en temps logarithmique sans dégrader la performance des opérations cons, hd et tl.

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

type 'a vector =
  {vect: 'a array; mutable hd: int; tl: 'a vlist}
and 'a vlist =
  | Nil
  | Node of 'a * 'a vlist 
  | Vect of int * 'a vector

let cons h t =
  match t with
  | Nil ->
      let v = {vect=Array.make 4 h; hd=0; tl=t}
      in  Vect(h,v)
  | Node _ ->
      Node(h,t)
  | Vect(h,v) ->
      if h=v.hd then begin
        v.hd <- v.hd + 1;
        if v.hd < Array.length v.vect then begin
          v.vect.(v.hd) <- h; Vect(v.hd,v)
        end else begin
          let w = {vect=Array.make (v.hd+v.hd) h; hd=0; tl=t}
          in  v.hd <- v.hd - 1; Vect(0,w)           
        end
      end else
        Node(h,t)      

let hd l =
  match l with
  | Nil -> failwith "hd"
  | Node(h,t) -> h
  | Vect(h,v) -> v.vect.(h)

let tl l =
  match l with
  | Nil ->  failwith "tl" 
  | Node(h,t) -> t
  | Vect(h,v) -> if h>0 then Vect(h-1,v) else v.tl

let rec nth l n =
  match l with
  | Nil -> failwith "nth"
  | Node(h,t) -> if n=0 then h else nth t (n-1)
  | Vect(h,v) -> if n <= h then v.vect.(h-n) else nth v.tl (n-h-1)

end

EDIT:
Contrairement à Phil Bagwell, dans le cas d'un partage j'ai préféré retourner à une liste ordinaire (sinon

la mémoire), et seule la liste "originale" bénéficie de l'accès en temps logarithmique. Pour un accès en temps logarithmique même en cas de partage et sans

la mémoire il faut des techniques plus avancées (à la Okasaki).

Il y a aussi la question du filtrage, on a pas de filtrage, d'où la nécessité des catamorphismes (ici fold_left et fold_right).

**InOCamlWeTrust** · 30/05/2008, 23h47

Dans la librairie de OCaml, il y a Set et Map aussi qui sont très bien... mais on peut faire un poil mieux (en travaillant beaucoup, par contre) avec les arbres AVL.

**gorgonite** · 30/05/2008, 23h51

Envoyé par InOCamlWeTrust

Dans la librairie de OCaml, il y a Set et Map aussi qui sont très bien... mais on peut faire un poil mieux (en travaillant beaucoup, par contre) avec les arbres AVL.

c'est quand même facile à coder un AVL... même dans des langages bas niveau où faut tout gérer (je me souviens d'une utilisation générique en C, ça m'a pris moins d'une aprem à coder

)

**SpiceGuid** · 31/05/2008, 00h21

Un AVL ne permet pas d'ajouter une donnée en temps constant.
Une table de hachage le fait mais n'est pas un TAD persistent (fonctionnel).

**gasche** · 12/09/2010, 16h53

Code haskell :

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
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** · 12/09/2010, 19h36

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

**gasche** · 12/09/2010, 21h03

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 :

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 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** · 13/09/2010, 12h42

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** · 27/03/2011, 19h13

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 :

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

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 :

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

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 :

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

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 :

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
(* 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 :

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
(* 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...

Page code source, mettez vos sources ici !

Langages fonctionnels

Vue hybride

Discussions similaires

Partager

Partager