(* Author: Johannes Hölzl <hoelzl@in.tum.de> *)

section \<open>Auxiliary Theory\<close>

text \<open>Parts of it should be moved to the Isabelle repository\<close>

theory Markov_Models_Auxiliary
imports
  "HOL-Probability.Probability"
  "HOL-Library.Rewrite"
  "HOL-Library.Linear_Temporal_Logic_on_Streams"
  Coinductive.Coinductive_Stream
  Coinductive.Coinductive_Nat
begin

lemma lfp_upperbound: "(\<And>y. x \<le> f y) \<Longrightarrow> x \<le> lfp f"
  unfolding lfp_def by (intro Inf_greatest) (auto intro: order_trans)

(* ?? *)
lemma lfp_arg: "(\<lambda>t. lfp (F t)) = lfp (\<lambda>x t. F t (x t))"
  apply (auto simp: lfp_def le_fun_def fun_eq_iff intro!: Inf_eqI Inf_greatest)
  subgoal for x y
    by (rule INF_lower2[of "top(x := y)"]) auto
  done

lemma lfp_pair: "lfp (\<lambda>f (a, b). F (\<lambda>a b. f (a, b)) a b) (a, b) = lfp F a b"
  unfolding lfp_def
  by (auto intro!: INF_eq simp: le_fun_def)
     (auto intro!: exI[of _ "\<lambda>(a, b). x a b" for x])

lemma all_Suc_split: "(\<forall>i. P i) \<longleftrightarrow> (P 0 \<and> (\<forall>i. P (Suc i)))"
  using nat_induct by auto

definition "with P f d = (if \<exists>x. P x then f (SOME x. P x) else d)"

lemma withI[case_names default exists]:
  "((\<And>x. \<not> P x) \<Longrightarrow> Q d) \<Longrightarrow> (\<And>x. P x \<Longrightarrow> Q (f x)) \<Longrightarrow> Q (with P f d)"
  unfolding with_def by (auto intro: someI2)

context order
begin

definition
  "maximal f S = {x\<in>S. \<forall>y\<in>S. f y \<le> f x}"

lemma maximalI: "x \<in> S \<Longrightarrow> (\<And>y. y \<in> S \<Longrightarrow> f y \<le> f x) \<Longrightarrow> x \<in> maximal f S"
  by (simp add: maximal_def)

lemma maximalI_trans: "x \<in> maximal f S \<Longrightarrow> f x \<le> f y \<Longrightarrow> y \<in> S \<Longrightarrow> y \<in> maximal f S"
  unfolding maximal_def by (blast intro: antisym order_trans)

lemma maximalD1: "x \<in> maximal f S \<Longrightarrow> x \<in> S"
  by (simp add: maximal_def)

lemma maximalD2: "x \<in> maximal f S \<Longrightarrow> y \<in> S \<Longrightarrow> f y \<le> f x"
  by (simp add: maximal_def)

lemma maximal_inject: "x \<in> maximal f S \<Longrightarrow> y \<in> maximal f S \<Longrightarrow> f x = f y"
  unfolding maximal_def by (blast intro: antisym)

lemma maximal_empty[simp]: "maximal f {} = {}"
  by (simp add: maximal_def)

lemma maximal_singleton[simp]: "maximal f {x} = {x}"
  by (auto simp add: maximal_def)

lemma maximal_in_S: "maximal f S \<subseteq> S"
  by (auto simp: maximal_def)

end

context linorder
begin

lemma maximal_ne:
  assumes "finite S" "S \<noteq> {}"
  shows "maximal f S \<noteq> {}"
  using assms
proof (induct rule: finite_ne_induct)
  case (insert s S)
  show ?case
  proof cases
    assume "\<forall>x\<in>S. f x \<le> f s"
    with insert have "s \<in> maximal f (insert s S)"
      by (auto intro!: maximalI)
    then show ?thesis
      by auto
  next
    assume "\<not> (\<forall>x\<in>S. f x \<le> f s)"
    then have "maximal f (insert s S) = maximal f S"
      by (auto simp: maximal_def)
    with insert show ?thesis
      by auto
  qed
qed simp

end

lemma mono_les:
  fixes s S N and l1 l2 :: "'a \<Rightarrow> real" and K :: "'a \<Rightarrow> 'a pmf"
  defines "\<Delta> x \<equiv> l2 x - l1 x"
  assumes s: "s \<in> S" and S: "(\<Union>s\<in>S. set_pmf (K s)) \<subseteq> S \<union> N"
  assumes int_l1[simp]: "\<And>s. s \<in> S \<Longrightarrow> integrable (K s) l1"
  assumes int_l2[simp]: "\<And>s. s \<in> S \<Longrightarrow> integrable (K s) l2"
  assumes to_N: "\<And>s. s \<in> S \<Longrightarrow> \<exists>t\<in>N. (s, t) \<in> (SIGMA s:UNIV. K s)\<^sup>*"
  assumes l1: "\<And>s. s \<in> S \<Longrightarrow> (\<integral>t. l1 t \<partial>K s) + c s \<le> l1 s"
  assumes l2: "\<And>s. s \<in> S \<Longrightarrow> l2 s \<le> (\<integral>t. l2 t \<partial>K s) + c s"
  assumes eq: "\<And>s. s \<in> N \<Longrightarrow> l2 s \<le> l1 s"
  assumes finitary: "finite (\<Delta> ` (S\<union>N))"
  shows "l2 s \<le> l1 s"
proof -
  define M where "M = {s\<in>S\<union>N. \<forall>t\<in>S\<union>N. \<Delta> t \<le> \<Delta> s}"

  have [simp]: "\<And>s. s\<in>S \<Longrightarrow> integrable (K s) \<Delta>"
    by (simp add: \<Delta>_def[abs_def])

  have M_unqiue: "\<And>s t. s \<in> M \<Longrightarrow> t \<in> M \<Longrightarrow> \<Delta> s = \<Delta> t"
    by (auto intro!: antisym simp: M_def)
  have M1: "\<And>s. s \<in> M \<Longrightarrow> s \<in> S \<union> N"
    by (auto simp: M_def)
  have M2: "\<And>s t. s \<in> M \<Longrightarrow> t \<in> S \<union> N \<Longrightarrow> \<Delta> t \<le> \<Delta> s"
    by (auto simp: M_def)
  have M3: "\<And>s t. s \<in> M \<Longrightarrow> t \<in> S \<union> N \<Longrightarrow> t \<notin> M \<Longrightarrow> \<Delta> t < \<Delta> s"
    by (auto simp: M_def less_le)

  have N: "\<forall>s\<in>N. \<Delta> s \<le> 0"
    using eq by (simp add: \<Delta>_def)

  { fix s assume s: "s \<in> M" "M \<inter> N = {}"
    then have "s \<in> S - N"
      by (auto dest: M1)
    with to_N[of s] obtain t where "(s, t) \<in> (SIGMA s:UNIV. K s)\<^sup>*" and "t \<in> N"
      by (auto simp: M_def)
    from this(1) \<open>s \<in> M\<close> have "\<Delta> s \<le> 0"
    proof (induction rule: converse_rtrancl_induct)
      case (step s s')
      then have s: "s \<in> M" "s \<in> S" "s \<notin> N" and s': "s' \<in> S \<union> N" "s' \<in> K s"
        using S \<open>M \<inter> N = {}\<close> by (auto dest: M1)
      have "s' \<in> M"
      proof (rule ccontr)
        assume "s' \<notin> M"
        with \<open>s \<in> S\<close> s' \<open>s \<in> M\<close>
        have "0 < pmf (K s) s'" "\<Delta> s' < \<Delta> s"
          by (auto intro: M2 M3 pmf_positive)

        have "\<Delta> s \<le> ((\<integral>t. l2 t \<partial>K s) + c s) - ((\<integral>t. l1 t \<partial>K s) + c s)"
          unfolding \<Delta>_def using \<open>s \<in> S\<close> \<open>s \<notin> N\<close> by (intro diff_mono l1 l2) auto
        then have "\<Delta> s \<le> (\<integral>s'. \<Delta> s' \<partial>K s)"
          using \<open>s \<in> S\<close> by (simp add: \<Delta>_def)
        also have "\<dots> < (\<integral>s'. \<Delta> s \<partial>K s)"
          using \<open>s' \<in> K s\<close> \<open>\<Delta> s' < \<Delta> s\<close> \<open>s\<in>S\<close> S \<open>s\<in>M\<close>
          by (intro measure_pmf.integral_less_AE[where A="{s'}"])
             (auto simp: emeasure_measure_pmf_finite AE_measure_pmf_iff set_pmf_iff[symmetric]
                   intro!: M2)
        finally show False
          using measure_pmf.prob_space[of "K s"] by simp
      qed
      with step.IH \<open>t\<in>N\<close> N have "\<Delta> s' \<le> 0" "s' \<in> M"
        by auto
      with \<open>s\<in>S\<close> show "\<Delta> s \<le> 0"
        by (force simp: M_def)
    qed (insert N \<open>t\<in>N\<close>, auto) }

  show ?thesis
  proof cases
    assume "M \<inter> N = {}"
    have "Max (\<Delta>`(S\<union>N)) \<in> \<Delta>`(S\<union>N)"
      using \<open>s \<in> S\<close> by (intro Max_in finitary) auto
    then obtain t where "t \<in> S \<union> N" "\<Delta> t = Max (\<Delta>`(S\<union>N))"
      unfolding image_iff by metis
    then have "t \<in> M"
      by (auto simp: M_def finitary intro!: Max_ge)
    have "\<Delta> s \<le> \<Delta> t"
      using \<open>t\<in>M\<close> \<open>s\<in>S\<close> by (auto dest: M2)
    also have "\<Delta> t \<le> 0"
      using \<open>t\<in>M\<close> \<open>M \<inter> N = {}\<close> by fact
    finally show ?thesis
      by (simp add: \<Delta>_def)
  next
    assume "M \<inter> N \<noteq> {}"
    then obtain t where "t \<in> M" "t \<in> N" by auto
    with N \<open>s\<in>S\<close> have "\<Delta> s \<le> 0"
      by (intro order_trans[of "\<Delta> s" "\<Delta> t" 0]) (auto simp: M_def)
    then show ?thesis
      by (simp add: \<Delta>_def)
  qed
qed

lemma unique_les:
  fixes s S N and l1 l2 :: "'a \<Rightarrow> real" and K :: "'a \<Rightarrow> 'a pmf"
  defines "\<Delta> x \<equiv> l2 x - l1 x"
  assumes s: "s \<in> S" and S: "(\<Union>s\<in>S. set_pmf (K s)) \<subseteq> S \<union> N"
  assumes "\<And>s. s \<in> S \<Longrightarrow> integrable (K s) l1"
  assumes "\<And>s. s \<in> S \<Longrightarrow> integrable (K s) l2"
  assumes "\<And>s. s \<in> S \<Longrightarrow> \<exists>t\<in>N. (s, t) \<in> (SIGMA s:UNIV. K s)\<^sup>*"
  assumes "\<And>s. s \<in> S \<Longrightarrow> l1 s = (\<integral>t. l1 t \<partial>K s) + c s"
  assumes "\<And>s. s \<in> S \<Longrightarrow> l2 s = (\<integral>t. l2 t \<partial>K s) + c s"
  assumes "\<And>s. s \<in> N \<Longrightarrow> l2 s = l1 s"
  assumes 1: "finite (\<Delta> ` (S\<union>N))"
  shows "l2 s = l1 s"
proof -
  have "finite ((\<lambda>x. l2 x - l1 x) ` (S\<union>N))"
    using 1 by (auto simp: \<Delta>_def[abs_def])
  moreover then have "finite (uminus ` (\<lambda>x. l2 x - l1 x) ` (S\<union>N))"
    by auto
  ultimately show ?thesis
    using assms
    by (intro antisym mono_les[of s S K N l2 l1 c] mono_les[of s S K N l1 l2 c])
       (auto simp: image_comp comp_def)
qed

lemma inf_continuous_suntil_disj[order_continuous_intros]:
  assumes Q: "inf_continuous Q"
  assumes disj: "\<And>x \<omega>. \<not> (P \<omega> \<and> Q x \<omega>)"
  shows "inf_continuous (\<lambda>x. P suntil Q x)"
  unfolding inf_continuous_def
proof (safe intro!: ext)
  fix M \<omega> i assume "(P suntil Q (\<Sqinter>i. M i)) \<omega>" "decseq M" then show "(P suntil Q (M i)) \<omega>"
    unfolding inf_continuousD[OF Q \<open>decseq M\<close>] by induction (auto intro: suntil.intros)
next
  fix M \<omega> assume *: "(\<Sqinter>i. P suntil Q (M i)) \<omega>" "decseq M"
  then have "(P suntil Q (M 0)) \<omega>"
    by auto
  from this * show "(P suntil Q (\<Sqinter>i. M i)) \<omega>"
    unfolding inf_continuousD[OF Q \<open>decseq M\<close>]
  proof induction
    case (base \<omega>) with disj[of \<omega> "M _"] show ?case by (auto intro: suntil.intros elim: suntil.cases)
  next
    case (step \<omega>) with disj[of \<omega> "M _"] show ?case by (auto intro: suntil.intros elim: suntil.cases)
  qed
qed

lemma inf_continuous_nxt[order_continuous_intros]: "inf_continuous P \<Longrightarrow> inf_continuous (\<lambda>x. nxt (P x) \<omega>)"
  by (auto simp: inf_continuous_def image_comp)

lemma sup_continuous_nxt[order_continuous_intros]: "sup_continuous P \<Longrightarrow> sup_continuous (\<lambda>x. nxt (P x) \<omega>)"
  by (auto simp: sup_continuous_def image_comp)

lemma mcont_ennreal_of_enat: "mcont Sup (\<le>) Sup (\<le>) ennreal_of_enat"
  by (auto intro!: mcontI monotoneI contI ennreal_of_enat_Sup)

lemma mcont2mcont_ennreal_of_enat[cont_intro]:
  "mcont lub ord Sup (\<le>) f \<Longrightarrow> mcont lub ord Sup (\<le>) (\<lambda>x. ennreal_of_enat (f x))"
  by (auto intro: ccpo.mcont2mcont[OF complete_lattice_ccpo'] mcont_ennreal_of_enat)

declare stream.exhaust[cases type: stream]

lemma scount_eq_emeasure: "scount P \<omega> = emeasure (count_space UNIV) {i. P (sdrop i \<omega>)}"
proof cases
  assume "alw (ev P) \<omega>"
  moreover then have "infinite {i. P (sdrop i \<omega>)}"
    using infinite_iff_alw_ev[of P \<omega>] by simp
  ultimately show ?thesis
    by (simp add: scount_infinite_iff[symmetric])
next
  assume "\<not> alw (ev P) \<omega>"
  moreover then have "finite {i. P (sdrop i \<omega>)}"
    using infinite_iff_alw_ev[of P \<omega>] by simp
  ultimately show ?thesis
    by (simp add: not_alw_iff not_ev_iff scount_eq_card)
qed

lemma measurable_scount[measurable]:
  assumes [measurable]: "Measurable.pred (stream_space M) P"
  shows "scount P \<in> measurable (stream_space M) (count_space UNIV)"
  unfolding scount_eq[abs_def] by measurable

lemma measurable_sfirst2:
  assumes [measurable]: "Measurable.pred (N \<Otimes>\<^sub>M stream_space M) (\<lambda>(x, \<omega>). P x \<omega>)"
  shows "(\<lambda>(x, \<omega>). sfirst (P x) \<omega>) \<in> measurable (N \<Otimes>\<^sub>M  stream_space M) (count_space UNIV)"
  apply (coinduction rule: measurable_enat_coinduct)
  apply simp
  apply (rule exI[of _ "\<lambda>x. 0"])
  apply (rule exI[of _ "\<lambda>(x, \<omega>). (x, stl \<omega>)"])
  apply (rule exI[of _ "\<lambda>(x, \<omega>). P x \<omega>"])
  apply (subst sfirst.simps[abs_def])
  apply (simp add: fun_eq_iff)
  done

lemma measurable_sfirst2'[measurable (raw)]:
  assumes [measurable (raw)]: "f \<in> N \<rightarrow>\<^sub>M stream_space M" "Measurable.pred (N \<Otimes>\<^sub>M stream_space M) (\<lambda>x. P (fst x) (snd x))"
  shows "(\<lambda>x. sfirst (P x) (f x)) \<in> measurable N (count_space UNIV)"
  using measurable_sfirst2[measurable] by measurable

lemma measurable_sfirst[measurable]:
  assumes [measurable]: "Measurable.pred (stream_space M) P"
  shows "sfirst P \<in> measurable (stream_space M) (count_space UNIV)"
  by measurable

lemma measurable_epred[measurable]: "epred \<in> count_space UNIV \<rightarrow>\<^sub>M count_space UNIV"
  by (rule measurable_count_space)

lemma nn_integral_stretch:
  "f \<in> borel \<rightarrow>\<^sub>M borel \<Longrightarrow> c \<noteq> 0 \<Longrightarrow> (\<integral>\<^sup>+x. f (c * x) \<partial>lborel) = (1 / \<bar>c\<bar>::real) * (\<integral>\<^sup>+x. f x \<partial>lborel)"
  using nn_integral_real_affine[of f c 0] by (simp add: mult.assoc[symmetric] ennreal_mult[symmetric])

lemma prod_sum_distrib:
  fixes f g :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::comm_semiring_1"
  assumes "finite I" shows "(\<And>i. i \<in> I \<Longrightarrow> finite (J i)) \<Longrightarrow> (\<Prod>i\<in>I. \<Sum>j\<in>J i. f i j) = (\<Sum>m\<in>Pi\<^sub>E I J. \<Prod>i\<in>I. f i (m i))"
  using \<open>finite I\<close>
proof induction
  case (insert i I) then show ?case
    by (auto simp: PiE_insert_eq finite_PiE sum.reindex inj_combinator sum.swap[of _ "Pi\<^sub>E I J"]
                   sum_cartesian_product' sum_distrib_left sum_distrib_right
             intro!: sum.cong prod.cong arg_cong[where f="(*) x" for x])
qed simp

lemma prod_add_distrib:
  fixes f g :: "'a \<Rightarrow> 'b::comm_semiring_1"
  assumes "finite I" shows "(\<Prod>i\<in>I. f i + g i) = (\<Sum>J\<in>Pow I. (\<Prod>i\<in>J. f i) * (\<Prod>i\<in>I - J. g i))"
proof -
  have "(\<Prod>i\<in>I. f i + g i) = (\<Prod>i\<in>I. \<Sum>b\<in>{True, False}. if b then f i else g i)"
    by simp
  also have "\<dots> = (\<Sum>m\<in>I \<rightarrow>\<^sub>E {True, False}. \<Prod>i\<in>I. if m i then f i else g i)"
    using \<open>finite I\<close> by (rule prod_sum_distrib) simp
  also have "\<dots> = (\<Sum>J\<in>Pow I. (\<Prod>i\<in>J. f i) * (\<Prod>i\<in>I - J. g i))"
    by (rule sum.reindex_bij_witness[where i="\<lambda>J. \<lambda>i\<in>I. i\<in>J" and j="\<lambda>m. {i\<in>I. m i}"])
       (auto simp: fun_eq_iff prod.If_cases \<open>finite I\<close> intro!: arg_cong2[where f="(*)"] prod.cong)
  finally show ?thesis .
qed

subclass (in linordered_nonzero_semiring) ordered_semiring_0
  proof qed

lemma (in linordered_nonzero_semiring) prod_nonneg: "(\<forall>a\<in>A. 0 \<le> f a) \<Longrightarrow> 0 \<le> prod f A"
  by (induct A rule: infinite_finite_induct) simp_all

lemma (in linordered_nonzero_semiring) prod_mono:
  "\<forall>i\<in>A. 0 \<le> f i \<and> f i \<le> g i \<Longrightarrow> prod f A \<le> prod g A"
  by (induct A rule: infinite_finite_induct) (auto intro!: prod_nonneg mult_mono)

lemma (in linordered_nonzero_semiring) prod_mono2:
  assumes "finite J" "I \<subseteq> J" "\<And>i. i \<in> I \<Longrightarrow> 0 \<le> g i \<and> g i \<le> f i" "(\<And>i. i \<in> J - I \<Longrightarrow> 1 \<le> f i)"
  shows "prod g I \<le> prod f J"
proof -
  have "prod g I = (\<Prod>i\<in>J. if i \<in> I then g i else 1)"
    using \<open>finite J\<close> \<open>I \<subseteq> J\<close> by (simp add: prod.If_cases Int_absorb1)
  also have "\<dots> \<le> prod f J"
    using assms by (intro prod_mono) auto
  finally show ?thesis .
qed

lemma (in linordered_nonzero_semiring) prod_mono3:
  assumes "finite J" "I \<subseteq> J" "\<And>i. i \<in> J \<Longrightarrow> 0 \<le> g i" "\<And>i. i \<in> I \<Longrightarrow> g i \<le> f i" "(\<And>i. i \<in> J - I \<Longrightarrow> g i \<le> 1)"
  shows "prod g J \<le> prod f I"
proof -
  have "prod g J \<le> (\<Prod>i\<in>J. if i \<in> I then f i else 1)"
    using assms by (intro prod_mono) auto
  also have "\<dots> = prod f I"
    using \<open>finite J\<close> \<open>I \<subseteq> J\<close> by (simp add: prod.If_cases Int_absorb1)
  finally show ?thesis .
qed

lemma (in linordered_nonzero_semiring) one_le_prod: "(\<And>i. i \<in> I \<Longrightarrow> 1 \<le> f i) \<Longrightarrow> 1 \<le> prod f I"
proof (induction I rule: infinite_finite_induct)
  case (insert i I) then show ?case
    using mult_mono[of 1 "f i" 1 "prod f I"]
    by (auto intro: order_trans[OF zero_le_one])
qed auto

lemma sum_plus_one_le_prod_plus_one:
  fixes p :: "'a \<Rightarrow> 'b::linordered_nonzero_semiring"
  assumes "\<And>i. i \<in> I \<Longrightarrow> 0 \<le> p i"
  shows "(\<Sum>i\<in>I. p i) + 1 \<le> (\<Prod>i\<in>I. p i + 1)"
proof cases
  assume [simp]: "finite I"
  with assms have [simp]: "J \<subseteq> I \<Longrightarrow> 0 \<le> prod p J" for J
    by (intro prod_nonneg) auto
  have "1 + (\<Sum>i\<in>I. p i) = (\<Sum>J\<in>insert {} ((\<lambda>x. {x})`I). (\<Prod>i\<in>J. p i) * (\<Prod>i\<in>I - J. 1))"
    by (subst sum.insert) (auto simp: sum.reindex)
  also have "\<dots> \<le> (\<Sum>J\<in>Pow I. (\<Prod>i\<in>J. p i) * (\<Prod>i\<in>I - J. 1))"
    using assms by (intro sum_mono2) auto
  finally show ?thesis
    by (subst prod_add_distrib) (auto simp: add.commute)
qed simp

lemma summable_iff_convergent_prod:
  fixes p :: "nat \<Rightarrow> real" assumes p: "\<And>i. 0 \<le> p i"
  shows "summable p \<longleftrightarrow> convergent (\<lambda>n. \<Prod>i<n. p i + 1)"
  unfolding summable_iff_convergent
proof
  assume "convergent (\<lambda>n. \<Prod>i<n. p i + 1)"
  then obtain x where x: "(\<lambda>n. \<Prod>i<n. p i + 1) \<longlonglongrightarrow> x"
    by (auto simp: convergent_def)
  then have "1 \<le> x"
    by (rule tendsto_lowerbound) (auto intro!: always_eventually one_le_prod p)

  have "convergent (\<lambda>n. 1 + (\<Sum>i<n. p i))"
  proof (intro Bseq_mono_convergent BseqI allI)
    show "0 < x" using \<open>1 \<le> x\<close> by auto
  next
    fix n
    have "norm ((\<Sum>i<n. p i) + 1) \<le> (\<Prod>i<n. p i + 1)"
      using p by (simp add: sum_nonneg sum_plus_one_le_prod_plus_one p)
    also have "\<dots> \<le> x"
      using assms
      by (intro tendsto_lowerbound[OF x])
          (auto simp: eventually_sequentially intro!: exI[of _ n] prod_mono2)
    finally show "norm (1 + sum p {..<n}) \<le> x"
      by (simp add: add.commute)
  qed (insert p, auto intro!: sum_mono2)
  then show "convergent (\<lambda>n. \<Sum>i<n. p i)"
    unfolding convergent_add_const_iff .
next
  assume "convergent (\<lambda>n. \<Sum>i<n. p i)"
  then obtain x where x: "(\<lambda>n. exp (\<Sum>i<n. p i)) \<longlonglongrightarrow> exp x"
    by (force simp: convergent_def intro!: tendsto_exp)
  show "convergent (\<lambda>n. \<Prod>i<n. p i + 1)"
  proof (intro Bseq_mono_convergent BseqI allI)
    show "0 < exp x" by simp
  next
    fix n
    have "norm (\<Prod>i<n. p i + 1) \<le> exp (\<Sum>i<n. p i)"
      using p exp_ge_add_one_self[of "p _"] by (auto simp add: prod_nonneg exp_sum add.commute intro!: prod_mono)
    also have "\<dots> \<le> exp x"
      using p
      by (intro tendsto_lowerbound[OF x]) (auto simp: eventually_sequentially intro!: sum_mono2 )
    finally show "norm (\<Prod>i<n. p i + 1) \<le> exp x" .
  qed (insert p, auto intro!: prod_mono2)
qed

primrec eexp :: "ereal \<Rightarrow> ennreal"
  where
    "eexp MInfty = 0"
  | "eexp (ereal r) = ennreal (exp r)"
  | "eexp PInfty = top"

lemma
  shows eexp_minus_infty[simp]: "eexp (-\<infinity>) = 0"
    and eexp_infty[simp]: "eexp \<infinity> = top"
  using eexp.simps by simp_all

lemma eexp_0[simp]: "eexp 0 = 1"
  by (simp add: zero_ereal_def)

lemma eexp_inj[simp]: "eexp x = eexp y \<longleftrightarrow> x = y"
  by (cases x; cases y; simp)

lemma eexp_mono[simp]: "eexp x \<le> eexp y \<longleftrightarrow> x \<le> y"
  by (cases x; cases y; simp add: top_unique)

lemma eexp_strict_mono[simp]: "eexp x < eexp y \<longleftrightarrow> x < y"
  by (simp add: less_le)

lemma exp_eq_0_iff[simp]: "eexp x = 0 \<longleftrightarrow> x = -\<infinity>"
  using eexp_inj[of x "-\<infinity>"] unfolding eexp_minus_infty .

lemma eexp_surj: "range eexp = UNIV"
proof -
  have part: "UNIV = {0} \<union> {0 <..< top} \<union> {top::ennreal}"
    by (auto simp: less_top)
  show ?thesis
    unfolding part
    by (force simp: image_iff less_top less_top_ennreal intro!: eexp.simps[symmetric] eexp.simps dest: exp_total)
qed

lemma continuous_on_eexp': "continuous_on UNIV eexp"
  by (rule continuous_onI_mono) (auto simp: eexp_surj)

lemma continuous_on_eexp[continuous_intros]: "continuous_on A f \<Longrightarrow> continuous_on A (\<lambda>x. eexp (f x))"
  by (rule continuous_on_compose2[OF continuous_on_eexp']) auto

lemma tendsto_eexp[tendsto_intros]: "(f \<longlongrightarrow> x) F \<Longrightarrow> ((\<lambda>x. eexp (f x)) \<longlongrightarrow> eexp x) F"
  by (rule continuous_on_tendsto_compose[OF continuous_on_eexp']) auto

lemma measurable_eexp[measurable]: "eexp \<in> borel \<rightarrow>\<^sub>M borel"
  using continuous_on_eexp' by (rule borel_measurable_continuous_onI)

lemma eexp_add: "\<not> ((x = \<infinity> \<and> y = -\<infinity>) \<or> (x = -\<infinity> \<and> y = \<infinity>)) \<Longrightarrow> eexp (x + y) = eexp x * eexp y"
  by (cases x; cases y; simp add: exp_add ennreal_mult ennreal_top_mult ennreal_mult_top)

lemma sum_Pinfty:
  fixes f :: "'a \<Rightarrow> ereal"
  shows "sum f I = \<infinity> \<longleftrightarrow> (finite I \<and> (\<exists>i\<in>I. f i = \<infinity>))"
  by (induction I rule: infinite_finite_induct) auto

lemma sum_Minfty:
  fixes f :: "'a \<Rightarrow> ereal"
  shows "sum f I = -\<infinity> \<longleftrightarrow> (finite I \<and> \<not> (\<exists>i\<in>I. f i = \<infinity>) \<and> (\<exists>i\<in>I. f i = -\<infinity>))"
  by (induction I rule: infinite_finite_induct)
     (auto simp: sum_Pinfty)

lemma eexp_sum: "\<not> (\<exists>i\<in>I. \<exists>j\<in>I. f i = -\<infinity> \<and> f j = \<infinity>) \<Longrightarrow> eexp (\<Sum>i\<in>I. f i) = (\<Prod>i\<in>I. eexp (f i))"
proof (induction I rule: infinite_finite_induct)
  case (insert i I)
  have "eexp (sum f (insert i I)) = eexp (f i) * eexp (sum f I)"
    using insert.prems insert.hyps by (auto simp: sum_Pinfty sum_Minfty intro!: eexp_add)
  then show ?case
    using insert by auto
qed simp_all

lemma eexp_suminf:
  assumes wf_f: "\<not> {-\<infinity>, \<infinity>} \<subseteq> range f" and f: "summable f"
  shows "(\<lambda>n. \<Prod>i<n. eexp (f i)) \<longlonglongrightarrow> eexp (\<Sum>i. f i)"
proof -
  have "(\<lambda>n. eexp (\<Sum>i<n. f i)) \<longlonglongrightarrow> eexp (\<Sum>i. f i)"
    by (intro tendsto_eexp summable_LIMSEQ f)
  also have "(\<lambda>n. eexp (\<Sum>i<n. f i)) = (\<lambda>n. \<Prod>i<n. eexp (f i))"
    using wf_f by (auto simp: fun_eq_iff image_iff eq_commute intro!: eexp_sum)
  finally show ?thesis .
qed

lemma continuous_onI_antimono:
  fixes f :: "'a::linorder_topology \<Rightarrow> 'b::{dense_order,linorder_topology}"
  assumes "open (f`A)"
    and mono: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<le> y \<Longrightarrow> f y \<le> f x"
  shows "continuous_on A f"
proof (rule continuous_on_generate_topology[OF open_generated_order], safe)
  have monoD: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f y < f x \<Longrightarrow> x < y"
    by (auto simp: not_le[symmetric] mono)
  have "\<exists>x. x \<in> A \<and> f x < b \<and> x < a" if a: "a \<in> A" and fa: "f a < b" for a b
  proof -
    obtain y where "f a < y" "{f a ..< y} \<subseteq> f`A"
      using open_right[OF \<open>open (f`A)\<close>, of "f a" b] a fa
      by auto
    obtain z where z: "f a < z" "z < min b y"
      using dense[of "f a" "min b y"] \<open>f a < y\<close> \<open>f a < b\<close> by auto
    then obtain c where "z = f c" "c \<in> A"
      using \<open>{f a ..< y} \<subseteq> f`A\<close>[THEN subsetD, of z] by (auto simp: less_imp_le)
    with a z show ?thesis
      by (auto intro!: exI[of _ c] simp: monoD)
  qed
  then show "\<exists>C. open C \<and> C \<inter> A = f -` {..<b} \<inter> A" for b
    by (intro exI[of _ "(\<Union>x\<in>{x\<in>A. f x < b}. {x <..})"])
       (auto intro: le_less_trans[OF mono] less_imp_le)

  have "\<exists>x. x \<in> A \<and> b < f x \<and> x > a" if a: "a \<in> A" and fa: "b < f a" for a b
  proof -
    note a fa
    moreover
    obtain y where "y < f a" "{y <.. f a} \<subseteq> f`A"
      using open_left[OF \<open>open (f`A)\<close>, of "f a" b]  a fa
      by auto
    then obtain z where z: "max b y < z" "z < f a"
      using dense[of "max b y" "f a"] \<open>y < f a\<close> \<open>b < f a\<close> by auto
    then obtain c where "z = f c" "c \<in> A"
      using \<open>{y <.. f a} \<subseteq> f`A\<close>[THEN subsetD, of z] by (auto simp: less_imp_le)
    with a z show ?thesis
      by (auto intro!: exI[of _ c] simp: monoD)
  qed
  then show "\<exists>C. open C \<and> C \<inter> A = f -` {b <..} \<inter> A" for b
    by (intro exI[of _ "(\<Union>x\<in>{x\<in>A. b < f x}. {..< x})"])
       (auto intro: less_le_trans[OF _ mono] less_imp_le)
qed

lemma minus_add_eq_ereal: "\<not> ((a = \<infinity> \<and> b = -\<infinity>) \<or> (a = -\<infinity> \<and> b = \<infinity>)) \<Longrightarrow> - (a + b::ereal) = -a - b"
  by (cases a; cases b; simp)

lemma setsum_negf_ereal: "\<not> {-\<infinity>, \<infinity>} \<subseteq> f`I \<Longrightarrow> (\<Sum>i\<in>I. - f i) = - (\<Sum>i\<in>I. f i::ereal)"
  by (induction I rule: infinite_finite_induct)
     (auto simp: minus_add_eq_ereal sum_Minfty sum_Pinfty,
      (subst minus_add_eq_ereal; auto simp: sum_Pinfty sum_Minfty image_iff minus_ereal_def)+)

lemma convergent_minus_iff_ereal: "convergent (\<lambda>x. - f x::ereal) \<longleftrightarrow> convergent f"
  unfolding convergent_def  by (metis ereal_uminus_uminus ereal_Lim_uminus)

lemma summable_minus_ereal: "\<not> {-\<infinity>, \<infinity>} \<subseteq> range f \<Longrightarrow> summable (\<lambda>n. f n) \<Longrightarrow> summable (\<lambda>n. - f n::ereal)"
  unfolding summable_iff_convergent
  by (subst setsum_negf_ereal) (auto simp: convergent_minus_iff_ereal)

lemma (in product_prob_space) product_nn_integral_component:
  assumes "f \<in> borel_measurable (M i)""i \<in> I"
  shows "integral\<^sup>N (Pi\<^sub>M I M) (\<lambda>x. f (x i)) = integral\<^sup>N (M i) f"
proof -
  from assms show ?thesis
    apply (subst PiM_component[symmetric, OF \<open>i \<in> I\<close>])
    apply (subst nn_integral_distr[OF measurable_component_singleton])
    apply simp_all
    done
qed

lemma ennreal_inverse_le[simp]: "inverse x \<le> inverse y \<longleftrightarrow> y \<le> (x::ennreal)"
  by (cases "0 < x"; cases x; cases "0 < y"; cases y; auto simp: top_unique inverse_ennreal)

lemma inverse_inverse_ennreal[simp]: "inverse (inverse x::ennreal) = x"
  by (cases "0 < x"; cases x; auto simp: inverse_ennreal)

lemma range_inverse_ennreal: "range inverse = (UNIV::ennreal set)"
proof -
  have "\<exists>x. y = inverse x" for y :: ennreal
    by (intro exI[of _ "inverse y"]) simp
  then show ?thesis
    unfolding surj_def by auto
qed

lemma continuous_on_inverse_ennreal': "continuous_on (UNIV :: ennreal set) inverse"
  by (rule continuous_onI_antimono) (auto simp: range_inverse_ennreal)

lemma sums_minus_ereal: "\<not> {- \<infinity>, \<infinity>} \<subseteq> f ` UNIV \<Longrightarrow> (\<lambda>n. - f n::ereal) sums x \<Longrightarrow> f sums - x"
  unfolding sums_def
  apply (subst ereal_Lim_uminus)
  apply (subst (asm) setsum_negf_ereal)
  apply auto
  done

lemma suminf_minus_ereal: "\<not> {- \<infinity>, \<infinity>} \<subseteq> f ` UNIV \<Longrightarrow> summable f \<Longrightarrow> (\<Sum>n. - f n :: ereal) = - suminf f"
  apply (rule sums_unique[symmetric])
  apply (rule sums_minus_ereal)
  apply (auto simp: ereal_uminus_eq_reorder)
  done

end


(*
    File:     DirProds.thy
    Author:   Joseph Thommes, TU München
*)
section \<open>Direct group product\<close>

theory DirProds
  imports Finite_Product_Extend Group_Hom Finite_And_Cyclic_Groups
begin

notation integer_mod_group ("Z")

text \<open>The direct group product is defined component-wise and provided in an indexed way.\<close>

definition DirProds :: "('a \<Rightarrow> ('b, 'c) monoid_scheme) \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'b) monoid" where
  "DirProds G I = \<lparr> carrier = Pi\<^sub>E I (carrier \<circ> G),
                   monoid.mult = (\<lambda>x y. restrict (\<lambda>i. x i \<otimes>\<^bsub>G i\<^esub> y i) I),
                   one = restrict (\<lambda>i. \<one>\<^bsub>G i\<^esub>) I \<rparr>"

text \<open>Basic lemmas about \<open>DirProds\<close>.\<close>

lemma DirProds_empty:
  "carrier (DirProds f {}) = {\<one>\<^bsub>DirProds f {}\<^esub>}"
  unfolding DirProds_def by auto

lemma DirProds_order:
  assumes "finite I"
  shows "order (DirProds G I) = prod (order \<circ> G) I"
  unfolding order_def DirProds_def using assms by (simp add: card_PiE)

lemma DirProds_in_carrI:
  assumes "\<And>i. i \<in> I \<Longrightarrow> x i \<in> carrier (G i)" "\<And>i. i \<notin> I \<Longrightarrow> x i = undefined"
  shows "x \<in> carrier (DirProds G I)"
  unfolding DirProds_def using assms by auto

lemma comp_in_carr:
  assumes "x \<in> carrier (DirProds G I)" "i \<in> I"
  shows "x i \<in> carrier (G i)"
  using assms unfolding DirProds_def by auto

lemma comp_mult:
  assumes "i \<in> I"
  shows "(x \<otimes>\<^bsub>DirProds G I\<^esub> y) i = (x i \<otimes>\<^bsub>G i\<^esub> y i)"
  using assms unfolding DirProds_def by simp

lemma comp_exp_nat:
  fixes k::nat
  assumes "i \<in> I"
  shows "(x [^]\<^bsub>DirProds G I\<^esub> k) i = x i [^]\<^bsub>G i\<^esub> k"
proof (induction k)
  case 0
  then show ?case using assms unfolding DirProds_def by simp
next
  case i: (Suc k)
  have "(x [^]\<^bsub>DirProds G I\<^esub> k \<otimes>\<^bsub>DirProds G I\<^esub> x) i = (x [^]\<^bsub>DirProds G I\<^esub> k) i \<otimes>\<^bsub>G i\<^esub> x i"
    by(rule comp_mult[OF assms])
  also from i have "\<dots> = x i [^]\<^bsub>G i\<^esub> k \<otimes>\<^bsub>G i\<^esub> x i" by simp
  also have "\<dots> = x i [^]\<^bsub>G i\<^esub> Suc k" by simp
  finally show ?case by simp
qed

lemma DirProds_m_closed:
  assumes "x \<in> carrier (DirProds G I)" "y \<in> carrier (DirProds G I)" "\<And>i. i \<in> I \<Longrightarrow> group (G i)"
  shows "x \<otimes>\<^bsub>DirProds G I\<^esub> y \<in> carrier (DirProds G I)"
  using assms monoid.m_closed[OF group.is_monoid[OF assms(3)]] unfolding DirProds_def by fastforce

lemma partial_restr:
  assumes "a \<in> carrier (DirProds G I)" "J \<subseteq> I"
  shows "restrict a J \<in> carrier (DirProds G J)"
  using assms unfolding DirProds_def by auto

lemma eq_parts_imp_eq:
  assumes "a \<in> carrier (DirProds G I)" "b \<in> carrier (DirProds G I)" "\<And>i. i \<in> I \<Longrightarrow> a i = b i"
  shows "a = b"
  using assms unfolding DirProds_def by fastforce

lemma mult_restr:
  assumes "a \<in> carrier (DirProds G I)" "b \<in> carrier (DirProds G I)" "J \<subseteq> I"
  shows "a \<otimes>\<^bsub>DirProds G J\<^esub> b = restrict (a \<otimes>\<^bsub>DirProds G I\<^esub> b) J"
  using assms unfolding DirProds_def by force

lemma DirProds_one:
  assumes "x \<in> carrier (DirProds G I)"
  shows "(\<forall>i \<in> I. x i = \<one>\<^bsub>G i\<^esub>) \<longleftrightarrow> x = \<one>\<^bsub>DirProds G I\<^esub>"
  using assms unfolding DirProds_def by fastforce

lemma DirProds_one':
  "i\<in>I \<Longrightarrow> \<one>\<^bsub>DirProds G I\<^esub> i = \<one>\<^bsub>G i\<^esub>"
  unfolding DirProds_def by simp

lemma DirProds_one'':
  "\<one>\<^bsub>DirProds G I\<^esub> = restrict (\<lambda>i. \<one>\<^bsub>G i\<^esub>) I"
  by (unfold DirProds_def, simp)

lemma DirProds_mult:
  "(\<otimes>\<^bsub>DirProds G I\<^esub>) = (\<lambda>x y. restrict (\<lambda>i. x i \<otimes>\<^bsub>G i\<^esub> y i) I)"
  unfolding DirProds_def by simp

lemma DirProds_one_iso: "(\<lambda>x. x G) \<in> iso (DirProds f {G}) (f G)"
proof (intro isoI homI)
  show "bij_betw (\<lambda>x. x G) (carrier (DirProds f {G})) (carrier (f G))"
  proof (unfold bij_betw_def, rule)
    show "inj_on (\<lambda>x. x G) (carrier (DirProds f {G}))"
      by (intro inj_onI, unfold DirProds_def PiE_def Pi_def extensional_def, fastforce)
    show "(\<lambda>x. x G) ` carrier (DirProds f {G}) = carrier (f G)"
    proof(intro equalityI subsetI)
      show "x \<in> carrier (f G)" if "x \<in> (\<lambda>x. x G) ` carrier (DirProds f {G})" for x
        using that unfolding DirProds_def by auto
      show "x \<in> (\<lambda>x. x G) ` carrier (DirProds f {G})" if xc: "x \<in> carrier (f G)" for x
      proof
        show "(\<lambda>k\<in>{G}. x) \<in> carrier (DirProds f {G})" unfolding DirProds_def using xc by auto
        moreover show "x = (\<lambda>k\<in>{G}. x) G" by simp
      qed
    qed
  qed
qed (unfold DirProds_def PiE_def Pi_def extensional_def, auto)

lemma DirProds_one_cong: "(DirProds f {G}) \<cong> (f G)"
  using DirProds_one_iso is_isoI by fast

lemma DirProds_one_iso_sym: "(\<lambda>x. (\<lambda>_\<in>{G}. x)) \<in> iso (f G) (DirProds f {G})"
proof (intro isoI homI)
  show "bij_betw (\<lambda>x. \<lambda>_\<in>{G}. x) (carrier (f G)) (carrier (DirProds f {G}))"
  proof (unfold bij_betw_def, rule)
    show "inj_on (\<lambda>x. (\<lambda>_\<in>{G}. x)) (carrier (f G))"
      by (intro inj_onI, metis imageI image_constant image_restrict_eq member_remove remove_def)
    show "(\<lambda>x. (\<lambda>_\<in>{G}. x)) ` carrier (f G) = carrier (DirProds f {G})"
      unfolding DirProds_def by fastforce
  qed
qed (unfold DirProds_def, auto)

lemma DirProds_one_cong_sym: "(f G) \<cong> (DirProds f {G})"
  using DirProds_one_iso_sym is_isoI by fast

text \<open>The direct product is a group iff all factors are groups.\<close>

lemma DirProds_is_group:
  assumes "\<And>i. i \<in> I \<Longrightarrow> group (G i)"
  shows "group (DirProds G I)"
proof(rule groupI)
  show one_closed: "\<one>\<^bsub>DirProds G I\<^esub> \<in> carrier (DirProds G I)" unfolding DirProds_def
    by (simp add: assms group.is_monoid)
  fix x
  assume x: "x \<in> carrier (DirProds G I)"
  have one_: "\<And>i. i \<in> I \<Longrightarrow> \<one>\<^bsub>G i\<^esub> = \<one>\<^bsub>DirProds G I\<^esub> i" unfolding DirProds_def by simp
  have "\<And>i. i \<in> I \<Longrightarrow> \<one>\<^bsub>DirProds G I\<^esub> i \<otimes>\<^bsub>G i\<^esub> x i = x i"
  proof -
    fix i
    assume i: "i \<in> I"
    interpret group "G i" using assms[OF i] .
    have "x i \<in> carrier (G i)" using x i comp_in_carr by fast
    thus "\<one>\<^bsub>DirProds G I\<^esub> i \<otimes>\<^bsub>G i\<^esub> x i = x i" by(subst one_[OF i, symmetric]; simp)
  qed
  with one_ x show "\<one>\<^bsub>DirProds G I\<^esub> \<otimes>\<^bsub>DirProds G I\<^esub> x = x" unfolding DirProds_def by force
  have "restrict (\<lambda>i. inv\<^bsub>G i\<^esub> (x i)) I \<in> carrier (DirProds G I)" using x group.inv_closed[OF assms]
    unfolding DirProds_def by fastforce
  moreover have "restrict (\<lambda>i. inv\<^bsub>G i\<^esub> (x i)) I \<otimes>\<^bsub>DirProds G I\<^esub> x = \<one>\<^bsub>DirProds G I\<^esub>"
    using x group.l_inv[OF assms] unfolding DirProds_def by fastforce
  ultimately show "\<exists>y\<in>carrier (DirProds G I). y \<otimes>\<^bsub>DirProds G I\<^esub> x = \<one>\<^bsub>DirProds G I\<^esub>" by blast
  fix y
  assume y: "y \<in> carrier (DirProds G I)"
  from DirProds_m_closed[OF x y assms] show m_closed: "x \<otimes>\<^bsub>DirProds G I\<^esub> y \<in> carrier (DirProds G I)"
    by blast
  fix z
  assume z: "z \<in> carrier (DirProds G I)"
  have "\<And>i. i \<in> I \<Longrightarrow> (x \<otimes>\<^bsub>DirProds G I\<^esub> y \<otimes>\<^bsub>DirProds G I\<^esub> z) i
                    = (x \<otimes>\<^bsub>DirProds G I\<^esub> (y \<otimes>\<^bsub>DirProds G I\<^esub> z)) i"
  proof -
    fix i
    assume i: "i \<in> I"
    have "(x \<otimes>\<^bsub>DirProds G I\<^esub> y \<otimes>\<^bsub>DirProds G I\<^esub> z) i = (x \<otimes>\<^bsub>DirProds G I\<^esub> y) i \<otimes>\<^bsub>G i\<^esub> z i"
      using assms by (simp add: comp_mult i m_closed z)
    also have "\<dots> = x i \<otimes>\<^bsub>G i\<^esub> y i \<otimes>\<^bsub>G i\<^esub> z i" by (simp add: assms comp_mult i x y)
    also have "\<dots> = x i \<otimes>\<^bsub>G i\<^esub> (y i \<otimes>\<^bsub>G i\<^esub> z i)" using i assms x y z
      by (meson Group.group_def comp_in_carr monoid.m_assoc)
    also have "\<dots> = (x \<otimes>\<^bsub>DirProds G I\<^esub> (y \<otimes>\<^bsub>DirProds G I\<^esub> z)) i" by (simp add: DirProds_def i)
    finally show "(x \<otimes>\<^bsub>DirProds G I\<^esub> y \<otimes>\<^bsub>DirProds G I\<^esub> z) i
                = (x \<otimes>\<^bsub>DirProds G I\<^esub> (y \<otimes>\<^bsub>DirProds G I\<^esub> z)) i" .
  qed
  thus "x \<otimes>\<^bsub>DirProds G I\<^esub> y \<otimes>\<^bsub>DirProds G I\<^esub> z = x \<otimes>\<^bsub>DirProds G I\<^esub> (y \<otimes>\<^bsub>DirProds G I\<^esub> z)"
    unfolding DirProds_def by auto
qed

lemma DirProds_obtain_elem_carr:
  assumes "group (DirProds G I)" "i \<in> I" "x \<in> carrier (G i)"
  obtains k where "k \<in> carrier (DirProds G I)" "k i = x"
proof -
  interpret DP: group "DirProds G I" by fact
  from comp_in_carr[OF DP.one_closed] DirProds_one' have ao: "\<forall>j\<in>I. \<one>\<^bsub>G j\<^esub> \<in> carrier (G j)" by metis
  let ?r = "restrict ((\<lambda>j. \<one>\<^bsub>G j\<^esub>)(i := x)) I"
  have "?r \<in> carrier (DirProds G I)"
    unfolding DirProds_def PiE_def Pi_def using assms(2, 3) ao by auto
  moreover have "?r i = x" using assms(2) by simp
  ultimately show "(\<And>k. \<lbrakk>k \<in> carrier (DirProds G I); k i = x\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis" by blast
qed

lemma DirProds_group_imp_groups:
  assumes "group (DirProds G I)" and i: "i \<in> I"
  shows "group (G i)"
proof (intro groupI)
  let ?DP = "DirProds G I"
  interpret DP: group ?DP by fact
  show "\<one>\<^bsub>G i\<^esub> \<in> carrier (G i)" using DirProds_one' comp_in_carr[OF DP.one_closed i] i by metis
  show "x \<otimes>\<^bsub>G i\<^esub> y \<in> carrier (G i)" if "x \<in> carrier (G i)" "y \<in> carrier (G i)" for x y
  proof -
    from DirProds_obtain_elem_carr[OF assms that(1)] obtain k where k: "k \<in> carrier ?DP" "k i = x" .
    from DirProds_obtain_elem_carr[OF assms that(2)] obtain l where l: "l \<in> carrier ?DP" "l i = y" .
    have "k \<otimes>\<^bsub>?DP\<^esub> l \<in> carrier ?DP" using k l by fast
    from comp_in_carr[OF this i] comp_mult[OF i] show ?thesis using k l by metis
  qed
  show "x \<otimes>\<^bsub>G i\<^esub> y \<otimes>\<^bsub>G i\<^esub> z = x \<otimes>\<^bsub>G i\<^esub> (y \<otimes>\<^bsub>G i\<^esub> z)"
    if x: "x \<in> carrier (G i)" and y: "y \<in> carrier (G i)" and z: "z \<in> carrier (G i)" for x y z
  proof -
    from DirProds_obtain_elem_carr[OF assms x] obtain k where k: "k \<in> carrier ?DP" "k i = x" .
    from DirProds_obtain_elem_carr[OF assms y] obtain l where l: "l \<in> carrier ?DP" "l i = y" .
    from DirProds_obtain_elem_carr[OF assms z] obtain m where m: "m \<in> carrier ?DP" "m i = z" .
    have "x \<otimes>\<^bsub>G i\<^esub> y \<otimes>\<^bsub>G i\<^esub> z = (k i) \<otimes>\<^bsub>G i\<^esub> (l i) \<otimes>\<^bsub>G i\<^esub> (m i)" using k l m by argo
    also have "\<dots> = (k \<otimes>\<^bsub>?DP\<^esub> l \<otimes>\<^bsub>?DP\<^esub> m) i" using comp_mult[OF i] k l m by metis
    also have "\<dots> = (k \<otimes>\<^bsub>?DP\<^esub> (l \<otimes>\<^bsub>?DP\<^esub> m)) i"
    proof -
      have "k \<otimes>\<^bsub>?DP\<^esub> l \<otimes>\<^bsub>?DP\<^esub> m = k \<otimes>\<^bsub>?DP\<^esub> (l \<otimes>\<^bsub>?DP\<^esub> m)" using DP.m_assoc[OF k(1) l(1) m(1)] .
      thus ?thesis by simp
    qed
    also have "\<dots> = (k i) \<otimes>\<^bsub>G i\<^esub> ((l i) \<otimes>\<^bsub>G i\<^esub> (m i))" using comp_mult[OF i] k l m by metis
    finally show ?thesis using k l m by blast
  qed
  show "\<one>\<^bsub>G i\<^esub> \<otimes>\<^bsub>G i\<^esub> x = x" if "x \<in> carrier (G i)" for x
  proof -
    from DirProds_obtain_elem_carr[OF assms that(1)] obtain k where k: "k \<in> carrier ?DP" "k i = x" .
    hence "\<one>\<^bsub>?DP\<^esub> \<otimes>\<^bsub>?DP\<^esub> k = k" by simp
    with comp_mult k DirProds_one[OF DP.one_closed] that i show ?thesis by metis
  qed
  show "\<exists>y\<in>carrier (G i). y \<otimes>\<^bsub>G i\<^esub> x = \<one>\<^bsub>G i\<^esub>" if "x \<in> carrier (G i)" for x
  proof -
    from DirProds_obtain_elem_carr[OF assms that(1)] obtain k where k: "k \<in> carrier ?DP" "k i = x" .
    hence ic: "inv\<^bsub>?DP\<^esub> k \<in> carrier ?DP" by simp
    have "inv\<^bsub>?DP\<^esub> k \<otimes>\<^bsub>?DP\<^esub> k = \<one>\<^bsub>?DP\<^esub>" using k by simp
    hence "(inv\<^bsub>?DP\<^esub> k) i \<otimes>\<^bsub>G i\<^esub> k i= \<one>\<^bsub>G i\<^esub>" using comp_mult[OF i] DirProds_one'[OF i] by metis
    with k(2) comp_in_carr[OF ic i] show ?thesis by blast
  qed
qed

lemma DirProds_group_iff: "group (DirProds G I) \<longleftrightarrow> (\<forall>i\<in>I. group (G i))"
  using DirProds_is_group DirProds_group_imp_groups by metis

lemma comp_inv:
  assumes "group (DirProds G I)" and x: "x \<in> carrier (DirProds G I)" and i: "i \<in> I"
  shows "(inv\<^bsub>(DirProds G I)\<^esub> x) i = inv\<^bsub>(G i)\<^esub> (x i)"
proof -
  interpret DP: group "DirProds G I" by fact
  interpret Gi: group "G i" using DirProds_group_imp_groups[OF DP.is_group i] .
  have ixc: "inv\<^bsub>(DirProds G I)\<^esub> x \<in> carrier (DirProds G I)" using x by blast
  hence "inv\<^bsub>(DirProds G I)\<^esub> x \<otimes>\<^bsub>DirProds G I\<^esub> x = \<one>\<^bsub>DirProds G I\<^esub>" using x by simp
  hence "(inv\<^bsub>(DirProds G I)\<^esub> x \<otimes>\<^bsub>DirProds G I\<^esub> x) i = \<one>\<^bsub>G i\<^esub>" by (simp add: DirProds_one' i)
  moreover from comp_mult[OF i]
  have "(inv\<^bsub>(DirProds G I)\<^esub> x \<otimes>\<^bsub>DirProds G I\<^esub> x) i = ((inv\<^bsub>(DirProds G I)\<^esub> x) i) \<otimes>\<^bsub>G i\<^esub> (x i)"
    by blast
  ultimately show ?thesis using x ixc by (simp add: comp_in_carr[OF _ i] group.inv_equality)
qed

text \<open>The same is true for abelian groups.\<close>

lemma DirProds_is_comm_group:
  assumes "\<And>i. i \<in> I \<Longrightarrow> comm_group (G i)"
  shows "comm_group (DirProds G I)" (is "comm_group ?DP")
proof
  interpret group ?DP using assms DirProds_is_group unfolding comm_group_def by metis
  show "carrier ?DP \<subseteq> Units ?DP" "\<one>\<^bsub>?DP\<^esub> \<in> carrier ?DP" by simp_all
  fix x
  assume x[simp]: "x \<in> carrier ?DP"
  show "\<one>\<^bsub>?DP\<^esub> \<otimes>\<^bsub>?DP\<^esub> x = x" "x \<otimes>\<^bsub>?DP\<^esub> \<one>\<^bsub>?DP\<^esub> = x" by simp_all
  fix y
  assume y[simp]: "y \<in> carrier ?DP"
  show "x \<otimes>\<^bsub>?DP\<^esub> y \<in> carrier ?DP" by simp
  show "x \<otimes>\<^bsub>DirProds G I\<^esub> y = y \<otimes>\<^bsub>DirProds G I\<^esub> x"
  proof (rule eq_parts_imp_eq[of _ G I])
    show "x \<otimes>\<^bsub>?DP\<^esub> y \<in> carrier ?DP" by simp
    show "y \<otimes>\<^bsub>?DP\<^esub> x \<in> carrier ?DP" by simp
    show "\<And>i. i\<in>I \<Longrightarrow> (x \<otimes>\<^bsub>DirProds G I\<^esub> y) i = (y \<otimes>\<^bsub>DirProds G I\<^esub> x) i"
    proof -
      fix i
      assume i: "i \<in> I"
      interpret gi: comm_group "(G i)" using assms(1)[OF i] .
      have "(x \<otimes>\<^bsub>?DP\<^esub> y) i = x i \<otimes>\<^bsub>G i\<^esub> y i"
        by (intro comp_mult[OF i])
      also have "\<dots> = y i \<otimes>\<^bsub>G i\<^esub> x i" using comp_in_carr[OF _ i] x y gi.m_comm by metis
      also have "\<dots> = (y \<otimes>\<^bsub>?DP\<^esub> x) i" by (intro comp_mult[symmetric, OF i])
      finally show "(x \<otimes>\<^bsub>DirProds G I\<^esub> y) i = (y \<otimes>\<^bsub>DirProds G I\<^esub> x) i" .
    qed
  qed
  fix z
  assume z[simp]: "z \<in> carrier ?DP"
  show "x \<otimes>\<^bsub>?DP\<^esub> y \<otimes>\<^bsub>?DP\<^esub> z = x \<otimes>\<^bsub>?DP\<^esub> (y \<otimes>\<^bsub>?DP\<^esub> z)" using m_assoc by simp
qed

lemma DirProds_comm_group_imp_comm_groups:
  assumes "comm_group (DirProds G I)" and i: "i \<in> I"
  shows "comm_group (G i)"
proof -
  interpret DP: comm_group "DirProds G I" by fact
  interpret Gi: group "G i" using DirProds_group_imp_groups[OF DP.is_group i] .
  show "comm_group (G i)"
  proof
    show "x \<otimes>\<^bsub>G i\<^esub> y = y \<otimes>\<^bsub>G i\<^esub> x" if x: "x \<in> carrier (G i)" and y: "y \<in> carrier (G i)" for x y
    proof -
      obtain a where a[simp]: "a \<in> carrier (DirProds G I)" "a i = x"
        using DirProds_obtain_elem_carr[OF DP.is_group i x] .
      obtain b where b[simp]: "b \<in> carrier (DirProds G I)" "b i = y"
        using DirProds_obtain_elem_carr[OF DP.is_group i y] .
      have "a \<otimes>\<^bsub>DirProds G I\<^esub> b = b \<otimes>\<^bsub>DirProds G I\<^esub> a" using DP.m_comm by simp
      hence "(a \<otimes>\<^bsub>DirProds G I\<^esub> b) i = (b \<otimes>\<^bsub>DirProds G I\<^esub> a) i" by argo
      with comp_mult[OF i] have "a i \<otimes>\<^bsub>G i\<^esub> b i = b i \<otimes>\<^bsub>G i\<^esub> a i" by metis
      with a b show "x \<otimes>\<^bsub>G i\<^esub> y = y \<otimes>\<^bsub>G i\<^esub> x" by blast
    qed
  qed
qed

lemma DirProds_comm_group_iff: "comm_group (DirProds G I) \<longleftrightarrow> (\<forall>i\<in>I. comm_group (G i))"
  using DirProds_is_comm_group DirProds_comm_group_imp_comm_groups by metis

text \<open>And also for finite groups.\<close>

lemma DirProds_is_finite_group:
  assumes "\<And>i. i\<in>I \<Longrightarrow> finite_group (G i)" "finite I"
  shows "finite_group (DirProds G I)"
proof -
  have "group (G i)" if "i\<in>I" for i using assms(1)[OF that] unfolding finite_group_def by blast
  from DirProds_is_group[OF this] interpret DP: group "DirProds G I" by fast
  show ?thesis
  proof(unfold_locales)
    have "order (DirProds G I) \<noteq> 0"
    proof(unfold DirProds_order[OF assms(2)])
      have "(order \<circ> G) i \<noteq> 0" if "i\<in>I" for i
        using assms(1)[OF that] by (simp add: finite_group.order_gt_0)
      thus "prod (order \<circ> G) I \<noteq> 0" by (simp add: assms(2))
    qed
    thus "finite (carrier (DirProds G I))" unfolding order_def by (meson card.infinite)
  qed
qed

lemma DirProds_finite_imp_finite_groups:
  assumes "finite_group (DirProds G I)" "finite I"
  shows "\<And>i. i\<in>I \<Longrightarrow> finite_group (G i)"
proof -
  fix i assume i: "i \<in> I"
  interpret DP: finite_group "DirProds G I" by fact
  interpret group "G i" by (rule DirProds_group_imp_groups[OF DP.is_group i])
  show "finite_group (G i)"
  proof(unfold_locales)
    have oDP: "order (DirProds G I) \<noteq> 0" by blast
    with DirProds_order[OF assms(2), of G] have "order (G i) \<noteq> 0" using i assms(2) by force
    thus "finite (carrier (G i))" unfolding order_def by (meson card_eq_0_iff)
  qed
qed

lemma DirProds_finite_group_iff:
  assumes "finite I"
  shows "finite_group (DirProds G I) \<longleftrightarrow> (\<forall>i\<in>I. finite_group (G i))"
  using DirProds_is_finite_group DirProds_finite_imp_finite_groups assms by metis

lemma DirProds_finite_comm_group_iff:
  assumes "finite I"
  shows "finite_comm_group (DirProds G I) \<longleftrightarrow> (\<forall>i\<in>I. finite_comm_group (G i))"
  using DirProds_finite_group_iff[OF assms] DirProds_comm_group_iff unfolding finite_comm_group_def by fast

text \<open>If a group is an internal direct product of a family of subgroups, it is isomorphic to the
direct product of these subgroups.\<close>

lemma (in comm_group) subgroup_iso_DirProds_IDirProds:
  assumes "subgroup J G" "is_idirprod J S I" "finite I"
  shows "(\<lambda>x. \<Otimes>\<^bsub>G\<^esub>i\<in>I. x i) \<in> iso (DirProds (\<lambda>i. G\<lparr>carrier := (S i)\<rparr>) I) (G\<lparr>carrier := J\<rparr>)"
(is "?fp \<in> iso ?DP ?J")
proof -
  from assms(2) have assm: "J = IDirProds G S I"
                           "compl_fam S I"
    unfolding is_idirprod_def by auto
  from assms(1, 2) have assm': "\<And>i. i \<in> I \<Longrightarrow> subgroup (S i) (G\<lparr>carrier := J\<rparr>)"
    using normal_imp_subgroup subgroup_incl by (metis IDirProds_incl assms(2) is_idirprod_def)
  interpret J: comm_group ?J using subgroup_is_comm_group[OF assms(1)] .
  interpret DP: comm_group ?DP
    by (intro DirProds_is_comm_group; use J.subgroup_is_comm_group[OF assm'] in simp)
  have inJ: "S i \<subseteq> J" if "i \<in> I" for i using subgroup.subset[OF assm'[OF that]] by simp
  have hom: "?fp \<in> hom ?DP ?J"
  proof (rule homI)
    fix x
    assume x[simp]: "x \<in> carrier ?DP"
    show "finprod G x I \<in> carrier ?J"
    proof (subst finprod_subgroup[OF _ assms(1)])
      show "x \<in> I \<rightarrow> J" using inJ comp_in_carr[OF x] by auto
      thus "finprod ?J x I \<in> carrier ?J" by (intro J.finprod_closed; simp)
    qed
    fix y
    assume y[simp]: "y \<in> carrier ?DP"
    show "finprod G (x \<otimes>\<^bsub>?DP\<^esub> y) I = finprod G x I \<otimes>\<^bsub>?J\<^esub> finprod G y I"
    proof(subst (1 2 3) finprod_subgroup[of _ _ J])
      show xyJ: "x \<in> I \<rightarrow> J" "y \<in> I \<rightarrow> J" using x y inJ comp_in_carr[OF x] comp_in_carr[OF y]
        by auto
      show xyJ1: "x \<otimes>\<^bsub>?DP\<^esub> y \<in> I \<rightarrow> J" using inJ x y comp_in_carr[of "x \<otimes>\<^bsub>?DP\<^esub> y"] by fastforce
      show "subgroup J G" using assms(1) .
      show "finprod ?J (x \<otimes>\<^bsub>?DP\<^esub> y) I = finprod ?J x I \<otimes>\<^bsub>?J\<^esub> finprod ?J y I"
      proof (rule J.finprod_cong_split)
        show "x \<in> I \<rightarrow> carrier ?J" "y \<in> I \<rightarrow> carrier ?J" using xyJ by simp_all
        show "x \<otimes>\<^bsub>?DP\<^esub> y \<in> I \<rightarrow> carrier ?J" using xyJ1 by simp
        fix i
        assume i: "i \<in> I"
        then have "x i \<otimes>\<^bsub>G\<lparr>carrier := (S i) \<rparr>\<^esub> y i = (x \<otimes>\<^bsub>?DP\<^esub> y) i"
          by (intro comp_mult[symmetric])
        thus "x i \<otimes>\<^bsub>?J\<^esub> y i = (x \<otimes>\<^bsub>?DP\<^esub> y) i" by simp
      qed
    qed
  qed
  then interpret fp: group_hom ?DP ?J ?fp unfolding group_hom_def group_hom_axioms_def by blast
  have s: "subgroup (S i) G" if "i \<in> I" for i using incl_subgroup[OF assms(1) assm'[OF that]] .
  have "kernel ?DP ?J ?fp = {\<one>\<^bsub>?DP\<^esub>}"
  proof -
    have "a = \<one>\<^bsub>?DP\<^esub>" if "a \<in> kernel ?DP ?J ?fp" for a
    proof -
      from that have a: "finprod G a I = \<one>" "a \<in> carrier ?DP" unfolding kernel_def by simp_all
      from compl_fam_imp_triv_finprod[OF assm(2) assms(3) s a(1)] comp_in_carr[OF a(2)]
      have "\<forall>i\<in>I. a i = \<one>" by simp
      then show ?thesis using DirProds_one[OF a(2)] by fastforce
    qed
    thus ?thesis using fp.one_in_kernel by blast
  qed
  moreover have "J \<subseteq> ?fp ` carrier ?DP"
    using assm(1) IDirProds_eq_finprod_PiE[OF assms(3) incl_subgroup[OF assms(1) assm']]
    unfolding DirProds_def PiE_def Pi_def by simp
  ultimately show ?thesis using hom fp.iso_iff unfolding kernel_def by auto
qed

lemma (in comm_group) iso_DirProds_IDirProds:
  assumes "is_idirprod (carrier G) S I" "finite I"
  shows "(\<lambda>x. \<Otimes>\<^bsub>G\<^esub>i\<in>I. x i) \<in> iso (DirProds (\<lambda>i. G\<lparr>carrier := (S i)\<rparr>) I) G"
  using subgroup_iso_DirProds_IDirProds[OF subgroup_self assms(1, 2)] by auto

lemma (in comm_group) cong_DirProds_IDirProds:
  assumes "is_idirprod (carrier G) S I" "finite I"
  shows "DirProds (\<lambda>i. G\<lparr>carrier := (S i)\<rparr>) I \<cong> G"
  by (intro is_isoI, use iso_DirProds_IDirProds[OF assms] in blast)

text \<open>In order to prove the isomorphism between two direct products, the following lemmas provide
some criterias.\<close>

lemma DirProds_iso:
  assumes "bij_betw f I J" "\<And>i. i\<in>I \<Longrightarrow> Gs i \<cong> Hs (f i)"
          "\<And>i. i\<in>I \<Longrightarrow> group (Gs i)" "\<And>j. j\<in>J \<Longrightarrow> group (Hs j)"
  shows "DirProds Gs I \<cong> DirProds Hs J"
proof -
  interpret DG: group "DirProds Gs I" using DirProds_is_group assms(3) by blast
  interpret DH: group "DirProds Hs J" using DirProds_is_group assms(4) by blast
  from assms(1) obtain g where g: "g = inv_into I f" "bij_betw g J I" by (meson bij_betw_inv_into)
  hence fgi: "\<And>i. i \<in> I \<Longrightarrow> g (f i) = i" "\<And>j. j \<in> J \<Longrightarrow> f (g j) = j"
    using assms(1) bij_betw_inv_into_left[OF assms(1)] bij_betw_inv_into_right[OF assms(1)] by auto
  from assms(2) have "\<And>i. i \<in> I \<Longrightarrow> (\<exists>h. h \<in> iso (Gs i) (Hs (f i)))" unfolding is_iso_def by blast
  then obtain h where h: "\<And>i. i \<in> I \<Longrightarrow> h i \<in> iso (Gs i) (Hs (f i))" by metis
  let ?h = "(\<lambda>x. (\<lambda>j. if j\<in>J then (h (g j)) (x (g j)) else undefined))"
  have hc: "?h x \<in> carrier (DirProds Hs J)" if "x \<in> carrier (DirProds Gs I)" for x
  proof -
    have xc: "x \<in> carrier (DirProds Gs I)" by fact
    have "h (g j) (x (g j)) \<in> carrier (Hs j)" if "j \<in> J" for j
    proof(intro iso_in_carr[OF _ comp_in_carr[OF xc], of "h (g j)" "g j" "Hs j"])
      show "g j \<in> I" using g(2)[unfolded bij_betw_def] that by blast
      from h[OF this] show "h (g j) \<in> Group.iso (Gs (g j)) (Hs j)" using fgi(2)[OF that] by simp
    qed
    thus ?thesis using xc unfolding DirProds_def PiE_def extensional_def by auto
  qed
  moreover have "?h (x \<otimes>\<^bsub>DirProds Gs I\<^esub> y)= ?h x \<otimes>\<^bsub>DirProds Hs J\<^esub> ?h y"
    if "x \<in> carrier (DirProds Gs I)" "y \<in> carrier (DirProds Gs I)" for x y
  proof(intro eq_parts_imp_eq[OF hc[OF DG.m_closed[OF that]] DH.m_closed[OF hc[OF that(1)] hc[OF that(2)]]])
    fix j
    assume j: "j \<in> J"
    hence gj: "g j \<in> I" using g unfolding bij_betw_def by blast
    from assms(3)[OF gj] assms(4)[OF j] have g: "group (Gs (g j))" "Group.group (Hs j)" .
    from iso_imp_homomorphism[OF h[OF gj]] fgi(2)[OF j] g
    interpret hjh: group_hom "Gs (g j)" "Hs j" "h (g j)"
      unfolding group_hom_def group_hom_axioms_def by simp
    show "(?h (x \<otimes>\<^bsub>DirProds Gs I\<^esub> y)) j = (?h x \<otimes>\<^bsub>DirProds Hs J\<^esub> ?h y) j"
    proof(subst comp_mult)
      show "(if j \<in> J then h (g j) (x (g j) \<otimes>\<^bsub>Gs (g j)\<^esub> y (g j)) else undefined)
          = (?h x \<otimes>\<^bsub>DirProds Hs J\<^esub> ?h y) j"
      proof(subst comp_mult)
        have "h (g j) (x (g j) \<otimes>\<^bsub>Gs (g j)\<^esub> y (g j)) = h (g j) (x (g j)) \<otimes>\<^bsub>Hs j\<^esub> h (g j) (y (g j))"
          using comp_in_carr[OF that(1) gj] comp_in_carr[OF that(2) gj] by simp
        thus "(if j \<in> J then h (g j) (x (g j) \<otimes>\<^bsub>Gs (g j)\<^esub> y (g j)) else undefined) =
              (if j \<in> J then h (g j) (x (g j)) else undefined)
      \<otimes>\<^bsub>Hs j\<^esub> (if j \<in> J then h (g j) (y (g j)) else undefined)"
          using j by simp
      qed (use j g that hc in auto)
    qed (use gj g that in auto)
  qed
  ultimately interpret hgh: group_hom "DirProds Gs I" "DirProds Hs J" ?h
    unfolding group_hom_def group_hom_axioms_def by (auto intro: homI)
  have "carrier (DirProds Hs J) \<subseteq> ?h ` carrier (DirProds Gs I)"
  proof
    show "x \<in> ?h ` carrier (DirProds Gs I)" if xc: "x \<in> carrier (DirProds Hs J)" for x
    proof -
      from h obtain k where k: "\<And>i. i\<in>I \<Longrightarrow> k i = inv_into (carrier (Gs i)) (h i)" by fast
      hence kiso: "\<And>i. i\<in>I \<Longrightarrow> k i \<in> iso (Hs (f i)) (Gs i)"
        using h by (simp add: assms(3) group.iso_set_sym)
      hence hk: "y = (h (g j) \<circ> (k (g j))) y" if "j \<in> J" "y \<in> carrier (Hs j)" for j y
      proof -
        have gj: "g j \<in> I" using that g[unfolded bij_betw_def] by blast
        thus ?thesis
          using h[OF gj, unfolded iso_def] k[OF gj] that fgi(2)[OF that(1)] bij_betw_inv_into_right
          unfolding comp_def by fastforce
      qed
      let ?k = "(\<lambda>i. if i\<in>I then k i else (\<lambda>_. undefined))"
      let ?y = "(\<lambda>i. (?k i) (x (f i)))"
      have "x j = (\<lambda>j. if j \<in> J then h (g j) (?y (g j)) else undefined) j" for j
      proof (cases "j \<in> J")
        case True
        thus ?thesis using hk[OF True comp_in_carr[OF that True]]
                           fgi(2)[OF True] g[unfolded bij_betw_def] by auto
      next
        case False
        thus ?thesis using that[unfolded DirProds_def] by auto
      qed
      moreover have "?y \<in> carrier (DirProds Gs I)"
      proof -
        have "?y i \<in> carrier (Gs i)" if i: "i \<in> I" for i
          using k[OF i] h[OF i] comp_in_carr[OF xc] assms(1) bij_betwE iso_in_carr kiso that
          by fastforce
        moreover have "?y i = undefined" if i: "i \<notin> I" for i using i by simp
        ultimately show ?thesis unfolding DirProds_def PiE_def Pi_def extensional_def by simp
      qed
      ultimately show ?thesis by fast
    qed
  qed
  moreover have "x = \<one>\<^bsub>DirProds Gs I\<^esub>"
    if "x \<in> carrier (DirProds Gs I)" "?h x = \<one>\<^bsub>DirProds Hs J\<^esub>" for x
  proof -
    have "\<forall>i\<in>I. x i = \<one>\<^bsub>Gs i\<^esub>"
    proof
      fix i
      assume i: "i \<in> I"
      interpret gi: group "Gs i" using assms(3)[OF i] .
      interpret hfi: group "Hs (f i)" using assms(4) i assms(1)[unfolded bij_betw_def] by blast
      from h[OF i] interpret hi: group_hom "(Gs i)" "Hs (f i)" "h i"
        unfolding group_hom_def group_hom_axioms_def iso_def by blast
      from that have hx: "?h x \<in> carrier (DirProds Hs J)" by simp
      from DirProds_one[OF this] that(2)
      have "(if j \<in> J then h (g j) (x (g j)) else undefined) = \<one>\<^bsub>Hs j\<^esub>" if "j \<in> J" for j
        using that by blast
      hence "h (g (f i)) (x (g (f i))) = \<one>\<^bsub>Hs (f i)\<^esub>" using i assms(1)[unfolded bij_betw_def] by auto
      hence "h i (x i) = \<one>\<^bsub>Hs (f i)\<^esub>" using fgi(1)[OF i] by simp
      with hi.iso_iff h[OF i] comp_in_carr[OF that(1) i] show "x i = \<one>\<^bsub>Gs i\<^esub>" by fast
    qed
    with DirProds_one that show ?thesis using assms(3) by blast
  qed
  ultimately show ?thesis unfolding is_iso_def using hgh.iso_iff by blast
qed

lemma DirProds_iso1:
  assumes "\<And>i. i\<in>I \<Longrightarrow> Gs i \<cong> (f \<circ> Gs) i" "\<And>i. i\<in>I \<Longrightarrow> group (Gs i)" "\<And>i. i\<in>I \<Longrightarrow> group ((f \<circ> Gs) i)"
  shows "DirProds Gs I \<cong> DirProds (f \<circ> Gs) I"
proof -
  interpret DP: group "DirProds Gs I" using DirProds_is_group assms by metis
  interpret fDP: group "DirProds (f \<circ> Gs) I" using DirProds_is_group assms by metis
  from assms have "\<forall>i\<in>I. (\<exists>g. g \<in> iso (Gs i) ((f \<circ> Gs) i))" unfolding is_iso_def by blast
  then obtain J where J: "\<forall>i\<in>I. J i \<in> iso (Gs i) ((f \<circ> Gs) i)" by metis
  let ?J = "(\<lambda>i. if i\<in>I then J i else (\<lambda>_. undefined))"
  from J obtain K where K: "\<forall>i\<in>I. K i = inv_into (carrier (Gs i)) (J i)" by fast
  hence K_iso: "\<forall>i\<in>I. K i \<in> iso ((f \<circ> Gs) i) (Gs i)" using group.iso_set_sym assms J by metis
  let ?K = "(\<lambda>i. if i\<in>I then K i else (\<lambda>_. undefined))"
  have JKi: "(?J i) ((?K i) (x i)) = x i" if "x \<in> carrier (DirProds (f \<circ> Gs) I)" for i x
  proof -
    have "(J i) ((K i) (x i)) = x i" if "x \<in> carrier (DirProds (f \<circ> Gs) I)" "i \<in> I" for i x
    proof -
      from J that have "(J i) ` (carrier (Gs i)) = carrier ((f \<circ> Gs) i)"
        unfolding iso_def bij_betw_def by blast
      hence "\<exists>y. y \<in> carrier (Gs i) \<and> (J i) y = x i" using that by (metis comp_in_carr imageE)
      with someI_ex[OF this] that show "(J i) ((K i) (x i)) = x i"
        using K J K_iso unfolding inv_into_def by auto
    qed
    moreover have "(?J i) ((K i) (x i)) = x i" if "x \<in> carrier (DirProds (f \<circ> Gs) I)" "i \<notin> I" for i x
      using that unfolding DirProds_def PiE_def extensional_def by force
    ultimately show ?thesis using that by simp
  qed
  let ?r = "(\<lambda>e. restrict (\<lambda>i. ?J i (e i)) I)"
  have hom: "?r \<in> hom (DirProds Gs I) (DirProds (f \<circ> Gs) I)"
  proof (intro homI)
    show "?r x \<in> carrier (DirProds (f \<circ> Gs) I)" if "x \<in> carrier (DirProds Gs I)" for x
      using that J comp_in_carr[OF that] unfolding DirProds_def iso_def bij_betw_def by fastforce
    show "?r (x \<otimes>\<^bsub>DirProds Gs I\<^esub> y) = ?r x \<otimes>\<^bsub>DirProds (f \<circ> Gs) I\<^esub> ?r y"
      if "x \<in> carrier (DirProds Gs I)" "y \<in> carrier (DirProds Gs I)" for x y
      using that J comp_in_carr[OF that(1)] comp_in_carr[OF that(2)]
      unfolding DirProds_def iso_def hom_def by force
  qed
  then interpret r: group_hom "(DirProds Gs I)" "(DirProds (f \<circ> Gs) I)" ?r
    unfolding group_hom_def group_hom_axioms_def by blast
  have "carrier (DirProds (f \<circ> Gs) I) \<subseteq> ?r ` carrier (DirProds Gs I)"
  proof
    show "x \<in> ?r ` carrier (DirProds Gs I)" if "x \<in> carrier (DirProds (f \<circ> Gs) I)" for x
    proof
      show "x = (\<lambda>i\<in>I. ?J i ((?K i) (x i)))"
        using JKi[OF that] that unfolding DirProds_def PiE_def by (simp add: extensional_restrict)
      show "(\<lambda>i. ?K i (x i)) \<in> carrier (DirProds Gs I)" using K_iso iso_in_carr that
        unfolding DirProds_def PiE_def Pi_def extensional_def by fastforce
    qed
  qed
  moreover have "x = \<one>\<^bsub>DirProds Gs I\<^esub>"
    if "x \<in> carrier (DirProds Gs I)" "?r x = \<one>\<^bsub>DirProds (f \<circ> Gs) I\<^esub>" for x
  proof -
    have "\<forall>i\<in>I. x i = \<one>\<^bsub>Gs i\<^esub>"
    proof
      fix i
      assume i: "i \<in> I"
      with J assms interpret Ji: group_hom "(Gs i)" "(f \<circ> Gs) i" "J i"
        unfolding group_hom_def group_hom_axioms_def iso_def by blast
      from that have rx: "?r x \<in> carrier (DirProds (f \<circ> Gs) I)" by simp
      from i DirProds_one[OF this] that
      have "(\<lambda>i\<in>I. (if i \<in> I then J i else (\<lambda>_. undefined)) (x i)) i = \<one>\<^bsub>(f \<circ> Gs) i\<^esub>" by blast
      hence "(J i) (x i) = \<one>\<^bsub>(f \<circ> Gs) i\<^esub>" using i by simp
      with Ji.iso_iff mp[OF spec[OF J[unfolded Ball_def]] i] comp_in_carr[OF that(1) i]
      show "x i = \<one>\<^bsub>Gs i\<^esub>" by fast
    qed
    with DirProds_one[OF that(1)] show ?thesis by blast
  qed
  ultimately show ?thesis unfolding is_iso_def using r.iso_iff by blast
qed

lemma DirProds_iso2:
  assumes "inj_on f A" "group (DirProds g (f ` A))"
  shows "DirProds (g \<circ> f) A \<cong> DirProds g (f ` A)"
proof (intro DirProds_iso[of f])
  show "bij_betw f A (f ` A)" using assms(1) unfolding bij_betw_def by blast
  show "\<And>i. i \<in> A \<Longrightarrow> (g \<circ> f) i \<cong> g (f i)" unfolding comp_def using iso_refl by simp
  from assms(2) show "\<And>i. i \<in> (f ` A) \<Longrightarrow> group (g i)" using DirProds_group_imp_groups by fast
  with assms(1) show "\<And>i. i \<in> A \<Longrightarrow> group ((g \<circ> f) i)" by auto
qed

text \<open>The direct group product distributes when nested.\<close>

lemma DirProds_Sigma:
  "DirProds (\<lambda>i. DirProds (G i) (J i)) I \<cong> DirProds (\<lambda>(i,j). G i j) (Sigma I J)" (is "?L \<cong> ?R")
proof (intro is_isoI isoI)
  let ?f = "\<lambda>x. restrict (case_prod x) (Sigma I J)"
  show hom: "?f \<in> hom ?L ?R"
  proof(intro homI)
    show "?f a \<in> carrier ?R" if "a \<in> carrier ?L" for a
      using that unfolding DirProds_def PiE_def Pi_def extensional_def by auto
    show "?f (a \<otimes>\<^bsub>?L\<^esub> b) = ?f a \<otimes>\<^bsub>?R\<^esub> ?f b" if "a \<in> carrier ?L" and "b \<in> carrier ?L" for a b
      using that unfolding DirProds_def PiE_def Pi_def extensional_def by auto
  qed
  show "bij_betw ?f (carrier ?L) (carrier ?R)"
  proof (intro bij_betwI)
    let ?g = "\<lambda>x. (\<lambda>i. if i\<in>I then (\<lambda>j. if j\<in>(J i) then x(i, j) else undefined) else undefined)"
    show "?f \<in> carrier ?L \<rightarrow> carrier ?R" unfolding DirProds_def by fastforce
    show "?g \<in> carrier ?R \<rightarrow> carrier ?L" unfolding DirProds_def by fastforce
    show "?f (?g x) = x" if "x \<in> carrier ?R" for x
      using that unfolding DirProds_def PiE_def Pi_def extensional_def by auto
    show "?g (?f x) = x" if "x \<in> carrier ?L" for x
      using that unfolding DirProds_def PiE_def Pi_def extensional_def by force
  qed
qed

no_notation integer_mod_group ("Z")

end


(*  Title:      HOL/Nitpick_Examples/Hotel_Nits.thy
    Author:     Jasmin Blanchette, TU Muenchen
    Copyright   2010-2011

Nitpick example based on Tobias Nipkow's hotel key card formalization.
*)

section {* Nitpick Example Based on Tobias Nipkow's Hotel Key Card
          Formalization *}

theory Hotel_Nits
imports Main
begin

nitpick_params [verbose, max_potential = 0, sat_solver = MiniSat_JNI,
                max_threads = 1, timeout = 240]

typedecl guest
typedecl key
typedecl room

type_synonym keycard = "key \<times> key"

record state =
  owns :: "room \<Rightarrow> guest option"
  currk :: "room \<Rightarrow> key"
  issued :: "key set"
  cards :: "guest \<Rightarrow> keycard set"
  roomk :: "room \<Rightarrow> key"
  isin :: "room \<Rightarrow> guest set"
  safe :: "room \<Rightarrow> bool"

inductive_set reach :: "state set" where
init:
"inj initk \<Longrightarrow>
 \<lparr>owns = (\<lambda>r. None), currk = initk, issued = range initk, cards = (\<lambda>g. {}),
  roomk = initk, isin = (\<lambda>r. {}), safe = (\<lambda>r. True)\<rparr> \<in> reach" |
check_in:
"\<lbrakk>s \<in> reach; k \<notin> issued s\<rbrakk> \<Longrightarrow>
 s\<lparr>currk := (currk s)(r := k), issued := issued s \<union> {k},
   cards := (cards s)(g := cards s g \<union> {(currk s r, k)}),
   owns :=  (owns s)(r := Some g), safe := (safe s)(r := False)\<rparr> \<in> reach" |
enter_room:
"\<lbrakk>s \<in> reach; (k,k') \<in> cards s g; roomk s r \<in> {k,k'}\<rbrakk> \<Longrightarrow>
 s\<lparr>isin := (isin s)(r := isin s r \<union> {g}),
   roomk := (roomk s)(r := k'),
   safe := (safe s)(r := owns s r = Some g \<and> isin s r = {} (* \<and> k' = currk s r *)
                         \<or> safe s r)\<rparr> \<in> reach" |
exit_room:
"\<lbrakk>s \<in> reach; g \<in> isin s r\<rbrakk> \<Longrightarrow> s\<lparr>isin := (isin s)(r := isin s r - {g})\<rparr> \<in> reach"

theorem safe: "s \<in> reach \<Longrightarrow> safe s r \<Longrightarrow> g \<in> isin s r \<Longrightarrow> owns s r = Some g"
nitpick [card room = 1, card guest = 2, card "guest option" = 3,
         card key = 4, card state = 6, show_consts, format = 2,
         expect = genuine]
(* nitpick [card room = 1, card guest = 2, expect = genuine] *) (* slow *)
oops

end