theory ExF007
  imports Main
begin

lemma "(\<not>(\<forall>x. \<exists>y. P x y)) \<longleftrightarrow> (\<exists>x. \<forall>y. \<not>P x y)"
proof -
  {
    assume a:"\<not> (\<forall>x. \<exists>y. P x y)"
    {
      assume b:"\<not>(\<exists>x. \<forall>y. \<not>P x y)"
      {
        fix aa
        {
          assume c:"\<not>(\<exists>y. P aa y)"
          {
            fix bb
            {
              assume "P aa bb"
              hence "\<exists>y. P aa y" by (rule exI)
              with c have False by contradiction
            }
            hence "\<not>P aa bb" by (rule notI)
          }
          hence "\<forall>y. \<not>P aa y" by (rule allI)
          hence "\<exists>x. \<forall>y. \<not>P x y" by (rule exI)
          with b have False by contradiction
        }
        hence "\<not>\<not>(\<exists>y. P aa y)" by (rule notI)
        hence "\<exists>y. P aa y" by (rule notnotD)
      }
      hence "\<forall>x. \<exists>y. P x y" by (rule allI)
      with a have False by contradiction
    }
    hence "\<not>\<not>(\<exists>x. \<forall>y. \<not>P x y)" by (rule notI)
    hence "\<exists>x. \<forall>y. \<not>P x y" by (rule notnotD)
  }
  moreover
  {
    assume a:"\<exists>x. \<forall>y. \<not>P x y"
    {
      assume b:"\<forall>x. \<exists>y. P x y"
      {
        fix aa
        assume c:"\<forall>y. \<not>P aa y"
        from b have d:"\<exists>y. P aa y" by (rule allE)
        {
          fix bb
          assume d:"P aa bb"
          from c have "\<not>P aa bb" by (rule allE)
          with d have False by contradiction
        }
        with d have False by (rule exE)
      }
      with a have False by (rule exE)
    }
    hence "\<not>(\<forall>x. \<exists>y. P x y)" by (rule notI)
  }
  ultimately show ?thesis by (rule iffI)
qed


section {* Monoid variants and extra properties *}

theory Monoid_extra
  imports List_extra "~~/src/HOL/Library/Prefix_Order"
begin

class ordered_semigroup = semigroup_add + order +
  assumes add_left_mono: "a \<le> b \<Longrightarrow> c + a \<le> c + b"
  and add_right_mono: "a \<le> b \<Longrightarrow> a + c \<le> b + c"
begin

lemma add_mono:
  "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> a + c \<le> b + d"
  using local.add_left_mono local.add_right_mono local.order.trans by blast

end

thm cancel_semigroup_add_axioms

class left_cancel_monoid = monoid_add +
  assumes add_left_imp_eq: "a + b = a + c \<Longrightarrow> b = c"

class right_cancel_monoid = monoid_add +
  assumes add_right_imp_eq: "b + a = c + a \<Longrightarrow> b = c"

class monoid_sum_0 = monoid_add +
  assumes zero_sum_left: "a + b = 0 \<Longrightarrow> a = 0"
begin

lemma zero_sum_right: "a + b = 0 \<Longrightarrow> b = 0"
  by (metis local.add_0_left local.zero_sum_left)

lemma zero_sum: "a + b = 0 \<longleftrightarrow> a = 0 \<and> b = 0"
  by (metis local.add_0_right zero_sum_right)

end

context monoid_add
begin

definition monoid_le (infix "\<le>\<^sub>m" 50)
where "a \<le>\<^sub>m b \<longleftrightarrow> (\<exists>c. b = a + c)"

definition monoid_subtract (infixl "-\<^sub>m" 65)
where "a -\<^sub>m b = (if (b \<le>\<^sub>m a) then THE c. a = b + c else 0)"

end

class cancel_monoid = left_cancel_monoid + right_cancel_monoid + monoid_sum_0
begin

lemma monoid_le_least_zero: "0 \<le>\<^sub>m a"
  by (simp add: monoid_le_def)

lemma monoid_le_refl: "a \<le>\<^sub>m a"
  by (simp add: monoid_le_def, metis add.right_neutral)

lemma monoid_le_trans: "\<lbrakk> a \<le>\<^sub>m b; b \<le>\<^sub>m c \<rbrakk> \<Longrightarrow> a \<le>\<^sub>m c"
  by (metis add.assoc monoid_le_def)

lemma monoid_le_antisym:
  assumes "a \<le>\<^sub>m b" "b \<le>\<^sub>m a"
  shows "a = b"
proof -
  obtain a' where a': "b = a + a'"
    using assms(1) monoid_le_def by auto

  obtain b' where b': "a = b + b'"
    using assms(2) monoid_le_def by auto

  have "b' = (b' + a' + b')"
    by (metis a' add_assoc b' local.add_left_imp_eq)

  hence "a' + b' = 0"
    by (metis add_assoc local.add_0_right local.add_left_imp_eq)

  hence "a' = 0" "b' = 0"
    by (simp add: zero_sum)+

  with a' b' show ?thesis
    by simp
qed

lemma monoid_le_add: "a \<le>\<^sub>m a + b"
  by (auto simp add: monoid_le_def)

lemma monoid_le_add_left_mono: "a \<le>\<^sub>m b \<Longrightarrow> c + a \<le>\<^sub>m c + b"
  using add_assoc by (auto simp add: monoid_le_def)

lemma add_monoid_diff_cancel_left [simp]: "(a + b) -\<^sub>m a = b"
  apply (simp add: monoid_subtract_def monoid_le_add)
  apply (rule the_equality)
  apply (simp)
  using local.add_left_imp_eq apply blast
done

end

class ordered_cancel_monoid_diff = cancel_monoid + ord + minus +
  assumes le_is_monoid_le: "a \<le> b \<longleftrightarrow> (a \<le>\<^sub>m b)"
  and less_iff: "a < b \<longleftrightarrow> a \<le> b \<and> \<not> (b \<le> a)"
  and minus_def: "a - b = a -\<^sub>m b"

instance ordered_cancel_monoid_diff \<subseteq> order
  apply (intro_classes)
  apply (simp_all add: less_iff le_is_monoid_le monoid_le_refl)
  using monoid_le_trans apply blast
  apply (simp add: monoid_le_antisym)
done

context ordered_cancel_monoid_diff
begin

  lemma le_iff_add: "a \<le> b \<longleftrightarrow> (\<exists> c. b = a + c)"
    by (simp add: local.le_is_monoid_le local.monoid_le_def)

  lemma least_zero [simp]: "0 \<le> a"
    by (simp add: local.le_is_monoid_le local.monoid_le_least_zero)

  lemma le_add [simp]: "a \<le> a + b"
    by (simp add: le_is_monoid_le local.monoid_le_add)

  lemma not_le_minus [simp]:  "\<not> (a \<le> b) \<Longrightarrow> b - a = 0"
    by (simp add: le_is_monoid_le local.minus_def local.monoid_subtract_def)

  lemma add_diff_cancel_left [simp]: "(a + b) - a = b"
    by (simp add: minus_def)

  lemma diff_zero [simp]: "a - 0 = a"
    by (metis local.add_0_left local.add_diff_cancel_left)

  lemma diff_cancel [simp]: "a - a = 0"
    by (metis local.add_0_right local.add_diff_cancel_left)

  lemma add_left_mono: "a \<le> b \<Longrightarrow> c + a \<le> c + b"
    by (simp add: local.le_is_monoid_le local.monoid_le_add_left_mono)

  lemma add_le_imp_le_left: "c + a \<le> c + b \<Longrightarrow> a \<le> b"
    by (auto simp add: le_iff_add, metis add_assoc local.add_diff_cancel_left)

  lemma add_diff_cancel_left' [simp]:  "(c + a) - (c + b) = a - b"
  proof (cases "b \<le> a")
    case True thus ?thesis
      by (metis add_assoc local.add_diff_cancel_left local.le_iff_add local.monoid_le_def)
  next
    case False thus ?thesis
      using local.add_le_imp_le_left not_le_minus by blast
  qed

  lemma minus_zero_eq: "\<lbrakk> b \<le> a; a - b = 0 \<rbrakk> \<Longrightarrow> a = b"
    using local.le_iff_add local.monoid_le_def by auto

  lemma diff_add_cancel_left': "a \<le> b \<Longrightarrow> a + (b - a) = b"
    using local.le_iff_add local.monoid_le_def by auto

end

instantiation list :: (type) monoid_add
begin

  definition zero_list :: "'a list" where "zero_list = []"
  definition plus_list :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where "plus_list = op @"

instance
  by (intro_classes, simp_all add: zero_list_def plus_list_def)

end

lemma monoid_le_list:
  "(xs :: 'a list) \<le>\<^sub>m ys \<longleftrightarrow> xs \<le> ys"
  apply (simp add: monoid_le_def plus_list_def)
  using Prefix_Order.prefixE Prefix_Order.prefixI apply blast
done

lemma monoid_subtract_list:
  "(xs :: 'a list) -\<^sub>m ys = xs - ys"
  apply (auto simp add: monoid_subtract_def monoid_le_list minus_list_def less_eq_list_def)
  apply (rule the_equality)
  apply (simp_all add: zero_list_def plus_list_def prefix_drop)
done

instance list :: (type) ordered_cancel_monoid_diff
  apply (intro_classes, simp_all add: zero_list_def plus_list_def monoid_le_def monoid_subtract_list)
  using Prefix_Order.prefixE Prefix_Order.prefixI apply blast
  apply (simp add: less_list_def)
done

lemma monoid_le_nat:
  "(x :: nat) \<le>\<^sub>m y \<longleftrightarrow> x \<le> y"
  by (simp add: monoid_le_def nat_le_iff_add)

lemma monoid_subtract_nat:
  "(x :: nat) -\<^sub>m y = x - y"
  by (auto simp add: monoid_subtract_def monoid_le_nat)

instance nat :: ordered_cancel_monoid_diff
  apply (intro_classes, simp_all add: monoid_subtract_nat)
  apply (simp add: nat_le_iff_add monoid_le_def)
  apply linarith
done
end


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

section \<open>Prefices on finite and infinite lists\<close>

theory ListInf_Prefix
imports "HOL-Library.Sublist" ListInf
begin

subsection \<open>Additional list prefix results\<close>

lemma prefix_eq_prefix_take_ex: "prefix xs ys = (\<exists>n. ys \<down> n = xs)"
apply (unfold prefix_def, safe)
apply (rule_tac x="length xs" in exI, simp)
apply (rule_tac x="ys \<up> n" in exI, simp)
done

lemma prefix_take_eq_prefix_take_ex: "(ys \<down> (length xs) = xs) = (\<exists>n. ys \<down> n = xs)"
by (fastforce simp: min_def)

lemma prefix_eq_prefix_take: "prefix xs ys = (ys \<down> (length xs) = xs)"
by (simp only: prefix_eq_prefix_take_ex prefix_take_eq_prefix_take_ex)

lemma strict_prefix_take_eq_strict_prefix_take_ex: "
  (ys \<down> (length xs) = xs \<and> xs \<noteq> ys) =
  ((\<exists>n. ys \<down> n = xs) \<and> xs \<noteq> ys)"
by (simp add: prefix_take_eq_prefix_take_ex)

lemma strict_prefix_eq_strict_prefix_take_ex: "strict_prefix xs ys = ((\<exists>n. ys \<down> n = xs) \<and> xs \<noteq> ys)"
by (simp add: strict_prefix_def prefix_eq_prefix_take_ex)
lemma strict_prefix_eq_strict_prefix_take: "strict_prefix xs ys = (ys \<down> (length xs) = xs \<and> xs \<noteq> ys)"
by (simp only: strict_prefix_eq_strict_prefix_take_ex strict_prefix_take_eq_strict_prefix_take_ex)

lemma take_imp_prefix: "prefix (xs \<down> n) xs"
by (rule take_is_prefix)

lemma eq_imp_prefix: "xs = (ys::'a list) \<Longrightarrow> prefix xs ys"
by simp

lemma le_take_imp_prefix: "a \<le> b \<Longrightarrow> prefix (xs \<down> a) (xs \<down> b)"
by (fastforce simp: prefix_eq_prefix_take_ex min_def)

lemma take_prefix_imp_le: "
  \<lbrakk> a \<le> length xs; prefix (xs \<down> a) (xs \<down> b) \<rbrakk> \<Longrightarrow> a \<le> b"
by (drule prefix_length_le, simp)

lemma take_prefixeq_le_conv: "
  a \<le> length xs \<Longrightarrow> prefix (xs \<down> a) (xs \<down> b) = (a \<le> b)"
apply (rule iffI)
 apply (rule take_prefix_imp_le, assumption+)
apply (rule le_take_imp_prefix, assumption+)
done
lemma append_imp_prefix[simp, intro]: "prefix a (a @ b)"
by (unfold prefix_def, blast)

lemma prefix_imp_take_eq: "
  \<lbrakk> n \<le> length xs; prefix xs ys \<rbrakk> \<Longrightarrow> xs \<down> n = ys \<down> n"
by (clarsimp simp: prefix_def)

lemma prefix_length_le_eq_conv: "(prefix xs ys \<and> length ys \<le> length xs) = (xs = ys)"
apply (rule iffI)
 apply (erule conjE)
 apply (frule prefix_length_le)
 apply (simp add: prefix_eq_prefix_take)
apply simp
done

lemma take_length_prefix_conv: "
  length xs \<le> length ys \<Longrightarrow> prefix (ys \<down> length xs) xs = prefix xs ys"
by (fastforce simp: prefix_eq_prefix_take)

lemma append_eq_imp_take: "
  \<lbrakk> k \<le> length xs; length r1 = k; r1 @ r2 = xs \<rbrakk> \<Longrightarrow> r1 = xs \<down> k"
by fastforce

lemma take_the_conv: "
  xs \<down> k = (if length xs \<le> k then xs else (THE r. length r = k \<and> (\<exists>r2. r @ r2 = xs)))"
apply (clarsimp simp: linorder_not_le)
apply (rule the1I2)
 apply (simp add: Ex1_def)
 apply (rule_tac x="xs \<down> k" in exI)
 apply (intro conjI)
   apply (simp add: min_eqR)
  apply (rule_tac x="xs \<up> k" in exI, simp)
 apply fastforce
apply fastforce
done

lemma prefix_refl: "prefix xs (xs::'a list)"
by (rule prefix_order.order_refl)

lemma prefix_trans: "\<lbrakk> prefix xs ys; prefix (ys::'a list) zs \<rbrakk> \<Longrightarrow> prefix xs zs"
by (rule prefix_order.order_trans)

lemma prefixeq_antisym: "\<lbrakk> prefix xs ys; prefix (ys::'a list) xs \<rbrakk> \<Longrightarrow> xs = ys"
by (rule prefix_order.antisym)

subsection \<open>Counting equal pairs\<close>
text \<open>Counting number of equal elements in two lists\<close>

definition mirror_pair :: "('a \<times> 'b) \<Rightarrow> ('b \<times> 'a)"
  where "mirror_pair p \<equiv> (snd p, fst p)"

lemma zip_mirror[rule_format]: "
  \<lbrakk> i < min (length xs) (length ys);
    p1 = (zip xs ys) ! i; p2 = (zip ys xs) ! i \<rbrakk> \<Longrightarrow>
  mirror_pair p1 = p2"
by (simp add: mirror_pair_def)

definition equal_pair :: "('a \<times> 'a) \<Rightarrow> bool"
  where "equal_pair p \<equiv> (fst p = snd p)"

lemma mirror_pair_equal: "equal_pair (mirror_pair p) = (equal_pair p)"
by (fastforce simp: mirror_pair_def equal_pair_def)

primrec
  equal_pair_count :: "('a \<times> 'a) list \<Rightarrow> nat"
where
  "equal_pair_count [] = 0"
| "equal_pair_count (p # ps) = (
    if (fst p = snd p)
      then Suc (equal_pair_count ps)
      else 0)"

lemma equal_pair_count_le: "equal_pair_count xs \<le> length xs"
by (induct xs, simp_all)

lemma equal_pair_count_0: "
  fst (hd ps) \<noteq> snd (hd ps) \<Longrightarrow> equal_pair_count ps = 0"
by (case_tac ps, simp_all)

lemma equal_pair_count_Suc: "
  equal_pair_count ((a, a) # ps) = Suc (equal_pair_count ps)"
by simp

lemma equal_pair_count_eq_pairwise[rule_format]: "
  \<lbrakk> length ps1 = length ps2;
    \<forall>i<length ps2. equal_pair (ps1 ! i) = equal_pair(ps2 ! i) \<rbrakk>
  \<Longrightarrow> equal_pair_count ps1 = equal_pair_count ps2"
apply (induct rule: list_induct2)
 apply simp
apply (fastforce simp add: equal_pair_def)
done

lemma equal_pair_count_mirror_pairwise[rule_format]: "
  \<lbrakk> length ps1 = length ps2;
    \<forall>i<length ps2. ps1 ! i = mirror_pair (ps2 ! i) \<rbrakk>
  \<Longrightarrow> equal_pair_count ps1 = equal_pair_count ps2"
apply (rule equal_pair_count_eq_pairwise, assumption)
apply (simp add: mirror_pair_equal)
done

(* The lemma states that all pairs with index < equal_pair_count ps
  are equal. It does not deal with maximality of equal_pair_count *)
lemma equal_pair_count_correct:"
  \<And>i. i < equal_pair_count ps \<Longrightarrow> equal_pair (ps ! i)"
apply (induct ps)
 apply simp
apply simp
apply (split if_split_asm)
apply (case_tac i)
apply (simp add: equal_pair_def)+
done

(* For @{text "i = equal_pair_count ps"} holds:
  either @{text "ps ! i"} not an equal pair,
  or all pairs are equal (@{text "equal_pair_count = length ps"}) *)
lemma equal_pair_count_maximality_aux[rule_format]: "\<And>i.
  i = equal_pair_count ps \<Longrightarrow> length ps = i \<or> \<not> equal_pair (ps ! i)"
apply (induct ps)
 apply simp
apply (simp add: equal_pair_def)
done

corollary equal_pair_count_maximality1a[rule_format]: "
  equal_pair_count ps = length ps \<or> \<not> equal_pair (ps!equal_pair_count ps)"
apply (insert equal_pair_count_maximality_aux[of "equal_pair_count ps" ps])
apply clarsimp
done

corollary equal_pair_count_maximality1b[rule_format]: "
  equal_pair_count ps \<noteq> length ps \<Longrightarrow>
  \<not> equal_pair (ps!equal_pair_count ps)"
by (insert equal_pair_count_maximality1a[of ps], simp)

lemma equal_pair_count_maximality2a[rule_format]: "
  equal_pair_count ps = length ps \<or> \<comment> \<open>either all pairs are equal\<close>
  (\<forall>i\<ge>equal_pair_count ps.(\<exists>j\<le>i. \<not>equal_pair (ps ! j)))"
apply clarsimp
apply (rule_tac x="equal_pair_count ps" in exI)
apply (simp add: equal_pair_count_maximality1b equal_pair_count_le)
done

corollary equal_pair_count_maximality2b[rule_format]: "
  equal_pair_count ps \<noteq> length ps \<Longrightarrow>
  \<forall>i\<ge>equal_pair_count ps.(\<exists>j\<le>i. \<not>equal_pair (ps!j))"
by (insert equal_pair_count_maximality2a[of ps], simp)

lemmas equal_pair_count_maximality =
  equal_pair_count_maximality1a equal_pair_count_maximality1b
  equal_pair_count_maximality2a equal_pair_count_maximality2b

subsection \<open>Prefix length\<close>

text \<open>Length of the prefix infimum\<close>

definition inf_prefix_length :: "'a list \<Rightarrow> 'a list \<Rightarrow> nat"
  where "inf_prefix_length xs ys \<equiv> equal_pair_count (zip xs ys)"

value "int (inf_prefix_length [1::int,2,3,4,7,8,15] [1::int,2,3,4,7,15])"
value "int (inf_prefix_length [1::int,2,3,4] [1::int,2,3,4,7,15])"
value "int (inf_prefix_length [] [1::int,2,3,4,7,15])"
value "int (inf_prefix_length [1::int,2,3,4,5] [1::int,2,3,4,5])"

lemma inf_prefix_length_commute[rule_format]:
  "inf_prefix_length xs ys = inf_prefix_length ys xs"
apply (unfold inf_prefix_length_def)
apply (insert equal_pair_count_mirror_pairwise[of "zip xs ys" "zip ys xs"])
apply (simp add: equal_pair_count_mirror_pairwise[of "zip xs ys" "zip ys xs"] mirror_pair_def)
done

lemma inf_prefix_length_leL[intro]:
  "inf_prefix_length xs ys \<le> length xs"
apply (unfold inf_prefix_length_def)
apply (insert equal_pair_count_le[of "zip xs ys"])
apply simp
done

corollary inf_prefix_length_leR[intro]:
  "inf_prefix_length xs ys \<le> length ys"
by (simp add: inf_prefix_length_commute[of xs] inf_prefix_length_leL)

lemmas inf_prefix_length_le =
  inf_prefix_length_leL
  inf_prefix_length_leR

lemma inf_prefix_length_le_min[rule_format]:
  "inf_prefix_length xs ys \<le> min (length xs) (length ys)"
by (simp add: inf_prefix_length_le)

lemma hd_inf_prefix_length_0: "
  hd xs \<noteq> hd ys \<Longrightarrow> inf_prefix_length xs ys = 0"
apply (unfold inf_prefix_length_def)
apply (case_tac "xs = []", simp)
apply (case_tac "ys = []", simp)
apply (simp add: equal_pair_count_0 hd_zip)
done

lemma inf_prefix_length_NilL[simp]: "inf_prefix_length [] ys = 0"
by (simp add: inf_prefix_length_def)
lemma inf_prefix_length_NilR[simp]: "inf_prefix_length xs [] = 0"
by (simp add: inf_prefix_length_def)

lemma inf_prefix_length_Suc[simp]: "
  inf_prefix_length (a # xs) (a # ys) = Suc (inf_prefix_length xs ys)"
by (simp add: inf_prefix_length_def)

lemma inf_prefix_length_correct: "
  i < inf_prefix_length xs ys \<Longrightarrow> xs ! i = ys ! i"
apply (frule order_less_le_trans[OF _ inf_prefix_length_leL])
apply (frule order_less_le_trans[OF _ inf_prefix_length_leR])
apply (unfold inf_prefix_length_def)
apply (drule equal_pair_count_correct)
apply (simp add: equal_pair_def)
done

corollary nth_neq_imp_inf_prefix_length_le: "
  xs ! i \<noteq> ys ! i \<Longrightarrow> inf_prefix_length xs ys \<le> i"
apply (rule ccontr)
apply (simp add: inf_prefix_length_correct)
done

lemma inf_prefix_length_maximality1[rule_format]: "
  inf_prefix_length xs ys \<noteq> min (length xs) (length ys) \<Longrightarrow>
  xs ! (inf_prefix_length xs ys) \<noteq> ys ! (inf_prefix_length xs ys)"
apply (insert equal_pair_count_maximality1b[of "zip xs ys", folded inf_prefix_length_def], simp)
apply (drule neq_le_trans)
 apply (simp add: inf_prefix_length_le)
apply (simp add:  inf_prefix_length_def equal_pair_def)
done

corollary inf_prefix_length_maximality2[rule_format]: "
  \<lbrakk> inf_prefix_length xs ys \<noteq> min (length xs) (length ys);
    inf_prefix_length xs ys \<le> i \<rbrakk> \<Longrightarrow>
  \<exists>j\<le>i. xs ! j \<noteq> ys ! j"
apply (rule_tac x="inf_prefix_length xs ys" in exI)
apply (simp add: inf_prefix_length_maximality1 inf_prefix_length_le_min)
done

lemmas inf_prefix_length_maximality =
  inf_prefix_length_maximality1 inf_prefix_length_maximality2

lemma inf_prefix_length_append[simp]: "
  inf_prefix_length (zs @ xs) (zs @ ys) =
  length zs + inf_prefix_length xs ys"
apply (induct zs)
 apply simp
apply (simp add: inf_prefix_length_def)
done

lemma inf_prefix_length_take_correct: "
  n \<le> inf_prefix_length xs ys \<Longrightarrow> xs \<down> n = ys \<down> n"
apply (frule order_trans[OF _ inf_prefix_length_leL])
apply (frule order_trans[OF _ inf_prefix_length_leR])
apply (simp add: list_eq_iff inf_prefix_length_correct)
done

lemma inf_prefix_length_0_imp_hd_neq: "
  \<lbrakk> xs \<noteq> []; ys \<noteq> []; inf_prefix_length xs ys = 0 \<rbrakk> \<Longrightarrow> hd xs \<noteq> hd ys"
apply (rule ccontr)
apply (insert inf_prefix_length_maximality2[of xs ys 0])
apply (simp add: hd_eq_first)
done

subsection \<open>Prefix infimum\<close>

definition inf_prefix :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"  (infixl "\<sqinter>" 70)
  where "xs \<sqinter> ys \<equiv> xs \<down> (inf_prefix_length xs ys)"

lemma length_inf_prefix: "length (xs \<sqinter> ys) = inf_prefix_length xs ys"
by (simp add: inf_prefix_def min_eqR inf_prefix_length_leL)

lemma inf_prefix_commute: "xs \<sqinter> ys = ys \<sqinter> xs"
by (simp add: inf_prefix_def inf_prefix_length_commute[of ys] inf_prefix_length_take_correct)

lemma inf_prefix_takeL: "xs \<sqinter> ys = xs \<down> (inf_prefix_length xs ys)"
by (simp add: inf_prefix_def)

lemma inf_prefix_takeR: "xs \<sqinter> ys = ys \<down> (inf_prefix_length xs ys)"
by (subst inf_prefix_commute, subst inf_prefix_length_commute, rule inf_prefix_takeL)

lemma inf_prefix_correct: "i < length (xs \<sqinter> ys) \<Longrightarrow> xs ! i = ys ! i"
by (simp add: length_inf_prefix inf_prefix_length_correct)

corollary inf_prefix_correctL: "
  i < length (xs \<sqinter> ys) \<Longrightarrow> (xs \<sqinter> ys) ! i = xs ! i"
by (simp add: inf_prefix_takeL)

corollary inf_prefix_correctR: "
  i < length (xs \<sqinter> ys) \<Longrightarrow> (xs \<sqinter> ys) ! i = ys ! i"
by (simp add: inf_prefix_takeR)

lemma inf_prefix_take_correct: "
  n \<le> length (xs \<sqinter> ys) \<Longrightarrow> xs \<down> n = ys \<down> n"
by (simp add: length_inf_prefix inf_prefix_length_take_correct)

lemma is_inf_prefix[rule_format]: "
  \<lbrakk> length zs = length (xs \<sqinter> ys);
    \<And>i. i < length (xs \<sqinter> ys) \<Longrightarrow> zs ! i = xs ! i \<and> zs ! i = ys ! i \<rbrakk> \<Longrightarrow>
  zs = xs \<sqinter> ys"
by (simp add: list_eq_iff inf_prefix_def)

lemma hd_inf_prefix_Nil: "hd xs \<noteq> hd ys \<Longrightarrow> xs \<sqinter> ys = []"
by (simp add: inf_prefix_def hd_inf_prefix_length_0)

lemma inf_prefix_Nil_imp_hd_neq: "
  \<lbrakk> xs \<noteq> []; ys \<noteq> []; xs \<sqinter> ys = [] \<rbrakk> \<Longrightarrow> hd xs \<noteq> hd ys"
by (simp add: inf_prefix_def inf_prefix_length_0_imp_hd_neq)

lemma length_inf_prefix_append[simp]: "
  length ((zs @ xs) \<sqinter> (zs @ ys)) =
  length zs + length (xs \<sqinter> ys)"
by (simp add: length_inf_prefix)

lemma inf_prefix_append[simp]: "(zs @ xs) \<sqinter> (zs @ ys) = zs @ (xs \<sqinter> ys)"
apply (rule is_inf_prefix[symmetric], simp)
apply (clarsimp simp: nth_append)
apply (intro conjI inf_prefix_correctL inf_prefix_correctR, simp+)
done

lemma hd_neq_inf_prefix_append: "
  hd xs \<noteq> hd ys \<Longrightarrow> (zs @ xs) \<sqinter> (zs @ ys) = zs"
by (simp add: hd_inf_prefix_Nil)

lemma inf_prefix_NilL[simp]: "[] \<sqinter> ys = []"
by (simp del: length_0_conv add: length_0_conv[symmetric] length_inf_prefix)

corollary inf_prefix_NilR[simp]: "xs \<sqinter> [] = []"
by (simp add: inf_prefix_commute)

lemmas inf_prefix_Nil = inf_prefix_NilL inf_prefix_NilR

lemma inf_prefix_Cons[simp]: "(a # xs) \<sqinter> (a # ys) = a # xs \<sqinter> ys"
by (insert inf_prefix_append[of "[a]" xs ys], simp)

corollary inf_prefix_hd[simp]: "hd ((a # xs) \<sqinter> (a # ys)) = a"
by simp

lemma inf_prefix_le1: "prefix (xs \<sqinter> ys) xs"
by (simp add: inf_prefix_takeL take_imp_prefix)

lemma inf_prefix_le2: "prefix (xs \<sqinter> ys) ys"
by (simp add: inf_prefix_takeR take_imp_prefix)

lemma le_inf_prefix_iff: "prefix x (y \<sqinter> z) = (prefix x y \<and> prefix x z)"
apply (rule iffI)
 apply (blast intro: prefix_order.order_trans inf_prefix_le1 inf_prefix_le2)
apply (clarsimp simp: prefix_def)
done

lemma le_imp_le_inf_prefix: "\<lbrakk> prefix x y; prefix x z \<rbrakk> \<Longrightarrow> prefix x (y \<sqinter> z)"
by (rule le_inf_prefix_iff[THEN iffD2], simp)

interpretation prefix:
  semilattice_inf
    "(\<sqinter>) :: 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
    "prefix"
    "strict_prefix"
apply intro_locales
apply (rule class.semilattice_inf_axioms.intro)
apply (rule inf_prefix_le1)
apply (rule inf_prefix_le2)
apply (rule le_imp_le_inf_prefix, assumption+)
done

subsection \<open>Prefices for infinite lists\<close>

definition iprefix :: "'a list \<Rightarrow> 'a ilist \<Rightarrow> bool"  (infixl "\<sqsubseteq>" 50)
  where "xs \<sqsubseteq> f \<equiv> \<exists>g. f = xs \<frown> g"

lemma iprefix_eq_iprefix_take: "(xs \<sqsubseteq> f) = (f \<Down> length xs = xs)"
apply (unfold iprefix_def)
apply (rule iffI)
 apply clarsimp
apply (rule_tac x="f \<Up> (length xs)" in exI)
apply (subst i_append_i_take_i_drop_id[where n="length xs", symmetric], simp)
done

lemma iprefix_take_eq_iprefix_take_ex: "
  (f \<Down> length xs = xs) = (\<exists>n. f \<Down> n = xs)"
apply (rule iffI)
 apply (rule_tac x="length xs" in exI, assumption)
apply clarsimp
done

lemma iprefix_eq_iprefix_take_ex: "(xs \<sqsubseteq> f) = (\<exists>n. f \<Down> n = xs)"
by (simp add: iprefix_eq_iprefix_take iprefix_take_eq_iprefix_take_ex)

lemma i_take_imp_iprefix[intro]: "f \<Down> n \<sqsubseteq> f"
by (simp add: iprefix_eq_iprefix_take)

lemma i_take_prefix_le_conv: "prefix (f \<Down> a) (f \<Down> b) = (a \<le> b)"
by (fastforce simp: prefix_eq_prefix_take list_eq_iff)

lemma i_append_imp_iprefix[simp,intro]: "xs \<sqsubseteq> xs \<frown> f"
by (simp add: iprefix_def)

lemma prefixeq_iprefix_trans: "\<lbrakk> prefix xs ys; ys \<sqsubseteq> f \<rbrakk> \<Longrightarrow> xs \<sqsubseteq> f"
by (fastforce simp: iprefix_eq_iprefix_take_ex prefix_eq_prefix_take_ex)

lemma i_take_length_prefix_conv: "prefix (f \<Down> length xs) xs = (xs \<sqsubseteq> f)"
by (simp add: iprefix_eq_iprefix_take prefix_length_le_eq_conv[symmetric])

lemma iprefixI[intro?]: "f = xs \<frown> g \<Longrightarrow> xs \<sqsubseteq> f"
by (unfold iprefix_def, simp)

lemma iprefixE[elim?]: "\<lbrakk> xs \<sqsubseteq> f; \<And>g. f = xs \<frown> g \<Longrightarrow> C \<rbrakk> \<Longrightarrow> C"
by (unfold iprefix_def, blast)

lemma Nil_iprefix[iff]: "[] \<sqsubseteq> f"
by (unfold iprefix_def, simp)

lemma same_prefix_iprefix[simp]: "(xs @ ys \<sqsubseteq> xs \<frown> f) = (ys \<sqsubseteq> f)"
by (simp add: iprefix_eq_iprefix_take)

lemma prefix_iprefix[simp]: "prefix xs ys \<Longrightarrow> xs \<sqsubseteq> ys \<frown> f"
by (clarsimp simp: prefix_def iprefix_def i_append_assoc[symmetric] simp del: i_append_assoc)

lemma append_iprefixD: "xs @ ys \<sqsubseteq> f \<Longrightarrow> xs \<sqsubseteq> f"
by (clarsimp simp: iprefix_def i_append_assoc[symmetric] simp del: i_append_assoc)

lemma iprefix_length_le_imp_prefix: "
  \<lbrakk> xs \<sqsubseteq> ys \<frown> f; length xs \<le> length ys \<rbrakk> \<Longrightarrow> prefix xs ys"
by (clarsimp simp: iprefix_eq_iprefix_take_ex take_is_prefix)

lemma iprefix_i_append: "
  (xs \<sqsubseteq> ys \<frown> f) = (prefix xs ys \<or> (\<exists>zs. xs = ys @ zs \<and> zs \<sqsubseteq> f))"
apply (rule iffI)
 apply (case_tac "length xs \<le> length ys")
  apply (blast intro: iprefix_length_le_imp_prefix)
 apply (rule disjI2)
 apply (rule_tac x="f \<Down> (length xs - length ys)" in exI)
 apply (simp add: iprefix_eq_iprefix_take)
apply fastforce
done

lemma i_append_one_iprefix: "
  xs \<sqsubseteq> f \<Longrightarrow> xs @ [f (length xs)] \<sqsubseteq> f"
by (simp add: iprefix_eq_iprefix_take i_take_Suc_conv_app_nth)

lemma iprefix_same_length_le: "
  \<lbrakk> xs \<sqsubseteq> f; ys \<sqsubseteq> f; length xs \<le> length ys \<rbrakk> \<Longrightarrow> prefix xs ys"
by (clarsimp simp: iprefix_eq_iprefix_take_ex i_take_prefix_le_conv)

lemma iprefix_same_cases: "
  \<lbrakk> xs \<sqsubseteq> f; ys \<sqsubseteq> f \<rbrakk> \<Longrightarrow> prefix xs ys \<or> prefix ys xs"
apply (case_tac "length xs \<le> length ys")
apply (simp add: iprefix_same_length_le)+
done

lemma set_mono_iprefix: "xs \<sqsubseteq> f \<Longrightarrow> set xs \<subseteq> range f"
by (unfold iprefix_def, fastforce)

end


(* Author: Tobias Nipkow *)

subsection "Examples"

theory Hoare_Examples imports Hoare begin

hide_const (open) sum

text\<open>Summing up the first \<open>x\<close> natural numbers in variable \<open>y\<close>.\<close>

fun sum :: "int \<Rightarrow> int" where
"sum i = (if i \<le> 0 then 0 else sum (i - 1) + i)"

lemma sum_simps[simp]:
  "0 < i \<Longrightarrow> sum i = sum (i - 1) + i"
  "i \<le> 0 \<Longrightarrow> sum i = 0"
by(simp_all)

declare sum.simps[simp del]

abbreviation "wsum ==
  WHILE Less (N 0) (V ''x'')
  DO (''y'' ::= Plus (V ''y'') (V ''x'');;
      ''x'' ::= Plus (V ''x'') (N (- 1)))"

subsubsection\<open>Proof by Operational Semantics\<close>

text\<open>The behaviour of the loop is proved by induction:\<close>

lemma while_sum:
  "(wsum, s) \<Rightarrow> t \<Longrightarrow> t ''y'' = s ''y'' + sum(s ''x'')"
apply(induction wsum s t rule: big_step_induct)
apply(auto)
done

text\<open>We were lucky that the proof was automatic, except for the
induction. In general, such proofs will not be so easy. The automation is
partly due to the right inversion rules that we set up as automatic
elimination rules that decompose big-step premises.

Now we prefix the loop with the necessary initialization:\<close>

lemma sum_via_bigstep:
  assumes "(''y'' ::= N 0;; wsum, s) \<Rightarrow> t"
  shows "t ''y'' = sum (s ''x'')"
proof -
  from assms have "(wsum,s(''y'':=0)) \<Rightarrow> t" by auto
  from while_sum[OF this] show ?thesis by simp
qed

subsubsection\<open>Proof by Hoare Logic\<close>

text\<open>Note that we deal with sequences of commands from right to left,
pulling back the postcondition towards the precondition.\<close>

lemma "\<turnstile> {\<lambda>s. s ''x'' = n} ''y'' ::= N 0;; wsum {\<lambda>s. s ''y'' = sum n}"
apply(rule Seq)
 prefer 2
 apply(rule While' [where P = "\<lambda>s. (s ''y'' = sum n - sum(s ''x''))"])
  apply(rule Seq)
   prefer 2
   apply(rule Assign)
  apply(rule Assign')
  apply simp
 apply simp
apply(rule Assign')
apply simp
done

text\<open>The proof is intentionally an apply script because it merely composes
the rules of Hoare logic. Of course, in a few places side conditions have to
be proved. But since those proofs are 1-liners, a structured proof is
overkill. In fact, we shall learn later that the application of the Hoare
rules can be automated completely and all that is left for the user is to
provide the loop invariants and prove the side-conditions.\<close>

end


(*  Title:      HOL/Induct/PropLog.thy
    Author:     Tobias Nipkow
    Copyright   1994  TU Muenchen & University of Cambridge
*)

section \<open>Meta-theory of propositional logic\<close>

theory PropLog imports Main begin

text \<open>
  Datatype definition of propositional logic formulae and inductive
  definition of the propositional tautologies.

  Inductive definition of propositional logic.  Soundness and
  completeness w.r.t.\ truth-tables.

  Prove: If \<open>H |= p\<close> then \<open>G |= p\<close> where \<open>G \<in>
  Fin(H)\<close>
\<close>

subsection \<open>The datatype of propositions\<close>

datatype 'a pl =
  false |
  var 'a ("#_" [1000]) |
  imp "'a pl" "'a pl" (infixr "->" 90)

subsection \<open>The proof system\<close>

inductive thms :: "['a pl set, 'a pl] => bool"  (infixl "|-" 50)
  for H :: "'a pl set"
where
  H: "p\<in>H ==> H |- p"
| K: "H |- p->q->p"
| S: "H |- (p->q->r) -> (p->q) -> p->r"
| DN: "H |- ((p->false) -> false) -> p"
| MP: "[| H |- p->q; H |- p |] ==> H |- q"

subsection \<open>The semantics\<close>

subsubsection \<open>Semantics of propositional logic.\<close>

primrec eval :: "['a set, 'a pl] => bool"  ("_[[_]]" [100,0] 100)
where
  "tt[[false]] = False"
| "tt[[#v]] = (v \<in> tt)"
| eval_imp: "tt[[p->q]] = (tt[[p]] --> tt[[q]])"

text \<open>
  A finite set of hypotheses from \<open>t\<close> and the \<open>Var\<close>s in
  \<open>p\<close>.
\<close>

primrec hyps :: "['a pl, 'a set] => 'a pl set"
where
  "hyps false  tt = {}"
| "hyps (#v)   tt = {if v \<in> tt then #v else #v->false}"
| "hyps (p->q) tt = hyps p tt Un hyps q tt"

subsubsection \<open>Logical consequence\<close>

text \<open>
  For every valuation, if all elements of \<open>H\<close> are true then so
  is \<open>p\<close>.
\<close>

definition sat :: "['a pl set, 'a pl] => bool"  (infixl "|=" 50)
  where "H |= p = (\<forall>tt. (\<forall>q\<in>H. tt[[q]]) --> tt[[p]])"

subsection \<open>Proof theory of propositional logic\<close>

lemma thms_mono: "G<=H ==> thms(G) <= thms(H)"
apply (rule predicate1I)
apply (erule thms.induct)
apply (auto intro: thms.intros)
done

lemma thms_I: "H |- p->p"
  \<comment> \<open>Called \<open>I\<close> for Identity Combinator, not for Introduction.\<close>
by (best intro: thms.K thms.S thms.MP)

subsubsection \<open>Weakening, left and right\<close>

lemma weaken_left: "[| G \<subseteq> H;  G|-p |] ==> H|-p"
  \<comment> \<open>Order of premises is convenient with \<open>THEN\<close>\<close>
  by (erule thms_mono [THEN predicate1D])

lemma weaken_left_insert: "G |- p \<Longrightarrow> insert a G |- p"
by (rule weaken_left) (rule subset_insertI)

lemma weaken_left_Un1: "G |- p \<Longrightarrow> G \<union> B |- p"
by (rule weaken_left) (rule Un_upper1)

lemma weaken_left_Un2: "G |- p \<Longrightarrow> A \<union> G |- p"
by (rule weaken_left) (rule Un_upper2)

lemma weaken_right: "H |- q ==> H |- p->q"
by (fast intro: thms.K thms.MP)

subsubsection \<open>The deduction theorem\<close>

theorem deduction: "insert p H |- q  ==>  H |- p->q"
apply (induct set: thms)
apply (fast intro: thms_I thms.H thms.K thms.S thms.DN
                   thms.S [THEN thms.MP, THEN thms.MP] weaken_right)+
done

subsubsection \<open>The cut rule\<close>

lemma cut: "insert p H |- q \<Longrightarrow> H |- p \<Longrightarrow> H |- q"
by (rule thms.MP) (rule deduction)

lemma thms_falseE: "H |- false \<Longrightarrow> H |- q"
by (rule thms.MP, rule thms.DN) (rule weaken_right)

lemma thms_notE: "H |- p -> false \<Longrightarrow> H |- p \<Longrightarrow> H |- q"
by (rule thms_falseE) (rule thms.MP)

subsubsection \<open>Soundness of the rules wrt truth-table semantics\<close>

theorem soundness: "H |- p ==> H |= p"
by (induct set: thms) (auto simp: sat_def)

subsection \<open>Completeness\<close>

subsubsection \<open>Towards the completeness proof\<close>

lemma false_imp: "H |- p->false ==> H |- p->q"
apply (rule deduction)
apply (metis H insert_iff weaken_left_insert thms_notE)
done

lemma imp_false:
    "[| H |- p;  H |- q->false |] ==> H |- (p->q)->false"
apply (rule deduction)
apply (metis H MP insert_iff weaken_left_insert)
done

lemma hyps_thms_if: "hyps p tt |- (if tt[[p]] then p else p->false)"
  \<comment> \<open>Typical example of strengthening the induction statement.\<close>
apply simp
apply (induct p)
apply (simp_all add: thms_I thms.H)
apply (blast intro: weaken_left_Un1 weaken_left_Un2 weaken_right
                    imp_false false_imp)
done

lemma sat_thms_p: "{} |= p ==> hyps p tt |- p"
  \<comment> \<open>Key lemma for completeness; yields a set of assumptions
        satisfying \<open>p\<close>\<close>
unfolding sat_def
by (metis (full_types) empty_iff hyps_thms_if)

text \<open>
  For proving certain theorems in our new propositional logic.
\<close>

declare deduction [intro!]
declare thms.H [THEN thms.MP, intro]

text \<open>
  The excluded middle in the form of an elimination rule.
\<close>

lemma thms_excluded_middle: "H |- (p->q) -> ((p->false)->q) -> q"
apply (rule deduction [THEN deduction])
apply (rule thms.DN [THEN thms.MP], best intro: H)
done

lemma thms_excluded_middle_rule:
    "[| insert p H |- q;  insert (p->false) H |- q |] ==> H |- q"
  \<comment> \<open>Hard to prove directly because it requires cuts\<close>
by (rule thms_excluded_middle [THEN thms.MP, THEN thms.MP], auto)

subsection\<open>Completeness -- lemmas for reducing the set of assumptions\<close>

text \<open>
  For the case \<^prop>\<open>hyps p t - insert #v Y |- p\<close> we also have \<^prop>\<open>hyps p t - {#v} \<subseteq> hyps p (t-{v})\<close>.
\<close>

lemma hyps_Diff: "hyps p (t-{v}) <= insert (#v->false) ((hyps p t)-{#v})"
by (induct p) auto

text \<open>
  For the case \<^prop>\<open>hyps p t - insert (#v -> Fls) Y |- p\<close> we also have
  \<^prop>\<open>hyps p t-{#v->Fls} \<subseteq> hyps p (insert v t)\<close>.
\<close>

lemma hyps_insert: "hyps p (insert v t) <= insert (#v) (hyps p t-{#v->false})"
by (induct p) auto

text \<open>Two lemmas for use with \<open>weaken_left\<close>\<close>

lemma insert_Diff_same: "B-C <= insert a (B-insert a C)"
by fast

lemma insert_Diff_subset2: "insert a (B-{c}) - D <= insert a (B-insert c D)"
by fast

text \<open>
  The set \<^term>\<open>hyps p t\<close> is finite, and elements have the form
  \<^term>\<open>#v\<close> or \<^term>\<open>#v->Fls\<close>.
\<close>

lemma hyps_finite: "finite(hyps p t)"
by (induct p) auto

lemma hyps_subset: "hyps p t <= (UN v. {#v, #v->false})"
by (induct p) auto

lemma Diff_weaken_left: "A \<subseteq> C \<Longrightarrow> A - B |- p \<Longrightarrow> C - B |- p"
  by (rule Diff_mono [OF _ subset_refl, THEN weaken_left])

subsubsection \<open>Completeness theorem\<close>

text \<open>
  Induction on the finite set of assumptions \<^term>\<open>hyps p t0\<close>.  We
  may repeatedly subtract assumptions until none are left!
\<close>

lemma completeness_0_lemma:
    "{} |= p ==> \<forall>t. hyps p t - hyps p t0 |- p"
apply (rule hyps_subset [THEN hyps_finite [THEN finite_subset_induct]])
 apply (simp add: sat_thms_p, safe)
 txt\<open>Case \<open>hyps p t-insert(#v,Y) |- p\<close>\<close>
 apply (iprover intro: thms_excluded_middle_rule
                     insert_Diff_same [THEN weaken_left]
                     insert_Diff_subset2 [THEN weaken_left]
                     hyps_Diff [THEN Diff_weaken_left])
txt\<open>Case \<open>hyps p t-insert(#v -> false,Y) |- p\<close>\<close>
 apply (iprover intro: thms_excluded_middle_rule
                     insert_Diff_same [THEN weaken_left]
                     insert_Diff_subset2 [THEN weaken_left]
                     hyps_insert [THEN Diff_weaken_left])
done

text\<open>The base case for completeness\<close>
lemma completeness_0:  "{} |= p ==> {} |- p"
  by (metis Diff_cancel completeness_0_lemma)

text\<open>A semantic analogue of the Deduction Theorem\<close>
lemma sat_imp: "insert p H |= q ==> H |= p->q"
by (auto simp: sat_def)

theorem completeness: "finite H ==> H |= p ==> H |- p"
apply (induct arbitrary: p rule: finite_induct)
 apply (blast intro: completeness_0)
apply (iprover intro: sat_imp thms.H insertI1 weaken_left_insert [THEN thms.MP])
done

theorem syntax_iff_semantics: "finite H ==> (H |- p) = (H |= p)"
by (blast intro: soundness completeness)

end


theory Artin
 imports "HOL-Algebra.Algebra" "HOL-Examples.Gauss_Numbers"
begin

(*
problem_number:2_2_9
natural language statement:
Let $H$ be the subgroup generated by two elements $a, b$ of a group $G$. Prove that if $a b=b a$, then $H$ is an abelian group.
lean statement:
theorem exercise_2_2_9 {G : Type*} [group G] {a b : G}
  (h : a * b = b * a) :
  \<forall> x y : closure {x | x = a \<or> x = b}, x*y = y*x :=

codex statement:
theorem abelian_of_commutative_generator:
  fixes G::"('a, 'b) monoid_scheme" (structure) and a b::'a
  assumes "group G" "a\<in>carrier G" "b\<in>carrier G" "a * b = b * a"
  shows "abelian (subgroup_generated G {a, b})"
Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem (in group) exercise_2_2_9:
  assumes "a \<in> carrier G" "b \<in> carrier G" "a\<noteq>b"
  shows "comm_group (subgroup_generated G {a,b})"
  oops

(*
problem_number:2_3_1
natural language statement:
Prove that the additive group $\mathbb{R}^{+}$ of real numbers is isomorphic to the multiplicative group $P$ of positive reals.
lean statement:

codex statement:
theorem isomorphic_additive_group_of_real_to_multiplicative_group_of_positive_real:
  shows "add_group_hom (\<lambda>x. exp x) (\<lambda>x. ln x) (UNIV::real set)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_2_3_1:
  defines "RA_group \<equiv> \<lparr>carrier = UNIV, monoid.mult = (+), one = (0::real)\<rparr>"
  defines "RM_group \<equiv> \<lparr>carrier = {0<..}, monoid.mult = (*), one = (1::real)\<rparr>"
  shows "RA_group \<cong> RM_group"
oops

(*
problem_number:2_3_2
natural language statement:
Prove that the products $a b$ and $b a$ are conjugate elements in a group.
lean statement:
theorem exercise_2_3_2 {G : Type*} [group G] (a b : G) :
  \<exists> g : G, b* a = g * a * b * inv g :=

codex statement:
theorem conjugate_of_product_of_conjugate:
  fixes G::"('a, 'b) monoid_scheme" (structure)
  assumes "group G"
  shows "\<forall>a b. a * b = b * a"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem (in group) exercise_2_3_2:
  assumes "a \<in> carrier G" "b \<in> carrier G"
  shows "\<exists>x \<in> carrier G. a \<otimes> b = inv x \<otimes> b \<otimes> a \<otimes> x"
  using assms by force

(*
problem_number:2_4_19
natural language statement:
Prove that if a group contains exactly one element of order 2 , then that element is in the center of the group.
lean statement:
theorem exercise_2_4_19 {G : Type*} [group G] {x : G}
  (hx : order_of x = 2) (hx1 : \<forall> y, order_of y = 2 \<rightarrow> y = x) :
  x \<in> center G :=

codex statement:
theorem center_of_group_contains_only_one_element_of_order_2:
  fixes G::"('a, 'b) monoid_scheme" (structure)
  assumes "group G" "\<exists>x. order x = 2" "\<forall>x. order x = 2 \<longrightarrow> x = y"
  shows "y \<in> center G"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)

definition (in group) "centre \<equiv> {z \<in> carrier G. \<forall>x \<in> carrier G. z \<otimes> x = x \<otimes> z}"

theorem (in group) exercise_2_4_19:
  assumes "a \<in> carrier G" "ord a = 2" "\<forall>x \<in> carrier G. ord x = 2 \<longrightarrow> x=a"
  shows "a \<in> centre"
  oops

(*
problem_number:2_8_6
natural language statement:
Prove that the center of the product of two groups is the product of their centers.
lean statement:
theorem exercise_2_8_6 {G H : Type*} [group G] [group H] :
  center (G \<times> H) \<cong>* (center G) \<times> (center H) :=

codex statement:
theorem center_of_prod_eq_prod_of_center:
  fixes G H::"('a, 'b) monoid_scheme" (structure)
  assumes "group G" "group H"
  shows "center (G \<times> H) = center G \<times> center H"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_2_8_6:
  assumes "group G" "group H"
  shows "group.centre (G \<times>\<times> H) = group.centre G \<times> group.centre H"
  oops

(*
problem_number:2_10_11
natural language statement:
Prove that the groups $\mathbb{R}^{+} / \mathbb{Z}^{+}$and $\mathbb{R}^{+} / 2 \pi \mathbb{Z}^{+}$are isomorphic.
lean statement:

codex statement:
theorem isomorphic_of_R_plus_Z_plus_and_R_plus_two_pi_Z_plus:
  shows "isomorphic_group (R_plus / Z_plus) (R_plus / two_pi_Z_plus)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_2_10_11:
  defines "RP_group \<equiv> \<lparr>carrier = UNIV, monoid.mult = (+), one = (0::real)\<rparr>"
  shows "RP_group Mod \<int> \<cong> RP_group Mod (range(\<lambda>z. 2 * pi * of_int z))"
  oops

(*
problem_number:2_11_3
natural language statement:
Prove that a group of even order contains an element of order $2 .$
lean statement:
theorem exercise_2_11_3 {G : Type*} [group G] [fintype G]
  (hG : even (card G)) : \<exists> x : G, order_of x = 2 :=

codex statement:
theorem injective_of_homomorphism_of_fields:
  fixes f::"'a::field \<Rightarrow> 'b::field"
  assumes "homomorphism f"
  shows "inj f"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem (in group) exercise_2_11_3:
  assumes "even (order G)"
  shows "\<exists>x \<in> carrier G. ord x = 2"
  oops

(*
problem_number:3_2_7
natural language statement:
Prove that every homomorphism of fields is injective.
lean statement:
theorem exercise_3_2_7 {F : Type*} [field F] {G : Type*} [field G]
  (\<phi> : F \<rightarrow>+* G) : injective \<phi> :=

codex statement:
theorem injective_of_homomorphism_of_fields:
  fixes f::"'a::field \<Rightarrow> 'b::field"
  assumes "homomorphism f"
  shows "inj f"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_3_2_7:
  assumes "h \<in> ring_hom R S" and "field R" and "field S" shows "inj_on h (carrier R)"
  by (metis assms non_trivial_field_hom_is_inj)

(*
problem_number:3_5_6
natural language statement:
Let $V$ be a vector space which is spanned by a countably infinite set. Prove that every linearly independent subset of $V$ is finite or countably infinite.
lean statement:
theorem exercise_3_5_6 {K V : Type*} [field K] [add_comm_group V]
  [module K V] {S : set V} (hS : set.countable S)
  (hS1 : span K S = \<top>) {\<iota> : Type*} (R : \<iota> \<rightarrow> V)
  (hR : linear_independent K R) : countable \<iota> :=

codex statement:
theorem independent_of_countable_span_is_finite_or_countable:
  fixes v::"'a::euclidean_space set"
  assumes "independent v" "countable (span v)"
  shows "finite v \<or> countable v"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_3_5_6: undefined oops

(*
problem_number:3_7_2
natural language statement:
Let $V$ be a vector space over an infinite field $F$. Prove that $V$ is not the union of finitely many proper subspaces.
lean statement:
theorem exercise_3_7_2 {K V : Type*} [field K] [add_comm_group V]
  [module K V] {\<iota> : Type*} [fintype \<iota>] (\<nu> : \<iota> \<rightarrow> submodule K V) :
  (\<Inter> (i : \<iota>), (\<nu> i : set V)) \<noteq> \<top> :=

codex statement:
theorem not_union_of_finite_proper_subspaces:
  fixes V::"'a::{field, infinite} set"
  assumes "finite S" "S \<subseteq> Pow V" "\<forall>W\<in>S. W \<subset> V" "\<forall>W\<in>S. W \<noteq> V"
  shows "\<Union>S \<noteq> V"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_3_7_2: undefined oops

(*
problem_number:6_1_14
natural language statement:
Let $Z$ be the center of a group $G$. Prove that if $G / Z$ is a cyclic group, then $G$ is abelian and hence $G=Z$.
lean statement:
theorem exercise_6_1_14 (G : Type* ) [group G]
  (hG : is_cyclic $ G / (center G)) :
  center G = \<top>  :=

codex statement:
theorem center_of_cyclic_quotient_is_abelian:
  fixes G::"('a, 'b) monoid_scheme" (structure)
  assumes "group G" "cyclic (G / Z)"
  shows "abelian G"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem (in group) exercise_6_1_14:
  assumes "cyclic_group (G Mod centre)"
  shows "comm_group G" "carrier G = centre"
  oops

(*
problem_number:6_4_2
natural language statement:
Prove that no group of order $p q$, where $p$ and $q$ are prime, is simple.
lean statement:
theorem exercise_6_4_2 {G : Type*} [group G] [fintype G] {p q : \<nat>}
  (hp : prime p) (hq : prime q) (hG : card G = p*q) :
  is_simple_group G \<rightarrow> false :=

codex statement:
theorem no_simple_group_of_order_pq:
  fixes p q::nat
  assumes "prime p" "prime q" "p \<noteq> q" "group G" "order G = p * q"
  shows "\<exists>H. subgroup H G \<and> H \<noteq> {\<one>} \<and> H \<noteq> carrier G"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)

locale simple_group = group +
  assumes order_gt_one: "order G > 1"
  assumes no_real_normal_subgroup: "\<And>H. H \<lhd> G \<Longrightarrow> (H = carrier G \<or> H = {\<one>})"

theorem (in group) exercise_6_4_2:
  assumes "order G = p*q" "Factorial_Ring.prime p" "Factorial_Ring.prime q"
  shows "\<not> simple_group G"
  oops

(*
problem_number:6_4_3
natural language statement:
Prove that no group of order $p^2 q$, where $p$ and $q$ are prime, is simple.
lean statement:
theorem exercise_6_4_3 {G : Type*} [group G] [fintype G] {p q : \<nat>}
  (hp : prime p) (hq : prime q) (hG : card G = p^2 *q) :
  is_simple_group G \<rightarrow> false :=

codex statement:
theorem not_simple_of_order_p_square_q:
  fixes p q::nat
  assumes "prime p" "prime q" "p \<noteq> q" "group G" "order G = p^2 * q"
  shows "\<exists>H. subgroup H G \<and> H \<noteq> {\<one>} \<and> H \<noteq> carrier G"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem (in group) exercise_6_4_3:
  assumes "order G = p^2 * q" "Factorial_Ring.prime p" "Factorial_Ring.prime q"
  shows "\<not> simple_group G"
  oops

(*
problem_number:6_4_12
natural language statement:
Prove that no group of order 224 is simple.
lean statement:
theorem exercise_6_4_12 {G : Type*} [group G] [fintype G]
  (hG : card G = 224) :
  is_simple_group G \<rightarrow> false :=

codex statement:
theorem no_simple_group_of_order_224:
  fixes G::"('a, 'b) monoid_scheme" (structure)
  assumes "group G" "order G = 224"
  shows "\<exists>H. subgroup H G \<and> H \<noteq> (carrier G) \<and> H \<noteq> {\<one>}"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_6_4_12:
  assumes "order G = 224"
  shows "\<not> simple_group G"
  oops

(*
problem_number:6_8_1
natural language statement:
Prove that two elements $a, b$ of a group generate the same subgroup as $b a b^2, b a b^3$.
lean statement:
theorem exercise_6_8_1 {G : Type*} [group G]
  (a b : G) : closure ({a, b} : set G) = closure {b*a*b^2, b*a*b^3} :=

codex statement:
theorem subgroup_generated_by_two_elements_eq_subgroup_generated_by_two_elements:
  fixes G::"('a, 'b) monoid_scheme" (structure)
  assumes "group G"
  shows "subgroup_generated G {a, b} = subgroup_generated G {b * a * b^2, b * a * b^3}"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem (in group) exercise_6_8_1:
  assumes "a \<in> carrier G" "b \<in> carrier G"
    shows "generate G {a,b} = generate G {b\<otimes>a\<otimes>b[^]2, b\<otimes>a\<otimes>b[^]3}"
  oops

(*
problem_number:6_8_4
natural language statement:
Prove that the group generated by $x, y, z$ with the single relation $y x y z^{-2}=1$ is actually a free group.
lean statement:
theorem exercise_6_8_4 {\<alpha> : Type*} [group \<alpha>] [free_group \<alpha>] (x y z : \<alpha>):
  closure ({x,y,z} : set \<alpha>) :=

codex statement:
theorem free_group_of_generators_and_relation:
  fixes x y z::"'a::group_add"
  assumes "y + x + y + - z - z = 0"
  shows "\<exists>G. free_group G \<and> {x, y, z} \<subseteq> carrier G"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_6_8_4: undefined oops

(*
problem_number:6_8_6
natural language statement:
Let $G$ be a group with a normal subgroup $N$. Assume that $G$ and $G / N$ are both cyclic groups. Prove that $G$ can be generated by two elements.
lean statement:
theorem exercise_6_8_6 {G : Type*} [group G] (N : subgroup G)
  [N.normal] (hG : is_cyclic G) (hGN : is_cyclic (G / N)) :
  \<exists> (g h : G), closure ({g,h} : set G) = \<top> :=

codex statement:
theorem exists_two_generators_of_cyclic_quotient_and_cyclic_group:
  fixes G::"('a, 'b) monoid_scheme" (structure)
  assumes "group G" "cyclic G" "normal_subgroup N G" "cyclic (G / N)"
  shows "\<exists>x y. x \<in> carrier G \<and> y \<in> carrier G \<and> G = \<lbrakk>x, y\<rbrakk>"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)

(*The text is ambiguous. The two elements must be distinct, because a cyclic group is one that
can be generated from one element.*)
theorem (in group) exercise_6_8_6:
  assumes "normal N G" "cyclic_group G" "cyclic_group (G Mod N)"
  shows "\<exists>x \<in> carrier G. \<exists>y \<in> carrier G. x\<noteq>y \<and> carrier G = generate G {x,y}"
  sorry

(*
problem_number:10_1_13
natural language statement:
An element $x$ of a ring $R$ is called nilpotent if some power of $x$ is zero. Prove that if $x$ is nilpotent, then $1+x$ is a unit in $R$.
lean statement:
theorem exercise_10_1_13 {R : Type*} [ring R] {x : R}
  (hx : is_nilpotent x) : is_unit (1 + x) :=

codex statement:
theorem one_plus_nilpotent_is_unit:
  fixes R::"'a::ring_1"
  assumes "\<exists>n. x^n = 0"
  shows "\<exists>y. y * (1 + x) = 1"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem (in ring) exercise_10_1_13:
  assumes "x \<in> carrier R" "x[^]n = \<zero>"
  shows "x \<in> carrier (units_of R)"
  oops

(*
problem_number:10_2_4
natural language statement:
Prove that in the ring $\mathbb{Z}[x],(2) \cap(x)=(2 x)$.
lean statement:
theorem exercise_10_2_4 :
  span ({2} : set $ polynomial \<int>) \<sqinter> (span {X}) =
  span ({2 * X} : set $ polynomial \<int>) :=

codex statement:
theorem int_poly_ideal_inter_ideal_eq_ideal_mul:
  fixes p::"int poly"
  assumes "p \<in> ideal_of_int_poly (2::int)" "p \<in> ideal_of_int_poly [:2:]"
  shows "p \<in> ideal_of_int_poly [:2*2:]"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_10_2_4: undefined oops

(*
problem_number:10_6_7
natural language statement:
Prove that every nonzero ideal in the ring of Gauss integers contains a nonzero integer.
lean statement:
theorem exercise_10_6_7 {I : ideal gaussian_int}
  (hI : I \<noteq> \<bot>) : \<exists> (z : I), z \<noteq> 0 \<and> (z : gaussian_int).im = 0 :=

codex statement:
theorem exists_nonzero_int_of_nonzero_ideal:
  fixes I::"int set"
  assumes "I \<noteq> {0}"
  shows "\<exists>x\<in>I. x\<noteq>0"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_10_6_7:
  defines "GI \<equiv>  \<lparr>carrier = UNIV, monoid.mult = (*), one = 1, ring.zero = (0::gauss), add = (+)\<rparr>"
  assumes "ideal I GI" "I \<noteq> {0}"
  shows "\<exists>x\<in>I. Im x = 0 \<and> x \<noteq> 0"
  oops

(*
problem_number:10_6_16
natural language statement:
Prove that a polynomial $f(x)=\sum a_i x^i$ can be expanded in powers of $x-a$ : $f(x)=\Sigma c_i(x-a)^i$, and that the coefficients $c_i$ are polynomials in the coefficients $a_i$, with integer coefficients.
lean statement:

codex statement:
theorem polynomial_expansion_of_polynomial:
  fixes f::"real \<Rightarrow> real" and a::real
  assumes "polynomial f"
  shows "\<exists>c. (\<forall>x. f x = (\<Sum>i. c i (x - a)^i)) \<and> (\<forall>i. polynomial (c i)) \<and> (\<forall>i. \<forall>j. coeff (c i) j \<in> \<int>)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_10_6_16: undefined oops

(*
problem_number:10_3_24a
natural language statement:
Let $I, J$ be ideals of a ring $R$. Show by example that $I \cup J$ need not be an ideal.
lean statement:

codex statement:
theorem union_of_ideals_is_not_ideal:
  fixes R::"'a::comm_ring_1 ring" and I J::"'a set"
  assumes "ideal I R" "ideal J R"
  shows "\<exists>x y. x\<in>I \<and> y\<in>J \<and> x+y\<notin>I \<union> J"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_10_3_24a:
  shows "\<exists>R I J. ring R \<and> ideal I R \<and> ideal J R \<and> \<not> ideal (I \<union> J) R"
  oops

(*
problem_number:10_4_6
natural language statement:
Let $I, J$ be ideals in a ring $R$. Prove that the residue of any element of $I \cap J$ in $R / I J$ is nilpotent.
lean statement:
theorem exercise_10_4_6 {R : Type*} [comm_ring R]
  [no_zero_divisors R] {I J : ideal R} (x : I \<sqinter> J) :
  is_nilpotent ((ideal.quotient.mk (I*J)) x) :=

codex statement:
theorem residue_of_inter_ideal_is_nilpotent:
  fixes R::"'a::comm_ring_1" and I J::"'a set"
  assumes "ideal I R" "ideal J R"
  shows "\<forall>x\<in>I\<inter>J. \<exists>n. (x + I J)^n = 0"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_10_4_6: undefined oops

(*
problem_number:10_4_7a
natural language statement:
Let $I, J$ be ideals of a ring $R$ such that $I+J=R$. Prove that $I J=I \cap J$.
lean statement:
theorem exercise_10_4_7a {R : Type*} [comm_ring R] [no_zero_divisors R]
  (I J : ideal R) (hIJ : I + J = \<top>) : I * J = I \<sqinter> J :=

codex statement:
theorem ideal_intersection_eq_product_of_ideals_of_sum_eq_ring:
  fixes R::"'a::comm_ring_1 ring" and I J::"'a set"
  assumes "ideal I R" "ideal J R" "I + J = carrier R"
  shows "I \<inter> J = I * J"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_10_4_7a: undefined oops

(*
problem_number:10_5_16
natural language statement:
Let $F$ be a field. Prove that the rings $F[x] /\left(x^2\right)$ and $F[x] /\left(x^2-1\right)$ are isomorphic if and only if $F$ has characteristic $2 .$
lean statement:
theorem exercise_10_5_16 {F : Type*} [fintype F] [field F] :
  is_empty ((polynomial F) / ideal.span ({X^2} : set (polynomial F)) \<cong>
  (polynomial F) / ideal.span ({X^2 - 1} : set (polynomial F))) \<longleftrightarrow>
  ring_char F \<noteq> 2 :=

codex statement:
theorem isomorphic_of_char_two:
  fixes F::"'a::field"
  assumes "char F = 2"
  shows "F[x] /\<langle>x^2\<rangle> \<cong> F[x] /\<langle>x^2 - 1\<rangle>"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_10_5_16: undefined oops

(*
problem_number:10_7_6
natural language statement:
Prove that the ring $\mathbb{F}_5[x] /\left(x^2+x+1\right)$ is a field.
lean statement:
theorem exercise_10_7_6 {F : Type*} [fintype F] [field F]
  (hF : card F = 5) :
  field $ (polynomial F) / ideal.span ({X^2 + X + 1} : set (polynomial F)) :=

codex statement:
theorem quotient_ring_is_field:
  fixes R::"('a::comm_ring_1) ring"
  assumes "\<forall>x. x^2 + x + 1 = 0 \<longrightarrow> x = 0"
  shows "field (R/(x^2 + x + 1))"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_10_7_6: undefined oops

(*
problem_number:10_7_10
natural language statement:
Let $R$ be a ring, with $M$ an ideal of $R$. Suppose that every element of $R$ which is not in $M$ is a unit of $R$. Prove that $M$ is a maximal ideal and that moreover it is the only maximal ideal of $R$.
lean statement:
theorem exercise_10_7_10 {R : Type*} [ring R]
  (M : ideal R) (hM : \<forall> (x : R), x \<notin> M \<rightarrow> is_unit x) :
  is_maximal M \<and> \<forall> (N : ideal R), is_maximal N \<rightarrow> N = M :=

codex statement:
theorem ideal_of_ring_is_maximal_of_every_non_member_is_unit:
  fixes R::"'a::comm_ring_1 ring" and M::"'a set"
  assumes "ideal M R" "\<forall>x\<in>carrier R. x\<notin>M \<longrightarrow> is_unit R x"
  shows "maximal_ideal M R"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_10_7_10: undefined oops

(*
problem_number:11_2_13
natural language statement:
If $a, b$ are integers and if $a$ divides $b$ in the ring of Gauss integers, then $a$ divides $b$ in $\mathbb{Z}$.
lean statement:
theorem exercise_11_2_13 (a b : \<int>) :
  (of_int a : gaussian_int)  dvd  of_int b \<rightarrow> a  dvd  b :=

codex statement:
theorem divides_of_Gauss_divides:
  fixes a b::int
  assumes "a dvd b" "a\<in>{x. \<exists>y. x = y*y}"
  shows "a dvd b"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_2_13:
  assumes "Gauss a 0 dvd Gauss b 0"
  shows "a dvd b"
  oops

(*
problem_number:11_3_1
natural language statement:
Let $a, b$ be elements of a field $F$, with $a \neq 0$. Prove that a polynomial $f(x) \in F[x]$ is irreducible if and only if $f(a x+b)$ is irreducible.
lean statement:
theorem exercise_11_3_1 {F : Type*} [field F] (a b : F) (ha : a \<noteq> 0) (p : polynomial F) :
  irreducible p \<longleftrightarrow> irreducible (\<Sum> n in p.support, p.coeff n \<bullet> (a \<bullet> X + b \<bullet> 1)^n : polynomial F) :=

codex statement:
theorem irreducible_of_irreducible_of_linear_transform:
  fixes a b::"'a::field" and f::"'a poly"
  assumes "a \<noteq> 0" "irreducible f"
  shows "irreducible (map_poly (\<lambda>x. a*x + b) f)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_3_1: undefined oops

(*
problem_number:11_3_2
natural language statement:
Let $F=\mathbb{C}(x)$, and let $f, g \in \mathbb{C}[x, y]$. Prove that if $f$ and $g$ have a common factor in $F[y]$, then they also have a common factor in $\mathbb{C}[x, y]$.
lean statement:

codex statement:
theorem exists_common_factor_of_common_factor_in_poly_ring:
  fixes f g::"complex poly"
  assumes "\<exists>h. h dvd f \<and> h dvd g \<and> h \<in> F[y]"
  shows "\<exists>h. h dvd f \<and> h dvd g"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_3_2: undefined oops

(*
problem_number:11_3_4
natural language statement:
Prove that two integer polynomials are relatively prime in $\mathbb{Q}[x]$ if and only if the ideal they generate in $\mathbb{Z}[x]$ contains an integer.
lean statement:
theorem exercise_11_3_4 : irreducible (X^3 + 6*X + 12 : polynomial \<rat>) :=

codex statement:
theorem relatively_prime_of_ideal_contains_int:
  fixes f g::"int poly"
  assumes "\<exists>a. a\<in>ideal_generated_by f g"
  shows "relatively_prime f g"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_3_4: undefined oops

(*
problem_number:11_4_1b
natural language statement:
Prove that $x^3 + 6x + 12$ is irreducible in $\mathbb{Q}$.
lean statement:
theorem exercise_11_4_1b {F : Type*} [field F] [fintype F] (hF : card F = 2) :
  irreducible (12 + 6 * X + X ^ 3 : polynomial F) :=

codex statement:
theorem irreducible_of_polynomial_of_degree_3:
  fixes x::"real poly"
  assumes "degree x = 3" "\<forall>x. x^3 + 6*x + 12 = (x+2)*x^2"
  shows "irreducible x"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_4_1b: undefined oops

(*
problem_number:11_4_6a
natural language statement:
Prove that $x^2+x+1$ is irreducible in the field $\mathbb{F}_2$.
lean statement:
theorem exercise_11_4_6a {F : Type*} [field F] [fintype F] (hF : card F = 7) :
  irreducible (X ^ 2 + 1 : polynomial F) :=

codex statement:
theorem irreducible_of_poly_over_finite_field:
  fixes x::"'a::{field_char_0,finite}"
  assumes "char_poly x = [:1,1,1:]"
  shows "irreducible (char_poly x)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_4_6a: undefined oops

(*
problem_number:11_4_6b
natural language statement:
Prove that $x^2+1$ is irreducible in $\mathbb{F}_7$
lean statement:
theorem exercise_11_4_6b {F : Type*} [field F] [fintype F] (hF : card F = 31) :
  irreducible (X ^ 3 - 9 : polynomial F) :=

codex statement:
theorem irreducible_of_x_square_plus_one:
  fixes x::"'a::{field, comm_ring_1}"
  assumes "char_0 (UNIV::'a set)"
  shows "irreducible (x^2 + 1)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_4_6b: undefined oops

(*
problem_number:11_4_6c
natural language statement:
Prove that $x^3 - 9$ is irreducible in $\mathbb{F}_{31}$.
lean statement:
theorem exercise_11_4_6c : irreducible (X^3 - 9 : polynomial (zmod 31)) :=

codex statement:
theorem irreducible_of_x_cube_minus_nine:
  assumes "prime p" "p > 3"
  shows "irreducible (poly_of_list [1, 0, 0, -9] :: 'a mod_ring poly)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_4_6c: undefined oops

(*
problem_number:11_4_8
natural language statement:
Let $p$ be a prime integer. Prove that the polynomial $x^n-p$ is irreducible in $\mathbb{Q}[x]$.
lean statement:
theorem exercise_11_4_8 {p : \<nat>} (hp : prime p) (n : \<nat>) :
  irreducible (X ^ n - p : polynomial \<rat>) :=

codex statement:
theorem irreducible_of_prime_power:
  fixes p::nat and n::nat
  assumes "prime p"
  shows "irreducible (poly_of_nat p ^ n - 1)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_4_8: undefined oops

(*
problem_number:11_4_10
natural language statement:
Let $p$ be a prime integer, and let $f \in \mathbb{Z}[x]$ be a polynomial of degree $2 n+1$, say $f(x)=a_{2 n+1} x^{2 n+1}+\cdots+a_1 x+a_0$. Suppose that $a_{2 n+1} \neq 0$ (modulo $p$ ), $a_0, a_1, \ldots, a_n \equiv 0$ (modulo $p^2$ ), $a_{n+1}, \ldots, a_{2 n} \equiv 0$ (modulo $p$ ), $a_0 \not\equiv 0$ (modulo $p^3$ ). Prove that $f$ is irreducible in $\mathbb{Q}[x]$.
lean statement:

codex statement:
theorem irreducible_of_degree_odd_and_coeff_mod_p_eq_zero:
  fixes p::nat and f::"int poly"
  assumes "prime p" "degree f = 2*n+1" "coeff f (2*n+1) mod p \<noteq> 0" "\<forall>i\<le>n. coeff f i mod p^2 = 0" "\<forall>i. n < i \<and> i \<le> 2*n \<longrightarrow> coeff f i mod p = 0" "coeff f 0 mod p^3 \<noteq> 0"
  shows "irreducible f"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_4_10: undefined oops

(*
problem_number:11_9_4
natural language statement:
Let $p$ be a prime which splits in $R$, say $(p)=P \bar{P}$, and let $\alpha \in P$ be any element which is not divisible by $p$. Prove that $P$ is generated as an ideal by $(p, \alpha)$.
lean statement:

codex statement:
theorem ideal_generated_by_prime_and_non_divisible_element:
  fixes R::"'a::comm_ring_1" and p::"'a"
  assumes "prime p" "p ∣ (\<Prod>i\<in>I. f i)" "\<forall>i\<in>I. p ∣ f i \<longrightarrow> p ∣ g i" "\<forall>i\<in>I. p ∣ g i \<longrightarrow> p ∣ f i"
  shows "p ∣ (\<Prod>i\<in>I. g i)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_9_4: undefined oops

(*
problem_number:11_12_3
natural language statement:
Prove that if $x^2 \equiv-5$ (modulo $p$ ) has a solution, then there is an integer point on one of the two ellipses $x^2+5 y^2=p$ or $2 x^2+2 x y+3 y^2=p$.
lean statement:
theorem exercise_11_12_3 (p : \<nat>) (hp : nat.prime p) {a : zmod p}
    (ha : a^2 = -5) :
    \<exists> (x y : \<int>), x ^ 2 + 5 * y ^ 2 = p \<or> 2 * x ^ 2 + 2 * x * y + 3 * y ^ 2 = p :=

codex statement:
theorem exists_integer_point_of_ellipse_of_congruence_mod_p:
  fixes p::nat
  assumes "\<exists>x. x^2 \<equiv> -5 (mod p)"
  shows "\<exists>x y. x^2 + 5 * y^2 = p \<or> 2 * x^2 + 2 * x * y + 3 * y^2 = p"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_12_3: undefined oops

(*
problem_number:11_13_3
natural language statement:
Prove that there are infinitely many primes congruent to $-1$ (modulo 4 ).
lean statement:
theorem exercise_11_13_3 (N : \<nat>):
  \<exists> p \<ge> N, nat.prime p \<and> p + 1 \<equiv> 0 [MOD 4] :=

codex statement:
theorem exists_infinite_primes_congruent_minus_one_mod_four:
  shows "\<exists>p. prime p \<and> p \<equiv> -1 [MOD 4]"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_11_13_3:
  shows "\<exists>p \<ge> N. Factorial_Ring.prime p \<and> 4 dvd (Suc p)"
  oops

(*
problem_number:13_1_3
natural language statement:
Let $R$ be an integral domain containing a field $F$ as subring and which is finite-dimensional when viewed as vector space over $F$. Prove that $R$ is a field.
lean statement:

codex statement:
theorem field_of_integral_domain_finite_dim_over_field:
  fixes R::"'a::field ring" and F::"'a ring"
  assumes "ring R" "ring F" "subring F R" "finite_dimensional F R"
  shows "field R"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_13_1_3: undefined oops

(*
problem_number:13_3_1
natural language statement:
Let $F$ be a field, and let $\alpha$ be an element which generates a field extension of $F$ of degree 5. Prove that $\alpha^2$ generates the same extension.
lean statement:

codex statement:
theorem exists_eq_of_degree_eq_of_generator:
  fixes F::"'a::field" and \<alpha>::"'a"
  assumes "degree F \<alpha> = 5"
  shows "\<exists>\<beta>. degree F \<beta> = 5 \<and> F \<subseteq> F[\<beta>]"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_13_3_1: undefined oops

(*
problem_number:13_3_8
natural language statement:
Let $K$ be a field generated over $F$ by two elements $\alpha, \beta$ of relatively prime degrees $m, n$ respectively. Prove that $[K: F]=m n$.
lean statement:

codex statement:
theorem degree_of_field_generated_by_two_elements_of_relatively_prime_degrees:
  fixes F::"'a::field_char_0" and \<alpha> \<beta>::"'a"
  assumes "degree \<alpha> m" "degree \<beta> n" "coprime m n"
  shows "degree F (\<alpha>, \<beta>) (m * n)"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_13_3_8: undefined oops

(*
problem_number:13_4_10
natural language statement:
Prove that if a prime integer $p$ has the form $2^r+1$, then it actually has the form $2^{2^k}+1$.
lean statement:
theorem exercise_13_4_10
    {p : \<nat>} {hp : nat.prime p} (h : \<exists> r : \<nat>, p = 2 ^ r + 1) :
    \<exists> (k : \<nat>), p = 2 ^ (2 ^ k) + 1 :=

codex statement:
theorem prime_of_form_2_pow_r_add_1_is_2_pow_2_pow_k_add_1:
  fixes p::nat
  assumes "prime p" "\<exists>r. p = 2^r + 1"
  shows "\<exists>k. p = 2^(2^k) + 1"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_13_4_10:
  assumes "Factorial_Ring.prime p" "p = Suc (2^r)"
  shows "\<exists>k. p = Suc (2^2^k)"
  oops

(*
problem_number:13_6_10
natural language statement:
Let $K$ be a finite field. Prove that the product of the nonzero elements of $K$ is $-1$.
lean statement:
theorem exercise_13_6_10 {K : Type*} [field K] [fintype K x] :
  \<Prod> (x : K x), x = -1 :=

codex statement:
theorem product_nonzero_eq_minus_one:
  fixes K::"'a::field_char_0"
  assumes "finite K" "card K > 1"
  shows "(\<Prod>x\<in>K. if x=0 then 1 else x) = -1"

Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_13_6_10: undefined oops

end


section \<open>Generic Computability\<close>

theory Computability
imports HOLCF HOLCFUtils
begin

text \<open>
Shivers proves the computability of the abstract semantics functions only by generic and slightly simplified example. This theory contains the abstract treatment in Section 4.4.3. Later, we will work out the details apply this to \<open>\<aPR>\<close>.
\<close>

subsection \<open>Non-branching case\<close>

text \<open>

After the following lemma (which could go into @{theory HOL.Set_Interval}), we show Shivers' Theorem 10. This says that the least fixed point of the equation
\[
f\ x = g\ x \cup f\ (r\ x)
\]
is given by
\[
f\ x = \bigcup_{i\ge 0} g\ (r^i\ x).
\]

The proof follows the standard proof of showing an equality involving a fixed point: First we show that the right hand side fulfills the above equation and then show that our solution is less than any other solution to that equation.
\<close>

lemma insert_greaterThan:
  "insert (n::nat) {n<..} = {n..}"
by auto

lemma theorem10:
  fixes g :: "'a::cpo \<rightarrow> 'b::type set" and r :: "'a \<rightarrow> 'a"
  shows "fix\<cdot>(\<Lambda> f x. g\<cdot>x \<union> f\<cdot>(r\<cdot>x)) = (\<Lambda> x. (\<Union>i. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x)))"
proof(induct rule:fix_eqI[OF cfun_eqI cfun_belowI, case_names fp least])
case (fp x)
  have "g\<cdot>x \<union> (\<Union>i. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>(r\<cdot>x))) = g\<cdot>(r\<^bsup>0\<^esup>\<cdot>x) \<union> (\<Union>i. g\<cdot>(r\<^bsup>Suc i\<^esup>\<cdot>x))"
    by (simp add: iterate_Suc2 del: iterate_Suc)
  also have "\<dots> = g\<cdot>(r\<^bsup>0\<^esup>\<cdot>x) \<union> (\<Union>i\<in>{0<..}. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x))"
    using less_iff_Suc_add by auto
  also have "\<dots>  = (\<Union>i\<in>insert 0 {0<..}. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x))"
    by simp
  also have "... = (\<Union>i. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x))"
    by (simp only: insert_greaterThan atLeast_0 )
  finally
  show ?case by auto
next
case (least f x)
  hence expand: "\<And>x. f\<cdot>x = (g\<cdot>x \<union> f\<cdot>(r\<cdot>x))" by (auto simp:cfun_eq_iff)
  { fix n
    have "f\<cdot>x = (\<Union>i\<in>{..n}. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x)) \<union> f\<cdot>(r\<^bsup>Suc n\<^esup>\<cdot>x)"
    proof(induct n)
      case 0 thus ?case by (auto simp add:expand[of x])
      case (Suc n)
      then have "f\<cdot>x = (\<Union>i\<in>{..n}. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x)) \<union> f\<cdot>(r\<^bsup>Suc n\<^esup>\<cdot>x)" by simp
      also have "\<dots> = (\<Union>i\<in>{..n}. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x))
                 \<union> g\<cdot>(r\<^bsup>Suc n\<^esup>\<cdot>x) \<union> f\<cdot>(r\<^bsup>Suc (Suc n)\<^esup>\<cdot>x)"
             by(subst expand[of "r\<^bsup>Suc n\<^esup>\<cdot>x"], auto)
      also have "\<dots> = (\<Union>i\<in>insert (Suc n) {..n}. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x)) \<union> f\<cdot>(r\<^bsup>Suc (Suc n)\<^esup>\<cdot>x)"
             by auto
      also have "\<dots> = (\<Union>i\<in>{..Suc n}. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x)) \<union> f\<cdot>(r\<^bsup>Suc (Suc n)\<^esup>\<cdot>x)"
             by (simp add:atMost_Suc)
      finally show ?case .
    qed
  } note fin = this
  have "(\<Union>i. g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x)) \<subseteq> f\<cdot>x"
    proof(rule UN_least)
      fix i
      show "g\<cdot>(r\<^bsup>i\<^esup>\<cdot>x) \<subseteq> f\<cdot>x"
      using fin[of i] by auto
    qed
  thus ?case
    apply (subst sqsubset_is_subset) by auto
qed

subsection \<open>Branching case\<close>

text \<open>
Actually, our functions are more complicated than the one above: The abstract semantics functions recurse with multiple arguments. So we have to handle a recursive equation of the kind
\[
f\ x = g\ x \cup \bigcup_{a \in R\ x} f\ r.
\]
By moving to the power-set relatives of our function, e.g.
\[
{\uline g}Y = \bigcup_{a\in A} g\ a \quad \text{and} {\uline R}Y = \bigcup_{a\in R} R\ a
\]
the equation becomes
\[
{\uline f}Y ={\uline g}Y \cup {\uline f}\ ({\uline R}Y)
\]
(which is shown in Lemma 11) and we can apply Theorem 10 to obtain Theorem 12.

We define the power-set relative for a function together with some properties.
\<close>

definition powerset_lift :: "('a::cpo \<rightarrow> 'b::type set) \<Rightarrow> 'a set \<rightarrow> 'b set" ("\<^ps>")
  where "\<^ps>f = (\<Lambda> S. (\<Union>y\<in>S . f\<cdot>y))"

lemma powerset_lift_singleton[simp]:
  "\<^ps>f\<cdot>{x} = f\<cdot>x"
unfolding powerset_lift_def by simp

lemma powerset_lift_union[simp]:
  "\<^ps>f\<cdot>(A \<union> B) = \<^ps>f\<cdot>A \<union> \<^ps>f\<cdot>B"
unfolding powerset_lift_def by auto

lemma UNION_commute:"(\<Union>x\<in>A. \<Union>y\<in>B . P x y) = (\<Union>y\<in>B. \<Union>x\<in>A . P x y)"
  by auto

lemma powerset_lift_UNION:
  "(\<Union>x\<in>S. \<^ps>g\<cdot>(A x)) = \<^ps>g\<cdot>(\<Union>x\<in>S. A x)"
unfolding powerset_lift_def by auto

lemma powerset_lift_iterate_UNION:
  "(\<Union>x\<in>S. (\<^ps>g)\<^bsup>i\<^esup>\<cdot>(A x)) = (\<^ps>g)\<^bsup>i\<^esup>\<cdot>(\<Union>x\<in>S. A x)"
by (induct i, auto simp add:powerset_lift_UNION)

lemmas powerset_distr = powerset_lift_UNION powerset_lift_iterate_UNION

text \<open>
Lemma 11 shows that if a function satisfies the relation with the branching $R$, its power-set function satisfies the powerset variant of the equation.

\<close>

lemma lemma11:
  fixes f :: "'a \<rightarrow> 'b set" and g :: "'a \<rightarrow> 'b set" and R :: "'a \<rightarrow> 'a set"
  assumes "\<And>x. f\<cdot>x = g\<cdot>x \<union> (\<Union>y\<in>R\<cdot>x. f\<cdot>y)"
  shows "\<^ps>f\<cdot>S = \<^ps>g\<cdot>S \<union> \<^ps>f\<cdot>(\<^ps>R\<cdot>S)"
proof-
  have "\<^ps>f\<cdot>S = (\<Union>x\<in>S . f\<cdot>x)" unfolding powerset_lift_def by auto
  also have "\<dots> = (\<Union>x\<in>S . g\<cdot>x \<union> (\<Union>y\<in>R\<cdot>x. f\<cdot>y))" apply (subst assms) by simp
  also have "\<dots> = \<^ps>g\<cdot>S \<union> \<^ps>f\<cdot>(\<^ps>R\<cdot>S)" by (auto simp add:powerset_lift_def)
  finally
  show ?thesis .
qed

text \<open>
Theorem 10 as it will be used in Theorem 12.
\<close>
lemmas theorem10ps = theorem10[of "\<^ps>g" "\<^ps>r"] for g r

text \<open>
Now we can show Lemma 12: If $F$ is the least solution to the recursive power-set equation, then $x \mapsto F\ {x}$ is the least solution to the equation with branching $R$.

We fix the type variable \<open>'a\<close> to be a discrete cpo, as otherwise $x \mapsto \{x\}$ is not continuous.
\<close>

(* discrete_cpo, otherwise x \<mapsto> {x} not continuous *)
lemma theorem12':
  fixes g :: "'a::discrete_cpo \<rightarrow> 'b::type set" and R :: "'a \<rightarrow> 'a set"
  assumes F_fix: "F = fix\<cdot>(\<Lambda> F x. \<^ps>g\<cdot>x \<union> F\<cdot>(\<^ps>R\<cdot>x))"
  shows "fix\<cdot>(\<Lambda> f x. g\<cdot>x \<union> (\<Union>y\<in>R\<cdot>x. f\<cdot>y)) = (\<Lambda> x. F\<cdot>{x})"
proof(induct rule:fix_eqI[OF cfun_eqI cfun_belowI, case_names fp least])
have F_union: "F = (\<Lambda> x. \<Union>i. \<^ps>g\<cdot>((\<^ps>R)\<^bsup>i\<^esup>\<cdot>x))"
  using F_fix by(simp)(rule theorem10ps)
case (fp x)
   have "g\<cdot>x \<union> (\<Union>x'\<in>R\<cdot>x. F\<cdot>{x'}) = \<^ps>g\<cdot>{x} \<union> F\<cdot>(\<^ps>R\<cdot>{x})"
    unfolding powerset_lift_singleton
    by (auto simp add: powerset_distr UNION_commute F_union)
  also have "\<dots> = F\<cdot>{x}"
    by (subst (2) fix_eq4[OF F_fix], auto)
  finally show ?case by simp
next
case (least f' x)
  hence expand: "f' = (\<Lambda> x. g\<cdot>x \<union> (\<Union>y\<in>R\<cdot>x. f'\<cdot>y))" by simp
  have "\<^ps>f' = (\<Lambda> S. \<^ps>g\<cdot>S \<union> \<^ps>f'\<cdot>(\<^ps>R\<cdot>S))"
    by (subst expand, rule cfun_eqI, auto simp add:powerset_lift_def)
  hence "(\<Lambda> F. \<Lambda> x. \<^ps>g\<cdot>x \<union> F\<cdot>(\<^ps>R\<cdot>x))\<cdot>(\<^ps>f') = \<^ps>f'" by simp
  from fix_least[OF this] and F_fix
  have  "F \<sqsubseteq> \<^ps>f'"  by simp
  hence  "F\<cdot>{x} \<sqsubseteq> \<^ps>f'\<cdot>{x}"
    by (subst (asm)cfun_below_iff, auto simp del:powerset_lift_singleton)
  thus ?case by (auto simp add:sqsubset_is_subset)
qed

lemma theorem12:
  fixes g :: "'a::discrete_cpo \<rightarrow> 'b::type set" and R :: "'a \<rightarrow> 'a set"
  shows "fix\<cdot>(\<Lambda> f x. g\<cdot>x \<union> (\<Union>y\<in>R\<cdot>x. f\<cdot>y))\<cdot>x =  \<^ps>g\<cdot>(\<Union>i.((\<^ps>R)\<^bsup>i\<^esup>\<cdot>{x}))"
  by(subst theorem12'[OF theorem10ps[THEN sym]], auto simp add:powerset_distr)

end


theory ND_proofs
  imports Main
begin

lemma "A \<longrightarrow> (A \<and> A)"
proof (rule impI)
  assume A
  show "A \<and> A"
  proof (rule conjI)
    show A by fact
    show A by fact
  qed
qed

lemma "A \<longrightarrow> (A \<and> A)"
proof (rule impI)
  assume A
  then show "A \<and> A"
  proof (rule conjI)
    show A by fact
  qed
qed

lemma "A \<longrightarrow> (B \<longrightarrow> A)"
proof (rule impI)
  assume A
  show "B \<longrightarrow> A"
  proof (rule impI)
    show A by fact
  qed
qed

lemma "A \<longrightarrow> (A \<or> B)"
proof (rule impI)
  assume A
  show "A \<or> B"
  proof (rule disjI1)
    show A by fact
  qed
qed

lemma "(A \<longrightarrow> B) \<longrightarrow> ((B \<longrightarrow> C) \<longrightarrow> (A \<longrightarrow> C))"
  apply (rule impI)
  apply (rule impI)
  apply (rule impI)
  apply (erule impE)
   apply assumption
  apply (erule impE)
   apply assumption
  apply assumption
  done

thm mp
thm impE

lemma "(A \<longrightarrow> B) \<longrightarrow> ((B \<longrightarrow> C) \<longrightarrow> (A \<longrightarrow> C))"
proof (rule impI)
  assume "A \<longrightarrow> B"
  show "(B \<longrightarrow> C) \<longrightarrow> (A \<longrightarrow> C)"
  proof
    assume "B \<longrightarrow> C"
    show "A \<longrightarrow> C"
    proof (rule impI)
      assume A
      with \<open>A \<longrightarrow> B\<close> have B by (rule impE)
      with \<open>B \<longrightarrow> C\<close> show C by (rule impE)
    qed
  qed
qed

lemma "(A \<and> B) \<longrightarrow> (A \<or> B)"
proof (rule impI)
  assume "A \<and> B"
  show "A \<or> B"
  proof (rule disjI1)
    from \<open>A \<and> B\<close> show A by (rule conjE)
  qed
qed

lemma "(A \<and> B) \<longrightarrow> (A \<or> B)"
proof (rule impI)
  assume "A \<and> B"
  then show "A \<or> B"
  proof (rule conjE)
    from \<open>A \<and> B\<close> have A by (rule conjunct1)
    then show ?thesis by (rule disjI1)
  qed
qed

lemma "A \<or> (B \<and> C) \<longrightarrow> (A \<or> B) \<and> (A \<or> C)"
proof (rule impI)
  assume "A \<or> (B \<and> C)"
  then show "(A \<or> B) \<and> (A \<or> C)"
  proof (rule disjE)
    assume A
    then have "A \<or> B" by (rule disjI1)
    from \<open>A\<close> have "A \<or> C" by (rule disjI1)
    with \<open>A \<or> B\<close> show ?thesis by (rule conjI)
  next
    assume "B \<and> C"
    then show "(A \<or> B) \<and> (A \<or> C)"
    proof (rule conjE)
      assume B
      then have "A \<or> B" by (rule disjI2)
      assume C
      then have "A \<or> C" by (rule disjI2)
      with \<open>A \<or> B\<close> show ?thesis by (rule conjI)
    qed
  qed
qed

thm impI
thm impI [of "A \<and> B" "B \<and> A"]

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof (rule impI [of "A \<and> B" "B \<and> A"])
  assume "A \<and> B"
  then show "B \<and> A"
  proof (rule conjE [of A B "B \<and> A"])
    assume B A
    then show ?thesis by (rule conjI [of B A])
  qed
qed

end


theory Chapter2
imports Main
begin

(* jEdit(1) *)
fun add :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "add 0 n = n"
| "add (Suc m) n = Suc (add m n)"

lemma add_02 : "add m 0 = m"
  apply (induction m)
  apply auto
done

thm add_02

fun app :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
  "app [] ys = ys"
| "app (x#xs) ys = x # (app xs ys)"

value "(app (Cons 0 (Nil::int list)) (Cons 0 Nil))"

fun rev :: "'a list \<Rightarrow> 'a list" where
  "rev Nil = Nil"
| "rev (Cons x xs) = app (rev xs) (Cons x Nil)"

value "rev (Cons True (Cons False Nil))"

lemma app_Nil2 [simp]: "app xs Nil = xs"
  apply (induction xs)
  apply auto
done

lemma app_assoc [simp]: "app (app xs ys) zs = app xs (app ys zs)"
  apply (induction xs)
  apply auto
done

lemma rev_app [simp]: "rev (app xs ys) = app (rev ys) (rev xs)"
  apply (induction xs)
  apply auto
done

theorem rev_rev [simp]: "rev (rev xs) = xs"
  apply (induction xs)
  apply auto
done

(* Ex 2.2 *)

lemma add_0[simp]: "add m 0 = m"
  apply (induct m)
  apply auto
done

lemma add_succ[simp]: "Suc (add m n) = add m (Suc n)"
  apply (induct m)
   apply auto
done

lemma add_comm: "add a b = add b a"
  apply (induction a)
  apply auto
done

fun double ::  "nat \<Rightarrow> nat" where
  "double 0 = 0"
| "double (Suc m) = Suc (Suc (double m))"

lemma add_double: "double m = add m m"
  apply (induct m)
  apply auto
done

(* Ex 2.3 *)
fun count :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
  "count v [] = 0"
| "count v (x#xs) = (if v = x then Suc (count v xs) else count v xs)"

lemma count_length_le : "count x xs \<le> length xs"
  apply (induct xs)
  apply auto
done

(* Ex 2.4 *)
fun snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
  "snoc [] a = [a]"
| "snoc (x#xs) a = x # (snoc xs a)"

fun reverse :: "'a list \<Rightarrow> 'a list" where
  "reverse [] = []"
| "reverse (x#xs) = snoc (reverse xs) x"

value "reverse [(1::nat),2,3,4,5]"

(*lemma reverse_reverse : "reverse (reverse xs) = xs"
  apply (induct xs)
  apply auto*)

(* Ex 2.5 *)
fun sum_upto :: "nat \<Rightarrow> nat" where
  "sum_upto 0 = 0"
| "sum_upto (Suc m) = Suc (m + (sum_upto m))"

value "sum_upto 10"

lemma sum_upto_correct : "sum_upto n = n * (n + 1) div 2"
  apply (induct n)
  apply auto
done

(* jEdit(2) *)

datatype 'a tree = Tip | Node "'a tree" 'a "'a tree"

fun mirror :: "'a tree \<Rightarrow> 'a tree" where
  "mirror Tip = Tip"
| "mirror (Node l v r) = Node (mirror r) v (mirror l)"

lemma "mirror (mirror t) = t"
  apply (induction t)
  apply auto
done

datatype 'a option = None | Some 'a

value "tl [(1::nat),2,3]"

fun lookup :: "('a * 'b) list \<Rightarrow> 'a \<Rightarrow> 'b option" where
  "lookup [] key = None"
| "lookup ((a, b) # ps) key =
     (if key = a then Some b else lookup ps key)"

(* jEdit(3) *)

fun div2 :: "nat \<Rightarrow> nat" where
  "div2 0 = 0"
| "div2 (Suc 0) = 0"
| "div2 (Suc (Suc n)) = Suc (div2 n)"

lemma "div2 n = n div 2"
  apply (induction n rule: div2.induct)
  apply auto
done

(* Ex 2.6 *)

fun contents :: "'a tree \<Rightarrow> 'a list" where
  "contents Tip = []"
| "contents (Node l a r) = contents l @ [a] @ contents r"

fun sum_tree :: "nat tree \<Rightarrow> nat" where
  "sum_tree Tip = 0"
| "sum_tree (Node l a r) = sum_tree l + a + sum_tree r"

lemma "sum_tree t = sum_list (contents t)"
  apply (induction t)
  apply auto
done

(* Ex 2.7 *)

datatype 'a tree2 = Tip2 'a | Node2 "'a tree2" 'a "'a tree2"

fun mirror2 :: "'a tree2 \<Rightarrow> 'a tree2" where
  "mirror2 (Tip2 a) = Tip2 a"
| "mirror2 (Node2 l a r) = Node2 (mirror2 r) a (mirror2 l)"

fun pre_order :: "'a tree2 \<Rightarrow> 'a list" where
  "pre_order (Tip2 a) = [a]"
| "pre_order (Node2 l a r) = [a] @ (pre_order l) @ (pre_order r)"

fun post_order :: "'a tree2 \<Rightarrow> 'a list" where
  "post_order (Tip2 a) = [a]"
| "post_order (Node2 l a r) = (post_order l) @ (post_order r) @ [a]"

(* lemma pre_post : "pre_order (mirror2 t) = reverse (post_order t)"
  apply (induct t)
   apply auto
  *)

(* Ex 2.8 *)

fun intersperse :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
  "intersperse a [] = []"
| "intersperse a (x#xs) = x # a # (intersperse a xs)"

lemma intersperse_map : "map f (intersperse a xs) = intersperse (f a) (map f xs)"
  apply (induction xs)
  apply auto
done

(* jEdit(4) *)

fun itrev :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
  "itrev [] ys     = ys"
| "itrev (x#xs) ys = itrev xs (x # ys)"

(* can't prove *)
(*lemma "itrev xs [] = rev xs"
  apply (induction xs)
  apply (auto)
*)

lemma app_att [simp]: "app a b = a @ b"
  apply (induct a)
  apply auto
done

lemma "itrev xs ys = rev xs @ ys"
  apply (induction xs arbitrary: ys) (* add forall in ys *)
  apply auto
done

(* Ex 2.9 *)
fun itadd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "itadd 0 n = n"
| "itadd (Suc m) n = itadd m (Suc n)"

lemma itadd_add_eq : "itadd m n = add m n"
  apply (induct m arbitrary:n)
  apply auto
done

(* Ex 2.10 *)

datatype tree0 = Tip0 | Node0 "tree0" "tree0"

fun nodes :: "tree0 \<Rightarrow> nat" where
  "nodes Tip0 = 1"
| "nodes (Node0 l r) = 1 + nodes l + nodes r"

fun explode :: "nat \<Rightarrow> tree0 \<Rightarrow> tree0" where
  "explode 0 t = t"
| "explode (Suc n) t = explode n (Node0 t t)"

(*lemma explode_n : "nodes (explode n t) = (nodes t + 1) * 2 ^ n - 1"
  apply (induct n)
  apply auto
*)

(* Ex 2.11 *)

datatype exp = Var | Const int | Add exp exp | Mult exp exp

fun eval :: "exp \<Rightarrow> int \<Rightarrow> int" where
  "eval Var x = x"
| "eval (Const i) _ = i"
| "eval (Add e1 e2) x = eval e1 x + eval e2 x"
| "eval (Mult e1 e2) x = eval e1 x * eval e2 x"

value "eval (Add Var (Const 3)) 5"

(*fun evalp :: "int list \<Rightarrow> int \<Rightarrow> int" where
  "evalp [] _ = 0"
| "evalp [x] _ = x"
| "evalp (x#y#xs) v = x + (evalp xs (v * 2))"

value "evalp [4, 2] 2"

fun coeffs :: "exp \<Rightarrow> int list" where
  "coeffs Var = 1"
| "coeffs (Const i) = *)

end


theory Why3_Set
imports
  Why3_Setup
  Why3_Map
  "HOL-Library.FSet"
begin

section {* Potentially infinite sets *}

definition complement :: "('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool" where
  "complement S v = Not (S v)"

definition mapi :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> bool)" where
  "mapi f s x = Set.member x (image f (Collect s))"

why3_open "set/Set.xml"
  constants
    empty = bot
    add = insert
    remove = Set.remove
    union = sup
    inter = inf
    diff = minus
    complement = complement
    pick = Eps
    all = top
    map = mapi

why3_vc diffqtdef by (simp add: mem_def)

why3_vc interqtdef by (simp add: mem_def)

why3_vc is_empty_empty by (simp add: constqtdef mem_def set.Set.is_empty_def)

why3_vc unionqtdef by (simp add: mem_def)

why3_vc add_remove
  using assms
  by (simp add: fun_upd_idem_iff mem_def)

why3_vc remove_add by auto

why3_vc pick_def
  using assms
  by (auto simp add: mem_def is_empty_def intro: someI_ex)

why3_vc subset_diff
  by (simp add: mem_def diffqtdef subset_def)

why3_vc subset_refl
  by (simp add: subset_def)

why3_vc subset_trans
  using assms
  by (simp add: subset_def)

why3_vc subset_remove
  by (simp add: mem_def remove_def subset_def)

why3_vc complementqtdef
  by (simp add: mem_def complement_def)

why3_vc extensionality
  using assms
  by (auto simp add: infix_eqeq_def mem_def)

why3_vc mapqtdef by (simp add: mem_def mapi_def image_iff)

why3_vc mem_map
  using assms
  by (meson facts.mapqtdef mem_def)

why3_vc mem_singleton
  by (metis assms constqtdef fun_upd_other mem_def)

why3_vc empty_is_empty
  using assms
  by (meson extensionality infix_eqeq_def is_empty_empty set.Set.is_empty_def)

why3_vc subset_inter_1
  by (simp add: set.Set.subset_def mem_def)

why3_vc subset_inter_2
  by (simp add: set.Set.subset_def mem_def)

why3_vc subset_union_1
  by (simp add: set.Set.subset_def mem_def)

why3_vc subset_union_2
  by (simp add: set.Set.subset_def mem_def)

why3_vc disjoint_diff_eq
  by (smt diffqtdef disjoint_def extensionality infix_eqeq_def mem_def)

why3_vc disjoint_diff_s2
  by (simp add: disjoint_def mem_def)

why3_vc disjoint_inter_empty
  by (simp add: disjoint_def mem_def set.Set.is_empty_def)

why3_end

section {* Finite sets *}

definition fremove :: "'a \<Rightarrow> 'a fset \<Rightarrow> 'a fset" where
  "fremove x A = A - {|x|}"

definition fchoose :: "'a fset \<Rightarrow> 'a" where
  "fchoose S = (\<some>x. x |\<in>| S)"

definition is_empty :: "'a fset \<Rightarrow> bool" where
  "is_empty S = (S = fempty)"

definition filter :: "'a fset \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a fset" where
  "filter S p = ffilter p S"

why3_open "set/Fset.xml"
  constants
    mem = fmember
    empty = bot
    add = finsert
    remove = fremove
    union = sup
    inter = inf
    diff = minus
    choose = fchoose
    all = top
    pick = fchoose
    filter = filter
    map = fimage
  types
    fset = fset

why3_vc add_def by auto

why3_vc add_remove
  using assms
  by (auto simp add: fremove_def)

why3_vc remove_add by (simp add: fremove_def)

why3_vc map_def by auto

why3_vc mem_map by (simp add: assms)

why3_vc inter_def by simp

why3_vc union_def by simp

why3_vc remove_def by (auto simp add: fremove_def)

why3_vc diff_def by auto

why3_vc pick_def
  using assms
  by (auto simp add: fchoose_def is_empty_def intro: someI_ex)

why3_vc subset_diff by (simp add: Fset.subset_def)

why3_vc subset_refl by (simp add: Fset.subset_def)

why3_vc subset_trans
  using assms
  by (simp add: Fset.subset_def)

why3_vc subset_remove by (auto simp add: Fset.subset_def fremove_def)

why3_vc subset_eq
  using assms fcard_seteq
  by (metis Fset.subset_def eq_imp_le fsubsetI of_nat_eq_iff)

why3_vc extensionality
  using assms
  by (simp add:  Fset.infix_eqeq_def fset_eqI)

why3_vc cardinal1
proof (cases s rule: fset_strong_cases)
  case 1
  with assms
  show ?thesis by (simp add: fcard_fempty)
next
  case (2 s' x)
  show ?thesis
  proof (cases s' rule: fset_strong_cases)
    case 1
    with `s = finsert x s'` assms
    show ?thesis by (simp add: fchoose_def)
  next
    case (2 s'' y)
    with `s = finsert x s'` assms
    show ?thesis by (auto simp add: fcard_finsert_if fchoose_def
      split: if_split_asm)
  qed
qed

why3_vc cardinal_add by (auto simp add: fcard_finsert_if finsert_absorb)

why3_vc cardinal_empty by (simp add: is_empty_def)

why3_vc cardinal_nonneg by simp

lemma cardinal_remove_in:
  "x |\<in>| s \<longrightarrow> int (fcard (fremove x s)) = int (fcard s) - 1"
  by (smt cardinal_add(2) fminus_finsert_absorb fremove_def set_finsert)

lemma cardinal_remove_out:
  "x |\<notin>| s \<longrightarrow> int (fcard (fremove x s)) = int (fcard s)"
  by (simp add: fremove_def)

why3_vc cardinal_remove by (auto simp add: cardinal_remove_out cardinal_remove_in)

why3_vc cardinal_subset
  using assms
  by (simp add: Fset.subset_def fcard_mono fsubsetI)

why3_vc filter_def by (simp add: Why3_Set.filter_def)

why3_vc cardinal_map
  apply (simp add: fcard_def card_def)
  by (metis card_def card_image_le finite_fset)

why3_vc cardinal_diff
  by (metis fcard_funion_fsubset fcard_mono fminus_finter2 inf.idem inf_commute inf_sup_ord(1) of_nat_diff)
(*  by (smt fcard_funion_fsubset fcard_mono finter_lower1 fminus_finter2 inf.idem inf_commute int_ops(6) of_nat_mono)*)

why3_vc mem_singleton
  using assms by auto

why3_vc subset_filter
  by (simp add: Fset.subset_def Why3_Set.filter_def)

why3_vc cardinal_union
  by (smt fcard_funion_finter of_nat_add)

why3_vc empty_is_empty
  by (meson Fset.is_empty_def assms bot.extremum_uniqueI fsubsetI)

why3_vc is_empty_empty
  by (simp add: cardinal_empty)

why3_vc subset_inter_1
  by (simp add: Fset.subset_def)

why3_vc subset_inter_2
  by (simp add: Fset.subset_def)

why3_vc subset_union_1
  by (simp add: Fset.subset_def)

why3_vc subset_union_2
  by (simp add: Fset.subset_def)

why3_vc cardinal_filter
  using cardinal_subset subset_filter by blast

why3_vc disjoint_diff_eq
  by (smt Fset.disjoint_def Fset.facts.diff_def fsubsetI fsubset_antisym)

why3_vc  disjoint_diff_s2
  by (simp add: Fset.facts.disjoint_diff_eq)

why3_vc disjoint_inter_empty
  by (metis Fset.facts.disjoint_diff_eq Fset.facts.empty_is_empty Fset.facts.is_empty_empty fminus_disjoint fminus_triv)

why3_vc cardinal_inter_disjoint
  by (meson Fset.facts.disjoint_inter_empty assms cardinal_empty)

why3_end

end