Set Implicit Arguments.
(* nat misc *)
Definition ltb (x y: nat): bool := negb (leb y x).
Definition geb (x y: nat): bool := leb y x.
Ltac subst_tac x y z := (* todo: rename *)
match z with
| x => y
| ?l + ?r =>
let l' := subst_tac x y l in
let r' := subst_tac x y r in
constr: (l' + r')
| ?l * ?r =>
let l' := subst_tac x y l in
let r' := subst_tac x y r in
constr: (l' * r')
| _ => z
end.
Ltac deep_le_trans h :=
match type of h with
| ?n <= ?u =>
match goal with
| |- ?l <= _ =>
let q := subst_tac n u l
in apply le_trans with q
end
end.
Instance Transitive_le: Transitive le := le_trans.
Proof with auto with arith.
destruct a... destruct b...
intros. simpl. discriminate.
Qed.
Proof with auto with arith.
intros.
apply lt_S_n.
apply lt_trans with m...
Qed.
Proof with auto.
induction p.
exists 0...
destruct IHp.
exists (S x0).
subst...
Qed.
Proof with auto.
intros.
omega.
Qed.
Proof with auto with arith.
revert x y.
induction d.
simpl.
intros.
destruct x...
inversion H.
simpl.
intros.
destruct x.
destruct y...
elimtype False.
apply le_Sn_n with d...
rewrite H1.
apply le_minus.
destruct y.
elimtype False.
apply le_Sn_n with d.
rewrite <- H1.
apply le_minus.
apply eq_S.
apply IHd...
Qed.
Proof with auto with arith.
intros.
unfold sqrd.
autorewrite with arith_norm...
Qed.
intros.
unfold sqrd.
apply mult_le_compat; auto.
Qed.
Hint Resolve sqrd_plus sqrd_le.
(* div2 properties *)
Proof with auto with arith.
induction b...
rewrite plus_Sn_m.
rewrite <- plus_Snm_nSm.
rewrite plus_Sn_m.
simpl...
Qed.
Proof with auto with arith.
intros.
unfold sqrd.
replace (S n * S n) with (n * n + 2 * n + 1) by ring.
replace (div2 (n * n) + n) with (div2 (n * n + 2 * n)).
apply div2_preserves_le...
rewrite div2_x_plus_2y...
Qed.
Proof with auto with arith.
destruct x as [|[|x]]...
simpl. intros H. apply div2_lt_inv0 in H...
Qed.
Proof with auto.
induction n...
simpl mult.
rewrite <- plus_n_Sm.
simpl in *...
Qed.
(* log2 *)
Function ceil_log2_S (n: nat) {wf lt n}: nat :=
match n with
| 0 => 0
| S _ => S (ceil_log2_S (div2 n))
end.
Proof with auto with arith.
intro.
functional induction (ceil_log2_S n)...
apply le_n_S.
apply le_trans with (div2 (S _x))...
apply lt_n_Sm_le.
apply lt_div2...
Qed.
Proof with auto.
destruct n...
simpl.
unfold lt.
intros.
apply le_n_S.
apply ceil_log2_Sn_le_n.
Qed.
Proof with auto with arith.
destruct n...
apply lt_le_weak.
apply log2ceil_lt...
Qed.
Proof with auto with arith.
revert y.
functional induction (ceil_log2_S x)...
intros.
destruct y.
inversion H.
apply le_trans with (S (ceil_log2_S (div2 (S y)))).
apply le_n_S...
apply IHn.
apply div2_preserves_le...
rewrite (ceil_log2_S_def (S y))...
Qed.
Proof with auto with arith.
destruct x.
destruct y...
destruct y.
intros.
inversion H.
simpl.
intros.
apply log2ceil_S_preserves_le...
Qed.
(* INR comparisons *)
Proof with auto with real.
intros.
destruct (Req_ne_dec a 0%R)...
destruct (Req_ne_dec b 0%R).
right...
elimtype False.
apply (prod_neq_R0 a b)...
Qed.

Lemma Req_le_trans x y z: x = y -> y <= z -> x <= z.