Page code source, mettez vos sources ici !

[Jedai]

Et quel serait l'intérêt exactement ? Si tu veux tu peux écrire ton interface avec les parenthèses que tu veux, et ces différents placements de parenthèses ne changent absolument rien du point de vue pratique, le seul endroit où tu les vois c'est dans l'interpréteur (très nul) d'OCaml.

--
Jedaï

[SpiceGuid]

Tu as raison, d'ailleurs la vraie bonne idée pour OCamlWin ça serait déjà qu'il arrête de planter à tout bout de champ, alors là je dirais

[millie]

Je sais que c'est bidon, mais c'était pour répondre à quelqu'un...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
(* Donne le maximum entre le maximum de la liste l  et de maxi *)
let rec getMaxC l maxi =
 match l with
 [] -> maxi
 | a::p -> getMaxC p (max a maxi);;

(*maximum de la liste l et Erreur si la liste est vide *)
let getMax l =
 match l with
  [] -> failwith "Erreur"
  | a::p -> getMaxC p a;;

(*version en complexité quadratique*)
let rec getMaxQuadra l =
  match l with
    a::[] -> a
   |a::p -> max a (getMaxQuadra p)
   | _   -> failwith "Erreur";;

getMax [1;4;5;7;12;3];;
getMaxQuadra [1;4;5;7;12;3];;

[SpiceGuid]

Et pourquoi tu lui as pas répondu:

Code :

let getMaxC l maxi = List.fold_left max maxi l;;

[millie]

Envoyé par SpiceGuid

Et pourquoi tu lui as pas répondu:

Code :

let getMaxC l maxi = List.fold_left max maxi l;;

C'était pour du caml light (et la manière de construire le getMaxC était importante car la partie "algo" (entre guillemet parce que ce n'est pas non plus très violent) était plus importante dans mon exemple )

[SpiceGuid]

Un petit module qui contient quelque fonctions élémentaires parfois utiles comme paramètre d'une fonctionnelle:

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
(*
 * Author:  Damien Guichard (aka SpiceGuid)
 * Created: 11 fev 2008
 * Updated: 11 fev 2008
 * License: Creative Commons http://creativecommons.org/licenses/by/3.0/
 *)

module Fun = struct

let id x = x
let const c x = c
let const2 c a b = c

let opp p x = not (p x)  
let opp2 p a b = not (p a b) 
let both   f g x = f x && g x 
let either f g x = f x or g x 
let both2   f g a b = f a b && g a b 
let either2 f g a b = f a b or g a b

let cons a l = a::l
let pair a b = a,b
let first a b = a
let second a b = b
let flip f a b = f b a

let (<<) g f x = g (f x)
let (>>) f g x = g (f x)
let (|>) x f = f x
let (<|) f x = f x

let power mult one x n =
  assert (n >= 0);
  let rec loop n =
    if n=0 then one
    else if n=1 then x
    else
      let p = loop (n asr 1) in
      if (n land 1 = 0) then mult p p 
      else mult x (mult p p)
  in loop n

end;;

Edit (suite aux remarques de Jedai):

• always et never sont généralisés par const et const2
• j'ai renommé fst, snd et not (pour ceux qui aiment "ouvrir" les modules)
• same devient id, opp devient opp2
• nouvelle fonction power

[SpiceGuid]

Un autre module qui contient des fonctions sur les listes, sauf mention contraire toutes les fonctions sont récursives terminales.

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
(*
 * Author:  Damien Guichard (aka SpiceGuid)
 * Created: 11 fev 2008
 * Updated: 12 fev 2008
 * License: Creative Commons http://creativecommons.org/licenses/by/3.0/
 *)

module Seq = struct

(* not tail recursive *)
let fold f init l =
  let rec helper l =
    match l with
    | [] -> init
    | a::l -> f (helper l) a
  in helper l

let rec rev_fold f init l =
  match l with
  | [] -> init
  | a::l -> rev_fold f (f init a) l

(* not tail recursive *)
let fold2 f init l1 l2 =
  let rec helper l1 l2 =
    match l1 , l2 with
    | [], [] -> Some init
    | a1::l1 , a2::l2 ->
        ( match helper l1 l2 with
        | None   -> None
        | Some h -> Some (f h a1 a2)
        ) 
    | _ , _ -> None
  in helper l1 l2

let rec rev_fold2 f init l1 l2 =
  match l1 , l2 with
  | [] , [] -> Some init
  | a1::l1 , a2::l2 -> rev_fold2 f (f init a1 a2) l1 l2
  | _ , _ -> None

let range a b =
  let rec loop n acc =
    if n = a then a::acc
    else loop (pred n) (n::acc)
  in if a <= b then loop b [] else []

let rec last l =
  match l with
  | []   -> None
  | [a]  -> Some a
  | a::l -> last l

(* not tail recursive *)
let rec poset l =
  match l with
  | [] -> [[]]
  | a::l ->
      let t = poset l
      in  List.rev_append (List.rev_map (fun x -> a::x) t) t

(* not tail recursive *)
let mapi f n l =
  let rec helper n l =
    match l with
    | []   -> []
    | h::t -> (f n h)::helper (succ n) t
  in helper n l

let rev_mapi f n l =
  let rec loop n l acc =
    match l with
    | [] -> acc
    | h::t -> loop (succ n) t (f n h::acc)
  in loop n l []

(* not tail recursive *)
let rev_iter f l =
  let rec helper l =
    match l with
    | [] -> ()
    | a::l -> helper l; f a
  in helper l

let rev_filter p l =
  let rec loop l acc =
    match l with
    | [] -> acc
    | h::t ->
        if p h then loop t (h::acc)
        else loop t acc
  in loop l []

let rev_append_map_filter p f l1 l2 =
  let rec loop l acc =
    match l with
    | [] -> acc
    | h::t ->
        if p h then loop t (f h::acc)
        else loop t acc
  in loop l1 l2

let exists_product p l =
  let rec loop l =
    match l with
    | []   -> false
    | h::t -> (exists (p h) t) or loop t
  in loop l

(* not tail recursive *)
let filter_product p l1 l2 =
  let rec helper l =
    match l with
    | []  -> []
    | a::l -> rev_append_map_filter (p a) (fun b -> a,b) l2 (helper l) 
  in helper l1

let filter_circular p l =
  let rec loop prev l acc = 
    match l with
    | [] -> acc
    | h::t ->
        if p prev h then loop h t ((prev,h)::acc)
        else loop h t acc
  in match last l with
  | None -> [] 
  | Some a -> loop a l []

let lexicographical (cmp: 'a ->'a->int) l1 l2 =
  let rec loop l1 l2 =
    match l1,l2 with
    | [],[] -> 0
    | [],_ -> -1
    | _,[] ->  1
    | a::t1,b::t2 ->
        let r = cmp a b in
        if r = 0 then loop t1 t2
        else r
  in loop l1 l2

end;;

[SpiceGuid]

Le Tutoriel de millie présente les graphes et leur parcours en OCaml.

Le chapitre 33 de mon tutoriel présente également un algorithme de parcours pour les graphes dirigés avec racine.

La version de millie est complètement fonctionnelle, alors que la mienne utilise un marquage des sommets déjà traversés.

Je donne ici une version 100% fonctionnelle de mon code.

Dans cette nouvelle version la notion de flèche devient explicite avec le type arrow :

Code :

1
2
3
4
5
6
type 'a node =
  {point: 'a; arrows: 'a arrow list}
and  'a arrow =
  | B of 'a node
  | W of 'a node
;;

Les flèches sont colorées, ou bien black (B) ou bien white (W).
Une flèche white conduit à un noeud jamais traversé.
Une flèche black conduit à un noeud déjà traversé.

Il n'y a plus ni d'horloge ni de champ mutable.
Les fonctions du chapitre 33 deviennent alors:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
let length_graph g =
  let rec loop acc g =
    match g with
    | B g -> acc
    | W g -> List.fold_left loop (acc+1) g.arrows
  in loop 0 g;;

let exists_graph p g =
  let rec loop g =
    match g with
    | B g -> false
    | W g -> (p g.point) or List.exists loop g.arrows
  in loop g;;

let flatten_graph g =
  let rec loop acc g =
    match g with
    | B g -> acc
    | W g -> List.fold_left loop (g.point::acc) g.arrows
  in List.rev (loop [] g);;

Remarque sur le type de ces fonctions: un digraph n'est plus désigné par un sommet racine mais par une flèche racine.





La fonction qui construit l'automate de cette figure devient:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
let r_graph () =
  let
  rec a = {point= 'a'; arrows= [W t;W y;W c] }
  and c = {point= 'c'; arrows= [W e]         }
  and d = {point= 'd'; arrows= [B e]         }
  and e = {point= 'e'; arrows= []            }
  and i = {point= 'i'; arrows= [B c;W d]     }
  and l = {point= 'l'; arrows= [B e]         }
  and m = {point= 'm'; arrows= [B e]         }
  and o = {point= 'o'; arrows= [W l;W m;W p;W s;W w] }
  and p = {point= 'p'; arrows= [B e]         }
  and r = {point= 'r'; arrows= [W a;W i;W o;W u] }
  and s = {point= 's'; arrows= [B e]         }
  and t = {point= 't'; arrows= []            }
  and u = {point= 'u'; arrows= [B d;B l]     }
  and w = {point= 'w'; arrows= []            }
  and y = {point= 'y'; arrows= []            }
  in  W r;;

Enfin la fonction reconnaisseur pour un automate devient:

Code :

1
2
3
4
5
6
7
8
let rec recognized l auto =
  match auto with
  | B auto | W auto ->
  match l with
  | [] -> false
  | c::[] -> auto.point=c && auto.arrows=[] 
  | c::l  -> auto.point=c && List.exists (recognized l) auto.arrows
  ;;

J'avoue avoir des doutes sur ce code... Comment est ce que tu peux "colorier" un sommet en coloriant les fleches qui arrivent dessus puisque tu n'as aucun moyen de trouver les antecedants? Et en plus tu ne "changes" à aucune moment la moindre couleur. La fonction length par exemple boucle sur un sommet ayant une simple fleche blanche vers lui même.
J'ai loupé un truc ?

[SpiceGuid]

Les flèches ne sont pas coloriées (à la traversée), elles sont colorées (à la création).

"lui-même" c'est un noeud déjà traversé, donc flèche noire vers "lui-même".

Envoyé par SpiceGuid

Les flèches ne sont pas coloriées (à la traversée), elles sont colorées (à la création).

"lui-même" c'est un noeud déjà traversé, donc flèche noire vers "lui-même".

Mais euh... comment est ce qu'on décide à la création quel noeud est déjà traversé ? Et pourquoi "lui-même" serait "déjà traversé" ? Et à la rigueur, tu fais pareil avec deux noeuds, chacun pointant vers l'autre

[SpiceGuid]

Code :

1
2
3
4
5
6
7
8
9
# let graph_2 () =
  let
  rec p1 = {point=1; arrows= [W p2]}
  and p2 = {point=2; arrows= [B p1]}
  in  W p1;;
val graph_2 : unit -> int arrow = <fun>
# flatten_graph (graph_2 ());;
- : int list = [1; 2]

Je ne comprends vraiment pas le principe de précolorier un graphe avant de le parcourir... En fonctionel pure, je comprendrais de conserver l'ensemble des sommets déjà parcouru, mais attribuer des couleurs "avant" pour que le parcours se passe "bien", ça sert à quoi ?

[SpiceGuid]

C'est fonctionnel pur ou du moins je crois que ça l'est.
D'autre part ça conserve l'ensemble des sommets déjà parcourus, mais je peux faire fausse route, c'est écrit accoudé au comptoir, c'est pas comme si c'était du code tiré d'une application réelle.

Envoyé par SpiceGuid

C'est fonctionnel pur ou du moins je crois que ça l'est.

C'est effectivement fonctionnel pur puisqu'il n'y a ni référence ni champ mutable. Mais à part ça... Il n'est pas vraiment normal d'avoir à définir le graphe à l'avance spécifiquement pour que le parcours "se passe bien" ! Et surtout, ça ne passe pas à l'échelle, et ce n'est pas adapté à des graphes générés automatiquements.

Je pense qu'une bonne façon de faire est de passer l'ensemble des sommets déjà rencontrés en argument (par exemple en donnant un identifiant unique à chaque sommet et en mettant les identifiants déjà rencontré dans un Map.Make(Int))

[SpiceGuid]

Lex est un module dédié à l'analyse lexicale/syntaxique récursive descendante.

Comme il serait trop long ici d'en détailler l'usage de façon réaliste, je vous renvoie à la partie VII de mon tutoriel.

Les avantages du module Lex :

• aucun métalangage, aucun fichier de configuration, aucune commande shell, aucune source générée
• ultra léger, le module ne fait que 250 lignes de ocaml
• mots clés contextuels, par exemple vous pouvez décider que private, public, protected ne sont pas des mots réservés mais sont quand même des mots-clés à l'intérieur d'une portée class...end
• opérateurs dynamiques et mots réservés dynamiques, ils n'ont pas de liste préfixée, vous pouvez en ajouter ou en soustraire à la volée
• possibilité d'avoir des commentaires dirigés par la syntaxe, utile pour les langages très verbeux comme par Eiffel dont la norme spécifie le contenu des commentaires à certain endroit du code (notamment les en-têtes de classes et de procédures)

Les inconvénients du module Lex :

• comme dans toute analyse descendante vous devez gérer manuellement la priorité des opérateurs
• les commentaires ne peuvent pas être placés librements (todo)
• pas de commentaires multi-lignes (todo)

L'archive jointe ci-desous contient:

• Lex.ml (un analyseur lexical générique en ocaml)
• TP5.ml (un analyseur syntaxique pour Turbo Pascal 5 en ocaml)
• TP5.exe (l'exécutable pour Win32)
• TP5 (l'exécutable pour Linux x86)

L'exécutable lit la source en pascal sur stdin (donc à rediriger depuis un fichier si nécessaire).


TP5 est un analyseur récursive descendant pour une syntaxe très proche de Turbo Pascal 5.
Les principales différences avec Turbo Pascal 5 sont:

• pas d'instruction case expr of
• pas de constantes real sous la forme mantisse + exposant
• pas de types ensemble set of ni de types intervalle
• pas d'enregistrements variants
• pas de transtypage
• pas de labels ni de goto
• pas d'asm
• commentaires delphi // uniquement, donc pas de commentaires (* *) ou {}
• afin de simplifier au maximum le code, et dans le seul souci de faciliter l'apprentissage par les débutants, quelques menues déviations à TP5 ont été volontaire introduites. par exemple dans une séquence begin...end la dernière instruction. il ne s'agit ni d'une erreur ni d'une limitation du module Lex.

[DavidDeharbe]

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

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

[gorgonite]

Classe pour gérer les intervalles


Pour les personnes ayant besoin de faire un peu d'analyse de code, voici une classe prête à l'emploi pour manipuler des intervalles sur des domaines tels que |R

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
#light

type 'a type_inf =
  MinInf | Type of 'a | MaxInf
with
  override this.ToString () = 
    match this with
    |Type(t) -> any_to_string t
    |_ -> any_to_string this
end

type 'a Interval() =
  let mutable (up : 'a type_inf) = MaxInf
  let mutable (low : 'a type_inf) = MinInf

  member self.Up
    with  get() = up
    and  set(u) = up <- u
  member self.Low
    with  get() = low
    and  set(l) = low <- l
  
  override obj.ToString () = 
    Printf.sprintf "[%A;%A]" low up
  
  member obj.copy () =
    Interval(Low=obj.Low , Up=obj.Up)
  
  member obj.reset () =
    obj.Up <- MaxInf
    obj.Low <- MinInf 
  
  member obj.check () = 
    obj.Low <= obj.Up 
  
  member obj.matchValue x =
    obj.Up=x && obj.Low=x
  
  member obj.matchInterval (i : 'a Interval) =
    obj.Up=i.Up && obj.Low=i.Low
  
  member obj.setValue x =
    obj.Up <- x
    obj.Low <- x
  
  member obj.isIncluded (i : 'a Interval) =
    obj.Low>=i.Low && obj.Up<=i.Up

  member obj.intersect (i : 'a Interval) =
    let res = Interval(Low=(max obj.Low i.Low) , Up=(min obj.Up i.Up))
    if not (res.check ()) 
    then
      res.Up <- MinInf
      res.Low <- MaxInf
    res

[SpiceGuid]

Juste pour te faire honte et afin que personne ne prenne exemple sur toi:

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
type 'a interval =
  | Empty
  | Whole               (* unbounded      *)
  | Greater of 'a       (* lower bound    *)
  | Lesser  of 'a       (* greater bound  *)
  | Interval of 'a * 'a (* double bounded *) 
  | Product  of 'a interval list (* multi-dimensional *)

let rec includes a b =
  match a,b with
  | _,Empty -> true
  | Whole,_ -> true
  | Lesser x,Lesser y -> x >= y 
  | Greater x,Greater y -> x <= y
  | Lesser z,Interval(x,y)  -> z >= y
  | Greater z,Interval(x,y) -> z <= x
  | Interval(u,v),Interval(x,y) -> u <= x && v >= y
  | Product a,Product b -> List.for_all2 includes a b
  | _ -> false

let rec intersection a b =
  match a,b with
  | _,Whole -> a
  | Whole,_ -> b
  | Greater x,Lesser y when x < y ->
      Interval(x,y)
  | Lesser x,Greater y when x > y ->
      Interval(y,x)
  | (Interval(x,y),Lesser z  | Lesser z,Interval(x,y)) when z > x  ->
      Interval(x,z)
  | (Interval(x,y),Greater z | Greater z,Interval(x,y)) when z < y ->
      Interval(z,y)
  | Interval(u,v),Interval(x,y) when v > x && u < y ->
      Interval(max u x,min v y)
  | Product a,Product b ->
      Product (List.map2 intersection a b)
  | _,_ -> Empty

Edit: j'ai amélioré le code pour mettre l'accent sur la sémantique (à l'aide d'un type inductif) plutôt que sur la concision

[gorgonite]

Envoyé par SpiceGuid

Juste pour te faire honte et afin que personne ne prenne exemple sur toi:

Code :

et comment fais-tu pour le cas de l'intervalle égal à l'ensemble des réels ?
il y a deux représentations alors qu'il s'agit du cas "standard" ; mais il est vrai que ta version est bien plus compacte



j'ai quand même mis pas mal de temps pour choisir mon type... qui est certes simple, mais que je n'arrivais pas à rendre plus contraignant

en effet, on a plusieurs représentations pour l'ensemble vide (comme le tien), et ça ne me plait pas trop