(* Afficher la fenêtre graphique *) let _ = Graphics.open_graph " 512x512" (**************************************) (* Déclarations des types de l'énoncé *) (**************************************) type couleur = Blanc | Noir type arbre = | Feuille of couleur | Noeud of arbre * arbre * arbre * arbre type image = couleur array array (**************) (* Question 1 *) (**************) let rec compte_feuilles a = match a with | Feuille _ -> 1 | Noeud (c1,c2,c3,c4) -> compte_feuilles c1 + compte_feuilles c2 + compte_feuilles c3 + compte_feuilles c4 (**************) (* Question 2 *) (**************) let rec do_vers_arbre img i j k = if k <= 1 then Feuille img.(i).(j) else let k2 = k/2 in let c1 = do_vers_arbre img i (j+k2) k2 and c2 = do_vers_arbre img (i+k2) (j+k2) k2 and c3 = do_vers_arbre img i j k2 and c4 = do_vers_arbre img (i+k2) j k2 in match c1,c2,c3,c4 with | Feuille n1, Feuille n2, Feuille n3, Feuille n4 when n1 = n2 && n2 = n3 && n3 = n4 -> c1 | _,_,_,_ -> Noeud (c1,c2,c3,c4) let image_vers_arbre k img = do_vers_arbre img 0 0 k (* Test de image_vers_arbre *) let img = [| [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Blanc ;Blanc ;Blanc ;Blanc ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Blanc ;Blanc ;Blanc ;Blanc ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir; Blanc ;Blanc ;Blanc ;Blanc ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir;Blanc ;Blanc ;Blanc ;Blanc ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ;Blanc ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; |] ; [| Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ;Noir ; |] ; |] let a = image_vers_arbre (Array.length img) img let _ = Printf.printf "Devrait etre 7: %d\n" (compte_feuilles a) ; flush stdout (* Question 2 *) let rec do_dessine i j k a = match a with | Feuille Noir -> Graphics.fill_rect i j k k | Feuille Blanc -> () | Noeud (c1,c2,c3,c4) -> let k2 = k/2 in do_dessine i (j+k2) k2 c1 ; do_dessine (i+k2) (j+k2) k2 c2 ; do_dessine i j k2 c3 ; do_dessine (i+k2) j k2 c4 let dessine_arbre k a = do_dessine 0 0 k a (**************) (* Question 3 *) (**************) let rec inverse a = match a with | Feuille Blanc -> Feuille Noir | Feuille Noir -> Feuille Blanc | Noeud (c1,c2,c3,c4) -> Noeud (inverse c1, inverse c2, inverse c3, inverse c4) (* 3 -> 4 -> 2 -> 1 *) let rec rotate a = match a with | Feuille _ -> a | Noeud (c1,c2,c3,c4) -> Noeud (rotate c2,rotate c4, rotate c1, rotate c3) (* 1 -> 2 -> 4 -> 3 *) let rec antirotate a = match a with | Feuille _ -> a | Noeud (c1,c2,c3,c4) -> Noeud (antirotate c3,antirotate c1, antirotate c4, antirotate c2) (* Test des rotations *) let rec q3 a = Graphics.clear_graph () ; dessine_arbre 512 a ; let rec do_rec () = let c = Graphics.read_key () in if c = 'n' then q3 (rotate a) else if c = 'p' then q3 (antirotate a) else if c = 'i' then q3 (inverse a) else if c = 'q' then () else do_rec () in do_rec () let _ = q3 a (**************) (* Question 4 *) (**************) let rec fractale n = if n <= 0 then Feuille Noir else let c = fractale (n-1) in let c1 = Noeud (c,c,c,Feuille Blanc) in let c3 = rotate c1 in let c4 = rotate c3 in let c2 = rotate c4 in Noeud (c1,c2,c3,c4) let rec q4 i = dessine_arbre 512 (fractale i) ; let rec do_rec () = let c = Graphics.read_key () in if c = 'n' && i < 4 then begin Graphics.clear_graph () ; q4 (i+1) end else if c = 'p' && i > 0 then begin Graphics.clear_graph () ; q4 (i-1) end else if c = 'q' then () else do_rec () in do_rec () let _ = q4 0 (**************) (* Question 5 *) (**************) type bit = Zero | Un let rec do_arbre_vers_liste a k = match a with | Feuille Blanc -> Zero :: Zero :: k | Feuille Noir -> Zero :: Un :: k | Noeud (a1,a2,a3,a4) -> Un:: do_arbre_vers_liste a1 (do_arbre_vers_liste a2 (do_arbre_vers_liste a3 (do_arbre_vers_liste a4 k))) let arbre_vers_liste a = do_arbre_vers_liste a [] let rec do_parse l = match l with | Zero::Zero::rem -> Feuille Blanc, rem | Zero::Un::rem -> Feuille Noir, rem | Un::rem -> let a1,rem = do_parse rem in let a2,rem = do_parse rem in let a3,rem = do_parse rem in let a4,rem = do_parse rem in Noeud (a1,a2,a3,a4),rem | _ -> assert false let liste_vers_arbre l = let a,_ = do_parse l in a let a = fractale 4 let _ = if a <> liste_vers_arbre (arbre_vers_liste a) then begin Printf.eprintf "Malaise dans la conversion en listes de bits\n" ; exit 1 end (* sauvegarde et lecture, octet par octet des listes de bits *) let bit_to_int b = match b with | Zero -> 0 | Un -> 1 let get_one_bit l = match l with | [] -> Zero,[] | b::rem -> b,rem let rec get_n_bits n l = if n <= 0 then 0,l else let b,rem = get_one_bit l in let r,rem = get_n_bits (n-1) rem in 2 * r + (bit_to_int b),rem let rec output_list f l = match l with | [] -> () | _ -> let byte,rem = get_n_bits 8 l in output_char f (Char.chr byte) ; output_list f rem let ecrire_arbre name a = let f = open_out_bin name in output_list f (arbre_vers_liste a) ; close_out f let read_byte f = try let c = input_char f in Some (Char.code c) with | End_of_file -> None let rec get_n_bits digits n = if digits <= 0 then [] else let b = match n mod 2 with 0 -> Zero | 1 -> Un | _ -> assert false in b::get_n_bits (digits-1) (n/2) let rec input_list f = match read_byte f with | None -> [] | Some n -> get_n_bits 8 n @ input_list f let lire_arbre name = let f = open_in_bin name in let a = liste_vers_arbre (input_list f) in close_in f ; a let q5 a = ecrire_arbre "f4.quad" a ; let aa = lire_arbre "f4.quad" in if a <> aa then begin Printf.eprintf "Malaise dans sauvegarde et lecture\n" ; exit 1 end let _ = q5 (fractale 4)