Require Import Arith.
Require Import List.
Require Import Relations.
Require Import Wellfounded.
Require Import list_util.
Require Import ModEq.
Require Import Peano_LQ.
Require Import Peano_Func.

Set Implicit Arguments.

(* Primitive recursive functions *)
Inductive PRfunc: nat -> (list nat->nat) -> Prop :=
|PRZero : PRfunc 0 (fun _ => 0)
|PRSucc : PRfunc 1 (fun l => match l with |nil => 0 (* dummy *) |a::_ => S a end)
|PRProj : forall i n, i<n -> PRfunc n (fun l => nth i l 0)
|PRComp : forall f gs n, PRfunc (length gs) f -> (forall x, In x gs->PRfunc n x) -> PRfunc n (fun a=>f (map (fun g=>g a) gs))
|PRRecu : forall n f g, PRfunc n f -> PRfunc (S (S n)) g -> PRfunc (S n) (fun l=> match l with |nil=>0 (*dummy*) |i::l'=> (fix rec (n:nat) := match n with |0=>f l' |S n'=>g (rec n'::n'::l') end) i end)
.
Hint Constructors PRfunc.

Theorem PRfunc_Func: forall f n, PRfunc n f -> exists F:Func, WFFunc n F /\ forall ns p, n=length ns -> Inf p (FuncT F (map n2t ns) == n2t (f ns)). Proof. intros f n H. induction H.
  exists FZero; split; auto. intros. destruct ns; auto. inversion H. exists (FSucc); split; auto. intros. destruct ns. inversion H. destruct ns; auto. inversion H. exists (FProj i); split; auto. intros. apply FProj_spec. rewrite map_length; subst n; auto. replace Zero with (n2t 0); auto. apply map_nth.
  destruct IHPRfunc as [F [H2 H3]]. destruct (MapR_build' (T:=list nat->nat) (U:=Func)) with (l:=gs) (R:=fun f F=>WFFunc n F /\ forall ns p,n=length ns->Inf p (FuncT F (map n2t ns)==n2t (f ns))) as [Gs H4]. intros; auto. assert (WFFunc n (FComp F Gs)). apply WFF_Comp. replace (length Gs) with (length gs); auto. apply MapR_length in H4; auto.
  apply Forall_forall. intros g H5. apply in_MapR_2 with (x:=g) in H4; auto. destruct H4 as [y [[H6 H7] H8]]. auto.  exists (FComp F Gs); split; auto. intros. apply Term_Eq_trans with (FuncT F (map (fun g=>n2t (g ns)) gs)). apply FComp_spec with n; auto. rewrite map_length; auto. apply MapR_sym. replace Gs with (map id Gs). apply MapR_map2. eapply MapR_trans; [|eapply H4].
  intros. replace (id y) with y; auto. destruct H9; auto. rewrite map_id; auto. rewrite <- map_map. apply H3. rewrite map_length; auto.
  destruct IHPRfunc1 as [F [H1 H2]]. destruct IHPRfunc2 as [G [H3 H4]]. exists (FRecu F G); split; auto. intros. destruct ns as [|i ns]. inversion H5. inversion H5. clear H5. subst n. induction i. simpl. apply Term_Eq_trans with (FuncT F (map n2t ns)). apply FRecu_Zero_spec; auto. rewrite map_length. auto. apply H2; auto. simpl. remember ((fix rec (n:nat):=match n with|O=>f ns|S n'=>g (rec n'::n'::ns) end) i) as t.
  apply Term_Eq_trans with (FuncT G (n2t t::n2t i::map n2t ns)). apply FRecu_Succ_spec; auto. rewrite map_length; auto. replace (n2t t::n2t i::map n2t ns) with (map n2t (t::i::ns)); auto. Qed.

Inductive PR0 (f:nat) : Prop := PR0_intro: forall pf, PRfunc 0 pf -> f = pf nil -> PR0 f.
Inductive PR1 (f:nat->nat) : Prop := PR1_intro: forall pf, PRfunc 1 pf -> (forall x, f x = pf (x::nil)) -> PR1 f.
Inductive PR2 (f:nat->nat->nat) : Prop := PR2_intro: forall pf, PRfunc 2 pf -> (forall x y, f x y = pf (x::y::nil)) -> PR2 f.
Inductive PR3 (f:nat->nat->nat->nat) : Prop := PR3_intro: forall pf, PRfunc 3 pf -> (forall x y z, f x y z = pf (x::y::z::nil)) -> PR3 f.
Inductive PR4 (f:nat->nat->nat->nat->nat) : Prop := PR4_intro: forall pf, PRfunc 4 pf -> (forall x y z w, f x y z w = pf (x::y::z::w::nil)) -> PR4 f.
Hint Constructors PR0 PR1 PR2 PR3 PR4.

Theorem PR0_Func: forall f, PR0 f -> exists F:Func, WFFunc 0 F /\ forall p, Inf p (FuncT F (nil) == n2t f). Proof. intros. destruct H. destruct (PRfunc_Func H) as [F [H1 H2]]. exists F; split; auto. intros. replace nil with (map n2t nil) at 1; auto. subst f; auto. Qed.
Theorem PR1_Func: forall f, PR1 f -> exists F:Func, WFFunc 1 F /\ forall n p, Inf p (FuncT F (n2t n::nil) == n2t (f n)). Proof. intros. destruct H. destruct (PRfunc_Func H) as [F [H1 H2]]. exists F; split; auto. intros. replace (f n) with (pf (n::nil)); auto. replace (n2t n::nil) with (map n2t (n::nil)); auto. Qed.
Theorem PR2_Func: forall f, PR2 f -> exists F:Func, WFFunc 2 F /\ forall x y p, Inf p (FuncT F (n2t x::n2t y::nil) == n2t (f x y)). Proof. intros. destruct H. destruct (PRfunc_Func H) as [F [H1 H2]]. exists F; split; auto. intros. replace (f x y) with (pf (x::y::nil)); auto. replace (n2t x::n2t y::nil) with (map n2t (x::y::nil)); auto. Qed.
Theorem PR3_Func: forall f, PR3 f -> exists F:Func, WFFunc 3 F /\ forall x y z p, Inf p (FuncT F (n2t x::n2t y::n2t z::nil) == n2t (f x y z)). Proof. intros. destruct H. destruct (PRfunc_Func H) as [F [H1 H2]]. exists F; split; auto. intros. replace (f x y z) with (pf (x::y::z::nil)); auto. replace (n2t x::n2t y::n2t z::nil) with (map n2t (x::y::z::nil)); auto. Qed.
Theorem PR4_Func: forall f, PR4 f -> exists F:Func, WFFunc 4 F /\ forall x y z w p, Inf p (FuncT F (n2t x::n2t y::n2t z::n2t w::nil) == n2t (f x y z w)). Proof. intros. destruct H. destruct (PRfunc_Func H) as [F [H1 H2]]. exists F; split; auto. intros. replace (f x y z w) with (pf (x::y::z::w::nil)); auto. replace (n2t x::n2t y::n2t z::n2t w::nil) with (map n2t (x::y::z::w::nil)); auto. Qed.

Theorem PR0_0: PR0 0. Proof. apply PR0_intro with (fun _=>0); auto. Qed.
Theorem PR1_S: PR1 S. Proof. apply PR1_intro with (fun l=>match l with |nil=>0 |a::_ => S a end); auto. Qed.
Theorem PR1_Proj0: PR1 (fun x=>x). Proof. apply PR1_intro with (fun l=>nth 0 l 0); auto. Qed.
Theorem PR2_Proj0: PR2 (fun x y=>x). Proof. apply PR2_intro with (fun l=>nth 0 l 0); auto. Qed.
Theorem PR2_Proj1: PR2 (fun x y=>y). Proof. apply PR2_intro with (fun l=>nth 1 l 0); auto. Qed.
Theorem PR3_Proj0: PR3 (fun x y z=>x). Proof. apply PR3_intro with (fun l=>nth 0 l 0); auto. Qed.
Theorem PR3_Proj1: PR3 (fun x y z=>y). Proof. apply PR3_intro with (fun l=>nth 1 l 0); auto. Qed.
Theorem PR3_Proj2: PR3 (fun x y z=>z). Proof. apply PR3_intro with (fun l=>nth 2 l 0); auto. Qed.
Theorem PR4_Proj0: PR4 (fun x y z w=>x). Proof. apply PR4_intro with (fun l=>nth 0 l 0); auto. Qed.
Theorem PR4_Proj1: PR4 (fun x y z w=>y). Proof. apply PR4_intro with (fun l=>nth 1 l 0); auto. Qed.
Theorem PR4_Proj2: PR4 (fun x y z w=>z). Proof. apply PR4_intro with (fun l=>nth 2 l 0); auto. Qed.
Theorem PR4_Proj3: PR4 (fun x y z w=>w). Proof. apply PR4_intro with (fun l=>nth 3 l 0); auto. Qed.
Hint Resolve PR0_0 PR1_S PR1_Proj0 PR2_Proj0 PR2_Proj1 PR3_Proj0 PR3_Proj1 PR3_Proj2 PR4_Proj0 PR4_Proj1 PR4_Proj2 PR4_Proj3.

Theorem PR0_Comp0: forall c f, PR0 f -> c = f -> PR0 c. Proof. intros. subst c; auto. Qed.
Theorem PR0_Comp1: forall c f g, PR1 f -> PR0 g -> c = f g -> PR0 c. Proof. intros. destruct H. destruct H0. apply PR0_intro with (fun a=>pf (map (fun g=>g a) (pf0::nil))). apply PRComp; auto. intros. apply In_one in H4; subst x; auto. intros. simpl. rewrite H1. rewrite <- H2; auto. Qed.
Theorem PR0_Comp2: forall c f g h, PR2 f -> PR0 g -> PR0 h -> c = f g h -> PR0 c. Proof. intros. destruct H. destruct H0. destruct H1. apply PR0_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::nil))). apply PRComp; auto. intros. destruct H6. subst x; auto. destruct H6. subst x; auto. destruct H6. intros. simpl. rewrite H2. rewrite H3. repeat f_equal; auto. Qed.
Theorem PR0_Comp3: forall c f g h i, PR3 f -> PR0 g -> PR0 h -> PR0 i -> c = f g h i -> PR0 c. Proof. intros. destruct H. destruct H0. destruct H1. destruct H2. apply PR0_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::pf2::nil))). apply PRComp; auto. intros. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. intros. simpl. rewrite H3. rewrite H4. repeat f_equal; auto. Qed.
Theorem PR1_Comp0: forall c f, PR0 f -> (forall x, c x= f) -> PR1 c. Proof. intros. destruct H. apply PR1_intro with (fun a=>pf (map (fun g=>g a) nil)). apply PRComp; auto. intros. destruct H2. intros. simpl. rewrite H0; auto. Qed.
Theorem PR1_Comp1: forall c f g, PR1 f -> PR1 g -> (forall x, c x= f (g x)) -> PR1 c. Proof. intros. destruct H. destruct H0. apply PR1_intro with (fun a=>pf (map (fun g=>g a) (pf0::nil))). apply PRComp; auto. intros. apply In_one in H4; subst x; auto. intros. simpl. rewrite H1. rewrite <- H2; auto. Qed.
Theorem PR1_Comp2: forall c f g h, PR2 f -> PR1 g -> PR1 h -> (forall x, c x = f (g x) (h x)) -> PR1 c. Proof. intros. destruct H. destruct H0. destruct H1. apply PR1_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::nil))). apply PRComp; auto. intros. destruct H6. subst x; auto. destruct H6. subst x; auto. destruct H6. intros. simpl. rewrite H2. rewrite H3. repeat f_equal; auto. Qed.
Theorem PR1_Comp3: forall c f g h i, PR3 f -> PR1 g -> PR1 h -> PR1 i -> (forall x, c x= f (g x) (h x) (i x)) -> PR1 c. Proof. intros. destruct H. destruct H0. destruct H1. destruct H2. apply PR1_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::pf2::nil))). apply PRComp; auto. intros. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. intros. simpl. rewrite H3. rewrite H4. repeat f_equal; auto. Qed.
Theorem PR2_Comp0: forall c f, PR0 f -> (forall x y, c x y= f) -> PR2 c. Proof. intros. destruct H. apply PR2_intro with (fun a=>pf (map (fun g=>g a) nil)). apply PRComp; auto. intros. destruct H2. intros. simpl. rewrite H0; auto. Qed.
Theorem PR2_Comp1: forall c f g, PR1 f -> PR2 g -> (forall x y, c x y= f (g x y)) -> PR2 c. Proof. intros. destruct H. destruct H0. apply PR2_intro with (fun a=>pf (map (fun g=>g a) (pf0::nil))). apply PRComp; auto. intros. apply In_one in H4; subst x; auto. intros. simpl. rewrite H1. rewrite <- H2; auto. Qed.
Theorem PR2_Comp2: forall c f g h, PR2 f -> PR2 g -> PR2 h -> (forall x y, c x y = f (g x y) (h x y)) -> PR2 c. Proof. intros. destruct H. destruct H0. destruct H1. apply PR2_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::nil))). apply PRComp; auto. intros. destruct H6. subst x; auto. destruct H6. subst x; auto. destruct H6. intros. simpl. rewrite H2. rewrite H3. repeat f_equal; auto. Qed.
Theorem PR2_Comp3: forall c f g h i, PR3 f -> PR2 g -> PR2 h -> PR2 i -> (forall x y, c x y= f (g x y) (h x y) (i x y)) -> PR2 c. Proof. intros. destruct H. destruct H0. destruct H1. destruct H2. apply PR2_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::pf2::nil))). apply PRComp; auto. intros. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. intros. simpl. rewrite H3. rewrite H4. repeat f_equal; auto. Qed.
Theorem PR3_Comp0: forall c f, PR0 f -> (forall x y z, c x y z= f) -> PR3 c. Proof. intros. destruct H. apply PR3_intro with (fun a=>pf (map (fun g=>g a) nil)). apply PRComp; auto. intros. destruct H2. intros. simpl. rewrite H0; auto. Qed.
Theorem PR3_Comp1: forall c f g, PR1 f -> PR3 g -> (forall x y z, c x y z= f (g x y z)) -> PR3 c. Proof. intros. destruct H. destruct H0. apply PR3_intro with (fun a=>pf (map (fun g=>g a) (pf0::nil))). apply PRComp; auto. intros. apply In_one in H4; subst x; auto. intros. simpl. rewrite H1. rewrite <- H2; auto. Qed.
Theorem PR3_Comp2: forall c f g h, PR2 f -> PR3 g -> PR3 h -> (forall x y z, c x y z= f (g x y z) (h x y z)) -> PR3 c. Proof. intros. destruct H. destruct H0. destruct H1. apply PR3_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::nil))). apply PRComp; auto. intros. destruct H6. subst x; auto. destruct H6. subst x; auto. destruct H6. intros. simpl. rewrite H2. rewrite H3. repeat f_equal; auto. Qed.
Theorem PR3_Comp3: forall c f g h i, PR3 f -> PR3 g -> PR3 h -> PR3 i -> (forall x y z, c x y z= f (g x y z) (h x y z) (i x y z)) -> PR3 c. Proof. intros. destruct H. destruct H0. destruct H1. destruct H2. apply PR3_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::pf2::nil))). apply PRComp; auto. intros. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. intros. simpl. rewrite H3. rewrite H4. repeat f_equal; auto. Qed.
Theorem PR4_Comp0: forall c f, PR0 f -> (forall x y z w, c x y z w= f) -> PR4 c. Proof. intros. destruct H. apply PR4_intro with (fun a=>pf (map (fun g=>g a) nil)). apply PRComp; auto. intros. destruct H2. intros. simpl. rewrite H0; auto. Qed.
Theorem PR4_Comp1: forall c f g, PR1 f -> PR4 g -> (forall x y z w, c x y z w= f (g x y z w)) -> PR4 c. Proof. intros. destruct H. destruct H0. apply PR4_intro with (fun a=>pf (map (fun g=>g a) (pf0::nil))). apply PRComp; auto. intros. apply In_one in H4; subst x; auto. intros. simpl. rewrite H1. rewrite <- H2; auto. Qed.
Theorem PR4_Comp2: forall c f g h, PR2 f -> PR4 g -> PR4 h -> (forall x y z w, c x y z w= f (g x y z w) (h x y z w)) -> PR4 c. Proof. intros. destruct H. destruct H0. destruct H1. apply PR4_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::nil))). apply PRComp; auto. intros. destruct H6. subst x; auto. destruct H6. subst x; auto. destruct H6. intros. simpl. rewrite H2. rewrite H3. repeat f_equal; auto. Qed.
Theorem PR4_Comp3: forall c f g h i, PR3 f -> PR4 g -> PR4 h -> PR4 i -> (forall x y z w, c x y z w= f (g x y z w) (h x y z w) (i x y z w)) -> PR4 c. Proof. intros. destruct H. destruct H0. destruct H1. destruct H2. apply PR4_intro with (fun a=>pf (map (fun g=>g a) (pf0::pf1::pf2::nil))). apply PRComp; auto. intros. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. subst x; auto. destruct H8. intros. simpl. rewrite H3. rewrite H4. repeat f_equal; auto. Qed.
Hint Resolve PR0_Comp0 PR0_Comp1 PR0_Comp2 PR0_Comp3 PR1_Comp0 PR1_Comp1 PR1_Comp2 PR1_Comp3 PR2_Comp0 PR2_Comp1 PR2_Comp2 PR2_Comp3 PR3_Comp0 PR3_Comp1 PR3_Comp2 PR3_Comp3 PR4_Comp0 PR4_Comp1 PR4_Comp2 PR4_Comp3.

Theorem PR1_Recu: forall r f g, PR0 f -> PR2 g -> (forall x, r x= (fix rec i := match i with 0=>f |S i'=> g (rec i') i' end) x) -> PR1 r. Proof. intros. destruct H. destruct H0. apply PR1_intro with (fun l=> match l with |nil=>0 |i::l'=> (fix rec (n:nat) := match n with |0=>pf l' |S n'=>pf0 (rec n'::n'::l') end) i end). apply PRRecu; auto. intros. rewrite H1. clear H1. induction x; auto. rewrite IHx. rewrite <- H3. auto. Qed.
Theorem PR2_Recu: forall r f g, PR1 f -> PR3 g -> (forall x y, r x y = (fix rec i y:= match i with 0=>f y|S i'=> g (rec i' y) i' y end) x y) -> PR2 r. Proof. intros. destruct H. destruct H0. apply PR2_intro with (fun l=> match l with |nil=>0 |i::l'=> (fix rec (n:nat) := match n with |0=>pf l' |S n'=>pf0 (rec n'::n'::l') end) i end). apply PRRecu; auto. intros. rewrite H1. clear H1. induction x; auto. rewrite IHx. rewrite <- H3. auto. Qed.
Theorem PR3_Recu: forall r f g, PR2 f -> PR4 g -> (forall x y z, r x y z = (fix rec i y z:= match i with 0=>f y z|S i'=> g (rec i' y z) i' y z end) x y z) -> PR3 r. Proof. intros. destruct H. destruct H0. apply PR3_intro with (fun l=> match l with |nil=>0 |i::l'=> (fix rec (n:nat) := match n with |0=>pf l' |S n'=>pf0 (rec n'::n'::l') end) i end). apply PRRecu; auto. intros. rewrite H1. clear H1. induction x; auto. rewrite IHx. rewrite <- H3. auto. Qed.
Hint Resolve PR1_Recu PR2_Recu PR3_Recu.

Theorem PR0_const: forall n, PR0 n. Proof. induction n; auto. apply PR0_Comp1 with S n; auto. Qed.
Theorem PR1_const: forall n, PR1 (fun _:nat=>n). Proof. induction n. apply PR1_Comp0 with 0; auto. apply PR1_Comp1 with S (fun _=>n); auto. Qed.
Theorem PR2_const: forall n, PR2 (fun _ _:nat=>n). Proof. induction n. apply PR2_Comp0 with 0; auto. apply PR2_Comp1 with S (fun _ _=>n); auto. Qed.
Theorem PR2_plus: PR2 plus. Proof. apply PR2_Recu with (fun y=>y) (fun r i y=>S r); auto. apply PR3_Comp1 with S (fun x y z=>x); auto. Qed.
Theorem PR2_mult: PR2 mult. Proof. apply PR2_Recu with (fun y=>0) (fun r i y=>r+y); auto. apply PR1_const. apply PR3_Comp2 with plus (fun x y z=>x) (fun x y z=>z); auto. apply PR2_plus. intros. induction x; simpl; auto. rewrite <- IHx. auto. Qed.
Theorem PR2_pow: PR2 pow. Proof. cut (PR2 (fun x y=>pow y x)). intros. apply PR2_Comp2 with (fun x y=>pow y x) (fun x y=>y) (fun x y=>x); auto. apply PR2_Recu with (fun y=>1) (fun r i y=>r*y); auto. apply PR1_const. apply PR3_Comp2 with mult (fun x y z=>x) (fun x y z=>z); auto. apply PR2_mult. intros. induction x; simpl; auto. rewrite <- IHx. auto. Qed.
Theorem PR1_pred: PR1 pred. Proof. apply PR1_Recu with 0 (fun r i =>i); auto. induction x; auto. Qed.
Theorem PR2_minus: PR2 minus. Proof. cut (PR2 (fun x y=>minus y x)). intros. apply PR2_Comp2 with (fun x y=>y-x) (fun x y=>y) (fun x y=>x); auto. apply PR2_Recu with (fun y=>y) (fun r i y=>pred r); auto. apply PR3_Comp1 with pred (fun x y z=>x); auto. apply PR1_pred. induction x; intros. rewrite <- minus_n_O; auto. rewrite <- IHx. clear IHx. destruct (le_lt_dec y x). replace (y-x) with 0. replace (y-S x) with 0; auto. symmetry; apply Nat.sub_0_le; auto. symmetry; apply Nat.sub_0_le; auto. destruct y. inversion l. replace (S y-x) with (S(y-x)). simpl; auto. rewrite <- minus_Sn_m; auto. Qed.
Theorem PR2_max: PR2 max. Proof. apply PR2_Comp2 with plus minus (fun x y=>y); auto. apply PR2_plus. apply PR2_minus. intros. destruct (le_lt_dec x y). rewrite max_r; auto. replace (x-y) with 0; auto. apply Nat.sub_0_le in l. auto. rewrite max_l; auto. rewrite plus_comm. rewrite <- le_plus_minus; auto. Qed.
Theorem PR2_min: PR2 min. Proof. apply PR2_Comp2 with minus (fun x y=>x) minus; auto. apply PR2_minus. apply PR2_minus. intros. destruct (le_lt_dec x y). rewrite min_l; auto. apply Nat.sub_0_le in l. rewrite l. rewrite <- minus_n_O; auto. rewrite min_r; auto. replace (x-(x-y)) with (y+(x-y)-(x-y)). rewrite plus_comm. rewrite minus_plus; auto. f_equal. rewrite <- le_plus_minus with y x; auto. Qed.
Hint Resolve PR0_const PR1_const PR2_const PR2_plus PR2_mult PR2_pow PR1_pred PR2_minus PR2_max PR2_min.

Definition abs n m:nat := if le_lt_dec n m then m-n else n-m.
Definition sign n:nat := match n with |0=>0 |S _=>1 end.
Definition nsign n:nat := match n with |0=>1 |S _=>0 end.
Definition modN' (n x:nat) := match nat_eq_dec n 0 with |left _ => x |right nz => modN nz x end. (* returns x if divider is 0 *)
Definition div' (x n:nat): nat := match divmod n x with |inleft _ s => (match s with existT _ d _ => d end) |inright _ => 0 end.
Definition Log (e x n:nat): Prop := MaxP (fun n=>Divide (pow e n) x) n.
Definition log_sig: forall e x, {n|Log e x n}+{e<=1\/x=0}. intros. destruct (le_lt_dec e 1); [right|]; auto. destruct (nat_eq_dec x 0); [right|left]; auto. revert n. apply (Fix lt_wf) with (P:=fun x=>x<>0->{n|Log e x n}). clear x. intros. destruct (Divide_dec e x). destruct (Divide_multN d) as [y H1]. subst x. destruct (H y) as [n H1]. rewrite mult_comm. destruct e. inversion l. destruct e. contradict l; auto. simpl. rewrite plus_assoc. apply lt_le_trans with (y+y); auto. destruct y; auto. simpl; auto. contradict H0; subst y; auto.
  exists (S n). inversion H1. subst n0. apply MaxP_intro. rewrite mult_comm. simpl. apply Divide_mult; auto. intros. destruct m; auto. rewrite mult_comm in H4. simpl in H4. apply Divide_div in H4. auto. contradict H0; subst e; auto. exists 0. apply MaxP_intro; auto. intros. destruct m; auto. contradict n. apply Divide_trans with (pow e (S m)); auto. simpl. rewrite mult_comm; auto. Defined.
Definition log (e x:nat):nat := match log_sig e x with inleft s => (match s with exist _ l _ => l end) |inright _ => match e with 0=>0 |S _=> x end end.
Theorem abs_spec: forall x y, abs x y = 0 <-> x=y. Proof. intros. unfold abs. destruct (le_lt_dec x y); split; intros. apply le_antisym; auto. apply Nat.sub_0_le; auto. subst y; rewrite <- minus_n_n; auto. apply le_antisym; auto. apply Nat.sub_0_le; auto. subst y; rewrite <- minus_n_n; auto. Qed.

Theorem PR2_abs: PR2 abs. Proof. apply PR2_Comp2 with plus minus (fun x y=>y-x); auto. apply PR2_Comp2 with minus (fun x y=>y) (fun x y=>x); auto. intros. unfold abs. destruct (le_lt_dec x y). apply Nat.sub_0_le in l. rewrite l. auto. apply lt_le_weak in l. apply Nat.sub_0_le in l. rewrite l. auto. Qed.
Theorem PR1_sign: PR1 sign. Proof. apply PR1_Recu with 0 (fun _ _=>1); auto. destruct x; auto. Qed.
Theorem PR1_nsign: PR1 nsign. Proof. apply PR1_Recu with 1 (fun _ _=>0); auto. destruct x; auto. Qed.
Theorem PR1_sum: forall f, PR1 f -> PR1 (fun x=>fold_right plus 0 (map f (seq 0 x))). Proof. intros. apply PR1_Recu with 0 (fun r i=>r+f i); auto. apply PR2_Comp2 with plus (fun x y=>x) (fun x y=>f y); auto. apply PR2_Comp1 with f (fun x y=>y); auto. intros. rewrite <- fold_symmetric; auto. induction x; auto. rewrite seqS. simpl. rewrite map_app. rewrite fold_left_app. simpl. rewrite <- IHx. auto. Qed.
Theorem PR2_sum: forall f, PR2 f -> PR2 (fun x y=>fold_right plus 0 (map (fun x=>f x y) (seq 0 x))). Proof. intros. apply PR2_Recu with (fun _=>0) (fun r i y=>r+f i y); auto. apply PR3_Comp2 with plus (fun x y z=>x) (fun x y z=>f y z); auto. apply PR3_Comp2 with f (fun x y z=>y) (fun x y z=>z); auto. intros. rewrite <- fold_symmetric; auto. induction x; auto. rewrite seqS. simpl. rewrite map_app. rewrite fold_left_app. simpl. rewrite <- IHx. auto. Qed.
Theorem PR3_sum: forall f, PR3 f -> PR3 (fun x y z=>fold_right plus 0 (map (fun x=>f x y z) (seq 0 x))). Proof. intros. apply PR3_Recu with (fun _ _=>0) (fun r i y z=>r+f i y z); auto. apply PR4_Comp2 with plus (fun r x y z=>r) (fun r x y z=>f x y z); auto. apply PR4_Comp3 with f (fun _ x y z=>x) (fun _ x y z=>y) (fun _ x y z=>z); auto. intros. rewrite <- fold_symmetric; auto. induction x; auto. rewrite seqS. simpl. rewrite map_app. rewrite fold_left_app. simpl. rewrite <- IHx. auto. Qed.
Theorem PR1_prod: forall f, PR1 f -> PR1 (fun x=>fold_right mult 1 (map f (seq 0 x))). Proof. intros. apply PR1_Recu with 1 (fun r i=>r*f i); auto. apply PR2_Comp2 with mult (fun x y=>x) (fun x y=>f y); auto. apply PR2_Comp1 with f (fun x y=>y); auto. intros. rewrite <- fold_symmetric; auto. induction x; auto. rewrite seqS. simpl. rewrite map_app. rewrite fold_left_app. simpl. rewrite <- IHx. auto. Qed.
Theorem PR2_prod: forall f, PR2 f -> PR2 (fun x y=>fold_right mult 1 (map (fun x=>f x y) (seq 0 x))). Proof. intros. apply PR2_Recu with (fun _=>1) (fun r i y=>r*f i y); auto. apply PR3_Comp2 with mult (fun x y z=>x) (fun x y z=>f y z); auto. apply PR3_Comp2 with f (fun x y z=>y) (fun x y z=>z); auto. intros. rewrite <- fold_symmetric; auto. induction x; auto. rewrite seqS. simpl. rewrite map_app. rewrite fold_left_app. simpl. rewrite <- IHx. auto. Qed.
Theorem PR3_prod: forall f, PR3 f -> PR3 (fun x y z=>fold_right mult 1 (map (fun x=>f x y z) (seq 0 x))). Proof. intros. apply PR3_Recu with (fun _ _=>1) (fun r i y z=>r*f i y z); auto. apply PR4_Comp2 with mult (fun r x y z=>r) (fun r x y z=>f x y z); auto. apply PR4_Comp3 with f (fun _ x y z=>x) (fun _ x y z=>y) (fun _ x y z=>z); auto. intros. rewrite <- fold_symmetric; auto. induction x; auto. rewrite seqS. simpl. rewrite map_app. rewrite fold_left_app. simpl. rewrite <- IHx. auto. Qed.
Theorem PR2_modN'_: PR2 (fun x n=>modN' n x). Proof. apply PR2_Recu with (fun _=>0) (fun r i y=>(S r)*sign (abs (S r) y)); auto. apply PR3_Comp2 with mult (fun r _ y=>S r) (fun r _ y=>sign(abs (S r) y)); auto. apply PR3_Comp1 with S (fun r _ _=>r); auto. apply PR3_Comp1 with sign (fun r _ y=>abs (S r) y); auto. apply PR1_sign. apply PR3_Comp2 with abs (fun r _ _=>S r) (fun _ _ y=>y); auto. apply PR2_abs. apply PR3_Comp1 with S (fun r _ _=>r); auto. intros. unfold modN'. destruct (nat_eq_dec y 0). subst y; auto. induction x; auto. rewrite <- IHx. unfold sign. unfold abs. destruct (le_lt_dec 0 (S x)). rewrite <- minus_n_O. rewrite mult_1_r; auto. inversion l.
  induction x; auto. rewrite <- IHx. clear IHx. unfold modN. destruct (divmod y (S x)) as [[q [r [H H0] H1]]|H1]; [|contradiction]. destruct (divmod y x) as [[q' [r' [H2 H3] H4]]|H2]; [|contradiction]. unfold sign. unfold abs. destruct (le_lt_dec (S r') y). remember (y-S r') as z. destruct z. symmetry in Heqz. apply Nat.sub_0_le in Heqz. assert (y=S r'). apply le_antisym; auto. rewrite mult_0_r. assert (S x=S q'*y+0). simpl. rewrite H5 at 1. simpl. f_equal. rewrite plus_comm; simpl. rewrite plus_comm; auto. apply H1 in H6. destruct H6; auto. destruct y; auto. rewrite mult_1_r. assert (S x=q'*y+S r'). rewrite <- plus_n_Sm. f_equal; auto. apply H1 in H5.
  destruct H5; auto. destruct (le_lt_dec y (S r')); auto. apply Nat.sub_0_le in l0. rewrite l0 in Heqz. inversion Heqz. contradict H3; auto. Qed.
Theorem PR2_modN': PR2 modN'. Proof. apply PR2_Comp2 with (fun x n=>modN' n x) (fun x y=>y) (fun x y=>x); auto. apply PR2_modN'_. Qed.
Hint Resolve abs_spec PR2_abs PR1_sign PR1_nsign PR1_sum PR2_sum PR3_sum PR1_prod PR2_prod PR3_prod PR2_modN'.

(* Predicates *)
Inductive PRP1 (P:nat->Prop) : Prop := PRP1_intro: forall f, PR1 f-> (forall x, f x = 0 -> P x) -> (forall x, f x<>0 -> ~P x) -> PRP1 P.
Inductive PRP2 (P:nat->nat->Prop) : Prop := PRP2_intro: forall f, PR2 f-> (forall x y, f x y = 0 -> P x y) -> (forall x y, f x y<>0 -> ~P x y) -> PRP2 P.
Inductive PRP3 (P:nat->nat->nat->Prop) : Prop := PRP3_intro: forall f, PR3 f-> (forall x y z, f x y z= 0 -> P x y z) -> (forall x y z, f x y z<>0 -> ~P x y z) -> PRP3 P.
Inductive PRP4 (P:nat->nat->nat->nat->Prop) : Prop := PRP4_intro: forall f, PR4 f-> (forall x y z w, f x y z w= 0 -> P x y z w) -> (forall x y z w, f x y z w<>0 -> ~P x y z w) -> PRP4 P.
Hint Constructors PRP1 PRP2 PRP3 PRP4.

Theorem PRP1_Func: forall P p v, PRP1 P -> exists (F:Formula), forall x, (P x -> Inf ((#v==n2t x)::p) F) /\ (~P x -> Inf ((#v==n2t x)::p) (!F)). Proof. intros. destruct H. apply PR1_Func in H as [G [H2 H3]]. exists (FuncT G ((#v)::nil) == n2t 0). intros; split; intros. apply Term_Eq_trans with (FuncT G (n2t x::nil)). apply Term_Eq_args; auto. replace 0 with (f x); auto. destruct (nat_eq_dec (f x) 0); auto. contradict H; auto.
  apply Contra with (n2t (f x)==n2t 0). apply Term_Eq_trans with (FuncT G ((#v)::nil)); auto. apply Term_Eq_trans with (FuncT G (n2t x::nil)); auto. apply Term_Eq_args; auto. apply n2t_neq. destruct (nat_eq_dec (f x) 0); auto; contradiction. Qed.
Theorem PRP2_Func: forall P p v u, PRP2 P -> exists (F:Formula), forall x y, (P x y -> Inf ((#v==n2t x)::(#u==n2t y)::p) F) /\ (~P x y-> Inf ((#v==n2t x)::(#u==n2t y)::p) (!F)). Proof. intros. destruct H. apply PR2_Func in H as [G [H2 H3]]. exists (FuncT G ((#v)::(#u)::nil) == n2t 0). intros; split; intros. apply Term_Eq_trans with (FuncT G (n2t x::n2t y::nil)). apply Term_Eq_args; auto. replace 0 with (f x y); auto. destruct (nat_eq_dec (f x y) 0); auto. contradict H; auto.
  apply Contra with (n2t (f x y)==n2t 0). apply Term_Eq_trans with (FuncT G ((#v)::(#u)::nil)); auto. apply Term_Eq_trans with (FuncT G (n2t x::n2t y::nil)); auto. apply Term_Eq_args; auto. apply MapR_cons; auto. apply MapR_cons; auto. apply n2t_neq. destruct (nat_eq_dec (f x y) 0); auto; contradiction. Qed.
Theorem PRP3_Func: forall P p v u w, PRP3 P -> exists (F:Formula), forall x y z, (P x y z-> Inf ((#v==n2t x)::(#u==n2t y)::(#w==n2t z)::p) F) /\ (~P x y z-> Inf ((#v==n2t x)::(#u==n2t y)::(#w==n2t z)::p) (!F)). Proof. intros. destruct H. apply PR3_Func in H as [G [H2 H3]]. exists (FuncT G ((#v)::(#u)::(#w)::nil) == n2t 0). intros; split; intros. apply Term_Eq_trans with (FuncT G (n2t x::n2t y::n2t z::nil)). apply Term_Eq_args; auto. apply MapR_cons; auto. apply MapR_cons; auto. replace 0 with (f x y z); auto. destruct (nat_eq_dec (f x y z) 0); auto. contradict H; auto.
  apply Contra with (n2t (f x y z)==n2t 0). apply Term_Eq_trans with (FuncT G ((#v)::(#u)::(#w)::nil)); auto. apply Term_Eq_trans with (FuncT G (n2t x::n2t y::n2t z::nil)); auto. apply Term_Eq_args; auto. apply MapR_cons; auto. apply MapR_cons; auto. apply MapR_cons; auto. apply Inf_incl'; auto. apply n2t_neq. destruct (nat_eq_dec (f x y z) 0); auto; contradiction. Qed.
Theorem PRP4_Func: forall P p v u t s, PRP4 P -> exists (F:Formula), forall x y z w, (P x y z w-> Inf ((#v==n2t x)::(#u==n2t y)::(#t==n2t z)::(#s==n2t w)::p) F) /\ (~P x y z w-> Inf ((#v==n2t x)::(#u==n2t y)::(#t==n2t z)::(#s==n2t w)::p) (!F)). Proof. intros. destruct H. apply PR4_Func in H as [G [H2 H3]]. exists (FuncT G ((#v)::(#u)::(#t)::(#s)::nil) == n2t 0). intros; split; intros. apply Term_Eq_trans with (FuncT G (n2t x::n2t y::n2t z::n2t w::nil)). apply Term_Eq_args; auto. repeat apply MapR_cons; auto. replace 0 with (f x y z w); auto. destruct (nat_eq_dec (f x y z w) 0); auto. contradict H; auto.
  apply Contra with (n2t (f x y z w)==n2t 0). apply Term_Eq_trans with (FuncT G ((#v)::(#u)::(#t)::(#s)::nil)); auto. apply Term_Eq_trans with (FuncT G (n2t x::n2t y::n2t z::n2t w::nil)); auto. apply Term_Eq_args; auto. repeat apply MapR_cons; auto. apply Inf_incl'; apply Inf_incl'; auto. apply Inf_incl'; auto. apply n2t_neq. destruct (nat_eq_dec (f x y z w) 0); auto; contradiction. Qed.

Theorem PRP1_Comp1: forall P f, PRP1 P -> PR1 f -> PRP1 (fun x=>P (f x)). Proof. intros. destruct H. apply PRP1_intro with (fun x=>f0 (f x)); intros; auto. apply PR1_Comp1 with f0 f; auto. Qed.
Theorem PRP1_Comp2: forall P f g, PRP2 P -> PR1 f -> PR1 g -> PRP1 (fun x=>P (f x) (g x)). Proof. intros. destruct H. apply PRP1_intro with (fun x=>f0 (f x) (g x)); intros; auto. apply PR1_Comp2 with f0 f g; auto. Qed.
Theorem PRP1_Comp3: forall P f g h, PRP3 P -> PR1 f -> PR1 g -> PR1 h -> PRP1 (fun x=>P (f x) (g x) (h x)). Proof. intros. destruct H. apply PRP1_intro with (fun x=>f0 (f x) (g x) (h x)); intros; auto. apply PR1_Comp3 with f0 f g h; auto. Qed.
Theorem PRP2_Comp1: forall P f, PRP1 P -> PR2 f -> PRP2 (fun x y=>P (f x y)). Proof. intros. destruct H. apply PRP2_intro with (fun x y=>f0 (f x y)); intros; auto. apply PR2_Comp1 with f0 f; auto. Qed.
Theorem PRP2_Comp2: forall P f g, PRP2 P -> PR2 f -> PR2 g -> PRP2 (fun x y=>P (f x y) (g x y)). Proof. intros. destruct H. apply PRP2_intro with (fun x y=>f0 (f x y) (g x y)); intros; auto. apply PR2_Comp2 with f0 f g; auto. Qed.
Theorem PRP2_Comp3: forall P f g h, PRP3 P -> PR2 f -> PR2 g -> PR2 h -> PRP2 (fun x y=>P (f x y) (g x y) (h x y)). Proof. intros. destruct H. apply PRP2_intro with (fun x y=>f0 (f x y) (g x y) (h x y)); intros; auto. apply PR2_Comp3 with f0 f g h; auto. Qed.
Theorem PRP3_Comp1: forall P f, PRP1 P -> PR3 f -> PRP3 (fun x y z=>P (f x y z)). Proof. intros. destruct H. apply PRP3_intro with (fun x y z=>f0 (f x y z)); intros; auto. apply PR3_Comp1 with f0 f; auto. Qed.
Theorem PRP3_Comp2: forall P f g, PRP2 P -> PR3 f -> PR3 g -> PRP3 (fun x y z=>P (f x y z) (g x y z)). Proof. intros. destruct H. apply PRP3_intro with (fun x y z=>f0 (f x y z) (g x y z)); intros; auto. apply PR3_Comp2 with f0 f g; auto. Qed.
Theorem PRP3_Comp3: forall P f g h, PRP3 P -> PR3 f -> PR3 g -> PR3 h -> PRP3 (fun x y z=>P (f x y z) (g x y z) (h x y z)). Proof. intros. destruct H. apply PRP3_intro with (fun x y z=>f0 (f x y z) (g x y z) (h x y z)); intros; auto. apply PR3_Comp3 with f0 f g h; auto. Qed.
Hint Resolve PRP1_Comp1 PRP1_Comp2 PRP1_Comp3 PRP2_Comp1 PRP2_Comp2 PRP2_Comp3 PRP3_Comp1 PRP3_Comp2 PRP3_Comp3.

Theorem PRP1_equiv: forall P Q, PRP1 P -> (forall x, P x<->Q x) -> PRP1 Q. Proof. intros. destruct H. apply PRP1_intro with f; intros; auto. apply H0; auto. intros C; apply H0 in C; contradict C; auto. Qed.
Theorem PRP2_equiv: forall P Q, PRP2 P -> (forall x y, P x y<->Q x y) -> PRP2 Q. Proof. intros. destruct H. apply PRP2_intro with f; intros; auto. apply H0; auto. intros C; apply H0 in C; contradict C; auto. Qed.
Theorem PRP3_equiv: forall P Q, PRP3 P -> (forall x y z, P x y z<->Q x y z) -> PRP3 Q. Proof. intros. destruct H. apply PRP3_intro with f; intros; auto. apply H0; auto. intros C; apply H0 in C; contradict C; auto. Qed.

Theorem PRP1_Neg: forall P, PRP1 P -> PRP1 (fun x=>~P x). Proof. intros. destruct H. apply PRP1_intro with (fun x=>nsign (f x)); auto. apply PR1_Comp1 with nsign f; auto. intros. apply H1. destruct (f x); auto. inversion H2. intros. intros C. apply C. apply H0. destruct (f x); auto. contradict H2; auto. Qed.
Theorem PRP2_Neg: forall P, PRP2 P -> PRP2 (fun x y=>~P x y). Proof. intros. destruct H. apply PRP2_intro with (fun x y=>nsign (f x y)); auto. apply PR2_Comp1 with nsign f; auto. intros. apply H1. destruct (f x y); auto. inversion H2. intros. intros C. apply C. apply H0. destruct (f x y); auto. contradict H2; auto. Qed.
Theorem PRP3_Neg: forall P, PRP3 P -> PRP3 (fun x y z=>~P x y z). Proof. intros. destruct H. apply PRP3_intro with (fun x y z=>nsign (f x y z)); auto. apply PR3_Comp1 with nsign f; auto. intros. apply H1. destruct (f x y z); auto. inversion H2. intros. intros C. apply C. apply H0. destruct (f x y z); auto. contradict H2; auto. Qed.

Theorem PRP1_Land: forall P Q, PRP1 P -> PRP1 Q -> PRP1 (fun x=>P x /\ Q x). Proof. intros. destruct H. destruct H0. apply PRP1_intro with (fun x=>plus (f x) (f0 x)); intros; auto. apply PR1_Comp2 with plus f f0; auto. split. apply H1. destruct (f x); auto. inversion H5. apply H3. destruct (f0 x); auto. rewrite <- plus_n_Sm in H5. inversion H5. contradict H5. destruct H5. destruct (nat_eq_dec (f x) 0); destruct (nat_eq_dec (f0 x) 0). rewrite e; rewrite e0; auto. contradict H6; auto. contradict H5; auto. contradict H5; auto. Qed.
Theorem PRP2_Land: forall P Q, PRP2 P -> PRP2 Q -> PRP2 (fun x y=>P x y/\ Q x y). Proof. intros. destruct H. destruct H0. apply PRP2_intro with (fun x y=>plus (f x y) (f0 x y)); intros; auto. apply PR2_Comp2 with plus f f0; auto. split. apply H1. destruct (f x y); auto. inversion H5. apply H3. destruct (f0 x y); auto. rewrite <- plus_n_Sm in H5. inversion H5. contradict H5. destruct H5. destruct (nat_eq_dec (f x y) 0); destruct (nat_eq_dec (f0 x y) 0). rewrite e; rewrite e0; auto. contradict H6; auto. contradict H5; auto. contradict H5; auto. Qed.
Theorem PRP3_Land: forall P Q, PRP3 P -> PRP3 Q -> PRP3 (fun x y z=>P x y z/\ Q x y z). Proof. intros. destruct H. destruct H0. apply PRP3_intro with (fun x y z=>plus (f x y z) (f0 x y z)); intros; auto. apply PR3_Comp2 with plus f f0; auto. split. apply H1. destruct (f x y z); auto. inversion H5. apply H3. destruct (f0 x y z); auto. rewrite <- plus_n_Sm in H5. inversion H5. contradict H5. destruct H5. destruct (nat_eq_dec (f x y z) 0); destruct (nat_eq_dec (f0 x y z) 0). rewrite e; rewrite e0; auto. contradict H6; auto. contradict H5; auto. contradict H5; auto. Qed.

Theorem PRP1_Lor: forall P Q, PRP1 P -> PRP1 Q -> PRP1 (fun x=>P x \/ Q x). Proof. intros. destruct H. destruct H0. apply PRP1_intro with (fun x=>mult (f x) (f0 x)); intros; auto. apply PR1_Comp2 with mult f f0; auto. apply mult_is_O in H5. destruct H5; auto. contradict H5. destruct H5. destruct (nat_eq_dec (f x) 0). rewrite e; auto. contradict H5; auto. destruct (nat_eq_dec (f0 x) 0). rewrite e; auto. contradict H5; auto. Qed.
Theorem PRP2_Lor: forall P Q, PRP2 P -> PRP2 Q -> PRP2 (fun x y=>P x y\/ Q x y). Proof. intros. destruct H. destruct H0. apply PRP2_intro with (fun x y=>mult (f x y) (f0 x y)); intros; auto. apply PR2_Comp2 with mult f f0; auto. apply mult_is_O in H5. destruct H5; auto. contradict H5. destruct H5. destruct (nat_eq_dec (f x y) 0). rewrite e; auto. contradict H5; auto. destruct (nat_eq_dec (f0 x y) 0). rewrite e; auto. contradict H5; auto. Qed.
Theorem PRP3_Lor: forall P Q, PRP3 P -> PRP3 Q -> PRP3 (fun x y z=>P x y z\/ Q x y z). Proof. intros. destruct H. destruct H0. apply PRP3_intro with (fun x y z=>mult (f x y z) (f0 x y z)); intros; auto. apply PR3_Comp2 with mult f f0; auto. apply mult_is_O in H5. destruct H5; auto. contradict H5. destruct H5. destruct (nat_eq_dec (f x y z) 0). rewrite e; auto. contradict H5; auto. destruct (nat_eq_dec (f0 x y z) 0). rewrite e; auto. contradict H5; auto. Qed.
Hint Resolve PRP1_equiv PRP2_equiv PRP3_equiv PRP1_Neg PRP2_Neg PRP3_Neg PRP1_Land PRP2_Land PRP3_Land PRP1_Lor PRP2_Lor PRP3_Lor.

Theorem PR1_ite: forall P (P_dec: forall x, {P x}+{~P x}) f g, PRP1 P -> PR1 f -> PR1 g -> PR1 (fun x=>if P_dec x then f x else g x). Proof. intros. destruct H as [p H2 H3]. apply PR1_Comp2 with plus (fun x=>nsign(p x)*f x) (fun x=>sign(p x)*g x); auto. apply PR1_Comp2 with mult (fun x=>nsign (p x)) f; auto. apply PR1_Comp1 with nsign p; auto. apply PR1_Comp2 with mult (fun x=>sign(p x)) g; auto. apply PR1_Comp1 with sign p; auto. intros. remember (p x) as n. unfold nsign. unfold sign. destruct n;destruct (P_dec x); simpl. repeat rewrite <- plus_n_O; auto. contradict n; auto. contradict p0. apply H. rewrite <- Heqn; auto. rewrite <- plus_n_O; auto. Qed.
Theorem PR2_ite: forall P (P_dec: forall x y, {P x y}+{~P x y}) f g, PRP2 P -> PR2 f -> PR2 g -> PR2 (fun x y=>if P_dec x y then f x y else g x y). Proof. intros. destruct H as [p H2 H3]. apply PR2_Comp2 with plus (fun x y=>nsign(p x y)*f x y) (fun x y=>sign(p x y)*g x y); auto. apply PR2_Comp2 with mult (fun x y=>nsign (p x y)) f; auto. apply PR2_Comp1 with nsign p; auto. apply PR2_Comp2 with mult (fun x y=>sign(p x y)) g; auto. apply PR2_Comp1 with sign p; auto. intros. remember (p x y) as n. unfold nsign. unfold sign. destruct n;destruct (P_dec x y); simpl. repeat rewrite <- plus_n_O; auto. contradict n; auto. contradict p0. apply H. rewrite <- Heqn; auto. rewrite <- plus_n_O; auto. Qed.
Theorem PR3_ite: forall P (P_dec: forall x y z, {P x y z}+{~P x y z}) f g, PRP3 P -> PR3 f -> PR3 g -> PR3 (fun x y z=>if P_dec x y z then f x y z else g x y z). Proof. intros. destruct H as [p H2 H3]. apply PR3_Comp2 with plus (fun x y z=>nsign(p x y z)*f x y z) (fun x y z=>sign(p x y z)*g x y z); auto. apply PR3_Comp2 with mult (fun x y z=>nsign (p x y z)) f; auto. apply PR3_Comp1 with nsign p; auto. apply PR3_Comp2 with mult (fun x y z=>sign(p x y z)) g; auto. apply PR3_Comp1 with sign p; auto. intros. remember (p x y z) as n. unfold nsign. unfold sign. destruct n;destruct (P_dec x); simpl. repeat rewrite <- plus_n_O; auto. contradict n; auto. contradict p0. apply H. rewrite <- Heqn; auto. rewrite <- plus_n_O; auto. Qed.
Theorem PR4_ite: forall P (P_dec: forall x y z w, {P x y z w}+{~P x y z w}) f g, PRP4 P -> PR4 f -> PR4 g -> PR4 (fun x y z w=>if P_dec x y z w then f x y z w else g x y z w). Proof. intros. destruct H as [p H2 H3]. apply PR4_Comp2 with plus (fun x y z w=>nsign(p x y z w)*f x y z w) (fun x y z w=>sign(p x y z w)*g x y z w); auto. apply PR4_Comp2 with mult (fun x y z w=>nsign (p x y z w)) f; auto. apply PR4_Comp1 with nsign p; auto. apply PR4_Comp2 with mult (fun x y z w=>sign(p x y z w)) g; auto. apply PR4_Comp1 with sign p; auto. intros. remember (p x y z w) as n. unfold nsign. unfold sign. destruct n;destruct (P_dec x); simpl. repeat rewrite <- plus_n_O; auto. contradict n; auto. contradict p0. apply H. rewrite <- Heqn; auto. rewrite <- plus_n_O; auto. Qed.
Hint Resolve PR1_ite PR2_ite PR3_ite PR4_ite.

Theorem PRP1_Ex: forall P, PRP1 P -> PRP1 (fun x=>exists n, n<x /\ P n). Proof. intros. destruct H. apply PRP1_intro with (fun x=>fold_right mult 1 (map f (seq 0 x))); intros; auto; rewrite <- fold_symmetric in H2; auto. induction x. simpl in H2; inversion H2. rewrite seqS in H2. rewrite map_app in H2. rewrite fold_left_app in H2; simpl in H2. apply mult_is_O in H2. destruct H2. apply IHx in H2. destruct H2 as [n [H3 H4]]. exists n; auto. exists x; auto. contradict H2. destruct H2 as [n [H3 H4]]. induction H3. rewrite seqS. rewrite map_app. rewrite fold_left_app. simpl. destruct (nat_eq_dec (f n) 0). rewrite e; auto. contradict H4; auto. rewrite seqS. rewrite map_app. rewrite fold_left_app. rewrite IHle; auto. Qed.
Theorem PRP2_Ex: forall P, PRP2 P -> PRP2 (fun x y=>exists n, n<x /\ P n y). Proof. intros. destruct H. apply PRP2_intro with (fun x y=>fold_right mult 1 (map (fun x=>f x y) (seq 0 x))); intros; auto; rewrite <- fold_symmetric in H2; auto. induction x. simpl in H2; inversion H2. rewrite seqS in H2. rewrite map_app in H2. rewrite fold_left_app in H2; simpl in H2. apply mult_is_O in H2. destruct H2. apply IHx in H2. destruct H2 as [n [H3 H4]]. exists n; auto. exists x; auto. contradict H2. destruct H2 as [n [H3 H4]]. induction H3. rewrite seqS. rewrite map_app. rewrite fold_left_app. simpl. destruct (nat_eq_dec (f n y) 0). rewrite e; auto. contradict H4; auto. rewrite seqS. rewrite map_app. rewrite fold_left_app. rewrite IHle; auto. Qed.
Theorem PRP3_Ex: forall P, PRP3 P -> PRP3 (fun x y z=>exists n, n<x /\ P n y z). Proof. intros. destruct H. apply PRP3_intro with (fun x y z=>fold_right mult 1 (map (fun x=>f x y z) (seq 0 x))); intros; auto; rewrite <- fold_symmetric in H2; auto. induction x. simpl in H2; inversion H2. rewrite seqS in H2. rewrite map_app in H2. rewrite fold_left_app in H2; simpl in H2. apply mult_is_O in H2. destruct H2. apply IHx in H2. destruct H2 as [n [H3 H4]]. exists n; auto. exists x; auto. contradict H2. destruct H2 as [n [H3 H4]]. induction H3. rewrite seqS. rewrite map_app. rewrite fold_left_app. simpl. destruct (nat_eq_dec (f n y z) 0). rewrite e; auto. contradict H4; auto. rewrite seqS. rewrite map_app. rewrite fold_left_app. rewrite IHle; auto. Qed.
Theorem PRP1_Any: forall P, PRP1 P -> PRP1 (fun x=>forall n, n<x -> P n). Proof. intros. destruct H. apply PRP1_intro with (fun x=>fold_right plus 0 (map f (seq 0 x))); intros; auto; rewrite <- fold_symmetric in H2; auto. induction x. inversion H3. rewrite seqS in H2. rewrite map_app in H2. rewrite fold_left_app in H2. simpl in H2. apply plus_is_O in H2. destruct H2. apply le_S_n in H3. apply le_lt_or_eq in H3. destruct H3; auto. subst n; auto. contradict H2. induction x. auto. rewrite seq_S. rewrite map_app. rewrite fold_left_app. simpl. rewrite IHx; auto. simpl. destruct (nat_eq_dec (f x) 0); auto. absurd (P x); auto. Qed.
Theorem PRP2_Any: forall P, PRP2 P -> PRP2 (fun x y=>forall n, n<x -> P n y). Proof. intros. destruct H. apply PRP2_intro with (fun x y=>fold_right plus 0 (map (fun x=>f x y) (seq 0 x))); intros; auto; rewrite <- fold_symmetric in H2; auto. induction x. inversion H3. rewrite seqS in H2. rewrite map_app in H2. rewrite fold_left_app in H2. simpl in H2. apply plus_is_O in H2. destruct H2. apply le_S_n in H3. apply le_lt_or_eq in H3. destruct H3; auto. subst n; auto. contradict H2. induction x. auto. rewrite seq_S. rewrite map_app. rewrite fold_left_app. simpl. rewrite IHx; auto. simpl. destruct (nat_eq_dec (f x y) 0); auto. absurd (P x y); auto. Qed.
Theorem PRP3_Any: forall P, PRP3 P -> PRP3 (fun x y z=>forall n, n<x -> P n y z). Proof. intros. destruct H. apply PRP3_intro with (fun x y z=>fold_right plus 0 (map (fun x=>f x y z) (seq 0 x))); intros; auto; rewrite <- fold_symmetric in H2; auto. induction x. inversion H3. rewrite seqS in H2. rewrite map_app in H2. rewrite fold_left_app in H2. simpl in H2. apply plus_is_O in H2. destruct H2. apply le_S_n in H3. apply le_lt_or_eq in H3. destruct H3; auto. subst n; auto. contradict H2. induction x. auto. rewrite seq_S. rewrite map_app. rewrite fold_left_app. simpl. rewrite IHx; auto. simpl. destruct (nat_eq_dec (f x y z) 0); auto. absurd (P x y z); auto. Qed.
Hint Resolve PRP1_Ex PRP2_Ex PRP3_Ex PRP1_Any PRP2_Any PRP3_Any.

Theorem PR1_PnumN: forall P, PRP1 P -> exists f, PR1 f /\ forall n, PnumN P n (f n). Proof. intros. destruct H. exists (fun x=>fold_right plus 0 (map (fun x=>nsign (f x)) (seq 0 x))). split. apply PR1_sum. apply PR1_Comp1 with nsign f; auto. intros. rewrite <- fold_symmetric; auto. induction n. simpl. auto. rewrite seq_S. rewrite map_app. rewrite fold_left_app. simpl. destruct (nat_eq_dec (f n) 0). rewrite e. apply H0 in e. simpl. rewrite plus_comm. auto. assert (~P n); auto. destruct (f n). contradict n0; auto. simpl. rewrite plus_comm; auto. Qed.
Theorem PR2_PnumN: forall P, PRP2 P -> exists f, PR2 f /\ forall n y, PnumN (fun n=>P n y) n (f n y). Proof. intros. destruct H. exists (fun x y=>fold_right plus 0 (map (fun x=>nsign (f x y)) (seq 0 x))). split. apply PR2_sum. apply PR2_Comp1 with nsign f; auto. intros. rewrite <- fold_symmetric; auto. induction n. simpl. auto. rewrite seq_S. rewrite map_app. rewrite fold_left_app. simpl. destruct (nat_eq_dec (f n y) 0). rewrite e. apply H0 in e. simpl. rewrite plus_comm. auto. assert (~P n y); auto. destruct (f n y). contradict n0; auto. simpl. rewrite plus_comm; auto. Qed.
Theorem PR3_PnumN: forall P, PRP3 P -> exists f, PR3 f /\ forall n y z, PnumN (fun n=>P n y z) n (f n y z). Proof. intros. destruct H. exists (fun x y z=>fold_right plus 0 (map (fun x=>nsign (f x y z)) (seq 0 x))). split. apply PR3_sum. apply PR3_Comp1 with nsign f; auto. intros. rewrite <- fold_symmetric; auto. induction n. simpl. auto. rewrite seq_S. rewrite map_app. rewrite fold_left_app. simpl. destruct (nat_eq_dec (f n y z) 0). rewrite e. apply H0 in e. simpl. rewrite plus_comm. auto. assert (~P n y z); auto. destruct (f n y z). contradict n0; auto. simpl. rewrite plus_comm; auto. Qed.
Hint Resolve PR1_PnumN PR2_PnumN PR3_PnumN.

Theorem PRP2_Eq: PRP2 (fun x y:nat =>x=y). Proof. apply PRP2_intro with abs; auto; intros. apply abs_spec; auto. contradict H. apply abs_spec; auto. Qed.
Theorem PRP2_le: PRP2 le. Proof. apply PRP2_intro with minus; auto; intros. apply Nat.sub_0_le; auto. contradict H. apply Nat.sub_0_le; auto. Qed.
Theorem PRP2_Neq: PRP2 (fun x y:nat =>x<>y). Proof. apply PRP2_Neg. apply PRP2_Eq. Qed.
Theorem PRP2_lt: PRP2 lt. Proof. apply PRP2_equiv with (fun x y=>x<=y /\ x<>y). apply PRP2_Land. apply PRP2_le. apply PRP2_Neq. intros; split; intros. destruct H. apply le_lt_or_eq in H. destruct H; auto; contradiction. split. auto. contradict H; subst y; auto. Qed.
Theorem PRP3_ModEq: PRP3 ModEq. Proof. apply PRP3_equiv with (fun n x y=>modN' n x=modN' n y). apply PRP3_intro with (fun n x y=>abs (modN' n x) (modN' n y)). apply PR3_Comp2 with abs (fun n x y=>modN' n x) (fun n x y=>modN' n y); auto. apply PR3_Comp2 with modN' (fun n _ _=>n) (fun _ x _=>x); auto. apply PR3_Comp2 with modN' (fun n _ _=>n) (fun _ _ y=>y); auto. intros. apply abs_spec; auto. intros. contradict H. apply abs_spec; auto. intros. unfold modN'. destruct (nat_eq_dec x 0) as [xz|nz]. subst x. split; intros. subst z; auto. auto. split; intros. apply modN_eq__ModEq in H; auto. apply ModEq__modN_eq; auto. Qed.
Theorem PRP2_Divide: PRP2 Divide. Proof. destruct (PRP3_ModEq). apply PRP2_intro with (fun n y=>f n 0 y). apply PR2_Comp3 with f (fun n y=>n) (fun _ _=>0) (fun n y=>y); auto. intros. unfold Divide. auto. intros. apply H1 in H2. unfold Divide. auto. Qed.
Theorem PRP1_Prime: PRP1 Prime. Proof. destruct PR2_PnumN with (P:=Divide) as [f [H H0]]. apply PRP2_Divide. apply PRP1_intro with (fun x=>abs (f (S x) x) 2). apply PR1_Comp2 with abs (fun x=>f (S x) x) (fun x=>2); auto. apply PR1_Comp2 with f (fun x=>S x) (fun x=>x); auto. intros. unfold Prime. assert (f (S x) x=2). apply abs_spec; auto. clear H1. destruct (nat_eq_dec x 0). subst x. assert (PnumN (fun n=>Divide n 0) 1 2). rewrite <- H2; auto. inversion H1. inversion H5. inversion H4. cut (PnumN (fun n=>Divide n x) (S x) 2). intros. apply Pnum_intro with (S x). intros. induction H3; auto. apply PnumN_NP; auto. intros C. apply Divide_le in C; auto. contradict H3; auto. rewrite <- H2. auto.
  intros. contradict H1. apply abs_spec. eapply PnumN_unique. eapply H0. assert (2<=x); auto. assert (PnumN (fun n=>Divide n x) 2 1). apply PnumN_P; auto. apply PnumN_NP; auto. intros C. apply ModEq0_eq in C. subst x; inversion H2. apply PnumN_P; auto. cut (forall i, 2<=i -> i<=x -> PnumN (fun n=>Divide n x) i 1). intros. auto. intros i H4. clear H2. induction H4; intros; auto. apply PnumN_NP. apply IHle. apply le_S_n; auto. intros C. apply Prime_Divide in C; auto. destruct C. contradict H4; subst m; auto. contradict H2; subst m; auto. Qed.
Theorem PR2_div': PR2 div'. Proof. apply PR2_Recu with (f:=fun _=>0) (g:=fun r i n=>if Divide_dec n (S i) then S r else r); auto. apply PR3_ite; auto. apply PRP3_Comp2; auto. apply PRP2_Divide. apply PR3_Comp1 with S (fun _ y _=>y); auto. apply PR3_Comp1 with S (fun x _ _=>x); auto. intros. unfold div'. destruct (divmod y x) as [[q [r [H1 H2] _]]|H1]. revert H2 H1. revert y q r. induction x; intros. destruct q; auto. simpl in H1. destruct y. inversion H2. inversion H1. destruct (nat_eq_dec r 0). subst r. destruct (Divide_dec y (S x)). destruct q. inversion H1. f_equal. apply IHx with (y-1). destruct y. inversion H2. simpl. rewrite <- minus_n_O; auto. destruct y. inversion H2. simpl. rewrite <- minus_n_O. simpl in H1. inversion H1. rewrite plus_comm. simpl; auto. contradict n. rewrite H1. rewrite plus_comm; auto.
  destruct (Divide_dec y (S x)). rewrite H1 in d. apply Divide_minus in d; auto. apply Divide_le_or_0 in d. destruct d. contradict H2; auto. contradiction. destruct r. contradict n; auto. apply IHx with r; auto. rewrite <- plus_n_Sm in H1. inversion H1; auto. subst y. induction x; auto. Qed.
Hint Resolve PRP2_Eq PRP2_le PRP2_Neq PRP2_lt PRP3_ModEq PRP2_Divide PRP1_Prime PR2_div'.

Theorem PR1_minP: forall P, PRP1 P -> exists f, PR1 f /\ forall n, f n<=n /\ (f n = 0 -> (forall i, i<n->~P i)) /\ forall m, f n = S m -> (P m /\ forall i, i<n->P i->m<=i). Proof. intros. destruct H. remember (fix rec n:=match n with |O=>O|S n'=>if nat_eq_dec (f n') 0 then if nat_eq_dec (rec n') 0 then S n' else rec n' else rec n' end) as rec. exists rec. split. apply PR1_Recu with (f:=0) (g:=fun s i=>if nat_eq_dec (f i) 0 then if nat_eq_dec s 0 then S i else s else s); auto. apply PR2_ite; auto. apply PRP2_intro with (fun _ y=>f y); auto. apply PR2_Comp1 with f (fun _ y=>y); auto. apply PR2_ite; auto. apply PR2_Comp1 with S (fun _ y=>y); auto. intros; simpl; subst rec; auto. induction n as [ |n [H2 [H3 H4]]]. repeat split; intros. subst rec; simpl; auto. inversion H3. subst rec; simpl in H2; inversion H2. inversion H3.
  split. rewrite Heqrec. destruct (nat_eq_dec (f n) 0); rewrite <- Heqrec; auto. destruct (nat_eq_dec (rec n) 0); auto. split; intros. rewrite Heqrec in H5. destruct (nat_eq_dec (f n) 0); rewrite <- Heqrec in H5. destruct (nat_eq_dec (rec n) 0). inversion H5. contradiction. apply le_S_n in H6. apply le_lt_or_eq in H6. destruct H6; auto. subst i; auto. rewrite Heqrec in H5. destruct (nat_eq_dec (f n) 0); rewrite <- Heqrec in H5. destruct (nat_eq_dec (rec n) 0). inversion H5. subst m. split; auto. intros. destruct (le_lt_dec n i); auto. contradict H7; auto. destruct (H4 m H5). split; auto. intros. apply le_S_n in H8. apply le_lt_or_eq in H8. destruct H8; auto. subst i. apply lt_le_weak. unfold lt. rewrite <- H5; auto. destruct (H4 m H5). split; auto. intros. apply le_S_n in H8. apply le_lt_or_eq in H8. destruct H8; auto. subst i; contradict H9; auto. Qed.
Theorem PR2_minP: forall P, PRP2 P -> exists f, PR2 f /\ forall n y, f n y<=n /\ (f n y= 0 -> (forall i, i<n->~P i y)) /\ forall m, f n y = S m -> (P m y /\ forall i, i<n->P i y->m<=i). Proof. intros. destruct H. remember (fix rec n y:=match n with |O=>O|S n'=>if nat_eq_dec (f n' y) 0 then if nat_eq_dec (rec n' y) 0 then S n' else rec n' y else rec n' y end) as rec. exists rec. split. apply PR2_Recu with (f:=fun _=>0) (g:=fun s i y=>if nat_eq_dec (f i y) 0 then if nat_eq_dec s 0 then S i else s else s); auto. apply PR3_ite; auto. apply PRP3_intro with (fun _ y z=>f y z); auto. apply PR3_Comp2 with f (fun _ y _=>y) (fun _ _ z=>z); auto. apply PR3_ite; auto. apply PRP3_intro with (fun x _ _=>x); auto. apply PR3_Comp1 with S (fun _ y _=>y); auto. intros; simpl; subst rec; auto. intros. induction n as [ |n [H2 [H3 H4]]]. repeat split; intros. subst rec; simpl; auto. inversion H3. subst rec; simpl in H2; inversion H2. inversion H3.
  split. rewrite Heqrec. destruct (nat_eq_dec (f n y) 0); rewrite <- Heqrec; auto. destruct (nat_eq_dec (rec n y) 0); auto. split; intros. rewrite Heqrec in H5. destruct (nat_eq_dec (f n y) 0); rewrite <- Heqrec in H5. destruct (nat_eq_dec (rec n y) 0). inversion H5. contradiction. apply le_S_n in H6. apply le_lt_or_eq in H6. destruct H6; auto. subst i; auto. rewrite Heqrec in H5. destruct (nat_eq_dec (f n y) 0); rewrite <- Heqrec in H5. destruct (nat_eq_dec (rec n y) 0). inversion H5. subst m. split; auto. intros. destruct (le_lt_dec n i); auto. contradict H7; auto. destruct (H4 m H5). split; auto. intros. apply le_S_n in H8. apply le_lt_or_eq in H8. destruct H8; auto. subst i. apply lt_le_weak. unfold lt. rewrite <- H5; auto. destruct (H4 m H5). split; auto. intros. apply le_S_n in H8. apply le_lt_or_eq in H8. destruct H8; auto. subst i; contradict H9; auto. Qed.
Theorem PR3_minP: forall P, PRP3 P -> exists f, PR3 f /\ forall n y z, f n y z<=n /\ (f n y z= 0 -> (forall i, i<n->~P i y z)) /\ forall m, f n y z = S m -> (P m y z /\ forall i, i<n->P i y z->m<=i). Proof. intros. destruct H. remember (fix rec n y z:=match n with |O=>O|S n'=>if nat_eq_dec (f n' y z) 0 then if nat_eq_dec (rec n' y z) 0 then S n' else rec n' y z else rec n' y z end) as rec. exists rec. split. apply PR3_Recu with (f:=fun _ _=>0) (g:=fun s i y z=>if nat_eq_dec (f i y z) 0 then if nat_eq_dec s 0 then S i else s else s); auto. apply PR4_ite; auto. apply PRP4_intro with (fun _ y z w=>f y z w); auto. apply PR4_Comp3 with f (fun _ y _ _=>y) (fun _ _ z _=>z) (fun _ _ _ w=>w); auto. apply PR4_ite; auto. apply PRP4_intro with (fun x _ _ _=>x); auto. apply PR4_Comp1 with S (fun _ y _ _=>y); auto. intros; simpl; subst rec; auto. intros. induction n as [ |n [H2 [H3 H4]]]. repeat split; intros. subst rec; simpl; auto. inversion H3. subst rec; simpl in H2; inversion H2. inversion H3.
  split. rewrite Heqrec. destruct (nat_eq_dec (f n y z) 0); rewrite <- Heqrec; auto. destruct (nat_eq_dec (rec n y z) 0); auto. split; intros. rewrite Heqrec in H5. destruct (nat_eq_dec (f n y z) 0); rewrite <- Heqrec in H5. destruct (nat_eq_dec (rec n y z) 0). inversion H5. contradiction. apply le_S_n in H6. apply le_lt_or_eq in H6. destruct H6; auto. subst i; auto. rewrite Heqrec in H5. destruct (nat_eq_dec (f n y z) 0); rewrite <- Heqrec in H5. destruct (nat_eq_dec (rec n y z) 0). inversion H5. subst m. split; auto. intros. destruct (le_lt_dec n i); auto. contradict H7; auto. destruct (H4 m H5). split; auto. intros. apply le_S_n in H8. apply le_lt_or_eq in H8. destruct H8; auto. subst i. apply lt_le_weak. unfold lt. rewrite <- H5; auto. destruct (H4 m H5). split; auto. intros. apply le_S_n in H8. apply le_lt_or_eq in H8. destruct H8; auto. subst i; contradict H9; auto. Qed.
Hint Resolve PR1_minP PR2_minP PR3_minP.
Theorem PR1_maxP: forall P, PRP1 P -> exists f, PR1 f /\ forall n, f n<=n /\ (f n = 0 -> (forall i, i<n->~P i)) /\ forall m, f n = S m -> (P m /\ forall i, i<n->P i->i<=m). Proof. intros. destruct H. remember (fix rec n:=match n with |O=>O|S n'=>if nat_eq_dec (f n') 0 then S n' else rec n' end) as rec. exists rec. split. apply PR1_Recu with (f:=0) (g:=fun s i=>if nat_eq_dec (f i) 0 then S i else s); auto. apply PR2_ite; auto. apply PRP2_intro with (fun _ y=>f y); auto. apply PR2_Comp1 with f (fun _ y=>y); auto. apply PR2_Comp1 with S (fun _ y=>y); auto. intros; simpl; subst rec; auto. induction n as [ |n [H2 [H3 H4]]]. repeat split; intros. subst rec; simpl; auto. inversion H3. subst rec; simpl in H2; inversion H2. inversion H3.
  split. rewrite Heqrec. destruct (nat_eq_dec (f n) 0); auto. rewrite <- Heqrec; auto. split; intros. rewrite Heqrec in H5. destruct (nat_eq_dec (f n) 0). inversion H5. rewrite <- Heqrec in H5. apply le_S_n in H6. apply le_lt_or_eq in H6. destruct H6; auto. subst i; auto. rewrite Heqrec in H5. destruct (nat_eq_dec (f n) 0); [|rewrite <- Heqrec in H5]. inversion H5. subst m. split; auto. destruct (H4 m H5). split; auto. intros. apply le_S_n in H8. apply le_lt_or_eq in H8. destruct H8; auto. subst i. contradict H9; auto. Qed.
Theorem PR2_maxP: forall P, PRP2 P -> exists f, PR2 f /\ forall n y, f n y<=n /\ (f n y = 0 -> (forall i, i<n->~P i y)) /\ forall m, f n y = S m -> (P m y /\ forall i, i<n->P i y->i<=m). Proof. intros. destruct H. remember (fix rec n y:=match n with |O=>O|S n'=>if nat_eq_dec (f n' y) 0 then S n' else rec n' y end) as rec. exists rec. split. apply PR2_Recu with (f:=fun _=>0) (g:=fun s i y=>if nat_eq_dec (f i y) 0 then S i else s); auto. apply PR3_ite; auto. apply PRP3_intro with (fun _ y z=>f y z); auto. apply PR3_Comp2 with f (fun _ y _=>y) (fun _ _ z=>z); auto. apply PR3_Comp1 with S (fun _ y _=>y); auto. intros; simpl; subst rec; auto. intros. induction n as [ |n [H2 [H3 H4]]]. repeat split; intros. subst rec; simpl; auto. inversion H3. subst rec; simpl in H2; inversion H2. inversion H3.
  split. rewrite Heqrec. destruct (nat_eq_dec (f n y) 0); auto. rewrite <- Heqrec; auto. split; intros. rewrite Heqrec in H5. destruct (nat_eq_dec (f n y) 0). inversion H5. rewrite <- Heqrec in H5. apply le_S_n in H6. apply le_lt_or_eq in H6. destruct H6; auto. subst i; auto. rewrite Heqrec in H5. destruct (nat_eq_dec (f n y) 0); [|rewrite <- Heqrec in H5]. inversion H5. subst m. split; auto. destruct (H4 m H5). split; auto. intros. apply le_S_n in H8. apply le_lt_or_eq in H8. destruct H8; auto. subst i. contradict H9; auto. Qed.
Theorem PR3_maxP: forall P, PRP3 P -> exists f, PR3 f /\ forall n y z, f n y z<=n /\ (f n y z = 0 -> (forall i, i<n->~P i y z)) /\ forall m, f n y z = S m -> (P m y z /\ forall i, i<n->P i y z->i<=m). Proof. intros. destruct H. remember (fix rec n y z:=match n with |O=>O|S n'=>if nat_eq_dec (f n' y z) 0 then S n' else rec n' y z end) as rec. exists rec. split. apply PR3_Recu with (f:=fun _ _=>0) (g:=fun s i y z=>if nat_eq_dec (f i y z) 0 then S i else s); auto. apply PR4_ite; auto. apply PRP4_intro with (fun _ y z w=>f y z w); auto. apply PR4_Comp3 with f (fun _ y _ _=>y) (fun _ _ z _=>z) (fun _ _ _ w=>w); auto. apply PR4_Comp1 with S (fun _ y _ _=>y); auto. intros; simpl; subst rec; auto. intros. induction n as [ |n [H2 [H3 H4]]]. repeat split; intros. subst rec; simpl; auto. inversion H3. subst rec; simpl in H2; inversion H2. inversion H3.
  split. rewrite Heqrec. destruct (nat_eq_dec (f n y z) 0); auto. rewrite <- Heqrec; auto. split; intros. rewrite Heqrec in H5. destruct (nat_eq_dec (f n y z) 0). inversion H5. rewrite <- Heqrec in H5. apply le_S_n in H6. apply le_lt_or_eq in H6. destruct H6; auto. subst i; auto. rewrite Heqrec in H5. destruct (nat_eq_dec (f n y z) 0); [|rewrite <- Heqrec in H5]. inversion H5. subst m. split; auto. destruct (H4 m H5). split; auto. intros. apply le_S_n in H8. apply le_lt_or_eq in H8. destruct H8; auto. subst i. contradict H9; auto. Qed.
Hint Resolve PR1_maxP PR2_maxP PR3_maxP.

Theorem PR2_gcd: exists f, PR2 f /\ f 0 0=0 /\ forall n m g, GCD g n m -> f n m=g. Proof. destruct PR3_maxP with (P:=fun x n m=>Divide x n/\Divide x m) as [f [H H0]]. apply PRP3_Land. apply PRP3_Comp2; auto. apply PRP3_Comp2; auto. exists (fun n m=>if nat_eq_dec n 0 then m else pred (f (S n) n m)). repeat split. apply PR2_ite; auto. apply PR2_Comp1 with pred (fun x y=>f (S x) x y); auto. apply PR2_Comp3 with f (fun x _=>S x) (fun x _=>x) (fun _ y=>y); auto. apply PR2_Comp1 with S (fun x _=>x); auto. intros. destruct (nat_eq_dec n 0). subst n. apply GCD_unique with 0 m; auto. apply GCD_0n. contradict H1; subst m; auto. destruct (H0 (S n) n m) as [H2 [H3 H4]]. remember (f (S n) n m) as x. destruct x. absurd (Divide 1 n/\Divide 1 m); auto. simpl. apply GCD_unique with n m; auto. apply MaxP_intro. destruct (H4 x); auto. destruct (H4 x); auto. intros i Hi. apply H6; auto. destruct Hi. apply Divide_le_or_0 in H7. destruct H7; auto; contradiction. Qed.
Theorem PRP2_Coprime: PRP2 Coprime. Proof. destruct PR2_gcd as [f [H [H1 H2]]]. apply PRP2_equiv with (fun n m=>f n m=1). apply PRP2_Comp2; auto. intros; split; intros. destruct (gcd_sig x y) as [[g H3]|H3]. replace g with 1 in H3; auto. rewrite <- H0; auto. destruct H3. subst x y. absurd (0=1); auto. rewrite <- H0. auto. auto. Qed.
Theorem PR1_PrimeDiv: exists f, PR1 f /\ (forall n, 2<=n -> Prime (f n) /\ Divide (f n) n /\ forall m, Prime m -> Divide m n -> f n<=m) /\ forall n, n<2 -> f n=n. Proof. destruct PR2_minP with (P:=fun i n=>Prime i /\ Divide i n) as [f [H H0]]; auto. exists (fun n=>if le_dec 2 n then pred (f (S n) n) else n). split. apply PR1_ite; auto. apply PR1_Comp1 with pred (fun x=>f (S x) x); auto. apply PR1_Comp2 with f S id; auto. split; intros. destruct (primeDivide n) as [[p H2 H3]|H2]. destruct (le_dec 2 n); [|contradict H1]; auto. destruct (H0 (S n) n) as [H4 [H5 H6]]. remember (f (S n) n) as m. destruct m. absurd (Prime p/\Divide p n); auto. apply H5; auto. apply le_n_S. apply Divide_le; auto. contradict H1; subst n; auto. destruct (H6 m) as [[H7 H8] H9]; auto. simpl. split; auto. split; auto. intros. apply H9; auto. apply le_n_S. apply Divide_le; auto. contradict H1; subst n; auto. contradict H2; auto. destruct (le_dec 2 n); auto. contradict H1; auto. Qed.
Theorem PR2_log: exists f, PR2 f /\ forall e x, f e x = log e x. Proof. destruct PR3_maxP with (P:=fun n e x=>Divide (pow e n) x) as [f [H H0]]. apply PRP3_Comp2; auto. apply PR3_Comp2 with pow (fun x y _=>y) (fun x _ _=>x); auto. exists (fun e x=>pred (f (S x) e x)). split. apply PR2_Comp1 with pred (fun e x=>f (S x) e x); auto. apply PR2_Comp3 with f (fun _ x=>S x) (fun e _=>e) (fun _ x=>x); auto. apply PR2_Comp1 with S (fun _ x=>x); auto. intros. destruct (H0 (S x) e x) as [H1 [H2 H3]]. clear H0. unfold log. destruct (log_sig e x) as [[n H0]|[H0|H0]]. inversion H0. subst n0. assert (n<S x). apply le_n_S. destruct (nat_eq_dec x 0) as [Hx|Hx]. subst x. absurd (S n<=n); auto. apply le_trans with (pow e n). destruct (le_lt_dec e 1) as [He|He]. inversion He. subst e. absurd (S n<=n); auto. apply H5. rewrite pow_1n; auto. inversion H7. subst m e. destruct n; auto. clear -He. induction n; auto. simpl. destruct n. rewrite mult_1_r; auto. apply le_trans with (e*S n). rewrite mult_comm. simpl.
  replace (S (S n)) with (2+n); auto. apply le_trans with (e+n). apply plus_le_compat_r; auto. apply plus_le_compat_l. destruct e. inversion He. rewrite mult_comm; simpl; auto. apply mult_le_compat_l; auto. apply Divide_le_or_0 in H4. destruct H4; auto; contradiction. remember (f (S x) e x) as m. destruct m. contradict H4. apply H2; auto. simpl. destruct (H3 m); auto. apply le_antisym; auto. destruct e. remember (f (S x) 0 x) as m. destruct m. absurd (Divide (pow 0 0) x); auto. destruct (H3 m); auto. simpl. destruct m; auto. simpl in H4. replace x with 0 in H1. contradict H1; auto. destruct (Divide_multN H4). subst x; auto. assert (e=0). destruct e; auto. contradict H0; auto. subst e. remember (f (S x) 1 x) as m. destruct m. absurd (Divide (pow 1 0) x); auto. destruct (H3 m); auto. simpl. apply le_antisym; auto. apply H5; auto. rewrite pow_1n; auto. subst x. remember (f 1 e 0) as m. inversion H1. simpl. destruct e; auto. inversion H4. simpl. destruct e; auto. Defined.

Hint Resolve PR2_gcd PRP2_Coprime PR1_PrimeDiv PR2_log.


Require Import Coq.Logic.Classical.
Require Import Coq.Logic.ClassicalFacts.

Require Import Notation.
Require Import GeneralTactics.
Require Import UipFacts.

Require Export Coq.Logic.Classical.

Tactic Notation "destruct" "classic" uconstr(c) "as" ident(H) :=
  destruct (classic c) as [H|H].

Tactic Notation "destruct" "classic" uconstr(c) :=
  let x := fresh in
  destruct classic c as x.

Tactic Notation "contradict" "goal" ident(H) :=
  apply NNPP; intro H.

Tactic Notation "contradict" "goal" :=
  let contra := fresh "contra" in
  apply NNPP; intro contra.

(* Consequences of classical LEM *)

(* Proof irrelevance *)

Lemma proof_irrelevance : forall (P: Prop) (p1 p2: P),
  p1 = p2.
Proof using.
  intros *.
  apply proof_irrelevance_cci.
  exact classic.
Qed.

Lemma exist_eq : forall A (P: A -> Prop) x y p q,
  x = y ->
  exist P x p = exist P y q.
Proof using.
  intros * ->.
  now rewrite (proof_irrelevance _ p q).
Qed.

Lemma exist_eq' : forall A (P: A -> Prop) (x y: {a | P a}),
  proj1_sig x = proj1_sig y ->
  x = y.
Proof using.
  intros *.
  destruct x, y.
  apply exist_eq.
Qed.

Lemma exist_neq : forall A (P: A -> Prop) x y p q,
  exist P x p <> exist P y q ->
  x <> y.
Proof using.
  intros * Hneq ?.
  apply Hneq.
  now apply exist_eq.
Qed.

Lemma exist_neq' : forall A (P: A -> Prop) (x y: {a | P a}),
  x <> y ->
  proj1_sig x <> proj1_sig y.
Proof using.
  intros *.
  destruct x, y.
  apply exist_neq.
Qed.

Lemma exists_prop_unique : forall (A: Prop) (P: A -> Prop),
  (exists a, P a) <-> exists! a, P a.
Proof using.
  tedious using proof_irrelevance.
Qed.

Lemma exists_prop_forall : forall (A: Prop) (P: A -> Prop),
  (exists a, P a) -> forall a, P a.
Proof using.
  intros * [a ?].
  intro a'.
  follows replace a' with a by apply proof_irrelevance.
Qed.

(* UIP *)

Module ClassicalUipImpl.
Lemma uip_refl : forall A (x: A) (h: x = x), h = eq_refl x.
Proof using.
  exact (proof_irrelevance__uip_refl proof_irrelevance).
Qed.
End ClassicalUipImpl.

Module UipTheory := UipTheory(ClassicalUipImpl).
Export UipTheory.

#[global]
Hint Resolve inj_pair2 inj_pairT2: eqdep.

Lemma JMproof_irrelevance : forall (P Q: Prop) (p: P) (q: Q),
  P = Q ->
  p ~=~ q.
Proof using.
  intros * <-.
  apply eq_JMeq.
  apply proof_irrelevance.
Qed.


Require Import Peano_dec.

Definition fact_F :
  forall (n:nat),
  (forall m, m<n -> nat) ->
  nat.
refine
  (fun n fact_rec =>
     if eq_nat_dec n 0 then
        1
     else
        let fn := fact_rec (n-1) _ in
        n * fn).
Admitted.


Require expr.
Require Import List Datatypes.
Require Import Arith.Peano_dec.
Require Import db util.

(* Compiles standard expressions to terms with deBruijn indices *)
Fixpoint db (t : expr.tm) (env : Map nat nat) : option tm := match t with
  | expr.var v => match lookup eq_nat_dec v env with
    | Some v' => Some (var v')
    | None => None
    end
  | expr.abs v b => match db b ((v, 0):: map (fmap S) env) with
    | Some b' => Some (lam b')
    | None => None
    end
  | expr.app m n => match db m env with
    | Some m' => match db n env with
      | Some n' => Some (app m' n')
      | None => None
      end
    | None => None
    end
  end.

(* We say two expressions are alpha equivalent if they compile to the same
deBruijn term *)
Definition alpha_equiv (t1 t2 : expr.tm) : Prop := db t1 = db t2.


(** * 6.512 Formal Reasoning About Programs, Spring 2023 - Pset 1 *)

(* Welcome to the wonderful world of Coq programming! *)

(* This pset dives straight in to building a program-analysis pass and
 * proving it sound in Coq. But before that, you will need to get set up
 * with Coq. *)

(*
 * Start by installing the Coq system by following the isntructions on the Coq
 * website at <https://coq.inria.fr/download>. For this class, you must use
 * version 8.16 (the latest).
 *
 * You may also install it from your operating system/package manager's
 * repositories (`pacman -S coq`, `brew install coq`, etc.), but note that
 * Ubuntu's `apt` package manager does not have the most recent version,
 * so Ubuntu users should use the `snap` package by running the command
 * `snap install coq-prover` as per the instructions on the download page.
 *
 * Run `coqc -v` to check that the right version was installed.
 *
 * It will also be *essential* to install a UI for editing Coq proofs!  The most
 * popular Coq IDE in the research world, which the course staff use and
 * recommend, is the venerable Proof General <https://proofgeneral.github.io/>,
 * a package for the Emacs IDE, which can optionally be extended with
 * company-coq <https://github.com/cpitclaudel/company-coq/>.
 *
 * If you're not ready to take the Emacs plunge (but it's worth it! We
 * promise!), then install one of the alternatives listed on the Coq website at
 * <https://coq.inria.fr/user-interfaces.html>.  The one called “CoqIDE” has
 * the least steep learning curve, but Proof General will make you significantly
 * more productive after spending some practice time.
 *
 * We will have special office hours the first week of class,
 * to help everyone get these packages set up.
 *
 * Now, on to the actual assignment, once you have Coq and a UI installed!  This
 * course uses a special Coq library, so we'll start by compiling that:
 *
 * Run `make -C frap lib` in the root directory of your 6.512 git clone.
 *)

Require Coq816.
(* If this import command doesn't work, you have installed an outdated version of
 * Coq. Make sure to follow the instructions at <https://coq.inria.fr/download>
 * and consult the TA if you need help.
 *)

Require Import Frap.
(* If this import command doesn't work, something may be wrong with the copy
 * of the FRAP book source that has been included as a Git submodule.
 * Running `git submodule init' or `git submodule update' in the repository
 * base directory (followed by rerunning `make -C frap lib` here) might help.
 *)

(* Throughout this assignment, if you find yourself running into trouble using
 * Coq or structuring proofs, we recommend reading the tips section found near the
 * end of this file. It's a brief collection of useful tips and tricks that you
 * might find useful--even beyond this pset!
 *
 * If you find yourself stuck specifically on solving a pset problem in terms
 * of defining a construct or formulating/proving a predicate, we've provided
 * a set of hints beneath the tips section at the end of this file. We recommend
 * trying to solve these problems on your own before consulting these hints!
 *)

(* The first part of this assignment involves the [bool] datatype,
 * which has the following definition.
 * <<
     Inductive bool :=
     | true
     | false.
   >>
 * We will define logical negation and conjunction of Boolean values,
 * and we will prove some properties of these definitions.

 * In the second part of this assignment, we will work with a simple language
 * of imperative arithmetic programs that sequentially apply operations
 * to a natural-number-valued state.

 * The file that you are currently reading contains only the *signature* of the
 * programs that we will implement: the module type `S` below defines the
 * interface of the code.

 * Your job is to write a module implementing this interface by fleshing out the
 * skeleton given in the file `Pset1Implementation.v`.  For the last problem, we
 * also ask you to give an informal explanation of the proof in addition to the
 * Coq proof script.
 *
 * Your `Pset1Implementation.v` file is what you upload to the course web site
 * to get credit for doing the assignment.  A line at the end of
 * `Pset1Implementation.v` (`Module Impl := …`) checks that your code conforms
 * to the expected signature.  Make sure that the file that you submit can be
 * compiled and checked: use `Admitted` if you're not sure how to complete a
 * proof.
 *
 * Percentages in square brackets below show the approximate rubric that we will
 * apply.
 *)

(*
 * First, here's the [Prog] datatype that defines abstract syntax trees for this
 * pset's language.
 *)

Inductive Prog :=
  | Done                             (* Don't modify the state. *)
  | AddThen (n : nat) (p : Prog)     (* Add [n] to the state, then run [p]. *)
  | MulThen (n : nat) (p : Prog)     (* Multiply the state by [n], then run [p]. *)
  | DivThen (n : nat) (p : Prog)     (* Divide the state by [n], then run [p]. *)
  | VidThen (n : nat) (p : Prog)     (* Divide [n] by the state, then run [p]. *)
  | SetToThen (n : nat) (p : Prog)   (* Set the state to [n], then run [p]. *)
  .

(* Then, here's the actual signature to implement. *)

Module Type S.

  (* Define [Neg] so that it implements Boolean negation, which flips
   * the truth value of a Boolean value.
   *)
  (*[2%]*) Parameter Neg : bool -> bool.

  (* For instance, the negation of [true] should be [false].
   * This proof should follow from reducing both sides of the equation
   * and observing that they are identical.
   *)
  (*[1%]*) Axiom Neg_true : Neg true = false.

  (* Negation should be involutive, meaning that if we negate
   * any Boolean value twice, we should get the original value back.

   * To prove a fact like this that holds for all Booleans, it suffices
   * to prove the fact for both [true] and [false] by using the
   * [cases] tactic.
   *)
  (*[4%]*) Axiom Neg_involutive : forall b : bool, Neg (Neg b) = b.

  (* Define [And] so that it implements Boolean conjunction. That is,
   * the result value should be [true] exactly when both inputs
   * are [true].
   *)
  (*[3%]*) Parameter And : bool -> bool -> bool.

  (* Here are a couple of examples of how [And] should act on
   * concrete inputs.
   *)
  (*[1%]*) Axiom And_true_true : And true true = true.
  (*[1%]*) Axiom And_false_true : And false true = false.

  (* Prove that [And] is commutative, meaning that switching the order
   * of its arguments doesn't affect the result.
   *)
  (*[4%]*) Axiom And_comm : forall x y : bool, And x y = And y x.

  (* Prove that the conjunction of a Boolean value with [true]
   * doesn't change that value.
   *)
  (*[4%]*) Axiom And_true_r : forall x : bool, And x true = x.

  (* Define [run] such that [run p n] gives the final state
   * that running the program [p] should result in, when the
   * initial state is [n].
   * Use the +, *, and / operators for natural numbers provided
   * by the Coq standard library, and for this part of the
   * exercise, don't worry about division by 0; doing the same
   * thing as division from the standard library does is fine.
   *)
  (*[3%]*) Parameter run : Prog -> nat -> nat.

  (*[1%]*) Axiom run_Example1 : run Done 0 = 0.
  (*[1%]*) Axiom run_Example2 : run (MulThen 5 (AddThen 2 Done)) 1 = 7.
  (*[1%]*) Axiom run_Example3 : run (SetToThen 3 (MulThen 2 Done)) 10 = 6.

  (* Define [numInstructions] to compute the number of instructions
   * in a program, not counting [Done] as an instruction.
   *)
  (*[3%]*) Parameter numInstructions : Prog -> nat.

  (*[1%]*) Axiom numInstructions_Example :
    numInstructions (MulThen 5 (AddThen 2 Done)) = 2.

  (* Define [concatProg] such that [concatProg p1 p2] is the program
   * that first runs [p1] and then runs [p2].
   *)
  (*[3%]*) Parameter concatProg : Prog -> Prog -> Prog.

  (*[1%]*) Axiom concatProg_Example :
     concatProg (AddThen 1 Done) (MulThen 2 Done)
   = AddThen 1 (MulThen 2 Done).

  (* Prove that the number of instructions in the concatenation of
   * two programs is the sum of the number of instructions in each
   * program.
   *)
  (*[8%]*) Axiom concatProg_numInstructions : forall p1 p2,
      numInstructions (concatProg p1 p2)
      = numInstructions p1 + numInstructions p2.

  (* Prove that running the concatenation of [p1] with [p2] is
     equivalent to running [p1] and then running [p2] on the
     result. *)
  (*[8%]*) Axiom concatProg_run : forall p1 p2 initState,
      run (concatProg p1 p2) initState =
      run p2 (run p1 initState).

  (* As there is no intuitive or broadly useful definition for x/0,
     common processors handle it differently. We would like to model the
     portable behavior of a program, that is, its behavior to the extent
     it is known without relying on arbitrary choices about division by
     zero. The following interpreter returns (b, s), where the Boolean [b]
     indicates whether the execution completed without division by
     zero, and if it did, then [s] is the final state. First, you will be
     asked to prove that [s] matches [run] in those cases. *)
  Fixpoint runPortable (p : Prog) (state : nat) : bool * nat :=
    match p with
    | Done => (true, state)
    | AddThen n p => runPortable p (n+state)
    | MulThen n p => runPortable p (n*state)
    | DivThen n p =>
        if n ==n 0 then (false, state) else
        runPortable p (state/n)
    | VidThen n p =>
        if state ==n 0 then (false, 0) else
        runPortable p (n/state)
    | SetToThen n p =>
        runPortable p n
    end.

  (*[8%]*) Axiom runPortable_run : forall p s0 s1,
    runPortable p s0 = (true, s1) -> run p s0 = s1.

  (* Static analysis to validate that a program never divides by 0 *)

  (* The final goal of this pset is to implement [validate : Prog -> bool]
   * Note that this problem is harder than the previous ones and will take
   * more time!
   *)
  (*[5%]*) Parameter validate : Prog -> bool.
  (* such that if this function returns [true], the program would not trigger
     division by zero regardless of what state it starts out in.  [validate] is
     allowed to return [false] for some perfectly good programs that never cause
     a division by zero, but it must recognize as good the examples given below.
     In jargon, [validate] is required to be sound but not complete, but
     "complete enough" for the use cases defined by the examples given here.
     We also ask you to define one additional negative test and prove that
     [validate] correctly flags it. *)

  Definition goodProgram1 := AddThen 1 (VidThen 10 Done).
  Definition goodProgram2 := AddThen 0 (MulThen 10 (AddThen 0 (DivThen 1 Done))).
  Definition goodProgram3 := AddThen 1 (MulThen 10 (AddThen 0 (VidThen 1 Done))).
  Definition goodProgram4 := Done.
  Definition goodProgram5 := SetToThen 0 (DivThen 1 Done).
  Definition goodProgram6 := SetToThen 1 (VidThen 1 Done).
  Definition goodProgram7 := AddThen 1 (DivThen 1 (DivThen 1 (VidThen 1 Done))).
  (*[0.5%]*) Axiom validate1 : validate goodProgram1 = true.
  (*[0.5%]*) Axiom validate2 : validate goodProgram2 = true.
  (*[0.5%]*) Axiom validate3 : validate goodProgram3 = true.
  (*[0.5%]*) Axiom validate4 : validate goodProgram4 = true.
  (*[0.5%]*) Axiom validate5 : validate goodProgram5 = true.
  (*[0.5%]*) Axiom validate6 : validate goodProgram6 = true.
  (*[0.5%]*) Axiom validate7 : validate goodProgram7 = true.

  Definition badProgram1 := AddThen 0 (VidThen 10 Done).
  Definition badProgram2 := AddThen 1 (DivThen 0 Done).
  (*[0.5%]*) Axiom validateb1 : validate badProgram1 = false.
  (*[0.5%]*) Axiom validateb2 : validate badProgram2 = false.

  (*[1.5%]*) Parameter badProgram3 : Prog.
  (*[1%]*) Axiom validateb3 : validate badProgram3 = false.

  (*[10%]*) (* Informal proof sketch for `validate_sound`. *)
  (* Before diving into the Coq proof, try to convince yourself that your code
   * is correct by applying induction by hand.  Can you describe the high-level
   * structure of the proof?  Which cases will you have to reason about?  What
   * do the induction hypotheses look like?  Which key lemmas do you need?
   * Write a short (~10-20 lines) informal proof sketch before proceeding. *)

  (*[20%]*) Axiom validate_sound : forall p, validate p = true ->
    forall s, runPortable p s = (true, run p s).
End S.

(*|
TIPS: A few things to keep in mind as you work through pset 1
=============================================================
|*)

Require Import Frap.

(*|
Coq resources
-------------

- Start by looking for examples in the course textbook, including the tactic appendix at the end of the book.

- For help on standard Coq tactics, consult Coq's reference manual (https://coq.inria.fr/distrib/current/refman/), starting from the indices at https://coq.inria.fr/distrib/current/refman/appendix/indexes/index.html.  The manual can be overwhelming, so it's best used for looking up fine details.

Useful commands
---------------

Coq comes with many predefined types, functions, and theorems (“objects”).  The most important commands to help you discover them are `Check`, `About`, `Print`, `Search`, and `Compute`.  Try the following examples:

`Check` gives the type of any term, even with holes:
|*)

Check (1 + _).
Check (fun b => match b with true => 0 | false => 1 end).

(*|
`About` gives general information about an object:
|*)

About bool.
About nat.

(*|
`Print` displays the definition of an object:
|*)

Print bool.
Print Nat.add.

(*|
`Search` finds objects.  Its syntax is very flexible:
|*)

(* Find functions of type [nat -> nat -> bool]. *)
Search (nat -> nat -> bool).
(* Find theorems about "+". *)
Search "+".
(* Find theorems whose statement mentions S and eq. *)
Search eq S.
(* Search for a lemma proving the symmetry of eq. *)
Search (?x = ?y -> ?y = ?x).

(*|
If you are puzzled by a notation, the `Locate` command can help:
|*)

Locate "*".

(*|
To evaluate an expression, use `Compute`:
|*)

Compute (2 * 3, 4 + 4, 0 - 2 + 2, pred (S (S (S 0)))).

(*|
Syntax recap
------------

To define a function inline, use `fun`:
|*)

Check (fun x => x + 1).
Check (fun x: bool => xorb x x).

(*|
To perform a case analysis on a value, use `match`:
|*)

Check (fun b (x y: nat) =>
         match b with
         | true => x
         | false => y
         end).

Check (fun (n: nat) =>
         match n with
         | 0 => 1
         | S n => n
         end).

(*|
In Coq, `if` is just short for `match`:
|*)

Check (fun (b: bool) (x y: nat) =>
         if b then x else y).

(*|
To define a global object, use `Definition` or `Lemma` (`Theorem` is an alias of `Lemma`):
|*)

Definition choose (b: bool) (x y: nat) :=
  if b then x else y.

Compute (choose true 6 512).

Lemma plus_commutes :
  forall x, x = x + 0 + 0.
Proof.
  intros.
  Search (_ + 0).
  rewrite <- plus_n_O.
  rewrite <- plus_n_O.
  equality.
Qed.

(*|
Recursive functions use the keyword `Fixpoint`:
|*)

Fixpoint do_n_times (ntimes: nat) (step: nat -> nat) (start_from: nat) :=
  match ntimes with
  | 0 => start_from
  | S ntimes' => step (do_n_times ntimes' step start_from)
  end.

Compute (6, do_n_times 12 (fun x => x + 65) 42).

(*|
You can use bullets or braces to structure your proofs:
|*)

Lemma both_zero:
  forall x y z: nat, x + y + z = 0 -> x = 0 /\ y = 0 /\ z = 0.
Proof.
  intros x.
  cases x.
  - intros.
    cases y.
    + propositional.
    + simplify.
      invert H.
  - intros y z Heq.
    simplify.
    invert Heq.
Qed.

(*|
A few gotchas
-------------

Natural numbers saturate at 0:
|*)

Compute (3 - 5 + 3).

(*|
The order in which you perform induction on variables matters: if `x` comes before `y` and you induct on `y`, your induction hypothesis will not be general enough.
|*)

Lemma add_comm:
  forall x y: nat, x + y = y + x.
Proof.
  induct y.
  - induct x; simplify; equality.
  - simplify.
    (* `IHy` is valid only for one specific `y` *)
Abort.

Lemma add_comm:
  forall x y: nat, x + y = y + x.
Proof.
  induct x.
  - induct y; simplify; equality.
  - simplify.
    (* `IHx` starts with `forall y`. *)
Abort.

(*|
Here's an example where this subtlety matters:
|*)

Fixpoint factorial (n: nat) :=
  match n with
  | O => 1
  | S n' => n * factorial n'
  end.

Fixpoint factorial_acc (n: nat) (acc: nat) :=
  match n with
  | O => acc
  | S n' => factorial_acc n' (n * acc)
  end.

(*|
First attempt, but our lemma is too weak.
|*)

Lemma factorial_acc_correct:
  forall n, factorial n = factorial_acc n 1.
Proof.
  induct n.
  - equality.
  - simplify.
    Search (_ * 1).
    rewrite Nat.mul_1_r.

(*|
Stuck!  We have no way to simplify `factorial_acc n (S n)`.
|*)

Abort.

(*|
Second attempt: a generalized lemma, but we put the `acc` first, so induction will not generalize it.
|*)

Lemma factorial_acc_correct:
  forall acc n, factorial n * acc = factorial_acc n acc.
Proof.
  induct n.
  - simplify.
    Search (_ + 0).
    rewrite Nat.add_0_r.
    equality.
  - simplify.
    Fail rewrite <- IHn.

(*|
Stuck!  IHn is too weak.
|*)

Abort.

(*|
Third time's the charm!  Note how we ordered `n` and `acc`.
|*)

Lemma factorial_acc_correct:
  forall n acc, factorial n * acc = factorial_acc n acc.
Proof.
  induct n.
  - simplify.
    linear_arithmetic.
  - simplify.

(*|
IHn is strong enough now!
|*)

    rewrite <- IHn.
    linear_arithmetic.
Qed.

(*|
HINTS: A few hints to help you if you get stuck on certain
       problems in pset 1.
       Beware! Don't read further if you don't want spoilers!
=============================================================
|*)

(* HINT 1: *)
(*   Definition validate p := validate' p false. *)
(*   Fixpoint validate' (p : Prog) (nz : bool) : bool. Admitted. *)
        (* if [nz=true], [validate'] can assume that the [state] on which
           [p] will be run is nonzero. When calling [validate']
           recursively, take care to pass in [nz] that corresponds to the
           state after the current operation. *)

(* HINT 2: some lemmas about arithmetic on natural numbers
   are necessary to prove the soundness of this validator.
   Some of them can be proven inline using [linear_arithmetic].
   The rest that we needed we found from the standard library by using
   [Search]. *)

(* HINT 3: to prove soundness of [validate'] from hint 1,
    it makes sense to do induction on the input program.
    The key to choosing the predicate [P] is to relate the
    [nz] indicator to the state of a program during a hypothetical
    execution of the program. *)

(* HINT 4: to prove soundness of [validate'] by induction on the
    program, one workable [P] looks like
      Definition P (p : Prog) :=
        forall nz : bool, validate' p nz = true ->
          forall s : nat, (*PRECONDITION ABOUT nz and s HERE*) ->
            runPortable p s = (true, run p s).
    This [P] is inferred by [induct p] from the goal
      forall p nz, validate' p nz = true ->
        forall s, (*PRECONDITION ABOUT nz and s HERE*) ->
          runPortable p s = (true, run p)]. *)

(* HINT 5: to prove soundness of [validate'] by induction on the
    program and develop a workable [P], consider the two cases in
    executing [validate'] separately. Split the soundness of [validate']
    into the case where the indicator passed into [validate'] is true
    and in the case where it is false.
 *)

(* HINT 6: to prove soundness of [validate'] by induction on the
    program, one workable [P] is
    forall p,
       (validate' p true = true ->
        forall s, s <> 0 -> runPortable p s = (true, run p s)) /\
       (validate' p false = true ->
        forall s, runPortable p s = (true, run p s)). *)

(* Authors:
 * Peng Wang
 * Adam Chlipala
 * Joonwon Choi
 * Benjamin Sherman
 * Andres Erbsen
 * Clément Pit-Claudel
 * Amanda Liu
 * Dustin Jamner
 *)


Require Import init.

Require Export category_base.
Require Import category_natural_transformation.

Definition cat_equivalence `{C1 : Category, C2 : Category}
    `(F : @Functor C1 C2, G : @Functor C2 C1)
    `(η : @NatTransformation C1 C1 𝟏 (G ○ F))
    `(ε : @NatTransformation C2 C2 (F ○ G) 𝟏)
    := nat_isomorphism η ∧ nat_isomorphism ε.

Definition cat_equivalent `(C1 : Category, C2 : Category)
    := ∃ (F : @Functor C1 C2) (G : @Functor C2 C1) η ε,
        cat_equivalence F G η ε.

Notation "A ⋍ B" := (cat_equivalent A B) (at level 70, no associativity).

Theorem cat_equiv_refl : ∀ `(C0 : Category), C0 ⋍ C0.
Proof.
    intros C0.
    exists 𝟏, 𝟏.
    unfold cat_equivalence.
    rewrite functor_lid.
    exists 𝕀, 𝕀.
    assert (nat_isomorphism (F:=𝟏) (G:=𝟏) 𝕀) as H.
    {
        exists 𝕀.
        cbn.
        rewrite nat_trans_lid.
        split; reflexivity.
    }
    split; exact H.
Qed.

Theorem cat_equiv_trans : ∀ (C1 C2 C3 : Category), C1 ⋍ C2 → C2 ⋍ C3 → C1 ⋍ C3.
Proof.
    intros C1 C2 C3 C12 C23.
    destruct C12 as [F1 [G1 [η1 [ε1 [η1_iso ε1_iso]]]]].
    destruct C23 as [F2 [G2 [η2 [ε2 [η2_iso ε2_iso]]]]].
    exists (F2 ○ F1), (G1 ○ G2).
    assert (nat_isomorphic 𝟏 (G1 ○ F1)) as iso1 by (exists η1; exact η1_iso).
    assert (nat_isomorphic (F1 ○ G1) 𝟏) as iso2 by (exists ε1; exact ε1_iso).
    assert (nat_isomorphic 𝟏 (G2 ○ F2)) as iso3 by (exists η2; exact η2_iso).
    assert (nat_isomorphic (F2 ○ G2) 𝟏) as iso4 by (exists ε2; exact ε2_iso).
    assert (nat_isomorphic 𝟏 (G1 ○ G2 ○ (F2 ○ F1))) as [η η_iso].
    {
        unfold nat_isomorphic in *.
        apply (isomorphic_trans iso1).
        rewrite <- (functor_lid F1) at 1.
        rewrite <- functor_assoc.
        apply lnat_iso.
        rewrite functor_assoc.
        apply rnat_iso.
        exact iso3.
    }
    assert (nat_isomorphic (F2 ○ F1 ○ (G1 ○ G2)) 𝟏) as [ε ε_iso].
    {
        unfold nat_isomorphic in *.
        apply (isomorphic_trans2 iso4).
        rewrite <- (functor_lid G2) at 2.
        rewrite <- functor_assoc.
        apply lnat_iso.
        rewrite functor_assoc.
        apply rnat_iso.
        exact iso2.
    }
    exists η, ε.
    split; assumption.
Qed.

(* begin hide *)
Section FunctorEquivalence1.

(* end hide *)
Context `{C1 : Category, C2 : Category}.
Context `(F : @Functor C1 C2, G : @Functor C2 C1).
Context `(η : @NatTransformation C1 C1 𝟏 (G ○ F)).
Context `(ε : @NatTransformation C2 C2 (F ○ G) 𝟏).
Hypothesis equiv : cat_equivalence F G η ε.

Theorem cat_equiv_sym_base : ∃ η' ε', cat_equivalence G F η' ε'.
Proof.
    destruct equiv as [η_iso ε_iso].
    rewrite nat_isomorphism_A in η_iso.
    rewrite nat_isomorphism_A in ε_iso.
    pose (η'_f A := ex_val (ε_iso A)).
    assert (∀ {A B} f, η'_f B ∘ (⌈𝟏⌉ f) = (⌈F ○ G⌉ f) ∘ η'_f A) as η'_commute.
    {
        intros A B f.
        unfold η'_f.
        rewrite_ex_val B' [B'_eq1 B'_eq2].
        rewrite_ex_val A' [A'_eq1 A'_eq2].
        cbn.
        pose proof (nat_trans_commute ε f) as eq.
        cbn in *.
        apply lcompose with B' in eq.
        rewrite cat_assoc in eq.
        rewrite B'_eq2 in eq.
        rewrite cat_lid in eq.
        rewrite eq.
        do 2 rewrite <- cat_assoc.
        rewrite A'_eq1.
        rewrite cat_rid.
        reflexivity.
    }
    pose (η' := {|nat_trans_f := η'_f; nat_trans_commute := η'_commute|}).
    pose (ε'_f A := ex_val (η_iso A)).
    assert (∀ {A B} f, ε'_f B ∘ (⌈G ○ F⌉ f) = (⌈𝟏⌉ f) ∘ ε'_f A) as ε'_commute.
    {
        intros A B f.
        unfold ε'_f.
        rewrite_ex_val B' [B'_eq1 B'_eq2].
        rewrite_ex_val A' [A'_eq1 A'_eq2].
        cbn.
        pose proof (nat_trans_commute η f) as eq.
        cbn in *.
        apply rcompose with A' in eq.
        rewrite <- (cat_assoc _ (η A) A') in eq.
        cbn in *.
        rewrite A'_eq1 in eq.
        rewrite cat_rid in eq.
        rewrite <- eq.
        do 2 rewrite cat_assoc.
        rewrite B'_eq2.
        rewrite cat_lid.
        reflexivity.
    }
    pose (ε' := {|nat_trans_f := ε'_f; nat_trans_commute := ε'_commute|}).
    cbn in *.
    exists η', ε'.
    split; rewrite nat_isomorphism_A.
    -   intros A.
        cbn.
        unfold η'_f.
        unfold ex_val.
        destruct (ex_to_type _) as [B [B_eq1 B_eq2]]; cbn.
        exists (ε A).
        split; assumption.
    -   intros A.
        cbn.
        unfold ε'_f.
        unfold ex_val.
        destruct (ex_to_type _) as [B [B_eq1 B_eq2]]; cbn.
        exists (η A).
        split; assumption.
Qed.

Theorem functor_equiv_faithful1 : faithful_functor F.
Proof.
    intros A B.
    split.
    intros f g eq.
    apply (f_equal (functor_morphism G)) in eq.
    pose proof (nat_trans_commute η f) as eq2.
    pose proof (nat_trans_commute η g) as eq3.
    cbn in *.
    rewrite eq in eq2; clear eq.
    rewrite <- eq3 in eq2; clear eq3.
    destruct equiv as [η_iso ε_iso].
    rewrite nat_isomorphism_A in η_iso.
    rewrite nat_isomorphism_A in ε_iso.
    pose proof (η_iso B) as [h [h_eq1 h_eq2]].
    cbn in *.
    apply lcompose with h in eq2.
    do 2 rewrite cat_assoc in eq2.
    rewrite h_eq2 in eq2.
    do 2 rewrite cat_lid in eq2.
    exact eq2.
Qed.

Theorem functor_equiv_sur1 : essentially_surjective F.
Proof.
    intros B.
    exists (G B).
    exists (ε B).
    destruct equiv as [η_iso ε_iso].
    rewrite nat_isomorphism_A in ε_iso.
    apply ε_iso.
Qed.

(* begin hide *)
End FunctorEquivalence1.

(* end hide *)
Theorem cat_equiv_sym : ∀ C1 C2, cat_equivalent C1 C2 → cat_equivalent C2 C1.
Proof.
    intros C1 C2 [F [G [η [ε equiv]]]].
    pose proof (cat_equiv_sym_base F G η ε equiv) as [η' [ε' equiv']].
    exists G, F, η', ε'.
    exact equiv'.
Qed.

(* begin hide *)
Section FunctorEquivalence2.

Context `{C1 : Category, C2 : Category}.
Context `(F : @Functor C1 C2, G : @Functor C2 C1).
Context `(η : @NatTransformation C1 C1 𝟏 (G ○ F)).
Context `(ε : @NatTransformation C2 C2 (F ○ G) 𝟏).
Hypothesis equiv : cat_equivalence F G η ε.

(* end hide *)
Theorem functor_equiv_faithful2 : faithful_functor G.
Proof.
    pose proof (cat_equiv_sym_base F G η ε equiv) as [η' [ε' equiv']].
    apply (functor_equiv_faithful1 G F η' ε' equiv').
Qed.

Theorem functor_equiv_sur2 : essentially_surjective G.
Proof.
    pose proof (cat_equiv_sym_base F G η ε equiv) as [η' [ε' equiv']].
    apply (functor_equiv_sur1 G F η' ε' equiv').
Qed.

Theorem functor_equiv_full1 : full_functor F.
Proof.
    intros A B.
    split.
    intros f.
    destruct equiv as [η_iso ε_iso].
    rewrite nat_isomorphism_A in η_iso.
    rewrite nat_isomorphism_A in ε_iso.
    pose proof (η_iso A) as [g' [g_eq1 g_eq2]].
    pose (g := nat_trans_f η A).
    pose proof (η_iso B) as [h [h_eq1 h_eq2]].
    cbn in *.
    pose (f2 := functor_morphism G f).
    pose (f3 := h ∘ f2 ∘ g).
    exists f3.
    unfold f3, f2, g; clear f3 f2 g.
    pose proof (functor_equiv_faithful2) as G_faith.
    apply G_faith.
    repeat rewrite functor_compose.
    pose proof (nat_trans_commute η (nat_trans_f η A)) as eq.
    cbn in eq.
    apply rcompose with g' in eq.
    do 2 rewrite <- cat_assoc in eq.
    rewrite g_eq1 in eq.
    do 2 rewrite cat_rid in eq.
    rewrite <- eq; clear eq.
    pose proof (nat_trans_commute η (functor_morphism G f)) as eq.
    cbn in eq.
    rewrite <- cat_assoc.
    rewrite <- eq; clear eq.
    rewrite cat_assoc.
    pose proof (nat_trans_commute η h) as eq.
    cbn in eq.
    rewrite <- eq.
    rewrite h_eq1.
    rewrite cat_lid.
    reflexivity.
Qed.

(* begin hide *)
End FunctorEquivalence2.
Section FunctorEquivalence3.

Context `{C1 : Category, C2 : Category}.
Context `(F : @Functor C1 C2, G : @Functor C2 C1).
Context `(η : @NatTransformation C1 C1 𝟏 (G ○ F)).
Context `(ε : @NatTransformation C2 C2 (F ○ G) 𝟏).
Hypothesis equiv : cat_equivalence F G η ε.

(* end hide *)
Theorem functor_equiv_full2 : full_functor G.
Proof.
    pose proof (cat_equiv_sym_base F G η ε equiv) as [η' [ε' equiv']].
    apply (functor_equiv_full1 G F η' ε' equiv').
Qed.

(* begin hide *)
End FunctorEquivalence3.

(* end hide *)
Theorem functor_equivalence `{C1 : Category, C2 : Category} :
    ∀ `(F : @Functor C1 C2),
    full_functor F → faithful_functor F → essentially_surjective F →
    cat_equivalent C1 C2.
Proof.
    intros F F_full F_faith F_sur.
    exists F.
    pose (G_f B := ex_val (F_sur B)).
    pose (g B := ex_val (ex_proof (ex_proof (F_sur B)))).
    pose (h A := ex_val (ex_proof (F_sur A))).
    pose (G_morphism A B (f : cat_morphism C2 A B) :=
        ex_val (sur _ (Surjective := F_full _ _) (g B ∘ f ∘ h A))
    ).
    assert (∀ A, g A ∘ h A = 𝟙) as gh_id.
    {
        intros A.
        unfold g, h.
        unfold ex_val, ex_proof.
        destruct (ex_to_type (F_sur A)) as [GA CC0]; cbn.
        destruct (ex_to_type CC0) as [f CC1]; cbn; clear CC0.
        destruct (ex_to_type CC1) as [f' [f_eq1 f_eq2]]; cbn; clear CC1.
        exact f_eq2.
    }
    assert (∀ A, h A ∘ g A = 𝟙) as hg_id.
    {
        intros A.
        unfold g, h.
        unfold ex_val, ex_proof.
        destruct (ex_to_type (F_sur A)) as [GA CC0]; cbn.
        destruct (ex_to_type CC0) as [f CC1]; cbn; clear CC0.
        destruct (ex_to_type CC1) as [f' [f_eq1 f_eq2]]; cbn; clear CC1.
        exact f_eq1.
    }
    assert (∀ {A B C} (f : cat_morphism C2 B C) (g : cat_morphism C2 A B),
        G_morphism _ _ (f ∘ g) = G_morphism _ _ f ∘ G_morphism _ _ g)
        as G_compose.
    {
        intros A B C f1 f2.
        unfold G_morphism.
        change (ex_type_val (ex_to_type (F_sur A))) with (G_f A).
        change (ex_type_val (ex_to_type (F_sur B))) with (G_f B).
        change (ex_type_val (ex_to_type (F_sur C))) with (G_f C).
        rewrite_ex_val f12' f12'_eq.
        rewrite_ex_val f1' f1'_eq.
        rewrite_ex_val f2' f2'_eq.
        clear G_morphism.
        pose proof (lrcompose f1'_eq f2'_eq) as eq.
        rewrite <- functor_compose in eq.
        rewrite <- cat_assoc in eq.
        do 2 rewrite (cat_assoc (h B)) in eq.
        rewrite hg_id in eq.
        rewrite cat_lid in eq.
        rewrite cat_assoc in eq.
        rewrite cat_assoc in f12'_eq.
        rewrite <- eq in f12'_eq.
        apply F_faith in f12'_eq.
        exact f12'_eq.
    }
    assert (∀ A, G_morphism _ _ (cat_id _ A) = 𝟙) as G_id.
    {
        intros A.
        unfold G_morphism.
        change (ex_type_val (ex_to_type (F_sur A))) with (G_f A).
        rewrite_ex_val f f_eq.
        rewrite cat_rid in f_eq.
        specialize (gh_id A).
        change (ex_type_val (ex_to_type (F_sur A))) with (G_f A) in *.
        rewrite gh_id in f_eq.
        rewrite <- functor_id in f_eq.
        apply F_faith in f_eq.
        exact f_eq.
    }
    pose (G := {|
        functor_f := G_f;
        functor_morphism := G_morphism;
        functor_compose := G_compose;
        functor_id := G_id;
    |}).
    pose (η_f A := ex_val (sur _ (Surjective := F_full _ _) (g (F A)))
        : cat_morphism C1 (𝟏 A) ((G ○ F) A)).
    assert (∀ {A B} (f : cat_morphism C1 A B),
        η_f B ∘ (⌈𝟏⌉ f) = (⌈G ○ F⌉ f) ∘ η_f A) as η_commute.
    {
        intros A B f0.
        cbn.
        unfold G_morphism.
        change (ex_type_val (ex_to_type (F_sur (F A)))) with (G_f (F A)).
        change (ex_type_val (ex_to_type (F_sur (F B)))) with (G_f (F B)).
        unfold η_f.
        rewrite_ex_val f1 f1_eq.
        rewrite_ex_val f2 f2_eq.
        rewrite_ex_val f3 f3_eq.
        rewrite <- f1_eq in f2_eq.
        pose proof (lrcompose f2_eq f3_eq) as eq.
        clear f1_eq f2_eq f3_eq.
        rewrite <- functor_compose in eq.
        rewrite <- functor_compose in eq.
        rewrite <- cat_assoc in eq.
        rewrite hg_id in eq.
        rewrite cat_rid in eq.
        apply F_faith in eq.
        symmetry; exact eq.
    }
    assert (∀ {A B} (f : cat_morphism C2 A B),
        h B ∘ (⌈F ○ G⌉ f) = (⌈𝟏⌉ f) ∘ h A) as ε_commute.
    {
        intros A B f.
        cbn.
        unfold G_morphism.
        change (ex_type_val (ex_to_type (F_sur A))) with (G_f A).
        change (ex_type_val (ex_to_type (F_sur B))) with (G_f B).
        rewrite_ex_val f' f'_eq.
        rewrite f'_eq.
        do 2 rewrite cat_assoc.
        rewrite hg_id.
        rewrite cat_lid.
        reflexivity.
    }
    pose (ε_f B := h B : cat_morphism C2 ((F ○ G) B) (𝟏 B)).
    pose (η := {|nat_trans_f := η_f; nat_trans_commute := η_commute|}).
    pose (ε := {|nat_trans_f := ε_f; nat_trans_commute := ε_commute|}).
    exists G, η, ε.
    split; rewrite nat_isomorphism_A.
    -   intros A.
        unfold isomorphism.
        exists (ex_val (sur _ (Surjective := F_full _ _) (h (F A)))).
        cbn.
        unfold η_f.
        change (ex_type_val (ex_to_type (F_sur (F A)))) with (G (F A)).
        rewrite_ex_val f1 f1_eq.
        rewrite_ex_val f2 f2_eq.
        split.
        +   pose proof (lrcompose f1_eq f2_eq) as eq.
            rewrite <- functor_compose in eq.
            specialize (gh_id (F A)).
            cbn in *.
            change (ex_type_val (ex_to_type (F_sur (F A)))) with (G_f (F A)) in *.
            rewrite gh_id in eq.
            rewrite <- functor_id in eq.
            apply F_faith in eq.
            exact eq.
        +   pose proof (lrcompose f2_eq f1_eq) as eq.
            rewrite <- functor_compose in eq.
            specialize (hg_id (F A)).
            cbn in *.
            change (ex_type_val (ex_to_type (F_sur (F A)))) with (G_f (F A)) in *.
            rewrite hg_id in eq.
            rewrite <- functor_id in eq.
            apply F_faith in eq.
            exact eq.
    -   intros A.
        unfold isomorphism.
        exists (g A).
        cbn.
        unfold ε_f.
        split.
        +   apply hg_id.
        +   apply gh_id.
Qed.