(* $Id: PartFunEquality.v,v 1.15 2003/03/13 12:06:21 lcf Exp $ *)

Require Export Intervals.

Section Definitions.

(* Tex_Prose
\chapter{Equality of Partial Functions}

\section{Definitions}

In some contexts (namely when quantifying over partial functions) we need to refer explicitly to the subsetoid of elements satisfying a given predicate rather than to the predicate itself.  The following definition makes this possible.
*)

(* Begin_Tex_Verb *)
Definition subset [P:IR->CProp] : CSetoid :=
  (Build_SubCSetoid IR P).
(* End_Tex_Verb *)

(* Tex_Prose
The core of our work will revolve around the following fundamental notion: two functions are equal in a given domain (predicate) iff they coincide on every point of that domain\footnote{Notice that, according to our definition of partial function, it is equivalent to prove the equality for every proof or for a specific proof.  Typically it is easier to consider a generic case}.  This file is concerned with proving the main properties of this equality relation.
*)

(* Begin_Tex_Verb *)
Definition Feq [P:IR->CProp][F,G:(PartIR)] :=
  (included P (Pred F))*(included P (Pred G))*
  {(x:IR)(P x)->(Hx,Hx':?)(F x Hx)[=](G x Hx')}.
(* End_Tex_Verb *)

(* Tex_Prose
Notice that, because the quantification over the proofs is universal, we must require explicitly that the predicate be included in the domain of each function; otherwise the basic properties of equality (like, for example, transitivity) would fail to hold\footnote{To see this it is enough to realize that the empty function would be equal to every other function in every domain.}.  The way to circumvent this would be to quantify existentially over the proofs; this, however, would have two major disadvantages: first, proofs of equality would become very cumbersome and clumsy; secondly (and most important), we often need to prove the inclusions from an equality hypothesis, and this definition allows us to do it in a very easy way.  Also, the pointwise equality is much nicer to use from this definition than in an existentially quantified one.
*)

End Definitions.

Section Equality_Results.

(* Tex_Prose
\section{Properties of Inclusion}

We will now prove the main properties of the equality relation.

\begin{convention} Let \verb!I,R:IR->CProp! and \verb!F,G:PartIR!, and denote by \verb!P! and \verb!Q!, respectively, the domains of \verb!F! and \verb!G!.
\end{convention}
*)

Variable I:IR->CProp.
Variables F,G:PartIR.

Local P:=(Pred F).
Local Q:=(Pred G).

Variable R:IR->CProp.

(* Tex_Prose
We start with two lemmas which make it much easier to prove and use this definition:
*)

(* Begin_Tex_Verb *)
Lemma eq_imp_Feq : (included I P)->(included I Q)->
  ((x:IR)(I x)->(Hx,Hx':?)(F x Hx)[=](G x Hx'))->
  (Feq I F G).
(* End_Tex_Verb *)
Intros.
Split.
Split; Assumption.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_imp_eq : (Feq I F G)->(x:IR)(I x)->
  (Hx,Hx':?)(F x Hx)[=](G x Hx').
(* End_Tex_Verb *)
Intros.
Elim H; Intros.
Elim a; Auto.
Qed.

(* Tex_Prose
Next, we show how the inclusion relation works with the operations on partial functions (the first lemma applies, obviously, to total functions).
*)

(* Begin_Tex_Verb *)
Lemma included_IR : (included I [x:IR]CTrue).
(* End_Tex_Verb *)
Split.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FPlus : (included R P)->(included R Q)->
  (included R (Pred F{+}G)).
(* End_Tex_Verb *)
Intros; Simpl; Apply included_conj; Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FPlus' :
  (included R (Pred F{+}G))->(included R P).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_conj_lft; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FPlus'' :
  (included R (Pred F{+}G))->(included R Q).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_conj_rht; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FInv :
  (included R P)->(included R (Pred {--}F)).
(* End_Tex_Verb *)
Intro; Simpl; Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FInv' :
  (included R (Pred {--}F))->(included R P).
(* End_Tex_Verb *)
Intro; Simpl; Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FMinus : (included R P)->(included R Q)->
  (included R (Pred F{-}G)).
(* End_Tex_Verb *)
Intros; Simpl; Apply included_conj; Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FMinus' :
  (included R (Pred F{-}G))->(included R P).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_conj_lft; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FMinus'' :
  (included R (Pred F{-}G))->(included R Q).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_conj_rht; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FMult : (included R P)->(included R Q)->
  (included R (Pred F{*}G)).
(* End_Tex_Verb *)
Intros; Simpl; Apply included_conj; Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FMult' :
  (included R (Pred F{*}G))->(included R P).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_conj_lft; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FMult'' :
  (included R (Pred F{*}G))->(included R Q).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_conj_rht; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FRecip : (included R Q)->
  ((x:IR)(R x)->(Hx:?)(G x Hx)[#]Zero)->
  (included R (Pred {1/}G)).
(* End_Tex_Verb *)
Intros.
Simpl.
Unfold extend.
Split.
Apply H; Assumption.
Intros; Apply H0; Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FRecip' :
  (included R (Pred {1/}G))->(included R Q).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_extend; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FDiv : (included R P)->(included R Q)->
  ((x:IR)(R x)->(Hx:?)(G x Hx)[#]Zero)->
  (included R (Pred F{/}G)).
(* End_Tex_Verb *)
Intros.
Simpl.
Apply included_conj.
Assumption.
Unfold extend.
Split.
Apply H0; Assumption.
Intros; Apply H1; Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FDiv' :
  (included R (Pred F{/}G))->(included R P).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_conj_lft; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FDiv'' :
  (included R (Pred F{/}G))->(included R Q).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_extend; EApply included_conj_rht; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FComp : (included R P)->
  ((x:IR)(Hx:(R x))(Hx':(P x))(Q (F x Hx')))->
  (included R (Pred G{o}F)).
(* End_Tex_Verb *)
Intros.
Simpl.
Red; Intros.
Exists (H x H1).
Apply H0.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FComp' :
  (included R (Pred G{o}F))->(included R P).
(* End_Tex_Verb *)
Intros; Simpl in H; Red; Intros.
Elim (H x H0); Intros; Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FScalMult : (included R P)->
  (c:IR)(included R (Pred c{**}F)).
(* End_Tex_Verb *)
Intros; Simpl; Apply included_conj.
Red; Intros; Auto.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FScalMult' : (c:IR)
  (included R (Pred c{**}F))->(included R P).
(* End_Tex_Verb *)
Intros; Simpl in H; EApply included_conj_rht; Apply H.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FNth : (included R P)->
  (n:nat)(included R (Pred F{^}n)).
(* End_Tex_Verb *)
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma included_FNth' : (n:nat)
  (included R (Pred F{^}n))->(included R (Pred F)).
(* End_Tex_Verb *)
Auto.
Qed.

End Equality_Results.

Section Some_More.

(* Tex_Prose
Also, if two function coincide on a given subset then they coincide in any smaller subset.
*)

(* Begin_Tex_Verb *)
Lemma included_Feq : (P,Q,F,G:?)
  (included P Q)->(Feq Q F G)->(Feq P F G).
(* End_Tex_Verb *)
Intros.
Inversion_clear H0.
Inversion_clear H1.
Apply eq_imp_Feq.
EApply included_trans.
Apply H.
Assumption.
EApply included_trans.
Apply H.
Assumption.
Intros; Apply H2.
Apply H; Assumption.
Qed.

End Some_More.

Tactic Definition Included := EAuto with included.

Hints Resolve included_IR included_refl included_refl' compact_map1 compact_map2 compact_map3
  included_compact included2_compact included3_compact
  included_FPlus included_FInv included_FMinus included_FMult included_FRecip included_FDiv
  included_FScalMult included_FNth included_FComp : included.

Hints Immediate included_trans included_FPlus' included_FPlus'' included_FInv'
  included_FMinus' included_FMinus'' included_FMult' included_FMult'' included_FRecip'
  included_FDiv' included_FDiv'' included_FScalMult' included_FNth' included_FComp' : included.

Tactic Definition FEQ := Apply eq_imp_Feq; [Included | Included | Intros; Try (Simpl; Rational)].

Section Away_from_Zero.

Section Definitions.

(* Tex_Prose
\section{Away from Zero}

Before we prove our main results about the equality we have to do some work on division.  A function is said to be \emph{bounded away from zero} in a set if there exists a positive lower bound for the set of absolute values of its image of that set.

\begin{convention} Let \verb!I:IR->CProp!, \verb!F:PartIR! and denote by \verb!P! the domain of \verb!F!.
\end{convention}
*)

Variable I:IR->CProp.
Variable F:PartIR.
Local P:=(Pred F).

(* Begin_Tex_Verb *)
Definition bnd_away_zero := (included I P) * ({c:IR & (Zero[<]c) |
  (y:IR)(Hy:(I y))(Hy':(P y))(c[<=](AbsIR (F y Hy')))}).
(* End_Tex_Verb *)

(* Tex_Prose
If $F$ is bounded away from zero in $I$ then $F$ is necessarily apart from zero in $I$; also this means that $I$ is included in the domain of $\frac1F$.
*)

(* Begin_Tex_Verb *)
Hypothesis Hf:bnd_away_zero.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma bnd_imp_ap_zero :
  (x:IR)(Hx:(I x))(Hx':(P x))(F x Hx')[#]Zero.
(* End_Tex_Verb *)
Intros.
Apply AbsIR_cancel_ap_zero.
Apply Greater_imp_ap.
Elim Hf; Intros.
Inversion_clear b.
EApply less_leEq_trans; Auto.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma bnd_imp_inc_recip : (included I (Pred {1/}F)).
(* End_Tex_Verb *)
Red.
Intros.
Elim Hf; Intros.
Split.
Apply (a x H).
Intro.
EApply ap_well_def_lft_unfolded.
Apply (bnd_imp_ap_zero x H H0).
Apply eq_reflexive_unfolded.
Qed.

(* Begin_Tex_Verb *)
Lemma bnd_imp_inc_div : (G:?)(included I (Pred G))->(included I (Pred G{/}F)).
(* End_Tex_Verb *)
Red.
Intros.
Split; Auto.
Elim Hf; Intros.
Split.
Apply (a x H0).
Intro.
EApply ap_well_def_lft_unfolded.
Apply (bnd_imp_ap_zero x H0 H1).
Apply eq_reflexive_unfolded.
Qed.

End Definitions.

(* Tex_Prose
Boundedness away from zero is preserved through restriction of the set.

\begin{convention} Let \verb!F! be a partial function and \verb!P,Q! be predicates.
\end{convention}
*)

Variable F:PartIR.
Variables P,Q:IR->CProp.

(* Begin_Tex_Verb *)
Lemma included_imp_bnd : (included Q P)->
  (bnd_away_zero P F)->(bnd_away_zero Q F).
(* End_Tex_Verb *)
Intros.
Red; Intros.
Inversion_clear H0; Split.
Apply included_trans with P; Auto.
Elim H2; Intros c Hc Hc'.
Exists c; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma FRestr_bnd : (HP,H:?)(included Q P)->
  (bnd_away_zero Q F)->(bnd_away_zero Q (!Frestr F P HP H)).
(* End_Tex_Verb *)
Intros.
Red; Intros.
Inversion_clear H1; Split.
Auto.
Elim H3; Intro c; Intros.
Exists c; Auto.
Simpl; Auto.
Qed.

(* Tex_Prose
A function is said to be bounded away from zero \emph{everywhere} if it is bounded away from zero in every compact subinterval of its domain; a similar definition is made for arbitrary sets, which will be necessary for future work.
*)

(* Begin_Tex_Verb *)
Definition bnd_away_zero_everywhere [G:PartIR] : CProp :=
  (a,b:IR)(Hab:?)(included (compact a b Hab) (Pred G))->
  (bnd_away_zero (compact a b Hab) G).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition bnd_away_zero_in_P : CProp := (a,b:IR)(Hab:?)
  (included (compact a b Hab) P)->
  (bnd_away_zero (compact a b Hab) F).
(* End_Tex_Verb *)

(* Tex_Prose
An immediate consequence:
*)

(* Begin_Tex_Verb *)
Lemma bnd_in_P_imp_ap_zero : (pred_well_def ? P)->
  bnd_away_zero_in_P->
  (x:IR)(P x)->(Hx:?)(F x Hx)[#]Zero.
(* End_Tex_Verb *)
Intros.
Apply bnd_imp_ap_zero with (Compact (leEq_reflexive ? x)).
Apply H0.
Red; Intros.
Cut x[=]x0; Intros.
Apply H with x; Auto.
Inversion_clear H2; Apply leEq_imp_eq; Auto.
Split; Apply leEq_reflexive.
Qed.

(* Begin_Tex_Verb *)
Lemma FRestr_bnd' : (HP,H:?)(bnd_away_zero_everywhere F)->
  (bnd_away_zero_everywhere (!Frestr F P HP H)).
(* End_Tex_Verb *)
Intros.
Red; Intros.
Elim (H0 a b Hab); Intros.
Split.
Auto.
Elim b0; Intro c; Intros.
Exists c; Auto.
Simpl; Auto.
Apply included_trans with P; Simpl in H1; Auto.
Qed.

End Away_from_Zero.

Hints Resolve bnd_imp_inc_recip bnd_imp_inc_div : included.
Hints Immediate bnd_in_P_imp_ap_zero : included.

Section More_on_Equality.

(* Tex_Prose
\section{Properties of Equality}

We are now finally able to prove the main properties of the equality relation.  We begin by showing it to be an equivalence relation.

\begin{convention} Let \verb!I! be a predicate and \verb!F,F',G,G',H! be partial functions.
\end{convention}
*)

Variable I:IR->CProp.

Section Feq_Equivalence.

Variables F,G,H:PartIR.

(* Begin_Tex_Verb *)
Lemma Feq_reflexive : (included I (Pred F))->(Feq I F F).
(* End_Tex_Verb *)
Intro; FEQ.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_symmetric : (Feq I F G)->(Feq I G F).
(* End_Tex_Verb *)
Intro.
Elim H0; Intros H' H1.
Elim H'; Intros incF incG.
FEQ; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_transitive : (Feq I F G)->(Feq I G H)->(Feq I F H).
(* End_Tex_Verb *)
Intro.
Elim H0; Intros H' H1.
Elim H'; Intros incF incG.
Clear H0 H'.
Intro.
Elim H0; Intros H' H2.
Elim H'; Intros incG' incH.
Clear H0 H'.
FEQ.
Step_final (G x (incG x H0)).
Qed.

End Feq_Equivalence.

Section Operations.

(* Tex_Prose
Also it is preserved through application of functional constructors and restriction.
*)

Variables F,F',G,G':PartIR.

(* Begin_Tex_Verb *)
Lemma Feq_plus : (Feq I F F')->(Feq I G G')->
  (Feq I F{+}G F'{+}G').
(* End_Tex_Verb *)
Intros H0 H1.
Elim H0; Intros H0' H2.
Elim H0'; Clear H0 H0'; Intros incF incG.
Elim H1; Intros H1' H0.
Elim H1'; Clear H1 H1'; Intros incF' incG'.
FEQ; Simpl; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_inv : (Feq I F F')->(Feq I {--}F {--}F').
(* End_Tex_Verb *)
Intro H0.
Elim H0; Intros H0' H1.
Elim H0'; Clear H0 H0'; Intros incF incF'.
FEQ; Simpl; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_minus : (Feq I F F')->(Feq I G G')->
  (Feq I F{-}G F'{-}G').
(* End_Tex_Verb *)
Intros H0 H1.
Elim H0; Intros H0' H2.
Elim H0'; Clear H0 H0'; Intros incF incG.
Elim H1; Intros H1' H0.
Elim H1'; Clear H1 H1'; Intros incF' incG'.
FEQ; Simpl; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_mult : (Feq I F F')->(Feq I G G')->
  (Feq I F{*}G F'{*}G').
(* End_Tex_Verb *)
Intros H0 H1.
Elim H0; Intros H0' H2.
Elim H0'; Clear H0 H0'; Intros incF incG.
Elim H1; Intros H1' H0.
Elim H1'; Clear H1 H1'; Intros incF' incG'.
FEQ; Simpl; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_nth : (n:nat)(Feq I F F')->(Feq I F{^}n F'{^}n).
(* End_Tex_Verb *)
Intros n H0.
Elim H0; Intros H0' H1.
Elim H0'; Clear H0 H0'; Intros incF incF'.
FEQ.
Step (F x Hx)[^]n; Step_final (Part F' x Hx')[^]n.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_recip : (bnd_away_zero I F)->(Feq I F F')->
  (Feq I {1/}F {1/}F').
(* End_Tex_Verb *)
Intros Hbnd H0.
Elim H0; Intros H0' H1.
Elim H0'; Clear H0 H0'; Intros incF incF'.
FEQ.
Apply included_FRecip.
Auto.
Intros; Apply ap_well_def_lft_unfolded with (F x (incF x H)).
Apply bnd_imp_ap_zero with I; Assumption.
Auto.
Simpl; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_recip' : (bnd_away_zero I F)->(Feq I F' F)->
  (Feq I {1/}F' {1/}F).
(* End_Tex_Verb *)
Intros.
Apply Feq_symmetric; Apply Feq_recip.
Assumption.
Apply Feq_symmetric; Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_div : (bnd_away_zero I G)->(Feq I F F')->
  (Feq I G G')->(Feq I F{/}G F'{/}G').
(* End_Tex_Verb *)
Intros Hbnd H0 H1.
Elim H0; Intros H0' H2.
Elim H0'; Clear H0 H0'; Intros incF incF'.
Elim H1; Intros H1' H0.
Elim H1'; Clear H1 H1'; Intros incG incG'.
FEQ.
Apply included_FDiv; Auto.
Intros; Apply ap_well_def_lft_unfolded with (G x (incG x H)).
Apply bnd_imp_ap_zero with I; Assumption.
Auto.
Simpl; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma Feq_div' : (bnd_away_zero I G)->(Feq I F' F)->
  (Feq I G' G)->(Feq I F'{/}G' F{/}G).
(* End_Tex_Verb *)
Intros.
Apply Feq_symmetric; Apply Feq_div.
Assumption.
Apply Feq_symmetric; Assumption.
Apply Feq_symmetric; Assumption.
Qed.

(* Tex_Prose
Notice that in the case of division we only need to require boundedness away from zero for one of the functions (as they are equal); thus the two last lemmas are stated in two different ways, as according to the context one or the other condition may be easier to prove.

Finally, the restriction of a function is well defined.
*)

(* Begin_Tex_Verb *)
Lemma FRestr_wd : (Iwd,Hinc:?)(Feq I F (!Frestr F I Iwd Hinc)).
(* End_Tex_Verb *)
Intros.
FEQ.
Qed.

End Operations.

End More_on_Equality.

Section Nth_Power.

(* Tex_Prose
\section{Nth Power}

We finish this group of lemmas with characterization results for the power function (similar to those already proved for arbitrary rings).  The characterization is done at first pointwise and later using the equality relation.

\begin{convention} Let \verb!F! be a partial function with domain \verb!P! and \verb!Q! be a predicate on the real numbers assumed to be included in \verb!P!.
\end{convention}
*)

Variable F:PartIR.
Local P:=(Pred F).

Variable Q:IR->CProp.
Hypothesis H:(included Q [x:IR]CTrue).
Hypothesis Hf:(included Q (Pred F)).

(* Begin_Tex_Verb *)
Lemma FNth_zero : (x:IR)(Q x)->(Hx:?)(Hx':?)
  ({-C-}One x Hx)[=](F{^}O x Hx').
(* End_Tex_Verb *)
Intros.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Variable n:nat.
Hypothesis H':(included Q (Pred F{*}F{^}n)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma FNth_mult : (x:IR)(Q x)->(Hx,Hx':?)
  (F{*}F{^}n x Hx)[=](F{^}(S n) x Hx').
(* End_Tex_Verb *)
Intros.
Simpl.
EApply eq_transitive_unfolded.
2: Apply mult_commutes.
Apply mult_wd.
Rational.
Change (F x (ProjIR2 Hx))[^]n[=](F x Hx')[^]n.
Apply nexp_wd; Rational.
Qed.

End Nth_Power.

Section Strong_Nth_Power.

(* Tex_Prose
\begin{convention} Let \verb!a,b! be real numbers such that \verb!I!$=[a,b]$ is included in the domain of \verb!F!.
\end{convention}
*)

Variables a,b:IR.
Hypothesis Hab:a[<=]b.
Local I:=(compact a b Hab).

Variable F:PartIR.
Hypothesis incF:(included I (Pred F)).

(* Begin_Tex_Verb *)
Lemma FNth_zero' : (Feq I {-C-}One F{^}O).
(* End_Tex_Verb *)
FEQ.
Qed.

(* Begin_Tex_Verb *)
Lemma FNth_mult' : (n:nat)(Feq I F{*}F{^}n F{^}(S n)).
(* End_Tex_Verb *)
Intro; FEQ.
Simpl.
EApply eq_transitive_unfolded.
2: Apply mult_commutes.
Apply bin_op_wd_unfolded.
Rational.
Change (F x (ProjIR2 Hx))[^]n[=](F x Hx')[^]n.
Apply nexp_wd; Rational.
Qed.

End Strong_Nth_Power.


Require Import Coq.NArith.NArith. Open Scope N_scope.
Require Import Frap.Frap.
Require Import Pset2. Notation "x !" := (fact x) (at level 12, format "x !"). (* local in Pset2 *)
Set Default Goal Selector "!".

(* The tactic we introduce in each example is underlined like this. *)
                                             (********************)

Parameter whatever: Prop.

Goal forall (P Q R: Prop) (H1: P) (H2: Q) (IH: P -> Q -> R), R.
Proof.
  simplify.
  apply IH.
 (********)
Abort.

Goal forall (n m k: N), n = m.
Proof.
  simplify.
  Fail apply N.mul_cancel_r.
  apply N.mul_cancel_r with (p := n - k + 1).
 (****)               (****)
Abort.

Goal forall (n m k: N), n = m -> whatever.
Proof.
  simplify.
  apply N.mul_cancel_r with (p := n - k + 1) in H.
 (*****)              (****)                (**)
Abort.

Goal forall (n m k: N), n - k + 1 <> 0 -> n = m -> whatever.
Proof.
  simplify.
  eapply N.mul_cancel_r in H0.
 (******)              (**)
  2: {
    apply H.
  }
Abort.

Goal forall (P Q R S: Prop), (P -> S) -> (R -> S) -> P \/ Q \/ R -> S.
Proof.
  simplify.
  cases H1.
 (*****)
  - apply H. apply H1.
  - admit.
   (*****)
  - apply H0. apply H1.
Fail Qed.
Admitted.
(* Feel free to submit such incomplete proofs, they still get partial credit! *)

Goal forall (f : N -> N) (count : N)
            (IHcount : forall i start : N, i < count -> ith i (seq f count start) = f (start + i))
            (i start : N)
            (H : i < count + 1),
  ith i (f start :: seq f count (start + 1)) = f (start + i).
Proof.
  simplify.
  assert (i = 0 \/ 0 < i) as A. {
 (******)                (**)
    linear_arithmetic.
  }
  cases A.
  - subst. simplify. admit.
   (*****)  (* or "subst i" for just one var *)
  - assert (i = i - 1 + 1) as E by linear_arithmetic. rewrite E.
   (******)                    (**)
    unfold_recurse ith (i - 1).
Abort.

Goal forall (n x0 k: N),
    0 < k ->
    k + 1 < n ->
    n! = x0 * ((n - (k - 1))! * (k - 1)!) ->
    whatever.
Proof.
  intros n m.
 (******)
  intros.
 (******)
  replace (n - (k - 1)) with (n - k + 1) in H1 by linear_arithmetic.
 (*******)             (****)           (**)  (**)
  (* "in" and "by" are optional *)
  unfold_recurse fact (n - k).
Abort.

Goal forall (P Q R: Prop) (H0: Q) (x: N) (H: forall (a b: N), P -> Q -> a < b -> R), whatever.
Proof.
  simplify.
  specialize H with (b := x).
 (**********) (****)
  assert (3 < x) by admit.
  specialize H with (2 := H0) (3 := H1).
Abort.

Goal forall (f : N -> N) (start : N),
    f start = f (start + 0).
Proof.
  simplify.
  rewrite N.add_0_r.
 (*******)
  (* Options like "with (a := 2)", "in H", "by tactic" also work! *)
  equality.
Abort.

Goal forall (f : N -> N) (start : N),
    f start = f (start + 0).
Proof.
  simplify.
  f_equal.
 (*******)
  linear_arithmetic.
Abort.

Goal forall (f : N -> N) (start : N),
    f start = f (start + 0).
Proof.
  simplify.
  (* how many other ways can we find? *)
  assert (start + 0 = start) as E by linear_arithmetic.
  rewrite E.
Abort.

Goal forall (l: list N) (a b: N), ith 1 (a :: b :: l) = b.
Proof.
  intros.
  simplify.
 (********)
 (* unfold if it leads to a simpler term than the right-hand side of the definition *)
Abort.

Goal forall (P: Prop), P -> P.
Proof.
  simplify.
  assumption.
Abort.

Goal forall (n m: N), (n | n * m).
Proof.
  simplify.
  Locate "( _ | _ )".
  unfold N.divide.
 (******)
  exists m.
 (******)
  linear_arithmetic. (* Note: not actually linear *)
 (*****************)
Abort.

Goal forall (A B: Type) (f: A -> B) (a1 a2 a3: A),
    Some a1 = Some a2 ->
    Some a2 = Some a3 ->
    f a3 = f a1.
Proof.
  simplify.
  (* "Replace hypothesis H with other facts that can be deduced from the structure of H's statement".
     Looks at the structure of the arguments passed to the constructor of inductives appearing in H
     and deduces equalities from that, and then substitutes the equalities.
     Also particularly useful for Inductive Props, which we will see later. *)
  invert H.
 (******)
  invert H0.
  equality.
Abort.

Goal forall (A B: Type) (f: A -> B) (a1 a2 a3: A),
    Some a1 = Some a2 ->
    Some a2 = Some a3 ->
    f a3 = f a1.
Proof.
  simplify.
  equality.
 (********)
Abort.

Goal forall (a1 a2 b1 b2: N) (l1 l2: list N),
    a1 :: b1 :: l1 = a2 :: b2 :: l2 ->
    a1 = a2 /\ b1 = b2 /\ l1 = l2.
Proof.
  simplify.
  invert H.
 (******)
Abort.

Goal forall (P: Prop) (a b: N),
    (a < b -> ~P) ->
    P ->
    whatever.
Proof.
  simplify.
  assert (a < b \/ b <= a) as C by linear_arithmetic. cases C.
  - exfalso.
   (*******)
    unfold not in H.
    apply H.
    all: assumption.
Abort.

Goal forall (a : N) (l : list N),
    a :: l = [] ->
    whatever.
Proof.
  simplify.
  discriminate.
 (************)
Abort.

Goal forall (P Q R S T: Prop), (P \/ Q -> T) -> (R \/ S -> T) -> P \/ S -> T.
Proof.
  simplify.
  cases H1.
  - apply H. left. assumption.
  - apply H0. right. assumption.
Abort.

Goal forall (P Q R S T: Prop), (P \/ Q -> T) -> (R \/ S -> T) -> P \/ S -> T.
Proof.
  simplify.
  propositional.
 (*************)
Abort.

(* More tactics to discuss if we still have time:
   - constructor, econstructor
   - eassumption
   - eexists
   - firstorder
   - induct
   - left, right
   - maps_equal
   - trivial
   - transitivity
   - symmetry
*)

(* References:

   - FRAP book Appendix A.2. Tactic Reference (http://adam.chlipala.net/frap/frap_book.pdf)
   - Coq Reference Manual, Chapter on Tactics (https://coq.inria.fr/refman/proof-engine/tactics.html)
*)


Require Import Base.
Require Import BaseProofs.

Require Import Coq.Bool.Bool.
Require Import Coq.Logic.Classical_Prop.
Require Import Coq.Logic.Classical_Pred_Type.
Require Import Coq.Logic.Decidable.

Module Type KeyModuleType.

  Parameter T : Type.
  Parameter equal : T -> T -> bool.
  Parameter eq_refl : forall x, equal x x = true.
  Parameter eq_extensionality : forall x y, equal x y = true -> x = y.

End KeyModuleType.

Module Type ValModuleType.

  Parameter T : Type.
  Parameter equal : T -> T -> bool.
  Parameter eq_refl : forall x, equal x x = true.

End ValModuleType.

Module moduleId <: KeyModuleType.

  Definition T := 𝔵.
  Definition equal : T -> T -> bool := var_eq.

  Lemma eq_refl : forall i, equal i i = true.
  Proof.
    intros. destruct i; simpl; apply nat_eq_refl.
  Qed.

  Lemma eq_extensionality : forall x y, equal x y = true -> x = y.
  Proof.
    intros. induction x; induction y; inversion H;
    apply nat_eq_to_eq in H1; subst n0; reflexivity.
  Qed.

End moduleId.

Module ListCtx
  ( KM : KeyModuleType )
  ( VM : ValModuleType ).

  Definition K : Type := KM.T.
  Definition V : Type := VM.T.

  (* Inductive Definition of Key-Value List *)
  Inductive T : Type :=
  | empty : T
  | append : T -> K -> V -> T.

  Example unittest_T : forall k v, append empty k v <> empty.
  Proof.
    intros. unfold not. intros. inversion H.
  Qed.

  Proposition decide_append_empty : forall s k v,
    empty = append s k v -> False.
  Proof.
    intros. inversion H.
  Qed.

  Definition null : T := empty.

  (* Equality *)
  Lemma equal_commut : forall (m1 m2 : T), m1 = m2 -> m2 = m1.
  Proof.
    intros. rewrite -> H. reflexivity.
  Qed.

  (* List Concat *)
  Fixpoint mult (s s' : T) : T :=
    match s, s' with
    | _, empty => s
    | empty, _ => s'
    | _, append t' k' v' => append (mult s t') k' v'
    end.

  Example unittest_mult : forall k k' v v',
    append (append empty k v) k' v' = mult (append empty k v) (append empty k' v').
  Proof.
    intros. simpl. reflexivity.
  Qed.

  (* Notations *)
  Notation "s1 'o' s2" := (mult s1 s2) (at level 20, left associativity).

  (* Append and Concat *)
  Proposition id_r : forall m, m o null = m.
  Proof.
    intros. induction m; simpl; reflexivity.
  Qed.

  Proposition id_l : forall m, null o m = m.
  Proof.
    intros. induction m; simpl; reflexivity.
  Qed.

  Proposition inverse : forall s1 s2, s1 o s2 = null -> s1 = null /\ s2 = null.
  Proof.
    intros. induction s1; induction s2; auto.
    simpl in H. inversion H.
  Qed.

  Proposition append_to_concat : forall s' k v,
    append s' k v = s' o (append empty k v).
  Proof.
    intros s. induction s.
    - intros. rewrite -> id_l. reflexivity.
    - intros k' v'. simpl. reflexivity.
  Qed.

  Proposition append_concat : forall s1 s2 s' k v,
    s2 = append s' k v ->
    s1 o s2 = append (s1 o s') k v.
  Proof.
    intros s1. induction s1.
    - intros. rewrite -> id_l. rewrite -> id_l. apply H.
    - intros s2 s' k' v' H. subst s2. simpl. reflexivity.
  Qed.

  (* Associativity of Concat *)
  Lemma assoc : forall m1 m2 m3, (m1 o m2) o m3 = m1 o (m2 o m3).
  Proof.
    intros m1; induction m1; intros m2; induction m2; intros m3; induction m3; simpl; try reflexivity.
    rewrite <- IHm3. simpl. reflexivity.
  Qed.

  (* Membership *)
  Inductive contains : T -> K -> V -> Prop :=
  | contains_append : forall s s' k v, s = append s' k v -> contains s k v
  | contains_append_set : forall s' k v k' v',
    contains s' k' v' -> k <> k' -> contains (append s' k v) k' v'.

  Example unittest_contains_overwrite : forall s k k' v v' v'',
    k <> k' ->
    s = append (append (append empty k v) k' v') k v'' ->
    contains s k v. (* We must not be able to prove this. *)
  Proof.
    intros. rewrite -> H0. try apply contains_append. apply contains_append_set.
  Abort.

  Example unittest_contains_overwrite' : forall s k k' v v' v'',
    k <> k' ->
    s = append (append (append empty k' v) k' v') k v'' ->
    contains s k' v. (* We must not be able to prove this. *)
  Proof.
    intros. rewrite -> H0. try apply contains_append. apply contains_append_set; try apply H.
    try apply contains_append. apply contains_append_set.
  Abort.

  (* Contains Key *)
  Inductive contains_key : T -> K -> Prop :=
    contains_key_contains : forall (A : T) (k : K) (v : V),
      contains A k v -> contains_key A k.

  Proposition contains_key_extend : forall (A : T) (k k' : K) (v' : V),
    contains_key A k -> contains_key (append A k' v') k.
  Proof.
    intros. inversion H.
    assert (Hkk' : k = k' \/ k <> k'). { apply classic. } inversion Hkk'.
    - assert (Hkv' : contains (append A k' v') k v').
      { apply contains_append with (s' := A). rewrite <- H3. reflexivity. }
      apply contains_key_contains with (v := v'). apply Hkv'.
    - assert (Hkv : contains (append A k' v') k v).
      { apply contains_append_set; auto. }
      apply contains_key_contains with (v := v). apply Hkv.
  Qed.

  Corollary not_contains_key_shrink : forall (A : T) (k k' : K) (v' : V),
    ~ contains_key (append A k' v') k -> ~ contains_key A k.
  Proof.
    intros. unfold not in H. unfold not. intros Hfalse.
    apply contains_key_extend with (k' := k') (v' := v') in Hfalse. apply H in Hfalse.
    inversion Hfalse.
  Qed.

  (* Union *)
  Lemma union_l : forall (B C : T) (k : K) (v : V),
    contains B k v -> ~ contains_key C k -> contains (B o C) k v.
  Proof.
    intros. induction C.
    - rewrite -> id_r. apply H.
    - assert (HX : B o append C k0 v0 = append (B o C) k0 v0).
      { apply append_concat. reflexivity. } rewrite -> HX.
      apply contains_append_set.
      + apply not_contains_key_shrink in H0. apply IHC in H0. auto.
      + unfold not. unfold not in H0. revert H0. rewrite -> contrapositive.
        * intros Hkk. rewrite -> Hkk. eapply contains_key_contains. eapply contains_append. reflexivity.
        * unfold decidable. apply classic.
  Qed.

  Lemma union_r : forall (B C : T) (k : K) (v : V),
    contains C k v -> contains (B o C) k v.
  Proof.
    intros. induction H.
    - rewrite -> H.
      assert (HX : B o append s' k v = append (B o s') k v).
      { apply append_concat. reflexivity. } rewrite -> HX.
      eapply contains_append. reflexivity.
    - assert (HX : B o append s' k v = append (B o s') k v).
      { apply append_concat. reflexivity. } rewrite -> HX.
      apply contains_append_set. apply IHcontains. auto.
  Qed.

  Lemma reunion : forall (B C : T) (k : K) (v : V),
    contains (B o C) k v -> contains B k v \/ contains C k v.
  Proof.
    intros. induction C.
    - left. rewrite -> id_r in H. apply H.
    - assert (HX : B o append C k0 v0 = append (B o C) k0 v0).
      { apply append_concat. reflexivity. } rewrite -> HX in H.
      inversion H.
      + subst k1 v1. inversion H0. subst k0 v0 s'.
        right. eapply contains_append. reflexivity.
      + subst s' k1 v1 k' v'. apply IHC in H5. inversion H5.
        * left. apply H0.
        * right. apply contains_append_set. apply H0. auto.
  Qed.

  (* Equivalence *)
  Definition subseteq (A B : T) : Prop :=
    forall (k : K) (v : V), contains A k v -> contains B k v.

  Definition eq (s s' : T) : Prop := subseteq s s' /\ subseteq s' s.

  Notation "s1 '≡' s2" := (eq s1 s2) (at level 82, left associativity).

  (* Equivalence Relation Axioms *)
  Proposition subseteq_reflexivity : forall m, subseteq m m.
  Proof.
    intros. unfold subseteq. intros k v. intros H. apply H.
  Qed.

  Proposition subseteq_transitivity : forall m1 m2 m3,
    subseteq m1 m2 -> subseteq m2 m3 -> subseteq m1 m3.
  Proof.
    intros m1 m2 m3 H H'. unfold subseteq in H. unfold subseteq in H'.
    unfold subseteq. intros k' v'. intros H''. apply H in H''.
    apply H' in H''. apply H''.
  Qed.

  Proposition eq_reflexivity : forall m, m ≡ m.
  Proof.
    intros. split; apply subseteq_reflexivity.
  Qed.

  Proposition eq_symmetry : forall m1 m2, m1 ≡ m2 -> m2 ≡ m1.
  Proof.
    intros. inversion H. split; try apply H0; try apply H1.
  Qed.

  Proposition eq_transitivity : forall m1 m2 m3,
    m1 ≡ m2 -> m2 ≡ m3 -> m1 ≡ m3.
  Proof.
    intros m1 m2 m3 H H'. inversion H. inversion H'.
    apply subseteq_transitivity with (m1 := m1) (m2 := m2) (m3 := m3) in H0.
    apply subseteq_transitivity with (m1 := m3) (m2 := m2) (m3 := m1) in H3.
    - split; try apply H0; try apply H3.
    - apply H1.
    - apply H2.
  Qed.

  (* Duplicate Keys *)
  Inductive duplicated : T -> Prop :=
  | duplicated_append : forall (A : T) (k : K) (v' : V),
      contains_key A k -> duplicated (append A k v')
  | duplicated_extend : forall (A : T) (k : K) (v' : V),
      duplicated A -> duplicated (append A k v').

  Definition unique_paired (A : T) : Prop := ~ duplicated A.

  Proposition unique_paired_shrink : forall (A : T) (k : K) (v : V),
    unique_paired (append A k v) -> unique_paired A.
  Proof.
    intros. unfold unique_paired. unfold not. unfold unique_paired in H. unfold not in H. revert H.
    apply contrapositive. { unfold decidable. apply classic. } apply duplicated_extend.
  Qed.

  Lemma unique_paired_either_or : forall (A B : T) (k : K),
    unique_paired (A o B) -> contains_key A k -> ~ contains_key B k.
  Proof.
    intros A B k Hu HcAk. unfold not. intros HcBk. induction B.
    - inversion HcBk. inversion H. inversion H2.
    - assert (Hu' : unique_paired (A o append B k0 v)). { auto. }
      rewrite -> append_concat with (s' := B) (k := k0) (v := v) in Hu; auto.
      apply unique_paired_shrink in Hu. apply IHB in Hu; auto. inversion HcBk. inversion H.
  Admitted.

  Lemma unique_paired_or_either : forall (A B : T) (k : K),
    unique_paired (A o B) -> contains_key B k -> ~ contains_key A k.
  Admitted.

  (* Well-Definedness and Contains Uniqueness *)
  Inductive ill_defined : T -> Prop :=
    duplicate_values : forall (A : T) (k : K) (v v' : V),
      contains A k v -> contains A k v' -> v <> v' -> ill_defined A.

  Definition well_defined (A : T) : Prop := ~ ill_defined A.

  Lemma contains_unique : forall (A : T) (k : K),
    well_defined A -> contains_key A k -> (exists! (v : V), contains A k v).
  Proof.
    intros A k H H'. inversion H'. subst A0 k0. exists v. unfold unique. split.
    - apply H0.
    - intros v'. unfold well_defined in H. unfold not in H. intros.
      (* reductio ad absurdum *)
      assert (Hx : v = v' \/ v <> v'). { apply classic. }
      inversion Hx; try apply H2. assert (Hf : ill_defined A).
      { eapply duplicate_values. apply H0. apply H1. apply H2. }
      apply H in Hf. inversion Hf.
  Qed.

  Fixpoint to_function (A : T) (none : V) (k : K) : V :=
    match A with
    | append B k' v' => if KM.equal k k' then v' else to_function B none k
    | empty => none
    end.

  (* Commutativity *)
  Lemma eq_commut : forall (B C : T), unique_paired (B o C) -> B o C ≡ C o B.
  Proof.
    intros B C Hwd. unfold eq. split.
    - unfold subseteq. intros. apply reunion in H. inversion H.
      + apply union_r. apply H0.
      + apply union_l. apply H0. eapply unique_paired_or_either. apply Hwd.
        eapply contains_key_contains. apply H0.
    - unfold subseteq. intros. apply reunion in H. inversion H.
      + apply union_r. apply H0.
      + apply union_l. apply H0. eapply unique_paired_either_or. apply Hwd.
        eapply contains_key_contains. apply H0.
  Qed.

  (* Axioms of Extionsionality *)
  Axiom extensionality : forall (A B : T), eq A B -> A = B.

  Lemma extensionality_converse : forall (A B : T), A = B -> eq A B.
  Proof.
    intros. rewrite <- H. apply eq_reflexivity.
  Qed.

  Lemma extensionality_inverse : forall (A B : T), ~ eq A B -> A <> B.
  Proof.
    intros. unfold not. intros Hf. apply extensionality_converse in Hf.
    apply H in Hf. apply Hf.
  Qed.

  Lemma extensionality_contraposition : forall (A B : T), A <> B -> ~ eq A B.
  Proof.
    intros. unfold not. intros Hf. apply extensionality in Hf.
    unfold not in H. apply H in Hf. apply Hf.
  Qed.

  (* Commutativity *)
  Lemma commut : forall (B C : T), unique_paired (B o C) -> B o C = C o B.
  Proof.
    intros. apply extensionality. apply eq_commut. auto.
  Qed.

  (* Exchange *)
  Lemma exchange : forall A B C D, unique_paired (B o C) -> A o B o C o D = A o C o B o D.
  Proof.
    intros A B C D Hu.
    assert (H : B o C = C o B). { apply commut. auto. }
    assert (H' : B o (C o D) = C o (B o D)).
      { repeat rewrite <- assoc. rewrite -> H. reflexivity. }
    repeat rewrite -> assoc. rewrite -> H'. reflexivity.
  Qed.

  Proposition append_commut : forall s k v k' v',
      unique_paired (append empty k v o append empty k' v') ->
      append (append s k v) k' v' = append (append s k' v') k v.
  Proof.
    intros. rewrite -> append_to_concat. rewrite -> append_to_concat.
    rewrite <- id_r with (m := s o (append empty k v) o (append empty k' v')).
    rewrite -> exchange; auto. rewrite -> id_r. repeat rewrite <- append_to_concat.
    reflexivity.
  Qed.

  Proposition append_commut_weak : forall s k v k' v',
      k <> k' -> append (append s k v) k' v' = append (append s k' v') k v.
  Proof.
    intros. apply extensionality. unfold eq. split.
    - unfold subseteq. intros k'' v'' H''. inversion H''; try inversion H5.
      + inversion H0. apply contains_append_set. apply contains_append with (s' := s). reflexivity. intros [=].
        rewrite <- H8 in H6. rewrite -> H6 in H. unfold not in H. apply H. reflexivity.
      + inversion H7. eapply contains_append. reflexivity.
      + apply contains_append_set; auto. apply contains_append_set; auto.
    - unfold subseteq. intros k'' v'' H''. inversion H''; try inversion H5.
      + inversion H0. apply contains_append_set. apply contains_append with (s' := s). reflexivity. intros [=].
        rewrite <- H8 in H6. rewrite -> H6 in H. unfold not in H. apply H. reflexivity.
      + inversion H7. eapply contains_append. reflexivity.
      + apply contains_append_set; auto. apply contains_append_set; auto.
  Qed.

  (* Remove Key *)
  Fixpoint remove (A : T) (k : K) : T :=
    match A with
    | append B k' v' =>
      if KM.equal k k' then remove B k else append (remove B k) k' v'
    | empty => empty
    end.

  Lemma remove_not_contains : forall A k, ~ contains_key (remove A k) k.
  Proof.
    intros A. induction A.
    - intros k. unfold not. intros Hf. simpl in Hf. inversion Hf. inversion H. inversion H2.
    - intros k'. unfold not. intros Hf.
      assert (Ht : KM.equal k' k = true \/ KM.equal k' k <> true). { apply classic. }
      inversion Ht.
      + simpl in Hf. rewrite -> H in Hf. apply IHA in Hf. apply Hf.
      + simpl in Hf. apply not_true_iff_false in H. rewrite -> H in Hf.
        inversion Hf. subst A0 k0. inversion H0.
        * subst k0 v1. inversion H1. subst k'.
          assert (H' : KM.equal k k = true). { apply KM.eq_refl. }
          rewrite -> H in H'. apply diff_false_true in H'. apply H'.
        * subst s' k0 v1 k'0 v0. apply contains_key_contains in H6.
          apply IHA in H6. apply H6.
  Qed.

  Proposition empty_contains_key : forall k, contains_key empty k -> False.
  Proof.
    intros. inversion H. inversion H0. inversion H3.
  Qed.

  Lemma remove_not_contained : forall (A : T) (k : K),
    ~ contains_key A k -> remove A k = A.
  Proof.
    intros A. induction A.
    - intros. simpl. reflexivity.
    - intros k' H. unfold not in H.
      assert (Ht : KM.equal k' k = true \/ KM.equal k' k <> true). { apply classic. }
      inversion Ht.
      + assert (Hf : contains (append A k v) k v). { eapply contains_append. reflexivity. }
        apply KM.eq_extensionality in H0. subst k'. apply contains_key_contains in Hf.
        apply H in Hf. inversion Hf.
      + simpl in H. apply not_true_iff_false in H0. simpl. rewrite -> H0.
        assert (HX : ~ contains_key A k').
        { unfold not. intros Hf. inversion Hf. subst A0 k0.
          assert (HX' : contains (append A k v) k' v0).
          { apply contains_append_set. apply H1. unfold not. intros Hfalse. rewrite <- Hfalse in H0.
            rewrite -> KM.eq_refl in H0. inversion H0. }
          apply contains_key_contains in HX'. apply H in HX'. apply HX'. }
        apply IHA in HX. rewrite -> HX. reflexivity.
  Qed.

  Corollary remove_empty : forall (k : K), remove empty k = empty.
  Proof.
    intros. apply remove_not_contained. unfold not. intros. inversion H.
    inversion H0. inversion H3.
  Qed.

  (* Remove Pair Once *)
  Fixpoint remove_pair (A : T) (k : K) (v : V) : T :=
    match A with
    | append B k' v' =>
      if andb (KM.equal k k') (VM.equal v v')
      then B
      else append (remove_pair B k v) k' v'
    | empty => empty
    end.

  Proposition remove_not_contained_pair : forall (A : T) (k : K) (v : V),
    ~ contains A k v -> remove_pair A k v = A.
  Proof.
    intros A. induction A.
    - intros. simpl. auto.
    - intros. unfold not in H.
  Admitted.

  (* Set Minus *)
  Fixpoint set_minus (s s' : T) : T :=
    match s' with
    | empty => s
    | append t' k' v' => set_minus (remove_pair s k' v') t'
    end.

  Lemma set_minus_right_eliminate : forall A B k v,
    set_minus (append A k v) (append B k v) = set_minus A B.
  Proof.
    intros. simpl. rewrite -> KM.eq_refl. rewrite -> VM.eq_refl.
    simpl. auto.
  Qed.

  Proposition set_minus_append_non_member : forall G G' k v,
    ~ contains G k v ->
    set_minus G (append G' k v) = set_minus G G'.
  Proof.
    intros. simpl. rewrite -> remove_not_contained_pair; auto.
  Qed.

End ListCtx.


From Hammer Require Import Hammer.

Require Import Bool.
Require Import RelationPairs.
Require Export NStrongRec.

Module NdefOpsProp (Import N : NAxiomsRecSig').
Include NStrongRecProp N.

Definition if_zero (A : Type) (a b : A) (n : N.t) : A :=
recursion a (fun _ _ => b) n.

Arguments if_zero [A] a b n.

Instance if_zero_wd (A : Type) :
Proper (Logic.eq ==> Logic.eq ==> N.eq ==> Logic.eq) (@if_zero A).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.if_zero_wd".
unfold if_zero.
f_equiv'.
Qed.

Theorem if_zero_0 : forall (A : Type) (a b : A), if_zero a b 0 = a.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.if_zero_0".
unfold if_zero; intros; now rewrite recursion_0.
Qed.

Theorem if_zero_succ :
forall (A : Type) (a b : A) (n : N.t), if_zero a b (S n) = b.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.if_zero_succ".
intros; unfold if_zero.
now rewrite recursion_succ.
Qed.

Definition def_add (x y : N.t) := recursion y (fun _ => S) x.

Local Infix "+++" := def_add (at level 50, left associativity).

Instance def_add_wd : Proper (N.eq ==> N.eq ==> N.eq) def_add.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.def_add_wd".
unfold def_add. f_equiv'.
Qed.

Theorem def_add_0_l : forall y, 0 +++ y == y.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.def_add_0_l".
intro y. unfold def_add. now rewrite recursion_0.
Qed.

Theorem def_add_succ_l : forall x y, S x +++ y == S (x +++ y).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.def_add_succ_l".
intros x y; unfold def_add.
rewrite recursion_succ; f_equiv'.
Qed.

Theorem def_add_add : forall n m, n +++ m == n + m.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.def_add_add".
intros n m; induct n.
now rewrite def_add_0_l, add_0_l.
intros n H. now rewrite def_add_succ_l, add_succ_l, H.
Qed.

Definition def_mul (x y : N.t) := recursion 0 (fun _ p => p +++ x) y.

Local Infix "**" := def_mul (at level 40, left associativity).

Instance def_mul_wd : Proper (N.eq ==> N.eq ==> N.eq) def_mul.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.def_mul_wd".
unfold def_mul.
f_equiv'.
Qed.

Theorem def_mul_0_r : forall x, x ** 0 == 0.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.def_mul_0_r".
intro. unfold def_mul. now rewrite recursion_0.
Qed.

Theorem def_mul_succ_r : forall x y, x ** S y == x ** y +++ x.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.def_mul_succ_r".
intros x y; unfold def_mul.
rewrite recursion_succ; auto with *.
f_equiv'.
Qed.

Theorem def_mul_mul : forall n m, n ** m == n * m.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.def_mul_mul".
intros n m; induct m.
now rewrite def_mul_0_r, mul_0_r.
intros m IH; now rewrite def_mul_succ_r, mul_succ_r, def_add_add, IH.
Qed.

Definition ltb (m : N.t) : N.t -> bool :=
recursion
(if_zero false true)
(fun _ f n => recursion false (fun n' _ => f n') n)
m.

Local Infix "<<" := ltb (at level 70, no associativity).

Instance ltb_wd : Proper (N.eq ==> N.eq ==> Logic.eq) ltb.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.ltb_wd".
unfold ltb. f_equiv'.
Qed.

Theorem ltb_base : forall n, 0 << n = if_zero false true n.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.ltb_base".
intro n; unfold ltb; now rewrite recursion_0.
Qed.

Theorem ltb_step :
forall m n, S m << n = recursion false (fun n' _ => m << n') n.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.ltb_step".
intros m n; unfold ltb at 1.
f_equiv.
rewrite recursion_succ; f_equiv'.
Qed.

Theorem ltb_0 : forall n, n << 0 = false.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.ltb_0".
cases n.
rewrite ltb_base; now rewrite if_zero_0.
intro n; rewrite ltb_step. now rewrite recursion_0.
Qed.

Theorem ltb_0_succ : forall n, 0 << S n = true.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.ltb_0_succ".
intro n; rewrite ltb_base; now rewrite if_zero_succ.
Qed.

Theorem succ_ltb_mono : forall n m, (S n << S m) = (n << m).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.succ_ltb_mono".
intros n m.
rewrite ltb_step. rewrite recursion_succ; f_equiv'.
Qed.

Theorem ltb_lt : forall n m, n << m = true <-> n < m.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.ltb_lt".
double_induct n m.
cases m.
rewrite ltb_0. split; intro H; [discriminate H | false_hyp H nlt_0_r].
intro n. rewrite ltb_0_succ. split; intro; [apply lt_0_succ | reflexivity].
intro n. rewrite ltb_0. split; intro H; [discriminate | false_hyp H nlt_0_r].
intros n m. rewrite succ_ltb_mono. now rewrite <- succ_lt_mono.
Qed.

Theorem ltb_ge : forall n m, n << m = false <-> n >= m.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.ltb_ge".
intros. rewrite <- not_true_iff_false, ltb_lt. apply nlt_ge.
Qed.

Definition even (x : N.t) := recursion true (fun _ p => negb p) x.

Instance even_wd : Proper (N.eq==>Logic.eq) even.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.even_wd".
unfold even. f_equiv'.
Qed.

Theorem even_0 : even 0 = true.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.even_0".
unfold even.
now rewrite recursion_0.
Qed.

Theorem even_succ : forall x, even (S x) = negb (even x).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.even_succ".
unfold even.
intro x; rewrite recursion_succ; f_equiv'.
Qed.

Definition half_aux (x : N.t) : N.t * N.t :=
recursion (0, 0) (fun _ p => let (x1, x2) := p in (S x2, x1)) x.

Definition half (x : N.t) := snd (half_aux x).

Instance half_aux_wd : Proper (N.eq ==> N.eq*N.eq) half_aux.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_aux_wd".
intros x x' Hx. unfold half_aux.
f_equiv; trivial.
intros y y' Hy (u,v) (u',v') (Hu,Hv). compute in *.
rewrite Hu, Hv; auto with *.
Qed.

Instance half_wd : Proper (N.eq==>N.eq) half.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_wd".
unfold half. f_equiv'.
Qed.

Lemma half_aux_0 : half_aux 0 = (0,0).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_aux_0".
unfold half_aux. rewrite recursion_0; auto.
Qed.

Lemma half_aux_succ : forall x,
half_aux (S x) = (S (snd (half_aux x)), fst (half_aux x)).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_aux_succ".
intros.
remember (half_aux x) as h.
destruct h as (f,s); simpl in *.
unfold half_aux in *.
rewrite recursion_succ, <- Heqh; simpl; f_equiv'.
Qed.

Theorem half_aux_spec : forall n,
n == fst (half_aux n) + snd (half_aux n).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_aux_spec".
apply induction.
intros x x' Hx. setoid_rewrite Hx; auto with *.
rewrite half_aux_0; simpl; rewrite add_0_l; auto with *.
intros.
rewrite half_aux_succ. simpl.
rewrite add_succ_l, add_comm; auto.
now f_equiv.
Qed.

Theorem half_aux_spec2 : forall n,
fst (half_aux n) == snd (half_aux n) \/
fst (half_aux n) == S (snd (half_aux n)).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_aux_spec2".
apply induction.
intros x x' Hx. setoid_rewrite Hx; auto with *.
rewrite half_aux_0; simpl. auto with *.
intros.
rewrite half_aux_succ; simpl.
destruct H; auto with *.
right; now f_equiv.
Qed.

Theorem half_0 : half 0 == 0.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_0".
unfold half. rewrite half_aux_0; simpl; auto with *.
Qed.

Theorem half_1 : half 1 == 0.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_1".
unfold half. rewrite one_succ, half_aux_succ, half_aux_0; simpl; auto with *.
Qed.

Theorem half_double : forall n,
n == 2 * half n \/ n == 1 + 2 * half n.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_double".
intros. unfold half.
nzsimpl'.
destruct (half_aux_spec2 n) as [H|H]; [left|right].
rewrite <- H at 1. apply half_aux_spec.
rewrite <- add_succ_l. rewrite <- H at 1. apply half_aux_spec.
Qed.

Theorem half_upper_bound : forall n, 2 * half n <= n.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_upper_bound".
intros.
destruct (half_double n) as [E|E]; rewrite E at 2.
apply le_refl.
nzsimpl.
apply le_le_succ_r, le_refl.
Qed.

Theorem half_lower_bound : forall n, n <= 1 + 2 * half n.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_lower_bound".
intros.
destruct (half_double n) as [E|E]; rewrite E at 1.
nzsimpl.
apply le_le_succ_r, le_refl.
apply le_refl.
Qed.

Theorem half_nz : forall n, 1 < n -> 0 < half n.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_nz".
intros n LT.
assert (LE : 0 <= half n) by apply le_0_l.
le_elim LE; auto.
destruct (half_double n) as [E|E];
rewrite <- LE, mul_0_r, ?add_0_r in E; rewrite E in LT.
order'.
order.
Qed.

Theorem half_decrease : forall n, 0 < n -> half n < n.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.half_decrease".
intros n LT.
destruct (half_double n) as [E|E]; rewrite E at 2; nzsimpl'.
rewrite <- add_0_l at 1.
rewrite <- add_lt_mono_r.
assert (LE : 0 <= half n) by apply le_0_l.
le_elim LE; auto.
rewrite <- LE, mul_0_r in E. rewrite E in LT. destruct (nlt_0_r _ LT).
rewrite <- add_succ_l.
rewrite <- add_0_l at 1.
rewrite <- add_lt_mono_r.
apply lt_0_succ.
Qed.

Definition pow (n m : N.t) := recursion 1 (fun _ r => n*r) m.

Local Infix "^^" := pow (at level 30, right associativity).

Instance pow_wd : Proper (N.eq==>N.eq==>N.eq) pow.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.pow_wd".
unfold pow. f_equiv'.
Qed.

Lemma pow_0 : forall n, n^^0 == 1.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.pow_0".
intros. unfold pow. rewrite recursion_0. auto with *.
Qed.

Lemma pow_succ : forall n m, n^^(S m) == n*(n^^m).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.pow_succ".
intros. unfold pow. rewrite recursion_succ; f_equiv'.
Qed.

Definition log (x : N.t) : N.t :=
strong_rec 0
(fun g x =>
if x << 2 then 0
else S (g (half x)))
x.

Instance log_prewd :
Proper ((N.eq==>N.eq)==>N.eq==>N.eq)
(fun g x => if x<<2 then 0 else S (g (half x))).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.log_prewd".
intros g g' Hg n n' Hn.
rewrite Hn.
destruct (n' << 2); auto with *.
f_equiv. apply Hg. now f_equiv.
Qed.

Instance log_wd : Proper (N.eq==>N.eq) log.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.log_wd".
intros x x' Exx'. unfold log.
apply strong_rec_wd; f_equiv'.
Qed.

Lemma log_good_step : forall n h1 h2,
(forall m, m < n -> h1 m == h2 m) ->
(if n << 2 then 0 else S (h1 (half n))) ==
(if n << 2 then 0 else S (h2 (half n))).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.log_good_step".
intros n h1 h2 E.
destruct (n<<2) eqn:H.
auto with *.
f_equiv. apply E, half_decrease.
rewrite two_succ, <- not_true_iff_false, ltb_lt, nlt_ge, le_succ_l in H.
order'.
Qed.
Hint Resolve log_good_step.

Theorem log_init : forall n, n < 2 -> log n == 0.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.log_init".
intros n Hn. unfold log. rewrite strong_rec_fixpoint; auto with *.
replace (n << 2) with true; auto with *.
symmetry. now rewrite ltb_lt.
Qed.

Theorem log_step : forall n, 2 <= n -> log n == S (log (half n)).
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.log_step".
intros n Hn. unfold log. rewrite strong_rec_fixpoint; auto with *.
replace (n << 2) with false; auto with *.
symmetry. rewrite <- not_true_iff_false, ltb_lt, nlt_ge; auto.
Qed.

Theorem pow2_log : forall n, 0 < n -> half n < 2^^(log n) <= n.
Proof. hammer_hook "NDefOps" "NDefOps.NdefOpsProp.pow2_log".
intro n; generalize (le_refl n). set (k:=n) at -2. clearbody k.
revert k. pattern n. apply induction; clear n.
intros n n' Hn; setoid_rewrite Hn; auto with *.
intros k Hk1 Hk2.
le_elim Hk1. destruct (nlt_0_r _ Hk1).
rewrite Hk1 in Hk2. destruct (nlt_0_r _ Hk2).

intros n IH k Hk1 Hk2.
destruct (lt_ge_cases k 2) as [LT|LE].

rewrite log_init, pow_0 by auto.
rewrite <- le_succ_l, <- one_succ in Hk2.
le_elim Hk2.
rewrite two_succ, <- nle_gt, le_succ_l in LT. destruct LT; auto.
rewrite <- Hk2.
rewrite half_1; auto using lt_0_1, le_refl.

rewrite log_step, pow_succ by auto.
rewrite two_succ, le_succ_l in LE.
destruct (IH (half k)) as (IH1,IH2).
rewrite <- lt_succ_r. apply lt_le_trans with k; auto.
now apply half_decrease.
apply half_nz; auto.
set (K:=2^^log (half k)) in *; clearbody K.
split.
rewrite <- le_succ_l in IH1.
apply mul_le_mono_l with (p:=2) in IH1.
eapply lt_le_trans; eauto.
nzsimpl'.
rewrite lt_succ_r.
eapply le_trans; [ eapply half_lower_bound | ].
nzsimpl'; apply le_refl.
eapply le_trans; [ | eapply half_upper_bound ].
apply mul_le_mono_l; auto.
Qed.

End NdefOpsProp.