(******************************************************************************************)
(* Quickcheck like *)
(******************************************************************************************)
(* how do without overloading ? objet ? can pass a generator as a parameter, but
    heavy,  prefer automatic inferring of the generator?, but in the same time
    quickcheck does not do better cos we must explictly type the property => 
    between a prop_unit:: [Int] -> [Int] -> bool ... prop_unit x = reverse [x] == [x]
    and     a let _ = laws "unit" (fun x -> reverse [x] = [x]) (listg intg)
    no real differences. Yes I define typeg generator but quickcheck too, he must define
    class instance, I emulate the context Gen a => Gen [a] by making listg take as a param a
    type generator
   morover i have not pb of monad, i can do random independently, so my code is more simple to
    understand
*)


let rec (foldn: ('a -> int -> 'a) -> 'a -> int -> 'a) = fun f acc i ->
  if i = 0 then acc else foldn f (f acc i) (i-1)

let sum_int   = List.fold_left (+) 0

let reverse = List.rev

let (++) = (@)

let (==>) b1 b2 = if b1 then b2 else true (* could use too => *)


(* unit test *)
let example b = assert b
let _ = example (List.map (fun x -> x +1) [1;2;3;4] = [2;3;4;5])


(*------------------------------------------------------------------------------*)
(* generator *)
(*------------------------------------------------------------------------------*)
type 'a gen = unit -> 'a

(* integer, list, pair generators *)
let (ig: int gen) = fun () -> Random.int 10
let (lg: ('a gen) -> ('a list) gen) = fun gen () -> 
  foldn (fun acc i -> (gen ())::acc) [] (Random.int 10)
let (pg: ('a gen) -> ('b gen) -> ('a * 'b) gen) = fun gen1 gen2 () -> 
  (gen1 (), gen2 ())

let polyg = ig

let (ng: (string gen)) = fun () -> "a" ^ (string_of_int (ig ()))

let (oneofl: ('a list) -> 'a gen) = fun xs () -> 
  List.nth xs (Random.int (List.length xs)) 
(* let oneofl l = oneof (List.map always l) *)

let (oneof: (('a gen) list) -> 'a gen) = fun xs -> 
  List.nth xs (Random.int (List.length xs)) 

let (always: 'a -> 'a gen) = fun e () -> e

let (frequency: ((int * ('a gen)) list) -> 'a gen) = fun xs -> 
  let sums = sum_int (List.map fst xs) in
  let i = Random.int sums in
  let rec aux acc = function ((x,g)::xs) -> if i < acc+x then g else aux (acc+x) xs | _ -> failwith "frequency" in
  aux 0 xs
let frequencyl l = frequency (List.map (fun (i,e) -> (i,always e)) l)


(* 
let b = oneof [always true; always false] ()
let b = frequency [3, always true; 2, always false] ()

cant do this:
 let rec (lg: ('a gen) -> ('a list) gen) = fun gen -> oneofl [[]; lg gen ()] 
 nor
 let rec (lg: ('a gen) -> ('a list) gen) = fun gen -> oneof [always []; lg gen] 
 cos caml is not as lazy as haskell :(
 fix the pb by introducing a size limit
 take the bounds/size as parameter
 morover this is needed for more complex type, how make a bintreeg ??
  we need recursion 


*)
(*------------------------------------------------------------------------------*)
(* example for homemade datatype *)

type 'a bintree = Leaf of 'a | Branch of ('a bintree * 'a bintree)

let rec (bintreeg: ('a gen) -> ('a bintree) gen) = fun gen () -> 
  let rec aux n = 
    if n = 0 then (Leaf (gen ()))
    else frequencyl [1, Leaf (gen ()); 4, Branch ((aux (n / 2)), aux (n / 2))] ()
  in aux 20


(*------------------------------------------------------------------------------*)
(* property *)
(*------------------------------------------------------------------------------*)

(* todo, a test_all_laws, better syntax (done already a little with ig in place of intg *)
(* en cas d'erreur, print the arg that not respect *)

(* return None when all is right, and Just the_case_that_produce_the_error when all is not right (we have a counter example) *)
let (laws: string -> ('a -> bool) -> ('a gen) -> 'a option) = fun s func gen ->
  let res = foldn (fun acc i -> let n = gen() in (n, func n)::acc) [] 1000 in
  let res = List.filter (fun (x,b) -> not b) res in
  if res = [] then None else Some (fst (List.hd res))

(*------------------------------------------------------------------------------*)
let _ = example 
    ((laws "rev" (fun xs -> reverse (reverse xs) = xs)  (lg ig))
    = None
    )

let _ = example 
    ((laws "app " (fun (xs,ys) -> reverse (xs++ys)  = reverse ys++reverse xs)    (pg (lg ig)(lg ig)))
    = None
    )

let _ = example 
    (match (laws "appwrong" (fun (xs,ys) -> reverse (xs++ys)  = reverse xs++reverse ys)  (pg (lg ig)(lg ig))) with
    | Some error_case -> true
    | None -> false
    )

(*
let b = laws "unit" (fun x       -> reverse [x]          = [x]                   )ig
let b = laws "max"  (fun (x,y)   -> x <= y ==> (max x y  = y)                       )(pg ig ig)
*)




(*------------------------------------------------------------------------------*)
let rec (statistic_number: ('a list) -> (int * 'a) list) = function
  | []    -> []
  | x::xs -> let (splitg, splitd) = List.partition (fun y -> y = x) xs in
    (1+(List.length splitg), x)::(statistic_number splitd)

(* in pourcentage *)
let (statistic: ('a list) -> (int * 'a) list) = fun xs ->
  let stat_num = statistic_number xs in
  let totals = sum_int (List.map fst stat_num) in
  List.map (fun (i, v) -> ((i * 100) / totals), v) stat_num 
  
let (laws2: string -> ('a -> (bool * 'b)) -> ('a gen) -> ('a option * ((int * 'b) list ))) = 
  fun s func gen ->
  let res = foldn (fun acc i -> let n = gen() in (n, func n)::acc) [] 1000 in
  let stat = statistic (List.map (fun (x,(b,v)) -> v) res) in
  let res = List.filter (fun (x,(b,v)) -> not b) res in
  if res = [] then (None, stat) else (Some (fst (List.hd res)), stat)

(* let b = laws2 "max"  (fun (x,y)   -> ((x <= y ==> (max x y  = y)), x <= y))(pg ig ig) *)