(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
Require Export Euclid.
(*********************************************************************** ********************************************************************** ********************************************************************** Some Arith Facts.*)
intros x y z t; case x; case z.
intros H'; inversion H'.
simpl in |- *; intros n H'; case t; auto with arith.
intros H'0; inversion H'0.
intros n H'; inversion H'.
intros n n0 H'; case t.
intros H'0; inversion H'0.
intros n1 H'0; apply lt_trans with (m := S n0 * S n1).
apply mult_S_lt_compat_l; auto.
rewrite (mult_comm (S n0)); rewrite (mult_comm (S n)); auto.
apply mult_S_lt_compat_l; auto.
Qed.
intros x y; case y.
intros H'; inversion H'.
intros n H'; rewrite mult_comm; simpl in |- *; auto with arith.
Qed.
(*********************************************************************** ********************************************************************** ********************************************************************** FACTORIAL*)
Fixpoint factorial (n : nat) : nat :=
match n with
| O => 1
| S n' => n * factorial n'
end.
(*********************************************************************** ********************************************************************** ********************************************************************** POWER*)
Fixpoint power (x n : nat) {struct n} : nat :=
match n with
| O => 1
| S n' => x * power x n'
end.
simple induction n; simpl in |- *; auto with arith.
intros n0; case x; intros.
simpl in |- *; auto.
change (0 * 0 < S n1 * power (S n1) n0) in |- *.
apply lt_mult_right; auto.
Qed.
(************************************************************************** ************************************************************************* *)
Definition plus_eq := f_equal2 plus.
Definition mult_eq := f_equal2 mult.
Definition minus_eq := f_equal2 minus.
(*****************************************************************************)
Inductive is_div : nat -> nat -> nat -> nat -> Prop :=
is_div_def :
forall a b q r : nat, r < b -> a = q * b + r -> is_div a b q r.
Inductive ex_div : nat -> nat -> Prop :=
ex_div_def : forall a b q r : nat, is_div a b q r -> ex_div a b.
intros a; elim a; auto.
intros b q1 q2 r1 r2 H' H'0.
apply trans_eq with (y := 0); auto.
apply div_x_O_r with (x := b) (q := q1); auto.
apply sym_eq; apply div_x_O_r with (x := b) (q := q2); auto.
intros n H' b q1 q2 r1 r2; case r1; case r2; auto.
intros n0 H'0 H'1; inversion_clear H'0; inversion_clear H'1.
cut (S n0 = (q1 - q2) * b); [ intros EqSn0 | idtac ].
generalize H1; rewrite EqSn0; case (q1 - q2); auto with arith.
intros n1 H'0; absurd (b > S n1 * b); auto; simpl in |- *; auto with arith.
rewrite mult_minus_distr_r; apply plus_minus.
rewrite (plus_n_O (q1 * b)); rewrite <- H0; auto.
intros n0 H'0 H'1; inversion_clear H'0; inversion_clear H'1.
cut (S n0 = (q2 - q1) * b); [ intros EqSn0 | idtac ].
generalize H; rewrite EqSn0; case (q2 - q1); auto with arith.
intros n1 H'0; absurd (b > S n1 * b); auto; simpl in |- *; auto with arith.
rewrite mult_minus_distr_r; apply plus_minus.
rewrite (plus_n_O (q2 * b)); rewrite <- H0; auto.
intros n0 n1 H'0 H'1; rewrite (H' b q1 q2 n1 n0); auto.
apply (div_SxS (S n) b q1 (S n1)); auto with arith.
apply (div_SxS (S n) b q2 (S n0)); auto with arith.
Qed.
intros n m; elim m; simpl in |- *; auto.
intros p H' H'0; case (mult_eqO p n); auto.
intros H'1; absurd (0 < n); auto; rewrite H'1; auto with arith.
intros m' H' p; case p; simpl in |- *; auto.
case n; simpl in |- *; intros; try discriminate; absurd (0 < 0);
auto with arith.
intros p' H'0 H'1.
rewrite (H' p'); auto.
apply plus_reg_l with (p := n); auto.
Qed.
intros x y q r H'.
apply div_unic_r with (a := x * y) (b := y) (q1 := q) (q2 := x);
auto with arith.
apply is_div_def; inversion_clear H'; auto with arith.
apply le_lt_trans with (m := r); auto with arith.
Qed.

Lemma diveucl_divex :
forall a b : nat,
diveucl a b -> exists q : _, (exists r : _, is_div a b q r).