theory IntExt
imports ZF.Int NatExt
begin

definition zmod :: "[i,i] \<Rightarrow> i" (infixl "$'/'/" 69)
where
  "x $// y == if(znegative(x),
                  if(zmagnitude(x) mod y = 0,
                    0, y #- (zmagnitude(x) mod y)),
              zmagnitude(x) mod y)"

definition zdiv :: "[i,i] \<Rightarrow> i" (infixl "$'/" 69)
where
  "x $/ y == if(znegative(x),
                if(zmagnitude(x) mod y = 0,
                  $- $#(zmagnitude(x) div y),
                  $- $#(succ(zmagnitude(x) div y))),
                $#(zmagnitude(x) div y))"

theorem not_zneg_zmag:
  "\<lbrakk> z:int; ~znegative(z) \<rbrakk> \<Longrightarrow> $# zmagnitude(z) = z"
apply(auto)
done

theorem zneg_zmag:
  "\<lbrakk> z:int; znegative(z) \<rbrakk> \<Longrightarrow> $# zmagnitude(z) = $-z"
apply(auto)
done

lemma zmag_0_eq_0_iff: "z:int \<Longrightarrow> zmagnitude(z) = 0 \<longleftrightarrow> z = $#0"
apply(auto)
apply(subgoal_tac "znegative(z) | ~znegative(z)")
apply(erule disjE)
apply(frule zneg_zmag, simp)
proof -
  assume a: "zmagnitude(z) = 0" and ab: "$# zmagnitude(z) = $- z" and ac: "z:int"
  have b: "$# zmagnitude(z) = $# 0" using a by simp
  then have "$- $# zmagnitude(z) = $- $- z" using ab by simp
  then have "z = $- $# zmagnitude(z)" using ac by simp
  then have "z = $- $#0" using b by simp
  then show "z = $#0" by simp
next
  assume a: "z:int" and ab: "zmagnitude(z) = 0" and ac: "~znegative(z)"
  have "$# zmagnitude(z) = z" using a ac by simp
  then show "z = $# 0" using ab by simp
next
  show "znegative(z) \<or> \<not> znegative(z)" by simp
qed

lemma int_eq_or_neq_0: "\<lbrakk> z:int \<rbrakk> \<Longrightarrow> z = $#0 | z \<noteq> $#0"
apply(auto)
done

theorem zneg_zmag_0_lt:
  "\<lbrakk> z:int; znegative(z) \<rbrakk> \<Longrightarrow> 0 < zmagnitude(z)"
apply(insert zmagnitude_type[of z])
apply(drule nat_0_le)
apply(frule int_eq_or_neq_0)
apply(erule disjE, simp)
proof -
  assume a: "z:int" "znegative(z)" "0 \<le> zmagnitude(z)" "z \<noteq> $#0"
  then have "zmagnitude(z) ~= 0" using zmag_0_eq_0_iff[of z] by auto
  then show "0 < zmagnitude(z)" using a Ord_0_lt by simp
qed

theorem znat_mult:
  "\<lbrakk> n:nat; m:nat \<rbrakk> \<Longrightarrow> $#(n #* m) = $#n $* $#m"
apply(induct_tac n, auto)
proof -
  fix x
  assume a: "m \<in> nat" "x \<in> nat" "$# (x #* m) = $# x $* $# m"
  have "$# (m #+ x #* m) = $# m $+ $# (x #* m)" using int_of_add by simp
  then have b: "$# (m #+ x #* m) = $# m $+ $# x $* $# m" using a by simp
  have "$# succ(x) $* $# m = $# (x #+ 1) $* $# m" using a by simp
  then have "$# succ(x) $* $# m = ($# x $+ $# 1) $* $# m" using int_of_add[of x 1] by simp
  then have "$# succ(x) $* $# m = $# x $* $# m $+ $# 1 $* $# m"
    using zadd_zmult_distrib[of "$# x" "$# 1" "$# m"] by simp
  then show "$# (m #+ x #* m) = $# succ(x) $* $# m" using b zadd_commute by simp
qed

theorem zminus_diff:
  "\<lbrakk> n:nat; m:nat; m \<le> n \<rbrakk> \<Longrightarrow> $- $#(n #- m) = $-$#n $+ $#m"
proof -
  assume a: "n:nat" "m:nat" "m \<le> n"
  then have "$#(n #- m) = $# n $- $# m" using int_of_diff by simp
  then have "$- $#(n #- m) = $- ($# n $- $# m)" by simp
  then have "$- $#(n #- m) = $#m $- $#n" using zminus_zdiff_eq by simp
  then show ?thesis using zadd_commute zcompare_rls by(simp add: zadd_commute zcompare_rls)
qed

theorem zadd_zmult_distrib_left:
  "\<lbrakk> z1:int; z2:int; w:int \<rbrakk>
    \<Longrightarrow> w $* (z1 $+ z2) = (w $* z1) $+ (w $* z2)"
apply(rule zadd_zmult_distrib2)
done

theorem zmult_1_right:
  "z:int \<Longrightarrow> z $* $#1 = z"
apply(insert zmult_int1)
apply(subst zmult_commute)
apply(simp)
done

theorem zmult_0_right:
  "z:int \<Longrightarrow> z $* $#0 = $#0"
apply(subst zmult_commute)
apply(rule zmult_int0)
done

theorem zdiff_type:
  "\<lbrakk> z:int; w:int \<rbrakk> \<Longrightarrow> z $- w : int"
apply(auto)
done

theorem zadd_left_commute:
  "\<lbrakk> z1:int; z2:int; z3:int \<rbrakk>
    \<Longrightarrow> z1 $+ (z2 $+ z3) = z2 $+ (z1 $+ z3)"
apply(subst zadd_assoc[of z2 z1 z3, THEN sym])
apply(subst zadd_commute[of z2 z1], simp add: zadd_assoc)
done

theorem zadd_cancel_right:
  "\<lbrakk> z $+ k = w $+ k; z:int; w:int; k:int \<rbrakk> \<Longrightarrow> z = w"
apply(auto)
done

lemma int_rep:
  "z:int \<Longrightarrow> (znegative(z) & z = $- $#(zmagnitude(z))) | (~znegative(z) & z = $#(zmagnitude(z)))"
apply(auto)
done

lemma int_zneg_zmag_iff:
  "\<lbrakk> z:int; w:int \<rbrakk> \<Longrightarrow> z = w \<longleftrightarrow> ((znegative(z) \<longleftrightarrow> znegative(w)) & zmagnitude(z) = zmagnitude(w))"
apply(auto)
apply((drule int_rep, auto)+)
done

lemma zmag_mult:
  "\<lbrakk> a:int; b:int \<rbrakk> \<Longrightarrow> zmagnitude(a $* b) = zmagnitude(a) #* zmagnitude(b)"
proof -
  assume a: "a:int" "b:int"
  {
    assume aa: "znegative(a)" "znegative(b)"
    have ab: "a = $- $#(zmagnitude(a))"
      using a aa int_rep by simp
    have ac: "b = $- $#(zmagnitude(b))"
      using a aa int_rep by simp
    have "zmagnitude(a $* b)
                = zmagnitude(($- $#(zmagnitude(a))) $* ($- $#(zmagnitude(b))))"
      using ab ac by simp
    then have "zmagnitude(a $* b)
                = zmagnitude($#(zmagnitude(a)) $* $#(zmagnitude(b)))" by simp
    then have "zmagnitude(a $* b)
                = zmagnitude($#(zmagnitude(a) #* zmagnitude(b)))"
      using znat_mult by simp
    then have "zmagnitude(a $* b) = zmagnitude(a) #* zmagnitude(b)" by simp
  } then have b: "\<lbrakk> znegative(a); znegative(b) \<rbrakk>
      \<Longrightarrow> zmagnitude(a $* b) = zmagnitude(a) #* zmagnitude(b)" by simp
  {
    assume aa: "znegative(a)" "~znegative(b)"
    have ab: "a = $- $#(zmagnitude(a))"
      using a aa int_rep by simp
    have ac: "b = $#(zmagnitude(b))"
      using a aa int_rep by simp
    have "zmagnitude(a $* b)
                = zmagnitude(($- $#(zmagnitude(a))) $* ($#(zmagnitude(b))))"
      using ab ac by simp
    then have "zmagnitude(a $* b)
                = zmagnitude($- ($#(zmagnitude(a)) $* $#(zmagnitude(b))))" by simp
    then have "zmagnitude(a $* b)
                = zmagnitude($-($#(zmagnitude(a) #* zmagnitude(b))))"
      using znat_mult by simp
    then have "zmagnitude(a $* b) = zmagnitude(a) #* zmagnitude(b)" by simp
  } then have c: "\<lbrakk> znegative(a); ~znegative(b) \<rbrakk>
      \<Longrightarrow> zmagnitude(a $* b) = zmagnitude(a) #* zmagnitude(b)" by simp
  {
    assume aa: "~znegative(a)" "znegative(b)"
    have ab: "a = $#(zmagnitude(a))"
      using a aa int_rep by simp
    have ac: "b = $- $#(zmagnitude(b))"
      using a aa int_rep by simp
    have "zmagnitude(a $* b)
                = zmagnitude(($#(zmagnitude(a))) $* ($- $#(zmagnitude(b))))"
      using ab ac by simp
    then have "zmagnitude(a $* b)
                = zmagnitude($- ($#(zmagnitude(a)) $* $#(zmagnitude(b))))" by simp
    then have "zmagnitude(a $* b)
                = zmagnitude($-($#(zmagnitude(a) #* zmagnitude(b))))"
      using znat_mult by simp
    then have "zmagnitude(a $* b) = zmagnitude(a) #* zmagnitude(b)" by simp
  } then have d: "\<lbrakk> ~znegative(a); znegative(b) \<rbrakk>
      \<Longrightarrow> zmagnitude(a $* b) = zmagnitude(a) #* zmagnitude(b)" by simp
  {
    assume aa: "~znegative(a)" "~znegative(b)"
    have ab: "a = $#(zmagnitude(a))"
      using a aa int_rep by simp
    have ac: "b = $#(zmagnitude(b))"
      using a aa int_rep by simp
    have "zmagnitude(a $* b)
                = zmagnitude(($#(zmagnitude(a))) $* ($#(zmagnitude(b))))"
      using ab ac by simp
    then have "zmagnitude(a $* b)
                = zmagnitude($#(zmagnitude(a)) $* $#(zmagnitude(b)))" by simp
    then have "zmagnitude(a $* b)
                = zmagnitude($#(zmagnitude(a) #* zmagnitude(b)))"
      using znat_mult by simp
    then have "zmagnitude(a $* b) = zmagnitude(a) #* zmagnitude(b)" by simp
  } then have "\<lbrakk> ~znegative(a); ~znegative(b) \<rbrakk>
      \<Longrightarrow> zmagnitude(a $* b) = zmagnitude(a) #* zmagnitude(b)" by simp
  then show ?thesis using b c d by auto
qed

lemma znegative_minus_int_of: "n:nat \<Longrightarrow> n \<noteq> 0 ==> znegative($- $# n)"
apply(rule ccontr)
apply(drule not_znegative_imp_zero, auto)
done

lemma zneg_mult:
  "\<lbrakk> a:int; b:int; a \<noteq> $# 0; b \<noteq> $# 0 \<rbrakk>
    \<Longrightarrow> ~znegative(a $* b)
        \<longleftrightarrow> (znegative(a) & znegative(b) | ~znegative(a) & ~znegative(b))"
apply(auto)
apply(rule ccontr)
prefer 2
apply(rule ccontr)
prefer 2
proof -
  assume a: "a \<in> int" "b \<in> int" "a \<noteq> $# 0" "b \<noteq> $# 0"
  have aa: "zmagnitude(a) \<noteq> 0" using zmag_0_eq_0_iff[of a] a by simp
  have "zmagnitude(b) \<noteq> 0" using zmag_0_eq_0_iff[of b] a by simp
  then have ab: "zmagnitude(a) #* zmagnitude(b) \<noteq> 0" using aa by simp
  assume b: "~znegative(a $* b)" "znegative(a)" "\<not> znegative(b)"
  have c: "a = $- $#(zmagnitude(a))" using int_rep a b by simp
  have "b = $#(zmagnitude(b))" using int_rep a b by simp
  then have "a $* b = ($- $#(zmagnitude(a)) $* $#(zmagnitude(b)))"
    using c by simp
  then have "a $* b = $- ($#(zmagnitude(a)) $* $#(zmagnitude(b)))" by simp
  then have d: "a $* b = $- $# (zmagnitude(a) #* zmagnitude(b))"
    using znat_mult by simp
  have "znegative($- ($# (zmagnitude(a) #* zmagnitude(b))))"
    using znegative_minus_int_of[of "zmagnitude(a) #* zmagnitude(b)"] ab a by simp
  then have "znegative(a $* b)" using d by simp
  then show "False" using b by simp
next
  assume a: "a \<in> int" "b \<in> int" "a \<noteq> $# 0" "b \<noteq> $# 0"
  have aa: "zmagnitude(a) \<noteq> 0" using zmag_0_eq_0_iff[of a] a by simp
  have "zmagnitude(b) \<noteq> 0" using zmag_0_eq_0_iff[of b] a by simp
  then have ab: "zmagnitude(a) #* zmagnitude(b) \<noteq> 0" using aa by simp
  assume b: "~znegative(a $* b)" "~znegative(a)" "znegative(b)"
  have c: "a = $#(zmagnitude(a))" using int_rep a b by simp
  have "b = $- $#(zmagnitude(b))" using int_rep a b by simp
  then have "a $* b = ($#(zmagnitude(a)) $* $- $#(zmagnitude(b)))"
    using c by simp
  then have "a $* b = $- ($#(zmagnitude(a)) $* $#(zmagnitude(b)))" by simp
  then have d: "a $* b = $- $# (zmagnitude(a) #* zmagnitude(b))"
    using znat_mult by simp
  have "znegative($- ($# (zmagnitude(a) #* zmagnitude(b))))"
    using znegative_minus_int_of[of "zmagnitude(a) #* zmagnitude(b)"] ab a by simp
  then have "znegative(a $* b)" using d by simp
  then show "False" using b by simp
next
  assume a: "a \<in> int" "b \<in> int" "a \<noteq> $# 0" "b \<noteq> $# 0"
  have aa: "zmagnitude(a) \<noteq> 0" using zmag_0_eq_0_iff[of a] a by simp
  have "zmagnitude(b) \<noteq> 0" using zmag_0_eq_0_iff[of b] a by simp
  then have ab: "zmagnitude(a) #* zmagnitude(b) \<noteq> 0" using aa by simp
  assume b: "znegative(a $* b)" "znegative(a)" "znegative(b)"
  have c: "a = $- $#(zmagnitude(a))" using int_rep a b by simp
  have "b = $- $#(zmagnitude(b))" using int_rep a b by simp
  then have "a $* b = ($- $#(zmagnitude(a)) $* $- $#(zmagnitude(b)))"
    using c by simp
  then have "a $* b = ($#(zmagnitude(a)) $* $#(zmagnitude(b)))" by simp
  then have d: "a $* b = $# (zmagnitude(a) #* zmagnitude(b))"
    using znat_mult by simp
  have "~ znegative(($# (zmagnitude(a) #* zmagnitude(b))))"
    using ab a by simp
  then have "~znegative(a $* b)" using d by simp
  then show "False" using b by simp
next
  assume a: "a \<in> int" "b \<in> int" "a \<noteq> $# 0" "b \<noteq> $# 0"
  have aa: "zmagnitude(a) \<noteq> 0" using zmag_0_eq_0_iff[of a] a by simp
  have "zmagnitude(b) \<noteq> 0" using zmag_0_eq_0_iff[of b] a by simp
  then have ab: "zmagnitude(a) #* zmagnitude(b) \<noteq> 0" using aa by simp
  assume b: "znegative(a $* b)" "~znegative(a)" "~znegative(b)"
  have c: "a = $#(zmagnitude(a))" using int_rep a b by simp
  have "b = $#(zmagnitude(b))" using int_rep a b by simp
  then have "a $* b = ($#(zmagnitude(a)) $* $#(zmagnitude(b)))"
    using c by simp
  then have "a $* b = ($#(zmagnitude(a)) $* $#(zmagnitude(b)))" by simp
  then have d: "a $* b = $# (zmagnitude(a) #* zmagnitude(b))"
    using znat_mult by simp
  have "~ znegative(($# (zmagnitude(a) #* zmagnitude(b))))"
    using ab a by simp
  then have "~znegative(a $* b)" using d by simp
  then show "False" using b by simp
qed

lemma neq_0_zmult_0: "\<lbrakk> m:int; n:int; m \<noteq> $# 0; m $* n = $# 0 \<rbrakk> \<Longrightarrow> n = $# 0"
apply(rule ccontr)
apply(frule zneg_mult)
apply(assumption)
back
apply(auto)
proof -
  assume a: "m \<in> int" "n \<in> int" "m \<noteq> $# 0" "m $* n = $# 0" "n \<noteq> $# 0"
  and b: "znegative(m)" "znegative(n)"
  have cont: "zmagnitude(m $* n) = 0" using zneg_mult a by simp
  have "zmagnitude(m $* n) = zmagnitude(m) #* zmagnitude(n)"
    using zmag_mult[of m n] a by simp
  have c: "zmagnitude(m) \<noteq> 0" using a zmag_0_eq_0_iff by simp
  have "zmagnitude(n) \<noteq> 0" using a zmag_0_eq_0_iff by simp
  then have d: "zmagnitude(m) #* zmagnitude(n) \<noteq> 0" using c by simp
  then have "zmagnitude(m $* n) = zmagnitude(m) #* zmagnitude(n)"
    using zmag_mult[of m n] a by simp
  then have "zmagnitude(m $* n) \<noteq> 0" using d by simp
  then show "False" using cont by simp
next
  assume a: "m \<in> int" "n \<in> int" "m \<noteq> $# 0" "m $* n = $# 0" "n \<noteq> $# 0"
  and b: "~znegative(m)" "~znegative(n)"
  have cont: "zmagnitude(m $* n) = 0" using zneg_mult a by simp
  have "zmagnitude(m $* n) = zmagnitude(m) #* zmagnitude(n)"
    using zmag_mult[of m n] a by simp
  have c: "zmagnitude(m) \<noteq> 0" using a zmag_0_eq_0_iff by simp
  have "zmagnitude(n) \<noteq> 0" using a zmag_0_eq_0_iff by simp
  then have d: "zmagnitude(m) #* zmagnitude(n) \<noteq> 0" using c by simp
  then have "zmagnitude(m $* n) = zmagnitude(m) #* zmagnitude(n)"
    using zmag_mult[of m n] a by simp
  then have "zmagnitude(m $* n) \<noteq> 0" using d by simp
  then show "False" using cont by simp
qed

theorem zmult_cancel:
  "\<lbrakk> $#n $* z = $#n $* w; z:int; w:int; n:nat; 0 < n \<rbrakk>
    \<Longrightarrow> z = w"
proof -
  assume a: "$#n $* z = $#n $* w" "z:int" "w:int" "n:nat" "0 < n"
  have b: "(znegative($#n $* z) & $#n $* z = $- $#(zmagnitude($#n $* z))) |
        (~znegative($#n $* z) & $#n $* z = $#(zmagnitude($#n $* z)))"
    using int_rep by simp
  have c: "(znegative($#n $* w) & $#n $* w = $- $#(zmagnitude($#n $* w))) |
        (~znegative($#n $* w) & $#n $* w = $#(zmagnitude($#n $* w)))"
    using int_rep by simp
  have d: "znegative(($#n $* z)) \<longleftrightarrow> (znegative($#n $* w))" using a by simp
  {
    assume aa: "znegative(($#n $* z))"
    then have ab: "(znegative($#n $* w))" using d by simp
    have ac: "$#n $* z = $- $#(zmagnitude($#n $* z))" using b aa by simp
    have ad: "$#n $* w = $- $#(zmagnitude($#n $* w))" using b ab by simp
    have imp: "zmagnitude($#n $* z) = zmagnitude($#n $* w)" using a by simp
    have "zmagnitude($#n $* z) = zmagnitude($#n) #* zmagnitude(z)"
      using zmag_mult[of "$# n" z] a by simp
    then have ae: "zmagnitude($#n $* z) = n #* zmagnitude(z)" by simp
    have "zmagnitude($#n $* w) = zmagnitude($#n) #* zmagnitude(w)"
      using zmag_mult[of "$# n" w] a by simp
    then have af: "zmagnitude($#n $* w) = n #* zmagnitude(w)" by simp
    have "n #* zmagnitude(z) = n #* zmagnitude(w)" using imp ae af by simp
    then have "zmagnitude(z) = zmagnitude(w)" using a by(auto)
  } then have e: "znegative(($#n $* z)) \<Longrightarrow> zmagnitude(z) = zmagnitude(w)" by simp
  {
    assume aa: "~znegative(($#n $* z))"
    then have ab: "(~znegative($#n $* w))" using d by simp
    have ac: "$#n $* z = $#(zmagnitude($#n $* z))" using b aa by simp
    have ad: "$#n $* w = $#(zmagnitude($#n $* w))" using b ab by simp
    have imp: "zmagnitude($#n $* z) = zmagnitude($#n $* w)" using a by simp
    have "zmagnitude($#n $* z) = zmagnitude($#n) #* zmagnitude(z)"
      using zmag_mult[of "$# n" z] a by simp
    then have ae: "zmagnitude($#n $* z) = n #* zmagnitude(z)" by simp
    have "zmagnitude($#n $* w) = zmagnitude($#n) #* zmagnitude(w)"
      using zmag_mult[of "$# n" w] a by simp
    then have af: "zmagnitude($#n $* w) = n #* zmagnitude(w)" by simp
    have "n #* zmagnitude(z) = n #* zmagnitude(w)" using imp ae af by simp
    then have "zmagnitude(z) = zmagnitude(w)" using a by(auto)
  } then have "~znegative(($#n $* z)) \<Longrightarrow> zmagnitude(z) = zmagnitude(w)" by simp
  then have f: "zmagnitude(z) = zmagnitude(w)" using e by(auto)
  {
    assume aa: "z = $# 0 | w = $# 0"
    have n_neq_0: "$# n \<noteq> $# 0" using a by auto
    have "z = $#0 ==> $# n $* z = $# n $* $# 0" by simp
    then have ab: "z = $#0 ==> $# n $* z = $# 0" using zmult_0_right by simp
    have "w = $#0 ==> $# n $* w = $# n $* $# 0" by simp
    then have ac: "w = $#0 ==> $# n $* w = $# 0" using zmult_0_right by simp
    have "$# n $* z = $# 0 | $# n $* w = $# 0" using aa ab ac by blast
    then have ad: "$# n $* z = $# 0" using a by(auto)
    then have "$# n $* w = $# 0" using a by(auto)
    then have ae: "w = $# 0" using neq_0_zmult_0[of "$# n" w] a n_neq_0 by simp
    have "z = $# 0" using neq_0_zmult_0[of "$# n" z] ad n_neq_0 a by simp
    then have "z = w" using ae by simp
  } then have g: "z = $# 0 | w = $# 0 \<Longrightarrow> z = w" by simp
  {
    assume aa: "z \<noteq> $# 0 & w \<noteq> $# 0"
    have "znegative($# n $* z) \<longleftrightarrow> ~znegative($# n) \<and> znegative(z) \<or> znegative($# n) \<and> ~znegative(z)"
      using zneg_mult[of "$# n" z] aa a by(auto)
    then have "znegative($# n $* z) \<longleftrightarrow> znegative(z)" by simp
    then have "znegative(z) \<longleftrightarrow> znegative($# n $* w)" using a by(auto)
    then have "znegative(z) \<longleftrightarrow> (znegative($# n) & ~znegative(w) | ~znegative($# n) & znegative(w))"
      using zneg_mult[of "$# n" w] a aa by(auto)
    then have "znegative(z) \<longleftrightarrow> znegative(w)" by simp
    then have "z = w" using int_zneg_zmag_iff f a by simp
  } then have "z \<noteq> $# 0 & w \<noteq> $# 0 \<Longrightarrow> z = w" by simp
  then show "z = w" using g by(auto)
qed

theorem zmult_cancel_int:
  "\<lbrakk> n $* z = n $* w; z:int; w:int; n:int; n \<noteq> $# 0 \<rbrakk> \<Longrightarrow> z = w"
apply(subgoal_tac
      "(znegative(n) & n = $- $#(zmagnitude(n))) | (~znegative(n) & n = $#(zmagnitude(n)))")
apply(erule disjE)
proof -
  assume a: "n $* z = n $* w" "z:int" "w:int"
            "znegative(n) \<and> n = $- $# zmagnitude(n)" and
         ab: "n:int" "n \<noteq> $# 0"
  then have "($- $# zmagnitude(n)) $* z = ($- $# zmagnitude(n)) $* w" by simp
  then have "$- $# zmagnitude(n) $* z = $- $# zmagnitude(n) $* w" by simp
  then have b: "$# zmagnitude(n) $* z = $# zmagnitude(n) $* w"
    using zminus_inject a ab by simp
  then have "0 < zmagnitude(n)" using zneg_zmag_0_lt a ab by simp
  then show "z = w" using a b zmult_cancel[of "zmagnitude(n)" z w] by simp
next
  assume a: "n $* z = n $* w" "z:int" "w:int"
            "~znegative(n) \<and> n = $# zmagnitude(n)" and
        ab: "n:int" "n \<noteq> $# 0"
  then have "$# zmagnitude(n) $* z = $# zmagnitude(n) $* w" by simp
  then have b: "$# zmagnitude(n) $* z = $# zmagnitude(n) $* w"
    using zminus_inject a by simp
  have "zmagnitude(n) \<noteq> 0" using zmag_0_eq_0_iff[of n] ab by simp
  then have "0 < zmagnitude(n)" using zmagnitude_type Ord_0_lt by simp
  then show "z = w" using a b zmult_cancel[of "zmagnitude(n)" z w] by simp
next
  assume a: "n:int"
  then show "znegative(n) \<and> n = $- $# zmagnitude(n) \<or> \<not> znegative(n) \<and> n = $# zmagnitude(n)"
    using int_rep by simp
qed

declare zmod_def [simp]

theorem zmod_dep_type:
  "\<lbrakk> 0 < n; m:int; n:nat \<rbrakk> \<Longrightarrow> (m $// n) : nats(n)"
apply(auto)
proof -
  assume a: "0 < n" "m \<in> int" "n \<in> nat" "zmagnitude(m) mod n \<noteq> 0" "znegative(m)"
  then have b: "0 < zmagnitude(m) mod n" using mod_type Ord_0_lt by simp
  have "zmagnitude(m) mod n < n"
    using mod_less_divisor[of n "zmagnitude(m)"] using a by simp
  then have "zmagnitude(m) mod n \<le> n" using leI by simp
  then show "n #- zmagnitude(m) mod n < n"
    using div_termination[of "zmagnitude(m) mod n" n] a b by simp
next
  assume a: "0 < n" "m \<in> int" "n \<in> nat" "zmagnitude(m) mod n \<noteq> 0" "~znegative(m)"
  show "zmagnitude(m) mod n < n"
    using mod_less_divisor[of n "zmagnitude(m)"] using a by simp
qed

theorem zmod_less_pos:
  "\<lbrakk> 0 < n; m:int; n:nat; zmagnitude(m) < n; ~znegative(m)\<rbrakk>
    \<Longrightarrow> m $// n = zmagnitude(m)"
apply(auto)
done

theorem zmod_less_neg:
  "\<lbrakk> 0 < n; m:int; n:nat; zmagnitude(m) < n; znegative(m);
    zmagnitude(m) mod n \<noteq> 0 \<rbrakk>
    \<Longrightarrow> m $// n = n #- zmagnitude(m)"
apply(auto)
done

theorem zmod_pos:
  "\<lbrakk> 0 < n; m:int; ~znegative(m) \<rbrakk>
    \<Longrightarrow> m $// n = zmagnitude(m) mod n"
apply(auto)
done

theorem zmod_neg_0:
  "\<lbrakk> 0 < n; m:int; znegative(m); zmagnitude(m) mod n = 0 \<rbrakk>
    \<Longrightarrow> m $// n = 0"
apply(auto)
done

theorem zmod_neg_not0:
  "\<lbrakk> 0 < n; m:int; znegative(m); zmagnitude(m) mod n ~= 0 \<rbrakk>
    \<Longrightarrow> m $// n = n #- (zmagnitude(m) mod n)"
apply(auto)
done

declare zdiv_def [simp]

theorem zdiv_type:
  "\<lbrakk> 0 < n; m:int; n:nat \<rbrakk> \<Longrightarrow> m $/ n : int"
apply(auto)
done

theorem zdiv_less_pos:
  "\<lbrakk> 0 < n; m:int; n:nat; zmagnitude(m) < n; ~znegative(m) \<rbrakk>
    \<Longrightarrow> m $/ n = $#0"
apply(auto)
done

theorem zdiv_less_neg:
  "\<lbrakk> 0 < n; m:int; n:nat; zmagnitude(m) < n; znegative(m) \<rbrakk>
    \<Longrightarrow> m $/ n = $- $#1"
apply(auto)
apply(drule zmag_0_eq_0_iff, simp)
done

theorem zdiv_geq_pos:
  "\<lbrakk> 0 < n; m:int; n:nat; n \<le> zmagnitude(m); ~znegative(m) \<rbrakk>
    \<Longrightarrow> m $/ n = $# (zmagnitude(m) div n)"
apply(auto)
done

theorem zdiv_geq_neg_0:
  "\<lbrakk> 0 < n; m:int; n:nat; znegative(m); n \<le> zmagnitude(m);
    zmagnitude(m) mod n = 0 \<rbrakk>
    \<Longrightarrow> m $/ n = $- $# (zmagnitude(m) div n)"
apply(auto)
done

theorem zdiv_geq_neg_not0:
  "\<lbrakk> 0 < n; m:int; n:nat; znegative(m); n \<le> zmagnitude(m);
    zmagnitude(m) mod n \<noteq> 0 \<rbrakk>
    \<Longrightarrow> m $/ n = $- $# (succ(zmagnitude(m) div n))"
apply(auto)
done

lemma same_eq_minus: "m = k \<Longrightarrow> m #- n = k #- n"
apply(auto)
done

theorem zmod_zdiv_equality: "\<lbrakk> 0 < n; m:int; n:nat \<rbrakk> \<Longrightarrow> (m $/ n) $* $#n $+ $#(m $// n) = m"
apply(auto)
apply(subst int_zneg_zmag_iff, auto)
apply(insert div_type[of "zmagnitude(m)" n])
apply(insert znat_mult[of "zmagnitude(m) div n" n, THEN sym], auto)
apply(rule znegative_minus_int_of, simp)
apply(rule ccontr, auto)
apply(insert mod_div_equality[of "zmagnitude(m)" n, THEN sym], auto)
apply(insert zmag_0_eq_0_iff[of m], auto)
prefer 2
apply(insert int_of_add[of "zmagnitude(m) div n #* n" "(zmagnitude(m) mod n)", THEN sym], auto)
apply(subst succ_add_1, simp)
apply(rule zminus_inject, auto)
proof -
  assume a: "0 < n" "m:int" "n:nat" "znegative(m)" "zmagnitude(m) mod n \<noteq> 0" "m \<noteq> $# 0"
      and ab: "zmagnitude(m) = zmagnitude(m) div n #* n #+ zmagnitude(m) mod n"
  then have b: "$# succ(zmagnitude(m) div n) $* $# n $+ $- $# (n #- zmagnitude(m) mod n)
            = $# (succ(zmagnitude(m) div n) #* n) $+ $- $# (n #- zmagnitude(m) mod n)"
    using znat_mult[of "succ(zmagnitude(m) div n)" n] by simp
  then have c: "$# (succ(zmagnitude(m) div n) #* n) $+ $- $# (n #- zmagnitude(m) mod n)
            = $# (succ(zmagnitude(m) div n) #* n) $- $# (n #- zmagnitude(m) mod n)"
    using zdiff_def by simp
  then have d: "$# (succ(zmagnitude(m) div n) #* n) $- $# (n #- zmagnitude(m) mod n)
            = $# (succ(zmagnitude(m) div n) #* n) $- $# (n #- zmagnitude(m) mod n)"
    using zdiff_def by simp
  have e: "n \<le> succ(zmagnitude(m) div n) #* n" using a by(auto)
  have "n #- zmagnitude(m) mod n \<le> n" using diff_le_self a by(auto)
  then have "n #- zmagnitude(m) mod n \<le> succ(zmagnitude(m) div n) #* n"
    using le_trans e by simp
  then have f: "$# (succ(zmagnitude(m) div n) #* n) $- $# (n #- zmagnitude(m) mod n)
            = $# ((succ(zmagnitude(m) div n) #* n) #- (n #- zmagnitude(m) mod n))"
    using int_of_diff a by simp
  then have g: "$# ((succ(zmagnitude(m) div n) #* n) #- (n #- zmagnitude(m) mod n))
            =  $# (((zmagnitude(m) div n #+ 1) #* n) #- (n #- zmagnitude(m) mod n))"
    using a by(auto)
  have h: "$#((zmagnitude(m) div n #+ 1) #* n #- (n #- zmagnitude(m) mod n))
        = $#(zmagnitude(m) div n #* n #+ 1 #* n #- (n #- zmagnitude(m) mod n))"
    using add_mult_distrib[of "(zmagnitude(m) div n)" 1 n]
          same_eq_minus by simp
  have i: "$#(zmagnitude(m) div n #* n #+ 1 #* n #- (n #- zmagnitude(m) mod n))
        = $#(zmagnitude(m) div n #* n #+ n #- (n #- zmagnitude(m) mod n))" by simp
  have mod_less_self: "zmagnitude(m) mod n < n" using mod_less_divisor a by simp
  then have "zmagnitude(m) mod n \<le> n" using leI by simp
  then have "n #- zmagnitude(m) mod n < n"
    using div_termination[of "zmagnitude(m) mod n" n] a Ord_0_lt_iff by(auto)
  then have j: "$#(zmagnitude(m) div n #* n #+ n #- (n #- zmagnitude(m) mod n))
        = $#(zmagnitude(m) div n #* n #+ (n #- (n #- zmagnitude(m) mod n)))"
    using diff_add_assoc[of "n #- zmagnitude(m) mod n" n "zmagnitude(m) div n #* n"] a by(auto)
  have k: " $#(zmagnitude(m) div n #* n #+ (n #- (n #- zmagnitude(m) mod n)))
            =  $#(zmagnitude(m) div n #* n #+ zmagnitude(m) mod n)"
    using diff_diff_inverse mod_less_self a by(auto)
  have "$#(zmagnitude(m) div n #* n #+ zmagnitude(m) mod n)
            = $#(zmagnitude(m))" using ab by(auto)
  then have "$# succ(zmagnitude(m) div n) $* $# n $+ $- $# (n #- zmagnitude(m) mod n)
            =  $#(zmagnitude(m))" using b c d f g h i j k by(auto)
  then have "$# succ(zmagnitude(m) div n) $* $# n $+ $- $# (n #- zmagnitude(m) mod n)
            = $- m" using zneg_zmag[of m] a by(auto)
  then show "$# succ(zmagnitude(m) div n) $* $# n $+ $- $# (n #- zmagnitude(m) mod n) = $- m"
    by simp
qed

theorem int_factorise:
  "ALL t':int. ALL n:{x:nat. 0 < x}. EX t:int. EX j:nats(n).
    t $* $#n $+ $#j = t'"
apply(auto)
apply(rename_tac l n)
apply(rule bexI)
apply(rule bexI)
apply(rule conjI)
proof -
  fix n l
  assume a: "n:nat" "l:int" "0 < n"
  then have main: "(l $/ n) $* $# n $+ $#(l $// n) = l"
    using zmod_zdiv_equality[of n l] by(simp)
  have b: "l $// n:nats(n)" using zmod_dep_type a by(auto)
  have c: "l $/ n:int" using a by(auto)
  let ?j25 = "l $// n"
  show lt_n: "?j25 < n" using a zmod_dep_type by(auto)
  have d: "(l $/ n) $* $#n $+ $# ?j25 = l" using main by(auto)
  let ?t22 = "l $/ n"
  show "?t22 $* $#n $+ $# ?j25 = l" using d main by(auto)
  show "l $// n:nat" using a by(auto)
  show "l $/ n:int" using a by(auto)
qed

theorem int_factorise2:
  "\<lbrakk> t':int; n:{x:nat. 0 < x} \<rbrakk>
    \<Longrightarrow> EX t:int. EX j:nats(n). $#n $* t $+ $#j = t'"
apply(simp only: zmult_commute)
apply(insert int_factorise, simp)
done

lemma mult_lt_keeps_ineqaulity: "\<lbrakk> a:nat; b:nat; c:nat; a < b; 0 < c \<rbrakk> \<Longrightarrow> a < b #* c"
apply(case_tac c, auto)
apply(insert add_lt_larger_side_help[of b a _], simp)
done

theorem mult_zmag_gt:
  "\<lbrakk> n:nat; 0 < n; t:int; znegative(t); j:nat; j < n \<rbrakk>
    \<Longrightarrow> j < n #* zmagnitude(t)"
apply(drule zneg_zmag_0_lt, auto)
apply(rule mult_lt_keeps_ineqaulity, auto)
done

theorem zneg_nt_simp:
  "\<lbrakk> n:nat; 0 < n; t:int; j:nat; j < n; znegative(t) \<rbrakk>
    \<Longrightarrow> $# n $* t $+ $# j = $-$#(n #* zmagnitude(t) #- j)"
proof -
  assume a: "znegative(t)" "t:int" "n:nat" "j < n" "j:nat"
  then have "$# n $* t = $# n $* ($- $# zmagnitude(t))" using int_rep[of t] by simp
  then have "$# n $* t = $- $# n $* $# zmagnitude(t)" by simp
  then have "$# n $* t $+ $# j= $- $# n $* $# zmagnitude(t) $+ $# j" by simp
  then have "$# n $* t $+ $# j=  $# j $+ $- $# n $* $# zmagnitude(t)"
    using zadd_commute by simp
  then have "$# n $* t $+ $# j=  $# j $- $# n $* $# zmagnitude(t)" using zdiff_def by simp
  then have "$# n $* t $+ $# j=  $- ($# n $* $# zmagnitude(t) $- $# j)"
    using zminus_zdiff_eq by simp
  then have b: "$# n $* t $+ $# j=  $- ($# (n #* zmagnitude(t)) $- $# j)"
    using znat_mult a by simp
  have "0 < zmagnitude(t)" using zneg_zmag_0_lt a by simp
  then have "j < n #* zmagnitude(t)" using mult_lt_keeps_ineqaulity a by simp
  then have "j \<le> n #* zmagnitude(t)" using leI by simp
  then have "$# n $* t $+ $# j=  $- ($# (n #* zmagnitude(t) #- j))"
    using b int_of_diff by simp
  then show ?thesis by simp
qed

theorem zneg_mult_add:
  "\<lbrakk> n:nat; 0 < n; t:int; znegative(t); j:nat; j < n \<rbrakk>
    \<Longrightarrow> znegative($# n $* t $+ $# j)"
apply(subst zneg_nt_simp, auto)
apply(rule znegative_minus_int_of, auto)
apply(insert diff_is_0_lemma[of "n #* zmagnitude(t)" j], auto)
apply(insert zneg_zmag_0_lt[of t], auto)
apply(insert mult_lt_keeps_ineqaulity[of j n "zmagnitude(t)"], auto)
apply(drule le_imp_not_lt, auto)
done

lemma zneg_zmult_rep: "\<lbrakk>  m:nat; t:int; znegative(t) \<rbrakk> \<Longrightarrow> $# m $* t = $- $#(m #* zmagnitude(t))"
proof -
  assume a: "m:nat" "t:int" "znegative(t)"
  then have " $# m $* t = $# m $* ($- $# zmagnitude(t))" using int_rep[of t] by simp
  then have b: "$# m $* t = $- ($# m $* $# zmagnitude(t))" by simp
  then have "$# m $* $# zmagnitude(t) = $# (m #* zmagnitude(t))"
    using znat_mult[of m "zmagnitude(t)", THEN sym] a by simp
  then have "$# m $* t = $- $# (m #* zmagnitude(t))" using b by simp
  then show ?thesis by simp
qed

lemma not_zneg_zmult_rep: "\<lbrakk>  m:nat; t:int; ~znegative(t) \<rbrakk> \<Longrightarrow> $# m $* t = $#(m #* zmagnitude(t))"

proof -
  assume a: "m:nat" "t:int" "~znegative(t)"
  then have " $# m $* t = $# m $* ($# zmagnitude(t))" using int_rep[of t] by simp
  then have b: "$# m $* t = ($# m $* $# zmagnitude(t))" by simp
  then have "$# m $* $# zmagnitude(t) = $# (m #* zmagnitude(t))"
    using znat_mult[of m "zmagnitude(t)", THEN sym] a by simp
  then have "$# m $* t = $# (m #* zmagnitude(t))" using b by simp
  then show ?thesis by simp
qed

lemma zneg_zmult_zmag_iff:
  "\<lbrakk> m:nat; t:int; znegative(t); j:nat; j < m \<rbrakk>
    \<Longrightarrow> zmagnitude($# m $* t $+ $# j) = (m #* zmagnitude(t) #- j)"
apply(subst zneg_zmult_rep, auto)
proof -
  assume a: "m \<in> nat" "t \<in> int" "znegative(t)" "j < m" "j:nat"
  then have "0 < zmagnitude(t)" using zneg_zmag_0_lt[of t] by simp
  then have "j \<le> m #* zmagnitude(t)"
    using mult_lt_keeps_ineqaulity[of j m "zmagnitude(t)"] a leI by simp
  then have "zmagnitude($- $# (m #* zmagnitude(t)) $+ $# j) = zmagnitude($- $# (m #* zmagnitude(t) #- j))"
    using zminus_diff[of "m #* zmagnitude(t)" j] a by simp
  then have "zmagnitude($- $# (m #* zmagnitude(t)) $+ $# j) = zmagnitude($# (m #* zmagnitude(t) #- j))"
    by simp
  then have "zmagnitude($- $# (m #* zmagnitude(t)) $+ $# j) = (m #* zmagnitude(t) #- j)"
    by simp
  then show "zmagnitude($- $# (m #* zmagnitude(t)) $+ $# j) = (m #* zmagnitude(t) #- j)" by simp
qed

lemma not_zneg_zmult_zmag_iff:
  "\<lbrakk> m:nat; t:int; ~znegative(t); j:nat\<rbrakk>
    \<Longrightarrow> zmagnitude($# m $* t $+ $# j) = (m #* zmagnitude(t) #+ j)"
apply(subst not_zneg_zmult_rep, auto)
proof -
  assume a: "m \<in> nat" "t \<in> int" "~znegative(t)" "j:nat"
  have "zmagnitude($# (m #* zmagnitude(t)) $+ $# j) = zmagnitude($# (m #* zmagnitude(t) #+ j))"
    using int_of_add a by simp
  then show "zmagnitude($# (m #* zmagnitude(t)) $+ $# j) = (m #* zmagnitude(t) #+ j)"
    by simp
qed

lemma div_termination2: "\<lbrakk>n \<le> m; m \<in> nat; n:nat \<rbrakk> \<Longrightarrow> m #- n \<le> m"
apply(case_tac n, auto)
proof -
  fix x
  assume a: "x < m" "m \<in> nat" "x \<in> nat" "n = succ(x)"
  then have b: "succ(x) \<le> m" by simp
  have "0 \<le> x" using a by simp
  then have "m #- succ(x) < m" using div_termination[of "succ(x)" m] b a by simp
  then show "m #- succ(x) \<le> m" using leI by(simp)
qed

theorem zmod_mult_self:
  "\<lbrakk> n:nat; 0 < n; t:int; j:nats(n) \<rbrakk>
    \<Longrightarrow> ($# n $* t $+ $# j) $// n = j"
apply(subgoal_tac "znegative(t) | ~znegative(t)")
prefer 2
apply(simp)
apply(erule disjE)
apply(frule zneg_zmag_0_lt, simp)
apply(auto)
proof -
  assume a: "n \<in> nat" "0 < n" "t \<in> int" "znegative(t)" "0 < zmagnitude(t)"
            "j \<in> nat" "j < n" "zmagnitude($# n $* t $+ $# j) mod n = 0"
  then have "zmagnitude($# n $* t $+ $# j) mod n = (n #* zmagnitude(t) #- j) mod n"
    using zneg_zmult_zmag_iff[of n t j] by simp
  then have "zmagnitude($# n $* t $+ $# j) mod n = (n #- j) mod n"
    using mod_diff[of "zmagnitude(t)" n j] a by simp
  then have b: "(n #- j) mod n = 0" using a by simp
  have "j \<le> n" using leI a by simp
  then have d: "n #- j \<le> n" using div_termination2[of j n] a by simp
  then have d: "n #- j < n \<or> n #- j = n" using a le_iff[of "n #- j" n] by simp
  {
    assume "n #- j < n"
    then have "(n #- j) mod n = n #- j" using mod_less[of "n #- j" n] using a by simp
    then have "n #- j = 0" using b by simp
    then have c: "n \<le> j" using diff_is_0_lemma a by simp
    then have "~ j < n" using le_imp_not_lt by simp
    then have "False" using a by simp
    then have "0 = j" by simp
  } then have c: "n #- j < n \<Longrightarrow> 0 = j" by simp
  {
    assume "n #- j = n"
    then have "n #- (n #- j) = n #- n" by simp
    then have "j = n #- n" using a diff_diff_inverse by simp
    then have "j = 0" by simp
  } then have "n #- j = n \<Longrightarrow> 0 = j" by simp
  then show "0 = j" using c d by(auto)
next
  assume a: "n \<in> nat" "0 < n" "t \<in> int" "znegative(t)" "0 < zmagnitude(t)"
            "j \<in> nat" "j < n" "zmagnitude($# n $* t $+ $# j) mod n \<noteq> 0"
  then have "zmagnitude($# n $* t $+ $# j) mod n = (n #* zmagnitude(t) #- j) mod n"
    using zneg_zmult_zmag_iff[of n t j] by simp
  then have mod: "zmagnitude($# n $* t $+ $# j) mod n = (n #- j) mod n"
    using mod_diff[of "zmagnitude(t)" n j] a by simp
  then have b: "(n #- j) mod n \<noteq> 0" using a by simp
  then have "j \<noteq> 0"
    proof -
      assume c: "(n #- j) mod n \<noteq> 0"
      {
        assume "j = 0"
        then have "(n #- j) mod n = n mod n" by simp
        then have "(n #- j) mod n = (n #- n) mod n" using mod_geq[of n n] le_refl_iff a by simp
        then have "(n #- j) mod n = 0 mod n" by simp
        then have "(n #- j) mod n = 0" using a by simp
        then have "False" using c by simp
      } then have "j = 0 \<Longrightarrow> False" by simp
      then show "j \<noteq> 0" by(auto)
  qed
  then have j: "0 < j" using a Ord_0_lt by simp
  then have c: "(n #- j) mod n < n" using mod_less_divisor a by simp
  have "j \<le> n" using a leI by simp
  then have "n #- j < n" using div_termination[of j n] a j by simp
  then have "(n #- j) mod n = n #- j" using mod_less a by simp
  then have "n #- zmagnitude($# n $* t $+ $# j) mod n = n #- (n #- j)" using mod by simp
  then show "n #- zmagnitude($# n $* t $+ $# j) mod n = j" using a diff_diff_inverse by simp
next
  assume a: "n \<in> nat" "0 < n" "t \<in> int" "znegative(t)" "0 < zmagnitude(t)"
            "j \<in> nat" "j < n" "zmagnitude($# n $* t $+ $# j) mod n \<noteq> 0"
            "\<not> znegative($# n $* t $+ $# j)"
  then have "$# n $* t $+ $# j = $- $#(n #* zmagnitude(t)) $+ $# j"
    using zneg_zmult_rep by simp
  then have "$# n $* t $+ $# j = $# j $+ $- $#(n #* zmagnitude(t))"
    using zadd_commute by(auto)
  then have "$# n $* t $+ $# j = $# j $- $#(n #* zmagnitude(t))"
    using zdiff_def by(auto)
  then have b: "$# n $* t $+ $# j = $- ($#(n #* zmagnitude(t)) $- $# j)"
    using zminus_zdiff_eq by simp
  have c: "j < n #* zmagnitude(t)" using mult_lt_keeps_ineqaulity a by simp
  then have "j \<le> n #* zmagnitude(t)" using leI by simp
  then have d: "$# n $* t $+ $# j = $- $#(n #* zmagnitude(t) #- j)"
    using int_of_diff[of "n #* zmagnitude(t)" j] b a by simp
  then have "0 < n #* zmagnitude(t) #- j" using c a by simp
  then have "n #* zmagnitude(t) #- j \<noteq> 0" using a Ord_0_lt_iff by simp
  then have "znegative($# n $* t $+ $# j)" using znegative_minus_int_of a d by simp
  then have "False" using a by simp
  then show "zmagnitude($# n $* t $+ $# j) mod n = j" by simp
next
  assume a: "n \<in> nat" "0 < n" "t \<in> int" "~znegative(t)"
            "j \<in> nat" "j < n" "zmagnitude($# n $* t $+ $# j) mod n = 0"
  then have "zmagnitude($# n $* t $+ $# j) mod n = (n #* zmagnitude(t) #+ j) mod n"
    using not_zneg_zmult_zmag_iff[of n t j] by simp
  then have "zmagnitude($# n $* t $+ $# j) mod n = j"
    using mod_mult_self[of "zmagnitude(t)" n j] a by simp
  then show "0 = j" using a by simp
next
  assume a: "n \<in> nat" "0 < n" "t \<in> int" "~znegative(t)"
            "j \<in> nat" "j < n" "zmagnitude($# n $* t $+ $# j) mod n ~= 0"
  then have "zmagnitude($# n $* t $+ $# j) mod n = (n #* zmagnitude(t) #+ j) mod n"
    using not_zneg_zmult_zmag_iff[of n t j] by simp
  then show "zmagnitude($# n $* t $+ $# j) mod n = j"
    using mod_mult_self[of "zmagnitude(t)" n j] a by simp
next
  assume a: "n \<in> nat" "0 < n" "t \<in> int" "\<not> znegative(t)" "j \<in> nat" "j < n"
          "zmagnitude($# n $* t $+ $# j) mod n \<noteq> 0" "znegative($# n $* t $+ $# j)"
  then have "znegative($# n $* $# zmagnitude(t) $+ $# j)" by simp
  then have "znegative($# (n #* zmagnitude(t)) $+ $# j)"
    using znat_mult a by simp
  then have b: "znegative($# (n #* zmagnitude(t) #+ j))"
    using int_of_add by simp
  have "\<not> znegative($# (n #* zmagnitude(t) #+ j))"
    using not_znegative_int_of by simp
  then have "False" using b by simp
  then show "n #- zmagnitude($# n $* t $+ $# j) mod n = j" by simp
qed

declare zmod_def [simp del]
declare zdiv_def [simp del]

theorem zdiv_mult_self:
  "\<lbrakk> n:nat; 0 < n; t:int; j:nats(n) \<rbrakk>
    \<Longrightarrow> ($# n $* t $+ $# j) $/ n = t"
apply(insert zmod_zdiv_equality[of n "$# n $* t $+ $# j"], simp)
apply(simp add: zmod_mult_self)
apply(insert zmult_cancel[of n "($# n $* t $+ $# j) $/ n" t])
apply(auto simp add: zmult_commute)
apply(insert zdiv_type, auto)
done

lemmas int_typechecks =
  zdiff_type int_typechecks

lemmas numt =
  int_typechecks arith_typechecks

lemmas int_simps =
  zminus_zminus zmagnitude_int_of zminus_int0
  zmult_zminus zmult_zminus_right zmagnitude_zminus_int_of
  zadd_int0 zadd_zminus_inverse2 zadd_int0_right
  zmult_int1 zmult_int0 zmult_1_right zmult_0_right
  zadd_zminus_inverse not_zneg_mag zneg_zmag zminus_diff

lemmas int_ss = int_simps int_typechecks

declare int_ss [simp]

declare nats_def[simp del]

lemmas zadd_ac =
  zadd_assoc zadd_commute zadd_left_commute

lemmas zdiv_rls =
  int_of_add[THEN sym] znat_mult[THEN sym]
  mod_less mod_div_equality zmult_zminus
  zmod_less_pos zmod_less_neg zmod_pos
  zmod_neg_0 zmod_neg_not0 zdiv_less_pos
  zdiv_less_neg zdiv_geq_pos zdiv_geq_neg_0
  zdiv_geq_neg_not0 nat_into_Ord not_lt_iff_le

end


section \<open>Accuracy with cutoff\label{sec:accuracy}\<close>

text \<open>This section verifies that each of the $l$ estimate have the required accuracy with high
probability assuming as long as the cutoff is below @{term "s\<^sub>M"}, generalizing the result from
Section~\ref{sec:accuracy_wo_cutoff}.\<close>

theory Distributed_Distinct_Elements_Accuracy
  imports
    Distributed_Distinct_Elements_Accuracy_Without_Cutoff
    Distributed_Distinct_Elements_Cutoff_Level
begin

unbundle intro_cong_syntax

lemma (in semilattice_set) Union:
  assumes "finite I" "I \<noteq> {}"
  assumes "\<And>i. i \<in> I \<Longrightarrow> finite (Z i)"
  assumes "\<And>i. i \<in> I \<Longrightarrow> Z i \<noteq> {}"
  shows "F (\<Union> (Z ` I)) = F ((\<lambda>i. (F (Z i))) ` I)"
  using assms(1,2,3,4)
proof (induction I rule:finite_ne_induct)
  case (singleton x)
  then show ?case by simp
next
  case (insert x I)
  have "F (\<Union> (Z ` insert x I)) = F ((Z x) \<union> (\<Union> (Z ` I)))"
    by simp
  also have "... = f (F (Z x)) (F (\<Union> (Z ` I)))"
    using insert by (intro union finite_UN_I) auto
  also have "... = f (F {F (Z x)}) (F ((\<lambda>i. F (Z i)) ` I))"
    using insert(5,6) by (subst insert(4)) auto
  also have "... = F ({F (Z x)} \<union> (\<lambda>i. F (Z i)) ` I)"
    using insert(1,2) by (intro union[symmetric] finite_imageI) auto
  also have "... = F ((\<lambda>i. F (Z i)) ` insert x I)"
    by simp
  finally show ?case by simp
qed

text \<open>This is similar to the existing @{thm [source] hom_Max_commute} with the crucial difference
that it works even if the function is a homomorphism between distinct lattices.
An example application is @{term "Max (int ` A) = int (Max A)"}.\<close>

lemma hom_Max_commute':
  assumes "finite A" "A \<noteq> {}"
  assumes "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> max (f x) (f y) = f (max x y)"
  shows "Max (f ` A) = f (Max A)"
  using assms by (induction A rule:finite_ne_induct) auto

context inner_algorithm_fix_A
begin

definition t\<^sub>c
  where "t\<^sub>c \<psi> \<sigma> = (Max ((\<lambda>j. \<tau>\<^sub>1 \<psi> A \<sigma> j + \<sigma>) ` {..<b})) - b_exp + 9"

definition s\<^sub>c (* tilde t *)
  where "s\<^sub>c \<psi> \<sigma> = nat (t\<^sub>c \<psi> \<sigma>)"

definition p\<^sub>c (* tilde p *)
  where "p\<^sub>c \<psi> \<sigma> = card {j\<in> {..<b}. \<tau>\<^sub>1 \<psi> A \<sigma> j + \<sigma> \<ge> s\<^sub>c \<psi> \<sigma>}"

definition Y\<^sub>c (* tilde A* *)
  where "Y\<^sub>c \<psi> \<sigma> = 2 ^ s\<^sub>c \<psi> \<sigma> * \<rho>_inv (p\<^sub>c \<psi> \<sigma>)"

lemma s\<^sub>c_eq_s:
  assumes "(f,g,h) \<in> sample_set \<Psi>"
  assumes "\<sigma> \<le> s f"
  shows "s\<^sub>c (f,g,h) \<sigma> = s f"
proof -
  have "int (Max (f ` A)) - int b_exp + 9 \<le> int (Max (f ` A)) - 26 + 9"
    using b_exp_ge_26 by (intro add_mono diff_left_mono) auto
  also have "... \<le> int (Max (f ` A))" by simp
  finally have 1:"int (Max (f ` A)) - int b_exp + 9 \<le> int (Max (f ` A))"
    by simp
  have "\<sigma> \<le> int (s f)" using assms(2) by simp
  also have "... = max 0 (t f)"
    unfolding s_def by simp
  also have "... \<le> max 0 (int (Max (f ` A)))"
    unfolding t_def using 1 by simp
  also have "... = int (Max (f ` A))"
    by simp
  finally have "\<sigma> \<le> int (Max (f ` A))"
    by simp
  hence 0: "int \<sigma> - 1 \<le> int (Max (f ` A))"
    by simp

  have c:"h \<in> sample_set (\<H> k (C\<^sub>7 * b\<^sup>2) [b]\<^sub>S)"
    using assms(1) sample_set_\<Psi> by auto
  hence h_range: "h x < b" for x
    using h_range_1 by simp

  have "(MAX j\<in>{..<b}. \<tau>\<^sub>1 (f, g, h) A \<sigma> j + int \<sigma>) =
    (MAX x\<in>{..<b}. Max ({int (f a) |a. a \<in> A \<and> h (g a) = x} \<union> {-1} \<union> {int \<sigma> -1}))"
    using fin_f[OF assms(1)] by (simp add:max_add_distrib_left max.commute \<tau>\<^sub>1_def)
  also have "... = Max (\<Union>x<b. {int (f a) |a. a \<in> A \<and> h (g a) = x} \<union> {- 1} \<union> {int \<sigma> - 1})"
    using fin_f[OF assms(1)] b_ne by (intro Max.Union[symmetric]) auto
  also have "... = Max ({int (f a) |a. a \<in> A} \<union> {- 1, int \<sigma> - 1})"
    using h_range by (intro arg_cong[where f="Max"]) auto
  also have "... = max (Max (int ` f ` A)) (int \<sigma> - 1)"
    using A_nonempty fin_A unfolding Setcompr_eq_image image_image
    by (subst Max.union) auto
  also have "... = max (int (Max (f ` A))) (int \<sigma> - 1)"
    using fin_A A_nonempty by (subst hom_Max_commute') auto
  also have "... = int (Max (f ` A))"
    by (intro max_absorb1 0)
  finally have "(MAX j\<in>{..<b}. \<tau>\<^sub>1 (f, g, h) A \<sigma> j + int \<sigma>) = Max (f ` A)" by simp

  thus ?thesis
    unfolding s\<^sub>c_def t\<^sub>c_def s_def t_def by simp
qed

lemma p\<^sub>c_eq_p:
  assumes "(f,g,h) \<in> sample_set \<Psi>"
  assumes "\<sigma> \<le> s f"
  shows "p\<^sub>c (f,g,h) \<sigma> = p (f,g,h)"
proof -
  have "{j \<in> {..<b}. int (s f) \<le> max (\<tau>\<^sub>0 (f, g, h) A j) (int \<sigma> - 1)} =
    {j \<in> {..<b}. int (s f) \<le> max (\<tau>\<^sub>0 (f, g, h) A j) (- 1)}"
    using assms(2) unfolding le_max_iff_disj by simp
  thus ?thesis
    unfolding p\<^sub>c_def p_def s\<^sub>c_eq_s[OF assms]
    by (simp add:max_add_distrib_left \<tau>\<^sub>1_def del:\<tau>\<^sub>0.simps)
qed

lemma Y\<^sub>c_eq_Y:
  assumes "(f,g,h) \<in> sample_set \<Psi>"
  assumes "\<sigma> \<le> s f"
  shows "Y\<^sub>c (f,g,h) \<sigma> = Y (f,g,h)"
  unfolding Y\<^sub>c_def Y_def s\<^sub>c_eq_s[OF assms] p\<^sub>c_eq_p[OF assms] by simp

lemma accuracy_single: "measure \<Psi> {\<psi>. \<exists>\<sigma> \<le> q_max. \<bar>Y\<^sub>c \<psi> \<sigma> - real X\<bar> > \<delta> * X} \<le> 1/2^4"
  (is "?L \<le> ?R")
proof -
  have "measure \<Psi> {\<psi>. \<exists>\<sigma> \<le> q_max. \<bar>Y\<^sub>c \<psi> \<sigma> - real X\<bar> > \<delta> * real X} \<le>
    measure \<Psi> {(f,g,h). \<bar>Y (f,g,h) - real X\<bar> >  \<delta> * real X \<or> s f < q_max}"
  proof (rule pmf_mono)
    fix \<psi>
    assume a:"\<psi> \<in> {\<psi>. \<exists>\<sigma>\<le>q_max. \<delta> * real X < \<bar>Y\<^sub>c \<psi> \<sigma> - real X\<bar>}"
    assume d:"\<psi> \<in> set_pmf (sample_pmf \<Psi>)"
    obtain \<sigma> where b:"\<sigma> \<le> q_max" and c:" \<delta> * real X < \<bar>Y\<^sub>c \<psi> \<sigma> - real X\<bar>"
      using a by auto
    obtain f g h where \<psi>_def: "\<psi> = (f,g,h)" by (metis prod_cases3)
    hence e:"(f,g,h) \<in> sample_set \<Psi>"
      using d unfolding sample_space_alt[OF sample_space_\<Psi>] by simp

    show "\<psi> \<in> {(f, g, h). \<delta> * real X < \<bar>Y (f, g, h) - real X\<bar> \<or> s f < q_max}"
    proof (cases "s f \<ge> q_max")
      case True
      hence f:"\<sigma> \<le> s f" using b by simp
      have "\<delta> * real X < \<bar>Y \<psi> - real X\<bar>"
        using Y\<^sub>c_eq_Y[OF e f] c unfolding \<psi>_def by simp
      then show ?thesis unfolding \<psi>_def by simp
    next
      case False
      then show ?thesis unfolding \<psi>_def by simp
    qed
  qed
  also have "... \<le> 1/2^4"
    using accuracy_without_cutoff by simp
  finally show ?thesis by simp
qed

lemma estimate1_eq:
  assumes "j < l"
  shows "estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>, \<sigma>) j = Y\<^sub>c (\<omega> j) \<sigma>" (is "?L = ?R")
proof -
  define t where "t = max 0 (Max ((\<tau>\<^sub>2 \<omega> A \<sigma> j) ` {..<b}) + \<sigma> - \<lfloor>log 2 b\<rfloor> + 9)"
  define p where "p = card { k. k \<in> {..<b} \<and> (\<tau>\<^sub>2 \<omega> A \<sigma> j k) + \<sigma> \<ge> t }"

  have 0: "int (nat x) = max 0 x" for x
    by simp
  have 1: "\<lfloor>log 2 b\<rfloor> = b_exp"
    unfolding b_def by simp

  have "b > 0"
    using b_min by simp
  hence 2: " {..<b} \<noteq> {}" by auto

  have "t = int (nat (Max ((\<tau>\<^sub>2 \<omega> A \<sigma> j) ` {..<b}) + \<sigma> - b_exp + 9))"
    unfolding t_def 0 1 by (rule refl)
  also have "... = int (nat (Max ((\<lambda>x. x + \<sigma>) ` (\<tau>\<^sub>2 \<omega> A \<sigma> j) ` {..<b}) - b_exp + 9))"
    by (intro_cong "[\<sigma>\<^sub>1 int,\<sigma>\<^sub>1 nat,\<sigma>\<^sub>2(+),\<sigma>\<^sub>2(-)]" more:hom_Max_commute) (simp_all add:2)
  also have "... = int (s\<^sub>c (\<omega> j) \<sigma>)"
    using assms
    unfolding s\<^sub>c_def t\<^sub>c_def \<tau>\<^sub>2_def image_image by simp
  finally have 3:"t = int (s\<^sub>c (\<omega> j) \<sigma>)"
    by simp

  have 4: "p = p\<^sub>c (\<omega> j) \<sigma>"
    using assms unfolding p_def p\<^sub>c_def 3 \<tau>\<^sub>2_def by simp

  have "?L = 2 powr t * ln (1-p/b) / ln(1-1/b)"
    unfolding estimate1.simps \<tau>_def \<tau>\<^sub>3_def
    by (simp only:t_def p_def Let_def)
  also have "... = 2 powr (s\<^sub>c (\<omega> j) \<sigma>) * \<rho>_inv p"
    unfolding 3 \<rho>_inv_def by (simp)
  also have "... = ?R"
    unfolding Y\<^sub>c_def 3 4 by (simp add:powr_realpow)
  finally show ?thesis
    by blast
qed

lemma estimate_result\<^sub>c:
  "measure \<Omega> {\<omega>. (\<exists>\<sigma>\<le>q_max. \<delta>*X < \<bar>estimate (\<tau>\<^sub>2 \<omega> A \<sigma>,\<sigma>)-X\<bar>) } \<le> \<epsilon>/2"
    (is "?L \<le> ?R")
proof -
  define I :: "real set" where "I = {x. \<bar>x - real X\<bar> \<le> \<delta>*X}"

  define \<mu> where "\<mu> = measure \<Psi> {\<psi>. \<exists>\<sigma>\<le>q_max. Y\<^sub>c \<psi> \<sigma>\<notin>I}"

  have int_I: "interval I"
    unfolding interval_def I_def by auto

  have "\<mu> = measure \<Psi> {\<psi>. \<exists>\<sigma> \<le> q_max. \<bar>Y\<^sub>c \<psi> \<sigma> - real X\<bar> > \<delta> * X}"
    unfolding \<mu>_def I_def by (simp add:not_le)
  also have "... \<le>  1 / 2 ^ 4"
    by (intro accuracy_single)
  also have "... = 1/ 16"
    by simp
  finally have 1:"\<mu> \<le> 1 / 16" by simp

  have "(\<mu> + \<Lambda>) \<le> 1/16 + 1/16"
    unfolding \<Lambda>_def by (intro add_mono 1) auto
  also have "... \<le> 1/8"
    by simp
  finally have 2:"(\<mu> + \<Lambda>) \<le> 1/8"
    by simp

  hence 0: "(\<mu> + \<Lambda>) \<le> 1/2"
    by simp

  have "\<mu> \<ge> 0"
    unfolding \<mu>_def by simp
  hence 3: "\<mu> + \<Lambda> > 0"
    by (intro add_nonneg_pos \<Lambda>_gt_0)

  have "?L = measure \<Omega> {\<omega>. (\<exists>\<sigma>\<le>q_max. \<delta>*X < \<bar>median l (estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>,\<sigma>))-X\<bar>) }"
    by simp
  also have "... = measure \<Omega> {\<omega>. (\<exists>\<sigma>\<le>q_max. median l (estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>,\<sigma>)) \<notin> I)}"
    unfolding I_def by (intro measure_pmf_cong) auto
  also have "... \<le> measure \<Omega> {\<omega>. real(card{i\<in>{..<l}.(\<exists>\<sigma>\<le>q_max. Y\<^sub>c (\<omega> i) \<sigma>\<notin>I)})\<ge> real l/2}"
  proof (rule pmf_mono)
    fix \<omega>
    assume "\<omega> \<in> set_pmf \<Omega>" "\<omega> \<in> {\<omega>. \<exists>\<sigma>\<le>q_max. median l (estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>, \<sigma>)) \<notin> I}"
    then obtain \<sigma> where \<sigma>_def: "median l (estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>, \<sigma>)) \<notin> I" "\<sigma>\<le>q_max"
      by auto

    have "real l = 2 * real l - real l"
      by simp
    also have "... \<le> 2 * real l - 2 * card {i. i < l \<and> estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>, \<sigma>) i \<in> I}"
      using \<sigma>_def median_est[OF int_I, where n="l"] not_less
      by (intro diff_left_mono Nat.of_nat_mono) (auto simp del:estimate1.simps)
    also have "... = 2 * (real (card {..<l}) -card {i. i < l \<and> estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>, \<sigma>) i \<in> I})"
      by (simp del:estimate1.simps)
    also have "... = 2 * real (card {..<l} -card {i. i < l \<and> estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>, \<sigma>) i \<in> I})"
      by (intro_cong "[\<sigma>\<^sub>2 (*)]" more:of_nat_diff[symmetric] card_mono)
        (auto simp del:estimate1.simps)
    also have "... = 2 * real (card ({..<l} - {i. i < l \<and> estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>, \<sigma>) i \<in> I}))"
      by (intro_cong "[\<sigma>\<^sub>2 (*), \<sigma>\<^sub>1 of_nat]" more:card_Diff_subset[symmetric])
        (auto simp del:estimate1.simps)
    also have "... = 2 * real (card {i\<in>{..<l}. estimate1 (\<tau>\<^sub>2 \<omega> A \<sigma>, \<sigma>) i \<notin> I})"
      by (intro_cong "[\<sigma>\<^sub>2 (*), \<sigma>\<^sub>1 of_nat, \<sigma>\<^sub>1 card]") (auto simp del:estimate1.simps)
    also have "... = 2 * real (card {i \<in> {..<l}. Y\<^sub>c (\<omega> i) \<sigma> \<notin> I})"
      using estimate1_eq by (intro_cong "[\<sigma>\<^sub>2 (*), \<sigma>\<^sub>1 of_nat, \<sigma>\<^sub>1 card]" more:restr_Collect_cong) auto
    also have "... \<le> 2 * real (card {i \<in> {..<l}. (\<exists>\<sigma>\<le>q_max. Y\<^sub>c (\<omega> i) \<sigma> \<notin> I)})"
      using \<sigma>_def(2) by (intro mult_left_mono Nat.of_nat_mono card_mono) auto
    finally have "real l \<le> 2 * real (card {i \<in> {..<l}. (\<exists>\<sigma>\<le>q_max. Y\<^sub>c (\<omega> i) \<sigma> \<notin> I)})"
      by simp
    thus "\<omega> \<in> {\<omega>. real l/2 \<le> real (card {i \<in> {..<l}. \<exists>\<sigma>\<le>q_max. Y\<^sub>c (\<omega> i) \<sigma> \<notin> I})}"
      by simp
  qed
  also have "... = measure \<Omega> {\<omega>. real (card{i\<in>{..<l}. (\<exists>\<sigma>\<le>q_max. Y\<^sub>c (\<omega> i) \<sigma>\<notin>I)}) \<ge> (1/2)*real l}"
    unfolding sample_pmf_alt[OF \<Omega>.sample_space] p_def by simp
  also have "... \<le> exp (- real l * ((1/2) * ln (1 / (\<mu> + \<Lambda>)) - 2 * exp (- 1)))"
    using 0 unfolding \<mu>_def by (intro \<Omega>.tail_bound l_gt_0 \<Lambda>_gt_0) auto
  also have "... = exp (- (real l * ((1/2) * ln (1 / (\<mu> + \<Lambda>)) - 2 * exp (- 1))))"
    by simp
  also have "... \<le> exp (- (real l * ((1/2) * ln 8 - 2 * exp (- 1))))"
    using 2 3 l_gt_0 by (intro iffD2[OF exp_le_cancel_iff] le_imp_neg_le mult_left_mono diff_mono)
      (auto simp add:divide_simps)
  also have "... \<le> exp (- (real l * (1/4)))"
    by (intro iffD2[OF exp_le_cancel_iff] le_imp_neg_le mult_left_mono of_nat_0_le_iff)
     (approximation 5)
  also have "... \<le> exp (- (C\<^sub>6 * ln (2/ \<epsilon>)*(1/4)))"
    by (intro iffD2[OF exp_le_cancel_iff] le_imp_neg_le mult_right_mono l_lbound) auto
  also have "... = exp ( - ln (2/ \<epsilon>))"
    unfolding C\<^sub>6_def by simp
  also have "... = ?R"
    using \<epsilon>_gt_0 by (subst ln_inverse[symmetric]) auto
  finally show ?thesis
    by simp
qed

theorem estimate_result:
  "measure \<Omega> {\<omega>. \<bar>estimate (\<tau> \<omega> A)- X\<bar> >  \<delta> * X} \<le>  \<epsilon>"
  (is "?L \<le> ?R")
proof -
  let ?P = "measure \<Omega>"
  have "?L \<le> ?P {\<omega>. (\<exists>\<sigma>\<le>q_max.  \<delta>*real X<\<bar>estimate (\<tau>\<^sub>2 \<omega> A \<sigma>, \<sigma>)-real X\<bar>)\<or>q \<omega> A> q_max}"
    unfolding \<tau>_def \<tau>\<^sub>3_def not_le[symmetric]
    by (intro pmf_mono) auto
  also have "...\<le> ?P {\<omega>. (\<exists>\<sigma>\<le>q_max. \<delta>*real X<\<bar>estimate (\<tau>\<^sub>2 \<omega> A \<sigma>,\<sigma>)-X\<bar>)} + ?P {\<omega>. q \<omega> A> q_max}"
    by (intro pmf_add) auto
  also have "...\<le>  \<epsilon>/2 +  \<epsilon>/2"
    by (intro add_mono cutoff_level estimate_result\<^sub>c)
  also have "... =  \<epsilon>"
    by simp
  finally show ?thesis
    by simp
qed

end

lemma (in inner_algorithm) estimate_result:
  assumes "A \<subseteq> {..<n}" "A \<noteq> {}"
  shows "measure \<Omega> {\<omega>. \<bar>estimate (\<tau> \<omega> A)- real (card A)\<bar> > \<delta> * real (card A)} \<le> \<epsilon>" (is "?L \<le> ?R")
proof -
  interpret inner_algorithm_fix_A
    using assms by unfold_locales auto
  have "?L = measure \<Omega> {\<omega>. \<bar>estimate (\<tau> \<omega> A)- X\<bar> > \<delta> * X}"
    unfolding X_def by simp
  also have "... \<le> ?R"
    by (intro estimate_result)
  finally show ?thesis
    by simp
qed

unbundle no_intro_cong_syntax

end


(*  Title:      Containers/Lexicographic_Order.thy
    Author:     Andreas Lochbihler, KIT *)

theory Lexicographic_Order imports
  List_Fusion
  "HOL-Library.Char_ord"
begin

hide_const (open) List.lexordp

section \<open>List fusion for lexicographic order\<close>

context linorder begin

lemma lexordp_take_index_conv:
  "lexordp xs ys \<longleftrightarrow>
   (length xs < length ys \<and> take (length xs) ys = xs) \<or>
   (\<exists>i < min (length xs) (length ys). take i xs = take i ys \<and> xs ! i < ys ! i)"
  (is "?lhs = ?rhs")
proof
  assume ?lhs thus ?rhs
    by induct (auto 4 3 del: disjCI intro: disjI2 exI[where x="Suc i" for i])
next
  assume ?rhs (is "?prefix \<or> ?less") thus ?lhs
  proof
    assume "?prefix"
    hence "ys = xs @ hd (drop (length xs) ys) # tl (drop (length xs) ys)"
      by (metis append_Nil2 append_take_drop_id less_not_refl list.collapse)
    thus ?thesis unfolding lexordp_iff by blast
  next
    assume "?less"
    then obtain i where "i < min (length xs) (length ys)"
      and "take i xs = take i ys" and nth: "xs ! i < ys ! i" by blast
    hence "xs = take i xs @ xs ! i # drop (Suc i) xs" "ys = take i xs @ ys ! i # drop (Suc i) ys"
      by -(subst append_take_drop_id[symmetric, of _ i], simp_all add: Cons_nth_drop_Suc)
    with nth show ?thesis unfolding lexordp_iff by blast
  qed
qed

\<comment> \<open>lexord is extension of partial ordering List.lex\<close>
lemma lexordp_lex: "(xs, ys) \<in> lex {(xs, ys). xs < ys} \<longleftrightarrow> lexordp xs ys \<and> length xs = length ys"
proof(induct xs arbitrary: ys)
  case Nil thus ?case by clarsimp
next
  case Cons thus ?case by(cases ys)(simp_all, safe, simp)
qed

end

subsection \<open>Setup for list fusion\<close>

context ord begin

definition lexord_fusion :: "('a, 's1) generator \<Rightarrow> ('a, 's2) generator \<Rightarrow> 's1 \<Rightarrow> 's2 \<Rightarrow> bool"
where [code del]: "lexord_fusion g1 g2 s1 s2 = lexordp (list.unfoldr g1 s1) (list.unfoldr g2 s2)"

definition lexord_eq_fusion :: "('a, 's1) generator \<Rightarrow> ('a, 's2) generator \<Rightarrow> 's1 \<Rightarrow> 's2 \<Rightarrow> bool"
where [code del]: "lexord_eq_fusion g1 g2 s1 s2 = lexordp_eq (list.unfoldr g1 s1) (list.unfoldr g2 s2)"

lemma lexord_fusion_code:
  "lexord_fusion g1 g2 s1 s2 \<longleftrightarrow>
  (if list.has_next g1 s1 then
     if list.has_next g2 s2 then
       let (x, s1') = list.next g1 s1;
           (y, s2') = list.next g2 s2
       in x < y \<or> \<not> y < x \<and> lexord_fusion g1 g2 s1' s2'
     else False
   else list.has_next g2 s2)"
unfolding lexord_fusion_def
by(subst (1 2) list.unfoldr.simps)(auto split: prod.split_asm)

lemma lexord_eq_fusion_code:
  "lexord_eq_fusion g1 g2 s1 s2 \<longleftrightarrow>
  (list.has_next g1 s1 \<longrightarrow>
   list.has_next g2 s2 \<and>
   (let (x, s1') = list.next g1 s1;
        (y, s2') = list.next g2 s2
    in x < y \<or> \<not> y < x \<and> lexord_eq_fusion g1 g2 s1' s2'))"
unfolding lexord_eq_fusion_def
by(subst (1 2) list.unfoldr.simps)(auto split: prod.split_asm)

end

lemmas [code] =
  lexord_fusion_code ord.lexord_fusion_code
  lexord_eq_fusion_code ord.lexord_eq_fusion_code

lemmas [symmetric, code_unfold] =
  lexord_fusion_def ord.lexord_fusion_def
  lexord_eq_fusion_def ord.lexord_eq_fusion_def

end


theory Chapter15_1_Language
imports DeBruijnEnvironment
begin

datatype type =
  Nat
| Arrow type type
| Unit
| Prod type type
| Void
| Sum type type

datatype expr =
  Var var
| Zero
| Suc expr
| IsZ expr expr expr
| Lam type expr
| Appl expr expr
| Triv
| Pair expr expr
| ProjL expr
| ProjR expr
| Abort type expr
| Case expr expr expr
| InL type type expr
| InR type type expr
| Fix type expr

primrec insert :: "var => expr => expr"
where "insert n (Var v) = Var (incr n v)"
    | "insert n Zero = Zero"
    | "insert n (Suc e) = Suc (insert n e)"
    | "insert n (IsZ et e0 es) = IsZ (insert n et) (insert n e0) (insert (next n) es)"
    | "insert n (Lam t e) = Lam t (insert (next n) e)"
    | "insert n (Appl e1 e2) = Appl (insert n e1) (insert n e2)"
    | "insert n Triv = Triv"
    | "insert n (Pair e1 e2) = Pair (insert n e1) (insert n e2)"
    | "insert n (ProjL e) = ProjL (insert n e)"
    | "insert n (ProjR e) = ProjR (insert n e)"
    | "insert n (Abort t e) = Abort t (insert n e)"
    | "insert n (Case et el er) = Case (insert n et) (insert (next n) el) (insert (next n) er)"
    | "insert n (InL t1 t2 e) = InL t1 t2 (insert n e)"
    | "insert n (InR t1 t2 e) = InR t1 t2 (insert n e)"
    | "insert n (Fix t e) = Fix t (insert (next n) e)"

primrec subst :: "expr => var => expr => expr"
where "subst e' n (Var v) = (if v = n then e' else Var (subr n v))"
    | "subst e' n Zero = Zero"
    | "subst e' n (Suc e) = Suc (subst e' n e)"
    | "subst e' n (IsZ et e0 es) =
                      IsZ (subst e' n et) (subst e' n e0) (subst (insert first e') (next n) es)"
    | "subst e' n (Lam t e) = Lam t (subst (insert first e') (next n) e)"
    | "subst e' n (Appl e1 e2) = Appl (subst e' n e1) (subst e' n e2)"
    | "subst e' n Triv = Triv"
    | "subst e' n (Pair e1 e2) = Pair (subst e' n e1) (subst e' n e2)"
    | "subst e' n (ProjL e) = ProjL (subst e' n e)"
    | "subst e' n (ProjR e) = ProjR (subst e' n e)"
    | "subst e' n (Abort t e) = Abort t (subst e' n e)"
    | "subst e' n (Case et el er) =
                      Case (subst e' n et)
                           (subst (insert first e') (next n) el)
                           (subst (insert first e') (next n) er)"
    | "subst e' n (InL t1 t2 e) = InL t1 t2 (subst e' n e)"
    | "subst e' n (InR t1 t2 e) = InR t1 t2 (subst e' n e)"
    | "subst e' n (Fix t e) = Fix t (subst (insert first e') (next n) e)"

end


theory CValue
imports C
begin

domain CValue' = CFn (lazy "(C \<rightarrow> CValue') \<rightarrow> (C \<rightarrow> CValue')")
type_synonym CValue = "C \<rightarrow> CValue'"

fixrec CFn_project :: "CValue' \<rightarrow> CValue \<rightarrow> CValue"
 where "CFn_project\<cdot>(CFn\<cdot>f)\<cdot>v = f \<cdot> v"

abbreviation CFn_project_abbr (infix "\<down>CFn" 55)
  where "f \<down>CFn v \<equiv> CFn_project\<cdot>f\<cdot>v"

lemma CFn_project_strict[simp]:
  "\<bottom> \<down>CFn v = \<bottom>"
  by (fixrec_simp)

text {* HOLCF provides us @{const CValue'_take}@{text "::"}@{typeof CValue'_take};
we want a similar function for @{typ CValue}. *}

abbreviation CValue_take where "CValue_take n \<equiv> cfun_map\<cdot>ID\<cdot>(CValue'_take n)"

lemma CValue_chain_take: "chain CValue_take"
  by (auto intro: chainI cfun_belowI chainE[OF CValue'.chain_take] monofun_cfun_fun)

lemma CValue_reach: "(\<Squnion> n. CValue_take n\<cdot>x) = x"
  by (auto intro:  cfun_eqI simp add: contlub_cfun_fun[OF ch2ch_Rep_cfunL[OF CValue_chain_take]]  CValue'.reach)

end


(*  Title:      HOL/Analysis/Measurable.thy
    Author:     Johannes Hölzl <hoelzl@in.tum.de>
*)
theory Measurable
  imports
    Sigma_Algebra
    "~~/src/HOL/Library/Order_Continuity"
begin

subsection \<open>Measurability prover\<close>

lemma (in algebra) sets_Collect_finite_All:
  assumes "\<And>i. i \<in> S \<Longrightarrow> {x\<in>\<Omega>. P i x} \<in> M" "finite S"
  shows "{x\<in>\<Omega>. \<forall>i\<in>S. P i x} \<in> M"
proof -
  have "{x\<in>\<Omega>. \<forall>i\<in>S. P i x} = (if S = {} then \<Omega> else \<Inter>i\<in>S. {x\<in>\<Omega>. P i x})"
    by auto
  with assms show ?thesis by (auto intro!: sets_Collect_finite_All')
qed

abbreviation "pred M P \<equiv> P \<in> measurable M (count_space (UNIV::bool set))"

lemma pred_def: "pred M P \<longleftrightarrow> {x\<in>space M. P x} \<in> sets M"
proof
  assume "pred M P"
  then have "P -` {True} \<inter> space M \<in> sets M"
    by (auto simp: measurable_count_space_eq2)
  also have "P -` {True} \<inter> space M = {x\<in>space M. P x}" by auto
  finally show "{x\<in>space M. P x} \<in> sets M" .
next
  assume P: "{x\<in>space M. P x} \<in> sets M"
  moreover
  { fix X
    have "X \<in> Pow (UNIV :: bool set)" by simp
    then have "P -` X \<inter> space M = {x\<in>space M. ((X = {True} \<longrightarrow> P x) \<and> (X = {False} \<longrightarrow> \<not> P x) \<and> X \<noteq> {})}"
      unfolding UNIV_bool Pow_insert Pow_empty by auto
    then have "P -` X \<inter> space M \<in> sets M"
      by (auto intro!: sets.sets_Collect_neg sets.sets_Collect_imp sets.sets_Collect_conj sets.sets_Collect_const P) }
  then show "pred M P"
    by (auto simp: measurable_def)
qed

lemma pred_sets1: "{x\<in>space M. P x} \<in> sets M \<Longrightarrow> f \<in> measurable N M \<Longrightarrow> pred N (\<lambda>x. P (f x))"
  by (rule measurable_compose[where f=f and N=M]) (auto simp: pred_def)

lemma pred_sets2: "A \<in> sets N \<Longrightarrow> f \<in> measurable M N \<Longrightarrow> pred M (\<lambda>x. f x \<in> A)"
  by (rule measurable_compose[where f=f and N=N]) (auto simp: pred_def Int_def[symmetric])

ML_file "measurable.ML"

attribute_setup measurable = \<open>
  Scan.lift (
    (Args.add >> K true || Args.del >> K false || Scan.succeed true) --
    Scan.optional (Args.parens (
      Scan.optional (Args.$$$ "raw" >> K true) false --
      Scan.optional (Args.$$$ "generic" >> K Measurable.Generic) Measurable.Concrete))
    (false, Measurable.Concrete) >>
    Measurable.measurable_thm_attr)
\<close> "declaration of measurability theorems"

attribute_setup measurable_dest = Measurable.dest_thm_attr
  "add dest rule to measurability prover"

attribute_setup measurable_cong = Measurable.cong_thm_attr
  "add congurence rules to measurability prover"

method_setup measurable = \<open> Scan.lift (Scan.succeed (METHOD o Measurable.measurable_tac)) \<close>
  "measurability prover"

simproc_setup measurable ("A \<in> sets M" | "f \<in> measurable M N") = \<open>K Measurable.simproc\<close>

setup \<open>
  Global_Theory.add_thms_dynamic (@{binding measurable}, Measurable.get_all)
\<close>

declare
  pred_sets1[measurable_dest]
  pred_sets2[measurable_dest]
  sets.sets_into_space[measurable_dest]

declare
  sets.top[measurable]
  sets.empty_sets[measurable (raw)]
  sets.Un[measurable (raw)]
  sets.Diff[measurable (raw)]

declare
  measurable_count_space[measurable (raw)]
  measurable_ident[measurable (raw)]
  measurable_id[measurable (raw)]
  measurable_const[measurable (raw)]
  measurable_If[measurable (raw)]
  measurable_comp[measurable (raw)]
  measurable_sets[measurable (raw)]

declare measurable_cong_sets[measurable_cong]
declare sets_restrict_space_cong[measurable_cong]
declare sets_restrict_UNIV[measurable_cong]

lemma predE[measurable (raw)]:
  "pred M P \<Longrightarrow> {x\<in>space M. P x} \<in> sets M"
  unfolding pred_def .

lemma pred_intros_imp'[measurable (raw)]:
  "(K \<Longrightarrow> pred M (\<lambda>x. P x)) \<Longrightarrow> pred M (\<lambda>x. K \<longrightarrow> P x)"
  by (cases K) auto

lemma pred_intros_conj1'[measurable (raw)]:
  "(K \<Longrightarrow> pred M (\<lambda>x. P x)) \<Longrightarrow> pred M (\<lambda>x. K \<and> P x)"
  by (cases K) auto

lemma pred_intros_conj2'[measurable (raw)]:
  "(K \<Longrightarrow> pred M (\<lambda>x. P x)) \<Longrightarrow> pred M (\<lambda>x. P x \<and> K)"
  by (cases K) auto

lemma pred_intros_disj1'[measurable (raw)]:
  "(\<not> K \<Longrightarrow> pred M (\<lambda>x. P x)) \<Longrightarrow> pred M (\<lambda>x. K \<or> P x)"
  by (cases K) auto

lemma pred_intros_disj2'[measurable (raw)]:
  "(\<not> K \<Longrightarrow> pred M (\<lambda>x. P x)) \<Longrightarrow> pred M (\<lambda>x. P x \<or> K)"
  by (cases K) auto

lemma pred_intros_logic[measurable (raw)]:
  "pred M (\<lambda>x. x \<in> space M)"
  "pred M (\<lambda>x. P x) \<Longrightarrow> pred M (\<lambda>x. \<not> P x)"
  "pred M (\<lambda>x. Q x) \<Longrightarrow> pred M (\<lambda>x. P x) \<Longrightarrow> pred M (\<lambda>x. Q x \<and> P x)"
  "pred M (\<lambda>x. Q x) \<Longrightarrow> pred M (\<lambda>x. P x) \<Longrightarrow> pred M (\<lambda>x. Q x \<longrightarrow> P x)"
  "pred M (\<lambda>x. Q x) \<Longrightarrow> pred M (\<lambda>x. P x) \<Longrightarrow> pred M (\<lambda>x. Q x \<or> P x)"
  "pred M (\<lambda>x. Q x) \<Longrightarrow> pred M (\<lambda>x. P x) \<Longrightarrow> pred M (\<lambda>x. Q x = P x)"
  "pred M (\<lambda>x. f x \<in> UNIV)"
  "pred M (\<lambda>x. f x \<in> {})"
  "pred M (\<lambda>x. P' (f x) x) \<Longrightarrow> pred M (\<lambda>x. f x \<in> {y. P' y x})"
  "pred M (\<lambda>x. f x \<in> (B x)) \<Longrightarrow> pred M (\<lambda>x. f x \<in> - (B x))"
  "pred M (\<lambda>x. f x \<in> (A x)) \<Longrightarrow> pred M (\<lambda>x. f x \<in> (B x)) \<Longrightarrow> pred M (\<lambda>x. f x \<in> (A x) - (B x))"
  "pred M (\<lambda>x. f x \<in> (A x)) \<Longrightarrow> pred M (\<lambda>x. f x \<in> (B x)) \<Longrightarrow> pred M (\<lambda>x. f x \<in> (A x) \<inter> (B x))"
  "pred M (\<lambda>x. f x \<in> (A x)) \<Longrightarrow> pred M (\<lambda>x. f x \<in> (B x)) \<Longrightarrow> pred M (\<lambda>x. f x \<in> (A x) \<union> (B x))"
  "pred M (\<lambda>x. g x (f x) \<in> (X x)) \<Longrightarrow> pred M (\<lambda>x. f x \<in> (g x) -` (X x))"
  by (auto simp: iff_conv_conj_imp pred_def)

lemma pred_intros_countable[measurable (raw)]:
  fixes P :: "'a \<Rightarrow> 'i :: countable \<Rightarrow> bool"
  shows
    "(\<And>i. pred M (\<lambda>x. P x i)) \<Longrightarrow> pred M (\<lambda>x. \<forall>i. P x i)"
    "(\<And>i. pred M (\<lambda>x. P x i)) \<Longrightarrow> pred M (\<lambda>x. \<exists>i. P x i)"
  by (auto intro!: sets.sets_Collect_countable_All sets.sets_Collect_countable_Ex simp: pred_def)

lemma pred_intros_countable_bounded[measurable (raw)]:
  fixes X :: "'i :: countable set"
  shows
    "(\<And>i. i \<in> X \<Longrightarrow> pred M (\<lambda>x. x \<in> N x i)) \<Longrightarrow> pred M (\<lambda>x. x \<in> (\<Inter>i\<in>X. N x i))"
    "(\<And>i. i \<in> X \<Longrightarrow> pred M (\<lambda>x. x \<in> N x i)) \<Longrightarrow> pred M (\<lambda>x. x \<in> (\<Union>i\<in>X. N x i))"
    "(\<And>i. i \<in> X \<Longrightarrow> pred M (\<lambda>x. P x i)) \<Longrightarrow> pred M (\<lambda>x. \<forall>i\<in>X. P x i)"
    "(\<And>i. i \<in> X \<Longrightarrow> pred M (\<lambda>x. P x i)) \<Longrightarrow> pred M (\<lambda>x. \<exists>i\<in>X. P x i)"
  by simp_all (auto simp: Bex_def Ball_def)

lemma pred_intros_finite[measurable (raw)]:
  "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> pred M (\<lambda>x. x \<in> N x i)) \<Longrightarrow> pred M (\<lambda>x. x \<in> (\<Inter>i\<in>I. N x i))"
  "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> pred M (\<lambda>x. x \<in> N x i)) \<Longrightarrow> pred M (\<lambda>x. x \<in> (\<Union>i\<in>I. N x i))"
  "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> pred M (\<lambda>x. P x i)) \<Longrightarrow> pred M (\<lambda>x. \<forall>i\<in>I. P x i)"
  "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> pred M (\<lambda>x. P x i)) \<Longrightarrow> pred M (\<lambda>x. \<exists>i\<in>I. P x i)"
  by (auto intro!: sets.sets_Collect_finite_Ex sets.sets_Collect_finite_All simp: iff_conv_conj_imp pred_def)

lemma countable_Un_Int[measurable (raw)]:
  "(\<And>i :: 'i :: countable. i \<in> I \<Longrightarrow> N i \<in> sets M) \<Longrightarrow> (\<Union>i\<in>I. N i) \<in> sets M"
  "I \<noteq> {} \<Longrightarrow> (\<And>i :: 'i :: countable. i \<in> I \<Longrightarrow> N i \<in> sets M) \<Longrightarrow> (\<Inter>i\<in>I. N i) \<in> sets M"
  by auto

declare
  finite_UN[measurable (raw)]
  finite_INT[measurable (raw)]

lemma sets_Int_pred[measurable (raw)]:
  assumes space: "A \<inter> B \<subseteq> space M" and [measurable]: "pred M (\<lambda>x. x \<in> A)" "pred M (\<lambda>x. x \<in> B)"
  shows "A \<inter> B \<in> sets M"
proof -
  have "{x\<in>space M. x \<in> A \<inter> B} \<in> sets M" by auto
  also have "{x\<in>space M. x \<in> A \<inter> B} = A \<inter> B"
    using space by auto
  finally show ?thesis .
qed

lemma [measurable (raw generic)]:
  assumes f: "f \<in> measurable M N" and c: "c \<in> space N \<Longrightarrow> {c} \<in> sets N"
  shows pred_eq_const1: "pred M (\<lambda>x. f x = c)"
    and pred_eq_const2: "pred M (\<lambda>x. c = f x)"
proof -
  show "pred M (\<lambda>x. f x = c)"
  proof cases
    assume "c \<in> space N"
    with measurable_sets[OF f c] show ?thesis
      by (auto simp: Int_def conj_commute pred_def)
  next
    assume "c \<notin> space N"
    with f[THEN measurable_space] have "{x \<in> space M. f x = c} = {}" by auto
    then show ?thesis by (auto simp: pred_def cong: conj_cong)
  qed
  then show "pred M (\<lambda>x. c = f x)"
    by (simp add: eq_commute)
qed

lemma pred_count_space_const1[measurable (raw)]:
  "f \<in> measurable M (count_space UNIV) \<Longrightarrow> Measurable.pred M (\<lambda>x. f x = c)"
  by (intro pred_eq_const1[where N="count_space UNIV"]) (auto )

lemma pred_count_space_const2[measurable (raw)]:
  "f \<in> measurable M (count_space UNIV) \<Longrightarrow> Measurable.pred M (\<lambda>x. c = f x)"
  by (intro pred_eq_const2[where N="count_space UNIV"]) (auto )

lemma pred_le_const[measurable (raw generic)]:
  assumes f: "f \<in> measurable M N" and c: "{.. c} \<in> sets N" shows "pred M (\<lambda>x. f x \<le> c)"
  using measurable_sets[OF f c]
  by (auto simp: Int_def conj_commute eq_commute pred_def)

lemma pred_const_le[measurable (raw generic)]:
  assumes f: "f \<in> measurable M N" and c: "{c ..} \<in> sets N" shows "pred M (\<lambda>x. c \<le> f x)"
  using measurable_sets[OF f c]
  by (auto simp: Int_def conj_commute eq_commute pred_def)

lemma pred_less_const[measurable (raw generic)]:
  assumes f: "f \<in> measurable M N" and c: "{..< c} \<in> sets N" shows "pred M (\<lambda>x. f x < c)"
  using measurable_sets[OF f c]
  by (auto simp: Int_def conj_commute eq_commute pred_def)

lemma pred_const_less[measurable (raw generic)]:
  assumes f: "f \<in> measurable M N" and c: "{c <..} \<in> sets N" shows "pred M (\<lambda>x. c < f x)"
  using measurable_sets[OF f c]
  by (auto simp: Int_def conj_commute eq_commute pred_def)

declare
  sets.Int[measurable (raw)]

lemma pred_in_If[measurable (raw)]:
  "(P \<Longrightarrow> pred M (\<lambda>x. x \<in> A x)) \<Longrightarrow> (\<not> P \<Longrightarrow> pred M (\<lambda>x. x \<in> B x)) \<Longrightarrow>
    pred M (\<lambda>x. x \<in> (if P then A x else B x))"
  by auto

lemma sets_range[measurable_dest]:
  "A ` I \<subseteq> sets M \<Longrightarrow> i \<in> I \<Longrightarrow> A i \<in> sets M"
  by auto

lemma pred_sets_range[measurable_dest]:
  "A ` I \<subseteq> sets N \<Longrightarrow> i \<in> I \<Longrightarrow> f \<in> measurable M N \<Longrightarrow> pred M (\<lambda>x. f x \<in> A i)"
  using pred_sets2[OF sets_range] by auto

lemma sets_All[measurable_dest]:
  "\<forall>i. A i \<in> sets (M i) \<Longrightarrow> A i \<in> sets (M i)"
  by auto

lemma pred_sets_All[measurable_dest]:
  "\<forall>i. A i \<in> sets (N i) \<Longrightarrow> f \<in> measurable M (N i) \<Longrightarrow> pred M (\<lambda>x. f x \<in> A i)"
  using pred_sets2[OF sets_All, of A N f] by auto

lemma sets_Ball[measurable_dest]:
  "\<forall>i\<in>I. A i \<in> sets (M i) \<Longrightarrow> i\<in>I \<Longrightarrow> A i \<in> sets (M i)"
  by auto

lemma pred_sets_Ball[measurable_dest]:
  "\<forall>i\<in>I. A i \<in> sets (N i) \<Longrightarrow> i\<in>I \<Longrightarrow> f \<in> measurable M (N i) \<Longrightarrow> pred M (\<lambda>x. f x \<in> A i)"
  using pred_sets2[OF sets_Ball, of _ _ _ f] by auto

lemma measurable_finite[measurable (raw)]:
  fixes S :: "'a \<Rightarrow> nat set"
  assumes [measurable]: "\<And>i. {x\<in>space M. i \<in> S x} \<in> sets M"
  shows "pred M (\<lambda>x. finite (S x))"
  unfolding finite_nat_set_iff_bounded by (simp add: Ball_def)

lemma measurable_Least[measurable]:
  assumes [measurable]: "(\<And>i::nat. (\<lambda>x. P i x) \<in> measurable M (count_space UNIV))"
  shows "(\<lambda>x. LEAST i. P i x) \<in> measurable M (count_space UNIV)"
  unfolding measurable_def by (safe intro!: sets_Least) simp_all

lemma measurable_Max_nat[measurable (raw)]:
  fixes P :: "nat \<Rightarrow> 'a \<Rightarrow> bool"
  assumes [measurable]: "\<And>i. Measurable.pred M (P i)"
  shows "(\<lambda>x. Max {i. P i x}) \<in> measurable M (count_space UNIV)"
  unfolding measurable_count_space_eq2_countable
proof safe
  fix n

  { fix x assume "\<forall>i. \<exists>n\<ge>i. P n x"
    then have "infinite {i. P i x}"
      unfolding infinite_nat_iff_unbounded_le by auto
    then have "Max {i. P i x} = the None"
      by (rule Max.infinite) }
  note 1 = this

  { fix x i j assume "P i x" "\<forall>n\<ge>j. \<not> P n x"
    then have "finite {i. P i x}"
      by (auto simp: subset_eq not_le[symmetric] finite_nat_iff_bounded)
    with \<open>P i x\<close> have "P (Max {i. P i x}) x" "i \<le> Max {i. P i x}" "finite {i. P i x}"
      using Max_in[of "{i. P i x}"] by auto }
  note 2 = this

  have "(\<lambda>x. Max {i. P i x}) -` {n} \<inter> space M = {x\<in>space M. Max {i. P i x} = n}"
    by auto
  also have "\<dots> =
    {x\<in>space M. if (\<forall>i. \<exists>n\<ge>i. P n x) then the None = n else
      if (\<exists>i. P i x) then P n x \<and> (\<forall>i>n. \<not> P i x)
      else Max {} = n}"
    by (intro arg_cong[where f=Collect] ext conj_cong)
       (auto simp add: 1 2 not_le[symmetric] intro!: Max_eqI)
  also have "\<dots> \<in> sets M"
    by measurable
  finally show "(\<lambda>x. Max {i. P i x}) -` {n} \<inter> space M \<in> sets M" .
qed simp

lemma measurable_Min_nat[measurable (raw)]:
  fixes P :: "nat \<Rightarrow> 'a \<Rightarrow> bool"
  assumes [measurable]: "\<And>i. Measurable.pred M (P i)"
  shows "(\<lambda>x. Min {i. P i x}) \<in> measurable M (count_space UNIV)"
  unfolding measurable_count_space_eq2_countable
proof safe
  fix n

  { fix x assume "\<forall>i. \<exists>n\<ge>i. P n x"
    then have "infinite {i. P i x}"
      unfolding infinite_nat_iff_unbounded_le by auto
    then have "Min {i. P i x} = the None"
      by (rule Min.infinite) }
  note 1 = this

  { fix x i j assume "P i x" "\<forall>n\<ge>j. \<not> P n x"
    then have "finite {i. P i x}"
      by (auto simp: subset_eq not_le[symmetric] finite_nat_iff_bounded)
    with \<open>P i x\<close> have "P (Min {i. P i x}) x" "Min {i. P i x} \<le> i" "finite {i. P i x}"
      using Min_in[of "{i. P i x}"] by auto }
  note 2 = this

  have "(\<lambda>x. Min {i. P i x}) -` {n} \<inter> space M = {x\<in>space M. Min {i. P i x} = n}"
    by auto
  also have "\<dots> =
    {x\<in>space M. if (\<forall>i. \<exists>n\<ge>i. P n x) then the None = n else
      if (\<exists>i. P i x) then P n x \<and> (\<forall>i<n. \<not> P i x)
      else Min {} = n}"
    by (intro arg_cong[where f=Collect] ext conj_cong)
       (auto simp add: 1 2 not_le[symmetric] intro!: Min_eqI)
  also have "\<dots> \<in> sets M"
    by measurable
  finally show "(\<lambda>x. Min {i. P i x}) -` {n} \<inter> space M \<in> sets M" .
qed simp

lemma measurable_count_space_insert[measurable (raw)]:
  "s \<in> S \<Longrightarrow> A \<in> sets (count_space S) \<Longrightarrow> insert s A \<in> sets (count_space S)"
  by simp

lemma sets_UNIV [measurable (raw)]: "A \<in> sets (count_space UNIV)"
  by simp

lemma measurable_card[measurable]:
  fixes S :: "'a \<Rightarrow> nat set"
  assumes [measurable]: "\<And>i. {x\<in>space M. i \<in> S x} \<in> sets M"
  shows "(\<lambda>x. card (S x)) \<in> measurable M (count_space UNIV)"
  unfolding measurable_count_space_eq2_countable
proof safe
  fix n show "(\<lambda>x. card (S x)) -` {n} \<inter> space M \<in> sets M"
  proof (cases n)
    case 0
    then have "(\<lambda>x. card (S x)) -` {n} \<inter> space M = {x\<in>space M. infinite (S x) \<or> (\<forall>i. i \<notin> S x)}"
      by auto
    also have "\<dots> \<in> sets M"
      by measurable
    finally show ?thesis .
  next
    case (Suc i)
    then have "(\<lambda>x. card (S x)) -` {n} \<inter> space M =
      (\<Union>F\<in>{A\<in>{A. finite A}. card A = n}. {x\<in>space M. (\<forall>i. i \<in> S x \<longleftrightarrow> i \<in> F)})"
      unfolding set_eq_iff[symmetric] Collect_bex_eq[symmetric] by (auto intro: card_ge_0_finite)
    also have "\<dots> \<in> sets M"
      by (intro sets.countable_UN' countable_Collect countable_Collect_finite) auto
    finally show ?thesis .
  qed
qed rule

lemma measurable_pred_countable[measurable (raw)]:
  assumes "countable X"
  shows
    "(\<And>i. i \<in> X \<Longrightarrow> Measurable.pred M (\<lambda>x. P x i)) \<Longrightarrow> Measurable.pred M (\<lambda>x. \<forall>i\<in>X. P x i)"
    "(\<And>i. i \<in> X \<Longrightarrow> Measurable.pred M (\<lambda>x. P x i)) \<Longrightarrow> Measurable.pred M (\<lambda>x. \<exists>i\<in>X. P x i)"
  unfolding pred_def
  by (auto intro!: sets.sets_Collect_countable_All' sets.sets_Collect_countable_Ex' assms)

subsection \<open>Measurability for (co)inductive predicates\<close>

lemma measurable_bot[measurable]: "bot \<in> measurable M (count_space UNIV)"
  by (simp add: bot_fun_def)

lemma measurable_top[measurable]: "top \<in> measurable M (count_space UNIV)"
  by (simp add: top_fun_def)

lemma measurable_SUP[measurable]:
  fixes F :: "'i \<Rightarrow> 'a \<Rightarrow> 'b::{complete_lattice, countable}"
  assumes [simp]: "countable I"
  assumes [measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> measurable M (count_space UNIV)"
  shows "(\<lambda>x. SUP i:I. F i x) \<in> measurable M (count_space UNIV)"
  unfolding measurable_count_space_eq2_countable
proof (safe intro!: UNIV_I)
  fix a
  have "(\<lambda>x. SUP i:I. F i x) -` {a} \<inter> space M =
    {x\<in>space M. (\<forall>i\<in>I. F i x \<le> a) \<and> (\<forall>b. (\<forall>i\<in>I. F i x \<le> b) \<longrightarrow> a \<le> b)}"
    unfolding SUP_le_iff[symmetric] by auto
  also have "\<dots> \<in> sets M"
    by measurable
  finally show "(\<lambda>x. SUP i:I. F i x) -` {a} \<inter> space M \<in> sets M" .
qed

lemma measurable_INF[measurable]:
  fixes F :: "'i \<Rightarrow> 'a \<Rightarrow> 'b::{complete_lattice, countable}"
  assumes [simp]: "countable I"
  assumes [measurable]: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> measurable M (count_space UNIV)"
  shows "(\<lambda>x. INF i:I. F i x) \<in> measurable M (count_space UNIV)"
  unfolding measurable_count_space_eq2_countable
proof (safe intro!: UNIV_I)
  fix a
  have "(\<lambda>x. INF i:I. F i x) -` {a} \<inter> space M =
    {x\<in>space M. (\<forall>i\<in>I. a \<le> F i x) \<and> (\<forall>b. (\<forall>i\<in>I. b \<le> F i x) \<longrightarrow> b \<le> a)}"
    unfolding le_INF_iff[symmetric] by auto
  also have "\<dots> \<in> sets M"
    by measurable
  finally show "(\<lambda>x. INF i:I. F i x) -` {a} \<inter> space M \<in> sets M" .
qed

lemma measurable_lfp_coinduct[consumes 1, case_names continuity step]:
  fixes F :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b::{complete_lattice, countable})"
  assumes "P M"
  assumes F: "sup_continuous F"
  assumes *: "\<And>M A. P M \<Longrightarrow> (\<And>N. P N \<Longrightarrow> A \<in> measurable N (count_space UNIV)) \<Longrightarrow> F A \<in> measurable M (count_space UNIV)"
  shows "lfp F \<in> measurable M (count_space UNIV)"
proof -
  { fix i from \<open>P M\<close> have "((F ^^ i) bot) \<in> measurable M (count_space UNIV)"
      by (induct i arbitrary: M) (auto intro!: *) }
  then have "(\<lambda>x. SUP i. (F ^^ i) bot x) \<in> measurable M (count_space UNIV)"
    by measurable
  also have "(\<lambda>x. SUP i. (F ^^ i) bot x) = lfp F"
    by (subst sup_continuous_lfp) (auto intro: F)
  finally show ?thesis .
qed

lemma measurable_lfp:
  fixes F :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b::{complete_lattice, countable})"
  assumes F: "sup_continuous F"
  assumes *: "\<And>A. A \<in> measurable M (count_space UNIV) \<Longrightarrow> F A \<in> measurable M (count_space UNIV)"
  shows "lfp F \<in> measurable M (count_space UNIV)"
  by (coinduction rule: measurable_lfp_coinduct[OF _ F]) (blast intro: *)

lemma measurable_gfp_coinduct[consumes 1, case_names continuity step]:
  fixes F :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b::{complete_lattice, countable})"
  assumes "P M"
  assumes F: "inf_continuous F"
  assumes *: "\<And>M A. P M \<Longrightarrow> (\<And>N. P N \<Longrightarrow> A \<in> measurable N (count_space UNIV)) \<Longrightarrow> F A \<in> measurable M (count_space UNIV)"
  shows "gfp F \<in> measurable M (count_space UNIV)"
proof -
  { fix i from \<open>P M\<close> have "((F ^^ i) top) \<in> measurable M (count_space UNIV)"
      by (induct i arbitrary: M) (auto intro!: *) }
  then have "(\<lambda>x. INF i. (F ^^ i) top x) \<in> measurable M (count_space UNIV)"
    by measurable
  also have "(\<lambda>x. INF i. (F ^^ i) top x) = gfp F"
    by (subst inf_continuous_gfp) (auto intro: F)
  finally show ?thesis .
qed

lemma measurable_gfp:
  fixes F :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b::{complete_lattice, countable})"
  assumes F: "inf_continuous F"
  assumes *: "\<And>A. A \<in> measurable M (count_space UNIV) \<Longrightarrow> F A \<in> measurable M (count_space UNIV)"
  shows "gfp F \<in> measurable M (count_space UNIV)"
  by (coinduction rule: measurable_gfp_coinduct[OF _ F]) (blast intro: *)

lemma measurable_lfp2_coinduct[consumes 1, case_names continuity step]:
  fixes F :: "('a \<Rightarrow> 'c \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'c \<Rightarrow> 'b::{complete_lattice, countable})"
  assumes "P M s"
  assumes F: "sup_continuous F"
  assumes *: "\<And>M A s. P M s \<Longrightarrow> (\<And>N t. P N t \<Longrightarrow> A t \<in> measurable N (count_space UNIV)) \<Longrightarrow> F A s \<in> measurable M (count_space UNIV)"
  shows "lfp F s \<in> measurable M (count_space UNIV)"
proof -
  { fix i from \<open>P M s\<close> have "(\<lambda>x. (F ^^ i) bot s x) \<in> measurable M (count_space UNIV)"
      by (induct i arbitrary: M s) (auto intro!: *) }
  then have "(\<lambda>x. SUP i. (F ^^ i) bot s x) \<in> measurable M (count_space UNIV)"
    by measurable
  also have "(\<lambda>x. SUP i. (F ^^ i) bot s x) = lfp F s"
    by (subst sup_continuous_lfp) (auto simp: F)
  finally show ?thesis .
qed

lemma measurable_gfp2_coinduct[consumes 1, case_names continuity step]:
  fixes F :: "('a \<Rightarrow> 'c \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'c \<Rightarrow> 'b::{complete_lattice, countable})"
  assumes "P M s"
  assumes F: "inf_continuous F"
  assumes *: "\<And>M A s. P M s \<Longrightarrow> (\<And>N t. P N t \<Longrightarrow> A t \<in> measurable N (count_space UNIV)) \<Longrightarrow> F A s \<in> measurable M (count_space UNIV)"
  shows "gfp F s \<in> measurable M (count_space UNIV)"
proof -
  { fix i from \<open>P M s\<close> have "(\<lambda>x. (F ^^ i) top s x) \<in> measurable M (count_space UNIV)"
      by (induct i arbitrary: M s) (auto intro!: *) }
  then have "(\<lambda>x. INF i. (F ^^ i) top s x) \<in> measurable M (count_space UNIV)"
    by measurable
  also have "(\<lambda>x. INF i. (F ^^ i) top s x) = gfp F s"
    by (subst inf_continuous_gfp) (auto simp: F)
  finally show ?thesis .
qed

lemma measurable_enat_coinduct:
  fixes f :: "'a \<Rightarrow> enat"
  assumes "R f"
  assumes *: "\<And>f. R f \<Longrightarrow> \<exists>g h i P. R g \<and> f = (\<lambda>x. if P x then h x else eSuc (g (i x))) \<and>
    Measurable.pred M P \<and>
    i \<in> measurable M M \<and>
    h \<in> measurable M (count_space UNIV)"
  shows "f \<in> measurable M (count_space UNIV)"
proof (simp add: measurable_count_space_eq2_countable, rule )
  fix a :: enat
  have "f -` {a} \<inter> space M = {x\<in>space M. f x = a}"
    by auto
  { fix i :: nat
    from \<open>R f\<close> have "Measurable.pred M (\<lambda>x. f x = enat i)"
    proof (induction i arbitrary: f)
      case 0
      from *[OF this] obtain g h i P
        where f: "f = (\<lambda>x. if P x then h x else eSuc (g (i x)))" and
          [measurable]: "Measurable.pred M P" "i \<in> measurable M M" "h \<in> measurable M (count_space UNIV)"
        by auto
      have "Measurable.pred M (\<lambda>x. P x \<and> h x = 0)"
        by measurable
      also have "(\<lambda>x. P x \<and> h x = 0) = (\<lambda>x. f x = enat 0)"
        by (auto simp: f zero_enat_def[symmetric])
      finally show ?case .
    next
      case (Suc n)
      from *[OF Suc.prems] obtain g h i P
        where f: "f = (\<lambda>x. if P x then h x else eSuc (g (i x)))" and "R g" and
          M[measurable]: "Measurable.pred M P" "i \<in> measurable M M" "h \<in> measurable M (count_space UNIV)"
        by auto
      have "(\<lambda>x. f x = enat (Suc n)) =
        (\<lambda>x. (P x \<longrightarrow> h x = enat (Suc n)) \<and> (\<not> P x \<longrightarrow> g (i x) = enat n))"
        by (auto simp: f zero_enat_def[symmetric] eSuc_enat[symmetric])
      also have "Measurable.pred M \<dots>"
        by (intro pred_intros_logic measurable_compose[OF M(2)] Suc \<open>R g\<close>) measurable
      finally show ?case .
    qed
    then have "f -` {enat i} \<inter> space M \<in> sets M"
      by (simp add: pred_def Int_def conj_commute) }
  note fin = this
  show "f -` {a} \<inter> space M \<in> sets M"
  proof (cases a)
    case infinity
    then have "f -` {a} \<inter> space M = space M - (\<Union>n. f -` {enat n} \<inter> space M)"
      by auto
    also have "\<dots> \<in> sets M"
      by (intro sets.Diff sets.top sets.Un sets.countable_UN) (auto intro!: fin)
    finally show ?thesis .
  qed (simp add: fin)
qed

lemma measurable_THE:
  fixes P :: "'a \<Rightarrow> 'b \<Rightarrow> bool"
  assumes [measurable]: "\<And>i. Measurable.pred M (P i)"
  assumes I[simp]: "countable I" "\<And>i x. x \<in> space M \<Longrightarrow> P i x \<Longrightarrow> i \<in> I"
  assumes unique: "\<And>x i j. x \<in> space M \<Longrightarrow> P i x \<Longrightarrow> P j x \<Longrightarrow> i = j"
  shows "(\<lambda>x. THE i. P i x) \<in> measurable M (count_space UNIV)"
  unfolding measurable_def
proof safe
  fix X
  define f where "f x = (THE i. P i x)" for x
  define undef where "undef = (THE i::'a. False)"
  { fix i x assume "x \<in> space M" "P i x" then have "f x = i"
      unfolding f_def using unique by auto }
  note f_eq = this
  { fix x assume "x \<in> space M" "\<forall>i\<in>I. \<not> P i x"
    then have "\<And>i. \<not> P i x"
      using I(2)[of x] by auto
    then have "f x = undef"
      by (auto simp: undef_def f_def) }
  then have "f -` X \<inter> space M = (\<Union>i\<in>I \<inter> X. {x\<in>space M. P i x}) \<union>
     (if undef \<in> X then space M - (\<Union>i\<in>I. {x\<in>space M. P i x}) else {})"
    by (auto dest: f_eq)
  also have "\<dots> \<in> sets M"
    by (auto intro!: sets.Diff sets.countable_UN')
  finally show "f -` X \<inter> space M \<in> sets M" .
qed simp

lemma measurable_Ex1[measurable (raw)]:
  assumes [simp]: "countable I" and [measurable]: "\<And>i. i \<in> I \<Longrightarrow> Measurable.pred M (P i)"
  shows "Measurable.pred M (\<lambda>x. \<exists>!i\<in>I. P i x)"
  unfolding bex1_def by measurable

lemma measurable_Sup_nat[measurable (raw)]:
  fixes F :: "'a \<Rightarrow> nat set"
  assumes [measurable]: "\<And>i. Measurable.pred M (\<lambda>x. i \<in> F x)"
  shows "(\<lambda>x. Sup (F x)) \<in> M \<rightarrow>\<^sub>M count_space UNIV"
proof (clarsimp simp add: measurable_count_space_eq2_countable)
  fix a
  have F_empty_iff: "F x = {} \<longleftrightarrow> (\<forall>i. i \<notin> F x)" for x
    by auto
  have "Measurable.pred M (\<lambda>x. if finite (F x) then if F x = {} then a = Max {}
    else a \<in> F x \<and> (\<forall>j. j \<in> F x \<longrightarrow> j \<le> a) else a = the None)"
    unfolding finite_nat_set_iff_bounded Ball_def F_empty_iff by measurable
  moreover have "(\<lambda>x. Sup (F x)) -` {a} \<inter> space M =
    {x\<in>space M. if finite (F x) then if F x = {} then a = Max {}
      else a \<in> F x \<and> (\<forall>j. j \<in> F x \<longrightarrow> j \<le> a) else a = the None}"
    by (intro set_eqI)
       (auto simp: Sup_nat_def Max.infinite intro!: Max_in Max_eqI)
  ultimately show "(\<lambda>x. Sup (F x)) -` {a} \<inter> space M \<in> sets M"
    by auto
qed

lemma measurable_if_split[measurable (raw)]:
  "(c \<Longrightarrow> Measurable.pred M f) \<Longrightarrow> (\<not> c \<Longrightarrow> Measurable.pred M g) \<Longrightarrow>
   Measurable.pred M (if c then f else g)"
  by simp

lemma pred_restrict_space:
  assumes "S \<in> sets M"
  shows "Measurable.pred (restrict_space M S) P \<longleftrightarrow> Measurable.pred M (\<lambda>x. x \<in> S \<and> P x)"
  unfolding pred_def sets_Collect_restrict_space_iff[OF assms] ..

lemma measurable_predpow[measurable]:
  assumes "Measurable.pred M T"
  assumes "\<And>Q. Measurable.pred M Q \<Longrightarrow> Measurable.pred M (R Q)"
  shows "Measurable.pred M ((R ^^ n) T)"
  by (induct n) (auto intro: assms)

lemma measurable_compose_countable_restrict:
  assumes P: "countable {i. P i}"
    and f: "f \<in> M \<rightarrow>\<^sub>M count_space UNIV"
    and Q: "\<And>i. P i \<Longrightarrow> pred M (Q i)"
  shows "pred M (\<lambda>x. P (f x) \<and> Q (f x) x)"
proof -
  have P_f: "{x \<in> space M. P (f x)} \<in> sets M"
    unfolding pred_def[symmetric] by (rule measurable_compose[OF f]) simp
  have "pred (restrict_space M {x\<in>space M. P (f x)}) (\<lambda>x. Q (f x) x)"
  proof (rule measurable_compose_countable'[where g=f, OF _ _ P])
    show "f \<in> restrict_space M {x\<in>space M. P (f x)} \<rightarrow>\<^sub>M count_space {i. P i}"
      by (rule measurable_count_space_extend[OF subset_UNIV])
         (auto simp: space_restrict_space intro!: measurable_restrict_space1 f)
  qed (auto intro!: measurable_restrict_space1 Q)
  then show ?thesis
    unfolding pred_restrict_space[OF P_f] by (simp cong: measurable_cong)
qed

lemma measurable_limsup [measurable (raw)]:
  assumes [measurable]: "\<And>n. A n \<in> sets M"
  shows "limsup A \<in> sets M"
by (subst limsup_INF_SUP, auto)

lemma measurable_liminf [measurable (raw)]:
  assumes [measurable]: "\<And>n. A n \<in> sets M"
  shows "liminf A \<in> sets M"
by (subst liminf_SUP_INF, auto)

lemma measurable_case_enat[measurable (raw)]:
  assumes f: "f \<in> M \<rightarrow>\<^sub>M count_space UNIV" and g: "\<And>i. g i \<in> M \<rightarrow>\<^sub>M N" and h: "h \<in> M \<rightarrow>\<^sub>M N"
  shows "(\<lambda>x. case f x of enat i \<Rightarrow> g i x | \<infinity> \<Rightarrow> h x) \<in> M \<rightarrow>\<^sub>M N"
  apply (rule measurable_compose_countable[OF _ f])
  subgoal for i
    by (cases i) (auto intro: g h)
  done

hide_const (open) pred

end