From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype choice.
From mathcomp Require Import ssralg ssrnum ssrint fintype bigop order matrix interval.
From mathcomp  Require Import boolp reals posnum.
From mathcomp Require Import classical_sets topology prodnormedzmodule  posnum topology normedtype landau forms sequences.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Import Order.TTheory GRing.Theory Num.Theory Num.Def.
Local Open Scope ring_scope.
Local Open Scope classical_set_scope.

Section Close_Ball.
Definition close_ball_ (R : numDomainType) (V: zmodType) (norm : V -> R) (x : V) (e :R) :=
[set y | (norm (x- y) <=e)%O ] .
Definition close_ball (R : realType) (M : completeNormedModType R) (x : M) (e : R) :=
  close_ball_ normr x e.

Lemma closed_close_ball (R : realType) (M : completeNormedModType R) (x : M) (e : R) :
  closed (close_ball x e).
Proof.
  Search _ closed.
  pose f := fun y => normr ( x - y).
  have : close_ball x e  = f @^-1` [set x | (x<= e)%O] by rewrite /close_ball /close_ball_ /preimage.
  move ->.
  apply (@closed_comp _ _ (f : M -> R^o) _).
  have H : forall x : M , x \in (~` f @^-1` (fun x : R => (x<=e)%O))  -> {for x, continuous ( f : M -> R^o)}.
   move => y Hy.
   apply  (@continuous_comp _ _ _ (fun y : M => (x-y)) (normr : M -> R^o) y) .
    apply: continuousB.
     by apply: cst_continuous.
     by [].
    by apply : norm_continuous.
   move=> a.
   exact (H a).
  by apply: closed_le.
Qed.

Variable (K : realType).

Lemma neighBall (U : completeNormedModType K) (y : U) (A : set U) :
  open_nbhs y A -> exists (r : {posnum K}), ball y r%:num `<=` A.
Proof.
  by move=> /open_nbhs_nbhs /(@nbhs_ballP _ _ y A) /exists2P [r [supr prop]]; exists (PosNum supr).
Qed.

Lemma closeNeigh_ball (U : completeNormedModType K) (y : U) (A : set U) :
  open_nbhs y A -> exists (r : {posnum K}), close_ball y r%:num `<=` A.
Proof.
  move=> H.
  have [r Hr] : (exists r : {posnum K}, ball y r%:num `<=` A).
    by apply: neighBall.
  have Hrr : r%:num / 2 > 0.
    by [].
  exists (PosNum Hrr).
  apply (@subset_trans  _ (ball y r%:num) _ _).
  rewrite -?ball_normE;  move=> a Ha;
  apply (@le_lt_trans _ _  (PosNum Hrr)%:num (`| y - a|) r%:num); rewrite ?(@ltr_pdivr_mulr _ 2 r%:num r%:num);
  by rewrite -?(@ltr_pdivr_mull _ r%:num 2 r%:num) //= mulrC mulfV ?ltr1n.
  by [].
Qed.

Lemma close_ball_center (U :completeNormedModType K) (x : U) (r : {posnum K}) :
  close_ball x r%:num x.
Proof.
  by rewrite /close_ball /close_ball_ //= subrr normr0.
Qed.

Lemma close_neigh_ball (U : completeNormedModType K) (x : U) (r : {posnum K}) :
  open_nbhs x (close_ball x r%:num)^°.
Proof.
  split.
    by apply: open_interior.
    apply: nbhs_singleton; apply: nbhs_interior; apply /nbhs_ballP; exists r%:num.
    by [].
    by rewrite -ball_normE; move=> a; apply/ltW.
Qed.

Lemma close_ball_ler (U : completeNormedModType K) (x : U) (e1 e2 : K) :
  (e1 <= e2)%O -> close_ball x e1 `<=` close_ball x e2.
  by move=> H e Y; apply: (@le_trans _ _ e1 (`|x-e|) e2).
Qed.

End Close_Ball.

Section Baire.
Variable (K: realType).
Definition dense (U : completeNormedModType K) (S : U  -> Prop) :=
  forall (O : set U), (exists y, O y) -> open O ->  exists x, (setI O S) x.

(*Definition dense_ (U : completeNormedModType K) (S : U -> Prop) :=
  forall O, (O <> set0) -> open O -> ((setI O S) <> set0).

Definition dense_alt (U : completeNormedModType K) (S : U -> Prop) :=
  closure S = setT.
Definition dense_altbis ( U : completeNormedModType K) (S : U -> Prop) :=
  forall x, exists O , (neigh x) O -> (O `&` S) <> set0.

Lemma densityEbis  (U : completeNormedModType K) (S : U -> Prop) :
  dense S <-> dense_ S.
Admitted.

Lemma densityE (U : completeNormedModType K) (S : U -> Prop) :
  dense S <-> dense_alt S.
Admitted.*)
Lemma floor_nat_comp (M :K) : (0 <= M) -> (M < `|Rtoint(floor M + 1%:~R)|%:R).
       move=> Hyp.
       set n:= (X in ( M < X)).
       have ->  : n = (floor M + 1).
       rewrite {}/n.
       have /RintP [z Hmz] := isint_floor M.
       rewrite Hmz -intrD Rtointz.
       have S : z +  1 = Posz (  `|(z+1)%R|%N).
       rewrite gez0_abs.
       by [].
       rewrite -(@ler_int K 0 (z+1)) intrD -Hmz (@le_trans _ _ M 0 (floor M + 1)).
       by [].
       by [].
       by apply/ltW; apply: floorS_gtr.
       by rewrite  S.
       by apply: floorS_gtr.
Qed.

Lemma minr_le1 (x y : K) : (x >= minr x y ).
Proof.
  case : (@lerP _ x y).
  by [].
  by apply: ltW.
Qed.

Lemma minr_le2 ( x y : K) : ( y >= minr x y).
Proof.
  by case : (@lerP _ x y).
Qed.
Lemma lt_inv (x y : K) : (x > 0) -> (y > 0) -> (x^-1 < y^-1) = (y < x).
Proof.
 by move => supx supy; rewrite -(mulr1 x^-1) ltr_pdivr_mull ?ltr_pdivl_mulr ?(mulrC 1 y) ?(mulr1 y).
Qed.

Definition Baire (U : completeNormedModType K) :=
  forall (F: nat -> (set U)), (forall i, open (F i) /\  dense (F i))  ->
                      dense (\bigcap_(i : nat) (F i)).

(* Definition Baire (U : completeNormedModType K) :=
  forall (F: nat -> (set U)), (forall i, open (F i) /\  dense (F i))  ->
                      dense (\bigcap_(i : nat) (F i)). *)

Theorem DeBaire  (U : completeNormedModType K) : Baire U.
Proof.
move=> F Hf D Dy  OpenD.
have [H /(_ D  Dy OpenD) [a0 DF0a0 ] ] : open (F 0%nat) /\ dense (F 0%nat)
  by apply Hf.
have openIDF0 : open (D `&` F 0%N) by apply: openI.
have neigh_a0 : open_nbhs a0 (D `&` F 0%N) by [].
move: (@closeNeigh_ball _ _   a0 (D `&` F 0%N) neigh_a0)
         {DF0a0 openIDF0} => [ r0 Ball_a0] {neigh_a0} .
pose P (m: nat) (arn : U * {posnum K}) (arm : U * {posnum K}) :=
  close_ball arm.1 (arm.2%:num)
                  `<=` ((close_ball (arn).1 ((arn).2%:num))^°
   `&` (F m)) /\ (arm.2%:num < ((S(m))%:R^-1)).
have Ar: forall na : nat * (U * {posnum K}), exists b : (U * {posnum K}) , P (S(na.1)) na.2 b.
  move=> [n [an rn]].
  move: (Hf ((S n)%N))=> [ openFn denseFn ].
  have [an1 B0Fn2an1]: exists x, ((close_ball an (numpos K rn))^° `&` F (S n)%N) x .
  move: (close_neigh_ball an rn)=> [h1 h2]; apply: denseFn.
   - by exists an.
   - by [].
simpl in (type of an1).
have openIB0Fn1 : open ((close_ball an (numpos K rn))^° `&` F (S n)%N).
  apply: openI; last by [].
  by apply: open_interior.
have neigh_an1 : open_nbhs an1 ((close_ball an (numpos K rn))^° `&` F (S n)%N) by [].
move: (@closeNeigh_ball _ _ an1  ((close_ball an (numpos K rn))^° `&` F (S n)%N) neigh_an1)
        {B0Fn2an1 openIB0Fn1 openFn denseFn} => [rn01 Ball_an1].
pose a := ((n.+3)%:R^-1 : K).
have asup: a > 0 by [].
pose abis := PosNum asup.
pose rn1b := minr abis%:num rn01%:num.
have majr : rn1b > 0 by apply min_pos_gt0.
pose rn1 := PosNum majr.
exists (an1,rn1); split.
   - have temp : close_ball an1 rn1b `<=` close_ball an1 rn01%:num
     by apply : close_ball_ler; apply: minr_le2.
     by apply:  (@subset_trans _ (close_ball an1 rn01%:num) _ _).
   - apply: (@le_lt_trans _ _ (n.+3%:R^-1) rn1b (n.+2%:R^-1)).
     by apply: minr_le1.
     by rewrite lt_inv ?ltr_nat.
move: (choice Ar) => [f Pf].
pose fix ar (n: nat):= match n with
                     | 0 => (a0,r0)
                     | S p => (f (p,(ar p)))
                     end .
pose a := fun n => (ar n).1 .
pose r := fun n => (ar n).2 .
have Suite_ball : forall (n m :nat) , (n <= m)%N -> close_ball (a m) (r m)%:num
                                            `<=` close_ball (a n) (r n)%:num.
 move=> n m.
 elim m=> [| k iHk].
  by rewrite leqn0; move=> /eqP ->.
 move=> iHk2.
 have step : close_ball (a k.+1) (r k.+1)%:num `<=` close_ball (a k) (r k)%:num.
 have [Htemp _]: P k.+1 (a k, r k)   (a (k.+1), r (k.+1)) by apply: (Pf (k, ar k)).
 move: Htemp ; rewrite subsetI.
 move=> [tempbis _].
 apply: (@subset_trans _ (close_ball (a k, r k).1 (numpos K (a k, r k).2))^° _ _).
   by [].
   by apply : interior_subset.
 rewrite leq_eqVlt in iHk2.
 have : (n==k.+1) \/ (n<k.+1)%N by apply /orP.
 case.
 - by move=> /eqP ->.
 - move => temp.
   have: (n<= k)%N by [].
   move  => /iHk final.
   by apply : (@subset_trans _ (close_ball (a k) (numpos K (r k))) _ _).
have cauchyexa: (cauchy_ex (a @ \oo )).
 move => e e0.
 rewrite /fmapE -ball_normE /ball_.
 have [n Hn]: exists n : nat , 2*(r n)%:num < e.
 pose eps := e/2.
 have [n Hn]: exists n : nat , ((n.+1)%:R^-1 < eps).
 exists `|Rtoint (floor eps^-1 + 1%:~R)|%N.
 have He : (eps^-1 < `|Rtoint(floor eps^-1 + 1%:~R)|%:R)
   by apply : floor_nat_comp;rewrite invr_ge0 ler_pdivl_mulr ?(mulrC 0 2) ?(mulr0 2) ?ltW.
 have : (eps^-1 < `|Rtoint(floor eps^-1 + 1%:~R)|%:R) by [].
 rewrite -(mulr1 eps^-1) ltr_pdivr_mull.
 rewrite mulrC -ltr_pdivr_mull mulr1.
    rewrite mulr1; move=> Ht; apply (@lt_trans _ _ (`|Rtoint (floor eps^-1 + 1%:~R)|%:R^-1) _ _).
    rewrite lt_inv //=.
      by rewrite ltr_nat //=.
      by rewrite (@lt_trans _ _ eps^-1 _ _) ?invr_gt0  ?ltr_pdivl_mulr ?(mulrC 0 2) ?(mulr0 2) //=.
      by [].
      by rewrite (@lt_trans _ _ eps^-1 _ _) ?invr_gt0  ?ltr_pdivl_mulr ?(mulrC 0 2) ?(mulr0 2) //=.
      by rewrite ltr_pdivl_mulr ?(mulrC 0 2) ?(mulr0 2).
 exists (n.+1).
 have: (r n.+1)%:num < n.+1%:R^-1.
 have: P n.+1 (a n, r n)   (a (n.+1), r (n.+1)) by apply: (Pf (n, ar n)).
 by move=> [_ B]; apply: (@lt_trans _ _ (n.+2%:R^-1) _ _);  rewrite ?lt_inv ?ltr_nat .
  move=> temp; apply: (@lt_trans _ _ (2* n.+1%:R^-1) _ _);
  by rewrite -ltr_pdivl_mull ?mulrA ?(mulrC 2^-1 2) ?mulfV ?(mulrC 2^-1 e) ?div1r.
 exists (a n); exists n; first by [].
 move =>  m nsupm.
 apply: (@lt_trans _ _ (2*(r n)%:num) (`|a n - a m|) e); last first. by [].
 have : (close_ball (a n) (r n)%:num) (a m).
 move : (Suite_ball n m nsupm).
 have : close_ball (a m) (r m)%:num (a m) by apply: close_ball_center.
 by move=> temp1 Ha; move : (Ha (a m) temp1).
 by move=> temp; rewrite (@le_lt_trans _ _ (r n)%:num (`|a n - a m|) (2*(r n)%:num)) -?ltr_pdivr_mulr ?mulfV ?ltr1n.
have cauchya : (cauchy (a @ \oo)) by apply: cauchy_exP.
have : cvg (a @ \oo) by apply: cauchy_cvg.
rewrite cvg_ex //=.
move=> [l Hl] {Hf Dy OpenD H cauchya cauchyexa}.
exists l.
have partie1 : D l.
 have Hinter : (close_ball a0 r0%:num) l.
  apply: (@closed_cvg _ _ \oo eventually_filter a); first by [].
  move=> m.
  have temp:  (0 <= m)%N by apply: leq0n.
    move : (Suite_ball 0%N m temp).
    have : close_ball (a m) (r m)%:num (a m) by apply: close_ball_center.
  by move=> temp1 Ha; move : (Ha (a m) temp1).
 by apply: closed_close_ball.
have : close_ball a0 r0%:num `<=` D by move: Ball_a0; rewrite subsetI; apply:  proj1.
by move=>  Htemp; move : (Htemp l Hinter).
have partie2 : (\bigcap_i F i) l.
move=> i _.
 have : close_ball (a i) (r i)%:num l.
  rewrite -(@cvg_shiftn i _ a l) in Hl.
  simpl in Hl.
  have partiecvg:  forall n : nat, close_ball (a i) (r i)%:num (a (n + i)%N).
   move=> n.
   have temp : (i <= (n +i)%N)%N by apply: leq_addl.
   have temp2 : close_ball (a (n+i)%N) (r (n+i)%N)%:num (a (n+i)%N) by apply: close_ball_center.
   by move : (Suite_ball i (n +i)%N temp (a (n+i)%N) temp2).
  apply (@closed_cvg _ _ \oo eventually_filter (fun n : nat => a (n+i)%N)).
  by [].
  by [].
  by apply :  closed_close_ball.
case i.
by rewrite subsetI in Ball_a0; move: Ball_a0; move=> [_ p] la0; move : (p l la0).
move=> n.
have [temp _] : P n.+1 (a n, r n) (a n.+1, r n.+1) by apply : (Pf (n , ar n)).
by rewrite subsetI in temp; move : temp; move=> [_ p] lan1; move: (p l lan1).
by [].
Qed.

End Baire.

Section banach_steinhauss.
Variable (K: realType).
Variable (V: completeNormedModType K)  (W: normedModType K).
(*Theorem banach_steinhauss *)

Check bounded_on.
Print bounded_on.

(*Definition bounded_alt (f: V -> W) :=
  bounded_on f (locally (0:V)).*)

Definition bounded (f: V -> W) := forall r, exists M,
      forall x, (`|x| <= r) -> (`|(f x)| <= M).

(*Lemma bounded_ballE (f: V -> W) : bounded f <-> bounded_alt f.
Proof.
Admitted.*)

Definition pointwise_bounded (F: (V -> W) -> Prop) := forall x, exists M,
      forall f , F f ->  (`|f x| <= M)%O.

Definition uniform_bounded (F: (V -> W) -> Prop) := forall r, exists M,
      forall f, F f -> forall x, (`|x| <= r)  -> (`|f x| <= M)%O.

Lemma bounded_landau (f :{linear V->W}) :
  bounded f <-> ((f : V -> W) =O_ (0:V) cst (1 : K^o)).
Proof.
  split.
  - rewrite eqOP => bf.
    move: (bf 1) => [M bm].
    rewrite !nearE /=; exists M; split. by  apply : num_real.
    move => x Mx; rewrite nearE nbhs_normP /=.
    exists 1; first by [].
    move => y /=. rewrite -ball_normE /ball_ sub0r normrN /cst normr1 mulr1 => y1.
    apply: (@le_trans _ _ M _ _).
    apply: (bm y); by apply: ltW.
    by apply: ltW.
  - rewrite eqOP !nearE /+oo /cst normr1; move=> [M [Mr Bf]] r.
    move: (Bf (2*M)); rewrite nearE /=.
    have: M < 2 * M by admit.
    move=> lem /(_ lem) {lem} //=; rewrite nbhs_normP /cst -mulrA mulr1 .
    move=> [R oR] BR; exists (R^-1 * r * 2 * 2 * M)  => x xr.
    case: (EM (0 < `|x|)). (*ameliorer*)
     - move => x0.
       have r0 : 0 < r by apply: (@lt_le_trans _ _ (`|x|)).
       move: (BR ((R * (2 * r)^-1) *: x)); simpl. rewrite -ball_normE /ball_ sub0r normrN.
       have R2r10 : (0 < R/(2*r)) by rewrite divr_gt0 ?mulr_gt0 //=.
       have: (`|(R / (2 * r)) *: x| < R)%O by rewrite normmZ gtr0_norm //= -mulrA -ltr_pdivl_mull //= mulVf;
         rewrite ?lt0r_neq0 //= ltr_pdivr_mull ?mulr1 ?mulr_gt0 //= (@le_lt_trans _ _ r) //=;
         rewrite -ltr_pdivr_mulr //= divff ?lt0r_neq0 //= ltr1n //=.
       move=> lem /(_ lem) {lem}.
       rewrite linearZZ normmZ gtr0_norm //= (mulrC R) -(mulrA (2*r)^-1) ler_pdivr_mull ?mulr_gt0 //= (mulrC 2 r).
       by rewrite -ler_pdivl_mull //= !mulrA.
     - move => x0.
       have -> :  x = 0.
        have : ~~ (0%R < `|x|)%O by apply /negP.
        by rewrite -leNgt normrE; apply: eqP.
       have M0 : 0 <= M.
        have temp : (PosNum oR)%:num = R by [].
        rewrite -temp in BR; move:  (BR 0 (@ball_center _ _ 0 (PosNum oR))).
        by rewrite linear0 normr0 -ler_pdivr_mull ?mulr0 //=.
       have r0 : 0 <= r by apply: (@le_trans _ _ (`|x|)); rewrite ?normr_ge0 //=.
       rewrite linear0 normr0 !mulr_ge0 //= ?invr_ge0 ?ltW //=.

Admitted.

Lemma bounded_imply_landau (f :{linear V->W}) :
  bounded f -> ((f : V->W) =O_ (0:V) cst (1 : K^o)).
Proof.
  rewrite eqOP => bf.
    move: (bf 1) => [M bm].
    rewrite !nearE /=; exists M; split. by  apply : num_real.
    move => x Mx; rewrite nearE nbhs_normP /=.
    exists 1; first by [].
    move => y /=. rewrite -ball_normE /ball_ sub0r normrN /cst normr1 mulr1 => y1.
    apply: (@le_trans _ _ M _ _).
    apply: (bm y); by apply: ltW.
    by apply: ltW.
Qed.

Lemma denseNE (S : set V) : (not(dense S)) -> (exists O, ( exists x, (open_nbhs x) O) /\ (O `&` S = set0)).
Proof.
  rewrite /dense /open_nbhs => /existsNP [X /not_implyP [[x Xx] /not_implyP [ Ox /forallNP A ]]].
  exists X; split; first by exists x; split.
  by rewrite -subset0; apply/A => y.
Qed.

Lemma setIsubset (A B : set V) : A `&` B = set0 -> A `<=` ~` B.
Proof.
  by rewrite -setD_eq0; move <-; rewrite setDE setCK.
Qed.

Lemma linearsub  (a b : V) (f : V -> W ) :
  linear f -> (f (a-b) = f(a) - f(b)).
Proof.
  by rewrite addrC -scaleN1r; move ->; rewrite addrC scaleN1r.
Qed.

Lemma not_and_or : forall P Q : Prop , ~(P /\ Q) -> ~ P \/ ~ Q.
Proof.
  by move => P Q H; apply: or_asboolP; rewrite !asbool_neg -negb_and -asbool_and; apply /asboolPn.
Qed.

Theorem Banach_Steinhauss (F: set ((V -> W))):
  (forall f, (F f) -> bounded f /\ linear f) ->
  pointwise_bounded F -> uniform_bounded F.
Proof.
  move=> Propf.
  move=> BoundedF.
  set O := (fun n :nat => \bigcup_(f in F) ((normr \o f)@^-1` [set y | y > n%:R])).
  have O_open: forall n : nat, open ( O n ).
   - move=>n.
     apply: open_bigU.
     move=> i App.
     apply: (@open_comp _ _ ((normr : W -> K^o) \o i) [set y | y > n%:R]).
     have Ci : continuous i.
     + have Li : linear i by apply Propf.
       have Bi : bounded i by apply Propf.
       have Landaui : i =O_ (0:V) cst (1:K^o) by apply (@bounded_imply_landau (Linear Li)).
       by apply: (@linear_continuous K V W (Linear Li)).
     move=> x Hx ; apply: continuous_comp.
       + by apply: Ci.
       + by apply: norm_continuous.
      by apply: open_gt.
  set O_inf := (\bigcap_i ( O i)).
  have  O_infempty : O_inf = set0.
     rewrite -subset0 => x //=.
     move: (BoundedF x) => [M HMx].
     rewrite /O_inf  /O //=  /bigsetI /bigsetU //=.
     case  /(_ (`|Rtoint (floor M + 1%:~R)|%N)).
     -  by rewrite /setT.
     - move=> f  Hf abs; move : (HMx f Hf) => abs2.
     have: (`|Rtoint (floor M + 1%:~R)|%:R < M) by  apply: (@lt_le_trans _ _ (`|f x|)).
     have : (M < `|Rtoint(floor M + 1%:~R)|%:R) by apply : floor_nat_comp; apply:  (@le_trans _ _ `|f x|).
     by apply : lt_nsym.
  have BaireV : Baire V by apply : DeBaire.
  have ContraBaire : exists i : nat, not (dense (O i)).
   - unfold Baire in BaireV.
     have BaireO : (forall i : nat, open(O i) /\ dense (O i)) -> dense (O_inf) by apply (BaireV O).
     apply contrap  in BaireO.
     + move: BaireO => /asboolPn /existsp_asboolPn [n /and_asboolP /nandP Hn].
       by exists n ; case : Hn => /asboolPn.
    + rewrite /dense O_infempty ; apply /existsNP.
       exists setT. elim.
       * by move=> x; rewrite setI0.
       * by exists point.
       * by apply: openT.
  have BaireContra : exists n :nat , exists x : V,
               exists r : {posnum K}, (ball x r%:num) `<=` (~` (O n)).
    - move: ContraBaire =>
      [ i /(denseNE) [ O0 [ [ x /(neighBall) [ r H1 ] ]
      /((@subsetI_eq0 _ (ball x r%:num) O0 (O i) (O i)) )  ]  ] /(_ H1) ] H2.
       by exists i; exists x; exists r;apply: setIsubset; apply H2.
  move: BaireContra => [n [x0 [ r H ] ] k]; exists ((n%:R + n%:R) * k * 2 /r%:num); move=> f Hf y Hx.
  move: (Propf f Hf) => [ _ linf].
  case: (eqVneq y 0) => [-> | Zeroy]; last first.
  - have  majballi : forall f, forall x, F f -> (ball x0 r%:num) x -> (`|f x | <= n%:R)%O.
    move=> g x Fg Bx; move: (H x Bx).
    rewrite /O //= /bigsetU //= /setC exists2P -forallNP.
    move /(_  g).  case /not_and_or ; first by [].
    by move=> /(@negP ((n%:R < `|g x|)%O)); rewrite -leNgt .
    have majball : forall f, forall x, F f -> (ball x0 r%:num) x -> (`|f (x - x0) | <= (n%:R + n%:R))%O.
    move=> g x Fg; move: (Propf g Fg) => [Bg Lg].
    have Ling : g(x - x0) = g(x) - g(x0) by apply: (@linearsub x x0 g).
    rewrite Ling.
    move=> Ballx.
    move: (majballi g x Fg Ballx) => Majx.
    move: (majballi g x0 Fg   (ball_center x0 r)) => Majx0.
    have Majf : `| g x | + `|g x0| <= n%:R + n%:R
      by apply: (@ler_add _ `|g x| n%:R `|g x0| n%:R).
    apply: (@le_trans _ _ (`|g x| + `|g x0|) (`|g x - g x0|) (n%:R + n%:R)).
    - by apply: ler_norm_sub.
    - by [].
    have ballprop : ball x0 r%:num (2^-1  * (r%:num / `|y|) *: y  + x0).
      rewrite -ball_normE /ball_ opprD.
      rewrite addrC -addrA (@addrC _ (-x0) x0) addrN addr0 normrN normmZ.
      rewrite R_normZ R_normZ -mulrA -mulrA  -(@normr_id _ _ y) -R_normZ normr_id.
      rewrite /GRing.scale //= mulVf; last by rewrite normr_eq0.
      rewrite normr1  mulr1 gtr0_norm; last by rewrite invr_gt0.
      by rewrite gtr0_norm //=  gtr_pmull //= invf_lt1 //= ltr1n.
    move: (majball f (2^-1 * (r%:num/`|y|)*:y + x0) Hf ballprop).
    rewrite -addrA addrN linf.
    have -> : f 0 =0 by rewrite -(linear0  (Linear linf)).
    rewrite addr0 normmZ !R_normZ -ler_pdivl_mull //=.
    rewrite !gtr0_norm //= ; last by rewrite invr_gt0 normr_gt0.
    rewrite mulrA mulrC invf_div mulrA (@mulrC _ (2^-1) _) invf_div mulrA.
    move=> Currentmaj {Propf BoundedF O O_open O_inf O_infempty BaireV ContraBaire H majball majballi}.
    rewrite (@le_trans  _ _ ((n%:R + n%:R) * `|y| * 2 / r%:num)) //= => {Currentmaj}.
    rewrite (mulrC (n%:R + n%:R)) -ler_pdivl_mulr //=.
    rewrite invrK -(mulrC r%:num) -(mulrC r%:num^-1) (mulrA r%:num) mulfV //=.
    rewrite (mulrC 1) mulr1 -ler_pdivl_mulr //=.
    rewrite -(mulrC 2) -(mulrC 2^-1) (mulrA 2^-1) mulVf //= (mulrC 1) mulr1.
    case: n.
    - by rewrite addr0 mulr0 (mulrC 0) mulr0.
    - move => n.
      rewrite -ler_pdivl_mulr //= -mulrC mulrA mulVf //=.
      by rewrite (mulrC 1) mulr1.
    rewrite mulr_gt0 ?invr_gt0 ?normr_gt0 //=.
    rewrite mulr_gt0 ?invr_gt0 ?normr_gt0 //=.
    by rewrite invr_neq0; rewrite ?normrE.
    have -> : f 0 =0 by rewrite -(linear0  (Linear linf)).
    rewrite normr0 !mulr_ge0 //=.
    by rewrite (@le_trans _ _ `|y| _ _).
Qed.

End banach_steinhauss.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (lf2 : natural) (x : natural) (lf1 : natural) : natural :=
  plus Zero lf1.


Require Import Classical.
Require Export Ensembles.
Require Import EnsemblesImplicit.
Require Export Relation_Definitions.
Require Import Relation_Definitions_Implicit.
Require Import EnsemblesSpec.

Section MinimalElements.

Variable T:Type.
Variable R:relation T.

(* R is well-founded if and only if every nonempty subset of
   T has a minimal element *)

Definition minimal_element_property : Prop :=
  forall S:Ensemble T, Inhabited S -> exists x:T, In S x /\
    forall y:T, In S y -> ~ R y x.

Lemma WF_implies_MEP: well_founded R -> minimal_element_property.
Proof.
unfold well_founded.
unfold minimal_element_property.
intros WF S Hinh.
destruct Hinh.
revert x H.
apply (@well_founded_ind T R WF
 (fun x:T =>
  In S x -> exists y:T, In S y /\ (forall z:T, In S z -> ~ R z y))).
intros.
case (classic (forall y:T, In S y -> ~ R y x)).
exists x.
split.
assumption.
assumption.

intro.
apply not_all_ex_not in H1.
destruct H1.
apply imply_to_and in H1.
destruct H1.
apply H with x0.
apply NNPP.
assumption.
assumption.
Qed.

Lemma MEP_implies_WF: minimal_element_property -> well_founded R.
Proof.
unfold well_founded.
unfold minimal_element_property.
intro MEP.
apply NNPP.
intuition.
apply not_all_ex_not in H.
destruct H.
assert (Inhabited [x:T | ~ Acc R x]).
exists x.
constructor; assumption.
apply MEP in H0.
destruct H0.
destruct H0.
destruct H0.
contradict H0.
constructor.
intros.
apply NNPP.
intuition.
apply H1 with y.
constructor; assumption.
assumption.
Qed.

End MinimalElements.

Require Import ClassicalChoice.

Section DecreasingSequences.

(* R is well-founded if and only if there is no infinite strictly
   decreasing sequence of elements of T *)

Variable T:Type.
Variable R:relation T.

Definition decreasing_sequence_property :=
  forall a:nat->T, exists n:nat, ~ R (a (S n)) (a n).

Lemma WF_implies_DSP: well_founded R -> decreasing_sequence_property.
Proof.
unfold decreasing_sequence_property.
intros WF a.
remember (a 0) as a0.
revert a0 a Heqa0.
apply (well_founded_ind WF (fun x:T =>
  forall a:nat->T, x = a 0 -> exists n:nat, ~ R (a (S n)) (a n))).
intros.
case (classic (R (a 1) (a 0))).
intro.
pose (b := fun n:nat => a (S n)).
assert (exists n:nat, ~ R (b (S n)) (b n)).
apply H with (a 1).
rewrite H0.
assumption.
trivial.
destruct H2.
exists (S x0).
unfold b in H2.
assumption.

exists 0.
assumption.
Qed.

Lemma DSP_implies_WF: decreasing_sequence_property -> well_founded R.
Proof.
unfold decreasing_sequence_property.
intro DSP.
apply MEP_implies_WF.
unfold minimal_element_property.
intro S0.
intros.
apply NNPP.
intuition.
assert (forall x:T, In S0 x -> exists y:T, In S0 y /\ R y x).
intros.
apply NNPP.
intuition.
assert (forall y:T, ~(In S0 y /\ R y x)).
apply not_ex_all_not.
assumption.
apply H0.
exists x.
split.
assumption.
intros.
apply H3 with y.
tauto.

pose (S_type := {x:T | In S0 x}).
assert (exists f:S_type -> S_type, forall x:S_type,
  R (proj1_sig (f x)) (proj1_sig x)).
apply choice with (R:=fun x y:S_type => R (proj1_sig y) (proj1_sig x)).
intro.
destruct x.
simpl.
pose proof (H1 x i).
destruct H2.
destruct H2.
exists (exist (fun x:T => In S0 x) x0 H2).
simpl.
assumption.

destruct H2 as [f Hf].

destruct H.
pose (b := nat_rect (fun n:nat => S_type)
  (exist (fun x:T => In S0 x) x H)
  (fun (n:nat) (x:S_type) => f x)).
simpl in b.
pose (a := fun n:nat => (proj1_sig (b n))).
assert (forall n:nat, R (a (S n)) (a n)).
unfold a.
intro.
simpl.
apply Hf.

contradict DSP.
apply ex_not_not_all.
exists a.
apply all_not_not_ex.
auto.
Qed.

End DecreasingSequences.


Require Export XR_plus_IZR_NEG_POS.

Local Open Scope R_scope.

Arguments Z.add _ _ : simpl nomatch.

Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m.
Proof.
  intros n.
  destruct n as [ | n | n ].
  {
    intro m.
    simpl.
    rewrite Rplus_0_l.
    reflexivity.
  }
  {
    intro m.
    simpl.
    destruct m as [ | m | m ].
    {
      simpl.
      rewrite Rplus_0_r.
      reflexivity.
    }
    {
      simpl.
      rewrite Pos2Nat.inj_add.
      rewrite plus_INR.
      reflexivity.
    }
    {
      rewrite plus_IZR_NEG_POS.
      simpl.
      reflexivity.
    }
  }
  {
    simpl.
    intro m.
    destruct m.
    {
      simpl.
      rewrite Rplus_0_r.
      reflexivity.
    }
    {
      rewrite Z.add_comm.
      rewrite plus_IZR_NEG_POS.
      simpl.
      rewrite Rplus_comm.
      reflexivity.
    }
    {
      simpl.
      rewrite Pos2Nat.inj_add.
      rewrite plus_INR.
      rewrite Ropp_plus_distr.
      reflexivity.
    }
  }
Qed.


(** * Maps: Total and Partial Maps *)

(** _Maps_ (or _dictionaries_) are ubiquitous data structures both in
    ordinary programming and in the theory of programming languages;
    we're going to need them in many places in the coming chapters.

    They also make a nice case study using ideas we've seen in
    previous chapters, including building data structures out of
    higher-order functions (from [Basics] and [Poly]) and the use of
    reflection to streamline proofs (from [IndProp]).

    We'll define two flavors of maps: _total_ maps, which include a
    "default" element to be returned when a key being looked up
    doesn't exist, and _partial_ maps, which instead return an
    [option] to indicate success or failure.  The latter is defined in
    terms of the former, using [None] as the default element. *)

(* ################################################################# *)
(** * The Coq Standard Library *)

(** One small digression before we begin...

    Unlike the chapters we have seen so far, this one does not
    [Require Import] the chapter before it (nor, transitively, all the
    earlier chapters).  Instead, in this chapter and from now, on
    we're going to import the definitions and theorems we need
    directly from Coq's standard library stuff.  You should not notice
    much difference, though, because we've been careful to name our
    own definitions and theorems the same as their counterparts in the
    standard library, wherever they overlap. *)

From Coq Require Import Arith.Arith.
From Coq Require Import Bool.Bool.
From Coq Require Import Datatypes.
Require Export Coq.Strings.String.
From Coq Require Import Logic.FunctionalExtensionality.
From Coq Require Import Lists.List.
Import ListNotations.

(** Documentation for the standard library can be found at
    https://coq.inria.fr/library/.

    The [Search] command is a good way to look for theorems involving
    objects of specific types. See [Lists] for a reminder of how
    to use it. *)

(** If you want to find out how or where a notation is defined, the
    [Locate] command is useful.  For example, where is the natural
    addition operation defined in the standard library? *)

Locate "+".

(** (There are several uses of the [+] notation, but only one for
    naturals.) *)

Print Init.Nat.add.

(** We'll see some more uses of [Locate] in the [Imp] chapter. *)

(* ################################################################# *)
(** * Identifiers *)

(** First, we need a type for the keys that we will use to index into
    our maps.  In [Lists.v] we introduced a fresh type [id] for a
    similar purpose; here and for the rest of _Software Foundations_
    we will use the [string] type from Coq's standard library. *)

(** To compare strings, we use the function [eqb] from the [String]
    module in the standard library. *)

Check String.eqb_refl :
  forall x : string, (x =? x)%string = true.

(** We will often use a few basic properties of string equality... *)
Check String.eqb_eq :
  forall n m : string, (n =? m)%string = true <-> n = m.
Check String.eqb_neq :
  forall n m : string, (n =? m)%string = false <-> n <> m.
Check String.eqb_spec :
  forall x y : string, reflect (x = y) (String.eqb x y).

(* ################################################################# *)
(** * Total Maps *)

(** Our main job in this chapter will be to build a definition of
    partial maps that is similar in behavior to the one we saw in the
    [Lists] chapter, plus accompanying lemmas about its behavior.

    This time around, though, we're going to use _functions_, rather
    than lists of key-value pairs, to build maps.  The advantage of
    this representation is that it offers a more "extensional" view of
    maps: two maps that respond to queries in the same way will be
    represented as exactly the same function, rather than just as
    "equivalent" list structures.  This, in turn, simplifies proofs
    that use maps. *)

(** We build up to partial maps in two steps.  First, we define a type
    of _total maps_ that return a default value when we look up a key
    that is not present in the map. *)

Definition total_map (A : Type) := string -> A.

(** Intuitively, a total map over an element type [A] is just a
    function that can be used to look up [string]s, yielding [A]s. *)

(** The function [t_empty] yields an empty total map, given a default
    element; this map always returns the default element when applied
    to any string. *)

Definition t_empty {A : Type} (v : A) : total_map A :=
  (fun _ => v).

(** More interesting is the map-updating function, which (as always)
    takes a map [m], a key [x], and a value [v] and returns a new map
    that takes [x] to [v] and takes every other key to whatever [m]
    does.  The novelty here is that we achieve this effect by wrapping
    a new function around the old one. *)

Definition t_update {A : Type} (m : total_map A)
                    (x : string) (v : A) :=
  fun x' => if String.eqb x x' then v else m x'.

(** This definition is a nice example of higher-order programming:
    [t_update] takes a _function_ [m] and yields a new function
    [fun x' => ...] that behaves like the desired map. *)

(** For example, we can build a map taking [string]s to [bool]s, where
    ["foo"] and ["bar"] are mapped to [true] and every other key is
    mapped to [false], like this: *)

Definition examplemap :=
  t_update (t_update (t_empty false) "foo" true)
           "bar" true.

(** Next, let's introduce some notations to facilitate working with
    maps. *)

(** First, we use the following notation to represent an empty total
    map with a default value. *)
Notation "'_' '!->' v" := (t_empty v)
  (at level 100, right associativity).

Example example_empty := (_ !-> false).

(** We next introduce a convenient notation for extending an existing
    map with a new binding. *)
Notation "x '!->' v ';' m" := (t_update m x v)
                              (at level 100, v at next level, right associativity).

(** The [examplemap] above can now be defined as follows: *)

Definition examplemap' :=
  ( "bar" !-> true;
    "foo" !-> true;
    _     !-> false
  ).

(** This completes the definition of total maps.  Note that we
    don't need to define a [find] operation on this representation of
    maps because it is just function application! *)

Example update_example1 : examplemap' "baz" = false.
Proof. reflexivity. Qed.

Example update_example2 : examplemap' "foo" = true.
Proof. reflexivity. Qed.

Example update_example3 : examplemap' "quux" = false.
Proof. reflexivity. Qed.

Example update_example4 : examplemap' "bar" = true.
Proof. reflexivity. Qed.

(** When we use maps in later chapters, we'll need several fundamental
    facts about how they behave. *)

(** Even if you don't bother to work the following exercises,
    make sure you thoroughly understand the statements of the
    lemmas! *)

(** (Some of the proofs require the functional extensionality axiom,
    which was discussed in the [Logic] chapter.) *)

(** **** Exercise: 1 star, standard, optional (t_apply_empty)

    First, the empty map returns its default element for all keys: *)

Lemma t_apply_empty : forall (A : Type) (x : string) (v : A),
  (_ !-> v) x = v.
Proof.
  reflexivity. Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (t_update_eq)

    Next, if we update a map [m] at a key [x] with a new value [v]
    and then look up [x] in the map resulting from the [update], we
    get back [v]: *)

Lemma t_update_eq : forall (A : Type) (m : total_map A) x v,
  (x !-> v ; m) x = v.
Proof.
  intros. unfold t_update. rewrite eqb_refl. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (t_update_neq)

    On the other hand, if we update a map [m] at a key [x1] and then
    look up a _different_ key [x2] in the resulting map, we get the
    same result that [m] would have given: *)

Theorem t_update_neq : forall (A : Type) (m : total_map A) x1 x2 v,
  x1 <> x2 ->
  (x1 !-> v ; m) x2 = m x2.
Proof.
  intros A m x1 x2 v H.
  unfold t_update. destruct (eqb_spec x1 x2). exfalso. apply H. apply e. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (t_update_shadow)

    If we update a map [m] at a key [x] with a value [v1] and then
    update again with the same key [x] and another value [v2], the
    resulting map behaves the same (gives the same result when applied
    to any key) as the simpler map obtained by performing just
    the second [update] on [m]: *)

Lemma t_update_shadow : forall (A : Type) (m : total_map A) x v1 v2,
  (x !-> v2 ; x !-> v1 ; m) = (x !-> v2 ; m).
Proof.
  intros A m x v1 v2.
  apply functional_extensionality. intros x'.
  unfold t_update.
  destruct (eqb_spec x x') as [_ | _]. reflexivity. reflexivity.
Qed.
(** [] *)
(** **** Exercise: 2 stars, standard (t_update_same)

    Given [string]s [x1] and [x2], we can use the tactic
    [destruct (eqb_spec x1 x2)] to simultaneously perform case
    analysis on the result of [String.eqb x1 x2] and generate
    hypotheses about the equality (in the sense of [=]) of [x1] and
    [x2].  With the example in chapter [IndProp] as a template,
    use [String.eqb_spec] to prove the following theorem, which states
    that if we update a map to assign key [x] the same value as it
    already has in [m], then the result is equal to [m]: *)

Theorem t_update_same : forall (A : Type) (m : total_map A) x,
  (x !-> m x ; m) = m.
Proof.
  intros A m x.
  apply functional_extensionality.
  intros x'.
  unfold t_update.
  destruct (eqb_spec x x') as [H | _]. rewrite H. reflexivity. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 3 stars, standard, especially useful (t_update_permute)

    Similarly, use [String.eqb_spec] to prove one final property of
    the [update] function: If we update a map [m] at two distinct
    keys, it doesn't matter in which order we do the updates. *)

Theorem t_update_permute : forall (A : Type) (m : total_map A)
                                  v1 v2 x1 x2,
  x2 <> x1 ->
  (x1 !-> v1 ; x2 !-> v2 ; m)
  =
  (x2 !-> v2 ; x1 !-> v1 ; m).
Proof.
  intros A m v1 v2 x1 x2 H.
  apply functional_extensionality.
  intros x'.
  unfold t_update.
  destruct (eqb_spec x1 x') as [H1 | H1].
  - destruct (eqb_spec x2 x') as [H2 | _].
    + exfalso. apply H. rewrite H1. rewrite H2. reflexivity.
    + reflexivity.
  - destruct (eqb_spec x2 x') as [H2 | H2].
    + reflexivity.
    + reflexivity.
Qed.
(** [] *)

(* ################################################################# *)
(** * Partial maps *)

(** Lastly, we define _partial maps_ on top of total maps.  A partial
    map with elements of type [A] is simply a total map with elements
    of type [option A] and default element [None]. *)

Definition partial_map (A : Type) := total_map (option A).

Definition empty {A : Type} : partial_map A :=
  t_empty None.

Definition update {A : Type} (m : partial_map A)
           (x : string) (v : A) :=
  (x !-> Some v ; m).

(** We introduce a similar notation for partial maps: *)
Notation "x '|->' v ';' m" := (update m x v)
  (at level 100, v at next level, right associativity).

(** We can also hide the last case when it is empty. *)
Notation "x '|->' v" := (update empty x v)
  (at level 100).

Definition examplepmap :=
  ("Church" |-> true ; "Turing" |-> false).

(** We now straightforwardly lift all of the basic lemmas about total
    maps to partial maps.  *)

Lemma apply_empty : forall (A : Type) (x : string),
  @empty A x = None.
Proof.
  intros. unfold empty. rewrite t_apply_empty.
  reflexivity.
Qed.

Lemma update_eq : forall (A : Type) (m : partial_map A) x v,
  (x |-> v ; m) x = Some v.
Proof.
  intros. unfold update. rewrite t_update_eq.
  reflexivity.
Qed.

Theorem update_neq : forall (A : Type) (m : partial_map A) x1 x2 v,
  x2 <> x1 ->
  (x2 |-> v ; m) x1 = m x1.
Proof.
  intros A m x1 x2 v H.
  unfold update. rewrite t_update_neq. reflexivity.
  apply H. Qed.

Lemma update_shadow : forall (A : Type) (m : partial_map A) x v1 v2,
  (x |-> v2 ; x |-> v1 ; m) = (x |-> v2 ; m).
Proof.
  intros A m x v1 v2. unfold update. rewrite t_update_shadow.
  reflexivity.
Qed.

Theorem update_same : forall (A : Type) (m : partial_map A) x v,
  m x = Some v ->
  (x |-> v ; m) = m.
Proof.
  intros A m x v H. unfold update. rewrite <- H.
  apply t_update_same.
Qed.

Theorem update_permute : forall (A : Type) (m : partial_map A)
                                x1 x2 v1 v2,
  x2 <> x1 ->
  (x1 |-> v1 ; x2 |-> v2 ; m) = (x2 |-> v2 ; x1 |-> v1 ; m).
Proof.
  intros A m x1 x2 v1 v2. unfold update.
  apply t_update_permute.
Qed.

(** One last thing: For partial maps, it's convenient to introduce a
    notion of map inclusion, stating that all the entries in one map
    are also present in another: *)

Definition includedin {A : Type} (m m' : partial_map A) :=
  forall x v, m x = Some v -> m' x = Some v.

(** We can then show that map update preserves map inclusion -- that is: *)

Lemma includedin_update : forall (A : Type) (m m' : partial_map A)
                                 (x : string) (vx : A),
  includedin m m' ->
  includedin (x |-> vx ; m) (x |-> vx ; m').
Proof.
  unfold includedin.
  intros A m m' x vx H.
  intros y vy.
  destruct (eqb_spec x y) as [Hxy | Hxy].
  - rewrite Hxy.
    rewrite update_eq. rewrite update_eq. intro H1. apply H1.
  - rewrite update_neq. rewrite update_neq.
    + apply H.
    + apply Hxy.
    + apply Hxy.
Qed.

(** This property is quite useful for reasoning about languages with
    variable binding -- e.g., the Simply Typed Lambda Calculus, which
    we will see in _Programming Language Foundations_, where maps are
    used to keep track of which program variables are defined in a
    given scope. *)

(* 2022-08-08 17:13 *)


Example auto_example_1' : forall (P Q R: Prop),
  (P -> Q) -> (Q -> R) -> P -> R.
Proof.
  auto.
Qed.

Example auto_example_2 : forall P Q R S T U : Prop,
  (P -> Q) ->
  (P -> R) ->
  (T -> R) ->
  (S -> T -> U) ->
  ((P->Q) -> (P->S)) ->
  T ->
  P ->
  U.
Proof. auto. Qed.

Example auto_example_3 : forall (P Q R S T U: Prop),
  (P -> Q) ->
  (Q -> R) ->
  (R -> S) ->
  (S -> T) ->
  (T -> U) ->
  P ->
  U.
Proof.
  (* 当 auto 无法解决此目标时，它就什么也不做 *)
  auto.
  (* 可选的参数用来控制它的搜索深度（默认为 5） *)
  auto 6.
Qed.

Example auto_example_5: 2 = 2.
Proof.
  info_auto.
Qed.
From Coq Require Import omega.Omega.
Lemma le_antisym : forall n m: nat, (n <= m /\ m <= n) -> n = m.
Proof. intros. omega. Qed.

Example auto_example_6 : forall n m p : nat,
  (n <= p -> (n <= m /\ m <= n)) ->
  n <= p ->
  n = m.
Proof.
  info_auto using le_antisym.
Qed.


Inductive gcd: nat -> nat -> nat -> Prop :=
  | gcd_O n : gcd n O n
  | gcd_step n m p : gcd m n p -> gcd (n + m) n p
  | gcd_swap n m p : gcd m n p -> gcd n m p.

Example gcd_ex1 : gcd 6 4 2.
Proof.
  apply gcd_step with (n := 4).
  apply gcd_swap.
  apply gcd_step with (n := 2).
  apply gcd_step with (n := 2).
  apply gcd_swap.
  apply gcd_O.
Qed.

Definition task := forall n, gcd n (n + 1) 1.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (lf1 : natural) (y : natural) (z : natural) (x : natural)
  : natural := mult lf1 (Succ Zero).