(* EXAMEN DE PROGRAMMATION FONCTIONNELLE 2022-2023 *)
(* CORRIGE *)


let rec list_filter_map f l = match l with
| [] -> []
| hd::tl -> begin
  match f hd with
  | Some v -> v :: list_filter_map f tl
  | None -> list_filter_map f tl
  end


(* question 1 *)

(* `list_filter_map f1 [-2; 0; 2; -1; 3]` renvoie `[4; 1]` *)

(* question 2 *)
let list_map f l = list_filter_map (fun x -> Some(f x)) l

(* question 3 *)
let list_filter f l = list_filter_map (fun x -> if f x then Some x else None) l


(* question 4 *)
type 'a bintree = 
| Feuille of 'a
| Arbre of 'a bintree * 'a bintree

let rec bintree_filter_map f a = match a with
| Feuille v -> begin
  match f v with
  | None -> None
  | Some v2 -> Some (Feuille v2)
  end
| Arbre(filsg, filsd) -> begin
    match bintree_filter_map f filsg, bintree_filter_map f filsd with
    | None, x | x, None -> x
    | Some a1, Some a2 -> Some (Arbre(a1, a2))
  end

(* question 5 *)

(* solution en style très impératif *)
let array_filter_map f arr = 
  let n = ref 0 in
  let a_val = ref None in
  let arr2 = Array.map f arr in
  for i = 0 to Array.length arr - 1 do
     if arr2.(i) <> None then begin
        n := !n + 1;
        a_val := arr2.(i)
    end
  done;
  if !n = 0 then [||] else
  let res = Array.make !n (Option.get !a_val) in
  let j = ref 0 in
  for i = 0 to Array.length arr - 1 do
    if arr2.(i) <> None then begin
      res.(!j) <- Option.get arr2.(i);
      j := !j + 1
    end
  done;
  res

(* solution en style un peu plus fonctionnel *)
let array_filter_map f arr =
  let arr2 = Array.map f arr in
  let count_some arr = Array.fold_left (fun n -> function None -> n | Some _ -> n+1) 0 arr2 in
  let find_some arr = Array.fold_left (fun v -> function None -> v | Some v2 -> Some v2) None arr2 in
  match (count_some arr, find_some arr) with
  | 0, None -> [||]
  | _, None -> assert false
  | n, Some v_default -> 
    let res = Array.make n v_default in
    let j = ref 0 in
    Array.iter (function None -> () | Some v -> res.(!j)<-v; j:= !j+1) arr2;
    res

(* encore une autre solution, qui ne suit pas les indications donnees dans le sujet *)
let array_filter_map f arr =
  let arr2 = Array.map f arr in
  let count_some arr = Array.fold_left (fun n -> function None -> n | Some _ -> n+1) 0 arr2 in
  let i = ref (-1) in
  let rec get_next () = 
    i := !i + 1; match f arr.(!i) with
    | None -> get_next ()
    | Some v -> v
  in Array.init (count_some arr) (fun _ -> get_next ())

(* question 6 *)
(* le code affiche adc; b n'est pas imprimé parce que le && est paresseux.
   d est imprimé avant c parce que l'évaluation des arguments en Caml se fait 
   de droite à gauche (il suffisait juste de dire que b n'est pas affiché pour
   avoir les points à la question) *)


(* question 7 *)

let rec andlist l = match l with
| [] -> true
| false::_ -> false
| _::tl -> andlist tl


(* question 8 *)

type 'a binop_partial_application =
| Result of 'a
| Transformation of ('a -> 'a)

type 'a lazy_binop = 'a -> 'a binop_partial_application

let lazy_product n = match n with
| 0 -> Result 0
| _ -> Transformation (fun m -> n * m)


(* question 9 *)

let fun_of_lazy_binop op x y = match op x with
| Result v -> v
| Transformation f -> f y

(* question 10 *)

let rec lazy_reduce plus zero l = match l with
| [] -> zero
| hd::tl -> begin
    match plus zero with
    | Result v -> v
    | Transformation f -> lazy_reduce plus (f hd) tl
  end


(* question 11 *)

module type PERSISTANT_MATRIX = sig
  type t
  val init: int -> int -> (int -> int -> float) -> t
  val dim: t -> (int * int)
  val get: t -> int -> int -> float 
  val set: t -> int -> int -> float -> t
end

module ArrayBasedMatrix : PERSISTANT_MATRIX = struct
  type t = float array array
  let init n m f = Array.init n (fun i -> Array.init m (fun j-> f i j))
  let dim mat = (Array.length mat, Array.length mat.(0))
  let get mat i j = mat.(i).(j)
  let set mat i j x = 
    let (n,m) = dim mat in
    init n m (fun i2 j2 -> if (i,j)<>(i2,j2) then mat.(i).(j) else x)
end

module SparseMatrix : PERSISTANT_MATRIX = struct
  type t = {
    width: int;
    height: int;
    non_null_cells: (int * int * float) list
  }
  let init n m f = 
    let l = ref [] in
    for i=0 to n-1 do
      for j=0 to m-1 do
        let x = f i j in
        if x <> 0. then l := (i, j, x) :: !l
      done
    done;
    {width = m; height = n; non_null_cells = !l}
  let dim mat = (mat.height, mat.width)
  let get mat i j = 
    let rec iter = function
    | [] -> 0.
    | (i2, j2, x)::_ when (i,j)=(i2,j2) -> x
    | _ :: tl -> iter tl
    in iter mat.non_null_cells

  let set mat i j x =
    {mat with non_null_cells = (i, j, x) :: mat.non_null_cells} 

  (* une version un peu plus efficace de set qui maintient l'invariant
    que toutes les valeurs nulles sont implicites *)
  let set mat i j x =
    if x <> 0.
    then {mat with non_null_cells = (i, j, x) :: mat.non_null_cells} 
    else {mat with non_null_cells = List.filter (fun (i2,j2,_) -> (i,j)<>(i2,j2)) mat.non_null_cells}
end