(* ============================================================ *)
(*    A SPECIFICATION IS RELATION BETWEEN INPUTS AND OUTPUT     *)
(* ============================================================ *)

(* ============================================================ *)
(*           Finding the minimum element in a list              *)
(* ============================================================ *)

(* Solution provided with contributions of 武祥晋 *)

(* ============================================================ *)

Section sec_min.

Variable A : Set.
Variable default : A.
(* comparison : R x y means x less or equal to y *)
Variable R : A -> A -> Prop. 

(* Some properties of R? *)
Hypothesis refl: forall x, R x x.
Hypothesis trans: forall x y z, R x y -> R y z -> R x z.

Hypothesis total : forall x y, R x y \/ R y x.

(* choice 1 for comparison pgm *)
Variable bool_comp : A -> A -> bool.
Hypothesis bool_comp1: 
  forall x y, bool_comp x y = true -> R x y.
Hypothesis bool_comp2: 
  forall x y, bool_comp x y = false -> R y x.

(* choice 2 for comparison pgm *)
Variable comp : forall x y, {R x y}+{R y x}.

Inductive list : Set :=
 | nil : list
 | cons : A -> list -> list.

(* 
Informal expectations:
- the result is in A
- have a list l as a parameter of find_min
- the result is a member of l
   ===> define member
- the result is less or equal (R) to all members of l 
  *NO "other"  --->  reflexivity of R
*)

(* Draft
Definition find_min (l : list) : A :=
*)

(* 
Specification: relation between inputs and output
*)


(* Draft thoughts
You can put here informal ideas, unfinished statements etc.

member : A -> list -> Prop

forall  l : list, m : A

forall x:A, member x l -> R m x
*)

(*
Inductive imember : A -> list -> Prop :=
   | forall x l, imember x (cons x l)
   | forall x y l, 
       imember x l -> imember x (cons y l).
*)

Inductive imember (x : A) : list -> Prop :=
   | Mhd : forall l, imember x (cons x l)
   | Mtl : forall y l, imember x l -> imember x (cons y l).

(* Note:
Inductive eq (A : Type) (x : A) : A -> Prop :=
   eq_refl : x = x
*)
Fixpoint member (x:A) (l:list) : Prop := 
  match l with
  | nil => False
  | cons y l => x = y \/ member x l
  end.


(* -------------------------------------------------- *)
(* Other auxiliary predicates ? *)

Definition lower_bound (m: A) (l: list) :=
  forall x:A, member x l -> R m x.

(* Main relation between input and output *)
Definition spec_find_min (l: list) (m: A) :=
  member m l /\ lower_bound m l.

(* Some other auxiliary definitions + properties *)
(* informally : if x smaller than y then x else y *)
Definition minimum (x y : A) : A.
destruct (comp x y) as [ xy | yx ].
  exact x.
  exact y.
Defined.

Lemma min_among : 
  forall x y, minimum x y = x \/ minimum x y = y.
Proof.
intros x y. unfold minimum. 
destruct (comp x y) as [ xy | yx ].
  left; reflexivity.
  right; reflexivity.
Qed.

Lemma min_sm1 : forall x y, R (minimum x y) x.
Proof.
intros x y. unfold minimum. 
destruct (comp x y) as [ xy | yx ].
  apply refl.
  exact yx.
Qed.

Lemma min_sm2 : forall x y, R (minimum x y) y.
intros x y. unfold minimum. 
destruct (comp x y) as [ xy | yx ].
  exact xy.
  apply refl.
Qed.

(* ------------------------------------------------------- *)
(* Yet another auxiliary predicate to be used later *)
Definition non_empty (l: list): Prop := 
  match l with
  | nil => False
  | cons x l => True
  end.


(* Another possibility is provide an inductive definition *)
Inductive ind_non_empty : list -> Prop := 
  | ind_non_empty_intro: forall x l, ind_non_empty (cons x l).

(* ------------------------------------------------------- *)
(* Specification of the expected result of [find_min] *)
(*
   The following relation should express expected constraints
   between the input [l] and the result [m]
*)


(* ================================================================= *)
(* Issue: dealing with partial functions such as find_min *)

(*
The first idea which comes to mind is to directly try something like :
Definition fm_direct (l: list) (nel: non_empty l): A.
As it is recursive, we would try:
*)

(* Five stars ***** *)

Inductive test_empty_t (l: list) : Set :=
  | DKE : test_empty_t l  (* always usable, so we don't know *)
  | NE : non_empty l -> test_empty_t l.

Definition test_empty (l:list) : test_empty_t l :=
  match l with
  | nil => DKE nil
  | cons x l' as xl  => NE xl I
  end.
(*
(* The following does not type-check, hence the "as" *)
Definition test_empty' (l:list) : test_empty_t l :=
  match l with
  | nil => DKE nil
  | cons x l' => NE l I
  end.
*)
Fixpoint fm_direct (l': list): (non_empty l') -> A.
intro not_empty_l.
destruct l' as [| x l''].
  case not_empty_l.
  destruct (test_empty l'') as [| ne].
    exact x.
    exact (minimum x (fm_direct l'' ne)).
Defined.

(*
We can see pattern patching on l' is performed twice:
before the recursive call and after. 
*)

(* 
A better idea way is as follows.
Instead of working with
  - a list [l']
  - a proof that [l'] is non-empty
it is just more simple to work with
  - an element [x] in A
  - a list [l]
considering that the intended meaning of [x] and [l] together
represent the list [l'] above.
*)

(* Then several approaches are possible *)

(* ----------------------------------------------------------------- *)
(* First choice: basic function +  separate correctness proof*)
(* find_min auxiliary function *)

Fixpoint fm_aux (x: A) (l: list) := 
  match l with
  | nil => x
  | cons y l => minimum x (fm_aux y l)
  end.
  

(* Version 1: defined everywhere, similar to [pred] *)
Definition find_min (l: list) : A :=
  match l with
  | nil => default
  | cons x l => fm_aux x l
  end.

(* Version 2: more precise typing, similar to [ppred] *)
Definition partial_find_min (l: list) : non_empty l -> A :=
  match l with
  | nil =>  fun F => match F return A with end
  | cons x l => fun _ => fm_aux x l
  end.
(* interactively:
destruct l as [ | x l].
  simpl. intro F; case F.
  intros _; exact (fm_aux x l).
*)

(* Remark: using the inductive definition is possible as well *)
(* Version 2': variant of version 2 *)
Lemma nn2false: ind_non_empty nil -> False.
  intro ind_ne. inversion ind_ne. 
Qed.
Definition partial_find_min' (l: list) : ind_non_empty l -> A.
  intro ind_ne.
  destruct l as [| x' l'].
    destruct (nn2false ind_ne).
    apply (fm_aux x' l').
Defined.

(* ------------------ *)
(* Correctness proofs *)

(* The specification of fm_aux is naturally:
   forall (x:A) (l: list), spec_find_min (cons x l) (fm_aux x l).
Reducing it yields auxiliary statements given in
  fm_aux_among, fm_aux_first and fm_aux_mem
*)
Lemma fm_aux_among :
  forall (x: A) (l: list),
  fm_aux x l = x \/ member (fm_aux x l) l.
Proof.
intros x l. revert x.
induction l as [ | y l Hl]; simpl; intro x.
  left; reflexivity.
  case (min_among x (fm_aux y l)); intro e_min.
    left. exact e_min.
    right. rewrite e_min. apply Hl.
Qed.


(* Note that rel_min_correct2 below (3rd choice) is much better *)
Lemma fm_aux_first: forall x l, R (fm_aux x l) x.
Proof.
  intros x l; revert x.
  induction l as [| x' l' Hl']; simpl; intro x.
    apply refl.
    apply min_sm1.
Qed.
Lemma fm_aux_mem: forall x l z, member z l -> R (fm_aux x l) z.
Proof.
  intros x l; revert x.
  induction l as [| y l' Hl']; simpl; intros x z m.
    destruct m.
    destruct m as [e | m].
      rewrite <- e. apply (trans _ (fm_aux z l') _).
        apply min_sm2.
        apply fm_aux_first.
      apply (trans _ (fm_aux y l') _).
        apply min_sm2.
        apply Hl'. apply m.
Qed.

Lemma fm_aux_correct :
  forall (x:A) (l: list), spec_find_min (cons x l) (fm_aux x l).
Proof.
intros x l. red. split; red.
  apply fm_aux_among.
  intros z [e | m]. 
    rewrite e. apply fm_aux_first.
    apply fm_aux_mem. assumption.
Qed.


Theorem find_min_correct :
  forall l: list, non_empty l -> (* precondition on the input *)
  spec_find_min l (find_min l).
Proof.
intros [ | x l]; intro ne; red in ne. 
  case ne.
  unfold find_min. apply fm_aux_correct.
Qed.


(* Similar result about partial_find_min *)

Theorem partial_find_min_correct :
  forall (l: list) (ne: non_empty l),
  spec_find_min l (partial_find_min l ne).
Proof.
intros [ | x l]; intro ne; red in ne. 
  case ne.
  unfold partial_find_min. apply fm_aux_correct.
Qed.

(* End of first choice *)

(* ----------------------------------------------------------------- *)
(* Second choice: mixing function and proof *)

(* NOT AN EXERCISE: Don't solve this one *)
Definition find_min_uax_c (x:A) (l: list) : 
  {m: A | spec_find_min  (cons x l) m}.
Admitted.

Definition find_min_c (l: list) : non_empty l -> {m: A | spec_find_min l m}.
Admitted.

(* End of second choice *)

(* ----------------------------------------------------------------- *)
(* Third choice: partial functions described by inductive relations *)
Inductive rel_min: list -> A -> Prop := 
  | rm1: forall x, rel_min (cons x nil) x
  | rm2: forall x l m, 
         rel_min l m -> R x m -> rel_min (cons x l) x
  | rm3: forall x l m, 
         rel_min l m -> R m x -> rel_min (cons x l) m.

(* First we can prove that find_min behaves according to rel_min *)
(* This is the only place where fm_aux is taken into account *)
(* TO BE READ CAREFULLY *)
Lemma find_rel_min: forall l, non_empty l -> rel_min l (find_min l).
Proof.
intros l ne. destruct l as [ | x l]; simpl in *.
  case ne; clear ne.

 (* reasoning about fm_aux *)
  revert x. induction l as [ | y l Hl]; simpl in *; intro x. 
    apply rm1.

 (* Target: rm2 and rm3; first, the suitable l for rel_min is (cons y l) *)
    generalize (Hl y). 
    pose (m:=fm_aux y l); fold m.
    pose (yl:=cons y l); fold yl.
    intros Hylm. 
 (* Choose rm2 or rm3 according to (R x m) or (R m x) *)
    unfold minimum. case (comp x m).
      intro xm; apply (rm2 _ _ _ Hylm xm). 
      intro mx; apply (rm3 _ _ _ Hylm mx). 
Qed.      

(* Now, we can reason on rel_min instead of find_min
   without worrying about find_min, fm_aux, minimum, etc.  
*)

Lemma rel_min_among :
  forall (l: list) (m: A), rel_min l m -> member m l.
Proof.
intros l m r. 
induction r as [x | x l m rlm Hrlm rxm | x l m rlm Hrm rxml ]; simpl.
  left; reflexivity.
  left; reflexivity.
  right; apply Hrm.  
Qed.

Lemma rel_min_correct2 :
  forall (l: list) (m: A), rel_min l m -> lower_bound m l.
Proof.
intros l m r. 
induction r as [x | x l m rlm Hrlm rxm | x l m rlm Hrml rxml ]; 
      red; simpl; intros z [e | mem].
   rewrite e. apply refl.
   case mem.
   rewrite e. apply refl.
   specialize (Hrlm z mem). apply (trans _ _ _ rxm Hrlm).  
   rewrite e. apply rxml.
   apply (Hrml z mem). 
Qed.

Theorem rel_min_correct :
  forall  (l: list) (m: A), rel_min l m -> spec_find_min l m.
Proof.
split. 
  apply rel_min_among; assumption.
  apply rel_min_correct2; assumption.
Qed.

(* Expected corollary *)
Theorem find_min_correct' :
  forall l: list, non_empty l -> (* assumption on the input? *)
  spec_find_min l (find_min l).
Proof.
intros l ne; generalize (find_rel_min l ne). 
apply rel_min_correct. 
Qed.

(* End of third choice *)

End sec_min.