theory ZFCmodel
imports Parity
begin

definition elem :: "nat \<Rightarrow> nat \<Rightarrow> bool"
 where "elem k n \<equiv> odd (n div 2^k)"

lemma elemZero:
 "elem 0 n = odd n"
by (metis div_by_1 elem_def power_0)

lemma elemSuc:
 "elem (Suc k) n = elem k (n div 2)"
apply (auto simp: elem_def)
apply (metis Divides.div_mult2_eq)
by (metis Divides.div_mult2_eq)

declare elemZero elemSuc [simp]

lemma elem2k:
 "elem k (2 * n) = (k \<noteq> 0 \<and> elem (k - 1) n)"
apply (cases "k")
apply (metis Suc_eq_plus1 div_by_1 elem_def even_Suc even_product odd_1_nat one_add_one power_0)
by auto

lemma elemSuc2k1:
 "elem (Suc k) (2 * n + 1) = elem k n"
by (metis add_self_div_2 elemSuc lemma_even_div2 mult_2 odd_add)

lemma elem2k1:
 "elem k (2 * n + 1) = (k = 0 \<or> elem (k - 1) n)"
apply (cases k)
apply (metis (poly_guards_query) Suc_eq_plus1 div_by_1 elem_def even_Suc even_sum_nat mult_2 power_0)
apply simp_all
by (metis Suc_eq_plus1 add_self_div_2 even_sum_nat lemma_even_div2 mult_2)

lemma nat_div1:
 "(n::nat) = k * (n div k) + n mod k"
by simp

lemma nat_div2:
  "2 \<le> k \<Longrightarrow> 1 \<le> n \<Longrightarrow> n div k < (n::nat)"
by simp

lemma nat_div3:
  "2 \<le> k \<Longrightarrow> n mod k < (k::nat)"
by simp

lemma nat_div4:
  "1 \<le> j \<Longrightarrow>
   \<forall>m<j. P m \<Longrightarrow>
   2 \<le> k \<Longrightarrow>
   (\<And>n m. m < k \<Longrightarrow> P n \<Longrightarrow> P (k * n + m)) \<Longrightarrow>
   P (j::nat)"
by (metis nat_div1 nat_div2 nat_div3)

lemma ind_k:
 "2 \<le> k \<Longrightarrow> P 0 \<Longrightarrow> (\<And>n m. m < k \<Longrightarrow> P n \<Longrightarrow> P (k * n + m)) \<Longrightarrow> P (x::nat)"
apply (induct "x" rule: nat_less_induct)
apply auto
apply (case_tac "n")
apply auto
apply (induct_tac rule: nat_div4)
by auto

lemma ind_k2:
 "P 0 \<Longrightarrow> (\<And>n. P n \<Longrightarrow> P (2 * n)) \<Longrightarrow> (\<And>n. P n \<Longrightarrow> P (2 * n + 1)) \<Longrightarrow> P (x::nat)"
apply (induct "x" rule: ind_k[of "2"])
apply clarify
apply simp
apply (case_tac "m")
by auto

lemma null:
  "\<not>elem k 0"
by (metis Divides.div_mult2_eq elem_def even_zero nat_mult_div_cancel_disj)

lemma null_ext:
  "(!k. \<not>elem k n) \<Longrightarrow> n = 0"
apply (induction "n" rule: ind_k2)
apply simp_all
apply (subst (asm) elem2k)
apply (metis Suc_eq_plus1 diff_Suc_Suc diff_zero monoid_add_class.add.left_neutral old.nat.distinct(2))
by (metis Suc_eq_plus1 elem2k1)

lemma div2even:
  "even m \<Longrightarrow> m = 2 * (m div 2)"
by (metis dvd_mult_div_cancel even_iff_2_dvd)

lemma div2odd:
  "odd m \<Longrightarrow> m = 2 * (m div 2) + 1"
by (metis add.commute even_def mult.commute not_mod_2_eq_0_eq_1 semiring_div_class.mod_div_equality')

lemma ext_1:
 "\<forall>m. (\<forall>k. elem k m = elem k n) \<longrightarrow> m = n"
apply (induct_tac "n" rule: ind_k2)
apply simp_all
apply (metis null null_ext)
apply auto
apply (subst div2even)
apply auto
apply (metis div_by_1 elem_def even_sum_nat mult.commute mult_2_right power_0)
apply (insert elemSuc)
apply (subst (asm) elem2k)
apply (metis diff_Suc_1 old.nat.distinct(2))
apply auto
apply (subst div2odd)
apply auto
apply (metis Suc_eq_plus1 elem2k elem2k1 even_mult_two_ex)
apply (insert elem2k1 elemSuc)
apply auto
by (metis Suc_eq_plus1 diff_Suc_1 elemSuc monoid_add_class.add.left_neutral old.nat.distinct(2))

lemma elem_ext:
 "(\<forall>k. elem k m = elem k n) \<Longrightarrow> m = n"
by (metis (poly_guards_query) ext_1)

lemma ZFC_extensionality:
 "\<forall>m n. (\<forall>k. elem k m = elem k n) \<longrightarrow> m = n"
by (metis (poly_guards_query) elem_ext)

lemma ZFC_null_set:
  "\<exists>x. \<not> (\<exists>k. elem k x)"
by (metis null)

definition pair :: "nat \<Rightarrow> nat \<Rightarrow> nat"
 where "pair m n \<equiv> if m = n then 2^m else 2^m + 2^n"

lemma pair_sym:
 "pair m n = pair n m"
by (metis add.commute pair_def)

lemma nat_diff:
 "EX k::nat. m = n + k \<or> n = m + k"
by presburger

lemma nat_ne_diff:
 "m \<noteq> n \<Longrightarrow> (EX k::nat. m = n + Suc k) \<or> (EX k::nat. n = m + Suc k)"
by presburger

lemma pow_div:
 "0 < (k::nat) \<Longrightarrow> (2::nat) ^ (m + k) div 2 ^ m = 2 ^ k"
by (metis Suc_eq_plus1 add.commute div_mult_self2_is_id nat_zero_less_power_iff neq0_conv one_add_one power_add zero_less_Suc)

lemma elem_pair_left:
 "elem m (pair m n)"
apply (insert nat_diff[of "m" "n"])
apply (auto simp add: elem_def pair_def)
by (metis Suc_eq_plus1 div_mult_self2_is_id even_numeral_nat even_power_nat mult.commute nat_zero_less_power_iff neq0_conv one_add_one power_add zero_less_Suc)

lemma elem_pair_right:
 "elem n (pair m n)"
by (metis elem_pair_left pair_sym)

lemma pow_div_0:
 "0 < (k::nat) \<Longrightarrow> (2::nat) ^ m div 2 ^ (m + k) = 0"
by simp

lemma elem_pair_1:
 "elem k (2 ^ n) \<Longrightarrow> k = n"
apply (auto simp add: elem_def)
apply (rule ccontr)
apply (drule nat_ne_diff)
apply (erule disjE)
apply (erule exE)
apply clarify
apply (subst (asm) pow_div_0)
apply simp
apply simp
apply clarify
apply (subst (asm) pow_div)
by auto

lemma elem_plus:
  "elem k s = elem (k + n) (s * 2 ^ n)"
apply (induction "n")
by simp_all

lemma nat_le_diff:
 "m \<le> n \<Longrightarrow> EX k::nat. n = k + m"
by presburger

lemma elem_minus:
  "n \<le> k \<Longrightarrow> elem (k - n) s = elem k (s * 2 ^ n)"
apply (drule nat_le_diff)
apply clarify
apply (subst elem_plus[symmetric])
by simp

lemma elem_size:
 "m < 2 ^ k \<Longrightarrow> \<not> elem k m"
by (simp add: elem_def)

lemma pow_succ:
 "2 * (n::nat) + 2 ^ Suc m = 2 * (n + 2 ^ m)"
by simp

lemma suc_div:
  "Suc (2 * n) div 2 = n"
by simp

lemma elem_plus_pow:
 "\<And>n k. k < n \<Longrightarrow> elem k (m + 2 ^ n) = elem k m"
apply (induction "m" rule: ind_k2)
apply simp_all
apply (metis elem_pair_1 less_not_refl null)
apply (case_tac "k")
apply simp
apply (metis elem2k even_mult_two_ex even_numeral_nat even_power_nat even_sum_nat)
apply (case_tac "na")
apply simp
apply clarify
apply (subst pow_succ)
apply (subst elem2k)+
apply simp
apply (case_tac "na")
apply simp
apply simp
apply (case_tac "k")
apply (simp add: elemZero)
apply clarify
apply (subst elemSuc)+
apply (subst suc_div)
by (metis comm_semiring_1_class.normalizing_semiring_rules(27) pow_succ suc_div)

lemma elem_plus_n_pow:
 "\<And>m. k < n \<Longrightarrow> elem k (m + s * 2 ^ n) = elem k m"
apply (induction "s")
apply simp_all
apply (subst add.assoc[symmetric])
by (metis elem_plus_pow)

lemma pow_less:
 "n \<le> (k::nat) \<Longrightarrow> (m::nat) < 2 ^ n \<Longrightarrow> m < 2 ^ k"
proof -
  assume a1: "m < 2 ^ n"
  assume "n \<le> k"
  hence "\<not> (2\<Colon>nat) ^ k < 2 ^ n" by (metis (no_types) nat_power_less_imp_less not_less zero_less_numeral)
  thus "m < 2 ^ k" using a1 by linarith
qed

lemma ind_div2:
 "P 0 \<Longrightarrow> (\<And>n. P (n div 2) \<Longrightarrow> P n) \<Longrightarrow> P (x::nat)"
apply (induct_tac "x" rule: nat_less_induct)
by (metis Suc_eq_plus1 Suc_leI lessI monoid_add_class.add.left_neutral nat_div2 neq0_conv one_add_one)

lemma elem_pair_3x:
  "((m::nat) + s * (2 * 2 ^ n)) div 2 = m div 2 + s * 2 ^ n"
by simp

lemma elem_pair_2x:
 "\<And>m. m < 2 ^ n \<Longrightarrow> elem (k + n) (m + s * 2 ^ n) = elem k s"
apply (induct "n")
apply simp
apply simp_all
apply (case_tac "m div 2 < 2 ^ n")
apply (metis elem_pair_3x)
by simp

lemma elem_pair_4x:
 "m < 2 ^ n \<Longrightarrow> elem k (m + s * 2 ^ n) \<Longrightarrow> elem k m \<or> elem (k - n) s"
apply (case_tac "k < n")
apply (metis elem_plus_n_pow)
apply (rule disjI2)
by (metis Nat.add_diff_inverse comm_semiring_1_class.normalizing_semiring_rules(24) elem_pair_2x)

lemma sym_lt:
   "\<And>(P::nat \<Rightarrow> nat \<Rightarrow> bool). (!m n. P m n = P n m) \<Longrightarrow> (!m n. m < n \<longrightarrow> P m n) \<Longrightarrow> (!m. P m m) \<Longrightarrow> P x y"
by (metis nat_neq_iff)

lemma elem_pair_5x:
 "!k. elem k (pair m n) \<longrightarrow> k = m \<or> k = n"
apply (rule sym_lt)
apply (metis pair_sym)
apply (simp add: pair_def)
apply auto
apply (subgoal_tac "2 ^ m < 2 ^ n")
apply (drule_tac s = 1 in elem_pair_4x)
apply simp
apply simp
apply (metis Nat.add_diff_inverse One_nat_def elem_pair_1 elem_plus_pow monoid_add_class.add.right_neutral power_0)
apply simp
by (metis elem_pair_1 pair_def)

lemma elem_pair:
 "elem k (pair m n) = (k = m \<or> k = n)"
by (metis elem_pair_5x elem_pair_left elem_pair_right)

lemma ZFC_pairs:
 "\<exists>z. \<forall>w. elem w z = (w = x \<or> w = y)"
by (metis elem_pair)

definition union_sing :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "union_sing n x \<equiv> if elem n x then x else x + 2 ^ n"

lemma elem_union_sing_1 :
 "!x. elem n (union_sing n x)"
apply (simp add: union_sing_def)
apply (induct_tac "n")
apply (metis Suc_eq_plus1 div_by_1 elem_def even_Suc power_0)
apply simp
by (metis comm_semiring_1_class.normalizing_semiring_rules(24))

lemma elem_union_sing_2 :
 "!k x. k \<noteq> n \<longrightarrow> elem k (union_sing n x) = elem k x"
apply (induct_tac "n")
apply (intro allI impI)
apply (simp add: union_sing_def)
apply (intro impI)
apply (case_tac "k")
apply simp
apply simp
apply (metis Suc_eq_plus1 div_by_1 elem_def lemma_even_div2 power_0)
apply (intro allI impI)
apply (simp add: union_sing_def)
apply clarify
apply (case_tac "k")
apply (simp add: elemZero)
apply simp
apply (thin_tac "k = Suc nat")
apply (subgoal_tac "elem nat (x div 2) =
                    elem nat (if elem n (x div 2) then (x div 2)
                              else (x div 2) + 2 ^ n)")
apply (erule ssubst)
apply simp
apply (metis comm_semiring_1_class.normalizing_semiring_rules(24))
by blast

lemma elem_union_sing :
 "elem k (union_sing n x) = (k = n \<or> elem k x)"
apply (case_tac "k = n")
apply (metis elem_union_sing_1)
by (metis elem_union_sing_2)

lemma elem_size_2:
 "elem k m \<Longrightarrow> 2 ^ k \<le> m"
by (metis elem_size not_less)

lemma pow_size:
 "k < 2 ^ k"
apply (induct_tac "k")
by auto

lemma elem_size_3:
 "elem k m \<Longrightarrow> k < m"
by (metis elem_size less_le_trans not_less pow_size)

fun elem_map_1 :: "(nat \<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
 "elem_map_1 P n 0 = (if elem 0 n
                then union_sing (P 0) 0
                else 0)" |
 "elem_map_1 P n (Suc m) = (let r = elem_map_1 P n m in if elem (Suc m) n
                      then union_sing (P (Suc m)) r
                      else r)"

definition elem_map :: "(nat \<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> nat" where
 "elem_map P n \<equiv> elem_map_1 P n n"

lemma elem_elem_map_1:
 "!k n. elem k (elem_map_1 P n m) = (\<exists>x. elem x n \<and> x \<le> m \<and> P x = k)"
apply (induct_tac "m")
apply (simp add: elem_union_sing)
apply (metis null)
apply (intro allI)
apply (simp del: elemSuc)
apply (case_tac "elem (Suc n) na")
apply (simp del: elemSuc add: elem_union_sing)
apply (auto simp del: elemSuc)
apply (metis le_Suc_eq)
by (metis le_Suc_eq)

lemma elem_elem_map:
 "elem k (elem_map P n) = (\<exists>x. elem x n \<and> P x = k)"
apply (simp add: elem_map_def)
by (metis (poly_guards_query) Suc_leI Suc_le_mono elem_elem_map_1 elem_size_3 le_Suc_eq)

definition img :: "(nat \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat" where
 "img P n \<equiv> elem_map (\<lambda>n. (SOME m. (P n m))) n"

lemma elem_img:
 "(\<forall>x. \<exists>!y. P x y) \<Longrightarrow>
  elem r (img P w) = (\<exists>s. elem s w \<and> P s r)"
apply (simp add: img_def elem_elem_map)
by (metis someI)

lemma ZFC_replacement:
 "(\<forall>x. \<exists>!y. P x y) \<longrightarrow>
  (\<forall>w. \<exists>v. \<forall>r. elem r v = (\<exists>s. elem s w \<and> P s r))"
apply clarify
apply (rule_tac x="img P w" in exI)
by (simp add: elem_img)

lemma notempty_1:
 "n \<noteq> 0 \<Longrightarrow> \<exists>x. elem x n"
by (metis null_ext)

lemma notempty_4:
 "((na::nat) - 2 * 2 ^ n) div 2 = (na div 2) - 2 ^ n"
by simp

lemma notempty_3:
 "\<forall>n. elem x n \<longrightarrow> \<not> elem x (n - 2 ^ x)"
apply (induct_tac "x")
apply (metis (poly_guards_query) Nat.add_diff_inverse div_by_1 elem_def elem_size even_sum_nat odd_1_nat power_0)
apply simp
by (metis notempty_4)

lemma notempty_2:
 "elem x n \<Longrightarrow> \<exists>y. \<not>elem x y \<and> n = union_sing x y"
apply (simp add: union_sing_def)
apply (rule_tac x="n - 2 ^ x" in exI)
apply auto
apply (metis notempty_3)
by (metis Nat.add_diff_inverse comm_semiring_1_class.normalizing_semiring_rules(24) elem_size)

lemma notempty:
 "n \<noteq> 0 \<Longrightarrow> \<exists>x y. ~elem x y \<and> n = union_sing x y"
by (metis (poly_guards_query) notempty_2 null_ext)

lemma size_union_sing:
 "\<not>elem x y \<Longrightarrow> y < union_sing x y"
by (simp add: union_sing_def)

lemma ind_sing:
 "P 0 \<Longrightarrow> (\<And>n x. \<not>elem n x \<Longrightarrow> P x \<Longrightarrow> P (union_sing n x)) \<Longrightarrow> P (x::nat)"
apply (induct_tac "x" rule: nat_less_induct)
apply (case_tac "n = 0")
apply simp
apply (drule_tac notempty)
apply clarify
by (metis size_union_sing)

definition power_set :: "nat \<Rightarrow> nat" where
  "power_set x \<equiv> (\<Prod>k\<in>{m. elem m x}. 1 + 2 ^ 2 ^ k)"

lemma power_set_zero:
 "power_set 0 = 1"
by (simp add: power_set_def null)

lemma insert_union_sing:
 "{m. elem m (union_sing n x)} = insert n {m. elem m x}"
apply (simp add: elem_union_sing)
by auto

lemma finite_elem:
 "finite {m. elem m x}"
apply (subgoal_tac "finite {..<x}")
apply (erule rev_finite_subset)
apply auto
by (metis elem_size_3)

lemma power_set_union_sing:
  "\<not> elem n x \<Longrightarrow> power_set (union_sing n x) = power_set x * (1 + 2 ^ (2 ^ n))"
apply (simp add: power_set_def insert_union_sing)
apply (subst Groups_Big.comm_monoid_mult_class.setprod.insert_remove)
apply (metis finite_elem)
by simp

lemma union_sing_swap:
  "union_sing x (union_sing x1 y1) = union_sing x1 (union_sing x y1)"
apply (rule elem_ext)
by (metis elem_union_sing)

lemma notempty_max:
 "n \<noteq> 0 \<Longrightarrow> \<exists>x y. (\<forall>z. elem z y \<longrightarrow> z < x) \<and> n = union_sing x y"
apply (induction "n" rule: nat_less_induct)
apply (drule_tac notempty)
apply clarify
apply (case_tac " \<forall>z. elem z y \<longrightarrow> z < x")
apply auto[1]
apply auto
apply (subgoal_tac "\<exists>x1 y1. (\<forall>z. elem z y1 \<longrightarrow> z < x1) \<and> y = union_sing x1 y1")
apply clarify
apply (rule_tac x = "x1" in exI)
apply (rule_tac x = "union_sing x y1" in exI)
apply safe
apply (simp add: elem_union_sing)
apply auto[1]
apply (metis union_sing_swap)
apply (subgoal_tac "y \<noteq> 0")
apply (subgoal_tac "y < union_sing x y")
apply auto[1]
apply (rule size_union_sing)
apply simp
apply (rule ccontr)
by (simp add: null)

lemma ind_sing_max:
 "P 0 \<Longrightarrow> (\<And>n x. (!y. elem y x \<longrightarrow> y < n) \<Longrightarrow> P x \<Longrightarrow> P (union_sing n x)) \<Longrightarrow> P (x::nat)"
apply (induct_tac "x" rule: nat_less_induct)
apply (case_tac "n = 0")
apply simp
apply (drule_tac notempty_max)
apply clarify
by (metis less_not_refl size_union_sing)

lemma elem_power_set_2:
  "elem n (k + 2 ^ n) \<Longrightarrow> elem w (k + 2 ^ n) \<Longrightarrow> \<not> elem w k \<Longrightarrow> w = n"
by (metis add_diff_cancel_right' elem_union_sing notempty_3 union_sing_def)

lemma elem_power_set_1:
  "elem n k \<Longrightarrow> elem w k \<Longrightarrow> \<not> elem w (k - 2 ^ n) \<Longrightarrow> w = n"
by (metis add.commute elem_power_set_2 elem_size_2 le_add_diff_inverse)

lemma power_set_size_2:
 "(z::nat) \<le> 2 ^ x \<Longrightarrow> x \<le> m \<Longrightarrow> z \<le> 2 ^ m"
apply (induction "z")
apply auto
by (metis Suc_1 le_antisym lessI not_less_eq_eq power_increasing_iff)

lemma power_set_size_1:
  "x \<le> 2 ^ n \<Longrightarrow>
   (z::nat) \<le> 2 ^ x \<Longrightarrow>
   z * (1 + 2 ^ 2 ^ n) \<le> (1 + z) * 2 ^ 2 ^ n"
by (auto simp add: power_set_size_2)

lemma power_set_size_4:
 "(z::nat) \<le> x \<Longrightarrow>
  b \<le> (1+z) * a \<Longrightarrow>
  b \<le> (1+x) * a"
proof -
  assume a1: "b \<le> (1 + z) * a"
  assume a2: "z \<le> x"
  have "\<And>x\<^sub>1. b \<le> x\<^sub>1 + a * (1 + z)" using a1 by (simp add: mult.commute trans_le_add2)
  thus "b \<le> (1 + x) * a" using a2 by (metis Nat.le_iff_add add.assoc add.commute distrib_left mult.commute)
qed

lemma power_set_size_3:
 "(z::nat) \<le> 2 ^ x \<Longrightarrow>
   x  \<le> 2 ^ n \<Longrightarrow>
   z * (1 + 2 ^ 2 ^ n) \<le> (1 + 2 ^ x) * 2 ^ 2 ^ n"
by (metis power_set_size_1 power_set_size_4)

lemma elem_size_bound:
 "!n. (\<forall>y. elem y x \<longrightarrow> y < n) \<longrightarrow>
      x + 1 \<le> 2 ^ n"
apply (induct_tac "x" rule: ind_div2)
apply auto
apply (subst (asm) elemSuc[symmetric])
apply (case_tac "na")
apply auto
apply (metis null_ext)
apply (subgoal_tac "2 * Suc (n div 2) \<le> 2 * 2 ^ nat")
apply simp
apply (subst (asm) elemSuc[symmetric])
by (metis Suc_less_eq mult_le_cancel1)

lemma power_set_size:
 "power_set x + 1 \<le> 2 ^ (x + 1)"
apply (induct_tac "x" rule: ind_sing_max)
apply (simp add: power_set_zero)
apply (subst power_set_union_sing)
apply auto[1]
apply (subgoal_tac "x + 1 \<le> 2 ^ n")
apply (drule power_set_size_3)
apply assumption
apply (auto simp add: union_sing_def)
apply (metis (erased, hide_lams) Suc_eq_plus1 add.assoc add.left_commute comm_semiring_1_class.normalizing_semiring_rules(24) mult_Suc_right power_Suc power_add)
by (metis Suc_eq_plus1 elem_size_bound)

lemma elem_mul_2k:
 "elem k (s * 2 ^ n) \<Longrightarrow> elem (k - n) s"
by (metis elem_pair_4x monoid_add_class.add.left_neutral mult_0_right neq0_conv null)

lemma div_pow_minus:
 "\<And>x. (x::nat) \<le> (k::nat) \<Longrightarrow> (2::nat) ^ k div 2 ^ x = 2 ^ (k - x)"
apply (induction "k")
apply auto
apply (case_tac "x")
by auto

lemma div_pow_minus_mult:
 "\<And>x. (x::nat) \<le> (k::nat) \<Longrightarrow> s * (2::nat) ^ k div 2 ^ x = s * 2 ^ (k - x)"
apply (induction "k")
apply auto
apply (case_tac "x")
by auto

lemma size_mul_2k:
 "elem x (m * 2 ^ k) \<Longrightarrow> k \<le> x"
apply (rule ccontr)
apply (simp add: elem_def)
apply (subst (asm) div_pow_minus_mult)
by auto

lemma mul_2k:
  "!w. elem w x \<longrightarrow> \<not> elem k w \<Longrightarrow>
   x * 2 ^ 2 ^ k = elem_map (union_sing k) x"
apply (rule elem_ext)
apply (simp add: elem_elem_map)
apply auto
apply (rule_tac x = "ka - 2 ^ k" in exI)
apply rule
apply (metis elem_mul_2k)
apply (simp add: union_sing_def)
apply auto
apply (metis elem_mul_2k)
apply (metis comm_semiring_1_class.normalizing_semiring_rules(24) le_add_diff_inverse size_mul_2k)
apply (subst elem_minus[symmetric])
apply (metis elem_size_2 elem_union_sing_1)
by (metis add_diff_cancel_right' union_sing_def)

lemma not_odd_div:
 "\<not>(odd n \<and> odd m) \<Longrightarrow> (n + m) div 2 = (n div 2) + (m div 2)"
apply (subgoal_tac "\<And>m n. even m \<Longrightarrow> (n + m) div 2 = n div 2 + m div 2")
apply auto[1]
apply (metis add.commute)
by (metis add.commute div2even div_by_0 div_mult_self2 monoid_add_class.add.right_neutral)

lemma disjunct_union:
 "\<And>k n. \<forall>x. elem x m \<longrightarrow> \<not> elem x n \<Longrightarrow>
      elem k (m + n) = (elem k m \<or> elem k n)"
apply (induction "m" rule: ind_div2)
apply (metis monoid_add_class.add.left_neutral null)
apply (case_tac "k")
apply clarify
apply (metis div_by_1 elem_def even_sum_nat power_0)
apply clarify
apply simp
apply (subst not_odd_div)
apply (metis div_by_1 elem_def power_0)
apply (subgoal_tac " \<forall>x. elem x (n div 2) \<longrightarrow> \<not> elem x (na div 2)")
apply auto
by (metis elemSuc)

lemma elem_power_set:
 "!k. elem k (power_set n) = (\<forall>w. elem w k \<longrightarrow> elem w n)"
apply (induct_tac "n" rule: ind_sing_max)
apply (metis elem_pair_1 null null_ext power_0 power_set_zero zero_neq_one)
apply clarify
apply (subst power_set_union_sing)
apply auto[1]
apply simp
apply (subst mul_2k)
apply auto[1]
apply (subst disjunct_union)
apply (metis elem_elem_map elem_union_sing_1 less_not_refl)
apply (simp add: elem_elem_map)
apply auto
apply (metis elem_union_sing)
apply (metis elem_union_sing)
by (metis elem_union_sing notempty_2)

lemma ZFC_power_set:
 "\<forall>x. \<exists>y. \<forall>z. elem z y = (\<forall>w. elem w z \<longrightarrow> elem w x)"
by (metis (poly_guards_query) elem_power_set)

definition set_filter :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat" where
 "set_filter P n \<equiv> (elem_map (\<lambda> k. if P k then Suc k else 0) n) div 2"

lemma elem_set_filter:
 "elem k (set_filter P n) = (P k \<and> elem k n)"
apply (simp add: set_filter_def)
apply (subst elemSuc[symmetric])
apply (subst elem_elem_map)
by auto

definition set_diff :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "set_diff m n \<equiv> set_filter (\<lambda> k. \<not> elem k n) m"

lemma elem_set_diff:
 "elem k (set_diff m n) = (elem k m \<and> \<not> elem k n)"
by (metis elem_set_filter set_diff_def)

definition set_intersect :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "set_intersect m n \<equiv> set_diff m (set_diff m n)"

lemma elem_set_intersect:
 "elem k (set_intersect m n) = (elem k m \<and> elem k n)"
by (metis (poly_guards_query) elem_set_diff set_intersect_def)

definition set_union :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "set_union m n \<equiv> (set_diff m n) + n"

lemma elem_set_union:
  "elem k (set_union m n) = (elem k m \<or> elem k n)"
apply (simp add: set_union_def)
apply (subst disjunct_union)
apply (metis elem_set_diff)
by (metis elem_set_diff)

fun sum_set_1 :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "sum_set_1 n 0 = 0" |
 "sum_set_1 n (Suc m) = (let r = sum_set_1 n m in
                      if elem (Suc m) n
                      then set_union (Suc m) r
                      else r)"

definition sum_set :: "nat \<Rightarrow> nat" where
 "sum_set n \<equiv> sum_set_1 n n"

lemma elem_sum_set_1:
 "!k n. elem k (sum_set_1 n m) = (\<exists>x. elem x n \<and> x \<le> m \<and> elem k x)"
apply (induct_tac "m")
apply (simp add: elem_union_sing)
apply (metis null)
apply (intro allI)
apply (simp del: elemSuc)
apply (case_tac "elem (Suc n) na")
apply (simp del: elemSuc add: elem_set_union)
apply (auto simp del: elemSuc)
apply (metis le_Suc_eq)
by (metis le_Suc_eq)

lemma elem_sum_set:
 "elem k (sum_set n) = (\<exists>x. elem x n \<and> elem k x)"
apply (simp add: sum_set_def)
by (metis (poly_guards_query) Suc_leI Suc_le_mono elem_sum_set_1 elem_size_3 le_Suc_eq)

lemma ZFC_sum_set:
 "\<forall>x. \<exists>y. \<forall>u. elem u y = (\<exists>z. elem z x \<and> elem u z)"
by (metis elem_sum_set)

lemma disjoint_intersect:
 "(set_intersect v u = 0) = (\<not>(\<exists>w. elem w v \<and> elem w u))"
by (metis elem_set_intersect null null_ext)

lemma set_intersect_sym:
 "set_intersect u v = set_intersect v u"
by (metis elem_set_intersect elem_ext)

lemma notempty_eqv:
 "(n \<noteq> 0) = (\<exists>w. elem w n)"
by (metis null null_ext)

fun max_elem_1 :: "nat => nat => nat" where
 "max_elem_1 m 0 = 0" |
 "max_elem_1 m (Suc n) = (if elem (Suc n) m
                          then (Suc n)
                          else max_elem_1 m n)"

definition max_elem :: "nat \<Rightarrow> nat" where
 "max_elem m \<equiv> max_elem_1 m m"

lemma elem_max_elem_1:
 "(\<exists>x. elem x m \<and> x \<le> k) \<Longrightarrow>
  elem (max_elem_1 m k) m"
apply (induction "k")
apply simp
by (metis le_Suc_eq max_elem_1.simps(2))

lemma max_elem_1_max:
 "elem w m \<Longrightarrow>
  w \<le> k \<Longrightarrow>
  w \<le> max_elem_1 m k"
apply (induction "k")
apply simp
by (metis le_Suc_eq max_elem_1.simps(2))

lemma elem_max_elem:
 "m \<noteq> 0 \<Longrightarrow>
  elem (max_elem m) m"
apply (subst (asm) notempty_eqv)
apply (simp add:  max_elem_def)
apply clarify
by (metis (poly_guards_query) Suc_leI Suc_le_mono elem_max_elem_1 elem_size_3 le_Suc_eq)

lemma max_elem_max:
 "elem w m \<Longrightarrow> w \<le> max_elem m"
by (metis Suc_leD Suc_leI elem_size_3 max_elem_1_max max_elem_def)

definition choice :: "nat \<Rightarrow> nat" where
 "choice m \<equiv> elem_map max_elem m"

lemma elem_choice_1:
 "\<forall>u. elem u x \<longrightarrow>
           (\<exists>w. elem w u) \<and>
           (\<forall>v. elem v x \<and> v \<noteq> u \<longrightarrow> (\<forall>w. elem w v \<longrightarrow> \<not> elem w u)) \<Longrightarrow>
       elem u x \<Longrightarrow>
       elem (max_elem w) u \<Longrightarrow> elem w x \<Longrightarrow> w = u"
apply (subgoal_tac "elem (max_elem w) w")
apply auto[1]
by (metis elem_max_elem null)

lemma elem_choice:
 " (\<forall>u. elem u x \<longrightarrow>
            (\<exists>w. elem w u) \<and>
            (\<forall>v. elem v x \<and> v \<noteq> u \<longrightarrow> \<not> (\<exists>w. elem w v \<and> elem w u))) \<Longrightarrow>
        (\<forall>u. elem u x \<longrightarrow> (\<exists>!w. elem w u \<and> elem w (choice x)))"
apply (simp add: choice_def elem_elem_map)
apply safe
apply (metis (poly_guards_query) elem_max_elem_1 elem_size_3 max_elem_def nat_le_linear not_less)
apply (subgoal_tac "xa = u")
apply (subgoal_tac "xaa = u")
apply simp
apply (erule elem_choice_1)
apply simp
apply simp
apply simp
apply (erule elem_choice_1)
by simp

lemma ZFC_CAC:
 " \<forall>x. (\<forall>u. elem u x \<longrightarrow>
            (\<exists>w. elem w u) \<and>
            (\<forall>v. elem v x \<and> v \<noteq> u \<longrightarrow> \<not> (\<exists>w. elem w v \<and> elem w u))) \<longrightarrow>
        (\<exists>y. \<forall>u. elem u x \<longrightarrow> (\<exists>!w. elem w u \<and> elem w y))"
apply (intro allI impI)
apply (rule_tac x = "choice x" in exI)
apply (rule elem_choice)
by metis

definition TC :: "nat \<Rightarrow> nat" where
 "TC x \<equiv> (2 ^ ((max_elem x) + 1)) - 1"

lemma pow_pre:
 "(((2::nat) ^ (Suc n))- 1) div 2 = (2 ^ (n::nat)) - 1"
by simp

lemma elem_pow_pre:
 "\<forall>x. elem x (2 ^ n - 1) = (x < n)"
apply (induct_tac "n")
apply (metis diff_self_eq_0 not_less0 null power_0)
apply clarify
apply (case_tac "x")
apply (simp add: elemZero)
apply clarify
apply (subst elemSuc)
by (metis Suc_less_eq pow_pre)

lemma elem_TC:
 "elem x (TC y) = (x \<le> max_elem y)"
by (metis Suc_eq_plus1 TC_def elem_pow_pre not_less not_less_eq_eq)

lemma TC_transitive:
 "elem z y \<Longrightarrow> elem y (TC x) \<Longrightarrow> elem z (TC x)"
apply (subst elem_TC)
apply (subgoal_tac "z < y")
apply (auto simp add: elem_size_3)
by (metis Suc_leD Suc_leI elem_TC elem_size_3 le_trans)

lemma TC_closure:
 "elem z x \<Longrightarrow> elem z (TC x)"
by (metis elem_TC max_elem_max)

lemma ZFC_TC:
 "\<forall>x. \<exists>u. (\<forall>w. elem w x \<longrightarrow> elem w u) \<and>
          (\<forall>y z. elem z y \<and> elem y u \<longrightarrow> elem z u)"
apply rule
apply (rule_tac x = "TC x" in exI)
by (metis TC_closure TC_transitive)

end


theory Kyber_NTT_Values

imports Kyber_Values
  NTT_Scheme
  Powers3844

begin
section \<open>Specification of Kyber with NTT\<close>
text \<open>Calculations for NTT specifications\<close>

lemma "3844 * 6584 = (1 :: fin7681 mod_ring)"
  by simp

lemma "62 * 1115 = (1 :: fin7681 mod_ring)"
  by simp

lemma "256 * 7651 = (1:: fin7681 mod_ring)"
  by simp

lemma "7681 = 30 * 256 + (1::int)" by simp

lemma powr256:  "3844 ^ 256 = (1::fin7681 mod_ring)"
proof -
  have calc1: "3844^16 = (7154::fin7681 mod_ring)" by simp
  have calc2: "7154^16 = (1::fin7681 mod_ring)" by simp
  have "(3844::fin7681 mod_ring)^256 = (3844^16)^16"
    by (metis (mono_tags, opaque_lifting) num_double numeral_times_numeral power_mult)
  also have "\<dots> = 1" unfolding calc1 calc2 by auto
  finally show ?thesis by blast
qed

lemma powr256':
  "62 ^ 256 = (- 1::fin7681 mod_ring)"
proof -
  have calc1: "62^16 = (1366::fin7681 mod_ring)" by simp
  have calc2: "1366^16 = (-1::fin7681 mod_ring)" by simp
  have "(62::fin7681 mod_ring)^256 = (62^16)^16"
    by (metis (mono_tags, opaque_lifting) num_double numeral_times_numeral power_mult)
  also have "\<dots> = -1" unfolding calc1 calc2 by auto
  finally show ?thesis by blast
qed

(*
powrs 3844^l for l=1..<256 in Powrs_3844 file"
*)

interpretation kyber7681_ntt: kyber_ntt 256 7681 3 8
  "TYPE(fin7681)" "TYPE(3)" 3844 6584 62 1115 7651 30
proof (unfold_locales, goal_cases)
  case 4
  then show ?case using kyber7681.q_prime by fastforce
next
  case 6
  then show ?case using kyber7681.CARD_k by blast
next
  case 7
  then show ?case by (simp add: qr_poly'_fin7681_def)
next
  case 9
  then show ?case using powr256 by blast
next
  case 11
  then show ?case proof (safe, goal_cases)
    case (1 m)
    then show ?case using powr_less256[OF 1(2)]
      using linorder_not_less by blast
  qed
next
  case 15
  then show ?case using powr256' by blast
next
  case 17
  have mult: "256 * 7651 = (1::fin7681 mod_ring)" by simp
  have of_int: "of_int_mod_ring (int 256) = 256"
    by (metis o_def of_nat_numeral of_nat_of_int_mod_ring)
  show ?case unfolding of_int mult by simp
qed (auto)

end


(*  Title:      ZF/Arith.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1992  University of Cambridge
*)

(*"Difference" is subtraction of natural numbers.
  There are no negative numbers; we have
     m #- n = 0  iff  m<=n   and     m #- n = succ(k) iff m>n.
  Also, rec(m, 0, \<lambda>z w.z) is pred(m).
*)

section\<open>Arithmetic Operators and Their Definitions\<close>

theory Arith imports Univ begin

text\<open>Proofs about elementary arithmetic: addition, multiplication, etc.\<close>

definition
  pred   :: "i\<Rightarrow>i"    (*inverse of succ*)  where
    "pred(y) \<equiv> nat_case(0, \<lambda>x. x, y)"

definition
  natify :: "i\<Rightarrow>i"    (*coerces non-nats to nats*)  where
    "natify \<equiv> Vrecursor(\<lambda>f a. if a = succ(pred(a)) then succ(f`pred(a))
                                                    else 0)"

consts
  raw_add  :: "[i,i]\<Rightarrow>i"
  raw_diff  :: "[i,i]\<Rightarrow>i"
  raw_mult  :: "[i,i]\<Rightarrow>i"

primrec
  "raw_add (0, n) = n"
  "raw_add (succ(m), n) = succ(raw_add(m, n))"

primrec
  raw_diff_0:     "raw_diff(m, 0) = m"
  raw_diff_succ:  "raw_diff(m, succ(n)) =
                     nat_case(0, \<lambda>x. x, raw_diff(m, n))"

primrec
  "raw_mult(0, n) = 0"
  "raw_mult(succ(m), n) = raw_add (n, raw_mult(m, n))"

definition
  add :: "[i,i]\<Rightarrow>i"                    (infixl \<open>#+\<close> 65)  where
    "m #+ n \<equiv> raw_add (natify(m), natify(n))"

definition
  diff :: "[i,i]\<Rightarrow>i"                    (infixl \<open>#-\<close> 65)  where
    "m #- n \<equiv> raw_diff (natify(m), natify(n))"

definition
  mult :: "[i,i]\<Rightarrow>i"                    (infixl \<open>#*\<close> 70)  where
    "m #* n \<equiv> raw_mult (natify(m), natify(n))"

definition
  raw_div  :: "[i,i]\<Rightarrow>i"  where
    "raw_div (m, n) \<equiv>
       transrec(m, \<lambda>j f. if j<n | n=0 then 0 else succ(f`(j#-n)))"

definition
  raw_mod  :: "[i,i]\<Rightarrow>i"  where
    "raw_mod (m, n) \<equiv>
       transrec(m, \<lambda>j f. if j<n | n=0 then j else f`(j#-n))"

definition
  div  :: "[i,i]\<Rightarrow>i"                    (infixl \<open>div\<close> 70)  where
    "m div n \<equiv> raw_div (natify(m), natify(n))"

definition
  mod  :: "[i,i]\<Rightarrow>i"                    (infixl \<open>mod\<close> 70)  where
    "m mod n \<equiv> raw_mod (natify(m), natify(n))"

declare rec_type [simp]
        nat_0_le [simp]

lemma zero_lt_lemma: "\<lbrakk>0<k; k \<in> nat\<rbrakk> \<Longrightarrow> \<exists>j\<in>nat. k = succ(j)"
apply (erule rev_mp)
apply (induct_tac "k", auto)
done

(* @{term"\<lbrakk>0 < k; k \<in> nat; \<And>j. \<lbrakk>j \<in> nat; k = succ(j)\<rbrakk> \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"} *)
lemmas zero_lt_natE = zero_lt_lemma [THEN bexE]

subsection\<open>\<open>natify\<close>, the Coercion to \<^term>\<open>nat\<close>\<close>

lemma pred_succ_eq [simp]: "pred(succ(y)) = y"
by (unfold pred_def, auto)

lemma natify_succ: "natify(succ(x)) = succ(natify(x))"
by (rule natify_def [THEN def_Vrecursor, THEN trans], auto)

lemma natify_0 [simp]: "natify(0) = 0"
by (rule natify_def [THEN def_Vrecursor, THEN trans], auto)

lemma natify_non_succ: "\<forall>z. x \<noteq> succ(z) \<Longrightarrow> natify(x) = 0"
by (rule natify_def [THEN def_Vrecursor, THEN trans], auto)

lemma natify_in_nat [iff,TC]: "natify(x) \<in> nat"
apply (rule_tac a=x in eps_induct)
apply (case_tac "\<exists>z. x = succ(z)")
apply (auto simp add: natify_succ natify_non_succ)
done

lemma natify_ident [simp]: "n \<in> nat \<Longrightarrow> natify(n) = n"
apply (induct_tac "n")
apply (auto simp add: natify_succ)
done

lemma natify_eqE: "\<lbrakk>natify(x) = y;  x \<in> nat\<rbrakk> \<Longrightarrow> x=y"
by auto

(*** Collapsing rules: to remove natify from arithmetic expressions ***)

lemma natify_idem [simp]: "natify(natify(x)) = natify(x)"
by simp

(** Addition **)

lemma add_natify1 [simp]: "natify(m) #+ n = m #+ n"
by (simp add: add_def)

lemma add_natify2 [simp]: "m #+ natify(n) = m #+ n"
by (simp add: add_def)

(** Multiplication **)

lemma mult_natify1 [simp]: "natify(m) #* n = m #* n"
by (simp add: mult_def)

lemma mult_natify2 [simp]: "m #* natify(n) = m #* n"
by (simp add: mult_def)

(** Difference **)

lemma diff_natify1 [simp]: "natify(m) #- n = m #- n"
by (simp add: diff_def)

lemma diff_natify2 [simp]: "m #- natify(n) = m #- n"
by (simp add: diff_def)

(** Remainder **)

lemma mod_natify1 [simp]: "natify(m) mod n = m mod n"
by (simp add: mod_def)

lemma mod_natify2 [simp]: "m mod natify(n) = m mod n"
by (simp add: mod_def)

(** Quotient **)

lemma div_natify1 [simp]: "natify(m) div n = m div n"
by (simp add: div_def)

lemma div_natify2 [simp]: "m div natify(n) = m div n"
by (simp add: div_def)

subsection\<open>Typing rules\<close>

(** Addition **)

lemma raw_add_type: "\<lbrakk>m\<in>nat;  n\<in>nat\<rbrakk> \<Longrightarrow> raw_add (m, n) \<in> nat"
by (induct_tac "m", auto)

lemma add_type [iff,TC]: "m #+ n \<in> nat"
by (simp add: add_def raw_add_type)

(** Multiplication **)

lemma raw_mult_type: "\<lbrakk>m\<in>nat;  n\<in>nat\<rbrakk> \<Longrightarrow> raw_mult (m, n) \<in> nat"
apply (induct_tac "m")
apply (simp_all add: raw_add_type)
done

lemma mult_type [iff,TC]: "m #* n \<in> nat"
by (simp add: mult_def raw_mult_type)

(** Difference **)

lemma raw_diff_type: "\<lbrakk>m\<in>nat;  n\<in>nat\<rbrakk> \<Longrightarrow> raw_diff (m, n) \<in> nat"
by (induct_tac "n", auto)

lemma diff_type [iff,TC]: "m #- n \<in> nat"
by (simp add: diff_def raw_diff_type)

lemma diff_0_eq_0 [simp]: "0 #- n = 0"
  unfolding diff_def
apply (rule natify_in_nat [THEN nat_induct], auto)
done

(*Must simplify BEFORE the induction: else we get a critical pair*)
lemma diff_succ_succ [simp]: "succ(m) #- succ(n) = m #- n"
apply (simp add: natify_succ diff_def)
apply (rule_tac x1 = n in natify_in_nat [THEN nat_induct], auto)
done

(*This defining property is no longer wanted*)
declare raw_diff_succ [simp del]

(*Natify has weakened this law, compared with the older approach*)
lemma diff_0 [simp]: "m #- 0 = natify(m)"
by (simp add: diff_def)

lemma diff_le_self: "m\<in>nat \<Longrightarrow> (m #- n) \<le> m"
apply (subgoal_tac " (m #- natify (n)) \<le> m")
apply (rule_tac [2] m = m and n = "natify (n) " in diff_induct)
apply (erule_tac [6] leE)
apply (simp_all add: le_iff)
done

subsection\<open>Addition\<close>

(*Natify has weakened this law, compared with the older approach*)
lemma add_0_natify [simp]: "0 #+ m = natify(m)"
by (simp add: add_def)

lemma add_succ [simp]: "succ(m) #+ n = succ(m #+ n)"
by (simp add: natify_succ add_def)

lemma add_0: "m \<in> nat \<Longrightarrow> 0 #+ m = m"
by simp

(*Associative law for addition*)

(*The following two lemmas are used for add_commute and sometimes
  elsewhere, since they are safe for rewriting.*)
lemma add_0_right_natify [simp]: "m #+ 0 = natify(m)"
apply (subgoal_tac "natify(m) #+ 0 = natify(m)")
apply (rule_tac [2] n = "natify(m)" in nat_induct)
apply auto
done

lemma add_succ_right [simp]: "m #+ succ(n) = succ(m #+ n)"
  unfolding add_def
apply (rule_tac n = "natify(m) " in nat_induct)
apply (auto simp add: natify_succ)
done

lemma add_0_right: "m \<in> nat \<Longrightarrow> m #+ 0 = m"
by auto

(*Commutative law for addition*)
lemma add_commute: "m #+ n = n #+ m"
apply (subgoal_tac "natify(m) #+ natify(n) = natify(n) #+ natify(m) ")
apply (rule_tac [2] n = "natify(m) " in nat_induct)
apply auto
done

(*for a/c rewriting*)
lemma add_left_commute: "m#+(n#+k)=n#+(m#+k)"
apply (rule add_commute [THEN trans])
apply (rule add_assoc [THEN trans])
apply (rule add_commute [THEN subst_context])
done

(*Addition is an AC-operator*)
lemmas add_ac = add_assoc add_commute add_left_commute

(*Cancellation law on the left*)
lemma raw_add_left_cancel:
     "\<lbrakk>raw_add(k, m) = raw_add(k, n);  k\<in>nat\<rbrakk> \<Longrightarrow> m=n"
apply (erule rev_mp)
apply (induct_tac "k", auto)
done

lemma add_left_cancel_natify: "k #+ m = k #+ n \<Longrightarrow> natify(m) = natify(n)"
  unfolding add_def
apply (drule raw_add_left_cancel, auto)
done

lemma add_left_cancel:
     "\<lbrakk>i = j;  i #+ m = j #+ n;  m\<in>nat;  n\<in>nat\<rbrakk> \<Longrightarrow> m = n"
by (force dest!: add_left_cancel_natify)

(*Thanks to Sten Agerholm*)
lemma add_le_elim1_natify: "k#+m \<le> k#+n \<Longrightarrow> natify(m) \<le> natify(n)"
apply (rule_tac P = "natify(k) #+m \<le> natify(k) #+n" in rev_mp)
apply (rule_tac [2] n = "natify(k) " in nat_induct)
apply auto
done

lemma add_le_elim1: "\<lbrakk>k#+m \<le> k#+n; m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> m \<le> n"
by (drule add_le_elim1_natify, auto)

lemma add_lt_elim1_natify: "k#+m < k#+n \<Longrightarrow> natify(m) < natify(n)"
apply (rule_tac P = "natify(k) #+m < natify(k) #+n" in rev_mp)
apply (rule_tac [2] n = "natify(k) " in nat_induct)
apply auto
done

lemma add_lt_elim1: "\<lbrakk>k#+m < k#+n; m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> m < n"
by (drule add_lt_elim1_natify, auto)

lemma zero_less_add: "\<lbrakk>n \<in> nat; m \<in> nat\<rbrakk> \<Longrightarrow> 0 < m #+ n \<longleftrightarrow> (0<m | 0<n)"
by (induct_tac "n", auto)

subsection\<open>Monotonicity of Addition\<close>

(*strict, in 1st argument; proof is by rule induction on 'less than'.
  Still need j\<in>nat, for consider j = omega.  Then we can have i<omega,
  which is the same as i\<in>nat, but natify(j)=0, so the conclusion fails.*)
lemma add_lt_mono1: "\<lbrakk>i<j; j\<in>nat\<rbrakk> \<Longrightarrow> i#+k < j#+k"
apply (frule lt_nat_in_nat, assumption)
apply (erule succ_lt_induct)
apply (simp_all add: leI)
done

text\<open>strict, in second argument\<close>
lemma add_lt_mono2: "\<lbrakk>i<j; j\<in>nat\<rbrakk> \<Longrightarrow> k#+i < k#+j"
by (simp add: add_commute [of k] add_lt_mono1)

text\<open>A [clumsy] way of lifting < monotonicity to \<open>\<le>\<close> monotonicity\<close>
lemma Ord_lt_mono_imp_le_mono:
  assumes lt_mono: "\<And>i j. \<lbrakk>i<j; j:k\<rbrakk> \<Longrightarrow> f(i) < f(j)"
      and ford:    "\<And>i. i:k \<Longrightarrow> Ord(f(i))"
      and leij:    "i \<le> j"
      and jink:    "j:k"
  shows "f(i) \<le> f(j)"
apply (insert leij jink)
apply (blast intro!: leCI lt_mono ford elim!: leE)
done

text\<open>\<open>\<le>\<close> monotonicity, 1st argument\<close>
lemma add_le_mono1: "\<lbrakk>i \<le> j; j\<in>nat\<rbrakk> \<Longrightarrow> i#+k \<le> j#+k"
apply (rule_tac f = "\<lambda>j. j#+k" in Ord_lt_mono_imp_le_mono, typecheck)
apply (blast intro: add_lt_mono1 add_type [THEN nat_into_Ord])+
done

text\<open>\<open>\<le>\<close> monotonicity, both arguments\<close>
lemma add_le_mono: "\<lbrakk>i \<le> j; k \<le> l; j\<in>nat; l\<in>nat\<rbrakk> \<Longrightarrow> i#+k \<le> j#+l"
apply (rule add_le_mono1 [THEN le_trans], assumption+)
apply (subst add_commute, subst add_commute, rule add_le_mono1, assumption+)
done

text\<open>Combinations of less-than and less-than-or-equals\<close>

lemma add_lt_le_mono: "\<lbrakk>i<j; k\<le>l; j\<in>nat; l\<in>nat\<rbrakk> \<Longrightarrow> i#+k < j#+l"
apply (rule add_lt_mono1 [THEN lt_trans2], assumption+)
apply (subst add_commute, subst add_commute, rule add_le_mono1, assumption+)
done

lemma add_le_lt_mono: "\<lbrakk>i\<le>j; k<l; j\<in>nat; l\<in>nat\<rbrakk> \<Longrightarrow> i#+k < j#+l"
by (subst add_commute, subst add_commute, erule add_lt_le_mono, assumption+)

text\<open>Less-than: in other words, strict in both arguments\<close>
lemma add_lt_mono: "\<lbrakk>i<j; k<l; j\<in>nat; l\<in>nat\<rbrakk> \<Longrightarrow> i#+k < j#+l"
apply (rule add_lt_le_mono)
apply (auto intro: leI)
done

(** Subtraction is the inverse of addition. **)

lemma diff_add_inverse: "(n#+m) #- n = natify(m)"
apply (subgoal_tac " (natify(n) #+ m) #- natify(n) = natify(m) ")
apply (rule_tac [2] n = "natify(n) " in nat_induct)
apply auto
done

lemma diff_add_inverse2: "(m#+n) #- n = natify(m)"
by (simp add: add_commute [of m] diff_add_inverse)

lemma diff_cancel: "(k#+m) #- (k#+n) = m #- n"
apply (subgoal_tac "(natify(k) #+ natify(m)) #- (natify(k) #+ natify(n)) =
                    natify(m) #- natify(n) ")
apply (rule_tac [2] n = "natify(k) " in nat_induct)
apply auto
done

lemma diff_cancel2: "(m#+k) #- (n#+k) = m #- n"
by (simp add: add_commute [of _ k] diff_cancel)

lemma diff_add_0: "n #- (n#+m) = 0"
apply (subgoal_tac "natify(n) #- (natify(n) #+ natify(m)) = 0")
apply (rule_tac [2] n = "natify(n) " in nat_induct)
apply auto
done

lemma pred_0 [simp]: "pred(0) = 0"
by (simp add: pred_def)

lemma eq_succ_imp_eq_m1: "\<lbrakk>i = succ(j); i\<in>nat\<rbrakk> \<Longrightarrow> j = i #- 1 \<and> j \<in>nat"
by simp

lemma pred_Un_distrib:
    "\<lbrakk>i\<in>nat; j\<in>nat\<rbrakk> \<Longrightarrow> pred(i \<union> j) = pred(i) \<union> pred(j)"
apply (erule_tac n=i in natE, simp)
apply (erule_tac n=j in natE, simp)
apply (simp add:  succ_Un_distrib [symmetric])
done

lemma pred_type [TC,simp]:
    "i \<in> nat \<Longrightarrow> pred(i) \<in> nat"
by (simp add: pred_def split: split_nat_case)

lemma nat_diff_pred: "\<lbrakk>i\<in>nat; j\<in>nat\<rbrakk> \<Longrightarrow> i #- succ(j) = pred(i #- j)"
apply (rule_tac m=i and n=j in diff_induct)
apply (auto simp add: pred_def nat_imp_quasinat split: split_nat_case)
done

lemma diff_succ_eq_pred: "i #- succ(j) = pred(i #- j)"
apply (insert nat_diff_pred [of "natify(i)" "natify(j)"])
apply (simp add: natify_succ [symmetric])
done

lemma nat_diff_Un_distrib:
    "\<lbrakk>i\<in>nat; j\<in>nat; k\<in>nat\<rbrakk> \<Longrightarrow> (i \<union> j) #- k = (i#-k) \<union> (j#-k)"
apply (rule_tac n=k in nat_induct)
apply (simp_all add: diff_succ_eq_pred pred_Un_distrib)
done

lemma diff_Un_distrib:
    "\<lbrakk>i\<in>nat; j\<in>nat\<rbrakk> \<Longrightarrow> (i \<union> j) #- k = (i#-k) \<union> (j#-k)"
by (insert nat_diff_Un_distrib [of i j "natify(k)"], simp)

text\<open>We actually prove \<^term>\<open>i #- j #- k = i #- (j #+ k)\<close>\<close>
lemma diff_diff_left [simplified]:
     "natify(i)#-natify(j)#-k = natify(i) #- (natify(j)#+k)"
by (rule_tac m="natify(i)" and n="natify(j)" in diff_induct, auto)

(** Lemmas for the CancelNumerals simproc **)

lemma eq_add_iff: "(u #+ m = u #+ n) \<longleftrightarrow> (0 #+ m = natify(n))"
apply auto
apply (blast dest: add_left_cancel_natify)
apply (simp add: add_def)
done

lemma less_add_iff: "(u #+ m < u #+ n) \<longleftrightarrow> (0 #+ m < natify(n))"
apply (auto simp add: add_lt_elim1_natify)
apply (drule add_lt_mono1)
apply (auto simp add: add_commute [of u])
done

lemma diff_add_eq: "((u #+ m) #- (u #+ n)) = ((0 #+ m) #- n)"
by (simp add: diff_cancel)

(*To tidy up the result of a simproc.  Only the RHS will be simplified.*)
lemma eq_cong2: "u = u' \<Longrightarrow> (t\<equiv>u) \<equiv> (t\<equiv>u')"
by auto

lemma iff_cong2: "u \<longleftrightarrow> u' \<Longrightarrow> (t\<equiv>u) \<equiv> (t\<equiv>u')"
by auto

subsection\<open>Multiplication\<close>

lemma mult_0 [simp]: "0 #* m = 0"
by (simp add: mult_def)

lemma mult_succ [simp]: "succ(m) #* n = n #+ (m #* n)"
by (simp add: add_def mult_def natify_succ raw_mult_type)

(*right annihilation in product*)
lemma mult_0_right [simp]: "m #* 0 = 0"
  unfolding mult_def
apply (rule_tac n = "natify(m) " in nat_induct)
apply auto
done

(*right successor law for multiplication*)
lemma mult_succ_right [simp]: "m #* succ(n) = m #+ (m #* n)"
apply (subgoal_tac "natify(m) #* succ (natify(n)) =
                    natify(m) #+ (natify(m) #* natify(n))")
apply (simp (no_asm_use) add: natify_succ add_def mult_def)
apply (rule_tac n = "natify(m) " in nat_induct)
apply (simp_all add: add_ac)
done

lemma mult_1_natify [simp]: "1 #* n = natify(n)"
by auto

lemma mult_1_right_natify [simp]: "n #* 1 = natify(n)"
by auto

lemma mult_1: "n \<in> nat \<Longrightarrow> 1 #* n = n"
by simp

lemma mult_1_right: "n \<in> nat \<Longrightarrow> n #* 1 = n"
by simp

(*Commutative law for multiplication*)
lemma mult_commute: "m #* n = n #* m"
apply (subgoal_tac "natify(m) #* natify(n) = natify(n) #* natify(m) ")
apply (rule_tac [2] n = "natify(m) " in nat_induct)
apply auto
done

(*addition distributes over multiplication*)
lemma add_mult_distrib: "(m #+ n) #* k = (m #* k) #+ (n #* k)"
apply (subgoal_tac "(natify(m) #+ natify(n)) #* natify(k) =
                    (natify(m) #* natify(k)) #+ (natify(n) #* natify(k))")
apply (rule_tac [2] n = "natify(m) " in nat_induct)
apply (simp_all add: add_assoc [symmetric])
done

(*Distributive law on the left*)
lemma add_mult_distrib_left: "k #* (m #+ n) = (k #* m) #+ (k #* n)"
apply (subgoal_tac "natify(k) #* (natify(m) #+ natify(n)) =
                    (natify(k) #* natify(m)) #+ (natify(k) #* natify(n))")
apply (rule_tac [2] n = "natify(m) " in nat_induct)
apply (simp_all add: add_ac)
done

(*Associative law for multiplication*)
lemma mult_assoc: "(m #* n) #* k = m #* (n #* k)"
apply (subgoal_tac "(natify(m) #* natify(n)) #* natify(k) =
                    natify(m) #* (natify(n) #* natify(k))")
apply (rule_tac [2] n = "natify(m) " in nat_induct)
apply (simp_all add: add_mult_distrib)
done

(*for a/c rewriting*)
lemma mult_left_commute: "m #* (n #* k) = n #* (m #* k)"
apply (rule mult_commute [THEN trans])
apply (rule mult_assoc [THEN trans])
apply (rule mult_commute [THEN subst_context])
done

lemmas mult_ac = mult_assoc mult_commute mult_left_commute

lemma lt_succ_eq_0_disj:
     "\<lbrakk>m\<in>nat; n\<in>nat\<rbrakk>
      \<Longrightarrow> (m < succ(n)) \<longleftrightarrow> (m = 0 | (\<exists>j\<in>nat. m = succ(j) \<and> j < n))"
by (induct_tac "m", auto)

lemma less_diff_conv [rule_format]:
     "\<lbrakk>j\<in>nat; k\<in>nat\<rbrakk> \<Longrightarrow> \<forall>i\<in>nat. (i < j #- k) \<longleftrightarrow> (i #+ k < j)"
by (erule_tac m = k in diff_induct, auto)

lemmas nat_typechecks = rec_type nat_0I nat_1I nat_succI Ord_nat

end


theory GabrielaLimonta
imports Main
begin

(* Homework 3.1 *)
datatype instr = LDI int | LD nat | ST nat | ADD nat

type_synonym state = "nat \<Rightarrow> int"

fun exec :: "instr \<Rightarrow> state \<Rightarrow> state" where
  "exec (LDI i) s = s(0 := i)"
| "exec (LD n) s = s(0 := (s (n + 1)))"
| "exec (ST n) s = s((n+1) := (s 0))"
| "exec (ADD n) s = s(0 := (s 0) + (s (n + 1)))"

fun execs :: "instr list \<Rightarrow> state \<Rightarrow> state" where
  "execs [] s = s"
| "execs (x#xs) s = execs xs (exec x s)"

datatype expr = C int | V nat | A expr expr

fun val :: "expr \<Rightarrow> (nat \<Rightarrow> int) \<Rightarrow> int" where
  "val (C i) s = i"
| "val (V n) s = s n"
| "val (A a1 a2) s = val a1 s + val a2 s"

fun cmp :: "expr \<Rightarrow> nat \<Rightarrow> instr list" where
  "cmp (C i) n = (LDI i # ST n # [])"
| "cmp (V x) n = (LD x # ST n # [])"
| "cmp (A a1 a2) n = cmp a1 (n + 1) @ cmp a2 (n + 2) @ (LD (n+1) # ADD (n+2) # ST n # [])"

value "cmp (A (C 21) (A (V 1) (C 21))) 2"

fun maxvar :: "expr \<Rightarrow> nat" where
  "maxvar (C i) = 0"
| "maxvar (V n) = n"
| "maxvar (A a1 a2) = (if maxvar a1 > maxvar a2 then maxvar a1 else maxvar a2)"

value "maxvar (A (C 21) (A (V 1) (V 42)))"

lemma [simp]: "\<forall> n \<le> maxvar e. s n = s' n \<Longrightarrow> val e s = val e s'"
  apply(induction)
  apply(auto)
  done

lemma [simp]: "\<forall> n \<le> maxvar e. n > 0 \<Longrightarrow> s n = (execs (cmp e (n+1)) s) n"
  apply(induction)
  apply(auto)
  done

theorem "execs (cmp e (maxvar e + 1)) s 0 = val e (comp s Suc)"
proof(induction e)
  print_cases
  case C thus ?case by simp
next
  case V thus ?case by simp
next
  case A thus ?case
oops

(* Exercise 3.2 *)
datatype ab = a | b

inductive_set S :: "ab list set" where
  A: "w \<in> S \<Longrightarrow> [a] @ w \<in> S"
| B: "w \<in> S \<Longrightarrow> w @ [b] \<in> S"
| E: "[] \<in> S"

fun only_b :: "ab list \<Rightarrow> bool" where
  "only_b [] = True"
| "only_b (x#xs) = (if x = b then only_b xs else False)"

value "only_b [b,b,b,b,b,b,b,b,b,b,b,b]"
value "only_b []"
value "only_b [b,b,b,b,b,a,b,b,b,b,b]"

fun is_ab :: "ab list \<Rightarrow> bool" where
  "is_ab [] = True"
| "is_ab (x#xs) = (case x of
   a \<Rightarrow> (is_ab xs \<or> only_b xs) |
   b \<Rightarrow> only_b xs)"

value "is_ab [b,b,b,b,b,b,b,b,b,b,b,b]"
value "is_ab []"
value "is_ab [b,b,b,b,b,a,b,b,b,b,b]"
value "is_ab [a,a,a,a,a,a,b,b,b]"
value "is_ab [a,a,a,a,a,a]"
value "is_ab [b,a]"

lemma [simp]: "(a#w) = [a] @ w"
  apply(auto)
  done

lemma "w \<in> S \<Longrightarrow> is_ab w"
proof (induction w)
  print_cases
  case Nil thus ?case by simp
next
  case (Cons e w)
  thus ?case by (auto split: ab.split)
qed

end


theory ConcreteSemantics9_2_Sec_Type_Expr
  imports Main "~~/src/HOL/IMP/Big_Step"
begin

section "Security Type Systems"

type_synonym level = nat

class sec =
fixes sec :: "'a \<Rightarrow> nat"

text\<open>The security/confidentiality level of each variable is globally fixed
for simplicity. For the sake of examples --- the general theory does not rely
on it! --- a variable of length \<open>n\<close> has security level \<open>n\<close>:\<close>

instantiation list :: (type)sec
begin

definition "sec(x :: 'a list) = length x"

instance ..

end

instantiation aexp::sec
begin
fun sec_aexp :: "aexp \<Rightarrow> level" where
"sec (N n) = 0" |
"sec (V x) = sec x" |
"sec (Plus a1 a2) = max (sec a1) (sec a2)"

instance ..

end

instantiation bexp :: sec
begin

fun sec_bexp :: "bexp \<Rightarrow> level" where
"sec (Bc v) = 0" |
"sec (Not b) = sec b" |
"sec (And b\<^sub>1 b\<^sub>2) = max (sec b\<^sub>1) (sec b\<^sub>2)" |
"sec (Less a\<^sub>1 a\<^sub>2) = max (sec a\<^sub>1) (sec a\<^sub>2)"

instance ..

end

abbreviation eq_le :: "state \<Rightarrow> state \<Rightarrow> level \<Rightarrow> bool" ("(_ = _ '(\<le> _'))" [51,51,0] 50) where
"s = s' (\<le> l) == (\<forall> x. sec x \<le> l \<longrightarrow> s x = s' x)"

abbreviation eq_less :: "state \<Rightarrow> state \<Rightarrow> level \<Rightarrow> bool" ("(_ = _ '(< _'))" [51,51,0] 50) where
"s = s' (< l) == (\<forall> x. sec x < l \<longrightarrow> s x = s' x)"

(* Lemma 9.9 (Noninterference for arithmetic expressions). *)
lemma aval_eq_if_eq_le:
  "\<lbrakk> s\<^sub>1 = s\<^sub>2 (\<le> l);  sec a \<le> l \<rbrakk> \<Longrightarrow> aval a s\<^sub>1 = aval a s\<^sub>2"
by (induct a) auto

(* Lemma 9.10 (Noninterference for boolean expressions). *)
lemma bval_eq_if_eq_le:
  "\<lbrakk> s\<^sub>1 = s\<^sub>2 (\<le> l);  sec b \<le> l \<rbrakk> \<Longrightarrow> bval b s\<^sub>1 = bval b s\<^sub>2"
  by (induct b) (auto simp add: aval_eq_if_eq_le)

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_sort_nat_QSortPermutes
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun lt :: "Nat => Nat => bool" where
  "lt y (Z) = False"
| "lt (Z) (S z2) = True"
| "lt (S n) (S z2) = lt n z2"

fun le :: "Nat => Nat => bool" where
  "le (Z) z = True"
| "le (S z2) (Z) = False"
| "le (S z2) (S x2) = le z2 x2"

fun gt :: "Nat => Nat => bool" where
  "gt y z = lt z y"

fun filter :: "('a => bool) => 'a list => 'a list" where
  "filter q (nil2) = nil2"
| "filter q (cons2 z xs) =
     (if q z then cons2 z (filter q xs) else filter q xs)"

(*fun did not finish the proof*)
function qsort :: "Nat list => Nat list" where
  "qsort (nil2) = nil2"
| "qsort (cons2 z xs) =
     x (qsort (filter (% (z2 :: Nat) => le z2 z) xs))
       (x (cons2 z (nil2))
          (qsort (filter (% (x2 :: Nat) => gt x2 z) xs)))"
  by pat_completeness auto

fun elem :: "'a => 'a list => bool" where
  "elem y (nil2) = False"
| "elem y (cons2 z2 xs) = ((z2 = y) | (elem y xs))"

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
  "deleteBy y z (nil2) = nil2"
| "deleteBy y z (cons2 y2 ys) =
     (if (y z) y2 then ys else cons2 y2 (deleteBy y z ys))"

fun isPermutation :: "'a list => 'a list => bool" where
  "isPermutation (nil2) (nil2) = True"
| "isPermutation (nil2) (cons2 z2 x2) = False"
| "isPermutation (cons2 x3 xs) z =
     ((elem x3 z) &
        (isPermutation
           xs (deleteBy (% (x4 :: 'a) => % (x5 :: 'a) => (x4 = x5)) x3 z)))"

theorem property0 :
  "isPermutation (qsort xs) xs"
  oops

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_regexp_Deeps
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype A = X | Y

datatype R
         = Nil | Eps | Atom "A" | Plus "R" "R" | Seq "R" "R" | Star "R"

fun seq :: "R => R => R" where
"seq x y =
   (case x of
      Nil => Nil
      | other =>
          (case y of
             Nil => Nil
             | other =>
                 (case x of
                    Eps => y
                    | other =>
                        (case y of
                           Eps => x
                           | other => Seq x y))))"

fun plus :: "R => R => R" where
"plus x y =
   (case x of
      Nil => y
      | other =>
          (case y of
             Nil => x
             | other => Plus x y))"

fun eqA :: "A => A => bool" where
"eqA (X) (X) = True"
| "eqA (X) (Y) = False"
| "eqA (Y) (X) = False"
| "eqA (Y) (Y) = True"

fun eps :: "R => bool" where
"eps x =
   (case x of
      Eps => True
      | Plus p q => ((eps p) | (eps q))
      | Seq r q2 => ((eps r) & (eps q2))
      | Star y => True
      | other => False)"

fun epsR :: "R => R" where
"epsR x = (if eps x then Eps else Nil)"

fun step :: "R => A => R" where
"step x y =
   (case x of
      Atom a => (if eqA a y then Eps else Nil)
      | Plus p q => plus (step p y) (step q y)
      | Seq r q2 => plus (seq (step r y) q2) (seq (epsR r) (step q2 y))
      | Star p2 => seq (step p2 y) x
      | other => Nil)"

fun recognise :: "R => A list => bool" where
"recognise x (nil2) = eps x"
| "recognise x (cons2 z xs) = recognise (step x z) xs"

fun deeps :: "R => R" where
"deeps (Nil) = Nil"
| "deeps (Eps) = Nil"
| "deeps (Atom a) = Atom a"
| "deeps (Plus p q) = Plus (deeps p) (deeps q)"
| "deeps (Seq r q2) =
     (if ((eps r) & (eps q2)) then Plus (deeps r) (deeps q2) else
        Seq r q2)"
| "deeps (Star p2) = deeps p2"

theorem property0 :
  "((recognise (Star p) s) = (recognise (Star (deeps p)) s))"
  oops

end


(*
    Author:     Wenda Li <wl302@cam.ac.uk / liwenda1990@hotmail.com>
*)

section \<open>Some useful lemmas in topology\<close>

theory Missing_Topology imports "HOL-Analysis.Multivariate_Analysis"
begin

subsection \<open>Misc\<close>

lemma open_times_image:
  fixes S::"'a::real_normed_field set"
  assumes "open S" "c\<noteq>0"
  shows "open (((*) c) ` S)"
proof -
  let ?f = "\<lambda>x. x/c" and ?g="((*) c)"
  have "continuous_on UNIV ?f" using \<open>c\<noteq>0\<close> by (auto intro:continuous_intros)
  then have "open (?f -` S)" using \<open>open S\<close> by (auto elim:open_vimage)
  moreover have "?g ` S = ?f -` S" using \<open>c\<noteq>0\<close>
    apply auto
    using image_iff by fastforce
  ultimately show ?thesis by auto
qed

lemma image_linear_greaterThan:
  fixes x::"'a::linordered_field"
  assumes "c\<noteq>0"
  shows "((\<lambda>x. c*x+b) ` {x<..}) = (if c>0 then {c*x+b <..} else {..< c*x+b})"
using \<open>c\<noteq>0\<close>
  apply (auto simp add:image_iff field_simps)
  subgoal for y by (rule bexI[where x="(y-b)/c"],auto simp add:field_simps)
  subgoal for y by (rule bexI[where x="(y-b)/c"],auto simp add:field_simps)
done

lemma image_linear_lessThan:
  fixes x::"'a::linordered_field"
  assumes "c\<noteq>0"
  shows "((\<lambda>x. c*x+b) ` {..<x}) = (if c>0 then {..<c*x+b} else {c*x+b<..})"
using \<open>c\<noteq>0\<close>
  apply (auto simp add:image_iff field_simps)
  subgoal for y by (rule bexI[where x="(y-b)/c"],auto simp add:field_simps)
  subgoal for y by (rule bexI[where x="(y-b)/c"],auto simp add:field_simps)
done

lemma continuous_on_neq_split:
  fixes f :: "'a::linear_continuum_topology \<Rightarrow> 'b::linorder_topology"
  assumes "\<forall>x\<in>s. f x\<noteq>y" "continuous_on s f" "connected s"
  shows "(\<forall>x\<in>s. f x>y) \<or> (\<forall>x\<in>s. f x<y)"
proof -
  { fix aa :: 'a and aaa :: 'a
    have "y \<notin> f ` s"
      using assms(1) by blast
    then have "(aa \<notin> s \<or> y < f aa) \<or> aaa \<notin> s \<or> f aaa < y"
      by (meson Topological_Spaces.connected_continuous_image assms(2) assms(3)
          connectedD_interval image_eqI linorder_not_le) }
  then show ?thesis
    by blast
qed

lemma
  fixes f::"'a::linorder_topology \<Rightarrow> 'b::topological_space"
  assumes "continuous_on {a..b} f" "a<b"
  shows continuous_on_at_left:"continuous (at_left b) f"
    and continuous_on_at_right:"continuous (at_right a) f"
proof -
  have "at b within {..a} = bot"
  proof -
    have "closed {..a}" by auto
    then have "closure ({..a} - {b}) = {..a}" by (simp add: assms(2) not_le)
    then have "b\<notin>closure ({..a} - {b})" using \<open>a<b\<close> by auto
    then show ?thesis using at_within_eq_bot_iff by auto
  qed
  then have "(f \<longlongrightarrow> f b) (at b within {..a})" by auto
  moreover have "(f \<longlongrightarrow> f b) (at b within {a..b})"
    using assms unfolding continuous_on by auto
  moreover have "{..a} \<union> {a..b} = {..b}"
    using \<open>a<b\<close> by auto
  ultimately have "(f \<longlongrightarrow> f b) (at b within {..b})"
    using Lim_Un[of f "f b" b "{..a}" "{a..b}"] by presburger
  then have "(f \<longlongrightarrow> f b) (at b within {..<b})"
    apply (elim tendsto_within_subset)
    by auto
  then show "continuous (at_left b) f" using continuous_within by auto
next
  have "at a within {b..} = bot"
  proof -
    have "closed {b..}" by auto
    then have "closure ({b..} - {a}) = {b..}" by (simp add: assms(2) not_le)
    then have "a\<notin>closure ({b..} - {a})" using \<open>a<b\<close> by auto
    then show ?thesis using at_within_eq_bot_iff by auto
  qed
  then have "(f \<longlongrightarrow> f a) (at a within {b..})" by auto
  moreover have "(f \<longlongrightarrow> f a) (at a within {a..b})"
    using assms unfolding continuous_on by auto
  moreover have "{b..} \<union> {a..b} = {a..}"
    using \<open>a<b\<close> by auto
  ultimately have "(f \<longlongrightarrow> f a) (at a within {a..})"
    using Lim_Un[of f "f a" a "{b..}" "{a..b}"] by presburger
  then have "(f \<longlongrightarrow> f a) (at a within {a<..})"
    apply (elim tendsto_within_subset)
    by auto
  then show "continuous (at_right a) f" using continuous_within by auto
qed

subsection \<open>More about @{term eventually}\<close>

lemma eventually_comp_filtermap:
    "eventually (P o f) F \<longleftrightarrow> eventually P (filtermap f F)"
  unfolding comp_def using eventually_filtermap by auto

lemma eventually_uminus_at_top_at_bot:
  fixes P::"'a::{ordered_ab_group_add,linorder} \<Rightarrow> bool"
  shows "eventually (P o uminus) at_bot \<longleftrightarrow> eventually P at_top"
    "eventually (P o uminus) at_top \<longleftrightarrow> eventually P at_bot"
  unfolding eventually_comp_filtermap
  by (fold at_top_mirror at_bot_mirror,auto)

lemma eventually_at_infinityI:
  fixes P::"'a::real_normed_vector \<Rightarrow> bool"
  assumes "\<And>x. c \<le> norm x \<Longrightarrow> P x"
  shows "eventually P at_infinity"
unfolding eventually_at_infinity using assms by auto

lemma eventually_at_bot_linorderI:
  fixes c::"'a::linorder"
  assumes "\<And>x. x \<le> c \<Longrightarrow> P x"
  shows "eventually P at_bot"
  using assms by (auto simp: eventually_at_bot_linorder)

lemma eventually_times_inverse_1:
  fixes f::"'a \<Rightarrow> 'b::{field,t2_space}"
  assumes "(f \<longlongrightarrow> c) F" "c\<noteq>0"
  shows "\<forall>\<^sub>F x in F. inverse (f x) * f x = 1"
proof -
  have "\<forall>\<^sub>F x in F. f x\<noteq>0"
    using assms tendsto_imp_eventually_ne by blast
  then show ?thesis
    apply (elim eventually_mono)
    by auto
qed

subsection \<open>More about @{term filtermap}\<close>

lemma filtermap_linear_at_within:
  assumes "bij f" and cont: "isCont f a" and open_map: "\<And>S. open S \<Longrightarrow> open (f`S)"
  shows "filtermap f (at a within S) = at (f a) within f`S"
  unfolding filter_eq_iff
proof safe
  fix P
  assume "eventually P (filtermap f (at a within S))"
  then obtain T where "open T" "a \<in> T" and impP:"\<forall>x\<in>T. x\<noteq>a \<longrightarrow> x\<in>S\<longrightarrow> P (f x)"
    by (auto simp: eventually_filtermap eventually_at_topological)
  then show "eventually P (at (f a) within f ` S)"
    unfolding eventually_at_topological
    apply (intro exI[of _ "f`T"])
    using \<open>bij f\<close> open_map by (metis bij_pointE imageE imageI)
next
  fix P
  assume "eventually P (at (f a) within f ` S)"
  then obtain T1 where "open T1" "f a \<in> T1" and impP:"\<forall>x\<in>T1. x\<noteq>f a \<longrightarrow> x\<in>f`S\<longrightarrow> P (x)"
    unfolding eventually_at_topological by auto
  then obtain T2 where "open T2" "a \<in> T2" "(\<forall>x'\<in>T2. f x' \<in> T1)"
    using cont[unfolded continuous_at_open,rule_format,of T1] by blast
  then have "\<forall>x\<in>T2. x\<noteq>a \<longrightarrow> x\<in>S\<longrightarrow> P (f x)"
    using impP by (metis assms(1) bij_pointE imageI)
  then show "eventually P (filtermap f (at a within S))"
    unfolding eventually_filtermap eventually_at_topological
    apply (intro exI[of _ T2])
    using \<open>open T2\<close> \<open>a \<in> T2\<close> by auto
qed

lemma filtermap_at_bot_linear_eq:
  fixes c::"'a::linordered_field"
  assumes "c\<noteq>0"
  shows "filtermap (\<lambda>x. x * c + b) at_bot = (if c>0 then at_bot else at_top)"
proof (cases "c>0")
  case True
  then have "filtermap (\<lambda>x. x * c + b) at_bot = at_bot"
    apply (intro filtermap_fun_inverse[of "\<lambda>x. (x-b) / c"])
    subgoal unfolding eventually_at_bot_linorder filterlim_at_bot
      by (auto simp add: field_simps)
    subgoal unfolding eventually_at_bot_linorder filterlim_at_bot
      by (metis mult.commute real_affinity_le)
    by auto
  then show ?thesis using \<open>c>0\<close> by auto
next
  case False
  then have "c<0" using \<open>c\<noteq>0\<close> by auto
  then have "filtermap (\<lambda>x. x * c + b) at_bot = at_top"
    apply (intro filtermap_fun_inverse[of "\<lambda>x. (x-b) / c"])
    subgoal unfolding eventually_at_top_linorder filterlim_at_bot
      by (meson le_diff_eq neg_divide_le_eq)
    subgoal unfolding eventually_at_bot_linorder filterlim_at_top
      using \<open>c < 0\<close> by (meson False diff_le_eq le_divide_eq)
    by auto
  then show ?thesis using \<open>c<0\<close> by auto
qed

lemma filtermap_linear_at_left:
  fixes c::"'a::{linordered_field,linorder_topology,real_normed_field}"
  assumes "c\<noteq>0"
  shows "filtermap (\<lambda>x. c*x+b) (at_left x) = (if c>0 then at_left (c*x+b) else at_right (c*x+b))"
proof -
  let ?f = "\<lambda>x. c*x+b"
  have "filtermap (\<lambda>x. c*x+b) (at_left x) = (at (?f x) within ?f ` {..<x})"
  proof (subst filtermap_linear_at_within)
    show "bij ?f" using \<open>c\<noteq>0\<close>
      by (auto intro!: o_bij[of "\<lambda>x. (x-b)/c"])
    show "isCont ?f x" by auto
    show "\<And>S. open S \<Longrightarrow> open (?f ` S)"
      using open_times_image[OF _ \<open>c\<noteq>0\<close>,THEN open_translation,of _ b]
      by (simp add:image_image add.commute)
    show "at (?f x) within ?f ` {..<x} = at (?f x) within ?f ` {..<x}" by simp
  qed
  moreover have "?f ` {..<x} =  {..<?f x}" when "c>0"
    using image_linear_lessThan[OF \<open>c\<noteq>0\<close>,of b x] that by auto
  moreover have "?f ` {..<x} =  {?f x<..}" when "\<not> c>0"
    using image_linear_lessThan[OF \<open>c\<noteq>0\<close>,of b x] that by auto
  ultimately show ?thesis by auto
qed

lemma filtermap_linear_at_right:
  fixes c::"'a::{linordered_field,linorder_topology,real_normed_field}"
  assumes "c\<noteq>0"
  shows "filtermap (\<lambda>x. c*x+b) (at_right x) = (if c>0 then at_right (c*x+b) else at_left (c*x+b))"
proof -
  let ?f = "\<lambda>x. c*x+b"
  have "filtermap ?f (at_right x) = (at (?f x) within ?f ` {x<..})"
  proof (subst filtermap_linear_at_within)
    show "bij ?f" using \<open>c\<noteq>0\<close>
      by (auto intro!: o_bij[of "\<lambda>x. (x-b)/c"])
    show "isCont ?f x" by auto
    show "\<And>S. open S \<Longrightarrow> open (?f ` S)"
      using open_times_image[OF _ \<open>c\<noteq>0\<close>,THEN open_translation,of _ b]
      by (simp add:image_image add.commute)
    show "at (?f x) within ?f ` {x<..} = at (?f x) within ?f ` {x<..}" by simp
  qed
  moreover have "?f ` {x<..} =  {?f x<..}" when "c>0"
    using image_linear_greaterThan[OF \<open>c\<noteq>0\<close>,of b x] that by auto
  moreover have "?f ` {x<..} =  {..<?f x}" when "\<not> c>0"
    using image_linear_greaterThan[OF \<open>c\<noteq>0\<close>,of b x] that by auto
  ultimately show ?thesis by auto
qed

lemma filtermap_at_top_linear_eq:
  fixes c::"'a::linordered_field"
  assumes "c\<noteq>0"
  shows "filtermap (\<lambda>x. x * c + b) at_top = (if c>0 then at_top else at_bot)"
proof (cases "c>0")
  case True
  then have "filtermap (\<lambda>x. x * c + b) at_top = at_top"
    apply (intro filtermap_fun_inverse[of "\<lambda>x. (x-b) / c"])
    subgoal unfolding eventually_at_top_linorder filterlim_at_top
      by (meson le_diff_eq pos_le_divide_eq)
    subgoal unfolding eventually_at_top_linorder filterlim_at_top
      apply auto
      by (metis mult.commute real_le_affinity)
    by auto
  then show ?thesis using \<open>c>0\<close> by auto
next
  case False
  then have "c<0" using \<open>c\<noteq>0\<close> by auto
  then have "filtermap (\<lambda>x. x * c + b) at_top = at_bot"
    apply (intro filtermap_fun_inverse[of "\<lambda>x. (x-b) / c"])
    subgoal unfolding eventually_at_bot_linorder filterlim_at_top
      by (auto simp add: field_simps)
    subgoal unfolding eventually_at_top_linorder filterlim_at_bot
      by (meson le_diff_eq neg_divide_le_eq)
    by auto
  then show ?thesis using \<open>c<0\<close> by auto
qed

lemma filtermap_nhds_open_map:
  assumes cont: "isCont f a"
    and open_map: "\<And>S. open S \<Longrightarrow> open (f`S)"
  shows "filtermap f (nhds a) = nhds (f a)"
  unfolding filter_eq_iff
proof safe
  fix P
  assume "eventually P (filtermap f (nhds a))"
  then obtain S where "open S" "a \<in> S" "\<forall>x\<in>S. P (f x)"
    by (auto simp: eventually_filtermap eventually_nhds)
  then show "eventually P (nhds (f a))"
    unfolding eventually_nhds
    apply (intro exI[of _ "f`S"])
    by (auto intro!: open_map)
qed (metis filterlim_iff tendsto_at_iff_tendsto_nhds isCont_def eventually_filtermap cont)

subsection \<open>More about @{term filterlim}\<close>

lemma filterlim_at_infinity_times:
  fixes f :: "'a \<Rightarrow> 'b::real_normed_field"
  assumes "filterlim f at_infinity F" "filterlim g at_infinity F"
  shows "filterlim (\<lambda>x. f x * g x) at_infinity F"
proof -
  have "((\<lambda>x. inverse (f x) * inverse (g x)) \<longlongrightarrow> 0 * 0) F"
    by (intro tendsto_mult tendsto_inverse assms filterlim_compose[OF tendsto_inverse_0])
  then have "filterlim (\<lambda>x. inverse (f x) * inverse (g x)) (at 0) F"
    unfolding filterlim_at using assms
    by (auto intro: filterlim_at_infinity_imp_eventually_ne tendsto_imp_eventually_ne eventually_conj)
  then show ?thesis
    by (subst filterlim_inverse_at_iff[symmetric]) simp_all
qed

lemma filterlim_at_top_at_bot[elim]:
  fixes f::"'a \<Rightarrow> 'b::unbounded_dense_linorder" and F::"'a filter"
  assumes top:"filterlim f at_top F" and bot: "filterlim f at_bot F" and "F\<noteq>bot"
  shows False
proof -
  obtain c::'b where True by auto
  have "\<forall>\<^sub>F x in F. c < f x"
    using top unfolding filterlim_at_top_dense by auto
  moreover have "\<forall>\<^sub>F x in F. f x < c"
    using bot unfolding filterlim_at_bot_dense by auto
  ultimately have "\<forall>\<^sub>F x in F. c < f x \<and> f x < c"
    using eventually_conj by auto
  then have "\<forall>\<^sub>F x in F. False" by (auto elim:eventually_mono)
  then show False using \<open>F\<noteq>bot\<close> by auto
qed

lemma filterlim_at_top_nhds[elim]:
  fixes f::"'a \<Rightarrow> 'b::{unbounded_dense_linorder,order_topology}" and F::"'a filter"
  assumes top:"filterlim f at_top F" and tendsto: "(f \<longlongrightarrow> c) F" and "F\<noteq>bot"
  shows False
proof -
  obtain c'::'b where "c'>c" using gt_ex by blast
  have "\<forall>\<^sub>F x in F. c' < f x"
    using top unfolding filterlim_at_top_dense by auto
  moreover have "\<forall>\<^sub>F x in F. f x < c'"
    using order_tendstoD[OF tendsto,of c'] \<open>c'>c\<close> by auto
  ultimately have "\<forall>\<^sub>F x in F. c' < f x \<and> f x < c'"
    using eventually_conj by auto
  then have "\<forall>\<^sub>F x in F. False" by (auto elim:eventually_mono)
  then show False using \<open>F\<noteq>bot\<close> by auto
qed

lemma filterlim_at_bot_nhds[elim]:
  fixes f::"'a \<Rightarrow> 'b::{unbounded_dense_linorder,order_topology}" and F::"'a filter"
  assumes top:"filterlim f at_bot F" and tendsto: "(f \<longlongrightarrow> c) F" and "F\<noteq>bot"
  shows False
proof -
  obtain c'::'b where "c'<c" using lt_ex by blast
  have "\<forall>\<^sub>F x in F. c' > f x"
    using top unfolding filterlim_at_bot_dense by auto
  moreover have "\<forall>\<^sub>F x in F. f x > c'"
    using order_tendstoD[OF tendsto,of c'] \<open>c'<c\<close> by auto
  ultimately have "\<forall>\<^sub>F x in F. c' < f x \<and> f x < c'"
    using eventually_conj by auto
  then have "\<forall>\<^sub>F x in F. False" by (auto elim:eventually_mono)
  then show False using \<open>F\<noteq>bot\<close> by auto
qed

lemma filterlim_at_top_linear_iff:
  fixes f::"'a::linordered_field \<Rightarrow> 'b"
  assumes "c\<noteq>0"
  shows "(LIM x at_top. f (x * c + b) :> F2) \<longleftrightarrow> (if c>0 then (LIM x at_top. f x :> F2)
            else (LIM x at_bot. f x :> F2))"
  unfolding filterlim_def
  apply (subst filtermap_filtermap[of f "\<lambda>x. x * c + b",symmetric])
  using assms by (auto simp add:filtermap_at_top_linear_eq)

lemma filterlim_at_bot_linear_iff:
  fixes f::"'a::linordered_field \<Rightarrow> 'b"
  assumes "c\<noteq>0"
  shows "(LIM x at_bot. f (x * c + b) :> F2) \<longleftrightarrow> (if c>0 then (LIM x at_bot. f x :> F2)
            else (LIM x at_top. f x :> F2)) "
  unfolding filterlim_def
  apply (subst filtermap_filtermap[of f "\<lambda>x. x * c + b",symmetric])
  using assms by (auto simp add:filtermap_at_bot_linear_eq)

lemma filterlim_tendsto_add_at_top_iff:
  assumes f: "(f \<longlongrightarrow> c) F"
  shows "(LIM x F. (f x + g x :: real) :> at_top) \<longleftrightarrow> (LIM x F. g x :> at_top)"
proof
  assume "LIM x F. f x + g x :> at_top"
  moreover have "((\<lambda>x. - f x) \<longlongrightarrow> - c) F"
    using f by (intro tendsto_intros,simp)
  ultimately show "filterlim g at_top F" using filterlim_tendsto_add_at_top
    by fastforce
qed (auto simp add:filterlim_tendsto_add_at_top[OF f])

lemma filterlim_tendsto_add_at_bot_iff:
  fixes c::real
  assumes f: "(f \<longlongrightarrow> c) F"
  shows "(LIM x F. f x + g x :> at_bot) \<longleftrightarrow> (LIM x F. g x :> at_bot)"
proof -
  have "(LIM x F. f x + g x :> at_bot)
        \<longleftrightarrow>  (LIM x F. - f x + (- g x)  :> at_top)"
    apply (subst filterlim_uminus_at_top)
    by (rule filterlim_cong,auto)
  also have "... = (LIM x F. - g x  :> at_top)"
    apply (subst filterlim_tendsto_add_at_top_iff[of _ "-c"])
    by (auto intro:tendsto_intros simp add:f)
  also have "... = (LIM x F. g x  :> at_bot)"
    apply (subst filterlim_uminus_at_top)
    by (rule filterlim_cong,auto)
  finally show ?thesis .
qed

lemma tendsto_inverse_0_at_infinity:
    "LIM x F. f x :> at_infinity \<Longrightarrow> ((\<lambda>x. inverse (f x) :: real) \<longlongrightarrow> 0) F"
  by (metis filterlim_at filterlim_inverse_at_iff)

lemma filterlim_at_infinity_divide_iff:
  fixes f::"'a \<Rightarrow> 'b::real_normed_field"
  assumes "(f \<longlongrightarrow> c) F" "c\<noteq>0"
  shows "(LIM x F. f x / g x :> at_infinity) \<longleftrightarrow> (LIM x F. g x :> at 0)"
proof
  assume asm:"LIM x F. f x / g x :> at_infinity"
  have "LIM x F. inverse (f x) * (f x / g x) :> at_infinity"
    apply (rule tendsto_mult_filterlim_at_infinity[of _ "inverse c", OF _ _ asm])
    by (auto simp add: assms(1) assms(2) tendsto_inverse)
  then have "LIM x F. inverse (g x) :> at_infinity"
    apply (elim filterlim_mono_eventually)
    using eventually_times_inverse_1[OF assms]
    by (auto elim:eventually_mono simp add:field_simps)
  then show "filterlim g (at 0) F" using filterlim_inverse_at_iff[symmetric] by force
next
  assume "filterlim g (at 0) F"
  then have "filterlim (\<lambda>x. inverse (g x)) at_infinity F"
    using filterlim_compose filterlim_inverse_at_infinity by blast
  then have "LIM x F. f x * inverse (g x) :> at_infinity"
    using tendsto_mult_filterlim_at_infinity[OF assms, of "\<lambda>x. inverse(g x)"]
    by simp
  then show "LIM x F. f x / g x :> at_infinity" by (simp add: divide_inverse)
qed

lemma filterlim_tendsto_pos_mult_at_top_iff:
  fixes f::"'a \<Rightarrow> real"
  assumes "(f \<longlongrightarrow> c) F" and "0 < c"
  shows "(LIM x F. (f x * g x) :> at_top) \<longleftrightarrow> (LIM x F. g x :> at_top)"
proof
  assume "filterlim g at_top F"
  then show "LIM x F. f x * g x :> at_top"
    using filterlim_tendsto_pos_mult_at_top[OF assms] by auto
next
  assume asm:"LIM x F. f x * g x :> at_top"
  have "((\<lambda>x. inverse (f x)) \<longlongrightarrow> inverse c) F"
    using tendsto_inverse[OF assms(1)] \<open>0<c\<close> by auto
  moreover have "inverse c >0" using assms(2) by auto
  ultimately have "LIM x F. inverse (f x) * (f x * g x) :> at_top"
    using filterlim_tendsto_pos_mult_at_top[OF _ _ asm,of "\<lambda>x. inverse (f x)" "inverse c"] by auto
  then show "LIM x F. g x :> at_top"
    apply (elim filterlim_mono_eventually)
      apply simp_all[2]
    using eventually_times_inverse_1[OF assms(1)] \<open>c>0\<close> eventually_mono by fastforce
qed

lemma filterlim_tendsto_pos_mult_at_bot_iff:
  fixes c :: real
  assumes "(f \<longlongrightarrow> c) F" "0 < c"
  shows "(LIM x F. f x * g x :> at_bot) \<longleftrightarrow> filterlim g at_bot F"
  using filterlim_tendsto_pos_mult_at_top_iff[OF assms(1,2), of "\<lambda>x. - g x"]
  unfolding filterlim_uminus_at_bot by simp

lemma filterlim_tendsto_neg_mult_at_top_iff:
  fixes f::"'a \<Rightarrow> real"
  assumes "(f \<longlongrightarrow> c) F" and "c < 0"
  shows "(LIM x F. (f x * g x) :> at_top) \<longleftrightarrow> (LIM x F. g x :> at_bot)"
proof -
  have "(LIM x F. f x * g x :> at_top) = (LIM x F. - g x :> at_top)"
    apply (rule filterlim_tendsto_pos_mult_at_top_iff[of "\<lambda>x. - f x" "-c" F "\<lambda>x. - g x", simplified])
    using assms by (auto intro: tendsto_intros )
  also have "... = (LIM x F. g x :> at_bot)"
    using filterlim_uminus_at_bot[symmetric] by auto
  finally show ?thesis .
qed

lemma filterlim_tendsto_neg_mult_at_bot_iff:
  fixes c :: real
  assumes "(f \<longlongrightarrow> c) F" "0 > c"
  shows "(LIM x F. f x * g x :> at_bot) \<longleftrightarrow> filterlim g at_top F"
  using filterlim_tendsto_neg_mult_at_top_iff[OF assms(1,2), of "\<lambda>x. - g x"]
  unfolding filterlim_uminus_at_top by simp

lemma Lim_add:
  fixes f g::"_ \<Rightarrow> 'a::{t2_space,topological_monoid_add}"
  assumes "\<exists>y. (f \<longlongrightarrow> y) F" and "\<exists>y. (g \<longlongrightarrow> y) F" and "F\<noteq>bot"
  shows "Lim F f + Lim F g = Lim F (\<lambda>x. f x+g x)"
  apply (rule tendsto_Lim[OF \<open>F\<noteq>bot\<close>, symmetric])
  apply (auto intro!:tendsto_eq_intros)
  using assms tendsto_Lim by blast+

(*
lemma filterlim_at_top_tendsto[elim]:
  fixes f::"'a \<Rightarrow> 'b::{unbounded_dense_linorder,order_topology}" and F::"'a filter"
  assumes top:"filterlim f at_top F" and tendsto: "(f \<longlongrightarrow> c) F"
          and "F\<noteq>bot"
  shows False
proof -
  obtain cc where "cc>c" using gt_ex by blast
  have "\<forall>\<^sub>F x in F. cc < f x"
    using top unfolding filterlim_at_top_dense by auto
  moreover have "\<forall>\<^sub>F x in F. f x < cc"
    using tendsto order_tendstoD(2)[OF _ \<open>cc>c\<close>] by auto
  ultimately have "\<forall>\<^sub>F x in F. cc < f x \<and> f x < cc"
    using eventually_conj by auto
  then have "\<forall>\<^sub>F x in F. False" by (auto elim:eventually_mono)
  then show False using \<open>F\<noteq>bot\<close> by auto
qed

lemma filterlim_at_bot_tendsto[elim]:
  fixes f::"'a \<Rightarrow> 'b::{unbounded_dense_linorder,order_topology}" and F::"'a filter"
  assumes top:"filterlim f at_bot F" and tendsto: "(f \<longlongrightarrow> c) F"
          and "F\<noteq>bot"
  shows False
proof -
  obtain cc where "cc<c" using lt_ex by blast
  have "\<forall>\<^sub>F x in F. cc > f x"
    using top unfolding filterlim_at_bot_dense by auto
  moreover have "\<forall>\<^sub>F x in F. f x > cc"
    using tendsto order_tendstoD(1)[OF _ \<open>cc<c\<close>] by auto
  ultimately have "\<forall>\<^sub>F x in F. cc < f x \<and> f x < cc"
    using eventually_conj by auto
  then have "\<forall>\<^sub>F x in F. False" by (auto elim:eventually_mono)
  then show False using \<open>F\<noteq>bot\<close> by auto
qed
*)

subsection \<open>Isolate and discrete\<close>

definition (in topological_space) isolate:: "'a \<Rightarrow> 'a set \<Rightarrow> bool"  (infixr "isolate" 60)
  where "x isolate S \<longleftrightarrow> (x\<in>S \<and> (\<exists>T. open T \<and> T \<inter> S = {x}))"

definition (in topological_space) discrete:: "'a set \<Rightarrow> bool"
  where "discrete S \<longleftrightarrow> (\<forall>x\<in>S. x isolate S)"

definition (in metric_space) uniform_discrete :: "'a set \<Rightarrow> bool" where
  "uniform_discrete S \<longleftrightarrow> (\<exists>e>0. \<forall>x\<in>S. \<forall>y\<in>S. dist x y < e \<longrightarrow> x = y)"

lemma uniformI1:
  assumes "e>0" "\<And>x y. \<lbrakk>x\<in>S;y\<in>S;dist x y<e\<rbrakk> \<Longrightarrow> x =y "
  shows "uniform_discrete S"
unfolding uniform_discrete_def using assms by auto

lemma uniformI2:
  assumes "e>0" "\<And>x y. \<lbrakk>x\<in>S;y\<in>S;x\<noteq>y\<rbrakk> \<Longrightarrow> dist x y\<ge>e "
  shows "uniform_discrete S"
unfolding uniform_discrete_def using assms not_less by blast

lemma isolate_islimpt_iff:"(x isolate S) \<longleftrightarrow> (\<not> (x islimpt S) \<and> x\<in>S)"
  unfolding isolate_def islimpt_def by auto

lemma isolate_dist_Ex_iff:
  fixes x::"'a::metric_space"
  shows "x isolate S \<longleftrightarrow> (x\<in>S \<and> (\<exists>e>0. \<forall>y\<in>S. dist x y < e \<longrightarrow> y=x))"
unfolding isolate_islimpt_iff islimpt_approachable by (metis dist_commute)

lemma discrete_empty[simp]: "discrete {}"
  unfolding discrete_def by auto

lemma uniform_discrete_empty[simp]: "uniform_discrete {}"
  unfolding uniform_discrete_def by (simp add: gt_ex)

lemma isolate_insert:
  fixes x :: "'a::t1_space"
  shows "x isolate (insert a S) \<longleftrightarrow> x isolate S \<or> (x=a \<and> \<not> (x islimpt S))"
by (meson insert_iff islimpt_insert isolate_islimpt_iff)

(*
TODO.
Other than

  uniform_discrete S \<longrightarrow> discrete S
  uniform_discrete S \<longrightarrow> closed S

, we should be able to prove

  discrete S \<and> closed S \<longrightarrow> uniform_discrete S

but the proof (based on Tietze Extension Theorem) seems not very trivial to me. Informal proofs can be found in

http://topology.auburn.edu/tp/reprints/v30/tp30120.pdf
http://msp.org/pjm/1959/9-2/pjm-v9-n2-p19-s.pdf
*)

lemma uniform_discrete_imp_closed:
  "uniform_discrete S \<Longrightarrow> closed S"
  by (meson discrete_imp_closed uniform_discrete_def)

lemma uniform_discrete_imp_discrete:
  "uniform_discrete S \<Longrightarrow> discrete S"
  by (metis discrete_def isolate_dist_Ex_iff uniform_discrete_def)

lemma isolate_subset:"x isolate S \<Longrightarrow> T \<subseteq> S \<Longrightarrow> x\<in>T \<Longrightarrow> x isolate T"
  unfolding isolate_def by fastforce

lemma discrete_subset[elim]: "discrete S \<Longrightarrow> T \<subseteq> S \<Longrightarrow> discrete T"
  unfolding discrete_def using islimpt_subset isolate_islimpt_iff by blast

lemma uniform_discrete_subset[elim]: "uniform_discrete S \<Longrightarrow> T \<subseteq> S \<Longrightarrow> uniform_discrete T"
  by (meson subsetD uniform_discrete_def)

lemma continuous_on_discrete: "discrete S \<Longrightarrow> continuous_on S f"
  unfolding continuous_on_topological by (metis discrete_def islimptI isolate_islimpt_iff)

(* Is euclidean_space really necessary?*)
lemma uniform_discrete_insert:
  fixes S :: "'a::euclidean_space set"
  shows "uniform_discrete (insert a S) \<longleftrightarrow> uniform_discrete S"
proof
  assume asm:"uniform_discrete S"
  let ?thesis = "uniform_discrete (insert a S)"
  have ?thesis when "a\<in>S" using that asm by (simp add: insert_absorb)
  moreover have ?thesis when "S={}" using that asm by (simp add: uniform_discrete_def)
  moreover have ?thesis when "a\<notin>S" "S\<noteq>{}"
  proof -
    obtain e1 where "e1>0" and e1_dist:"\<forall>x\<in>S. \<forall>y\<in>S. dist y x < e1 \<longrightarrow> y = x"
      using asm unfolding uniform_discrete_def by auto
    define e2 where "e2 \<equiv> min (setdist {a} S) e1"
    have "closed S" using asm uniform_discrete_imp_closed by auto
    then have "e2>0" by (simp add: \<open>0 < e1\<close> e2_def setdist_gt_0_compact_closed that(1) that(2))
    moreover have "x = y" when "x\<in>insert a S" "y\<in>insert a S" "dist x y < e2 " for x y
    proof -
      have ?thesis when "x=a" "y=a" using that by auto
      moreover have ?thesis when "x=a" "y\<in>S"
        using that setdist_le_dist[of x "{a}" y S] \<open>dist x y < e2\<close> unfolding e2_def
        by fastforce
      moreover have ?thesis when "y=a" "x\<in>S"
        using that setdist_le_dist[of y "{a}" x S] \<open>dist x y < e2\<close> unfolding e2_def
        by (simp add: dist_commute)
      moreover have ?thesis when "x\<in>S" "y\<in>S"
        using e1_dist[rule_format, OF that] \<open>dist x y < e2\<close> unfolding e2_def
        by (simp add: dist_commute)
      ultimately show ?thesis using that by auto
    qed
    ultimately show ?thesis unfolding uniform_discrete_def by meson
  qed
  ultimately show ?thesis by auto
qed (simp add: subset_insertI uniform_discrete_subset)

lemma discrete_compact_finite_iff:
  fixes S :: "'a::t1_space set"
  shows "discrete S \<and> compact S \<longleftrightarrow> finite S"
proof
  assume "finite S"
  then have "compact S" using finite_imp_compact by auto
  moreover have "discrete S"
    unfolding discrete_def using isolate_islimpt_iff islimpt_finite[OF \<open>finite S\<close>] by auto
  ultimately show "discrete S \<and> compact S" by auto
next
  assume "discrete S \<and> compact S"
  then show "finite S"
    by (meson discrete_def Heine_Borel_imp_Bolzano_Weierstrass isolate_islimpt_iff order_refl)
qed

lemma uniform_discrete_finite_iff:
  fixes S :: "'a::heine_borel set"
  shows "uniform_discrete S \<and> bounded S \<longleftrightarrow> finite S"
proof
  assume "uniform_discrete S \<and> bounded S"
  then have "discrete S" "compact S"
    using uniform_discrete_imp_discrete uniform_discrete_imp_closed compact_eq_bounded_closed
    by auto
  then show "finite S" using discrete_compact_finite_iff by auto
next
  assume asm:"finite S"
  let ?thesis = "uniform_discrete S \<and> bounded S"
  have ?thesis when "S={}" using that by auto
  moreover have ?thesis when "S\<noteq>{}"
  proof -
    have "\<forall>x. \<exists>d>0. \<forall>y\<in>S. y \<noteq> x \<longrightarrow> d \<le> dist x y"
      using finite_set_avoid[OF \<open>finite S\<close>] by auto
    then obtain f where f_pos:"f x>0"
        and f_dist: "\<forall>y\<in>S. y \<noteq> x \<longrightarrow> f x \<le> dist x y"
        if "x\<in>S" for x
      by metis
    define f_min where "f_min \<equiv> Min (f ` S)"
    have "f_min > 0"
      unfolding f_min_def
      by (simp add: asm f_pos that)
    moreover have "\<forall>x\<in>S. \<forall>y\<in>S. f_min > dist x y \<longrightarrow> x=y"
      using f_dist unfolding f_min_def
      by (metis Min_gr_iff all_not_in_conv asm dual_order.irrefl eq_iff finite_imageI imageI
          less_eq_real_def)
    ultimately have "uniform_discrete S"
      unfolding uniform_discrete_def by auto
    moreover have "bounded S" using \<open>finite S\<close> by auto
    ultimately show ?thesis by auto
  qed
  ultimately show ?thesis by blast
qed

lemma uniform_discrete_image_scale:
  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  assumes "uniform_discrete S" and dist:"\<forall>x\<in>S. \<forall>y\<in>S. dist x y = c * dist (f x) (f y)"
  shows "uniform_discrete (f ` S)"
proof -
  have ?thesis when "S={}" using that by auto
  moreover have ?thesis when "S\<noteq>{}" "c\<le>0"
  proof -
    obtain x1 where "x1\<in>S" using \<open>S\<noteq>{}\<close> by auto
    have ?thesis when "S-{x1} = {}"
    proof -
      have "S={x1}" using that \<open>S\<noteq>{}\<close> by auto
      then show ?thesis using uniform_discrete_insert[of "f x1"] by auto
    qed
    moreover have ?thesis when "S-{x1} \<noteq> {}"
    proof -
      obtain x2 where "x2\<in>S-{x1}" using \<open>S-{x1} \<noteq> {}\<close> by auto
      then have "x2\<in>S" "x1\<noteq>x2" by auto
      then have "dist x1 x2 > 0" by auto
      moreover have "dist x1 x2 = c * dist (f x1) (f x2)"
        using dist[rule_format, OF \<open>x1\<in>S\<close> \<open>x2\<in>S\<close>] .
      moreover have "dist (f x2) (f x2) \<ge> 0" by auto
      ultimately have False using \<open>c\<le>0\<close> by (simp add: zero_less_mult_iff)
      then show ?thesis by auto
    qed
    ultimately show ?thesis by auto
  qed
  moreover have ?thesis when "S\<noteq>{}" "c>0"
  proof -
    obtain e1 where "e1>0" and e1_dist:"\<forall>x\<in>S. \<forall>y\<in>S. dist y x < e1 \<longrightarrow> y = x"
      using \<open>uniform_discrete S\<close> unfolding uniform_discrete_def by auto
    define e where "e= e1/c"
    have "x1 = x2" when "x1\<in> f ` S" "x2\<in> f ` S" "dist x1 x2 < e " for x1 x2
    proof -
      obtain y1 where y1:"y1\<in>S" "x1=f y1" using \<open>x1\<in> f ` S\<close> by auto
      obtain y2 where y2:"y2\<in>S" "x2=f y2" using \<open>x2\<in> f ` S\<close> by auto
      have "dist y1 y2 < e1"
        using dist[rule_format, OF y1(1) y2(1)] \<open>c>0\<close> \<open>dist x1 x2 < e\<close> unfolding e_def
        apply (fold y1(2) y2(2))
        by (auto simp add:divide_simps mult.commute)
      then have "y1=y2"
        using e1_dist[rule_format, OF y2(1) y1(1)] by simp
      then show "x1=x2" using y1(2) y2(2) by auto
    qed
    moreover have "e>0" using \<open>e1>0\<close> \<open>c>0\<close> unfolding e_def by auto
    ultimately show ?thesis unfolding uniform_discrete_def by meson
  qed
  ultimately show ?thesis by fastforce
qed

end


theory HybridSCInduct imports Main
begin

datatype 'a form =
  Pro 'a |
  Nom nat |
  Neg "'a form" |
  Con "'a form" "'a form" |
  Sat nat "'a form" (\<open>@\<close> 210) |
  Pos "'a form" (\<open>\<diamond>\<close> 220)

primrec replace_form where
  \<open>replace_form (Pro a) n m = Pro a\<close> |
  \<open>replace_form (Nom i) n m = Nom (if i = n then m else i)\<close> |
  \<open>replace_form (Neg p) n m = Neg (replace_form p n m)\<close> |
  \<open>replace_form (Con p q) n m = Con (replace_form p n m) (replace_form q n m)\<close> |
  \<open>replace_form (Sat i p) n m = Sat (if i = n then m else i) (replace_form p n m)\<close> |
  \<open>replace_form (Pos p) n m = Pos (replace_form p n m)\<close>

primrec replace' :: \<open>(nat \<times> 'a form) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (nat \<times> 'a form)\<close> where
  \<open>replace' (i,p) n m = (if i = n then m else i, replace_form p n m)\<close>

definition replace where
  \<open>replace A n m B \<equiv>
    (\<forall> p \<in> A. \<exists> q \<in> B. replace' p n m = q) \<and> (\<forall> q \<in> B. \<exists> p \<in> A. replace' p n m = q)\<close>

primrec fresh' where
  \<open>fresh' (Pro a) n = True\<close> |
  \<open>fresh' (Nom i) n = (i \<noteq> n)\<close> |
  \<open>fresh' (Neg p) n = fresh' p n\<close> |
  \<open>fresh' (Con p q) n = (fresh' p n \<and> fresh' q n)\<close> |
  \<open>fresh' (Sat i p) n = (i \<noteq> n \<and> fresh' p n)\<close> |
  \<open>fresh' (Pos p) n = fresh' p n\<close>

definition fresh where \<open>fresh A n \<equiv> \<forall> (i,p) \<in> A. n \<noteq> i \<and> fresh' p n\<close>

inductive SC :: \<open>(nat \<times> 'a form) set \<Rightarrow> (nat \<times> 'a form) set \<Rightarrow> bool\<close> (infix \<open>\<turnstile>\<close> 0) where
1:\<open>insert a \<Gamma> \<turnstile> insert a \<Delta>\<close> |
2:\<open>\<Gamma> \<turnstile> insert (n, Nom n) \<Delta>\<close> |
3:\<open>replace \<Gamma> n m \<Gamma>' \<Longrightarrow> replace \<Delta> n m \<Delta>' \<Longrightarrow> \<Gamma>' \<turnstile> \<Delta>' \<Longrightarrow> insert (n, Nom m) \<Gamma> \<turnstile> \<Delta>\<close> |
4:\<open>\<Gamma> \<turnstile> insert (n, p) \<Delta> \<Longrightarrow> insert (n, Neg p) \<Gamma> \<turnstile> \<Delta>\<close> |
5:\<open>insert (n, p) \<Gamma> \<turnstile> \<Delta> \<Longrightarrow> \<Gamma> \<turnstile> insert (n, Neg p) \<Delta>\<close> |
6:\<open>insert (n, p) (insert (n, q) \<Gamma>) \<turnstile> \<Delta> \<Longrightarrow> insert (n, Con p q) \<Gamma> \<turnstile> \<Delta>\<close> |
7:\<open>\<Gamma> \<turnstile> insert (n, p) \<Delta> \<Longrightarrow> \<Gamma> \<turnstile> insert (n, q) \<Delta> \<Longrightarrow> \<Gamma> \<turnstile> insert (n, Con p q) \<Delta>\<close> |
8:\<open>\<Gamma> \<turnstile> insert (m, p) \<Delta> \<Longrightarrow> \<Gamma> \<turnstile> insert (n, Sat m p) \<Delta>\<close> |
9:\<open>insert (m, p) \<Gamma> \<turnstile> \<Delta> \<Longrightarrow> insert (n, Sat m p) \<Gamma> \<turnstile> \<Delta>\<close> |
10:\<open>fresh ({(n, Pos p)} \<union> \<Gamma> \<union> \<Delta>) m \<Longrightarrow> insert (n, Pos (Nom m)) (insert (m, p) \<Gamma>) \<turnstile> \<Delta> \<Longrightarrow>
  insert (n, Pos p) \<Gamma> \<turnstile> \<Delta>\<close> |
11:\<open>\<not>fresh (\<Gamma> \<union> {(n, Pos p)} \<union> \<Delta>) m \<Longrightarrow> \<Gamma> \<turnstile> insert (n, Pos (Nom m)) \<Delta> \<Longrightarrow> \<Gamma> \<turnstile> insert (m, p) \<Delta> \<Longrightarrow>
  \<Gamma> \<turnstile> insert (n, Pos p) \<Delta>\<close>

primrec semantics_form where
  \<open>semantics_form R V G w (Pro a) = V w a\<close> |
  \<open>semantics_form R V G w (Nom n) = (G n = w)\<close> |
  \<open>semantics_form R V G w (Neg p) = (\<not> semantics_form R V G w p)\<close> |
  \<open>semantics_form R V G w (Con p q) = (semantics_form R V G w p \<and> semantics_form R V G w q)\<close> |
  \<open>semantics_form R V G w (Sat n p) = semantics_form R V G (G n) p\<close> |
  \<open>semantics_form R V G w (Pos p) = (\<exists> w'. R w w' \<and> semantics_form R V G w' p)\<close>

definition semantics_SC where
  \<open>semantics_SC R V G A B \<equiv>
    (\<forall> (n,p) \<in> A. semantics_form R V G (G n) p) \<longrightarrow> (\<exists> (n,p) \<in> B. semantics_form R V G (G n) p)\<close>

lemma lcon:\<open>
  semantics_SC R V G (insert (n, p) (insert (n, q) \<Gamma>)) \<Delta> \<Longrightarrow>
    semantics_SC R V G (insert (n, Con p q) \<Gamma>) \<Delta>\<close> (is \<open>?L1 \<Longrightarrow> ?R1\<close>)
proof-
  assume a1:?L1
  have \<open>
    (\<forall> (n,p) \<in> (insert (n, Con p q) \<Gamma>). semantics_form R V G (G n) p)
      \<Longrightarrow> (\<exists> (n,p) \<in> \<Delta>. semantics_form R V G (G n) p)\<close> (is \<open>?L2 \<Longrightarrow> ?R2\<close>)
  proof -
    assume a2: ?L2
    have \<open>semantics_form R V G (G n) p\<close>
      using a2 by fastforce
    moreover have \<open>semantics_form R V G (G n) q\<close>
      using a2 by fastforce
    ultimately have \<open>(\<forall> (n,p) \<in> (insert (n, p) (insert (n, q) \<Gamma>)). semantics_form R V G (G n) p)\<close>
      using a2 by simp
    then show ?R2
      using a1 semantics_SC_def by blast
  qed
  then show ?R1
    using semantics_SC_def by metis
qed

lemma completness: \<open>(\<forall> R V G. semantics_SC R V G A B) \<Longrightarrow> A \<turnstile> B\<close>
proof (induct rule: SC.induct) \<comment> \<open>Failed to apply proof method!\<close>
  oops

end