aboutsummaryrefslogtreecommitdiffhomepage
path: root/theories/Numbers/Natural/Abstract/NMiscFunct.v
diff options
context:
space:
mode:
Diffstat (limited to 'theories/Numbers/Natural/Abstract/NMiscFunct.v')
-rw-r--r--theories/Numbers/Natural/Abstract/NMiscFunct.v398
1 files changed, 0 insertions, 398 deletions
diff --git a/theories/Numbers/Natural/Abstract/NMiscFunct.v b/theories/Numbers/Natural/Abstract/NMiscFunct.v
deleted file mode 100644
index 4333d9e46..000000000
--- a/theories/Numbers/Natural/Abstract/NMiscFunct.v
+++ /dev/null
@@ -1,398 +0,0 @@
-Require Import Bool. (* To get the orb and negb function *)
-Require Export NStrongRec.
-Require Export NTimesOrder.
-
-Module MiscFunctFunctor (Import NatMod : NBaseSig).
-Module Export StrongRecPropertiesModule := StrongRecProperties NatMod.
-Open Local Scope NatScope.
-
-(*****************************************************)
-(** Addition *)
-
-Definition plus (x y : N) := recursion y (fun _ p => S p) x.
-
-Lemma plus_step_wd : fun2_wd E E E (fun _ p => S p).
-Proof.
-unfold fun2_wd; intros _ _ _ p p' H; now rewrite H.
-Qed.
-
-Add Morphism plus with signature E ==> E ==> E as plus_wd.
-Proof.
-unfold plus.
-intros x x' Exx' y y' Eyy'.
-apply recursion_wd with (EA := E).
-assumption.
-unfold eq_fun2; intros _ _ _ p p' Epp'; now rewrite Epp'.
-assumption.
-Qed.
-
-Theorem plus_0 : forall y, plus 0 y == y.
-Proof.
-intro y. unfold plus.
-(*pose proof (recursion_0 E y (fun _ p => S p)) as H.*)
-rewrite recursion_0. apply (proj1 E_equiv).
-Qed.
-
-Theorem plus_succ : forall x y, plus (S x) y == S (plus x y).
-Proof.
-intros x y; unfold plus.
-now rewrite (recursion_succ E); [|apply plus_step_wd|].
-Qed.
-
-(*****************************************************)
-(** Multiplication *)
-
-Definition times (x y : N) := recursion 0 (fun _ p => plus p x) y.
-
-Lemma times_step_wd : forall x, fun2_wd E E E (fun _ p => plus p x).
-Proof.
-unfold fun2_wd. intros. now apply plus_wd.
-Qed.
-
-Lemma times_step_equal :
- forall x x', x == x' -> eq_fun2 E E E (fun _ p => plus p x) (fun x p => plus p x').
-Proof.
-unfold eq_fun2; intros; apply plus_wd; assumption.
-Qed.
-
-Add Morphism times with signature E ==> E ==> E as times_wd.
-Proof.
-unfold times.
-intros x x' Exx' y y' Eyy'.
-apply recursion_wd with (EA := E).
-reflexivity. apply times_step_equal. assumption. assumption.
-Qed.
-
-Theorem times_0_r : forall x, times x 0 == 0.
-Proof.
-intro. unfold times. now rewrite recursion_0.
-Qed.
-
-Theorem times_succ_r : forall x y, times x (S y) == plus (times x y) x.
-Proof.
-intros x y; unfold times.
-now rewrite (recursion_succ E); [| apply times_step_wd |].
-Qed.
-
-(*****************************************************)
-(** Less Than *)
-
-Definition lt (m : N) : N -> bool :=
- recursion (if_zero false true)
- (fun _ f => fun n => recursion false (fun n' _ => f n') n)
- m.
-
-(* It would be more efficient to make a three-way comparison, i.e.,
-return Eq, Lt, or Gt, but since these are no-use default functions,
-we define <= as (< or =) *)
-Definition le (n m : N) := lt n m || e n m.
-
-Theorem le_lt : forall n m, le n m <-> lt n m \/ n == m.
-Proof.
-intros n m. rewrite E_equiv_e. unfold le.
-do 3 rewrite eq_true_unfold_pos.
-assert (H : lt n m || e n m = true <-> lt n m = true \/ e n m = true).
-split; [apply orb_prop | apply orb_true_intro].
-now rewrite H.
-Qed.
-
-Theorem le_intro_left : forall n m, lt n m -> le n m.
-Proof.
-intros; rewrite le_lt; now left.
-Qed.
-
-Theorem le_intro_right : forall n m, n == m -> le n m.
-Proof.
-intros; rewrite le_lt; now right.
-Qed.
-
-Lemma lt_base_wd : eq_fun E eq_bool (if_zero false true) (if_zero false true).
-unfold eq_fun, eq_bool; intros; apply if_zero_wd; now unfold LE_succet.
-Qed.
-
-Lemma lt_step_wd :
- let step := (fun _ f => fun n => recursion false (fun n' _ => f n') n) in
- eq_fun2 E (eq_fun E eq_bool) (eq_fun E eq_bool) step step.
-Proof.
-unfold eq_fun2, eq_fun, eq_bool.
-intros x x' Exx' f f' Eff' y y' Eyy'.
-apply recursion_wd with (EA := eq_bool); unfold eq_bool.
-reflexivity.
-unfold eq_fun2; intros; now apply Eff'.
-assumption.
-Qed.
-
-Lemma lt_curry_wd : forall m m', m == m' -> eq_fun E eq_bool (lt m) (lt m').
-Proof.
-unfold lt.
-intros m m' Emm'.
-apply recursion_wd with (EA := eq_fun E eq_bool).
-apply lt_base_wd.
-apply lt_step_wd.
-assumption.
-Qed.
-
-Add Morphism lt with signature E ==> E ==> eq_bool as lt_wd.
-Proof.
-unfold eq_fun; intros m m' Emm' n n' Enn'.
-now apply lt_curry_wd.
-Qed.
-
-(* Note that if we unfold lt along with eq_fun above, then "apply" signals
-as error "Impossible to unify", not just, e.g., "Cannot solve second-order
-unification problem". Something is probably wrong. *)
-
-Add Morphism le with signature E ==> E ==> eq_bool as le_wd.
-Proof.
-intros x1 x2 H1 x3 x4 H2; unfold le; rewrite H1; now rewrite H2.
-Qed.
-
-Theorem lt_base_eq : forall n, lt 0 n = if_zero false true n.
-Proof.
-intro n; unfold lt; now rewrite recursion_0.
-Qed.
-
-Theorem lt_step_eq : forall m n, lt (S m) n = recursion false (fun n' _ => lt m n') n.
-Proof.
-intros m n; unfold lt.
-pose proof (recursion_succ (eq_fun E eq_bool) (if_zero false true)
- (fun _ f => fun n => recursion false (fun n' _ => f n') n)
- lt_base_wd lt_step_wd m n n) as H.
-unfold eq_bool in H.
-assert (H1 : n == n); [reflexivity | apply H in H1; now rewrite H1].
-Qed.
-
-Theorem lt_0 : forall n, ~ lt n 0.
-Proof.
-ases/g
-rewrite lt_base_eq; rewrite if_zero_0; now intro.
-intros n; rewrite lt_step_eq. rewrite recursion_0. now intro.
-Qed.
-
-(* Above, we rewrite applications of function. Is it possible to rewrite
-functions themselves, i.e., rewrite (recursion lt_base lt_step (S n)) to
-lt_step n (recursion lt_base lt_step n)? *)
-
-Lemma lt_0_1 : lt 0 1.
-Proof.
-rewrite lt_base_eq; now rewrite if_zero_succ.
-Qed.
-
-Lemma lt_0_succn : forall n, lt 0 (S n).
-Proof.
-intro n; rewrite lt_base_eq; now rewrite if_zero_succ.
-Qed.
-
-Lemma lt_succn_succm : forall n m, lt (S n) (S m) <-> lt n m.
-Proof.
-intros n m.
-rewrite lt_step_eq. rewrite (recursion_succ eq_bool).
-reflexivity.
-now unfold eq_bool.
-unfold fun2_wd; intros; now apply lt_wd.
-Qed.
-
-Theorem lt_succ : forall m n, lt m (S n) <-> le m n.
-Proof.
-assert (A : forall m n, lt m (S n) <-> lt m n \/ m == n).
-induct m.
-ases/g
-[split; intro; [now right | apply lt_0_1] |
-intro n; split; intro; [left |]; apply lt_0_succn].
-ases/g
-split.
-intro. assert (H1 : lt n 0); [now apply -> lt_succn_succm | false_hyp H1 lt_0].
-intro H; destruct H as [H | H].
-false_hyp H lt_0. false_hyp H succ_0.
-intro m. pose proof (IH m) as H; clear IH.
-assert (lt (S n) (S (S m)) <-> lt n (S m)); [apply lt_succn_succm |].
-assert (lt (S n) (S m) <-> lt n m); [apply lt_succn_succm |].
-assert (S n == S m <-> n == m); [split; [ apply succ_inj | apply succ_wd]|]. tauto.
-intros; rewrite le_lt; apply A.
-Qed.
-
-(*****************************************************)
-(** Even *)
-
-Definition even (x : N) := recursion true (fun _ p => negb p) x.
-
-Lemma even_step_wd : fun2_wd E eq_bool eq_bool (fun x p => if p then false else true).
-Proof.
-unfold fun2_wd.
-intros x x' Exx' b b' Ebb'.
-unfold eq_bool; destruct b; destruct b'; now simpl.
-Qed.
-
-Add Morphism even with signature E ==> eq_bool as even_wd.
-Proof.
-unfold even; intros.
-apply recursion_wd with (A := bool) (EA := eq_bool).
-now unfold eq_bool.
-unfold eq_fun2. intros _ _ _ b b' Ebb'. unfold eq_bool; destruct b; destruct b'; now simpl.
-assumption.
-Qed.
-
-Theorem even_0 : even 0 = true.
-Proof.
-unfold even.
-now rewrite recursion_0.
-Qed.
-
-Theorem even_succ : forall x : N, even (S x) = negb (even x).
-Proof.
-unfold even.
-intro x; rewrite (recursion_succ (@eq bool)); try reflexivity.
-unfold fun2_wd.
-intros _ _ _ b b' Ebb'. destruct b; destruct b'; now simpl.
-Qed.
-
-(*****************************************************)
-(** Division by 2 *)
-
-Definition half_aux (x : N) : N * N :=
- recursion (0, 0) (fun _ p => let (x1, x2) := p in ((S x2, x1))) x.
-
-Definition half (x : N) := snd (half_aux x).
-
-Definition E2 := prod_rel E E.
-
-Add Relation (prod N N) E2
-reflexivity proved by (prod_rel_refl N N E E E_equiv E_equiv)
-symmetry proved by (prod_rel_symm N N E E E_equiv E_equiv)
-transitivity proved by (prod_rel_trans N N E E E_equiv E_equiv)
-as E2_rel.
-
-Lemma half_step_wd: fun2_wd E E2 E2 (fun _ p => let (x1, x2) := p in ((S x2, x1))).
-Proof.
-unfold fun2_wd, E2, prod_rel.
-intros _ _ _ p1 p2 [H1 H2].
-destruct p1; destruct p2; simpl in *.
-now split; [rewrite H2 |].
-Qed.
-
-Add Morphism half with signature E ==> E as half_wd.
-Proof.
-unfold half.
-assert (H: forall x y, x == y -> E2 (half_aux x) (half_aux y)).
-intros x y Exy; unfold half_aux; apply recursion_wd with (EA := E2); unfold E2.
-unfold E2.
-unfold prod_rel; simpl; now split.
-unfold eq_fun2, prod_rel; simpl.
-intros _ _ _ p1 p2; destruct p1; destruct p2; simpl.
-intros [H1 H2]; split; [rewrite H2 | assumption]. reflexivity. assumption.
-unfold E2, prod_rel in H. intros x y Exy; apply H in Exy.
-exact (proj2 Exy).
-Qed.
-
-(*****************************************************)
-(** Logarithm for the base 2 *)
-
-Definition log (x : N) : N :=
-strong_rec 0
- (fun x g =>
- if (e x 0) then 0
- else if (e x 1) then 0
- else S (g (half x)))
- x.
-
-Add Morphism log with signature E ==> E as log_wd.
-Proof.
-intros x x' Exx'. unfold log.
-apply strong_rec_wd with (EA := E); try (reflexivity || assumption).
-unfold eq_fun2. intros y y' Eyy' g g' Egg'.
-assert (H : e y 0 = e y' 0); [now apply e_wd|].
-rewrite <- H; clear H.
-assert (H : e y 1 = e y' 1); [now apply e_wd|].
-rewrite <- H; clear H.
-assert (H : S (g (half y)) == S (g' (half y')));
-[apply succ_wd; apply Egg'; now apply half_wd|].
-now destruct (e y 0); destruct (e y 1).
-Qed.
-
-(*********************************************************)
-(** To get the properties of plus, times and lt defined *)
-(** via recursion, we form the corresponding modules and *)
-(** apply the properties functors to these modules *)
-
-Module NDefaultPlusModule <: NPlusSig.
-
-Module NBaseMod := NatMod.
-(* If we used the name NBaseMod instead of NatMod then this would
-produce many warnings like "Trying to mask the absolute name
-NBaseMod", "Trying to mask the absolute name Nat.O" etc. *)
-
-Definition plus := plus.
-
-Add Morphism plus with signature E ==> E ==> E as plus_wd.
-Proof.
-exact plus_wd.
-Qed.
-
-Theorem plus_0_l : forall n, plus 0 n == n.
-Proof.
-exact plus_0.
-Qed.
-
-Theorem plus_succ_l : forall n m, plus (S n) m == S (plus n m).
-Proof.
-exact plus_succ.
-Qed.
-
-End NDefaultPlusModule.
-
-Module NDefaultTimesModule <: NTimesSig.
-Module NPlusMod := NDefaultPlusModule.
-
-Definition times := times.
-
-Add Morphism times with signature E ==> E ==> E as times_wd.
-Proof.
-exact times_wd.
-Qed.
-
-Definition times_0_r := times_0_r.
-Definition times_succ_r := times_succ_r.
-
-End NDefaultTimesModule.
-
-Module NDefaultOrderModule <: NOrderSig.
-Module NBaseMod := NatMod.
-
-Definition lt := lt.
-Definition le := le.
-
-Add Morphism lt with signature E ==> E ==> eq_bool as lt_wd.
-Proof.
-exact lt_wd.
-Qed.
-
-Add Morphism le with signature E ==> E ==> eq_bool as le_wd.
-Proof.
-exact le_wd.
-Qed.
-
-(* This produces a warning about a morphism redeclaration. Why is not
-there a warning after declaring lt? *)
-
-Theorem le_lt : forall x y, le x y <-> lt x y \/ x == y.
-Proof.
-exact le_lt.
-Qed.
-
-Theorem lt_0 : forall x, ~ (lt x 0).
-Proof.
-exact lt_0.
-Qed.
-
-Theorem lt_succ : forall x y, lt x (S y) <-> le x y.
-Proof.
-exact lt_succ.
-Qed.
-
-End NDefaultOrderModule.
-
-Module Export DefaultTimesOrderProperties :=
- NTimesOrderProperties NDefaultTimesModule NDefaultOrderModule.
-
-End MiscFunctFunctor.
-