section\<open>Additions to standard library\<close>

text\<open>In this section we define some additional functions and prove some
 additional lemmas about lists and multisets.\<close>

subsection \<open>Additions to the List library\<close>

theory More_List
  imports Main "HOL-Library.Product_Lexorder"
begin

text \<open>@{text rev}\<close>

lemma nth_rev: "n < length xs \<Longrightarrow> rev xs ! n = xs ! (length xs - 1 - n)"
  using rev_nth by simp

text \<open>@{text takeWhile}\<close>

lemma length_takeWhile:
  assumes "i < length l" "\<forall> i' < i. P (l ! i')" "\<not> P (l ! i)"
  shows "length (takeWhile P l) = i"
  using assms
proof (induction l arbitrary: i)
  case Nil
  thus ?case
    by simp
next
  case (Cons x l)
  show ?case
  proof (cases "i = 0")
    case True
    thus ?thesis
      using Cons(4)
      by simp
  next
    case False
    hence "length (takeWhile P l) = i - 1"
      using Cons(1)[of "i-1"] Cons(2) Cons(3) Cons(4)
      by (auto simp add: nth_Cons) (metis Cons.prems(2) Cons.prems(3) Suc_less_SucD diff_Suc_Suc gr0_implies_Suc less_Suc_eq_0_disj minus_nat.diff_0 nth_Cons old.nat.simps(5))
    thus ?thesis
      using Cons(3)[rule_format, of 0] `i \<noteq> 0`
      by simp
  qed
qed

lemma length_takeWhile':
  assumes "length (takeWhile P xs) = n"
  shows "(\<forall> i < n. P (xs ! i)) \<and> ((n < length xs \<and> \<not> P (xs ! n)) \<or> n = length xs)"
  using assms
  by (metis length_takeWhile_le nat_less_le nth_length_takeWhile nth_mem set_takeWhileD takeWhile_nth)

text \<open>@{text min_list}\<close>

lemma min_list_map_iff:
  fixes f :: "'a \<Rightarrow> 'b::linorder"
  assumes "ps \<noteq> []"
  shows "((\<exists> i \<in> set ps. s = f i) \<and> list_all (\<lambda>p. s \<le> f p) ps) \<longleftrightarrow>
          (min_list (map (\<lambda>p. f p) ps) = s)"
  using assms
  unfolding list_all_iff
proof safe
  fix i
  assume "\<forall>p\<in>set ps. f i \<le> f p" "i \<in> set ps"
  thus "min_list (map f ps) = f i"
    using `ps \<noteq> []` min_list_Min[of  "map f ps"] eq_Min_iff[of "set (map f ps)" "f i"]
    by auto
next
  show "\<exists>i\<in>set ps. min_list (map f ps) = f i"
    using `ps \<noteq> []` min_list_Min[of  "map f ps"] eq_Min_iff[of "set (map f ps)"]
    by auto
next
  fix p
  assume "p \<in> set ps"
  thus "min_list (map f ps) \<le> f p"
    using `ps \<noteq> []` min_list_Min[of  "map f ps"] eq_Min_iff[of "set (map f ps)"]
    by auto
qed

lemma P_min_list:
  fixes l :: "'a::{linorder} list"
  assumes "l \<noteq> []" "\<forall> x \<in> set l. P x"
  shows "P (min_list l)"
  using assms
  using min_list_Min[of l] Min_in[of "set l"]
  by simp

lemma min_list_map_is_min:
  fixes f :: "'a \<Rightarrow> 'b::linorder"
  assumes "ps \<noteq> []"
  shows "list_all (\<lambda>p. min_list (map (\<lambda>p. f p) ps) \<le> f p) ps"
  using assms
  unfolding list_all_iff
  by (simp add: min_list_Min)

text \<open>@{text max_list}\<close>

fun max_list where
  "max_list (x#xs) = fold max xs x"

lemma max_list_ubound:
  assumes "xs \<noteq> []" "\<forall> x \<in> set xs. x \<le> n"
  shows "max_list xs \<le> n"
proof-
  from assms obtain x xs' where "xs = x # xs'"
    by (cases xs) auto
  hence "x \<le> n" "\<forall> x \<in> set xs'. x \<le> n"
    using assms
    by auto
  hence "fold max xs' x \<le> n"
    by (induction xs' rule: rev_induct) (auto simp add: max_def)
  thus ?thesis
    using `xs = x # xs'`
    by auto
qed

lemma max_list_max:
  fixes xs :: "('a :: linorder) list"
  shows "\<forall> x \<in> set xs. max_list xs \<ge> x"
proof (cases xs)
  case (Cons x xs)
  have "x \<le> fold max xs x"
    by (induction xs) (auto, smt List.finite_set Max.in_idem Max.set_eq_fold insertCI list.set(2) max.assoc max.commute max_def)
  moreover
  have "\<forall>x'\<in>set xs. x' \<le> fold max xs x"
    by (induction xs, auto,
        smt List.finite_set Max.in_idem Max.set_eq_fold list.set_intros(1) max.assoc max_def min.orderI min_def,
        metis List.finite_set Max.in_idem Max.set_eq_fold insertCI list.set(2) max.commute max.orderI)
  ultimately
  show ?thesis
    using Cons
    by simp
qed simp

lemma max_list_is_nth:
  assumes "l \<noteq> []"
  shows "\<exists> i. i < length l \<and> l ! i = max_list l"
  using assms
proof-
  from assms obtain a l' where "l = a # l'"
    by (cases l) auto
  have "\<exists>i. i < length (a # l') \<and> (a # l') ! i = fold max l' a"
  proof (induction l' rule: rev_induct)
    case Nil
    then show ?case
      by (rule_tac x=0 in exI, simp)
  next
    case (snoc x xs)
    show ?case
    proof (cases "x \<le> (fold max xs a)")
      case True
      obtain i where i: "i < length (a # xs)" "(a # xs) ! i = fold max xs a"
        using snoc
        by auto
      have "(a # xs @ [x]) ! i = (a # xs) ! i"
        using `i < length (a # xs)`
        by (metis (mono_tags, lifting) append_Cons butlast_snoc nth_butlast)
      moreover
      have "fold max (xs @ [x]) a = fold max xs a"
        using True
        by (simp add: max_def)
      ultimately
      show ?thesis
        using i
        by (rule_tac x=i in exI, simp)
    next
      case False
      hence "fold max (xs @ [x]) a = x"
        by (simp add: max_def)
      moreover
      have "(a # xs @ [x]) ! (length (a # xs)) = x"
        by (simp add: nth_append)
      ultimately
      show ?thesis
        by (rule_tac x="length (a # xs)" in exI, simp)
    qed
  qed
  thus ?thesis
    using `l = a # l'`
    by simp
qed

text \<open>@{text index_of}\<close>

definition index_of where
  "index_of xs x = snd (hd (filter (\<lambda> (a, b). a = x) (zip xs [0..<length xs])))"

lemma index_of_in_set:
  assumes "x \<in> set xs"
  shows "index_of xs x < length xs \<and> xs ! index_of xs x = x"
proof-
  obtain i where "x = xs ! i" "i < length xs"
    using assms in_set_conv_nth[of x xs]
    by auto
  hence "(x, i) \<in> set (zip xs [0..<length xs])"
    using assms
    by (auto simp add: set_zip)
  hence "filter (\<lambda>(a, b). a = x) (zip xs [0..<length xs]) \<noteq> []"
    by (metis (mono_tags, lifting) filter_empty_conv old.prod.case)
  thus ?thesis
    unfolding index_of_def
    using hd_in_set[of "(filter (\<lambda>(a, b). a = x) (zip xs [0..<length xs]))"]
    by (auto split: prod.split_asm simp add: set_zip)
qed

lemma singleton_list_iff:
  "xs = [x] \<longleftrightarrow> set xs = {x} \<and> distinct xs"
  by auto (metis distinct.simps(2) distinct_length_2_or_more insert_not_empty  neq_Nil_conv set_empty2 singletonD)

lemma index_of_list_element:
  assumes "p < length xs" "distinct xs"
  shows "index_of xs (xs ! p) = p"
proof-
  have "(xs ! p, p) \<in> set (zip xs [0..<length xs])"
    using assms
    by (auto simp add: set_zip)
  moreover
  hence "\<forall> p'. (xs ! p, p') \<in> set (zip xs [0..<length xs]) \<longrightarrow> p = p'"
    using `distinct xs` `p < length xs`
    by (auto simp add: set_zip nth_eq_iff_index_eq)
  ultimately
  have "set (filter (\<lambda>(a, b). a = xs ! p) (zip xs [0..<length xs])) = {(xs ! p, p)}"
    by auto
  moreover
  have "distinct (filter (\<lambda>(a, b). a = xs ! p) (zip xs [0..<length xs]))"
    by  (rule distinct_filter, rule distinct_zipI2, simp)
  ultimately
  have "filter (\<lambda>(a, b). a = xs ! p) (zip xs [0..<length xs]) = [(xs ! p, p)]"
    by (simp add: singleton_list_iff)
  thus ?thesis
    unfolding index_of_def
    by auto
qed

text \<open>@{text sum_list}\<close>

lemma sum_list_ge_eq:
  fixes xs ys :: "nat list"
  assumes "length xs = length ys" "\<forall> i < length xs. xs ! i \<ge> ys ! i" "sum_list xs = sum_list ys"
  shows "\<forall> i < length xs. xs ! i = ys ! i"
  using assms
proof safe
  fix i
  assume "i < length xs"
  show "xs ! i = ys ! i"
  proof (rule ccontr)
    assume "\<not> ?thesis"
    hence "xs ! i > ys ! i"
      using assms `i < length xs`
      by auto
    moreover
    have "xs = take i xs @ [xs ! i] @ drop (i + 1) xs"
         "ys = take i ys @ [ys ! i] @ drop (i + 1) ys"
      using `i < length xs` `length xs = length ys`
      by (metis One_nat_def add.right_neutral add_Suc_right append.assoc append_take_drop_id hd_drop_conv_nth take_hd_drop)+
    hence "sum_list (take i xs) + xs ! i + sum_list (drop (i + 1) xs) =
           sum_list (take i ys) + ys ! i + sum_list (drop (i + 1) ys)"
      using `sum_list xs = sum_list ys`
      by (metis (mono_tags, lifting) add.assoc add.right_neutral sum_list.Cons sum_list.Nil sum_list.append)
    moreover
    have "sum_list (take i xs) \<ge> sum_list (take i ys)"
    proof-
      have "map ((!) xs) [0..<i] = take i xs"  "map ((!) ys) [0..<i] = take i ys"
        using  `i < length xs` `length xs = length ys`
        by (auto intro: nth_equalityI)+
      thus ?thesis
        using sum_list_mono[of "[0..<i]" "(!) ys" "(!) xs"] assms `i < length xs`
        by auto
    qed
    moreover
    have "sum_list (drop (i+1) xs) \<ge> sum_list (drop (i+1) ys)"
    proof-
      have "map ((!) xs) [i+1..<length xs] = drop (i+1) xs"  "map ((!) ys) [i+1..<length ys] = drop (i+1) ys"
        using  `i < length xs` `length xs = length ys`
        by (auto intro: nth_equalityI)+
      thus ?thesis
        using sum_list_mono[of "[i+1..<length xs]" "(!) ys" "(!) xs"] assms `i < length xs`
        by auto
    qed
    ultimately
    show False
      by simp
  qed
qed

lemma sum_list_const:
  assumes "\<forall> x \<in> set L. f x = y"
  shows "sum_list (map f L) = y * length L"
  using assms
  by (induction L) auto

lemma sum_list_replicate [simp]:
  fixes x :: nat
  shows "sum_list (replicate n x) = n * x"
  by (induction n) auto

lemma sum_list_nonempty_gt:
  fixes xs :: "nat list"
  assumes "x \<in> set xs" "x > 1" "\<forall> x \<in> set xs. x \<ge> 1"
  shows "sum_list xs > List.length xs"
proof-
  obtain i where "i < List.length xs" "xs ! i = x"
    by (meson assms(1) in_set_conv_nth)
  then have "xs = (take i xs) @ [x] @ (drop (i + 1) xs)" (is "?l = ?l1 @ ?x @ ?l2")
    using id_take_nth_drop by auto
  then have "sum_list xs = sum_list ?l1 + sum_list [x] + sum_list ?l2"
    by (metis append.assoc sum_list_append)
  moreover
  have "sum_list ?l1 \<ge> i"
    using sum_list_mono[of "take i xs" "\<lambda> x. 1" "\<lambda> x. x"]
    by (metis \<open>i < List.length xs\<close> assms(3) in_set_takeD lambda_one length_take less_or_eq_imp_le map_ident min.bounded_iff order_antisym_conv sum_list_const take_map)
  moreover
  have "sum_list ?l2 \<ge> List.length xs - 1 - i"
    using sum_list_mono[of "drop (i + 1) xs" "\<lambda> x. 1" "\<lambda> x. x"]
    by (metis assms(3) drop_drop in_set_dropD lambda_one length_drop map_ident sum_list_const)
  moreover
  have "sum_list ?x > 1"
    using \<open>1 < x\<close>
    by fastforce
  ultimately
  show ?thesis
    using `i < List.length xs`
    by auto
qed

text \<open>@{text insort}\<close>

lemma insort_middle:
  "\<exists> p s. xs = p @ s \<and> insort x xs = p @ [x] @ s"
  by (induct xs) (auto, meson Cons_eq_appendI)

lemma insort_append:
   "(\<exists> p s. l1 = p @ s \<and> insort x (l1 @ l2) = p @ [x] @ s @ l2) \<or>
    (\<exists> p s. l2 = p @ s \<and> insort x (l1 @ l2) = l1 @ p @ [x] @ s)"
proof-
  obtain p s where "l1 @ l2 = p @ s" and ps: "insort x (l1 @ l2) = p @ [x] @ s"
    using insort_middle[of "l1 @ l2" x]
    by auto
  then obtain us where "l1 = p @ us \<and> us @ l2 = s \<or> l1 @ us = p \<and> l2 = us @ s"
    by (subst (asm) append_eq_append_conv2) auto
  thus ?thesis
  proof
    assume "l1 = p @ us \<and> us @ l2 = s"
    thus ?thesis
      using ps
      by blast
  next
    assume "l1 @ us = p \<and> l2 = us @ s"
    thus ?thesis
      using ps
      by - (rule disjI2, rule_tac x=us in exI, rule_tac x=s in exI, simp)
  qed
qed

lemma insort_append_skip_first:
  assumes "\<forall> b \<in> set xs. b < a"
  shows "insort a (xs @ ys) = xs @ insort a ys"
  using assms
  by (induction xs) auto

text \<open>@{text sort}\<close>

lemma sort_snoc [simp]:
  shows "sort (xs @ [a]) = insort a (sort xs)"
by (induction xs) (auto simp add: insort_left_comm)

lemma sort_rev [simp]:
  shows "sort (rev s) = sort s"
  by (induction s, auto)

lemma sort_append_swapped:
  assumes "\<forall> A \<in> set xs. \<forall> B \<in> set ys. A > B"
  shows "sort (xs @ ys) = sort ys @ sort xs"
  using assms
proof (induction xs)
  case Nil
  then show ?case by simp
next
  case (Cons a xs)
  then show ?case
    using insort_append_skip_first[of "sort ys"]
    by (auto simp add: sorted_append)
qed

text \<open>@{text sorted}\<close>

lemma sorted_rev_cons:
  assumes "sorted (rev xs)" "x \<ge> hd xs"
  shows "sorted (rev (x # xs))"
proof (cases "xs = []")
  case True
  thus ?thesis
    by simp
next
  case False
  hence "last (rev xs) = hd xs"
    by (simp add: last_rev)
  moreover
  have  "\<forall> x' \<in> set xs. x' \<le> last (rev xs)"
    using `sorted (rev xs)`
    using last_conv_nth[OF `xs \<noteq> []`]
    by (metis False calculation hd_conv_nth in_set_conv_nth le0 sorted_rev_nth_mono)
  ultimately
  show ?thesis
    using assms
    by (auto simp add: sorted_append)
qed

lemma sorted_filter [simp]:
  assumes "sorted xs"
  shows  "sorted (filter P xs)"
  using assms
  by (induction xs) auto

lemma sorted_rev_tl:
  assumes "sorted (rev l)"
  shows "sorted (rev (tl l))"
  using assms
  using sorted_butlast
  by (cases "l = []") force+

lemma sorted_hd:
  assumes "x \<in> set xs" "sorted xs"
  shows "hd xs \<le> x"
  using assms
  by (metis dual_order.eq_iff empty_set equals0D list.exhaust_sel set_ConsD sorted_simps(2))

lemma sorted_last_Max:
  assumes "sorted xs" "set xs \<noteq> {}"
  shows "last xs = Max (set xs)"
  using assms
proof (induction rule: rev_induct)
  case Nil
  then show ?case
    by simp
next
  case (snoc x xs)
  then show ?case
    by (cases "xs = []") (auto simp add: sorted_append max_def antisym)
qed

lemma sorted_map_mono:
  assumes "sorted xs" "\<forall> x \<in> set xs. \<forall> y \<in> set xs. x \<le> y \<longrightarrow> f x \<le> f y"
  shows "sorted (map f xs)"
  using assms
  by (metis (no_types, lifting) sorted_map sorted_wrt_mono_rel)

lemma sorted_map_rev:
  assumes "sorted xs"
  assumes "\<forall> x y. x \<in> set xs \<and> y \<in> set xs \<and> x < y \<longrightarrow> f x > f y"
  shows "sorted (map f (rev xs))"
  using assms
  by (induction xs, simp, auto simp add: sorted_append less_imp_le antisym_conv2)
     (metis antisym_conv2 eq_iff less_imp_le)

lemma distinct_last_not_in_butlast:
  assumes "distinct xs" "xs \<noteq> []"
  shows "last xs \<notin> set (butlast xs)"
  using assms
  by (metis append_butlast_last_id distinct_butlast not_distinct_conv_prefix)

text \<open>@{text sorted_list_of_set}\<close>

lemma sorted_list_of_set_remove_Max:
  assumes "A \<noteq> {}" "finite A"
  shows "sorted_list_of_set (A - {Max A}) = butlast (sorted_list_of_set A)" (is "?lhs = ?rhs")
proof (rule sorted_distinct_set_unique)
  show "sorted ?lhs" "distinct ?lhs"
    using assms
    by auto
next
  show "sorted ?rhs" "distinct ?rhs"
    using assms
    by (auto simp add: sorted_butlast distinct_butlast)
next
  let ?A = "sorted_list_of_set A"
  let ?B = "butlast ?A"
  have "A = set ?B \<union> {Max A}"
    using assms append_butlast_last_id[of "sorted_list_of_set A"]
    using sorted_last_Max[of "sorted_list_of_set A"]
    by (metis empty_set list.simps(15) set_append set_sorted_list_of_set sorted_sorted_list_of_set)
  moreover
  have "Max A \<notin> set ?B"
    using sorted_last_Max[of "sorted_list_of_set A"]
    using distinct_last_not_in_butlast[of ?A] assms
    by auto
  moreover
  have "Max A \<in> A"
    using assms
    by auto
  ultimately
  show "set ?lhs = set ?rhs"
    using assms
    by (auto simp add: sorted_list_of_set_remove)
qed

lemma sorted_list_of_set_insert_Max [simp]:
  assumes "finite F" "\<forall> s' \<in> F. s' < s"
  shows "sorted_list_of_set (insert s F) = sorted_list_of_set F @ [s]" (is "?lhs = ?rhs @ [s]")
proof-
  have "s \<notin> F"
    using assms
    by auto

  have s1Max: "Max (insert s F) = s"
    using assms
    apply (cases "F = {}")
    apply simp
    apply (metis (no_types, lifting) Max_gr_iff Max_in Un_insert_right finite_insert infinite_growing insert_iff sup_bot.comm_neutral)
    done

  hence "butlast ?lhs = ?rhs"
    using assms sorted_list_of_set_remove_Max[of "insert s F"] `s \<notin> F`
    by simp

  moreover

  have "last ?lhs = s"
    using s1Max sorted_last_Max[of "sorted_list_of_set (insert s F)"]
    using assms  \<open>s \<notin> F\<close>
    by (metis Un_insert_right finite_insert insert_iff set_sorted_list_of_set sorted_sorted_list_of_set sup_bot.comm_neutral)

  ultimately

  show ?thesis
    using assms append_butlast_last_id[of "?lhs"]
    by auto
qed

lemma sorted_list_of_set_inj:
  assumes "finite x" "finite y" "sorted_list_of_set x = sorted_list_of_set y"
  shows "x = y"
  using assms
  using set_sorted_list_of_set by fastforce

lemma sorted_list_of_set_union:
  assumes "\<forall> x \<in> p. \<forall> y \<in> s. x \<le> y" "p \<inter> s = {}" "finite p" "finite s"
  shows "sorted_list_of_set (p \<union> s) = sorted_list_of_set p @ sorted_list_of_set s" (is "?lhs = ?rhs")
  by (rule sorted_distinct_set_unique) (auto simp add: assms sorted_append)

lemma sorted_list_of_set_image_rev:
  assumes "\<forall> x y. x \<in> A \<and> y \<in> A \<and> x < y \<longrightarrow> f x > f y" "inj_on f A" "finite A"
  shows "sorted_list_of_set (f ` A) = rev (map f (sorted_list_of_set A))" (is "?lhs = ?rhs")
proof (rule sorted_distinct_set_unique)
  show "sorted ?lhs" "distinct ?lhs"
    using assms
    by auto
next
  show "sorted ?rhs"
    using assms
    by (simp add: rev_map sorted_map_rev)
next
  show "distinct ?rhs"
    using assms
    by (simp add: distinct_map inj_on_def)
next
  show "set ?lhs = set ?rhs"
    using assms
    by auto
qed

text \<open>@{text map2}\<close>

lemma map2_map:
   "map2 f (map g xs) xs = map (\<lambda> k. f (g k) k) xs"
  by (induction xs) auto

text \<open>@{text replicate}\<close>

lemma list_eq_replicate:
  assumes "\<forall> x \<in> set l. x = a"
  shows "l = replicate (length l) a"
proof (rule nth_equalityI)
  show "length l = length (replicate (length l) a)"
    by simp
next
  fix i
  assume "i < length l"
  thus "l ! i = replicate (length l) a ! i"
    using assms in_set_conv_nth[of "l ! i" l]
    by auto
qed

text \<open>@{text concat}\<close>

lemma concat_nth:
  assumes "\<forall> x \<in> set M. length x = n" "i < n * length M"
  shows "concat M ! i = M ! (i div n) ! (i mod n)"
  using assms
proof (induction M rule: rev_induct)
  case Nil
  then show ?case
    by simp
next
  case (snoc a M)
  show ?case
  proof (cases "i < n * length M")
    case True
    hence "i div n < length M"
      by (simp add: Groups.mult_ac(2) less_mult_imp_div_less)
    moreover
    have "length (concat M) = n * length M"
      using snoc(2)
      by (induction M) auto
    ultimately
    show ?thesis
      using snoc True
      by (simp add: nth_append)
  next
    case False
    hence "i div n \<ge> length M"
      by (metis assms(2) div_le_mono le_less_linear mult_is_0 nonzero_mult_div_cancel_left)
    moreover
    have "length (concat M) = n * length M"
      using snoc(2)
      by (induction M) auto
    moreover
    have "i div n = length M"
      using snoc(3) False div_nat_eqI
      by auto
    moreover
    have "i - n * length M = i mod n"
      using False
      by (metis `i div n = length M` minus_mult_div_eq_mod)
    ultimately
    show ?thesis
      using False
      by(simp add: nth_append)
  qed
qed

lemma drop_concat:
  assumes "\<forall> x \<in> set M. length x = n" "i < length M"
  shows "drop (i * n) (concat M) = (concat (drop i M))"
  using assms
proof (induct M rule: rev_induct)
  case Nil
  then show ?case
    by simp
next
  case (snoc x xs)
  show ?case
  proof (cases "i < length xs")
    case True
    then show ?thesis
      using snoc
      using length_concat[of xs]
      using sum_list_const[of xs length n]
      by auto
  next
    case False
    hence "i = length xs"
      using snoc(3)
      by simp
    then show ?thesis
      using snoc(2)
      using length_concat[of xs]
      using sum_list_const[of xs length n]
      by simp
  qed
qed

lemma take_concat:
  assumes "length (hd M) = n" "M \<noteq> []"
  shows "take n (concat M) = hd M"
  using assms
  by (metis append_eq_conv_conj concat.simps(2) hd_Cons_tl)

lemma take_drop_concat:
  assumes "\<forall> x \<in> set M. length x = n" "i < length M"
  shows "take n (drop (i * n) (concat M)) = M ! i"
  using assms
  using drop_concat[OF assms]
  using take_concat[of "drop i M" n]
  by (simp add: hd_drop_conv_nth)

lemma hd_concat [simp]:
  assumes "xs \<noteq> []" "hd xs \<noteq> []"
  shows "hd (concat xs) = hd (hd xs)"
  using assms
  by (induction xs, auto)

lemma concat_filter_empty:
  shows "concat xs = concat (filter (\<lambda> x. x \<noteq> []) xs)"
  by (induction xs) auto

lemma sorted_concat:
  assumes "\<forall> xs \<in> set xss. sorted xs"
          "\<forall> i j. i < j \<and> j < length xss \<longrightarrow> (\<forall> x \<in> set (xss ! i). \<forall> y \<in> set (xss ! j). x \<le> y)"
 shows "sorted (concat xss)"
  using assms
proof (induction xss)
  case Nil
  then show ?case
    by simp
next
  case (Cons a xss)
  have "sorted a"
    using Cons(2)
    by simp
  moreover
  have "sorted (concat xss)"
  proof (rule Cons(1))
    show "\<forall> a \<in> set xss. sorted a"
      using Cons(2)
      by simp
  next
    show "\<forall>i j. i < j \<and> j < length xss \<longrightarrow> (\<forall>x\<in>set (xss ! i). \<forall>a\<in>set (xss ! j). x \<le> a)"
    proof safe
      fix i j x y
      assume "x \<in> set (xss ! i)" "y \<in> set (xss ! j)" "i < j" "j < length xss"
      thus "x \<le> y"
        using Cons(3)[rule_format, of "i+1" "j+1" x y]
        by simp
    qed
  qed

  moreover
  have "\<forall> x \<in> set a. \<forall> y \<in> set xss. \<forall>z\<in>set y. x \<le> z"
  proof safe
    fix x y z
    assume *: "x \<in> set a" "y \<in> set xss" "z \<in> set y"
    then obtain j where "j < length xss" "xss ! j = y"
      using in_set_conv_nth[of y xss]
      by auto
    thus "x \<le> z"
      using Cons(3)[rule_format, of 0 "j+1" x z] *
      by simp
  qed

  ultimately

  show ?case
    by (simp add: sorted_append)
qed

lemma concat_nonempty_singletons:
  assumes "List.length (concat xs) = List.length xs" "\<forall> x \<in> set xs. x \<noteq> []" "x \<in> set xs"
  shows "List.length x = 1"
proof (rule ccontr)
  assume "\<not> ?thesis"
  then have "List.length x > 1"
    using assms(2-3)
    using antisym_conv3 by auto
  moreover
  have "\<forall> x \<in> set xs. List.length x \<ge> 1"
    using assms(2)
    by (simp add: Suc_leI)
  ultimately
  have "sum_list (map List.length xs) > List.length xs"
    using sum_list_nonempty_gt[of "List.length x" "map List.length xs"] `x \<in> set xs`
    by auto
  then show False
    using assms(1)
    by (simp add: length_concat)
qed

definition concat_prefix_length :: "'a list list \<Rightarrow> nat \<Rightarrow> nat" where
  "concat_prefix_length xs n = sum_list (map length (take n xs))"

lemma concat_prefix_length_Suc [simp]:
  assumes "n < List.length xs"
  shows "concat_prefix_length xs (n + 1) = concat_prefix_length xs n  + length (xs ! n)"
proof-
  have "take (n + 1) xs = take n xs @ [xs ! n]"
    using assms
    using take_Suc_conv_app_nth by auto
  then show ?thesis
    unfolding concat_prefix_length_def
    by auto
qed

lemma concat_prefix_length_ub:
  shows "concat_prefix_length xs n \<le> length (concat xs)"
  unfolding concat_prefix_length_def
  by (metis append_take_drop_id concat_append length_append length_concat linorder_not_less not_add_less1)

lemma length_prefix_mono:
  assumes "n1 \<le> n2"
  shows "concat_prefix_length xs n1 \<le> concat_prefix_length xs n2"
proof-
  obtain ys where "take n2 xs = take n1 xs @ ys"
    by (metis assms nat_le_iff_add take_add)
  then have "sum_list (map List.length (take n2 xs)) = sum_list (map List.length (take n1 xs)) + sum_list (map List.length ys)"
    by auto
  moreover have "sum_list (map List.length ys) \<ge> 0"
    by auto
  ultimately show ?thesis
    unfolding concat_prefix_length_def
    by auto
qed

lemma concat_in_nth_list:
  assumes "j < length xs" "k < length (xs ! j)"
  assumes "x = (xs ! j ! k)" "i = concat_prefix_length xs j + k"
  shows "(concat xs) ! i = x"
proof-
  let ?p = "take j xs"
  let ?s = "drop (j+1) xs"
  have "xs = ?p @ [xs ! j] @ ?s"
    by (metis add.commute append_assoc append_take_drop_id assms(1) hd_drop_conv_nth plus_1_eq_Suc take_hd_drop)
  then have "concat xs = concat ?p @ (xs ! j) @ concat ?s"
    by (metis append.right_neutral concat.simps(1) concat.simps(2) concat_append)
  moreover have "length (concat ?p) = sum_list (map length ?p)"
    by (rule length_concat)
  ultimately have "concat xs ! i = ((xs ! j) @ concat ?s) ! k"
    using `i = concat_prefix_length xs j + k`
    by (metis nth_append_length_plus concat_prefix_length_def)
  also have "... = (xs ! j) ! k"
    using `k < length (xs ! j)`
    thm nth_append
    by (simp add: nth_append)
  finally show ?thesis
    using `x = (xs ! j) ! k`
    by simp
qed

text \<open>@{text positions}\<close>

definition positions :: "bool list \<Rightarrow> nat list" where
  "positions xs = map snd (filter (\<lambda> (x, p). x) (zip xs [0..<length xs]))"

lemma sorted_positions:
  shows "sorted (positions xs)"
  unfolding positions_def
  by (induction xs rule: rev_induct) (auto simp add: sorted_append set_zip)

lemma distinct_positions:
  shows "distinct (positions xs)"
  unfolding positions_def
  by (induction xs rule: rev_induct) (auto simp add: set_zip)

lemma set_positions:
  shows "set (positions xs) = {p. p < length xs \<and> xs ! p}"
  unfolding positions_def
  by (induction xs rule: rev_induct) (auto simp add: nth_append)

lemma positions_sorted_list_of_set:
  shows "positions xs = sorted_list_of_set {p. p < length xs \<and> xs ! p}"
  using sorted_distinct_set_unique[of "positions xs" "sorted_list_of_set {p. p < length xs \<and> xs ! p}"]
  by (simp add: sorted_positions distinct_positions set_positions)

text \<open>@{text of_positions}\<close>

definition of_positions where
  "of_positions n xs = map (\<lambda> k. k \<in> set xs) [0..<n]"

lemma of_positions_positions:
  shows "of_positions (length xs) (positions xs) = xs"
proof-
  have "map (\<lambda>k. k < length xs \<and> xs ! k) [0..<length xs] = map (\<lambda> k. xs ! k) [0..<length xs]"
    by simp
  thus ?thesis
    using map_nth[of xs]
    unfolding of_positions_def
    by (simp add: set_positions)
qed

lemma positions_of_positions:
  assumes "set ps \<subseteq> {0..<n}" "distinct ps" "sorted ps"
  shows "positions (of_positions n ps) = ps"
proof-
  let ?A = "{k. k < length (of_positions n ps) \<and> of_positions n ps ! k}"
  have "set ps = ?A"
    using `set ps \<subseteq> {0..<n}`
    unfolding of_positions_def
    by auto
  hence "ps = sorted_list_of_set ?A"
    using `sorted ps` `distinct ps`
    using sorted_distinct_set_unique[of ps "sorted_list_of_set ?A"]
    by simp
  thus ?thesis
    using positions_sorted_list_of_set[of "of_positions n ps"]
    by simp
qed

definition max_by_prop :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b::linorder) \<Rightarrow> 'a set" where
  "max_by_prop A f = (
    let max = Max (f ` A)
     in {x \<in> A. f x = max}
  )"

lemma max_by_prop_nonempty [simp]:
  assumes "finite A" "A \<noteq> {}"
  shows "max_by_prop A f \<noteq> {}"
  using assms Max_in[of "f ` A"]
  unfolding max_by_prop_def Let_def
  by fastforce

lemma max_by_prop_finite [simp]:
  assumes "finite A"
  shows "finite (max_by_prop A f)"
  using assms
  unfolding max_by_prop_def Let_def
  by auto

lemma max_by_prop_subseteq:
  shows "max_by_prop A f \<subseteq> A"
  unfolding max_by_prop_def
  by auto

lemma max_by_prop_max_prop:
  assumes "finite A" "x \<in> max_by_prop A f" "x' \<in> A"
  shows "f x \<ge> f x'"
  using assms
  unfolding max_by_prop_def Let_def
  by simp

lemma max_by_prop_max_prop_eq:
  assumes "finite A" "x \<in> max_by_prop A f" "x' \<in> max_by_prop A f"
  shows "f x = f x'"
  using assms
  unfolding max_by_prop_def Let_def
  by simp

lemma max_by_prop_max_prop_gt:
  assumes "finite A" "x \<in> max_by_prop A f" "x' \<in> A" "x' \<notin> max_by_prop A f"
  shows "f x > f x'"
  using assms
  unfolding max_by_prop_def Let_def
  by (simp add: order_less_le)

lemma max_by_prop_iff:
  assumes "finite A" "A \<noteq> {}"
  shows "x \<in> max_by_prop A f \<longleftrightarrow> x \<in> A \<and> (\<forall> x' \<in> A. f x' \<le> f x)"
  unfolding max_by_prop_def Let_def
  by (smt (verit, best) Max.coboundedI Max_in assms(1) assms(2) finite_has_maximal2 finite_imageI imageE image_eqI image_is_empty mem_Collect_eq)

lemma max_by_prop_pair:
  assumes "finite A" "A \<noteq> {}"
  shows "max_by_prop (max_by_prop A f1) f2 = max_by_prop A (\<lambda> x. (f1 x, f2 x))" (is "?lhs = ?rhs")
proof-
  have "\<forall> x. x \<in> ?lhs \<longleftrightarrow> x \<in> ?rhs"
  proof
    fix x
    have "x \<in> ?lhs \<longleftrightarrow> x \<in> max_by_prop A f1 \<and> (\<forall> x' \<in> max_by_prop A f1. f2 x \<ge> f2 x')"
      using assms max_by_prop_iff
      by (metis max_by_prop_finite max_by_prop_nonempty)
    also have "... \<longleftrightarrow> x \<in> A \<and> (\<forall> x' \<in> A. f1 x' \<le> f1 x) \<and> (\<forall> x' \<in> A. (\<forall> x'' \<in> A. f1 x'' \<le> f1 x') \<longrightarrow> f2 x \<ge> f2 x')"
      using assms max_by_prop_iff
      by metis
    also have "... \<longleftrightarrow> x \<in> ?rhs"
      by (subst max_by_prop_iff[OF assms]) (force simp add: less_eq_prod_def nless_le)
    finally show "x \<in> ?lhs \<longleftrightarrow> x \<in> ?rhs"
      .
  qed
  then show ?thesis
    by blast
qed

lemma max_by_prop_cong:
  assumes "finite A" "A \<noteq> {}"
  assumes "\<forall> x1 \<in> A. \<forall> x2 \<in> A. f1 x1 < f1 x2 \<longleftrightarrow> f2 x1 < f2 x2"
  shows "max_by_prop A f1 = max_by_prop A f2"
  using assms
  unfolding max_by_prop_def
  by (smt (verit, ccfv_SIG) Collect_cong Max_ge Max_in finite_imageI imageE image_eqI image_is_empty linorder_not_less not_less_iff_gr_or_eq)

definition split_by_prop :: "'a set => ('a => 'b) => 'a set set" where
  "split_by_prop A f = { {y \<in> A. f y = x} | x. x \<in> f ` A}"

lemma split_by_prop_finite [simp]:
  assumes "finite A"
  shows "finite (split_by_prop A f)"
  unfolding split_by_prop_def
  using assms
  by auto

lemma split_by_prop_nonempty [simp]:
  shows "{} \<notin> split_by_prop A f"
  unfolding split_by_prop_def
  by auto

lemma split_by_prop_set [simp]:
  shows "\<Union> (split_by_prop A f) = A"
  unfolding split_by_prop_def
  by auto

lemma split_by_prop_disjoint:
  assumes "x \<in> split_by_prop A f" "y \<in> split_by_prop A f"
  shows "x = y \<or> x \<inter> y = {}"
  using assms
  unfolding split_by_prop_def
  by auto

definition is_split_by_prop where
  "is_split_by_prop cs f \<longleftrightarrow>
    (\<forall> cl \<in> cs. \<forall> v1 \<in> cl. \<forall> v2 \<in> cl. f v1 = f v2) \<and>
    (\<forall> cl1 \<in> cs. \<forall> cl2 \<in> cs. cl1 \<noteq> cl2  \<longrightarrow> (\<forall> v1 \<in> cl1. \<forall> v2 \<in> cl2. f v1 \<noteq> f v2)) \<and>
    (\<forall> cl \<in> cs. cl \<noteq> {})"

lemma split_by_prop_is_split_by_prop [simp]:
  shows "is_split_by_prop (split_by_prop A f) f"
  unfolding is_split_by_prop_def split_by_prop_def
  by auto

lemma split_by_prop_singleton:
  assumes "A \<noteq> {}"
  shows "split_by_prop A f = {A} \<longleftrightarrow> (\<forall> x \<in> A. \<forall> y \<in> A. f x = f y)"
proof
  assume "split_by_prop A f = {A}"
  then show "\<forall> x \<in> A. \<forall> y \<in> A. f x = f y"
    by (metis is_split_by_prop_def singletonI split_by_prop_is_split_by_prop)
next
  assume *: "\<forall> x \<in> A. \<forall> y \<in> A. f x = f y"
  from assms obtain x where "x \<in> A"
    by auto
  then have "\<forall> x' \<in> A. f x' = f x"
    using *
    by blast
  then have "f ` A = {f x}"
    using \<open>x \<in> A\<close> by blast
  then have "{{y \<in> A. f y = x} |x. x \<in> f ` A} = {{y \<in> A. f y = f x}}"
    by auto
  then show "split_by_prop A f = {A}"
    unfolding split_by_prop_def
    using *
    by blast
qed

end


(*
 * Copyright Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

section \<open>Arithmetic lemmas\<close>

theory More_Arithmetic
  imports Main "HOL-Library.Type_Length"
begin

lemma n_less_equal_power_2:
  "n < 2 ^ n"
  by (fact less_exp)

lemma min_pm [simp]: "min a b + (a - b) = a"
  for a b :: nat
  by arith

lemma min_pm1 [simp]: "a - b + min a b = a"
  for a b :: nat
  by arith

lemma rev_min_pm [simp]: "min b a + (a - b) = a"
  for a b :: nat
  by arith

lemma rev_min_pm1 [simp]: "a - b + min b a = a"
  for a b :: nat
  by arith

lemma min_minus [simp]: "min m (m - k) = m - k"
  for m k :: nat
  by arith

lemma min_minus' [simp]: "min (m - k) m = m - k"
  for m k :: nat
  by arith

lemma nat_less_power_trans:
  fixes n :: nat
  assumes nv: "n < 2 ^ (m - k)"
  and     kv: "k \<le> m"
  shows "2 ^ k * n < 2 ^ m"
proof (rule order_less_le_trans)
  show "2 ^ k * n < 2 ^ k * 2 ^ (m - k)"
    by (rule mult_less_mono2 [OF nv zero_less_power]) simp
  show "(2::nat) ^ k * 2 ^ (m - k) \<le> 2 ^ m" using nv kv
    by (subst power_add [symmetric]) simp
qed

lemma nat_le_power_trans:
  fixes n :: nat
  shows "\<lbrakk>n \<le> 2 ^ (m - k); k \<le> m\<rbrakk> \<Longrightarrow> 2 ^ k * n \<le> 2 ^ m"
  by (metis le_add_diff_inverse mult_le_mono2 semiring_normalization_rules(26))

lemma nat_add_offset_less:
  fixes x :: nat
  assumes yv: "y < 2 ^ n"
  and     xv: "x < 2 ^ m"
  and     mn: "sz = m + n"
  shows   "x * 2 ^ n + y < 2 ^ sz"
proof (subst mn)
  from yv obtain qy where "y + qy = 2 ^ n" and "0 < qy"
    by (auto dest: less_imp_add_positive)

  have "x * 2 ^ n + y < x * 2 ^ n + 2 ^ n" by simp fact+
  also have "\<dots> = (x + 1) * 2 ^ n" by simp
  also have "\<dots> \<le> 2 ^ (m + n)" using xv
    by (subst power_add) (rule mult_le_mono1, simp)
  finally show "x * 2 ^ n + y < 2 ^ (m + n)" .
qed

lemma nat_power_less_diff:
  assumes lt: "(2::nat) ^ n * q < 2 ^ m"
  shows "q < 2 ^ (m - n)"
  using lt
proof (induct n arbitrary: m)
  case 0
  then show ?case by simp
next
  case (Suc n)

  have ih: "\<And>m. 2 ^ n * q < 2 ^ m \<Longrightarrow> q < 2 ^ (m - n)"
    and prem: "2 ^ Suc n * q < 2 ^ m" by fact+

  show ?case
  proof (cases m)
    case 0
    then show ?thesis using Suc by simp
  next
    case (Suc m')
    then show ?thesis using prem
      by (simp add: ac_simps ih)
  qed
qed

lemma power_2_mult_step_le:
  "\<lbrakk>n' \<le> n; 2 ^ n' * k' < 2 ^ n * k\<rbrakk> \<Longrightarrow> 2 ^ n' * (k' + 1) \<le> 2 ^ n * (k::nat)"
  apply (cases "n'=n", simp)
   apply (metis Suc_leI le_refl mult_Suc_right mult_le_mono semiring_normalization_rules(7))
  apply (drule (1) le_neq_trans)
  apply clarsimp
  apply (subgoal_tac "\<exists>m. n = n' + m")
   prefer 2
   apply (simp add: le_Suc_ex)
  apply (clarsimp simp: power_add)
  apply (metis Suc_leI mult.assoc mult_Suc_right nat_mult_le_cancel_disj)
  done

lemma nat_mult_power_less_eq:
  "b > 0 \<Longrightarrow> (a * b ^ n < (b :: nat) ^ m) = (a < b ^ (m - n))"
  using mult_less_cancel2[where m = a and k = "b ^ n" and n="b ^ (m - n)"]
        mult_less_cancel2[where m="a * b ^ (n - m)" and k="b ^ m" and n=1]
  apply (simp only: power_add[symmetric] nat_minus_add_max)
  apply (simp only: power_add[symmetric] nat_minus_add_max ac_simps)
  apply (simp add: max_def split: if_split_asm)
  done

lemma diff_diff_less:
  "(i < m - (m - (n :: nat))) = (i < m \<and> i < n)"
  by auto

lemma small_powers_of_2:
  \<open>x < 2 ^ (x - 1)\<close> if \<open>x \<ge> 3\<close> for x :: nat
proof -
  define m where \<open>m = x - 3\<close>
  with that have \<open>x = m + 3\<close>
    by simp
  moreover have \<open>m + 3 < 4 * 2 ^ m\<close>
    by (induction m) simp_all
  ultimately show ?thesis
    by simp
qed

lemma msrevs:
  "0 < n \<Longrightarrow> (k * n + m) div n = m div n + k"
  "(k * n + m) mod n = m mod n"
  for n :: nat
  by simp_all

end


(*
    File:     Finite_And_Cyclic_Groups.thy
    Author:   Joseph Thommes, TU München; Manuel Eberl, TU München
*)
section \<open>Finite and cyclic groups\<close>

theory Finite_And_Cyclic_Groups
  imports Group_Hom Generated_Groups_Extend General_Auxiliary
begin

subsection \<open>Finite groups\<close>

text \<open>We define the notion of finite groups and prove some trivial facts about them.\<close>

locale finite_group = group +
  assumes fin[simp]: "finite (carrier G)"

(* Manuel Eberl *)
lemma (in finite_group) ord_pos:
  assumes "x \<in> carrier G"
  shows   "ord x > 0"
  using ord_ge_1[of x] assms by auto

lemma (in finite_group) order_gt_0 [simp,intro]: "order G > 0"
  by (subst order_gt_0_iff_finite) auto

lemma (in finite_group) finite_ord_conv_Least:
  assumes "x \<in> carrier G"
  shows "ord x = (LEAST n::nat. 0 < n \<and> x [^] n = \<one>)"
  using pow_order_eq_1 order_gt_0_iff_finite ord_conv_Least assms by auto

lemma (in finite_group) non_trivial_group_ord_gr_1:
  assumes "carrier G \<noteq> {\<one>}"
  shows "\<exists>e \<in> carrier G. ord e > 1"
proof -
  from one_closed obtain e where e: "e \<noteq> \<one>" "e \<in> carrier G" using assms carrier_not_empty by blast
  thus ?thesis using ord_eq_1[of e] le_neq_implies_less ord_ge_1 by fastforce
qed

(* Manuel Eberl *)
lemma (in finite_group) max_order_elem:
  obtains a where "a \<in> carrier G" "\<forall>x \<in> carrier G. ord x \<le> ord a"
proof -
  have "\<exists>x. x \<in> carrier G \<and> (\<forall>y. y \<in> carrier G \<longrightarrow> ord y \<le> ord x)"
  proof (rule ex_has_greatest_nat[of _ \<one> _ "order G + 1"], safe)
    show "\<one> \<in> carrier G"
      by auto
  next
    fix x assume "x \<in> carrier G"
    hence "ord x \<le> order G"
      by (intro ord_le_group_order fin)
    also have "\<dots> < order G + 1"
      by simp
    finally show "ord x < order G + 1" .
  qed
  thus ?thesis using that by blast
qed

lemma (in finite_group) iso_imp_finite:
  assumes "G \<cong> H" "group H"
  shows "finite_group H"
proof -
  interpret H: group H by fact
  show ?thesis
  proof(unfold_locales)
    show "finite (carrier H)" using iso_same_card[OF assms(1)]
      by (metis card_gt_0_iff order_def order_gt_0)
  qed
qed

lemma (in finite_group) finite_FactGroup:
  assumes "H \<lhd> G"
  shows "finite_group (G Mod H)"
proof -
  interpret H: normal H G by fact
  interpret Mod: group "G Mod H" using H.factorgroup_is_group .
  show ?thesis
    by (unfold_locales, unfold FactGroup_def RCOSETS_def, simp)
qed

lemma (in finite_group) bigger_subgroup_is_group:
  assumes "subgroup H G" "card H \<ge> order G"
  shows "H = carrier G"
  using subgroup.subset fin assms by (metis card_seteq order_def)

text \<open>All generated subgroups of a finite group are obviously also finite.\<close>

lemma (in finite_group) finite_generate:
  assumes "A \<subseteq> carrier G"
  shows "finite (generate G A)"
  using generate_incl[of A] rev_finite_subset[of "carrier G" "generate G A"] assms by simp

text \<open>We also provide an induction rule for finite groups inspired by Manuel Eberl's AFP entry
"Dirichlet L-Functions and Dirichlet's Theorem" and the contained theory "Group\_Adjoin". A property
that is true for a subgroup generated by some set and stays true when adjoining an element, is also
true for the whole group.\<close>

lemma (in finite_group) generate_induct[consumes 1, case_names base adjoin]:
  assumes "A0 \<subseteq> carrier G"
  assumes "A0 \<subseteq> carrier G \<Longrightarrow> P (G\<lparr>carrier := generate G A0\<rparr>)"
  assumes "\<And>a A. \<lbrakk>A \<subseteq> carrier G; a \<in> carrier G - generate G A; A0 \<subseteq> A;
           P (G\<lparr>carrier := generate G A\<rparr>)\<rbrakk> \<Longrightarrow> P (G\<lparr>carrier := generate G (A \<union> {a})\<rparr>)"
  shows "P G"
proof -
  define A where A: "A = carrier G"
  hence gA: "generate G A = carrier G"
    using generate_incl[of "carrier G"] generate_sincl[of "carrier G"] by simp
  hence "finite A" using fin A by argo
  moreover have "A0 \<subseteq> A" using assms(1) A by argo
  moreover have "A \<subseteq> carrier G" using A by simp
  moreover have "generate G A0 \<subseteq> generate G A" using gA generate_incl[OF assms(1)] by argo
  ultimately have "P (G\<lparr>carrier := generate G A\<rparr>)" using assms(2, 3)
  proof (induction "A" taking: card rule: measure_induct_rule)
    case (less A)
    then show ?case
    proof(cases "generate G A0 = generate G A")
      case True
      thus ?thesis using less by force
    next
      case gA0: False
      with less(3) have s: "A0 \<subset> A" by blast
      then obtain a where a: "a \<in> A - A0" by blast
      have P1: "P (G\<lparr>carrier := generate G (A - {a})\<rparr>)"
      proof(rule less(1))
        show "card (A - {a}) < card A" using a less(2) by (meson DiffD1 card_Diff1_less)
        show "A0 \<subseteq> A - {a}" using a s by blast
        thus "generate G A0 \<subseteq> generate G (A - {a})" using mono_generate by presburger
      qed (use less a s in auto)
      show ?thesis
      proof (cases "generate G A = generate G (A - {a})")
        case True
        then show ?thesis using P1 by simp
      next
        case False
        have "a \<in> carrier G - generate G (A - {a})"
        proof -
          have "a \<notin> generate G (A - {a})"
          proof
            assume a2: "a \<in> generate G (A - {a})"
            have "generate G (A - {a}) = generate G A"
            proof (rule equalityI)
              show "generate G (A - {a}) \<subseteq> generate G A" using mono_generate by auto
              show "generate G A \<subseteq> generate G (A - {a})"
              proof(subst (2) generate_idem[symmetric])
                show "generate G A \<subseteq> generate G (generate G (A - {a}))"
                  by (intro mono_generate, use generate_sincl[of "A - {a}"] a2 in blast)
              qed (use less in auto)
            qed
            with False show False by argo
          qed
          with a less show ?thesis by fast
        qed
        from less(7)[OF _ this _ P1] less(4) s a have "P (G\<lparr>carrier := generate G (A - {a} \<union> {a})\<rparr>)"
          by blast
        moreover have "A - {a} \<union> {a} = A" using a by blast
        ultimately show ?thesis by auto
      qed
    qed
  qed
  with gA show ?thesis by simp
qed

subsection \<open>Finite abelian groups\<close>

text \<open>Another trivial locale: the finite abelian group with some trivial facts.\<close>

locale finite_comm_group = finite_group + comm_group

lemma (in finite_comm_group) iso_imp_finite_comm:
  assumes "G \<cong> H" "group H"
  shows "finite_comm_group H"
proof -
  interpret H: group H by fact
  interpret H: comm_group H by (intro iso_imp_comm_group[OF assms(1)], unfold_locales)
  interpret H: finite_group H by (intro iso_imp_finite[OF assms(1)], unfold_locales)
  show ?thesis by unfold_locales
qed

lemma (in finite_comm_group) finite_comm_FactGroup:
  assumes "subgroup H G"
  shows "finite_comm_group (G Mod H)"
  unfolding finite_comm_group_def
proof(safe)
  show "finite_group (G Mod H)" using finite_FactGroup[OF subgroup_imp_normal[OF assms]] .
  show "comm_group (G Mod H)" by (simp add: abelian_FactGroup assms)
qed

(* Manuel Eberl *)
lemma (in finite_comm_group) subgroup_imp_finite_comm_group:
  assumes "subgroup H G"
  shows   "finite_comm_group (G\<lparr>carrier := H\<rparr>)"
proof -
  interpret G': group "G\<lparr>carrier := H\<rparr>" by (intro subgroup_imp_group) fact+
  interpret H: subgroup H G by fact
  show ?thesis by standard (use finite_subset[OF H.subset] in \<open>auto simp: m_comm\<close>)
qed

subsection \<open>Cyclic groups\<close>

text \<open>Now, the central notion of a cyclic group is introduced: a group generated
by a single element.\<close>

locale cyclic_group = group +
  fixes gen :: "'a"
  assumes gen_closed[intro, simp]: "gen \<in> carrier G"
  assumes generator: "carrier G = generate G {gen}"

lemma (in cyclic_group) elem_is_gen_pow:
  assumes "x \<in> carrier G"
  shows "\<exists>n :: int. x = gen [^] n"
proof -
  from generator have x_g:"x \<in> generate G {gen}" using assms by fast
  with generate_pow[of gen] show ?thesis using gen_closed by blast
qed

text \<open>Every cyclic group is commutative/abelian.\<close>

sublocale cyclic_group \<subseteq> comm_group
proof(unfold_locales)
  fix x y
  assume "x \<in> carrier G" "y \<in> carrier G"
  then obtain a b where ab:"x = gen [^] (a::int)" "y = gen [^] (b::int)"
    using elem_is_gen_pow by presburger
  then have "x \<otimes> y = gen [^] (a + b)" by (simp add: int_pow_mult)
  also have "\<dots> = y \<otimes> x" using ab int_pow_mult
    by (metis add.commute gen_closed)
  finally show "x \<otimes> y = y \<otimes> x" .
qed

text \<open>Some trivial intro rules for showing that a group is cyclic.\<close>

lemma (in group) cyclic_groupI0:
  assumes "a \<in> carrier G" "carrier G = generate G {a}"
  shows "cyclic_group G a"
  using assms by (unfold_locales; auto)

lemma (in group) cyclic_groupI1:
  assumes "a \<in> carrier G" "carrier G \<subseteq> generate G {a}"
  shows "cyclic_group G a"
  using assms by (unfold_locales, use generate_incl[of "{a}"] in auto)

lemma (in group) cyclic_groupI2:
  assumes "a \<in> carrier G"
  shows "cyclic_group (G\<lparr>carrier := generate G {a}\<rparr>) a"
proof (intro group.cyclic_groupI0)
  show "group (G\<lparr>carrier := generate G {a}\<rparr>)"
    by (intro subgroup.subgroup_is_group group.generate_is_subgroup, use assms in simp_all)
  show "a \<in> carrier (G\<lparr>carrier := generate G {a}\<rparr>)" using generate.incl[of a "{a}"] by auto
  show "carrier (G\<lparr>carrier := generate G {a}\<rparr>) = generate (G\<lparr>carrier := generate G {a}\<rparr>) {a}"
    using assms
    by (simp add: generate_consistent generate.incl group.generate_is_subgroup)
qed

text \<open>The order of the generating element is always the same as the group order.\<close>

lemma (in cyclic_group) ord_gen_is_group_order:
  shows "ord gen = order G"
proof (cases "finite (carrier G)")
  case True
  with generator show "ord gen = order G"
    using generate_pow_card[of gen] order_def[of G] gen_closed by simp
next
  case False
  thus ?thesis
    using generate_pow_card generator order_def[of G] card_eq_0_iff[of "carrier G"] by force
qed

text \<open>In the case of a finite group, it is sufficient to have one element of group order to know
that the group is cyclic.\<close>

lemma (in finite_group) element_ord_generates_cyclic:
  assumes "a \<in> carrier G" "ord a = order G"
  shows "cyclic_group G a"
proof (unfold_locales)
  show "a \<in> carrier G" using assms(1) by simp
  show "carrier G = generate G {a}"
    using assms bigger_subgroup_is_group[OF generate_is_subgroup]
    by (metis empty_subsetI fin generate_pow_card insert_subset ord_le_group_order)
qed

text \<open>Another useful fact is that a group of prime order is also cyclic.\<close>

lemma (in group) prime_order_group_is_cyc:
  assumes "Factorial_Ring.prime (order G)"
  obtains g where "cyclic_group G g"
proof (unfold_locales)
  obtain p where order_p: "order G = p" and p_prime: "Factorial_Ring.prime p" using assms by blast
  then have "card (carrier G) \<ge> 2" by (simp add: order_def prime_ge_2_nat)
  then obtain a where a_in: "a \<in> carrier G" and a_not_one: "a \<noteq> \<one>" using one_unique
    by (metis (no_types, lifting) card_2_iff' obtain_subset_with_card_n subset_iff)
  interpret fin: finite_group G
    using assms order_gt_0_iff_finite unfolding order_def by unfold_locales auto
  have "ord a dvd p" using a_in order_p ord_dvd_group_order by blast
  hence "ord a = p" using prime_nat_iff[of p] p_prime ord_eq_1 a_in a_not_one by blast
  then interpret cyclic_group G a
    using fin.element_ord_generates_cyclic order_p a_in by simp
  show ?thesis using that cyclic_group_axioms .
qed

text \<open>What follows is an induction principle for cyclic groups: a predicate is true for all elements
of the group if it is true for all elements that can be formed by the generating element by just
multiplication and if it also holds under the forming of the inverse (as we by this cover
all elements of the group),\<close>

(* Manuel Eberl *)
lemma (in cyclic_group) generator_induct [consumes 1, case_names generate inv]:
  assumes x: "x \<in> carrier G"
  assumes IH1: "\<And>n::nat. P (gen [^] n)"
  assumes IH2: "\<And>x. x \<in> carrier G \<Longrightarrow> P x \<Longrightarrow> P (inv x)"
  shows   "P x"
proof -
  from x obtain n :: int where n: "x = gen [^] n"
    using elem_is_gen_pow[of x] by auto
  show ?thesis
  proof (cases "n \<ge> 0")
    case True
    have "P (gen [^] nat n)"
      by (rule IH1)
    with True n show ?thesis by simp
  next
    case False
    have "P (inv (gen [^] nat (-n)))"
      by (intro IH1 IH2) auto
    also have "gen [^] nat (-n) = gen [^] (-n)"
      using False by simp
    also have "inv \<dots> = x"
      using n by (simp add: int_pow_neg)
    finally show ?thesis .
  qed
qed

subsection \<open>Finite cyclic groups\<close>

text \<open>Additionally, the notion of the finite cyclic group is introduced.\<close>

locale finite_cyclic_group = finite_group + cyclic_group

sublocale finite_cyclic_group \<subseteq> finite_comm_group
  by unfold_locales

lemma (in finite_cyclic_group) ord_gen_gt_zero:
  "ord gen > 0"
  using ord_ge_1[OF fin gen_closed] by simp

text \<open>In order to prove something about an element in a finite abelian group, it is possible to show
this property for the neutral element or the generating element and inductively for the elements
that are formed by multiplying with the generator.\<close>

lemma (in finite_cyclic_group) generator_induct0 [consumes 1, case_names one step]:
  assumes x: "x \<in> carrier G"
  assumes IH1: "P \<one>"
  assumes IH2: "\<And>x. \<lbrakk>x \<in> carrier G; P x\<rbrakk> \<Longrightarrow> P (x \<otimes> gen)"
  shows   "P x"
proof -
  from ord_gen_gt_zero generate_nat_pow[OF _ gen_closed] obtain n::nat where n: "x = gen [^] n"
    using generator x by blast
  thus ?thesis by (induction n arbitrary: x, use assms in auto)
qed

lemma (in finite_cyclic_group) generator_induct1 [consumes 1, case_names gen step]:
  assumes x: "x \<in> carrier G"
  assumes IH1: "P gen"
  assumes IH2: "\<And>x. \<lbrakk>x \<in> carrier G; P x\<rbrakk> \<Longrightarrow> P (x \<otimes> gen)"
  shows   "P x"
proof(rule generator_induct0[OF x])
  show "\<And>x. \<lbrakk>x \<in> carrier G; P x\<rbrakk> \<Longrightarrow> P (x \<otimes> gen)" using IH2 by blast
  have "P x" if "n > 0" "x = gen [^] n" for n::nat and x using that
    by (induction n arbitrary: x; use assms in fastforce)
  from this[OF ord_pos[OF gen_closed] pow_ord_eq_1[OF gen_closed, symmetric]] show "P \<one>" .
qed

subsection \<open>\<open>get_exp\<close> - discrete logarithm\<close>

text \<open>What now follows is the discrete logarithm for groups. It is used at several times througout
this entry and is initially used to show that two cyclic groups of the same order are isomorphic.\<close>

definition (in group) get_exp where
  "get_exp g = (\<lambda>a. SOME k::int. a = g [^] k)"

text \<open>For each element with itself as the basis the discrete logarithm indeed does what expected.
This is not the strongest possible statement, but sufficient for our needs.\<close>

lemma (in group) get_exp_self_fulfills:
  assumes "a \<in> carrier G"
  shows "a = a [^] get_exp a a"
proof -
  have "a = a [^] (1::int)" using assms by auto
  moreover have "a [^] (1::int) = a [^] (SOME x::int. a [^] (1::int) = a [^] x)"
    by (intro someI_ex[of "\<lambda>x::int. a [^] (1::int) = a [^] x"]; blast)
  ultimately show ?thesis unfolding get_exp_def by simp
qed

lemma (in group) get_exp_self:
  assumes "a \<in> carrier G"
  shows "get_exp a a mod ord a = (1::int) mod ord a"
  by (intro pow_eq_int_mod[OF assms], use get_exp_self_fulfills[OF assms] assms in auto)

text \<open>For cyclic groups, the discrete logarithm "works" for every element.\<close>

lemma (in cyclic_group) get_exp_fulfills:
  assumes "a \<in> carrier G"
  shows "a = gen [^] get_exp gen a"
proof -
  from elem_is_gen_pow[OF assms] obtain k::int where k: "a = gen [^] k" by blast
  moreover have "gen [^] k = gen [^] (SOME x::int. gen [^] k = gen [^] x)"
    by(intro someI_ex[of "\<lambda>x::int. gen [^] k = gen [^] x"]; blast)
  ultimately show ?thesis unfolding get_exp_def by blast
qed

lemma (in cyclic_group) get_exp_non_zero:
  assumes"b \<in> carrier G" "b \<noteq> \<one>"
  shows "get_exp gen b \<noteq> 0"
  using assms get_exp_fulfills[OF assms(1)] by auto

text \<open>One well-known logarithmic identity.\<close>

lemma (in cyclic_group) get_exp_mult_mod:
  assumes "a \<in> carrier G" "b \<in> carrier G"
  shows "get_exp gen (a \<otimes> b) mod (ord gen) = (get_exp gen a + get_exp gen b) mod (ord gen)"
proof (intro pow_eq_int_mod[OF gen_closed])
  from get_exp_fulfills[of "a \<otimes> b"] have "gen [^] get_exp gen (a \<otimes> b) = a \<otimes> b" using assms by simp
  moreover have "gen [^] (get_exp gen a + get_exp gen b) = a \<otimes> b"
  proof -
    have "gen [^] (get_exp gen a + get_exp gen b) = gen [^] (get_exp gen a) \<otimes> gen [^] (get_exp gen b)"
      using int_pow_mult by blast
    with get_exp_fulfills assms show ?thesis by simp
  qed
  ultimately show "gen [^] get_exp gen (a \<otimes> b) = gen [^] (get_exp gen a + get_exp gen b)" by simp
qed

text \<open>We now show that all functions from a group generated by 'a' to a group generated by 'b'
that map elements from $a^k$ to $b^k$ in the other group are in fact isomorphisms between these two
groups.\<close>

lemma (in group) iso_cyclic_groups_generate:
  assumes "a \<in> carrier G" "b \<in> carrier H" "group.ord G a = group.ord H b" "group H"
  shows "{f. \<forall>k \<in> (UNIV::int set). f (a [^] k) = b [^]\<^bsub>H\<^esub> k}
         \<subseteq> iso (G\<lparr>carrier := generate G {a}\<rparr>) (H\<lparr>carrier := generate H {b}\<rparr>)"
proof
  interpret H: group H by fact
  let ?A = "G\<lparr>carrier := generate G {a}\<rparr>"
  let ?B = "H\<lparr>carrier := generate H {b}\<rparr>"
  interpret A: cyclic_group ?A a by (intro group.cyclic_groupI2; use assms(1) in simp)
  interpret B: cyclic_group ?B b by (intro group.cyclic_groupI2; use assms(2) in simp)
  have sA: "subgroup (generate G {a}) G" by (intro generate_is_subgroup, use assms(1) in simp)
  have sB: "subgroup (generate H {b}) H" by (intro H.generate_is_subgroup, use assms(2) in simp)
  fix x
  assume x: "x \<in> {f. \<forall>k\<in>(UNIV::int set). f (a [^] k) = b [^]\<^bsub>H\<^esub> k}"
  have hom: "x \<in> hom ?A ?B"
  proof (intro homI)
    fix c
    assume c: "c \<in> carrier ?A"
    from A.elem_is_gen_pow[OF this] obtain k::int where k: "c = a [^] k"
      using int_pow_consistent[OF sA generate.incl[of a]] by auto
    with x have "x c = b [^]\<^bsub>H\<^esub> k" by blast
    thus "x c \<in> carrier ?B"
      using B.int_pow_closed H.int_pow_consistent[OF sB] generate.incl[of b "{b}" H] by simp
    fix d
    assume d: "d \<in> carrier ?A"
    from A.elem_is_gen_pow[OF this] obtain l::int where l: "d = a [^] l"
      using int_pow_consistent[OF sA generate.incl[of a]] by auto
    with k have "c \<otimes> d = a [^] (k + l)" by (simp add: int_pow_mult assms(1))
    with x have "x (c \<otimes>\<^bsub>?A\<^esub> d) = b [^]\<^bsub>H\<^esub> (k + l)" by simp
    also have "\<dots> = b [^]\<^bsub>H\<^esub> k \<otimes>\<^bsub>H\<^esub> b [^]\<^bsub>H\<^esub> l" by (simp add: H.int_pow_mult assms(2))
    finally show "x (c \<otimes>\<^bsub>?A\<^esub> d) = x c \<otimes>\<^bsub>?B\<^esub> x d" using x k l by simp
  qed
  then interpret xgh: group_hom ?A ?B x unfolding group_hom_def group_hom_axioms_def by blast
  have "kernel ?A ?B x = {\<one>}"
  proof(intro equalityI)
    show "{\<one>} \<subseteq> kernel ?A ?B x" using xgh.one_in_kernel by auto
    have "c = \<one>" if "c \<in> kernel ?A ?B x" for c
    proof -
      from that have c: "c \<in> carrier ?A" unfolding kernel_def by blast
      from A.elem_is_gen_pow[OF this] obtain k::int where k: "c = a [^] k"
        using int_pow_consistent[OF sA generate.incl[of a]] by auto
      moreover have "x c = \<one>\<^bsub>H\<^esub>" using that x unfolding kernel_def by auto
      ultimately have "\<one>\<^bsub>H\<^esub> = b [^]\<^bsub>H\<^esub> k" using x by simp
      with assms(3) have "a [^] k = \<one>"
        using int_pow_eq_id[OF assms(1), of k] H.int_pow_eq_id[OF assms(2), of k] by simp
      thus "c = \<one>" using k by blast
    qed
    thus "kernel ?A ?B x \<subseteq> {\<one>}" by blast
  qed
  moreover have "carrier ?B \<subseteq> x ` carrier ?A"
  proof
    fix c
    assume c: "c \<in> carrier ?B"
    from B.elem_is_gen_pow[OF this] obtain k::int where k: "c = b [^]\<^bsub>H\<^esub> k"
      using H.int_pow_consistent[OF sB generate.incl[of b]] by auto
    then have "x (a [^] k) = c" using x by blast
    moreover have "a [^] k \<in> carrier ?A"
      using int_pow_consistent[OF sA generate.incl[of a]] A.int_pow_closed generate.incl[of a]
      by fastforce
    ultimately show "c \<in> x ` carrier ?A" by blast
  qed
  ultimately show "x \<in> iso ?A ?B" using hom xgh.iso_iff unfolding kernel_def by auto
qed

text \<open>This is then used to derive the isomorphism of two cyclic groups of the same order as a
direct consequence.\<close>

lemma (in cyclic_group) iso_cyclic_groups_same_order:
  assumes "cyclic_group H h" "order G = order H"
  shows "G \<cong> H"
proof(intro is_isoI)
  interpret H: cyclic_group H h by fact
  define f where "f = (\<lambda>a. h [^]\<^bsub>H\<^esub> get_exp gen a)"
  from assms(2) have o: "ord gen = H.ord h" using ord_gen_is_group_order H.ord_gen_is_group_order
    by simp
  have "\<forall>k \<in> (UNIV::int set). f (gen [^] k) = h [^]\<^bsub>H\<^esub> k"
  proof
    fix k
    assume k: "k \<in> (UNIV::int set)"
    have "gen [^] k = gen [^] (SOME x::int. gen [^] k = gen [^] x)"
      by(intro someI_ex[of "\<lambda>x::int. gen [^] k = gen [^] x"]; blast)
    moreover have "(SOME x::int. gen [^] k = gen [^] x) = (SOME x::int. h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> x)"
    proof -
      have "gen [^] k = gen [^] x \<longleftrightarrow> h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> x" for x::int
        by (simp add: o group.int_pow_eq)
      thus ?thesis by simp
    qed
    moreover have "h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> (SOME x::int. h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> x)"
      by(intro someI_ex[of "\<lambda>x::int. h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> x"]; blast)
    ultimately show "f (gen [^] k) = h [^]\<^bsub>H\<^esub> k" unfolding f_def get_exp_def by metis
  qed
  thus "f \<in> iso G H"
    using iso_cyclic_groups_generate[OF gen_closed H.gen_closed o H.is_group]
    by (auto simp flip: generator H.generator)
qed

subsection \<open>Integer modular groups\<close>

text \<open>We show that \<open>integer_mod_group\<close> (written as \<open>Z n\<close>) is in fact a cyclic group.
For $n \neq 1$ it is generated by $1$ and in the other case by $0$.\<close>

notation integer_mod_group ("Z")

lemma Zn_neq1_cyclic_group:
  assumes "n \<noteq> 1"
  shows "cyclic_group (Z n) 1"
proof(unfold cyclic_group_def cyclic_group_axioms_def, safe)
  show "group (Z n)" using group_integer_mod_group .
  then interpret group "Z n" .
  show oc: "1 \<in> carrier (Z n)"
    unfolding integer_mod_group_def integer_group_def using assms by force
  show "x \<in> generate (Z n) {1}" if "x \<in> carrier (Z n)" for x
    using generate_pow[OF oc] that int_pow_integer_mod_group solve_equation subgroup_self
    by fastforce
  show "x \<in> carrier (Z n)" if "x \<in> generate (Z n) {1}" for x using generate_incl[of "{1}"] that oc
    by fast
qed

lemma Z1_cyclic_group: "cyclic_group (Z 1) 0"
proof(unfold cyclic_group_def cyclic_group_axioms_def, safe)
  show "group (Z 1)" using group_integer_mod_group .
  then interpret group "Z 1" .
  show "0 \<in> carrier (Z 1)" unfolding integer_mod_group_def by simp
  thus "x \<in> carrier (Z 1)" if "x \<in> generate (Z 1) {0}" for x using generate_incl[of "{0}"] that
    by fast
  show "x \<in> generate (Z 1) {0}" if "x \<in> carrier (Z 1)" for x
  proof -
    from that have "x = 0" unfolding integer_mod_group_def by auto
    with generate.one[of "Z 1" "{0}"] show "x \<in> generate (Z 1) {0}" unfolding integer_mod_group_def
      by simp
  qed
qed

lemma Zn_cyclic_group:
  obtains x where "cyclic_group (Z n) x"
  using Z1_cyclic_group Zn_neq1_cyclic_group by metis

text \<open>Moreover, its order is just $n$.\<close>

lemma Zn_order: "order (Z n) = n"
  by (unfold integer_mod_group_def integer_group_def order_def, auto)

text \<open>Consequently, \<open>Z n\<close> is isomorphic to any cyclic group of order $n$.\<close>

lemma (in cyclic_group) Zn_iso:
  assumes "order G = n"
  shows "G \<cong> Z n"
  using Zn_order Zn_cyclic_group iso_cyclic_groups_same_order assms by metis

no_notation integer_mod_group ("Z")
end