(* Copyright 2012-2015 by Adam Petcher.				* * Use of this source code is governed by the license described	* * in the LICENSE file at the root of the source tree.		*)
(* This file contains the definition of the base 2 logarithm function (rounded down) over natural numbers. *)
(* Some of the definitions and theory in this file were added to Coq 8.4, so we should refactor this at some point. *)
Set Implicit Arguments.
(* log2 is like log_inf except it returns nat, so I don't have to reason about an unnecessary conversion. This function is only used to implement lognat below.*)
Fixpoint log2(n : positive) : nat :=
match n with
| xH => 0
| xO n' | xI n' => (S (log2 n'))
end.
intros. auto.
Qed.
intros. omega.
Qed.
induction a;
simpl in *; try apply le_s; auto.
Qed.
induction a;
simpl in *; try apply le_s; auto.
Qed.
Definition nat_to_pos (n : nat) : (n <> 0) -> positive :=
fun _ => (P_of_succ_nat (pred n)).
intros. omega.
Qed.
intros. omega.
Qed.
intros.
destruct a.
congruence.
unfold nat_to_pos in *.
simpl in *.
intros. auto.
Qed.
intros. omega.
Qed.
intros. omega.
Qed.
induction a; intros; simpl in *.
congruence.
destruct (eq_nat_dec a 0).
subst.
unfold nat_to_pos.
auto.
assert (a + S (a + 0) <> 0) by omega.
specialize (factor_s_conv H). intros.
unfold nat_to_pos in *.
rewrite (H0 pf2). clear H0.  clear pf2.
assert (a + S (a + 0) = S (a + (a + 0))) by omega.
rewrite H0.
assert (a + (a + 0) <> 0) by omega.
specialize (factor_s_conv H1). intros.
unfold nat_to_pos in H2.
rewrite <- H0 in H2.
rewrite <- H0.
rewrite (H2 H). clear H. clear H2.
rewrite (IHa n). clear IHa.
simpl.
destruct a. intros. destruct n. auto.
auto.
omega.
Qed.
Definition lognat(n : nat) : (n <> 0) -> nat :=
fun pf => (log2 (nat_to_pos pf)).
intros.
unfold lognat in *.
rewrite (factor_double_conv pf1 pf2).
eapply log2_prod_sum.
Qed.
induction a.
intros.
destruct pf1. auto.
intros.
unfold lognat in *.
rewrite (factor_s_conv pf1).
apply log2_monotonic_b.
Qed.
(* for good measure, we will define exponentiation for nat and prove that lognat is correct *)
Fixpoint expnat(a e : nat) : nat :=
match e with
| 0 => 1
| (S e') => a * (expnat a e')
end.
intros.
destruct a. omega.
destruct b. omega.
simpl.
remember (b + a * (S b)) as c.
omega.
Qed.
induction e.
simpl. auto.
simpl.
intros.
eapply mult_ne; eauto.
Qed.
omega.
Qed.
intros.
apply (expnat_nz e nz_2).
Qed.
induction e1.
intros.
simpl.
specialize (expnat_2_nz e2). intros.
omega.
induction e2;
intros.
omega.
simpl.
specialize (IHe1 e2).
omega.
Qed.
induction b.
intros. simpl in *. auto.
intros.
specialize (lognat_prod_sum (expnat_2_nz b)). intros.
specialize (IHb (expnat_2_nz b)).
rewrite IHb in H.
symmetry in H.
simpl in *.
apply H.
Qed.
intros. omega.
Qed.
induction a.
intros.
destruct pf1. auto.
intros.
unfold lognat in *.
rewrite (factor_s_conv pf1).
apply log2_monotonic_b.
Qed.
intuition.
Qed.
induction c.
intros.
assert (a = b) by intuition.
subst. auto.
intros.
assert (a >= (S b)) by omega.
assert (c = a - (S b)) by omega.
eapply ge_trans.
apply (IHc a (S b) pfa (s_nat_nz pfb)).
apply H1.
apply H2.
apply lognat_ge_monotonic_b.
Qed.
intros.
remember (a - b) as c.
apply (@lognat_ge_monotonic_h c); auto.
Qed.
intros.
remember (b - a) as c.
apply (@lognat_ge_monotonic_h c); auto.
Qed.
unfold not in *.
intros.
apply H0.
apply H.
apply H1.
Qed.
intuition.
Qed.
intros.
specialize (lognat_ge_monotonic pfa pfb).
intros.
specialize (mt H0).
intros.
apply ge_not. omega.
Qed.
intros.
simpl.
rewrite fold_add.
assert (expnat 2 (lognat pf) <> 0). apply expnat_nz. auto.
assert (2 * (expnat 2 (lognat pf)) <> 0). omega.
eapply (lognat_ge_monotonic_mt pf H0).
rewrite <- (lognat_prod_sum H).
rewrite lognat_correct_eq.
omega.
Qed.
intros.
unfold lognat in *.
rewrite (factor_s_conv pf1 pf2).
assert (a <> 0). omega.
rewrite (factor_double_conv H pf1).
simpl.
auto.
Qed.

Lemma double_s : forall a, (S (S (2 * a))) = 2 * (S a).