(*  Title:      Util_Div.thy
    Date:       Oct 2006
    Author:     David Trachtenherz
*)

header {* Results for division and modulo operators on integers *}

theory Util_Div
imports Util_Nat
begin

subsection {* Additional (in-)equalities with @{text div} and @{text mod} *}

corollary Suc_mod_le_divisor: "0 < m \<Longrightarrow> Suc (n mod m) \<le> m"
by (rule Suc_leI, rule mod_less_divisor)

lemma mod_less_dividend: "\<lbrakk> 0 < m; m \<le> n \<rbrakk> \<Longrightarrow> n mod m < (n::nat)"
by (rule less_le_trans[OF mod_less_divisor])
(*lemma mod_le_dividend: "n mod m \<le> (n::nat)"*)
lemmas mod_le_dividend = mod_less_eq_dividend

lemma diff_mod_le: "(t - r) mod m \<le> (t::nat)"
by (rule le_trans[OF mod_le_dividend, OF diff_le_self])

(*corollary div_mult_cancel: "m div n * n = m - m mod (n::nat)"*)
lemmas div_mult_cancel = div_mod_equality'

lemma mod_0_div_mult_cancel: "(n mod (m::nat) = 0) = (n div m * m = n)"
apply (insert eq_diff_left_iff[OF mod_le_dividend le0, of n m])
apply (simp add: mult.commute mult_div_cancel)
done

lemma div_mult_le: "(n::nat) div m * m \<le> n"
by (simp add: mult.commute mult_div_cancel)
lemma less_div_Suc_mult: "0 < (m::nat) \<Longrightarrow> n < Suc (n div m) * m"
apply (simp add: mult.commute mult_div_cancel)
apply (rule less_add_diff)
by (rule mod_less_divisor)

lemma nat_ge2_conv: "((2::nat) \<le> n) = (n \<noteq> 0 \<and> n \<noteq> 1)"
by fastforce

lemma Suc0_mod: "m \<noteq> Suc 0 \<Longrightarrow> Suc 0 mod m = Suc 0"
by (case_tac m, simp_all)
corollary Suc0_mod_subst: "
  \<lbrakk> m \<noteq> Suc 0; P (Suc 0) \<rbrakk> \<Longrightarrow> P (Suc 0 mod m)"
by (blast intro: subst[OF Suc0_mod[symmetric]])
corollary Suc0_mod_cong: "
  m \<noteq> Suc 0 \<Longrightarrow> f (Suc 0 mod m) = f (Suc 0)"
by (blast intro: arg_cong[OF Suc0_mod])

subsection {* Additional results for addition and subtraction with @{text mod} *}

lemma mod_Suc_conv: "
  ((Suc a) mod m = (Suc b) mod m) = (a mod m = b mod m)"
by (simp add: mod_Suc)

lemma mod_Suc': "
  0 < n \<Longrightarrow> Suc m mod n = (if m mod n < n - Suc 0 then Suc (m mod n) else 0)"
apply (simp add: mod_Suc)
apply (intro conjI impI)
 apply simp
apply (insert le_neq_trans[OF mod_less_divisor[THEN Suc_leI, of n m]], simp)
done

lemma mod_add:"
  ((a + k) mod m = (b + k) mod m) =
  ((a::nat) mod m = b mod m)"
by (induct "k", simp_all add: mod_Suc_conv)

corollary mod_sub_add: "
  k \<le> (a::nat) \<Longrightarrow>
  ((a - k) mod m = b mod m) = (a mod m = (b + k) mod m)"
by (simp add: mod_add[where m=m and a="a-k" and b=b and k=k, symmetric])

lemma mod_sub_eq_mod_0_conv: "
  a + b \<le> (n::nat) \<Longrightarrow>
  ((n - a) mod m = b mod m) = ((n - (a + b)) mod m = 0)"
by (insert mod_add[of "n-(a+b)" b m 0], simp)
lemma mod_sub_eq_mod_swap: "
  \<lbrakk> a \<le> (n::nat); b \<le> n \<rbrakk> \<Longrightarrow>
  ((n - a) mod m = b mod m) = ((n - b) mod m = a mod m)"
by (simp add: mod_sub_add add.commute)

lemma le_mod_greater_imp_div_less: "
  \<lbrakk> a \<le> (b::nat); a mod m > b mod m \<rbrakk> \<Longrightarrow> a div m < b div m"
apply (rule ccontr, simp add: linorder_not_less)
apply (drule mult_le_mono1[of "b div m" _ m])
apply (drule add_less_le_mono[of "b mod m" "a mod m" "b div m * m" "a div m * m"])
apply simp_all
done

lemma less_mod_ge_imp_div_less: "\<lbrakk> a < (b::nat); a mod m \<ge> b mod m \<rbrakk> \<Longrightarrow> a div m < b div m"
apply (case_tac "m = 0", simp)
apply (rule mult_less_cancel1[of m, THEN iffD1, THEN conjunct2])
apply (simp add: mult_div_cancel)
apply (rule order_less_le_trans[of _ "b - a mod m"])
apply (rule diff_less_mono)
apply simp+
done
corollary less_mod_0_imp_div_less: "\<lbrakk> a < (b::nat); b mod m = 0 \<rbrakk> \<Longrightarrow> a div m < b div m"
by (simp add: less_mod_ge_imp_div_less)

lemma mod_diff_right_eq: "
  (a::nat) \<le> b \<Longrightarrow> (b - a) mod m = (b - a mod m) mod m"
proof -
  assume a_as:"a \<le> b"
  have "(b - a) mod m = (b - a + a div m * m) mod m" by simp
  also have "\<dots> = (b + a div m * m - a) mod m" using a_as by simp
  also have "\<dots> = (b + a div m * m - (a div m * m + a mod m)) mod m" by simp
  also have "\<dots> = (b + a div m * m - a div m * m - a mod m) mod m"
    by (simp only: diff_diff_left[symmetric])
  also have "\<dots> = (b - a mod m) mod m" by simp
  finally show ?thesis .
qed
corollary mod_eq_imp_diff_mod_eq: "
  \<lbrakk> x mod m = y mod m; x \<le> (t::nat); y \<le> t \<rbrakk> \<Longrightarrow>
  (t - x) mod m = (t - y) mod m"
by (simp only: mod_diff_right_eq)
lemma mod_eq_imp_diff_mod_eq2: "
  \<lbrakk> x mod m = y mod m; (t::nat) \<le> x; t \<le> y \<rbrakk> \<Longrightarrow>
  (x - t) mod m = (y - t) mod m"
apply (case_tac "m = 0", simp+)
apply (subst mod_mult_self2[of "x - t" m t, symmetric])
apply (subst mod_mult_self2[of "y - t" m t, symmetric])
apply (simp only: add_diff_assoc2 diff_add_assoc gr0_imp_self_le_mult2)
apply (simp only: mod_add)
done

lemma divisor_add_diff_mod_if: "
  (m + b mod m - a mod m) mod (m::nat)= (
  if a mod m \<le> b mod m
  then (b mod m - a mod m)
  else (m + b mod m - a mod m))"
apply (case_tac "m = 0", simp)
apply clarsimp
apply (subst diff_add_assoc, assumption)
apply (simp only: mod_add_self1)
apply (rule mod_less)
apply (simp add: less_imp_diff_less)
done
corollary divisor_add_diff_mod_eq1: "
  a mod m \<le> b mod m \<Longrightarrow>
  (m + b mod m - a mod m) mod (m::nat) = b mod m - a mod m"
by (simp add: divisor_add_diff_mod_if)
corollary divisor_add_diff_mod_eq2: "
  b mod m < a mod m \<Longrightarrow>
  (m + b mod m - a mod m) mod (m::nat) = m + b mod m - a mod m"
by (simp add: divisor_add_diff_mod_if)

lemma mod_add_mod_if: "
  (a mod m + b mod m) mod (m::nat)= (
  if a mod m + b mod m < m
  then a mod m + b mod m
  else a mod m + b mod m - m)"
apply (case_tac "m = 0", simp_all)
apply (clarsimp simp: linorder_not_less)
apply (simp add: mod_if[of "a mod m + b mod m"])
apply (rule mod_less)
apply (rule diff_less_conv[THEN iffD2], assumption)
apply (simp add: add_less_mono)
done
corollary mod_add_mod_eq1: "
  a mod m + b mod m < m \<Longrightarrow>
  (a mod m + b mod m) mod (m::nat) = a mod m + b mod m"
by (simp add: mod_add_mod_if)
corollary mod_add_mod_eq2: "
  m \<le> a mod m + b mod m\<Longrightarrow>
  (a mod m + b mod m) mod (m::nat) = a mod m + b mod m - m"
by (simp add: mod_add_mod_if)

lemma mod_add1_eq_if: "
  (a + b) mod (m::nat) = (
  if (a mod m + b mod m < m) then a mod m + b mod m
  else a mod m + b mod m - m)"
by (simp add: mod_add_eq[of a b] mod_add_mod_if)

lemma mod_add_eq_mod_conv: "0 < (m::nat) \<Longrightarrow>
  ((x + a) mod m = b mod m ) =
  (x mod m = (m + b mod m - a mod m) mod m)"
apply (simp only: mod_add_eq[of x a])
apply (rule iffI)
 apply (drule sym)
 apply (simp add: mod_add_mod_if)
apply (simp add: mod_add_left_eq[symmetric] le_add_diff_inverse2[OF trans_le_add1[OF mod_le_divisor]])
done

lemma mod_diff1_eq: "
  (a::nat) \<le> b \<Longrightarrow> (b - a) mod m = (m + b mod m - a mod m) mod m"
apply (case_tac "m = 0", simp)
apply simp
proof -
  assume a_as:"a \<le> b"
    and m_as: "0 < m"
  have a_mod_le_b_s: "a mod m \<le> b"
    by (rule le_trans[of _ a], simp only: mod_le_dividend, simp only: a_as)
  have "(b - a) mod m = (b - a mod m) mod m"
    using a_as by (simp only: mod_diff_right_eq)
  also have "\<dots> = (b - a mod m + m) mod m"
    by simp
  also have "\<dots> = (b + m - a mod m) mod m"
    using a_mod_le_b_s by simp
  also have "\<dots> = (b div m * m + b mod m + m - a mod m) mod m"
    by simp
  also have "\<dots> = (b div m * m + (b mod m + m - a mod m)) mod m"
    by (simp add: diff_add_assoc[OF mod_le_divisor, OF m_as])
  also have "\<dots> = ((b mod m + m - a mod m) + b div m * m) mod m"
    by simp
  also have "\<dots> = (b mod m + m - a mod m) mod m"
    by simp
  also have "\<dots> = (m + b mod m - a mod m) mod m"
    by (simp only: add.commute)
  finally show ?thesis .
qed
corollary mod_diff1_eq_if: "
  (a::nat) \<le> b \<Longrightarrow> (b - a) mod m = (
    if a mod m \<le> b mod m then b mod m - a mod m
    else m + b mod m - a mod m)"
by (simp only: mod_diff1_eq divisor_add_diff_mod_if)
corollary mod_diff1_eq1: "
  \<lbrakk> (a::nat) \<le> b; a mod m \<le> b mod m \<rbrakk>
  \<Longrightarrow> (b - a) mod m = b mod m - a mod m"
by (simp add: mod_diff1_eq_if)
corollary mod_diff1_eq2: "
  \<lbrakk> (a::nat) \<le> b; b mod m < a mod m\<rbrakk>
  \<Longrightarrow> (b - a) mod m = m + b mod m - a mod m"
by (simp add: mod_diff1_eq_if)

subsubsection {* Divisor subtraction with @{text div} and @{text mod} *}

lemma mod_diff_self1: "
  0 < (n::nat) \<Longrightarrow> (m - n) mod m = m - n"
by (case_tac "m = 0", simp_all)
lemma mod_diff_self2: "
  m \<le> (n::nat) \<Longrightarrow> (n - m) mod m = n mod m"
by (simp add: mod_diff_right_eq)
lemma mod_diff_mult_self1: "
  k * m \<le> (n::nat) \<Longrightarrow> (n - k * m) mod m = n mod m"
by (simp add: mod_diff_right_eq)
lemma mod_diff_mult_self2: "
  m * k \<le> (n::nat) \<Longrightarrow> (n - m * k) mod m = n mod m"
by (simp only: mult.commute[of m k] mod_diff_mult_self1)

lemma div_diff_self1: "0 < (n::nat) \<Longrightarrow> (m - n) div m = 0"
by (case_tac "m = 0", simp_all)
lemma div_diff_self2: "(n - m) div m = n div m - Suc 0"
apply (case_tac "m = 0", simp)
apply (case_tac "n < m", simp)
apply (case_tac "n = m", simp)
apply (simp add: div_if)
done

lemma div_diff_mult_self1: "
  (n - k * m) div m = n div m - (k::nat)"
apply (case_tac "m = 0", simp)
apply (case_tac "n < k * m")
 apply simp
 apply (drule div_le_mono[OF less_imp_le, of n _ m])
 apply simp
apply (simp add: linorder_not_less)
apply (rule iffD1[OF mult_cancel1_gr0[where k=m]], assumption)
apply (subst diff_mult_distrib2)
apply (simp only: mult_div_cancel)
apply (simp only: diff_commute[of _ "k*m"])
apply (simp only: mult.commute[of m])
apply (simp only: mod_diff_mult_self1)
done
lemma div_diff_mult_self2: "
  (n - m * k) div m = n div m - (k::nat)"
by (simp only: mult.commute div_diff_mult_self1)

subsubsection {* Modulo equality and modulo of difference*}

lemma mod_eq_imp_diff_mod_0:"
  (a::nat) mod m = b mod m \<Longrightarrow> (b - a) mod m = 0"
  (is "?P \<Longrightarrow> ?Q")
proof -
  assume as1: ?P
  have "b - a = b div m * m + b mod m - (a div m * m + a mod m)"
    by simp
  also have "\<dots> = b div m * m + b mod m - (a mod m + a div m * m)"
    by simp
  also have "\<dots> = b div m * m + b mod m - a mod m - a div m * m"
    by simp
  also have "\<dots> = b div m * m + b mod m - b mod m - a div m * m"
    using as1 by simp
  also have "\<dots> = b div m * m - a div m * m"
    by (simp only: diff_add_inverse2)
  also have "\<dots> = (b div m - a div m) * m"
    by (simp only: diff_mult_distrib)
  finally have "b - a = (b div m - a div m) * m" .
  hence "(b - a) mod m = (b div m - a div m) * m mod m"
    by (rule arg_cong)
  thus ?thesis by (simp only: mod_mult_self2_is_0)
qed
corollary mod_eq_imp_diff_dvd: "
  (a::nat) mod m = b mod m \<Longrightarrow> m dvd b - a"
by (rule dvd_eq_mod_eq_0[THEN iffD2, OF mod_eq_imp_diff_mod_0])

lemma mod_neq_imp_diff_mod_neq0:"
  \<lbrakk> (a::nat) mod m \<noteq> b mod m; a \<le> b \<rbrakk> \<Longrightarrow> 0 < (b - a) mod m"
apply (case_tac "m = 0", simp)
apply (drule le_imp_less_or_eq, erule disjE)
 prefer 2
 apply simp
apply (drule neq_iff[THEN iffD1], erule disjE)
 apply (simp add: mod_diff1_eq1)
apply (simp add: mod_diff1_eq2[OF less_imp_le] trans_less_add1[OF mod_less_divisor])
done
corollary mod_neq_imp_diff_not_dvd:"
  \<lbrakk> (a::nat) mod m \<noteq> b mod m; a \<le> b \<rbrakk> \<Longrightarrow> \<not> m dvd b - a"
by (simp add: dvd_eq_mod_eq_0 mod_neq_imp_diff_mod_neq0)

lemma diff_mod_0_imp_mod_eq:"
  \<lbrakk> (b - a) mod m = 0; a \<le> b \<rbrakk> \<Longrightarrow> (a::nat) mod m = b mod m"
apply (rule ccontr)
apply (drule mod_neq_imp_diff_mod_neq0)
apply simp_all
done
corollary diff_dvd_imp_mod_eq:"
  \<lbrakk> m dvd b - a; a \<le> b \<rbrakk> \<Longrightarrow> (a::nat) mod m = b mod m"
by (rule dvd_eq_mod_eq_0[THEN iffD1, THEN diff_mod_0_imp_mod_eq])

lemma mod_eq_diff_mod_0_conv: "
  a \<le> (b::nat) \<Longrightarrow> (a mod m = b mod m) = ((b - a) mod m = 0)"
apply (rule iffI)
apply (rule mod_eq_imp_diff_mod_0, assumption)
apply (rule diff_mod_0_imp_mod_eq, assumption+)
done
corollary mod_eq_diff_dvd_conv: "
  a \<le> (b::nat) \<Longrightarrow> (a mod m = b mod m) = (m dvd b - a)"
by (rule dvd_eq_mod_eq_0[symmetric, THEN subst], rule mod_eq_diff_mod_0_conv)

subsection {* Some additional lemmata about integer @{text div} and @{text mod} *}

lemma zmod_eq_imp_diff_mod_0:"
  (a::int) mod m = b mod m \<Longrightarrow> (b - a) mod m = 0"
  by (metis diff_minus_eq_add minus_minus mod_0 right_minus ring_div_class.mod_diff_right_eq)

(*lemma int_mod_distrib: "int (n mod m) = int n mod int m"*)
lemmas int_mod_distrib = zmod_int

lemma zdiff_mod_0_imp_mod_eq__pos:"
  \<lbrakk> (b - a) mod m = 0; 0 < (m::int) \<rbrakk> \<Longrightarrow> a mod m = b mod m"
  (is "\<lbrakk> ?P; ?Pm \<rbrakk> \<Longrightarrow> ?Q")
proof -
  assume as1: ?P
    and as2: "0 < m"

  obtain r1 where a_r1:"r1 = a mod m" by blast
  obtain r2 where b_r2:"r2 = b mod m" by blast

  obtain q1 where a_q1: "q1 = a div m" by blast
  obtain q2 where b_q2: "q2 = b div m" by blast

  have a_r1_q1: "a = m * q1 + r1"
    using a_r1 a_q1 by simp
  have b_r2_q2: "b = m * q2 + r2"
    using b_r2 b_q2 by simp

  have "b - a = m * q2 + r2 - (m * q1 + r1)"
    using a_r1_q1 b_r2_q2 by simp
  also have "\<dots> = m * q2 + r2 - m * q1 - r1"
    by simp
  also have "\<dots> = m * q2 - m * q1 + r2 - r1"
    by simp
  finally have "b - a = m * (q2 - q1) + (r2 - r1)"
    by (simp add: right_diff_distrib)
  hence "(b - a) mod m = (r2 - r1) mod m"
    by (simp add: mod_add_eq)
  hence r2_r1_mod_m_0:"(r2 - r1) mod m = 0" (is "?R1")
    by (simp only: as1)

  have "r1 = r2"
  proof (rule notI[of "r1 \<noteq> r2", simplified])
    assume as1': "r1 \<noteq> r2"
    have diff_le_s: "\<And>a b (m::int). \<lbrakk> 0 \<le> a; b < m \<rbrakk> \<Longrightarrow> b - a < m"
      by simp
    have s_r1:"0 \<le> r1 \<and> r1 < m" and s_r2:"0 \<le> r2 \<and> r2 < m"
      by (simp add: as2 a_r1 b_r2 pos_mod_conj)+
    have mr2r1:"-m < r2 - r1" and r2r1m:"r2 - r1 < m"
      by (simp add: minus_less_iff[of m] s_r1 s_r2 diff_le_s)+
    have "0 \<le> r2 - r1 \<Longrightarrow> (r2 - r1) mod m = (r2 - r1)"
      using r2r1m by (blast intro: mod_pos_pos_trivial)
    hence s1_pos: "0 \<le> r2 - r1 \<Longrightarrow> r2 - r1 = 0"
      using r2_r1_mod_m_0 by simp

    have "(r2-r1) mod -m = 0"
      by (simp add: zmod_zminus2_eq_if[of "r2-r1" m, simplified] r2_r1_mod_m_0)
    moreover
    have "r2 - r1 \<le> 0 \<Longrightarrow> (r2 - r1) mod -m = r2 - r1"
      using mr2r1
      by (simp add: mod_neg_neg_trivial)
    ultimately have s1_neg:"r2 - r1 \<le> 0 \<Longrightarrow> r2 - r1 = 0"
      by simp

    have "r2 - r1 = 0"
      using s1_pos s1_neg linorder_linear by blast
    hence "r1 = r2" by simp
    thus False
      using as1' by blast
  qed
  thus ?thesis
    using a_r1 b_r2 by blast
qed

lemma zmod_zminus_eq_conv_pos: "
  0 < (m::int) \<Longrightarrow> (a mod - m = b mod - m) = (a mod m = b mod m)"
apply (simp only: mod_minus_right neg_equal_iff_equal)
apply (simp only: zmod_zminus1_eq_if)
apply (split split_if)+
apply (safe, simp_all)
apply (insert pos_mod_bound[of m a] pos_mod_bound[of m b], simp_all)
done
lemma zmod_zminus_eq_conv: "
  ((a::int) mod - m = b mod - m) = (a mod m = b mod m)"
apply (insert linorder_less_linear[of 0 m], elim disjE)
apply (blast dest: zmod_zminus_eq_conv_pos)
apply simp
apply (simp add: zmod_zminus_eq_conv_pos[of "-m", symmetric])
done

lemma zdiff_mod_0_imp_mod_eq:"
  (b - a) mod m = 0 \<Longrightarrow> (a::int) mod m = b mod m"
by (metis dvd_eq_mod_eq_0 zmod_eq_dvd_iff)

lemma zmod_eq_diff_mod_0_conv: "
  ((a::int) mod m = b mod m) = ((b - a) mod m = 0)"
apply (rule iffI)
apply (rule zmod_eq_imp_diff_mod_0, assumption)
apply (rule zdiff_mod_0_imp_mod_eq, assumption)
done

lemma "\<not>(\<exists>(a::int) b m. (b - a) mod m = 0 \<and> a mod m \<noteq> b mod m)"
by (simp add: zmod_eq_diff_mod_0_conv)
lemma "\<exists>(a::nat) b m. (b - a) mod m = 0 \<and> a mod m \<noteq> b mod m"
apply (rule_tac x=1 in exI)
apply (rule_tac x=0 in exI)
apply (rule_tac x=2 in exI)
apply simp
done

lemma zmult_div_leq_mono:"
  \<lbrakk> (0::int) \<le> x; a \<le> b; 0 < d \<rbrakk> \<Longrightarrow> x * a div d \<le> x * b div d"
by (metis mult_right_mono zdiv_mono1 mult.commute)

lemma zmult_div_leq_mono_neg:"
  \<lbrakk> x \<le> (0::int); a \<le> b; 0 < d \<rbrakk> \<Longrightarrow> x * b div d \<le> x * a div d"
by (metis mult_left_mono_neg zdiv_mono1)

lemma zmult_div_pos_le:"
  \<lbrakk> (0::int) \<le> a; 0 \<le> b; b \<le> c \<rbrakk> \<Longrightarrow> a * b div c \<le> a"
apply (case_tac "b = 0", simp)
apply (subgoal_tac "b * a \<le> c * a")
 prefer 2
 apply (simp only: mult_right_mono)
apply (simp only: mult.commute)
apply (subgoal_tac "a * b div c \<le> a * c div c")
 prefer 2
 apply (simp only: zdiv_mono1)
apply simp
done

lemma zmult_div_neg_le:"
  \<lbrakk> a \<le> (0::int); 0 < c; c \<le> b \<rbrakk> \<Longrightarrow> a * b div c \<le> a"
apply (subgoal_tac "b * a \<le> c * a")
 prefer 2
 apply (simp only: mult_right_mono_neg)
apply (simp only: mult.commute)
apply (subgoal_tac "a * b div c \<le> a * c div c")
 prefer 2
 apply (simp only: zdiv_mono1)
apply simp
done

lemma zmult_div_ge_0:"\<lbrakk> (0::int) \<le> x; 0 \<le> a; 0 < c \<rbrakk> \<Longrightarrow> 0 \<le> a * x div c"
by (metis pos_imp_zdiv_nonneg_iff split_mult_pos_le)

corollary zmult_div_plus_ge_0: "
  \<lbrakk> (0::int) \<le> x; 0 \<le> a; 0 \<le> b; 0 < c\<rbrakk> \<Longrightarrow> 0 \<le> a * x div c + b"
by (insert zmult_div_ge_0[of x a c], simp)

lemma zmult_div_abs_ge: "
  \<lbrakk> (0::int) \<le> b; b \<le> b'; 0 \<le> a; 0 < c\<rbrakk> \<Longrightarrow>
  \<bar>a * b div c\<bar> \<le> \<bar>a * b' div c\<bar>"
apply (insert zmult_div_ge_0[of b a c] zmult_div_ge_0[of "b'" a c], simp)
by (metis zmult_div_leq_mono)

lemma zmult_div_plus_abs_ge: "
  \<lbrakk> (0::int) \<le> b; b \<le> b'; 0 \<le> a; 0 < c \<rbrakk> \<Longrightarrow>
  \<bar>a * b div c + a\<bar> \<le> \<bar>a * b' div c + a\<bar>"
apply (insert zmult_div_plus_ge_0[of b a a c] zmult_div_plus_ge_0[of "b'" a a c], simp)
by (metis zmult_div_leq_mono)

subsection {* Some further (in-)equality results for @{text div} and @{text mod} *}

lemma less_mod_eq_imp_add_divisor_le: "
  \<lbrakk> (x::nat) < y; x mod m = y mod m \<rbrakk> \<Longrightarrow> x + m \<le> y"
apply (case_tac "m = 0")
 apply simp
apply (rule contrapos_pp[of "x mod m = y mod m"])
 apply blast
apply (rule ccontr, simp only: not_not, clarify)
proof -
  assume m_greater_0: "0 < m"
  assume x_less_y:"x < y"
  hence y_x_greater_0:"0 < y - x"
    by simp
  assume "x mod m = y mod m"
  hence y_x_mod_m: "(y - x) mod m = 0"
    by (simp only: mod_eq_imp_diff_mod_0)
  assume "\<not> x + m \<le> y"
  hence "y < x + m" by simp
  hence "y - x < x + m - x"
    by (simp add: diff_add_inverse diff_less_conv m_greater_0)
  hence y_x_less_m: "y - x < m"
    by simp
  have "(y - x) mod m = y - x"
    using y_x_less_m by simp
  hence "y - x = 0"
    using y_x_mod_m by simp
  thus False
    using y_x_greater_0 by simp
qed

lemma less_div_imp_mult_add_divisor_le: "
  (x::nat) < n div m \<Longrightarrow> x * m + m \<le> n"
apply (case_tac "m = 0", simp)
apply (case_tac "n < m", simp)
apply (simp add: linorder_not_less)
apply (subgoal_tac "m \<le> n - n mod m")
 prefer 2
 apply (drule div_le_mono[of m _ m])
 apply (simp only: div_self)
 apply (drule mult_le_mono2[of 1 _ m])
 apply (simp only: mult_1_right mult_div_cancel)
apply (drule less_imp_le_pred[of x])
apply (drule mult_le_mono2[of x _ m])
apply (simp add: diff_mult_distrib2 mult_div_cancel del: diff_diff_left)
apply (simp only: le_diff_conv2[of m])
apply (drule le_diff_imp_le[of "m * x + m"])
apply (simp only: mult.commute[of _ m])
done

lemma mod_add_eq_imp_mod_0: "
  ((n + k) mod (m::nat) = n mod m) = (k mod m = 0)"
by (metis add_eq_if mod_add mod_add_self1 mod_self add.commute)

lemma between_imp_mod_between: "
  \<lbrakk> b < (m::nat); m * k + a \<le> n; n \<le> m * k + b \<rbrakk> \<Longrightarrow>
  a \<le> n mod m \<and> n mod m \<le> b"
apply (case_tac "m = 0", simp_all)
apply (frule gr_implies_gr0)
apply (subgoal_tac "k = n div m")
 prefer 2
 apply (rule split_div_lemma[THEN iffD1], assumption)
 apply simp
apply clarify
apply (rule conjI)
apply (rule add_le_imp_le_left[where c="m * (n div m)"], simp)+
done

corollary between_imp_mod_le: "
  \<lbrakk> b < (m::nat); m * k \<le> n; n \<le> m * k + b \<rbrakk> \<Longrightarrow> n mod m \<le> b"
by (insert between_imp_mod_between[of b m k 0 n], simp)
corollary between_imp_mod_gr0: "
  \<lbrakk> (m::nat) * k < n; n < m * k + m \<rbrakk> \<Longrightarrow> 0 < n mod m"
apply (case_tac "m = 0", simp_all)
apply (rule Suc_le_lessD)
apply (rule between_imp_mod_between[THEN conjunct1, of "m - Suc 0" m k "Suc 0" n])
apply simp_all
done

text {* Some variations of @{term split_div_lemma} *}
corollary le_less_div_conv: "
  0 < m \<Longrightarrow> (k * m \<le> n \<and> n < Suc k * m) = (n div m = k)"
by (metis div_mult_le mult.commute split_div_lemma)
lemma le_less_imp_div: "
  \<lbrakk> k * m \<le> n; n < Suc k * m \<rbrakk> \<Longrightarrow> n div m = k"
by (metis gr_implies_not0 mult_eq_if mult.commute neq0_conv split_div_lemma)
lemma div_imp_le_less: "
  \<lbrakk> n div m = k; 0 < m \<rbrakk> \<Longrightarrow> k * m \<le> n \<and> n < Suc k * m"
by (rule le_less_div_conv[THEN iffD2])

lemma div_le_mod_le_imp_le: "
  \<lbrakk> (a::nat) div m \<le> b div m; a mod m \<le> b mod m \<rbrakk> \<Longrightarrow> a \<le> b"
apply (rule subst[OF mod_div_equality2[of m a]])
apply (rule subst[OF mod_div_equality2[of m b]])
apply (rule add_le_mono)
apply (rule mult_le_mono2)
apply assumption+
done

lemma le_mod_add_eq_imp_add_mod_le: "
  \<lbrakk> a \<le> b; (a + k) mod m = (b::nat) mod m \<rbrakk> \<Longrightarrow> a + k mod m \<le> b"
by (metis add_le_mono2 diff_add_inverse le_add1 le_add_diff_inverse mod_diff1_eq mod_less_eq_dividend)

corollary mult_divisor_le_mod_ge_imp_ge: "
  \<lbrakk> (m::nat) * k \<le> n; r \<le> n mod m \<rbrakk> \<Longrightarrow> m * k + r \<le> n"
apply (insert le_mod_add_eq_imp_add_mod_le[of "m * k" n "n mod m" m])
apply (simp add: add.commute[of "m * k"])
done

subsection {* Additional multiplication results for @{text mod} and @{text div} *}

lemma mod_0_imp_mod_mult_right_0: "
  n mod m = (0::nat) \<Longrightarrow> n * k mod m = 0"
by fastforce
lemma mod_0_imp_mod_mult_left_0: "
  n mod m = (0::nat) \<Longrightarrow> k * n mod m = 0"
by fastforce

lemma mod_0_imp_div_mult_left_eq: "
  n mod m = (0::nat) \<Longrightarrow> k * n div m = k * (n div m)"
by fastforce
lemma mod_0_imp_div_mult_right_eq: "
  n mod m = (0::nat) \<Longrightarrow> n * k div m = k * (n div m)"
by fastforce

lemma mod_0_imp_mod_factor_0_left: "
  n mod (m * m') = (0::nat) \<Longrightarrow> n mod m = 0"
by fastforce
lemma mod_0_imp_mod_factor_0_right: "
  n mod (m * m') = (0::nat) \<Longrightarrow> n mod m' = 0"
by fastforce

subsection {* Some factor distribution facts for @{text mod}*}

lemma mod_eq_mult_distrib: "
  (a::nat) mod m = b mod m \<Longrightarrow>
  a * k mod (m * k) = b * k mod (m * k)"
by simp

lemma mod_mult_eq_imp_mod_eq: "
  (a::nat) mod (m * k) = b mod (m * k) \<Longrightarrow> a mod m = b mod m"
apply (simp only: mod_mult2_eq)
apply (drule_tac arg_cong[where f="\<lambda>x. x mod m"])
apply (simp add: add.commute)
done
corollary mod_eq_mod_0_imp_mod_eq: "
  \<lbrakk> (a::nat) mod m' = b mod m'; m' mod m = 0 \<rbrakk>
  \<Longrightarrow> a mod m = b mod m"
by (clarify, drule mod_mult_eq_imp_mod_eq)

lemma mod_factor_imp_mod_0: "
  \<lbrakk>(x::nat) mod (m * k) = y * k mod (m * k)\<rbrakk> \<Longrightarrow> x mod k = 0"
  (is "\<lbrakk> ?P1 \<rbrakk> \<Longrightarrow> ?Q")
proof -
  assume as1: ?P1
  have "y * k mod (m * k) = y mod m * k"
    by simp
  hence "x mod (m * k) = y mod m * k"
    using as1 by simp
  hence "y mod m * k = k * (x div k mod m) + x mod k" (is "?l1 = ?r1")
    by (simp only: ac_simps mod_mult2_eq)
  hence "(y mod m * k) mod k = ?r1 mod k"
    by simp
  hence "0 = ?r1 mod k"
    by simp
  thus "x mod k = 0"
    by (simp add: mod_add_eq)
qed
corollary mod_factor_div: "
  \<lbrakk>(x::nat) mod (m * k) = y * k mod (m * k)\<rbrakk> \<Longrightarrow> x div k * k = x"
by (blast intro: mod_factor_imp_mod_0[THEN mod_0_div_mult_cancel[THEN iffD1]])

lemma mod_factor_div_mod:"
  \<lbrakk> (x::nat) mod (m * k) = y * k mod (m * k); 0 < k \<rbrakk>
  \<Longrightarrow> x div k mod m = y mod m"
  (is "\<lbrakk> ?P1; ?P2 \<rbrakk> \<Longrightarrow> ?L = ?R")
proof -
  assume as1: ?P1
  assume as2: ?P2
  have x_mod_k_0: "x mod k = 0"
    using as1 by (blast intro: mod_factor_imp_mod_0)
  have "?L * k + x mod k = x mod (k * m)"
    by (simp only: mod_mult2_eq mult.commute[of _ k])
  hence "?L * k = x mod (k * m)"
    using x_mod_k_0 by simp
  hence "?L * k = y * k mod (m * k)"
    using as1 by (simp only: ac_simps)
  hence "?L * k = y mod m * k"
    by (simp only: mult_mod_left)
  thus ?thesis
    using as2 by simp
qed

subsection {* More results about quotient @{text div} with addition and subtraction *}

lemma div_add1_eq_if: "0 < m \<Longrightarrow>
  (a + b) div (m::nat) = a div m + b div m + (
    if a mod m + b mod m < m then 0 else Suc 0)"
apply (simp only: div_add1_eq[of a b])
apply (rule arg_cong[of "(a mod m + b mod m) div m"])
apply (clarsimp simp: linorder_not_less)
apply (rule le_less_imp_div[of "Suc 0" m "a mod m + b mod m"], simp)
apply simp
apply (simp only: add_less_mono[OF mod_less_divisor mod_less_divisor])
done
corollary div_add1_eq1: "
  a mod m + b mod m < (m::nat) \<Longrightarrow>
  (a + b) div (m::nat) = a div m + b div m"
apply (case_tac "m = 0", simp)
apply (simp add: div_add1_eq_if)
done
corollary div_add1_eq1_mod_0_left: "
  a mod m = 0 \<Longrightarrow> (a + b) div (m::nat) = a div m + b div m"
apply (case_tac "m = 0", simp)
apply (simp add: div_add1_eq1)
done
corollary div_add1_eq1_mod_0_right: "
  b mod m = 0 \<Longrightarrow> (a + b) div (m::nat) = a div m + b div m"
by (fastforce simp: div_add1_eq1_mod_0_left)
corollary div_add1_eq2: "
  \<lbrakk> 0 < m; (m::nat) \<le> a mod m + b mod m \<rbrakk> \<Longrightarrow>
  (a + b) div (m::nat) = Suc (a div m + b div m)"
by (simp add: div_add1_eq_if)

lemma div_Suc: "
  0 < n \<Longrightarrow> Suc m div n = (if Suc (m mod n) = n then Suc (m div n) else m div n)"
apply (drule Suc_leI, drule le_imp_less_or_eq)
apply (case_tac "n = Suc 0", simp)
apply (split split_if, intro conjI impI)
 apply (rule_tac t="Suc m" and s="m + 1" in subst, simp)
 apply (subst div_add1_eq2, simp+)
apply (insert le_neq_trans[OF mod_less_divisor[THEN Suc_leI, of n m]], simp)
apply (rule_tac t="Suc m" and s="m + 1" in subst, simp)
apply (subst div_add1_eq1, simp+)
done
lemma div_Suc': "
  0 < n \<Longrightarrow> Suc m div n = (if m mod n < n - Suc 0 then m div n else Suc (m div n))"
apply (simp add: div_Suc)
apply (intro conjI impI)
 apply simp
apply (insert le_neq_trans[OF mod_less_divisor[THEN Suc_leI, of n m]], simp)
done

lemma div_diff1_eq_if: "
  (b - a) div (m::nat) =
  b div m - a div m - (if a mod m \<le> b mod m then 0 else Suc 0)"
apply (case_tac "m = 0", simp)
apply (case_tac "b < a")
 apply (frule less_imp_le[of b])
 apply (frule div_le_mono[of _ _ m])
 apply simp
apply (simp only: linorder_not_less neq0_conv)
proof -
  assume le_as: "a \<le> b"
    and m_as: "0 < m"
  have div_le:"a div m \<le> b div m"
    using le_as by (simp only: div_le_mono)
  have "b - a = b div m * m + b mod m - (a div m * m + a mod m)"
    by simp
  also have "\<dots> = b div m * m + b mod m - a div m * m - a mod m"
    by simp
  also have "\<dots> = b div m * m - a div m * m + b mod m - a mod m"
    by (simp only: diff_add_assoc2[OF mult_le_mono1[OF div_le]])
  finally have b_a_s1: "b - a = (b div m - a div m) * m + b mod m - a mod m"
    (is "?b_a = ?b_a1")
    by (simp only: diff_mult_distrib)
  hence b_a_div_s: "(b - a) div m =
    ((b div m - a div m) * m + b mod m - a mod m) div m"
    by (rule arg_cong)

  show ?thesis
  proof (cases "a mod m \<le> b mod m")
    case True
    hence as': "a mod m \<le> b mod m" .

    have "(b - a) div m = ?b_a1 div m"
      using b_a_div_s .
    also have "\<dots> = ((b div m - a div m) * m + (b mod m - a mod m)) div m"
      using as' by simp
    also have "\<dots> = b div m - a div m + (b mod m - a mod m) div m"
      apply (simp only: add.commute)
      by (simp only: div_mult_self1[OF less_imp_neq[OF m_as, THEN not_sym]])
    finally have b_a_div_s': "(b - a) div m = \<dots>" .
    have "(b mod m - a mod m) div m = 0"
      by (rule div_less, rule less_imp_diff_less,
          rule mod_less_divisor, rule m_as)
    thus ?thesis
      using b_a_div_s' as'
      by simp
  next
    case False
    hence as1': "\<not> a mod m \<le> b mod m" .
    hence as': "b mod m < a mod m" by simp

    have a_div_less: "a div m < b div m"
      using le_as as'
      by (blast intro: le_mod_greater_imp_div_less)

    have "b div m - a div m = b div m - a div m - (Suc 0 - Suc 0)"
      by simp
    also have "\<dots> = b div m - a div m + Suc 0 - Suc 0"
      by simp
    also have "\<dots> = b div m - a div m - Suc 0 + Suc 0"
      by (simp only: diff_add_assoc2
        a_div_less[THEN zero_less_diff[THEN iffD2], THEN Suc_le_eq[THEN iffD2]])
    finally have b_a_div_s': "b div m - a div m = \<dots>" .

    have "(b - a) div m = ?b_a1 div m"
      using b_a_div_s .
    also have "\<dots> = ((b div m - a div m - Suc 0 + Suc 0) * m
      + b mod m - a mod m ) div m"
      using b_a_div_s' by (rule arg_cong)
    also have "\<dots> = ((b div m - a div m - Suc 0) * m
      + Suc 0 * m + b mod m - a mod m ) div m"
      by (simp only: add_mult_distrib)
    also have "\<dots> = ((b div m - a div m - Suc 0) * m
      + m + b mod m - a mod m ) div m"
      by simp
    also have "\<dots> = ((b div m - a div m - Suc 0) * m
      + (m + b mod m - a mod m) ) div m"
      by (simp only: add.assoc m_as
        diff_add_assoc[of "a mod m" "m + b mod m"]
        trans_le_add1[of "a mod m" m, OF mod_le_divisor])
    also have "\<dots> = b div m - a div m - Suc 0
      + (m + b mod m - a mod m) div m"
      by (simp only: add.commute div_mult_self1[OF less_imp_neq[OF m_as, THEN not_sym]])
    finally have b_a_div_s': "(b - a) div m = \<dots>" .

    have div_0_s: "(m + b mod m - a mod m) div m = 0"
      by (rule div_less, simp only: add_diff_less m_as as')
    show ?thesis
      by (simp add: as1' b_a_div_s' div_0_s)
  qed
qed

corollary div_diff1_eq: "
  (b - a) div (m::nat) =
  b div m - a div m - (m + a mod m - Suc (b mod m)) div m"
apply (case_tac "m = 0", simp)
apply (simp only: neq0_conv)
apply (rule subst[of
  "if a mod m \<le> b mod m then 0 else Suc 0"
  "(m + a mod m - Suc(b mod m)) div m"])
 prefer 2 apply (rule div_diff1_eq_if)
apply (split split_if, rule conjI)
 apply simp
apply (clarsimp simp: linorder_not_le)
apply (rule sym)
apply (drule Suc_le_eq[of "b mod m", THEN iffD2])
apply (simp only: diff_add_assoc)
apply (simp only: div_add_self1)
apply (simp add: less_imp_diff_less)
done

corollary div_diff1_eq1: "
  a mod m \<le> b mod m \<Longrightarrow>
  (b - a) div (m::nat) = b div m - a div m"
by (simp add: div_diff1_eq_if)
corollary div_diff1_eq1_mod_0: "
  a mod m = 0 \<Longrightarrow>
  (b - a) div (m::nat) = b div m - a div m"
by (simp add: div_diff1_eq1)
corollary div_diff1_eq2: "
  b mod m < a mod m \<Longrightarrow>
  (b - a) div (m::nat) = b div m - Suc (a div m)"
by (simp add: div_diff1_eq_if)

subsection {* Further results about @{text div} and @{text mod}*}

subsubsection {* Some auxiliary facts about @{text mod} *}

lemma diff_less_divisor_imp_sub_mod_eq: "
  \<lbrakk> (x::nat) \<le> y; y - x < m \<rbrakk> \<Longrightarrow> x = y - (y - x) mod m"
by simp
lemma diff_ge_divisor_imp_sub_mod_less: "
  \<lbrakk> (x::nat) \<le> y; m \<le> y - x; 0 < m \<rbrakk> \<Longrightarrow> x < y - (y - x) mod m"
apply (simp only: less_diff_conv)
apply (simp only: le_diff_conv2 add.commute[of m])
apply (rule less_le_trans[of _ "x + m"])
apply simp_all
done

lemma le_imp_sub_mod_le: "
  (x::nat) \<le> y \<Longrightarrow> x \<le> y - (y - x) mod m"
apply (case_tac "m = 0", simp_all)
apply (case_tac "m \<le> y - x")
apply (drule diff_ge_divisor_imp_sub_mod_less[of x y m])
apply simp_all
done

lemma mod_less_diff_mod: "
  \<lbrakk> n mod m < r; r \<le> m; r \<le> (n::nat) \<rbrakk> \<Longrightarrow>
  (n - r) mod m = m + n mod m - r"
apply (case_tac "r = m")
 apply (simp add: mod_diff_self2)
apply (simp add: mod_diff1_eq[of r n m])
done

lemma mod_0_imp_mod_pred: "
  \<lbrakk> 0 < (n::nat); n mod m = 0 \<rbrakk> \<Longrightarrow>
  (n - Suc 0) mod m = m - Suc 0"
apply (case_tac "m = 0", simp_all)
apply (simp only: Suc_le_eq[symmetric])
apply (simp only: mod_diff1_eq)
apply (case_tac "m = Suc 0")
apply simp_all
done

lemma mod_pred: "
  0 < n \<Longrightarrow>
  (n - Suc 0) mod m = (
    if n mod m = 0 then m - Suc 0 else n mod m - Suc 0)"
apply (split split_if, rule conjI)
 apply (simp add: mod_0_imp_mod_pred)
apply clarsimp
apply (case_tac "m = Suc 0", simp)
apply (frule subst[OF Suc0_mod[symmetric], where P="\<lambda>x. x \<le> n mod m"], simp)
apply (simp only: mod_diff1_eq1)
apply (simp add: Suc0_mod)
done
corollary mod_pred_Suc_mod: "
  0 < n \<Longrightarrow> Suc ((n - Suc 0) mod m) mod m = n mod m"
apply (case_tac "m = 0", simp)
apply (simp add: mod_pred)
done
corollary diff_mod_pred: "
  a < b \<Longrightarrow>
  (b - Suc a) mod m = (
    if a mod m = b mod m then m - Suc 0 else (b - a) mod m - Suc 0)"
apply (rule_tac t="b - Suc a" and s="b - a - Suc 0" in subst, simp)
apply (subst mod_pred, simp)
apply (simp add: mod_eq_diff_mod_0_conv)
done
corollary diff_mod_pred_Suc_mod: "
  a < b \<Longrightarrow> Suc ((b - Suc a) mod m) mod m = (b - a) mod m"
apply (case_tac "m = 0", simp)
apply (simp add: diff_mod_pred mod_eq_diff_mod_0_conv)
done

lemma mod_eq_imp_diff_mod_eq_divisor: "
  \<lbrakk> a < b; 0 < m; a mod m = b mod m \<rbrakk> \<Longrightarrow>
  Suc ((b - Suc a) mod m) = m"
apply (drule mod_eq_imp_diff_mod_0[of a])
apply (frule iffD2[OF zero_less_diff])
apply (drule mod_0_imp_mod_pred[of "b-a" m], assumption)
apply simp
done

lemma sub_diff_mod_eq: "
  r \<le> t \<Longrightarrow> (t - (t - r) mod m) mod (m::nat) = r mod m"
by (metis mod_diff_right_eq diff_diff_cancel diff_le_self)

lemma sub_diff_mod_eq': "
  r \<le> t \<Longrightarrow> (k * m + t - (t - r) mod m) mod (m::nat) = r mod m"
apply (simp only: diff_mod_le[of t r m, THEN add_diff_assoc, symmetric])
apply (simp add: sub_diff_mod_eq)
done

lemma mod_eq_Suc_0_conv: "Suc 0 < k \<Longrightarrow> ((x + k - Suc 0) mod k = 0) = (x mod k = Suc 0)"
apply (simp only: mod_pred)
apply (case_tac "x mod k = Suc 0")
apply simp_all
done

lemma mod_eq_divisor_minus_Suc_0_conv: "Suc 0 < k \<Longrightarrow> (x mod k = k - Suc 0) = (Suc x mod k = 0)"
by (simp only: mod_Suc, split split_if, fastforce)

subsubsection {* Some auxiliary facts about @{text div} *}

lemma sub_mod_div_eq_div: "((n::nat) - n mod m) div m = n div m"
apply (case_tac "m = 0", simp)
apply (simp add: mult_div_cancel[symmetric])
done

lemma mod_less_imp_diff_div_conv: "
  \<lbrakk> n mod m < r; r \<le> m + n mod m\<rbrakk> \<Longrightarrow> (n - r) div m = n div m - Suc 0"
apply (case_tac "m = 0", simp)
apply (simp only: neq0_conv)
apply (case_tac "n < m", simp)
apply (simp only: linorder_not_less)
apply (rule iffD1[OF split_div_lemma, symmetric], assumption)
apply (rule conjI)
apply (simp_all add: diff_mult_distrib2 mult_div_cancel)
done

corollary mod_0_le_imp_diff_div_conv: "
  \<lbrakk> n mod m = 0; 0 < r; r \<le> m \<rbrakk> \<Longrightarrow> (n - r) div m = n div m - Suc 0"
by (simp add: mod_less_imp_diff_div_conv)
corollary mod_0_less_imp_diff_Suc_div_conv: "
  \<lbrakk> n mod m = 0; r < m \<rbrakk> \<Longrightarrow> (n - Suc r) div m = n div m - Suc 0"
by (drule mod_0_le_imp_diff_div_conv[where r="Suc r"], simp_all)
corollary mod_0_imp_diff_Suc_div_conv: "
  (n - r) mod m = 0 \<Longrightarrow> (n - Suc r) div m = (n - r) div m - Suc 0"
apply (case_tac "m = 0", simp)
apply (rule_tac t="n - Suc r" and s="n - r - Suc 0" in subst, simp)
apply (rule mod_0_le_imp_diff_div_conv, simp+)
done
corollary mod_0_imp_sub_1_div_conv: "
  n mod m = 0 \<Longrightarrow> (n - Suc 0) div m = n div m - Suc 0"
apply (case_tac "m = 0", simp)
apply (simp add: mod_0_less_imp_diff_Suc_div_conv)
done
corollary sub_Suc_mod_div_conv: "
  (n - Suc (n mod m)) div m = n div m - Suc 0"
apply (case_tac "m = 0", simp)
apply (simp add: mod_less_imp_diff_div_conv)
done

lemma div_le_conv: "0 < m \<Longrightarrow> n div m \<le> k = (n \<le> Suc k * m - Suc 0)"
apply (rule iffI)
 apply (drule mult_le_mono1[of _ _ m])
 apply (simp only: mult.commute[of _ m] mult_div_cancel)
 apply (drule le_diff_conv[THEN iffD1])
 apply (rule le_trans[of _ "m * k + n mod m"], assumption)
 apply (simp add: add.commute[of m])
 apply (simp only: diff_add_assoc[OF Suc_leI])
 apply (rule add_le_mono[OF le_refl])
 apply (rule less_imp_le_pred)
 apply (rule mod_less_divisor, assumption)
apply (drule div_le_mono[of _ _ m])
apply (simp add: mod_0_imp_sub_1_div_conv)
done

lemma le_div_conv: "0 < (m::nat) \<Longrightarrow> (n \<le> k div m) = (n * m \<le> k)"
apply (rule iffI)
 apply (drule mult_le_mono1[of _ _ m])
 apply (simp add: div_mult_cancel)
apply (drule div_le_mono[of _ _ m])
apply simp
done

lemma less_mult_imp_div_less: "n < k * m \<Longrightarrow> n div m < (k::nat)"
apply (case_tac "k = 0", simp)
apply (case_tac "m = 0", simp)
apply simp
apply (drule less_imp_le_pred[of n])
apply (drule div_le_mono[of _ _ m])
apply (simp add: mod_0_imp_sub_1_div_conv)
done

lemma div_less_imp_less_mult: "\<lbrakk> 0 < (m::nat); n div m < k \<rbrakk> \<Longrightarrow> n < k * m"
apply (rule ccontr, simp only: linorder_not_less)
apply (drule div_le_mono[of _ _ m])
apply simp
done

lemma div_less_conv: "0 < (m::nat) \<Longrightarrow> (n div m < k) = (n < k * m)"
apply (rule iffI)
apply (rule div_less_imp_less_mult, assumption+)
apply (rule less_mult_imp_div_less, assumption)
done

lemma div_eq_0_conv: "(n div (m::nat) = 0) = (m = 0 \<or> n < m)"
apply (rule iffI)
 apply (case_tac "m = 0", simp)
 apply (rule ccontr)
 apply (simp add: linorder_not_less)
 apply (drule div_le_mono[of _ _ m])
 apply simp
apply fastforce
done
lemma div_eq_0_conv': "0 < m \<Longrightarrow> (n div (m::nat) = 0) = (n < m)"
by (simp add: div_eq_0_conv)
corollary div_gr_imp_gr_divisor: "x < n div (m::nat) \<Longrightarrow> m \<le> n"
apply (drule gr_implies_gr0, drule neq0_conv[THEN iffD2])
apply (simp add: div_eq_0_conv)
done

lemma mod_0_less_div_conv: "
  n mod (m::nat) = 0 \<Longrightarrow> (k * m < n) = (k < n div m)"
apply (case_tac "m = 0", simp)
apply fastforce
done

lemma add_le_divisor_imp_le_Suc_div: "
  \<lbrakk> x div m \<le> n; y \<le> m \<rbrakk> \<Longrightarrow> (x + y) div m \<le> Suc n"
apply (case_tac "m = 0", simp)
apply (simp only: div_add1_eq_if[of _ x])
apply (drule order_le_less[of y, THEN iffD1], fastforce)
done

text {* List of definitions and lemmas *}

thm
  Divides.mod_less
  Divides.mod_less_divisor
  Divides.mod_le_divisor
  mod_less_dividend
  mod_le_dividend

thm
  Divides.mult_div_cancel
  mod_0_div_mult_cancel
  div_mult_le
  less_div_Suc_mult
thm
  Suc0_mod
  Suc0_mod_subst
  Suc0_mod_cong

thm
  Divides.mod_Suc
thm
  mod_Suc_conv

thm
  mod_add
  mod_sub_add

thm
  mod_sub_eq_mod_0_conv
  mod_sub_eq_mod_swap

thm
  le_mod_greater_imp_div_less
thm
  mod_diff_right_eq
  mod_eq_imp_diff_mod_eq

thm
  divisor_add_diff_mod_if
  divisor_add_diff_mod_eq1
  divisor_add_diff_mod_eq2

thm
  mod_add_eq
  mod_add1_eq_if
thm
  mod_diff1_eq_if
  mod_diff1_eq
  mod_diff1_eq1
  mod_diff1_eq2

thm
  Divides.nat_mod_distrib
  int_mod_distrib

thm
  zmod_zminus_eq_conv

thm
  mod_eq_imp_diff_mod_0
  zmod_eq_imp_diff_mod_0

thm
  mod_neq_imp_diff_mod_neq0
  diff_mod_0_imp_mod_eq
  zdiff_mod_0_imp_mod_eq

thm
  zmod_eq_diff_mod_0_conv
  mod_eq_diff_mod_0_conv

thm
  less_mod_eq_imp_add_divisor_le
thm
  mod_add_eq_imp_mod_0
thm
  mod_eq_mult_distrib
  mod_factor_imp_mod_0
  mod_factor_div
  mod_factor_div_mod

thm
  Divides.mod_add_self1
  Divides.mod_add_self2
  Divides.mod_mult_self1
  Divides.mod_mult_self2

  mod_diff_self1
  mod_diff_self2
  mod_diff_mult_self1
  mod_diff_mult_self2

thm
  Divides.div_add_self1
  Divides.div_add_self2
  Divides.div_mult_self1
  Divides.div_mult_self2

  div_diff_self1
  div_diff_self2
  div_diff_mult_self1
  div_diff_mult_self2

thm
  le_less_imp_div
  div_imp_le_less
thm
  le_less_div_conv

thm
  diff_less_divisor_imp_sub_mod_eq
  diff_ge_divisor_imp_sub_mod_less
  le_imp_sub_mod_le

thm
  sub_mod_div_eq_div

thm
  mod_less_imp_diff_div_conv
  mod_0_le_imp_diff_div_conv
  mod_0_less_imp_diff_Suc_div_conv
  mod_0_imp_sub_1_div_conv

thm
  sub_Suc_mod_div_conv

thm
  mod_less_diff_mod
  mod_0_imp_mod_pred

thm
  mod_pred
  mod_pred_Suc_mod

thm
  mod_eq_imp_diff_mod_eq_divisor

thm
  diff_mod_le
  sub_diff_mod_eq
  sub_diff_mod_eq'

thm
  Divides.div_add1_eq
  div_add1_eq_if
  div_add1_eq1
  div_add1_eq2
thm
  div_diff1_eq_if
  div_diff1_eq
  div_diff1_eq1
  div_diff1_eq2

thm
  div_le_conv

end


(*
  Author: Jose Divasón
  Email:  jose.divason@unirioja.es
*)

section \<open>Definition of Smith normal form in JNF\<close>

theory Smith_Normal_Form_JNF
  imports
    SNF_Missing_Lemmas
begin

text \<open>Now, we define diagonal matrices and Smith normal form in JNF\<close>

definition "isDiagonal_mat A = (\<forall>i j. i \<noteq> j \<and> i < dim_row A \<and> j < dim_col A \<longrightarrow> A$$(i,j) = 0)"

definition "Smith_normal_form_mat A =
  (
    (\<forall>a. a + 1 < min (dim_row A) (dim_col A) \<longrightarrow> A $$ (a,a) dvd A $$ (a+1,a+1))
    \<and> isDiagonal_mat A
  )"

lemma SNF_first_divides:
  assumes SNF_A: "Smith_normal_form_mat A" and "(A::('a::comm_ring_1) mat) \<in> carrier_mat n m"
  and i: "i < min (dim_row A) (dim_col A)"
shows "A $$ (0,0) dvd A $$ (i,i)"
  using i
proof (induct i)
  case 0
  then show ?case by auto
next
  case (Suc i)
  show ?case
    by (metis (full_types) Smith_normal_form_mat_def Suc.hyps Suc.prems
        Suc_eq_plus1 Suc_lessD SNF_A dvd_trans)
qed

lemma Smith_normal_form_mat_intro:
  assumes "(\<forall>a. a + 1 < min (dim_row A) (dim_col A) \<longrightarrow> A $$ (a,a) dvd A $$ (a+1,a+1))"
    and "isDiagonal_mat A"
  shows "Smith_normal_form_mat A"
  unfolding Smith_normal_form_mat_def using assms by auto

lemma Smith_normal_form_mat_m0[simp]:
  assumes A: "A\<in>carrier_mat m 0"
  shows "Smith_normal_form_mat A"
  using A unfolding Smith_normal_form_mat_def isDiagonal_mat_def by auto

lemma Smith_normal_form_mat_0m[simp]:
  assumes A: "A\<in>carrier_mat 0 m"
  shows "Smith_normal_form_mat A"
  using A unfolding Smith_normal_form_mat_def isDiagonal_mat_def by auto

lemma S00_dvd_all_A:
  assumes A: "(A::'a::comm_ring_1 mat) \<in> carrier_mat m n"
  and P: "P \<in> carrier_mat m m"
  and Q: "Q \<in> carrier_mat n n"
  and inv_P: "invertible_mat P"
  and inv_Q: "invertible_mat Q"
  and S_PAQ: "S = P*A*Q"
  and SNF_S: "Smith_normal_form_mat S"
  and i: "i<m" and j: "j<n"
shows "S$$(0,0) dvd A $$ (i,j)"
proof -
  have S00: "(\<forall>i j. i<m \<and> j<n \<longrightarrow> S$$(0,0) dvd S$$(i,j))"
    using SNF_S unfolding Smith_normal_form_mat_def isDiagonal_mat_def
    by (smt P Q SNF_first_divides A S_PAQ SNF_S carrier_matD
        dvd_0_right min_less_iff_conj mult_carrier_mat)
    obtain P' where PP': "inverts_mat P P'" and P'P: "inverts_mat P' P"
      using inv_P unfolding invertible_mat_def by auto
    obtain Q' where QQ': "inverts_mat Q Q'" and Q'Q: "inverts_mat Q' Q"
      using inv_Q unfolding invertible_mat_def by auto
    have A_P'SQ': "P'*S*Q' = A"
    proof -
      have "P'*S*Q' = P'*(P*A*Q)*Q'" unfolding S_PAQ by auto
      also have "... = (P'*P)*A*(Q*Q')"
        by (smt A PP' Q Q'Q P assoc_mult_mat carrier_mat_triv index_mult_mat(2) index_mult_mat(3)
            index_one_mat(3) inverts_mat_def right_mult_one_mat)
      also have "... = A"
        by (metis A P'P QQ' A Q P carrier_matD(1) index_mult_mat(3) index_one_mat(3) inverts_mat_def
            left_mult_one_mat right_mult_one_mat)
      finally show ?thesis .
    qed
    have "(\<forall>i j. i<m \<and> j<n \<longrightarrow> S$$(0,0) dvd (P'*S*Q')$$(i,j))"
    proof (rule dvd_elements_mult_matrix_left_right[OF _ _ _ S00])
      show "S \<in> carrier_mat m n" using P A Q S_PAQ by auto
      show "P' \<in> carrier_mat m m"
        by (metis (mono_tags, lifting) A_P'SQ' PP' P A carrier_matD carrier_matI index_mult_mat(2)
            index_mult_mat(3) inverts_mat_def one_carrier_mat)
      show "Q' \<in> carrier_mat n n"
        by (metis (mono_tags, lifting) A_P'SQ' Q'Q Q A carrier_matD(2) carrier_matI
            index_mult_mat(3) inverts_mat_def one_carrier_mat)
    qed
    thus ?thesis using A_P'SQ' i j by auto
qed

lemma SNF_first_divides_all:
  assumes SNF_A: "Smith_normal_form_mat A" and A: "(A::('a::comm_ring_1) mat) \<in> carrier_mat m n"
  and i: "i < m" and j: "j<n"
shows "A $$ (0,0) dvd A $$ (i,j)"
proof (cases "i=j")
  case True
  then show ?thesis using assms SNF_first_divides by (metis carrier_matD min_less_iff_conj)
next
  case False
  hence "A$$(i,j) = 0" using SNF_A i j A unfolding Smith_normal_form_mat_def isDiagonal_mat_def by auto
  then show ?thesis by auto
qed

(*This can also be obtained from HOL Analysis via local type definitions*)
lemma SNF_divides_diagonal:
  fixes A::"'a::comm_ring_1 mat"
  assumes A: "A \<in> carrier_mat n m"
    and SNF_A: "Smith_normal_form_mat A"
    and j: "j < min n m"
    and ij: "i\<le>j"
  shows "A$$(i,i) dvd A$$(j,j)"
  using ij j
proof (induct j)
  case 0
  then show ?case by auto
next
  case (Suc j)
  show ?case
  proof (cases "i\<le>j")
    case True
    have "A $$ (i, i) dvd A $$ (j, j)" using Suc.hyps Suc.prems True by simp
    also have "... dvd A $$ (Suc j, Suc j)"
      using SNF_A Suc.prems A
      unfolding Smith_normal_form_mat_def by auto
    finally show ?thesis by auto
  next
    case False
    hence "i=Suc j" using Suc.prems by auto
    then show ?thesis by auto
  qed
qed

lemma Smith_zero_imp_zero:
  fixes A::"'a::comm_ring_1 mat"
  assumes  A: "A \<in> carrier_mat m n"
    and SNF: "Smith_normal_form_mat A"
    and Aii: "A$$(i,i) = 0"
    and j: "j<min m n"
    and ij: "i\<le>j"
  shows "A$$(j,j) = 0"
proof -
  have "A$$(i,i) dvd A$$(j,j)" by (rule SNF_divides_diagonal[OF A SNF j ij])
  thus ?thesis using Aii by auto
qed

lemma SNF_preserved_multiples_identity:
  assumes S: "S \<in> carrier_mat m n" and SNF: "Smith_normal_form_mat (S::'a::comm_ring_1 mat)"
  shows "Smith_normal_form_mat (S*(k \<cdot>\<^sub>m 1\<^sub>m n))"
proof (rule Smith_normal_form_mat_intro)
  have rw: "S*(k \<cdot>\<^sub>m 1\<^sub>m n) = Matrix.mat m n (\<lambda>(i, j). S $$ (i, j) * k)"
    unfolding mat_diag_smult[symmetric] by (rule mat_diag_mult_right[OF S])
  show "isDiagonal_mat (S * (k \<cdot>\<^sub>m 1\<^sub>m n))"
    using SNF S unfolding Smith_normal_form_mat_def isDiagonal_mat_def rw
    by auto
  show "\<forall>a. a + 1 < min (dim_row (S * (k \<cdot>\<^sub>m 1\<^sub>m n))) (dim_col (S * (k \<cdot>\<^sub>m 1\<^sub>m n))) \<longrightarrow>
        (S * (k \<cdot>\<^sub>m 1\<^sub>m n)) $$ (a, a) dvd (S * (k \<cdot>\<^sub>m 1\<^sub>m n)) $$ (a + 1, a + 1)"
    using SNF S unfolding Smith_normal_form_mat_def isDiagonal_mat_def rw
    by (auto simp add: mult_dvd_mono)
qed

end


theory Exercise3p4
imports Main
begin

(* Exercise 3.4.

Take a copy of theory AExp and modify it as follows. Extend type
aexp with a binary constructor Times that represents multiplication. Modify
the definition of the functions aval and asimp accordingly. You can remove
asimp_const. Function asimp should eliminate 0 and 1 from multiplications as
well as evaluate constant subterms. Update all proofs concerned.

*)

type_synonym vname = string
datatype aexp = N int | V vname | Plus aexp aexp | Times aexp aexp

type_synonym val = int
type_synonym state = "vname \<Rightarrow> val"

fun aval :: "aexp \<Rightarrow> state \<Rightarrow> val" where
  "aval (N n) s = n" |
  "aval (V x) s = s x" |
  "aval (Plus a1 a2) s = aval a1 s + aval a2 s" |
  "aval (Times a1 a2) s = aval a1 s * aval a2 s"

value "aval (Plus (N 3) (V ''x'')) (\<lambda>x.0)"

fun plus :: "aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
  "plus (N i1) (N i2) = N (i1 + i2)" |
  "plus (N i) a = (if i = 0 then a else Plus (N i) a)" |
  "plus a (N i) = (if i = 0 then a else Plus a (N i))" |
  "plus a1 a2 = Plus a1 a2"

lemma aval_plus: "aval (plus a1 a2) s = aval a1 s + aval a2 s"
  apply (induction a1 a2 rule: plus.induct)
              apply auto
    done

fun times :: "aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
  "times (N i1) (N i2) = N (i1 * i2)" |
  "times (N i) a = (if i = 1 then a else Times (N i) a)" |
  "times a (N i) = (if i = 1 then a else Times a (N i))" |
  "times a1 a2 = Times a1 a2"

lemma aval_times: "aval (times a1 a2) s = aval a1 s * aval a2 s"
  apply (induction a1 a2 rule: times.induct)
                      apply auto
    done

fun asimp :: "aexp \<Rightarrow> aexp" where
  "asimp (N n) = N n" |
  "asimp (V x) = V x" |
  "asimp (Plus a1 a2) = plus (asimp a1) (asimp a2)" |
  "asimp (Times a1 a2) = times (asimp a1) (asimp a2)"

lemma "aval (asimp a) s = aval a s"
  apply (induction a)
    apply (auto simp: aval_plus aval_times)
    done

end


(*
 * Copyright 2019, NTU
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 *  Author: Albert Rizaldi, NTU Singapore
 *)

theory Bits_Int_Aux
  imports
    Main "HOL-Word.Word" "HOL.Archimedean_Field"
begin

text \<open>The function @{term "bl_to_bin_aux"} is the auxiliary function for converting a bit vector
(list of booleans) into an integer with unsigned number interpretation. This semantics or conversion
is taken from @{cite "Bryant2010"} (Chapter 2.2). Given a list x = [x_{n-1}, x_{n-2}, ... , x_0] of
booleans with conversion False \<mapsto> 0 and True \<mapsto> 1, the unsigned number it represents is

    B2U (x) \<equiv> \<Sum>i=0..<n. x_i * 2 ^ i   .

The following lemma formalises this correctness.\<close>

lemma bl_to_bin_aux_correctness:
  " bl_to_bin_aux bs w =  w * 2 ^ length bs + (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (rev bs ! i) * 2 ^ i)"
proof (induction bs arbitrary: w)
  case Nil
  then show ?case by auto
next
  case (Cons a bs)
    \<comment> \<open>from left hand side\<close>
  have " bl_to_bin_aux (a # bs) w = bl_to_bin_aux bs (w BIT a)"
    by auto
  also have "... =  (w BIT a) * 2 ^ length bs + (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (rev bs ! i) * 2 ^ i)" (is "_ = _ + ?rhs2")
    using Cons by auto
  also have "... = (2 * w + (int o of_bool) a) * 2 ^ length bs + ?rhs2"
    unfolding Bit_def by auto
  also have "... = w * 2 ^ (length (a # bs)) + (int o of_bool) a * 2 ^ length bs + ?rhs2"
    by (auto simp add: field_simps)
  also have "... = w * 2 ^ length (a # bs) + (\<Sum>i = 0..<length (a # bs). (int \<circ> of_bool) (rev (a # bs) ! i) * 2 ^ i)"
  proof -
    have "(\<Sum>i = 0..<length (a # bs). (int \<circ> of_bool) (rev (a # bs) ! i) * 2 ^ i) =
          (\<Sum>i = 0..<Suc (length bs). (int \<circ> of_bool) (rev (a # bs) ! i) * 2 ^ i) "
      by auto
    also have "... = (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (rev (a # bs) ! i) * 2 ^ i) + (int \<circ> of_bool) a * 2 ^ length bs "
      using nth_rev_alt by fastforce
    also have "... = (\<Sum>i= 0..< length bs. (int o of_bool) (rev bs ! i) * 2 ^ i) + (int o of_bool) a * 2 ^ length bs"
      unfolding cancel_semigroup_add_class.add_right_cancel
    proof (intro sum.mono_neutral_cong)
      fix x
      assume "x \<in> {0..<length bs} \<inter> {0..<length bs}"
      hence "x \<in> {0 ..< length bs}"
        by auto
      thus "(int \<circ> of_bool) (rev (a # bs) ! x) * 2 ^ x = (int \<circ> of_bool) (rev bs ! x) * 2 ^ x"
        by (smt atLeastLessThan_iff bin_nth_of_bl_aux bl_to_bin_aux.simps(2) length_Cons less_Suc_eq not_less)
    qed (auto)
    finally show ?thesis
      by auto
  qed
  finally show ?case
    by auto
qed

lemma bl_to_bin_correctness:
  "bl_to_bin bs = (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (rev bs ! i) * 2 ^ i)"
  unfolding bl_to_bin_def using bl_to_bin_aux_correctness by auto

text \<open> In case it is interpreted as a signed number, the equation is

    B2S (x) \<equiv> - x_{n-1} * 2 ^ {n - 1} + \<Sum>i=0..<n-1. x_i * 2 ^ i .

Note that the most significant bit has the value of (- 2 ^ {n - 1}) instead of (2 ^ {n - 1}).
Unfortunately there is no such function in @{theory "HOL-Word.Bits_Int"}. Fortunately we can
easily obtain such function with simple arithmetic as follows.
\<close>

fun sbl_to_bin :: "bool list \<Rightarrow> int" where
  "sbl_to_bin [] = 0"
| "sbl_to_bin bs = bl_to_bin bs - (int o of_bool) (hd bs) * 2 ^ (length bs)"

text \<open>This is the correctness theorem according to the definition of B2S. \<close>

lemma sbl_to_bin_correctness:
  "sbl_to_bin (a # bs) = - (int o of_bool) a * 2 ^ (length bs) + (\<Sum>i = 0 ..< length bs. ((int o of_bool) (rev bs ! i)) * 2 ^ i) "
proof -
  have "sbl_to_bin (a # bs) = bl_to_bin (a # bs) - (int o of_bool) a * 2 ^ (1 + length bs)"
    by auto
  also have "... = bl_to_bin (a # bs) - 2 * (int o of_bool) a * 2 ^ length bs"
    by auto
  also have "... = (\<Sum>i = 0..< Suc (length bs). (int \<circ> of_bool) (rev (a # bs) ! i) * 2 ^ i) - 2 * (int o of_bool) a * 2 ^ length bs"
    unfolding bl_to_bin_correctness by auto
  also have "... = (\<Sum>i = 0..< length bs. (int \<circ> of_bool) (rev (a # bs) ! i) * 2 ^ i) + (int o of_bool) a * 2 ^ length bs - 2 * (int o of_bool) a * 2 ^ length bs"
    using list.size(4) nth_rev_alt by fastforce
  also have "... = (\<Sum>i = 0..< length bs. (int \<circ> of_bool) (rev (a # bs) ! i) * 2 ^ i) - (int o of_bool) a * 2 ^ length bs"
    by auto
  also have "... = (\<Sum>i = 0..< length bs. (int \<circ> of_bool) (rev bs ! i) * 2 ^ i) - (int o of_bool) a * 2 ^ length bs"
  proof -
    have "(\<Sum>i = 0..<length bs. (int \<circ> of_bool) (rev (a # bs) ! i) * 2 ^ i) =
          (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (rev bs ! i) * 2 ^ i)"
      apply (intro sum.mono_neutral_cong[rotated 4])
      by (smt One_nat_def add.commute atLeastLessThan_iff bin_nth_of_bl bin_nth_of_bl_aux
      bl_to_bin_aux.Cons inf.idem less_Suc_eq list.size(4) not_less plus_1_eq_Suc) auto
    thus ?thesis
      by auto
  qed
  finally show ?thesis
    by auto
qed

lemma sign_bit_is_0:
  assumes "0 \<le> w" and "w < 2 ^ len"
  shows   "hd (bin_to_bl (Suc len) w) = False"
  using assms sbintrunc_mod2p sign_Min_lt_0 unfolding bl_sbin_sign by auto

lemma sign_bit_is_1:
  assumes "w < 0" and "- w < 2 ^ len"
  shows   "hd (bin_to_bl (Suc len) w) = True"
  using assms bin_sign_def no_sbintr_alt2 unfolding bl_sbin_sign by auto

lemma sbin_bl_bin:
  assumes "0 < n" and "\<bar>w\<bar> < 2 ^ (n - 1)"
  shows "sbl_to_bin (bin_to_bl n w) = w"
proof -
  obtain a bs where "bin_to_bl n w = (a # bs)"
    using assms  size_bin_to_bl  by (metis list.size(3) not_less_zero sbl_to_bin.cases)
  have "sbl_to_bin (bin_to_bl n w) = sbl_to_bin (a # bs)"
    using \<open>bin_to_bl n w = (a # bs)\<close> by auto
  also have "... = - (int o of_bool) a * 2 ^ (length bs)
                 + (\<Sum>i = 0 ..< length bs. ((int o of_bool) (rev bs ! i)) * 2 ^ i)"
    unfolding sbl_to_bin_correctness by auto
  finally have "sbl_to_bin (bin_to_bl n w) = - (int o of_bool) a * 2 ^ (length bs)
                                           + (\<Sum>i = 0 ..< length bs. ((int o of_bool) (rev bs ! i)) * 2 ^ i)"
    by auto
  have "sbl_to_bin (bin_to_bl n w) = sbl_to_bin (a # bs)"
    using \<open>bin_to_bl n w = a # bs\<close> by auto
  also have "... = bl_to_bin (a # bs) - (int o of_bool) a * 2 ^ (1 + length bs)"
    by auto
  also have "... = bl_to_bin (bin_to_bl n w) - (int o of_bool) a * 2 ^ (1 + length bs)"
    using \<open>bin_to_bl n w = a # bs\<close> by auto
  also have "... = bintrunc n w - (int o of_bool) a * 2 ^ (1 + length bs)"
    unfolding bin_bl_bin by auto
  also have "... = w mod (2 ^ n) - (int o of_bool) a * 2 ^ (1 + length bs)"
    by (simp add: no_bintr_alt1)
  also have "... = w mod (2 ^ n) - (int o of_bool) a * 2 ^ n"
    by (metis \<open>bin_to_bl n w = a # bs\<close> length_Cons plus_1_eq_Suc size_bin_to_bl)
  also have "... = w"
  proof (cases "0 \<le> w")
    case True
    hence "a = False"
      using sign_bit_is_0
      by (smt One_nat_def \<open>bin_to_bl n w = a # bs\<close> add.commute add_diff_cancel_left' assms(2)
      length_Cons list.sel(1) list.size(4) size_bin_to_bl)
    then show ?thesis
      by (smt Bit_B1_2t One_nat_def True \<open>bin_to_bl n w = a # bs\<close> add.commute add_diff_cancel_left'
      assms(2) comp_apply int_mod_eq' list.size(4) mult_eq_0_iff of_bool_eq(1) plus_1_eq_Suc
      power_BIT semiring_1_class.of_nat_0 size_bin_to_bl)
  next
    case False
    hence "a = True"
      using sign_bit_is_1
      by (smt One_nat_def \<open>bin_to_bl n w = a # bs\<close> add.commute add_diff_cancel_left' assms(2)
      list.sel(1) list.size(4) plus_1_eq_Suc size_bin_to_bl)
    obtain w' where "w = -w'"
      using False  by (metis add.inverse_inverse)
    hence *: "- w' mod 2 ^ n = (if w' mod 2 ^ n = 0 then 0 else 2 ^ n - w' mod 2 ^ n)"
      unfolding zmod_zminus1_eq_if by auto
    have "w' < 2 ^ n"
      by (smt One_nat_def \<open>bin_to_bl n w = a # bs\<close> \<open>w = - w'\<close> add.commute add_diff_cancel_left'
      assms(2) less_Suc_eq list.size(4) plus_1_eq_Suc power_strict_increasing_iff size_bin_to_bl)
    hence "w' mod 2 ^ n \<noteq> 0"
      using False \<open>w = - w'\<close> by auto
    hence "- w' mod 2 ^ n = 2 ^ n - (w' mod 2 ^ n)"
      using * by auto
    hence "w mod 2 ^ n = 2 ^ n - (\<bar>w\<bar> mod 2 ^ n)"
      using False \<open>w = - w'\<close> by auto
    hence "w mod 2 ^ n - (int \<circ> of_bool) a * 2 ^ n = 2 ^ n - (\<bar>w\<bar> mod 2 ^ n) - 2 ^ n"
      by (simp add: \<open>a = True\<close>)
    also have "... = - (\<bar>w\<bar> mod 2 ^ n)"
      by auto
    also have "... = w"
      using False \<open>w = - w'\<close> \<open>w' < 2 ^ n\<close> by auto
    finally show ?thesis
      by auto
  qed
  finally show ?thesis
    by auto
qed

lemma sbin_bl_bin':
  assumes "0 < n"
  shows   "sbl_to_bin (bin_to_bl n w) mod 2 ^ n = w mod 2 ^ n"
proof -
  obtain a bs where "bin_to_bl n w = (a # bs)"
    using assms  size_bin_to_bl  by (metis list.size(3) not_less_zero sbl_to_bin.cases)
  have "sbl_to_bin (bin_to_bl n w) = sbl_to_bin (a # bs)"
    using \<open>bin_to_bl n w = (a # bs)\<close> by auto
  also have "... = - (int o of_bool) a * 2 ^ (length bs)
                 + (\<Sum>i = 0 ..< length bs. ((int o of_bool) (rev bs ! i)) * 2 ^ i)"
    unfolding sbl_to_bin_correctness by auto
  finally have "sbl_to_bin (bin_to_bl n w) = - (int o of_bool) a * 2 ^ (length bs)
                                           + (\<Sum>i = 0 ..< length bs. ((int o of_bool) (rev bs ! i)) * 2 ^ i)"
    by auto
  have "sbl_to_bin (bin_to_bl n w) = sbl_to_bin (a # bs)"
    using \<open>bin_to_bl n w = a # bs\<close> by auto
  also have "... = bl_to_bin (a # bs) - (int o of_bool) a * 2 ^ (1 + length bs)"
    by auto
  also have "... = bl_to_bin (bin_to_bl n w) - (int o of_bool) a * 2 ^ (1 + length bs)"
    using \<open>bin_to_bl n w = a # bs\<close> by auto
  also have "... = bintrunc n w - (int o of_bool) a * 2 ^ (1 + length bs)"
    unfolding bin_bl_bin by auto
  also have "... = w mod (2 ^ n) - (int o of_bool) a * 2 ^ (1 + length bs)"
    by (simp add: no_bintr_alt1)
  also have "... = w mod (2 ^ n) - (int o of_bool) a * 2 ^ n"
    by (metis \<open>bin_to_bl n w = a # bs\<close> length_Cons plus_1_eq_Suc size_bin_to_bl)
  finally have "sbl_to_bin (bin_to_bl n w) = w mod (2 ^ n) - (int o of_bool) a * 2 ^ n"
    by auto
  hence "sbl_to_bin (bin_to_bl n w) mod 2 ^ n = (w mod 2 ^ n - (int o of_bool) a * 2 ^ n) mod 2 ^ n"
    by auto
  also have "... = (w - (int \<circ> of_bool) a * 2 ^ n) mod 2 ^ n"
    using pull_mods(6)[where a="w" and c="2 ^ n" and b="(int o of_bool) a * 2 ^ n"] by auto
  also have "... = w mod 2 ^ n"
    by simp
  finally show ?thesis
    by auto
qed

lemma butlast_pow_rest_bl2bin:
  "bl_to_bin ((butlast ^^ n) bl) = (bin_rest ^^ n) (bl_to_bin bl)"
  by (simp add: bin_rest_bl_to_bin fn_comm_power')

lemma take_rest_bl2bin:
  "bl_to_bin (take (length bl - n) bl) = (bin_rest ^^ n) (bl_to_bin bl)"
  by (metis butlast_pow_rest_bl2bin butlast_power)

lemma bin_rest_compow:
  "(bin_rest ^^ m) n = (n div 2 ^ m)"
  using bin_rest_shiftr shiftr_int_def by (induct m) auto

lemma bin_rest_sbl_to_bin:
  assumes "1 < length bs"
  shows "bin_rest (sbl_to_bin bs) = sbl_to_bin (butlast bs)"
proof -
  have "sbl_to_bin bs = bl_to_bin bs - (int o of_bool) (hd bs) * 2 ^ (length bs)"
    using assms  by (metis (full_types) list.size(3) not_less_zero sbl_to_bin.elims)
  hence "bin_rest (sbl_to_bin bs) = bin_rest (bl_to_bin bs + - (int o of_bool) (hd bs) * 2 ^ length bs)"
    by auto
  also have "... = bin_rest (bl_to_bin bs) - bin_rest ((int o of_bool) (hd bs) * 2 ^ length bs)"
  proof -
    have "2 dvd - (int \<circ> of_bool) (hd bs) * 2 ^ length bs"
      using assms by auto
    thus ?thesis
      unfolding bin_rest_def  using div_plus_div_distrib_dvd_right
      by (smt dvd_neg_div mult_minus_left)
  qed
  also have "... = bl_to_bin (butlast bs) - (int o of_bool) (hd bs) * 2 ^ (length bs - 1)"
    unfolding bin_rest_bl_to_bin bin_rest_def
    by (smt BIT_special_simps(3) assms bin_rest_BIT bin_rest_bl_to_bin bin_rest_def
    mult_BIT_simps(1) mult_cancel_left2 mult_cancel_right2 not_less_zero o_apply of_bool_eq(1)
    of_bool_eq(2) of_nat_1 power_eq_if semiring_1_class.of_nat_0)
  also have "... = bl_to_bin (butlast bs) - (int o of_bool) (hd (butlast bs)) * 2 ^ (length (butlast bs))"
    using assms hd_butlast by auto
  also have "... = sbl_to_bin (butlast bs)"
    by (metis assms length_butlast length_greater_0_conv sbl_to_bin.elims zero_less_diff)
  finally show ?thesis
    by auto
qed

lemma butlast_pow_rest_sbl2bin:
  assumes "n < length bl"
  shows   "sbl_to_bin ((butlast ^^ n) bl) = (bin_rest ^^ n) (sbl_to_bin bl)"
proof -
  let ?bs = "(butlast ^^ n) bl"
  have "(butlast ^^ n) bl \<noteq> []"
    using assms unfolding butlast_power by auto
  hence "sbl_to_bin ?bs = bl_to_bin ?bs - (int o of_bool) (hd ?bs) * 2 ^ (length ?bs)"
    by (metis sbl_to_bin.elims)
  moreover have "hd ?bs = hd bl"
    unfolding butlast_power  by (simp add: assms)
  moreover have "length ?bs = length bl - n"
    unfolding butlast_power by simp
  ultimately have "sbl_to_bin ?bs = bl_to_bin ?bs - (int o of_bool) (hd bl) * 2 ^ (length bl - n)"
    by auto
  also have "... = (bin_rest ^^ n) (bl_to_bin bl) - (int o of_bool) (hd bl) * 2 ^ (length bl - n)"
    unfolding butlast_pow_rest_bl2bin by auto
  also have "... = (bin_rest ^^ n) (bl_to_bin bl) + (- (int o of_bool) (hd bl) * 2 ^ length bl) div 2 ^ n"
  proof -
    have "(2::int) ^ (length bl - n) = 2 ^ length bl div 2 ^ n"
      using power_diff[OF _ less_imp_le[OF assms], of "2::int"] by auto
    hence "(int o of_bool) (hd bl) * 2 ^ (length bl - n) = (int o of_bool) (hd bl) * 2 ^ length bl div 2 ^ n"
      by auto
    thus ?thesis
      by (smt add_diff_inverse_nat assms dvd_neg_div dvd_triv_left linorder_not_less
      mult_cancel_right2 mult_minus_left o_apply of_bool_eq(1) of_bool_eq(2) of_nat_1
      order_less_imp_le power_add semiring_1_class.of_nat_0)
  qed
  also have "... = (bin_rest ^^ n) (bl_to_bin bl) + (bin_rest ^^ n) (- (int o of_bool) (hd bl) * 2 ^ length bl)"
    unfolding bin_rest_compow by auto
  also have "... = (bin_rest ^^ n) (bl_to_bin bl - (int o of_bool) (hd bl) * 2 ^ length bl)"
  proof -
    have "2 ^ n dvd (- (int \<circ> of_bool) (hd bl) * 2 ^ length bl)"
      using assms  dvd_triv_right order_less_imp_le power_le_dvd by blast
    thus ?thesis
      unfolding bin_rest_compow
      by (metis add.inverse_inverse diff_minus_eq_add div_plus_div_distrib_dvd_right
          mult_minus_left)
  qed
  also have "... = (bin_rest ^^ n) (sbl_to_bin bl)"
    by (metis (full_types) assms length_0_conv less_imp_diff_less less_not_refl2 sbl_to_bin.elims
    zero_less_diff)
  finally show ?thesis
    by auto
qed

lemma take_rest_sbl2bin:
  assumes "n < length bl"
  shows   "sbl_to_bin (take (length bl - n) bl) = (bin_rest ^^ n) (sbl_to_bin bl)"
  using butlast_pow_rest_sbl2bin[OF assms] by (simp add: butlast_power)

lemma bl_to_bin_replicate_T:
  "bl_to_bin (replicate n True) = 2 ^ n - 1"
proof -
  have "bl_to_bin (replicate n True) = (\<Sum>i = 0..<n. (int \<circ> of_bool) ((replicate n True) ! i) * 2 ^ i)"
    unfolding bl_to_bin_correctness by auto
  also have "... = 2 ^ n - 1"
  proof (induction n)
    case 0
    then show ?case by auto
  next
    case (Suc n)
    have " (\<Sum>i = 0..<Suc n. (int \<circ> of_bool) (replicate (Suc n) True ! i) * 2 ^ i) =
           (\<Sum>i = 0..<n. (int \<circ> of_bool) (replicate (Suc n) True ! i) * 2 ^ i) + 2 ^ n"
      by (metis (no_types, lifting) One_nat_def add_Suc add_diff_cancel_left' lessI nth_replicate
      o_apply of_bool_eq(2) of_nat_1 plus_1_eq_Suc power_0 power_add sum.atLeast0_lessThan_Suc)
    also have "... = (\<Sum>i = 0..<n. (int \<circ> of_bool) (replicate n True ! i) * 2 ^ i) + 2 ^ n"
      by (metis (no_types, lifting) Diff_cancel atLeastLessThan_iff empty_iff finite_atLeastLessThan
      inf.idem less_Suc_eq nth_replicate sum.mono_neutral_cong)
    also have "... = 2 ^ n - 1 + 2 ^ n"
      using Suc by auto
    also have "... = 2 ^ Suc n - 1"
      by auto
    finally show ?case by auto
  qed
  finally show ?thesis
    by auto
qed

lemma sbl_to_bin_replicate_app:
  assumes "0 < length bl"
  shows "sbl_to_bin (replicate n (hd bl) @ bl) = sbl_to_bin bl"
proof (cases "hd bl")
  case False
  hence "sbl_to_bin (replicate n (hd bl) @ bl) = sbl_to_bin (replicate n False @ bl)"
    by auto
  also have "... = bl_to_bin (replicate n False @ bl)"
    using sbl_to_bin.simps assms
    by (smt False append_is_Nil_conv comp_apply hd_append hd_replicate length_greater_0_conv
    mult_cancel_left of_bool_eq(1) power2_eq_square replicate_empty sbl_to_bin.elims
    semiring_1_class.of_nat_0 zero_power2)
  also have "... = bl_to_bin bl"
    by (simp add: bl_to_bin_rep_F)
  also have "... = sbl_to_bin bl"
    using False sbl_to_bin.simps
    by (smt assms comp_apply length_greater_0_conv mult_cancel_left of_bool_eq(1) power2_eq_square
        sbl_to_bin.elims semiring_1_class.of_nat_0 zero_power2)
  finally show ?thesis
    by auto
next
  case True
  hence "sbl_to_bin (replicate n (hd bl) @ bl) = sbl_to_bin (replicate n True @ bl)"
    by auto
  also have "... = bl_to_bin (replicate n True @ bl) - 2 ^ (length bl + n)"
    by (smt True add.commute assms comp_apply hd_append hd_replicate length_append
    length_greater_0_conv length_replicate mult_cancel_right2 of_bool_eq(2) of_nat_1 replicate_empty
    sbl_to_bin.elims)
  also have "... = bl_to_bin_aux bl (bl_to_bin (replicate n True)) - 2 ^ (length bl + n)"
    unfolding bl_to_bin_append by auto
  also have "... = bl_to_bin_aux bl (2 ^ n - 1) - 2 ^ (length bl + n)"
    unfolding bl_to_bin_replicate_T by auto
  also have "... = (2 ^ n - 1) * 2 ^ length bl + (\<Sum>i = 0..<length bl. (int \<circ> of_bool) (rev bl ! i) * 2 ^ i) - 2 ^ (length bl + n)"
    unfolding bl_to_bin_aux_correctness by auto
  also have "... = (2 ^ (length bl + n) - 2 ^ length bl) + (\<Sum>i = 0..<length bl. (int \<circ> of_bool) (rev bl ! i) * 2 ^ i) - 2 ^ (length bl + n)"
    by (simp add: mult.commute power_add right_diff_distrib)
  also have "... = (\<Sum>i = 0..<length bl. (int \<circ> of_bool) (rev bl ! i) * 2 ^ i) - 2 ^ length bl"
    by auto
  also have "... = bl_to_bin bl - 2 ^ length bl"
    unfolding bl_to_bin_correctness by auto
  also have "... = bl_to_bin bl - (int o of_bool) (hd bl) * 2 ^ length bl"
    using True by simp
  also have "... = sbl_to_bin bl"
    by (metis assms length_greater_0_conv sbl_to_bin.elims)
  finally show ?thesis
    by auto
qed

text \<open>Equivalence between @{term "sbl_to_bin"} and @{term "sbintrunc"} + @{term "bl_to_bin"}\<close>

lemma sbl_to_bin_alt_def:
  "sbl_to_bin bs = sbintrunc (length bs - 1) (bl_to_bin bs)"
proof (induction bs)
  case Nil
  then show ?case by auto
next
  case (Cons a bs)
  have " sbl_to_bin (a # bs) =  bl_to_bin (a # bs) - (int \<circ> of_bool) a * 2 ^ (length (bs) + 1)"
    unfolding sbl_to_bin.simps by auto
  have "a = True \<or> a = False"
    by auto
  moreover
  { assume "a = False"
    hence *: "bl_to_bin (a # bs) - (int o of_bool) a * 2 ^ (length bs + 1) =  bl_to_bin (a # bs)"
      by auto
    have "bl_to_bin (a # bs) + 2 ^ length bs < 2 ^ (length bs + 1)"
      using `a = False` bl_to_bin_False by (auto simp add: bl_to_bin_lt2p)
    hence "bl_to_bin (a # bs) = sbintrunc (length (a # bs) - 1) (bl_to_bin (a # bs))"
      unfolding sbintrunc_mod2p  by (simp add: bl_to_bin_ge0)
    hence ?case
      using * by auto }
  moreover
  { assume "a = True"
    hence *: "bl_to_bin (a # bs) = 2 ^ length bs + bl_to_bin bs"
      using bl_to_bin_correctness  sbl_to_bin_correctness by auto
    hence "bl_to_bin (a # bs) - (int \<circ> of_bool) a * 2 ^ (length (bs) + 1) =   bl_to_bin bs - 2 ^ length bs "
      using `a = True` by auto
    also have "... = sbintrunc (length bs) (bl_to_bin (a # bs))"
      unfolding sbintrunc_mod2p *
      by (smt "*" \<open>a = True\<close> add.commute bl_to_bin_ge0 bl_to_bin_lt2p calculation int_mod_eq'
      minus_mod_self2 mult_cancel_right2 o_apply of_bool_eq(2) of_nat_1 plus_1_eq_Suc)
    finally have ?case
      by simp }
  ultimately show ?case by auto
qed

lemma
  "bl_to_bin (map Not bs) + 1 = 2 ^ length bs - bl_to_bin bs"
proof -
  have "bl_to_bin (map Not bs) = (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (\<not> (rev bs ! i)) * 2 ^ i)"
    unfolding bl_to_bin_correctness rev_map using nth_map[of _ "rev bs" "Not"] by auto
  moreover have "bl_to_bin bs = (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (rev bs ! i) * 2 ^ i)"
    unfolding bl_to_bin_correctness by auto
  ultimately have "bl_to_bin (map Not bs) + bl_to_bin bs = (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (\<not> (rev bs ! i)) * 2 ^ i) +  (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (rev bs ! i) * 2 ^ i)"
    by auto
  also have "... = (\<Sum>x = 0..<length bs. (int \<circ> of_bool) (\<not> rev bs ! x) * 2 ^ x + (int \<circ> of_bool) (rev bs ! x) * 2 ^ x)"
    unfolding sum.distrib[symmetric] by auto
  also have "... = (\<Sum>x = 0..<length bs. ((int \<circ> of_bool) (\<not> rev bs ! x) + (int o of_bool) (rev bs ! x)) * 2 ^ x)"
    by (auto simp add: field_simps)
  also have "... = (\<Sum>x = 0..<length bs. 2 ^ x)"
    by (smt comp_apply mult_cancel_right2 of_bool_eq(1) of_bool_eq(2) of_nat_1 semiring_1_class.of_nat_0 sum.cong)
  also have "... = bl_to_bin (replicate (length bs) True) "
    unfolding bl_to_bin_correctness by auto
  also have "... = 2 ^ length bs - 1"
    using bl_to_bin_replicate_T by auto
  finally show ?thesis
    by auto
qed

lemma uminus_alt':
  "sbl_to_bin (map Not (a # bs)) + 1 = - sbl_to_bin (a # bs)"
proof -
  have "sbl_to_bin (map Not (a # bs)) = sbl_to_bin (Not a # map Not bs)"
    by auto
  also have "... = - (int \<circ> of_bool) (\<not> a) * 2 ^ length bs + (\<Sum>i = 0..<length bs. (int \<circ> of_bool) ( \<not> (rev bs ! i)) * 2 ^ i)" (is "_ = ?init_not + ?sbl_not")
    unfolding sbl_to_bin_correctness rev_map using nth_map[of _ "rev bs" "Not"] by auto
  finally have "sbl_to_bin (map Not (a # bs)) = ?init_not + ?sbl_not"
    by auto
  have "sbl_to_bin (a # bs) = - (int \<circ> of_bool) a * 2 ^ length bs + (\<Sum>i = 0..<length bs. (int \<circ> of_bool) (rev bs ! i) * 2 ^ i)" (is "_ = ?init_def + ?sbl_def")
    unfolding sbl_to_bin_correctness by auto
  hence "sbl_to_bin (map Not (a # bs)) + sbl_to_bin (a # bs) = ?init_not + ?init_def + ?sbl_not + ?sbl_def"
    using `sbl_to_bin (map Not (a # bs)) = ?init_not + ?sbl_not` by auto
  also have "... = - (2 ^ length bs) + (?sbl_not + ?sbl_def)"
    by auto
  also have "... = - (2 ^ length bs) + (\<Sum>x = 0..<length bs. (int \<circ> of_bool) (\<not> rev bs ! x) * 2 ^ x + (int \<circ> of_bool) (rev bs ! x) * 2 ^ x)"
    unfolding sum.distrib[symmetric] by auto
  also have "... = - (2 ^ length bs) + (\<Sum>x = 0..<length bs. ((int \<circ> of_bool) (\<not> rev bs ! x) + (int o of_bool) (rev bs ! x)) * 2 ^ x)"
    by (auto simp add: field_simps)
  also have "... = - (2 ^ length bs) + (\<Sum>x = 0..<length bs. 2 ^ x)"
    by (smt comp_apply mult_cancel_right2 of_bool_eq(1) of_bool_eq(2) of_nat_1 semiring_1_class.of_nat_0 sum.cong)
  also have "... = - (2 ^ length bs) + bl_to_bin (replicate (length bs) True)"
    unfolding bl_to_bin_correctness by auto
  also have "... = - (2 ^ length bs) + 2 ^ length bs - 1"
    using bl_to_bin_replicate_T by auto
  also have "... = -1"
    by auto
  finally show ?thesis
    by auto
qed

lemma uminus_alt:
  "0 < length bs \<Longrightarrow> sbl_to_bin (map Not bs) + 1 = - sbl_to_bin bs"
  using uminus_alt'  by (metis list_exhaust_size_gt0)

lemma sbin_bl_bin_sbintruc:
  "0 < n \<Longrightarrow> sbl_to_bin (bin_to_bl n w) = sbintrunc (n - 1) w"
  using bin_bl_bin sbl_to_bin_alt_def size_bin_to_bl by auto

lemma sbl_to_bin_alt_def2:
  "sbl_to_bin bs = sbintrunc (length bs - 1) (sbl_to_bin bs)"
  by (simp add: sbl_to_bin_alt_def)

lemma trunc_sbl2bin:
  "sbintrunc m (sbl_to_bin bs) = sbl_to_bin (drop (length bs - 1 - m) bs)"
proof -
  have *: "sbintrunc m (sbl_to_bin bs) =  sbintrunc m (sbintrunc (length bs - 1) (bl_to_bin bs))"
    unfolding sbl_to_bin_alt_def by auto
  have "length bs - 1 \<le> m \<or> m < length bs - 1"
    by auto
  moreover
  { assume less: "length bs - 1 \<le> m"
    have "sbintrunc m (sbintrunc (length bs - 1) (bl_to_bin bs)) = sbintrunc (length bs - 1) (bl_to_bin bs)"
      unfolding sbintrunc_sbintrunc_l[OF less] by auto
    also have "... = sbl_to_bin bs"
      unfolding sbl_to_bin_alt_def by auto
    finally have "sbintrunc m (sbl_to_bin bs) = sbl_to_bin bs"
      using * by auto
    also have "... = sbl_to_bin (drop (length bs - 1 - m) bs)"
      using less by auto
    finally have ?thesis
      by blast }
  moreover
  { assume "m < length bs - 1"
    hence ?thesis
      using bl2bin_drop sbintrunc_bintrunc sbl_to_bin_alt_def by auto }
  ultimately show ?thesis
    by auto
qed

lemma sbl2bin_drop:
  "k < length bl \<Longrightarrow> sbl_to_bin (drop k bl) = sbintrunc (length bl - 1 - k) (sbl_to_bin bl)"
  apply (rule trans)
   prefer 2
   apply (rule trunc_sbl2bin [symmetric])
  apply (cases "k \<le> length bl - 1")
   apply auto
  done

lemma bin_rest_power_strunc:
  "k \<le> n \<Longrightarrow> (bin_rest ^^ k) (sbintrunc n bin) = sbintrunc (n - k) ((bin_rest ^^ k) bin)"
proof (induction k)
  case 0
  then show ?case by simp
next
  case (Suc k)
  hence "(bin_rest ^^ k) (sbintrunc n bin) = sbintrunc (n - k) ((bin_rest ^^ k) bin)"
    by auto
  then show ?case
    using Suc.prems Suc_diff_le by fastforce
qed

end


(*
  File:     Miller_Rabin.thy
  Authors:  Daniel Stüwe

  Some facts about Quadratic Residues that are missing from the library
*)
section \<open>Additional Material on Quadratic Residues\<close>
theory QuadRes
imports
  Jacobi_Symbol
  Algebraic_Auxiliaries
begin

text \<open>Proofs are inspired by \<^cite>\<open>"Quadratic_Residues"\<close>.\<close>

lemma inj_on_QuadRes:
  fixes p :: int
  assumes "prime p"
  shows "inj_on (\<lambda>x. x^2 mod p) {0..(p-1) div 2}"
proof
  fix x y :: int
  assume elem: "x \<in> {0..(p-1) div 2}" "y \<in> {0..(p-1) div 2}"

  have * : "abs(a) < p \<Longrightarrow> p dvd a \<Longrightarrow> a = 0" for a :: int
    using dvd_imp_le_int by force

  assume "x\<^sup>2 mod p = y\<^sup>2 mod p"

  hence "[x\<^sup>2 = y\<^sup>2] (mod p)" unfolding cong_def .

  hence "p dvd (x\<^sup>2 - y\<^sup>2)" by (simp add: cong_iff_dvd_diff)

  hence "p dvd (x + y) * (x - y)"
    by (simp add: power2_eq_square square_diff_square_factored)

  hence "p dvd (x + y) \<or> p dvd (x - y)"
    using \<open>prime p\<close> by (simp add: prime_dvd_mult_iff)

  moreover have "p dvd x + y \<Longrightarrow> x + y = 0" "p dvd x - y \<Longrightarrow> x - y = 0"
           and "0 \<le> x" "0 \<le> y"
      using elem
      by (fastforce intro!: * )+

  ultimately show "x = y" by auto
qed

lemma QuadRes_set_prime:
  assumes "prime p" and "odd p"
  shows "{x . QuadRes p x \<and> x \<in> {0..<p}} = {x^2 mod p | x . x \<in> {0..(p-1) div 2}}"
proof(safe, goal_cases)
  case (1 x)
  then obtain y where "[y\<^sup>2 = x] (mod p)"
    unfolding QuadRes_def by blast

  then have A: "[(y mod p)\<^sup>2 = x] (mod p)"
    unfolding cong_def
    by (simp add: power_mod)

  then have "[(-(y mod p))\<^sup>2 = x] (mod p)"
    by simp

  then have B: "[(p - (y mod p))\<^sup>2 = x] (mod p)"
    unfolding cong_def
    using minus_mod_self1
    by (metis power_mod)

  have "p = 1 + ((p - 1) div 2) * 2"
    using prime_gt_0_int[OF \<open>prime p\<close>] \<open>odd p\<close>
    by simp

  then have C: "(p - (y mod p)) \<in> {0..(p - 1) div 2} \<or> y mod p \<in> {0..(p - 1) div 2}"
    using prime_gt_0_int[OF \<open>prime p\<close>]
    by (clarsimp, auto simp: le_less)

  then show ?case proof
    show ?thesis if "p - y mod p \<in> {0..(p - 1) div 2}"
      using that B
      unfolding cong_def
      using \<open>x \<in> {0..<p}\<close> by auto

    show ?thesis if "y mod p \<in> {0..(p - 1) div 2}"
      using that A
      unfolding cong_def
      using \<open>x \<in> {0..<p}\<close> by auto
  qed
qed (auto simp: QuadRes_def cong_def)

corollary QuadRes_iff:
  assumes "prime p" and "odd p"
  shows "(QuadRes p x \<and> x \<in> {0..<p}) \<longleftrightarrow> (\<exists> a \<in> {0..(p-1) div 2}. a^2 mod p = x)"
proof -
  have "(QuadRes p x \<and> x \<in> {0..<p}) \<longleftrightarrow> x \<in> {x. QuadRes p x \<and> x \<in> {0..<p}}"
    by auto
  also note QuadRes_set_prime[OF assms]
  also have "(x \<in> {x\<^sup>2 mod p |x. x \<in> {0..(p - 1) div 2}}) = (\<exists>a\<in>{0..(p - 1) div 2}. a\<^sup>2 mod p = x)"
    by blast
  finally show ?thesis .
qed

corollary card_QuadRes_set_prime:
  fixes p :: int
  assumes "prime p" and "odd p"
  shows "card {x. QuadRes p x \<and> x \<in> {0..<p}} = nat (p+1) div 2"
proof -
  have "card {x. QuadRes p x \<and> x \<in> {0..<p}} = card {x\<^sup>2 mod p | x . x \<in> {0..(p-1) div 2}}"
    unfolding QuadRes_set_prime[OF assms] ..

  also have "{x\<^sup>2 mod p | x . x \<in> {0..(p-1) div 2}} = (\<lambda>x. x\<^sup>2 mod p) ` {0..(p-1) div 2}"
    by auto

  also have "card ... = card {0..(p-1) div 2}"
    using inj_on_QuadRes[OF \<open>prime p\<close>] by (rule card_image)

  also have "... = nat (p+1) div 2" by simp

  finally show ?thesis .
qed

corollary card_not_QuadRes_set_prime:
  fixes p :: int
  assumes "prime p" and "odd p"
  shows "card {x. \<not>QuadRes p x \<and> x \<in> {0..<p}} = nat (p-1) div 2"
proof -
  have "{0..<p} \<inter> {x. QuadRes p x \<and> x \<in> {0..<p}} = {x. QuadRes p x \<and> x \<in> {0..<p}}"
    by blast

  moreover have "nat p - nat (p + 1) div 2 = nat (p - 1) div 2"
    using \<open>odd p\<close> prime_gt_0_int[OF \<open>prime p\<close>]
    by (auto elim!: oddE simp: nat_add_distrib nat_mult_distrib)

  ultimately have "card {0..<p} - card ({0..<p} \<inter> {x. QuadRes p x \<and> x \<in> {0..<p}}) = nat (p - 1) div 2"
    using card_QuadRes_set_prime[OF assms] and card_atLeastZeroLessThan_int by presburger

  moreover have "{x. \<not>QuadRes p x \<and> x \<in> {0..<p}} = {0..<p} - {x. QuadRes p x \<and> x \<in> {0..<p}}"
    by blast

  ultimately show ?thesis by (auto simp add: card_Diff_subset_Int)
qed

lemma not_QuadRes_ex_if_prime:
  assumes "prime p" and "odd p"
  shows "\<exists> x. \<not>QuadRes p x"
proof -
  have "2 < p" using odd_prime_gt_2_int assms by blast

  then have False if "{x . \<not>QuadRes p x \<and> x \<in> {0..<p}} = {}"
    using card_not_QuadRes_set_prime[OF assms]
    unfolding that
    by simp

  thus ?thesis by blast
qed

lemma not_QuadRes_ex:
  "1 < p \<Longrightarrow> odd p \<Longrightarrow> \<exists>x. \<not>QuadRes p x"
proof (induction p rule: prime_divisors_induct)
  case (factor p x)
  then show ?case
    by (meson not_QuadRes_ex_if_prime QuadRes_def cong_iff_dvd_diff dvd_mult_left even_mult_iff)
qed simp_all

end