Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (* AP1 TD8 *)
- #use "APutil.ml";;
- (* initialisation du tableau fortune *)
- let init(nbp : int) : int array =
- let t : int array = arr_make(nbp, 1000) in
- t
- ;;
- (* saisie controle d¡¯un entier dans l¡¯intervalle [a, b] *)
- let get_int(a, b : int * int) : int =
- let v : int ref = ref 0 and thend : bool ref = ref false in
- (
- while not( !thend)
- do
- print_string("saisissez une valeur comprise entre ") ;
- print_int(a);
- print_string(" et ");
- print_int(b);
- print_string(" : ");
- v := read_int();
- thend := ( !v >= a && !v <= b)
- done;
- !v
- )
- ;;
- (* exemple d'utilisation - valider la saisie par crtl-Entrée (mais pas la touche Entre du pavé numérique)*)
- let y : int = get_int(1,7);;
- (* choix du numero joue *)
- let choice_number(t : int array) : unit =
- let maxind : int = arr_len(t) - 1 in
- for i = 0 to maxind
- do
- print_string(" joueur numero ") ;
- print_int(i) ;
- print_string(", saisissez le numero sur lequel vous misez") ;
- print_newline() ;
- t.(i) <- get_int(0, 36)
- done
- ;;
- (* test de la fct choice_mumber *)
- let mytabmumber : int array = [|0;0;0;0;0|];;
- choice_number(mytabmumber);;
- mytabmumber;;
- (**** parenthese sur le fait de modifier un paremetre dans une fct ********)
- (* exemple d'une fct qui modifie son parametre *)
- let modifie( x : int ref): unit =
- x := 2* !x
- ;;
- let yy: int ref = ref 77;;
- modifie(yy);;
- yy;;
- (* le cas qui ne marche pas: le cast de y en int ref ne permet pas la modification de y *)
- let y: int = 7;;
- modifie( ref(y) );;
- y;; (* et non: y reste inchangé*)
- (************************************************ fin de la parenthese ***)
- (* choix de la mise *)
- let choice_bet(t, f : int array * int array) : unit =
- let maxind : int = arr_len(t) - 1 in
- for i = 0 to maxind
- do
- print_string(" joueur numero ") ;
- print_int(i) ;
- print_string(", saisissez votre mise") ;
- print_newline() ;
- t.(i) <- get_int(1, f.(i))
- done
- ;;
- (* calcul des mises par numero *)
- let compute_bet_per_number(num, be, tot, totbet : int array * int array * int array * int ref) : unit =
- let maxind : int = arr_len(num) - 1 in
- (
- for i = 0 to 36
- do tot.(i) <- 0
- done ;
- for i = 0 to maxind
- do
- tot.(num.(i)) <- tot.(num.(i)) + be.(i) ;
- totbet := !totbet + be.(i)
- done
- )
- ;;
- (* calcul des gains *)
- let compute_gain(num, be, tot, totbet, gain, n : int array * int array * int array * int ref * int array * int) : unit =
- let maxind : int = arr_len(num) - 1 and hasbet : bool ref = ref false in
- (
- for i = 0 to maxind
- do
- if num.(i) = n
- then
- (
- hasbet := true ;
- gain.(i) <- ( !totbet * be.(i)) / tot.(n)
- )
- else gain.(i) <- - be.(i)
- done ;
- if !hasbet
- then totbet := 0
- else ()
- )
- ;;
- (* fonction de simulation *)
- let simul(nb, nbPlayers : int * int) : int array =
- let fortune : int array = init(nbPlayers)
- and number : int array = arr_make(nbPlayers, 0)
- and bet : int array = arr_make(nbPlayers, 0)
- and total : int array = arr_make(37, 0)
- and totalbet : int ref = ref 0
- and gain : int array = arr_make(nbPlayers, 0)
- and n : int ref = ref 0
- and maxind : int = nbPlayers - 1
- in
- (
- for i = 1 to nb
- do
- choice_number(number);
- choice_bet(bet, fortune);
- compute_bet_per_number(number, bet, total, totalbet);
- n := rand_int(0, 36);
- print_string("numero gagnant : ");
- print_int( !n);
- print_newline();
- compute_gain(number, bet, total, totalbet, gain, !n);
- for i = 0 to maxind
- do fortune.(i) <- fortune.(i) + gain.(i)
- done
- done ;
- fortune
- )
- ;;
- (* exo 25 ------------------------------------------------------------------------------*)
- (* definition des types et creation du tableau *)
- type t_date = {d : int ; m : int ; y : int} ;;
- type t_member = {name : string ; birth : t_date} ;;
- (* fonction replace *)
- let replace(t, member, i : t_member array * t_member * int) : unit =
- if not(0 <= i && i <= arr_len(t) - 1)
- then failwith "erreur replace : erreur d’indice"
- else t.(i) <- member
- ;;
- (* fonction inf_date *)
- let inf_date(d1, d2 : t_date * t_date) : bool =
- (d1.y < d2.y) || ((d1.y = d2.y) && ((d1.m < d2.m) || ((d1.y = d2.y) && (d1.m = d2.m) && (d1.d <= d2.d))))
- ;;
- (* la case 0 du tableau n est pas utilisée *)
- (* fonction youngest_member *)
- let youngest_member(t : t_member array) : t_member =
- let n : int = arr_len(t) in
- if n = 0
- then failwith "erreur youngest_member : tableau de longueur nulle"
- else
- let member : t_member ref = ref (t.(1))
- in
- (
- for i = 2 to n - 1
- do
- (* inf_date renvoie VRAI si la 1ere date est antérieure (donc plus vielle) que la seconde *)
- (* on mémorisera le membre de la case du moment s'il est plus jeune que le plus jeune pécédement trouvé *)
- if inf_date( (!member).birth, (t.(i)).birth) )
- then member := t.(i)
- else ()
- done ;
- !member
- )
- ;;
- (* fonction oldest_member *)
- let oldest_member(t : t_member array) : t_member =
- let n : int = arr_len(t)
- in
- if n = 0
- then failwith "erreur oldest_member : tableau de longueur nulle"
- else
- let member : t_member ref = ref (t.(1)) in
- (
- for i = 2 to n - 1
- do
- if inf_date((t.(i)).birth, ( !member).birth)
- then member := t.(i)
- else ()
- done ;
- !member
- )
- ;;
- (* test *)
- let t : t_member array = arr_make(20, {name = "truc" ; birth = {d = 20 ; m = 1 ; y = 2001}}) ;;
- replace(t, {name = "machin" ; birth = {d = 4 ; m = 6 ; y = 2007}}, 2) ;;
- youngest_member(t) ;;
- oldest_member(t) ;;
- (* exercice 26 --------------------------------------------------------------*)
- (* saisie de n valeurs comprises entre v_min et v_max *)
- let get_nval(n, v_min, v_max : int * float * float) : float array =
- let t : float array = arr_make(n, 0.0) and indmax : int = n - 1 in
- (
- for i = 0 to indmax
- do t.(i) <- get_float(v_min, v_max)
- done ;
- t
- )
- ;;
- (* calcul de la somme, moyenne, min et max d’un tableau *)
- let comp_val(t : float array) : float * float * float * float =
- let ln : int = arr_len(t) in
- let indmax : int = ln - 1 in
- if ln = 0
- then failwith "erreur comp_val : tableau vide"
- else
- let sum : float ref = ref t.(0) and min : float ref = ref t.(0)
- and max : float ref = ref t.(0)
- in
- (
- for i = 1 to indmax
- do
- sum :=!sum +. t.(i);
- if !min > t.(i)
- then min := t.(i);
- if !max < t.(i)
- then max := t.(i)
- else ()
- done ;
- (!sum, !sum /. float_of_int(ln), !min, !max)
- )
- ;;
- (* saisie et calcul *)
- let main(v_min, v_max : float * float) : float array * float * float * float * float =
- let n : int = get_intpos() in
- let t : float array = get_nval(n, v_min, v_max) in
- let (sum, avg, min, max) : float * float * float * float = comp_val(t) in
- (t, sum, avg, min, max)
- ;;
- (* exercice 27 --------------------------------------------------------------*)
- let tab : int array = [|12;6;3;1;0;-1|];;
- let mirror(t : int array) : int array =
- let ln : int = arr_len(t) in
- let indmax : int = ln - 1
- and r : int array = arr_make(ln, 0)
- in
- (
- for i = indmax downto 0
- do r.(i) <- t.(indmax - i)
- done;
- r
- )
- ;;
- let mirror_bis(t : int array) : unit =
- let ln : int = arr_len(t) in
- let indmax : int = ln - 1
- and r : int array = arr_make(ln, 0)
- in
- (
- (* inverse les valeurs vers un tableau intermediaire *)
- for i = indmax downto 0
- do r.(i) <- t.(indmax - i)
- done;
- (* recopioe des valeurs inversées dans le tab source*)
- for i = 0 to indmax
- do t.(i) <- r.(i)
- done;
- )
- ;;
- tab;;
- let inverse : int array = mirror(tab);;
- mirror_bis(tab);;
- tab;;
- (* exercice 28 --------------------------------------------------------------*)
- let seek(v, t : int * int array) : bool =
- let n : int = arr_len(t) in
- let exist : bool ref = ref false and thend : bool ref = ref false
- and indmax : int = n - 1 and i : int ref = ref (-1)
- in
- (
- while not( !thend)
- do
- i := !i + 1;
- if !i <= indmax
- then
- (
- exist := (v = t.( !i));
- thend := !exist
- )
- else thend := true
- done;
- !exist
- )
- ;;
- (* variante rendant en plus l’indice *)
- let seek(v, t : int * int array) : bool * int =
- let n : int = arr_len(t) in
- let exist : bool ref = ref false and thend : bool ref = ref false
- and indmax : int = n - 1 and i : int ref = ref (-1) in
- (
- while not( !thend)
- do
- i := !i + 1 ;
- if !i <= indmax
- then
- (
- exist := (v = t.( !i)) ;
- thend := !exist
- )
- else thend := true
- done ;
- (!exist, !i)
- )
- ;;
- (* exercice 29 --------------------------------------------------------------*)
- let simul() : int * int array =
- let t : int array = arr_make(20, 0) and thend : bool ref = ref false
- and nb : int ref = ref 0 and v : int ref = ref 0 in
- (
- while not( !thend)
- do
- nb := !nb + 1 ;
- v := rand_int(1, 20) ;
- t.( !v - 1) <- t.( !v - 1) + 1 ;
- thend := ( !v = 20)
- done ;
- (!nb, t)
- )
- ;;
- (* exercice 30 --------------------------------------------------------------*)
- let shift_left(t : int array) : unit =
- let ln : int = arr_len(t) in
- let indmax : int = ln - 1 and c : int ref = ref 0 in
- if ln <> 0
- then
- (
- c := t.(0);
- for i = 1 to indmax
- do t.(i-1) <- t.(i)
- done;
- t.(indmax) <- !c
- )
- else ()
- ;;
- let shift_right(t : int array) : unit =
- let ln : int = arr_len(t) in
- let indmax : int = ln - 1 and c : int ref = ref 0 in
- if ln <> 0
- then
- (
- c := t.(indmax);
- for i = indmax downto 1
- do t.(i) <- t.(i - 1)
- done ;
- t.(0) <- !c
- )
- else ()
- ;;
- (* exercice 31 --------------------------------------------------------------*)
- let comp_sin(n : int) : (float * float) array =
- if n <= 0
- then failwith "erreur comp_sin : parametre negatif"
- else
- (
- let pi : float = 3.141592653589793 and t = arr_make(n+1, (0.0, 0.0))
- and x : float ref = ref 0.0 and y : float ref = ref 0.0
- in
- let dx : float = (2.0 *. pi) /. float_of_int(n) in
- for i = 0 to n
- do
- x := -. pi +. float_of_int(i) *. dx ;
- y := sin( !x) ;
- t.(i) <- ( !x, !y)
- done ;
- t
- )
- ;;
- (* exercice 32 --------------------------------------------------------------*)
- (* types *)
- type t_prod = {name : string ; cat : string ; nb : int ref ; price : int ref} ;;
- type t_date = {year : int ; month : int ; day : int} ;;
- type t_mem = {forename : string ; name : string ; birth : t_date ; amount : int ref} ;;
- type t_products = t_prod array ;;
- type t_members = t_mem array ;;
- (* fonction testant l’existence d’un produit de nom donne *)
- let prod_exists(name, tp : string * t_products) : bool * int =
- let ln : int = arr_len(tp) in
- let indmax : int = ln - 1 and found : bool ref = ref false and
- thend : bool ref = ref false and i : int ref = ref (-1)
- in
- (
- while not( !thend)
- do
- i := !i + 1 ;
- if !i > indmax
- then thend := true
- else
- if (tp.( !i)).name = name
- then
- (
- found := true ;
- thend := true
- )
- else i := !i + 1
- done ;
- (!found, !i)
- )
- ;;
- (* ajout de n exemplaires du produit de nom donne *)
- let add_product(name, nb, tp : string * int * t_products) : unit =
- let (b, i) : bool * int = prod_exists(name, tp) in
- if b
- then (tp.(i)).nb := !((tp.(i)).nb) + nb
- else (
- print_string("produit non en stock");
- print_newline();
- )
- ;;
- (* modification des prix d’un certain taux ; ici, le taux est un entier a diviser par 100 *)
- let mod_price(tp, rate : t_products * int) : unit =
- let ln : int = arr_len(tp) in
- let indmax : int = ln - 1 in
- for i = 0 to indmax
- do (tp.(i)).price := ( !((tp.(i)).price) * rate) / 100
- done
- ;;
- (* achat d’un produit ; il faut une fonction de recherche d’un client *)
- let mem_exists(name, tc : string * t_members) : bool * int =
- let ln : int = arr_len(tc) in
- let indmax : int = ln - 1 and found : bool ref = ref false
- and thend : bool ref = ref false and i : int ref = ref (-1) in
- (
- while not( !thend)
- do
- i := !i + 1 ;
- if !i > indmax
- then thend := true
- else
- if (tc.( !i)).name = name
- then
- (
- found := true ;
- thend := true
- )
- else i := !i + 1
- done ;
- ( !found, !i)
- )
- ;;
- let buy(c_name, p_name, n, tc, tp : string * string * int * t_members * t_products) : bool =
- let (bc, ic) : bool * int = mem_exists(c_name, tc)
- and (bp, ip) : bool * int = prod_exists(p_name, tp)
- and pricetot : int ref = ref 0 in
- if bc && bp
- then
- (
- pricetot := n * !(tp.(ip).price) ;
- if !(tc.(ic).amount) >=!pricetot
- then
- (
- tc.(ic).amount := !(tc.(ic).amount) - !pricetot ;
- tp.(ip).nb := !(tp.(ip).nb) - n ;
- true
- )
- else false
- )
- else false
- ;;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement