(* Author: R. Thiemann *)

subsection \<open>Farkas Lemma for Matrices\<close>

text \<open>In this part we convert the simplex-structures like linear polynomials, etc., into
  equivalent formulations using matrices and vectors. As a result we present Farkas' Lemma
  via matrices and vectors.\<close>

theory Matrix_Farkas
  imports Farkas
  Jordan_Normal_Form.Matrix
begin

lift_definition poly_of_vec :: "rat vec \<Rightarrow> linear_poly" is
  "\<lambda> v x. if (x < dim_vec v) then v $ x else 0"
  by auto

definition val_of_vec :: "rat vec \<Rightarrow> rat valuation" where
  "val_of_vec v x = v $ x"

lemma valuate_poly_of_vec: assumes "w \<in> carrier_vec n"
  and "v \<in> carrier_vec n"
shows "valuate (poly_of_vec v) (val_of_vec w) = v \<bullet> w"
  using assms by (transfer, auto simp: val_of_vec_def scalar_prod_def intro: sum.mono_neutral_left)

definition constraints_of_mat_vec :: "rat mat \<Rightarrow> rat vec \<Rightarrow> rat le_constraint set" where
  "constraints_of_mat_vec A b = (\<lambda> i . Leqc (poly_of_vec (row A i)) (b $ i)) ` {0 ..< dim_row A}"

lemma constraints_of_mat_vec_solution_main: assumes A: "A \<in> carrier_mat nr nc"
  and x: "x \<in> carrier_vec nc"
  and b: "b \<in> carrier_vec nr"
  and sol: "A *\<^sub>v x \<le> b"
  and c: "c \<in> constraints_of_mat_vec A b"
shows "val_of_vec x \<Turnstile>\<^sub>l\<^sub>e c"
proof -
  from c[unfolded constraints_of_mat_vec_def] A obtain i where
    i: "i < nr" and c: "c = Leqc (poly_of_vec (row A i)) (b $ i)" by auto
  from i A have ri: "row A i \<in> carrier_vec nc" by auto
  from sol i A x b have sol: "(A *\<^sub>v x) $ i \<le> b $ i" unfolding less_eq_vec_def by auto
  thus "val_of_vec x \<Turnstile>\<^sub>l\<^sub>e c" unfolding c satisfiable_le_constraint.simps rel_of.simps
      valuate_poly_of_vec[OF x ri] using A x i by auto
qed

lemma vars_poly_of_vec: "vars (poly_of_vec v) \<subseteq> { 0 ..< dim_vec v}"
  by (transfer', auto)

lemma finite_constraints_of_mat_vec: "finite (constraints_of_mat_vec A b)"
  unfolding constraints_of_mat_vec_def by auto

lemma constraints_of_mat_vec_solution_1:
  assumes A: "A \<in> carrier_mat nr nc"
    and b: "b \<in> carrier_vec nr"
    and sol: "\<exists> x \<in> carrier_vec nc. A *\<^sub>v x \<le> b"
  shows "\<exists> v. \<forall> c \<in> constraints_of_mat_vec A b. v \<Turnstile>\<^sub>l\<^sub>e c"
  using constraints_of_mat_vec_solution_main[OF A _ b _] sol by blast

lemma constraints_of_mat_vec_solution_2:
  assumes A: "A \<in> carrier_mat nr nc"
    and b: "b \<in> carrier_vec nr"
    and sol: "\<exists> v. \<forall> c \<in> constraints_of_mat_vec A b. v \<Turnstile>\<^sub>l\<^sub>e c"
  shows "\<exists> x \<in> carrier_vec nc. A *\<^sub>v x \<le> b"
proof -
  from sol obtain v where sol: "v \<Turnstile>\<^sub>l\<^sub>e c" if "c \<in> constraints_of_mat_vec A b" for c by auto
  define x where "x = vec nc (\<lambda> i. v i)"
  show ?thesis
  proof (intro bexI[of _ x])
    show x: "x \<in> carrier_vec nc" unfolding x_def by auto
    have "row A i \<bullet> x \<le> b $ i" if "i < nr" for i
    proof -
      from that have "Leqc (poly_of_vec (row A i)) (b $ i) \<in> constraints_of_mat_vec A b"
        unfolding constraints_of_mat_vec_def using A by auto
      from sol[OF this, simplified] have "valuate (poly_of_vec (row A i)) v \<le> b $ i" by simp
      also have "valuate (poly_of_vec (row A i)) v = valuate (poly_of_vec (row A i)) (val_of_vec x)"
        by (rule valuate_depend, insert A that,
          auto simp: x_def val_of_vec_def dest!: set_mp[OF vars_poly_of_vec])
      also have "\<dots> = row A i \<bullet> x"
        by (subst valuate_poly_of_vec[OF x], insert that A x, auto)
      finally show ?thesis .
    qed
    thus "A *\<^sub>v x \<le> b" unfolding less_eq_vec_def using x A b by auto
  qed
qed

lemma constraints_of_mat_vec_solution:
  assumes A: "A \<in> carrier_mat nr nc"
    and b: "b \<in> carrier_vec nr"
  shows "(\<exists> x \<in> carrier_vec nc. A *\<^sub>v x \<le> b) =
    (\<exists> v. \<forall> c \<in> constraints_of_mat_vec A b. v \<Turnstile>\<^sub>l\<^sub>e c)"
  using constraints_of_mat_vec_solution_1[OF assms] constraints_of_mat_vec_solution_2[OF assms]
  by blast

lemma farkas_lemma_matrix: fixes A :: "rat mat"
  assumes A: "A \<in> carrier_mat nr nc"
  and b: "b \<in> carrier_vec nr"
shows "(\<exists> x \<in> carrier_vec nc. A *\<^sub>v x \<le> b) \<longleftrightarrow>
  (\<forall> y. y \<ge> 0\<^sub>v nr \<longrightarrow> mat_of_row y * A = 0\<^sub>m 1 nc \<longrightarrow> y \<bullet> b \<ge> 0)"
proof -
  define cs where "cs = constraints_of_mat_vec A b"
  have fin: "finite {0 ..< nr}" by auto
  have dim: "dim_row A = nr" using A by simp
  have sum_id: "(\<Sum> i = 0..<nr. f i) = sum_list (map f [0..<nr])" for f
    by (subst sum_list_distinct_conv_sum_set, auto)
  have "(\<exists> x \<in> carrier_vec nc. A *\<^sub>v x \<le> b) =
   (\<not> (\<nexists> v. \<forall> c \<in> cs. v \<Turnstile>\<^sub>l\<^sub>e c))"
    unfolding constraints_of_mat_vec_solution[OF assms] cs_def by simp
  also have "\<dots> = (\<not> (\<nexists>v. \<forall>i\<in>{0..<nr}. v \<Turnstile>\<^sub>l\<^sub>e Le_Constraint Leq_Rel (poly_of_vec (row A i)) (b $ i)))"
    unfolding cs_def constraints_of_mat_vec_def dim by auto
  also have "\<dots> = (\<nexists>C.
        (\<forall>i\<in>{0..<nr}. 0 \<le> C i) \<and>
         (\<Sum>i = 0..<nr. (C i *R poly_of_vec (row A i))) = 0 \<and>
         (\<Sum>i = 0..<nr. (C i * b $ i)) < 0)"
    unfolding Farkas'_Lemma_indexed[OF
        lec_rec_constraints_of_mat_vec[unfolded constraints_of_mat_vec_def], of A b,
        unfolded dim, OF fin] sum_id sum_list_lec le_constraint.simps
        sum_list_Leq_Rel map_map o_def unfolding sum_id[symmetric] by simp
  also have "\<dots> = (\<forall> C. (\<forall>i\<in> {0..<nr}. 0 \<le> C i) \<longrightarrow>
         (\<Sum>i = 0..<nr. (C i *R poly_of_vec (row A i))) = 0 \<longrightarrow>
         (\<Sum>i = 0..<nr. (C i * b $ i)) \<ge> 0)"
    using not_less by blast
  also have "\<dots> = (\<forall> y. y \<ge> 0\<^sub>v nr \<longrightarrow> mat_of_row y * A = 0\<^sub>m 1 nc \<longrightarrow> y \<bullet> b \<ge> 0)"
  proof ((standard; intro allI impI), goal_cases)
    case *: (1 y)
    define C where "C = (\<lambda> i. y $ i)"
    note main = *(1)[rule_format, of C]
    from *(2) have y: "y \<in> carrier_vec nr" and nonneg: "\<And>i. i \<in> {0..<nr} \<Longrightarrow> 0 \<le> C i"
      unfolding less_eq_vec_def C_def by auto
    have sum_0: "(\<Sum>i = 0..<nr. C i *R poly_of_vec (row A i)) = 0" unfolding C_def
      unfolding zero_coeff_zero coeff_sum
    proof
      fix v
      have "(\<Sum>i = 0..<nr. coeff (y $ i *R poly_of_vec (row A i)) v) =
            (\<Sum>i < nr. y $ i * coeff (poly_of_vec (row A i)) v)" by (rule sum.cong, auto)
      also have "\<dots> = 0"
      proof (cases "v < nc")
        case False
        have "(\<Sum>i < nr. y $ i * coeff (poly_of_vec (row A i)) v) =
              (\<Sum>i < nr. y $ i * 0)"
          by (rule sum.cong[OF refl], rule arg_cong[of _ _ "\<lambda> x. _ * x"], insert A False, transfer, auto)
        also have "\<dots> = 0" by simp
        finally show ?thesis by simp
      next
        case True
        have "(\<Sum>i<nr. y $ i * coeff (poly_of_vec (row A i)) v) =
              (\<Sum>i<nr. y $ i * row A i $ v)"
          by (rule sum.cong[OF refl], rule arg_cong[of _ _ "\<lambda> x. _ * x"], insert A True, transfer, auto)
        also have "\<dots> = (mat_of_row y * A) $$ (0,v)"
          unfolding times_mat_def scalar_prod_def
          using A y True by (auto intro: sum.cong)
        also have "\<dots> = 0" unfolding *(3) using True by simp
        finally show ?thesis .
      qed
      finally show "(\<Sum>i = 0..<nr. coeff (y $ i *R poly_of_vec (row A i)) v) = 0" .
    qed
    from main[OF nonneg sum_0] have le: "0 \<le> (\<Sum>i = 0..<nr. C i * b $ i)" .
    thus ?case using y b unfolding scalar_prod_def C_def by auto
  next
    case *: (2 C)
    define y where "y = vec nr C"
    have y: "y \<in> carrier_vec nr" unfolding y_def by auto
    note main = *(1)[rule_format, of y]
    from *(2) have y0: "y \<ge> 0\<^sub>v nr" unfolding less_eq_vec_def y_def by auto
    have prod0: "mat_of_row y * A = 0\<^sub>m 1 nc"
    proof -
      {
        fix j
        assume j: "j < nc"
        from arg_cong[OF *(3), of "\<lambda> x. coeff x j", unfolded coeff_sum]
        have "0 = (\<Sum>i = 0..<nr. C i * coeff (poly_of_vec (row A i)) j)" by simp
        also have "\<dots> = (\<Sum>i = 0..<nr. C i * row A i $ j)"
          by (rule sum.cong[OF refl], rule arg_cong[of _ _ "\<lambda> x. _ * x"], insert A j, transfer, auto)
        also have "\<dots> = y \<bullet> col A j" unfolding scalar_prod_def y_def using A j
          by (intro sum.cong, auto)
        finally have "y \<bullet> col A j = 0" by simp
      }
      thus ?thesis by (intro eq_matI, insert A y, auto)
    qed
    from main[OF y0 prod0] have "0 \<le> y \<bullet> b" .
    thus ?case unfolding scalar_prod_def y_def using b by auto
  qed
  finally show ?thesis .
qed

lemma farkas_lemma_matrix': fixes A :: "rat mat"
  assumes A: "A \<in> carrier_mat nr nc"
  and b: "b \<in> carrier_vec nr"
shows "(\<exists> x \<ge> 0\<^sub>v nc. A *\<^sub>v x = b) \<longleftrightarrow>
  (\<forall> y \<in> carrier_vec nr. mat_of_row y * A \<ge> 0\<^sub>m 1 nc \<longrightarrow> y \<bullet> b \<ge> 0)"
proof -
  define B where "B = (- 1\<^sub>m nc) @\<^sub>r (A @\<^sub>r -A)"
  define b' where "b' = 0\<^sub>v nc @\<^sub>v (b @\<^sub>v -b)"
  define n where "n = nc + (nr + nr)"
  have id0: "0\<^sub>v (nc + (nr + nr)) = 0\<^sub>v nc @\<^sub>v (0\<^sub>v nr @\<^sub>v 0\<^sub>v nr)" by (intro eq_vecI, auto)
  have B: "B \<in> carrier_mat n nc" unfolding B_def n_def using A by auto
  have b': "b' \<in> carrier_vec n" unfolding b'_def n_def using b by auto
  have "(\<exists> x \<ge> 0\<^sub>v nc. A *\<^sub>v x = b) = (\<exists> x. x \<in> carrier_vec nc \<and> x \<ge> 0\<^sub>v nc \<and> A *\<^sub>v x = b)"
    by (rule arg_cong[of _ _ Ex], intro ext, insert A b, auto simp: less_eq_vec_def)
  also have "\<dots> = (\<exists> x \<in> carrier_vec nc. x \<ge> 0\<^sub>v nc \<and> A *\<^sub>v x = b)" by blast
  also have "\<dots> = (\<exists> x \<in> carrier_vec nc. 1\<^sub>m nc *\<^sub>v x \<ge> 0\<^sub>v nc \<and> A *\<^sub>v x \<le> b \<and> A *\<^sub>v x \<ge> b)"
    by (rule bex_cong[OF refl], insert A b, auto)
  also have "\<dots> = (\<exists> x \<in> carrier_vec nc. (- 1\<^sub>m nc) *\<^sub>v x \<le> 0\<^sub>v nc \<and> A *\<^sub>v x \<le> b \<and> (- A) *\<^sub>v x \<le> -b)"
    by (rule bex_cong[OF refl], insert A b, auto simp: less_eq_vec_def)
  also have "\<dots> = (\<exists> x \<in> carrier_vec nc. B *\<^sub>v x \<le> b')"
    by (rule bex_cong[OF refl], insert A b, unfold B_def b'_def,
      subst append_rows_le[of _ ], (auto)[4], intro conj_cong[OF refl], subst append_rows_le, auto)
  also have "\<dots> = (\<forall>y\<ge>0\<^sub>v n. mat_of_row y * B = 0\<^sub>m 1 nc \<longrightarrow> y \<bullet> b' \<ge> 0)"
    by (rule farkas_lemma_matrix[OF B b'])
  also have "\<dots> = (\<forall> y. y \<in> carrier_vec n \<longrightarrow> y\<ge>0\<^sub>v n \<longrightarrow> mat_of_row y * B = 0\<^sub>m 1 nc \<longrightarrow> y \<bullet> b' \<ge> 0)"
    by (intro arg_cong[of _ _ All], intro ext, auto simp: less_eq_vec_def)
  also have "\<dots> = (\<forall> y \<in> carrier_vec n. y\<ge>0\<^sub>v n \<longrightarrow> mat_of_row y * B = 0\<^sub>m 1 nc \<longrightarrow> y \<bullet> b' \<ge> 0)"
    by blast
  also have "\<dots> = (\<forall>y1 \<in>carrier_vec nc. \<forall>y2 \<in>carrier_vec nr. \<forall>y3 \<in>carrier_vec nr.
              0\<^sub>v nc @\<^sub>v (0\<^sub>v nr @\<^sub>v 0\<^sub>v nr) \<le> y1 @\<^sub>v y2 @\<^sub>v y3  \<longrightarrow>
              mat_of_row (y1 @\<^sub>v y2 @\<^sub>v y3) * ((- 1\<^sub>m nc) @\<^sub>r (A @\<^sub>r -A)) = 0\<^sub>m 1 nc
              \<longrightarrow> 0 \<le> (y1 @\<^sub>v y2 @\<^sub>v y3) \<bullet> (0\<^sub>v nc @\<^sub>v (b @\<^sub>v -b)))"
    unfolding n_def all_vec_append id0 b'_def B_def by auto
  also have "\<dots> = (\<forall>y1 \<in>carrier_vec nc. \<forall>y2 \<in>carrier_vec nr. \<forall>y3 \<in>carrier_vec nr.
              0\<^sub>v nc \<le> y1 \<longrightarrow> 0\<^sub>v nr \<le> y2 \<longrightarrow> 0\<^sub>v nr \<le> y3 \<longrightarrow>
              (- mat_of_row y1) +
              (mat_of_row y2 * A - (mat_of_row y3 * A)) = 0\<^sub>m 1 nc
              \<longrightarrow> y2 \<bullet> b - y3 \<bullet> b \<ge> 0)"
    by (intro ball_cong[OF refl], subst append_vec_le, (auto)[2], subst append_vec_le, (auto)[2], insert A b,
      subst scalar_prod_append, (auto)[4], subst scalar_prod_append, (auto)[4],
      subst mat_of_row_mult_append_rows, (auto)[4],
      subst mat_of_row_mult_append_rows, (auto)[4],
      subst add_uminus_minus_mat[symmetric], auto)
  also have "\<dots> = (\<forall>y1 \<in>carrier_vec nc. \<forall>y2 \<in>carrier_vec nr. \<forall>y3 \<in>carrier_vec nr.
              0\<^sub>v nc \<le> y1 \<longrightarrow> 0\<^sub>v nr \<le> y2 \<longrightarrow> 0\<^sub>v nr \<le> y3 \<longrightarrow>
              mat_of_row y1 = mat_of_row y2 * A - mat_of_row y3 * A
              \<longrightarrow> y2 \<bullet> b - y3 \<bullet> b \<ge> 0)"
  proof ((intro ball_cong[OF refl] arg_cong2[of _ _ _ _ "(\<longrightarrow>)"] refl, standard), goal_cases)
    case (1 y1 y2 y3)
    from arg_cong[OF 1(4), of "\<lambda> x. mat_of_row y1 + x"] show ?case using 1(1-3) A
      by (subst (asm) assoc_add_mat[symmetric], (auto)[3],
        subst (asm) add_uminus_minus_mat, (auto)[1],
        subst (asm) minus_r_inv_mat, force,
        subst (asm) right_add_zero_mat, force,
        subst (asm) left_add_zero_mat, force, auto)
  next
    case (2 y1 y2 y3)
    show ?case unfolding 2(4) using 2(1-3) A
      by (intro eq_matI, auto)
  qed
  also have "\<dots> = (\<forall>y1 \<in>carrier_vec nc. \<forall>y2 \<in>carrier_vec nr. \<forall>y3 \<in>carrier_vec nr.
              0\<^sub>v nc \<le> y1 \<longrightarrow> 0\<^sub>v nr \<le> y2 \<longrightarrow> 0\<^sub>v nr \<le> y3 \<longrightarrow>
              mat_of_row y1 = mat_of_row (y2 - y3) * A
              \<longrightarrow> (y2 - y3) \<bullet> b \<ge> 0)"
    by (intro ball_cong[OF refl] imp_cong refl
      arg_cong2[of _ _ _ _ "(\<le>)"] arg_cong2[of _ _ _ _ "(=)"],
      subst minus_mult_distrib_mat[symmetric], insert A b, auto
      simp: minus_scalar_prod_distrib mat_of_rows_def
      intro!: arg_cong[of _ _ "\<lambda> x. x * _"])
  also have "\<dots> = (\<forall>y1 \<in>carrier_vec nc. \<forall>y2 \<in>carrier_vec nr. \<forall>y3 \<in>carrier_vec nr.
              0\<^sub>v nc \<le> y1 \<longrightarrow> 0\<^sub>v nr \<le> y2 \<longrightarrow> 0\<^sub>v nr \<le> y3 \<longrightarrow>
              y1 = row (mat_of_row (y2 - y3) * A) 0
              \<longrightarrow> (y2 - y3) \<bullet> b \<ge> 0)"
  proof (intro ball_cong[OF refl] arg_cong2[of _ _ _ _ "(\<longrightarrow>)"] refl, standard, goal_cases)
    case (1 y1 y2 y3)
    from arg_cong[OF 1(4), of "\<lambda> x. row x 0"] 1(1-3) A
    show ?case by auto
  qed (insert A, auto)
  also have "\<dots> = (\<forall>y2 \<in>carrier_vec nr. \<forall>y3 \<in>carrier_vec nr.
              0\<^sub>v nc \<le> row (mat_of_row (y2 - y3) * A) 0 \<longrightarrow> 0\<^sub>v nr \<le> y2 \<longrightarrow> 0\<^sub>v nr \<le> y3 \<longrightarrow>
              row (mat_of_row (y2 - y3) * A) 0 \<in> carrier_vec nc
              \<longrightarrow> (y2 - y3) \<bullet> b \<ge> 0)" by blast
  also have "\<dots> = (\<forall>y2 \<in>carrier_vec nr. \<forall>y3 \<in>carrier_vec nr.
              0\<^sub>v nc \<le> row (mat_of_row (y2 - y3) * A) 0 \<longrightarrow> 0\<^sub>v nr \<le> y2 \<longrightarrow> 0\<^sub>v nr \<le> y3
              \<longrightarrow> (y2 - y3) \<bullet> b \<ge> 0)"
    by (intro ball_cong[OF refl] arg_cong2[of _ _ _ _ "(\<longrightarrow>)"] refl, insert A,
        auto simp: row_def)
  also have "\<dots> = (\<forall> y \<in> carrier_vec nr. row (mat_of_row y * A) 0 \<ge> 0\<^sub>v nc \<longrightarrow> y \<bullet> b \<ge> 0)"
  proof ((standard; intro ballI impI), goal_cases)
    case (1 y)
    define y2 where "y2 = vec nr (\<lambda> i. if y $ i \<ge> 0 then y $ i else 0)"
    define y3 where "y3 = vec nr (\<lambda> i. if y $ i \<ge> 0 then 0 else - y $ i)"
    have y: "y = y2 - y3" unfolding y2_def y3_def using 1(2)
      by (intro eq_vecI, auto)
    show ?case by (rule 1(1)[rule_format, of y2 y3, folded y, OF _ _ 1(3)],
       auto simp: y2_def y3_def less_eq_vec_def)
  qed auto
  also have "\<dots> = (\<forall> y \<in> carrier_vec nr. mat_of_row y * A \<ge> 0\<^sub>m 1 nc \<longrightarrow> y \<bullet> b \<ge> 0)"
    by (intro ball_cong arg_cong2[of _ _ _ _ "(\<longrightarrow>)"] refl,
      insert A, auto simp: less_eq_vec_def less_eq_mat_def)
  finally show ?thesis .
qed

end


(*
  Theory: Density_Predicates.thy
  Authors: Manuel Eberl
*)

section \<open>Density Predicates\<close>

theory Density_Predicates
imports "HOL-Probability.Probability"
begin

subsection \<open>Probability Densities\<close>

definition is_subprob_density :: "'a measure \<Rightarrow> ('a \<Rightarrow> ennreal) \<Rightarrow> bool" where
  "is_subprob_density M f \<equiv> (f \<in> borel_measurable M) \<and> space M \<noteq> {} \<and>
                           (\<forall>x\<in>space M. f x \<ge> 0) \<and> (\<integral>\<^sup>+x. f x \<partial>M) \<le> 1"

lemma is_subprob_densityI[intro]:
    "\<lbrakk>f \<in> borel_measurable M; \<And>x. x \<in> space M \<Longrightarrow> f x \<ge> 0; space M \<noteq> {}; (\<integral>\<^sup>+x. f x \<partial>M) \<le> 1\<rbrakk>
        \<Longrightarrow> is_subprob_density M f"
  unfolding is_subprob_density_def by simp

subsection \<open>Measure spaces with densities\<close>

definition has_density :: "'a measure \<Rightarrow> 'a measure \<Rightarrow> ('a \<Rightarrow> ennreal) \<Rightarrow> bool" where
  "has_density M N f \<longleftrightarrow> (f \<in> borel_measurable N) \<and> space N \<noteq> {} \<and> M = density N f"

lemma has_densityI[intro]:
  "\<lbrakk>f \<in> borel_measurable N; M = density N f; space N \<noteq> {}\<rbrakk> \<Longrightarrow> has_density M N f"
  unfolding has_density_def by blast

lemma has_densityD:
  assumes "has_density M N f"
  shows "f \<in> borel_measurable N" "M = density N f" "space N \<noteq> {}"
using assms unfolding has_density_def by simp_all

lemma has_density_sets: "has_density M N f \<Longrightarrow> sets M = sets N"
  unfolding has_density_def by simp

lemma has_density_space: "has_density M N f \<Longrightarrow> space M = space N"
  unfolding has_density_def by simp

lemma has_density_emeasure:
    "has_density M N f \<Longrightarrow> X \<in> sets M \<Longrightarrow> emeasure M X = \<integral>\<^sup>+x. f x * indicator X x \<partial>N"
  unfolding has_density_def by (simp_all add: emeasure_density)

lemma nn_integral_cong': "(\<And>x. x \<in> space N =simp=> f x = g x) \<Longrightarrow> (\<integral>\<^sup>+x. f x \<partial>N) = (\<integral>\<^sup>+x. g x \<partial>N)"
  by (simp add: simp_implies_def cong: nn_integral_cong)

lemma has_density_emeasure_space:
    "has_density M N f \<Longrightarrow> emeasure M (space M) = (\<integral>\<^sup>+x. f x \<partial>N)"
  by (simp add: has_density_emeasure) (simp add: has_density_space cong: nn_integral_cong')

lemma has_density_emeasure_space':
    "has_density M N f \<Longrightarrow> emeasure (density N f) (space (density N f)) = \<integral>\<^sup>+x. f x \<partial>N"
  by (frule has_densityD(2)[symmetric]) (simp add: has_density_emeasure_space)

lemma has_density_imp_is_subprob_density:
    "\<lbrakk>has_density M N f; (\<integral>\<^sup>+x. f x \<partial>N) = 1\<rbrakk> \<Longrightarrow> is_subprob_density N f"
  by (auto dest: has_densityD)

lemma has_density_imp_is_subprob_density':
    "\<lbrakk>has_density M N f; prob_space M\<rbrakk> \<Longrightarrow> is_subprob_density N f"
  by (auto intro!: has_density_imp_is_subprob_density dest: prob_space.emeasure_space_1
           simp: has_density_emeasure_space)

lemma has_density_equal_on_space:
  assumes "has_density M N f" "\<And>x. x \<in> space N \<Longrightarrow> f x = g x"
  shows "has_density M N g"
proof
  from assms show "g \<in> borel_measurable N"
    by (subst measurable_cong[of _ _ f]) (auto dest: has_densityD)
  with assms show "M = density N g"
    by (subst density_cong[of _ _ f]) (auto dest: has_densityD)
  from assms(1) show "space N \<noteq> {}" by (rule has_densityD)
qed

lemma has_density_cong:
  assumes "\<And>x. x \<in> space N \<Longrightarrow> f x = g x"
  shows "has_density M N f = has_density M N g"
using assms by (intro iffI) (erule has_density_equal_on_space, simp)+

lemma has_density_dens_AE:
    "\<lbrakk>AE y in N. f y = f' y; f' \<in> borel_measurable N;
      \<And>x. x \<in> space M \<Longrightarrow> f' x \<ge> 0; has_density M N f\<rbrakk>
        \<Longrightarrow> has_density M N f'"
  unfolding has_density_def by (simp cong: density_cong)

subsection \<open>Probability spaces with densities\<close>

lemma is_subprob_density_imp_has_density:
    "\<lbrakk>is_subprob_density N f; M = density N f\<rbrakk> \<Longrightarrow> has_density M N f"
  by (rule has_densityI) auto

lemma has_subprob_density_imp_subprob_space':
    "\<lbrakk>has_density M N f; is_subprob_density N f\<rbrakk> \<Longrightarrow> subprob_space M"
proof (rule subprob_spaceI)
  assume "has_density M N f"
  hence "M = density N f" by (simp add: has_density_def)
  also from \<open>has_density M N f\<close> have "space ... \<noteq> {}" by (simp add: has_density_def)
  finally show "space M \<noteq> {}" .
qed (auto simp add: has_density_emeasure_space dest: has_densityD)

lemma has_subprob_density_imp_subprob_space[dest]:
    "is_subprob_density M f \<Longrightarrow> subprob_space (density M f)"
  by (rule has_subprob_density_imp_subprob_space') auto

definition "has_subprob_density M N f \<equiv> has_density M N f \<and> subprob_space M"

(* TODO: Move *)
lemma subprob_space_density_not_empty: "subprob_space (density M f) \<Longrightarrow> space M \<noteq> {}"
  by (subst space_density[symmetric], subst subprob_space.subprob_not_empty, assumption) simp

lemma has_subprob_densityI':
  assumes "f \<in> borel_measurable N" "space N \<noteq> {}"
          "M = density N f" "(\<integral>\<^sup>+x. f x \<partial>N) \<le> 1"
  shows "has_subprob_density M N f"
proof-
  from assms have D: "has_density M N f" by blast
  moreover from D and assms have "subprob_space M"
    by (auto intro!: subprob_spaceI simp: has_density_emeasure_space emeasure_density
             cong: nn_integral_cong')
  ultimately show ?thesis unfolding has_subprob_density_def by simp
qed

lemma has_subprob_densityD:
  assumes "has_subprob_density M N f"
  shows "f \<in> borel_measurable N" "\<And>x. x \<in> space N \<Longrightarrow> f x \<ge> 0" "M = density N f" "subprob_space M"
using assms unfolding has_subprob_density_def by (auto dest: has_densityD)

lemma has_subprob_density_measurable[measurable_dest]:
  "has_subprob_density M N f \<Longrightarrow> f \<in> N \<rightarrow>\<^sub>M borel"
  by (auto dest: has_subprob_densityD)

lemma has_subprob_density_imp_has_density:
  "has_subprob_density M N f \<Longrightarrow> has_density M N f" by (simp add: has_subprob_density_def)

lemma has_subprob_density_equal_on_space:
  assumes "has_subprob_density M N f" "\<And>x. x \<in> space N \<Longrightarrow> f x = g x"
  shows "has_subprob_density M N g"
using assms unfolding has_subprob_density_def by (auto dest: has_density_equal_on_space)

lemma has_subprob_density_cong:
  assumes "\<And>x. x \<in> space N \<Longrightarrow> f x = g x"
  shows "has_subprob_density M N f = has_subprob_density M N g"
using assms by (intro iffI) (erule has_subprob_density_equal_on_space, simp)+

lemma has_subprob_density_dens_AE:
    "\<lbrakk>AE y in N. f y = f' y; f' \<in> borel_measurable N;
      \<And>x. x \<in> space M \<Longrightarrow> f' x \<ge> 0; has_subprob_density M N f\<rbrakk>
      \<Longrightarrow> has_subprob_density M N f'"
  unfolding has_subprob_density_def by (simp add: has_density_dens_AE)

subsection \<open>Parametrized probability densities\<close>

definition
  "has_parametrized_subprob_density M N R f \<equiv>
       (\<forall>x \<in> space M. has_subprob_density (N x) R (f x)) \<and> case_prod f \<in> borel_measurable (M \<Otimes>\<^sub>M R)"

lemma has_parametrized_subprob_densityI:
  assumes "\<And>x. x \<in> space M \<Longrightarrow> N x = density R (f x)"
  assumes "\<And>x. x \<in> space M \<Longrightarrow> subprob_space (N x)"
  assumes "case_prod f \<in> borel_measurable (M \<Otimes>\<^sub>M R)"
  shows "has_parametrized_subprob_density M N R f"
  unfolding has_parametrized_subprob_density_def using assms
  by (intro ballI conjI has_subprob_densityI) simp_all

lemma has_parametrized_subprob_densityD:
  assumes "has_parametrized_subprob_density M N R f"
  shows "\<And>x. x \<in> space M \<Longrightarrow> N x = density R (f x)"
    and "\<And>x. x \<in> space M \<Longrightarrow> subprob_space (N x)"
    and [measurable_dest]: "case_prod f \<in> borel_measurable (M \<Otimes>\<^sub>M R)"
  using assms unfolding has_parametrized_subprob_density_def
  by (auto dest: has_subprob_densityD)

lemma has_parametrized_subprob_density_integral:
  assumes "has_parametrized_subprob_density M N R f" "x \<in> space M"
  shows "(\<integral>\<^sup>+y. f x y \<partial>R) \<le> 1"
proof-
  have "(\<integral>\<^sup>+y. f x y \<partial>R) = emeasure (density R (f x)) (space (density R (f x)))" using assms
    by (auto simp: emeasure_density cong: nn_integral_cong' dest: has_parametrized_subprob_densityD)
  also have "density R (f x) = (N x)" using assms by (auto dest: has_parametrized_subprob_densityD)
  also have "emeasure ... (space ...) \<le> 1" using assms
    by (subst subprob_space.emeasure_space_le_1) (auto dest: has_parametrized_subprob_densityD)
  finally show ?thesis .
qed

lemma has_parametrized_subprob_density_cong:
  assumes "\<And>x. x \<in> space M \<Longrightarrow> N x = N' x"
  shows "has_parametrized_subprob_density M N R f = has_parametrized_subprob_density M N' R f"
using assms unfolding has_parametrized_subprob_density_def by auto

lemma has_parametrized_subprob_density_dens_AE:
  assumes "\<And>x. x \<in> space M \<Longrightarrow> AE y in R. f x y = f' x y"
          "case_prod f' \<in> borel_measurable (M \<Otimes>\<^sub>M R)"
          "has_parametrized_subprob_density M N R f"
  shows   "has_parametrized_subprob_density M N R f'"
unfolding has_parametrized_subprob_density_def
proof (intro conjI ballI)
  fix x assume x: "x \<in> space M"
  with assms(3) have "space (N x) = space R"
    by (auto dest!: has_parametrized_subprob_densityD(1))
  with assms and x show "has_subprob_density (N x) R (f' x)"
    by (rule_tac has_subprob_density_dens_AE[of "f x"])
       (auto simp: has_parametrized_subprob_density_def)
qed fact

subsection \<open>Density in the Giry monad\<close>

lemma emeasure_bind_density:
  assumes "space M \<noteq> {}" "\<And>x. x \<in> space M \<Longrightarrow> has_density (f x) N (g x)"
          "f \<in> measurable M (subprob_algebra N)" "X \<in> sets N"
  shows "emeasure (M \<bind> f) X = \<integral>\<^sup>+x. \<integral>\<^sup>+y. g x y * indicator X y \<partial>N \<partial>M"
proof-
  from assms have "emeasure (M \<bind> f) X = \<integral>\<^sup>+x. emeasure (f x) X \<partial>M"
    by (intro emeasure_bind)
  also have "... = \<integral>\<^sup>+x. \<integral>\<^sup>+y. g x y * indicator X y \<partial>N \<partial>M" using assms
    by (intro nn_integral_cong) (simp add: has_density_emeasure sets_kernel)
  finally show ?thesis .
qed

lemma bind_density:
  assumes "sigma_finite_measure M" "sigma_finite_measure N"
          "space M \<noteq> {}" "\<And>x. x \<in> space M \<Longrightarrow> has_density (f x) N (g x)"
     and [measurable]: "case_prod g \<in> borel_measurable (M \<Otimes>\<^sub>M N)" "f \<in> measurable M (subprob_algebra N)"
  shows "(M \<bind> f) = density N (\<lambda>y. \<integral>\<^sup>+x. g x y \<partial>M)"
proof (rule measure_eqI)
  interpret sfN: sigma_finite_measure N by fact
  interpret sfNM: pair_sigma_finite N M unfolding pair_sigma_finite_def using assms by simp
  show eq: "sets (M \<bind> f) = sets (density N (\<lambda>y. \<integral>\<^sup>+x. g x y \<partial>M))"
    using sets_bind[OF sets_kernel[OF assms(6)] assms(3)] by auto
  fix X assume "X \<in> sets (M \<bind> f)"
  with eq have [measurable]: "X \<in> sets N" by auto
  with assms have "emeasure (M \<bind> f) X = \<integral>\<^sup>+x. \<integral>\<^sup>+y. g x y * indicator X y \<partial>N \<partial>M"
    by (intro emeasure_bind_density) simp_all
  also from \<open>X \<in> sets N\<close> have "... = \<integral>\<^sup>+y. \<integral>\<^sup>+x. g x y * indicator X y \<partial>M \<partial>N"
    by (intro sfNM.Fubini') measurable
  also {
    fix y assume "y \<in> space N"
    have "(\<lambda>x. g x y) = case_prod g \<circ> (\<lambda>x. (x, y))" by (rule ext) simp
    also from \<open>y \<in> space N\<close> have "... \<in> borel_measurable M"
      by (intro measurable_comp[OF _ assms(5)] measurable_Pair2')
    finally have "(\<lambda>x. g x y) \<in> borel_measurable M" .
  }
  hence "... = \<integral>\<^sup>+y. (\<integral>\<^sup>+x. g x y \<partial>M) * indicator X y \<partial>N"
    by (intro nn_integral_cong nn_integral_multc)  simp_all
  also from \<open>X \<in> sets N\<close> and assms have "... = emeasure (density N (\<lambda>y. \<integral>\<^sup>+x. g x y \<partial>M)) X"
    by (subst emeasure_density) (simp_all add: sfN.borel_measurable_nn_integral)
  finally show "emeasure (M \<bind> f) X = emeasure (density N (\<lambda>y. \<integral>\<^sup>+x. g x y \<partial>M)) X" .
qed

lemma bind_has_density:
  assumes "sigma_finite_measure M" "sigma_finite_measure N"
          "space M \<noteq> {}" "\<And>x. x \<in> space M \<Longrightarrow> has_density (f x) N (g x)"
          "case_prod g \<in> borel_measurable (M \<Otimes>\<^sub>M N)"
          "f \<in> measurable M (subprob_algebra N)"
  shows "has_density (M \<bind> f) N (\<lambda>y. \<integral>\<^sup>+x. g x y \<partial>M)"
proof
  interpret sigma_finite_measure M by fact
  show "(\<lambda>y. \<integral>\<^sup>+ x. g x y \<partial>M) \<in> borel_measurable N" using assms
    by (intro borel_measurable_nn_integral, subst measurable_pair_swap_iff) simp
  show "M \<bind> f = density N (\<lambda>y. \<integral>\<^sup>+ x. g x y \<partial>M)"
    by (intro bind_density) (simp_all add: assms)
  from \<open>space M \<noteq> {}\<close> obtain x where "x \<in> space M" by blast
  with assms have "has_density (f x) N (g x)" by simp
  thus "space N \<noteq> {}" by (rule has_densityD)
qed

lemma bind_has_density':
  assumes sfM: "sigma_finite_measure M"
      and sfR: "sigma_finite_measure R"
      and not_empty: "space M \<noteq> {}" and dens_M: "has_density M N \<delta>M"
      and dens_f: "\<And>x. x \<in> space M \<Longrightarrow> has_density (f x) R (\<delta>f x)"
      and M\<delta>f: "case_prod \<delta>f \<in> borel_measurable (N \<Otimes>\<^sub>M R)"
      and Mf: "f \<in> measurable N (subprob_algebra R)"
  shows "has_density (M \<bind> f) R (\<lambda>y. \<integral>\<^sup>+x. \<delta>M x * \<delta>f x y \<partial>N)"
proof-
  from dens_M have M_M: "measurable M = measurable N"
    by (intro ext measurable_cong_sets) (auto dest: has_densityD)
  from dens_M have M_MR: "measurable (M \<Otimes>\<^sub>M R) = measurable (N \<Otimes>\<^sub>M R)"
    by (intro ext measurable_cong_sets sets_pair_measure_cong) (auto dest: has_densityD)
  have "has_density (M \<bind> f) R (\<lambda>y. \<integral>\<^sup>+x. \<delta>f x y \<partial>M)"
    by (rule bind_has_density) (auto simp: assms M_MR M_M)
  moreover {
    fix y assume A: "y \<in> space R"
    have "(\<lambda>x. \<delta>f x y) = case_prod \<delta>f \<circ> (\<lambda>x. (x,y))" by (rule ext) (simp add: o_def)
    also have "... \<in> borel_measurable N" by (intro measurable_comp[OF _ M\<delta>f] measurable_Pair2' A)
    finally have M_\<delta>f': "(\<lambda>x. \<delta>f x y) \<in> borel_measurable N" .

    from dens_M have "M = density N \<delta>M" by (auto dest: has_densityD)
    also from dens_M have "(\<integral>\<^sup>+x. \<delta>f x y \<partial>...) = \<integral>\<^sup>+x. \<delta>M x * \<delta>f x y \<partial>N"
      by (subst nn_integral_density) (auto dest: has_densityD simp: M_\<delta>f')
    finally have "(\<integral>\<^sup>+x. \<delta>f x y \<partial>M) = \<integral>\<^sup>+x. \<delta>M x * \<delta>f x y \<partial>N" .
  }
  ultimately show "has_density (M \<bind> f) R (\<lambda>y. \<integral>\<^sup>+x. \<delta>M x * \<delta>f x y \<partial>N)"
    by (rule has_density_equal_on_space) simp_all
qed

lemma bind_has_subprob_density:
  assumes "subprob_space M" "sigma_finite_measure N"
          "space M \<noteq> {}" "\<And>x. x \<in> space M \<Longrightarrow> has_density (f x) N (g x)"
          "case_prod g \<in> borel_measurable (M \<Otimes>\<^sub>M N)"
          "f \<in> measurable M (subprob_algebra N)"
  shows "has_subprob_density (M \<bind> f) N (\<lambda>y. \<integral>\<^sup>+x. g x y \<partial>M)"
proof (unfold has_subprob_density_def, intro conjI)
  from assms show "has_density (M \<bind> f) N (\<lambda>y. \<integral>\<^sup>+x. g x y \<partial>M)"
    by (intro bind_has_density) (auto simp: subprob_space_imp_sigma_finite)
  from assms show "subprob_space (M \<bind> f)" by (intro subprob_space_bind)
qed

lemma bind_has_subprob_density':
  assumes "has_subprob_density M N \<delta>M" "space R \<noteq> {}" "sigma_finite_measure R"
          "\<And>x. x \<in> space M \<Longrightarrow> has_subprob_density (f x) R (\<delta>f x)"
          "case_prod \<delta>f \<in> borel_measurable (N \<Otimes>\<^sub>M R)" "f \<in> measurable N (subprob_algebra R)"
  shows "has_subprob_density (M \<bind> f) R (\<lambda>y. \<integral>\<^sup>+x. \<delta>M x * \<delta>f x y \<partial>N)"
proof (unfold has_subprob_density_def, intro conjI)
  from assms(1) have "space M \<noteq> {}" by (intro subprob_space.subprob_not_empty has_subprob_densityD)
  with assms show "has_density (M \<bind> f) R (\<lambda>y. \<integral>\<^sup>+x. \<delta>M x * \<delta>f x y \<partial>N)"
    by (intro bind_has_density' has_densityI)
       (auto simp: subprob_space_imp_sigma_finite dest: has_subprob_densityD)
  from assms show "subprob_space (M \<bind> f)"
    by (intro subprob_space_bind) (auto dest: has_subprob_densityD)
qed

lemma null_measure_has_subprob_density:
  "space M \<noteq> {} \<Longrightarrow> has_subprob_density (null_measure M) M (\<lambda>_. 0)"
  by (intro has_subprob_densityI)
     (auto intro: null_measure_eq_density simp: subprob_space_null_measure_iff)

lemma emeasure_has_parametrized_subprob_density:
  assumes "has_parametrized_subprob_density M N R f"
  assumes "x \<in> space M" "X \<in> sets R"
  shows "emeasure (N x) X = \<integral>\<^sup>+y. f x y * indicator X y \<partial>R"
proof-
  from has_parametrized_subprob_densityD(3)[OF assms(1)] and assms(2)
    have Mf: "f x \<in> borel_measurable R" by simp
  have "N x = density R (f x)"
    by (rule has_parametrized_subprob_densityD(1)[OF assms(1,2)])
  also from Mf and assms(3) have "emeasure ... X = \<integral>\<^sup>+y. f x y * indicator X y \<partial>R"
    by (rule emeasure_density)
  finally show ?thesis .
qed

lemma emeasure_count_space_density_singleton:
  assumes "x \<in> A" "has_density M (count_space A) f"
  shows "emeasure M {x} = f x"
proof-
  from has_densityD[OF assms(2)] have nonneg: "\<And>x. x \<in> A \<Longrightarrow> f x \<ge> 0" by simp
  from assms have M: "M = density (count_space A) f" by (intro has_densityD)
  from assms have "emeasure M {x} = \<integral>\<^sup>+y. f y * indicator {x} y \<partial>count_space A"
    by (simp add: M emeasure_density)
  also from assms and nonneg have "... = f x"
    by (subst nn_integral_indicator_singleton) auto
  finally show ?thesis .
qed

lemma subprob_count_space_density_le_1:
  assumes "has_subprob_density M (count_space A) f" "x \<in> A"
  shows "f x \<le> 1"
proof (cases "f x > 0")
  assume "f x > 0"
  from assms interpret subprob_space M by (intro has_subprob_densityD)
  from assms have M: "M = density (count_space A) f" by (intro has_subprob_densityD)
  from assms have "f x = emeasure M {x}"
    by (intro emeasure_count_space_density_singleton[symmetric])
       (auto simp: has_subprob_density_def)
  also have "... \<le> 1" by (rule subprob_emeasure_le_1)
  finally show ?thesis .
qed (auto simp: not_less intro: order.trans[of _ 0 1])

lemma has_density_embed_measure:
  assumes inj: "inj f" and inv: "\<And>x. x \<in> space N \<Longrightarrow> f' (f x) = x"
  shows "has_density (embed_measure M f) (embed_measure N f) (\<delta> \<circ> f') \<longleftrightarrow> has_density M N \<delta>"
        (is "has_density ?M' ?N' ?\<delta>' \<longleftrightarrow> has_density M N \<delta>")
proof
  assume dens: "has_density ?M' ?N' ?\<delta>'"
  show "has_density M N \<delta>"
  proof
    from dens show "space N \<noteq> {}" by (auto simp: space_embed_measure dest: has_densityD)
    from dens have M\<delta>f': "\<delta> \<circ> f' \<in> borel_measurable ?N'" by (rule has_densityD)
    hence M\<delta>f'f: "\<delta> \<circ> f' \<circ> f \<in> borel_measurable N"
      by (rule_tac measurable_comp, rule_tac measurable_embed_measure2[OF inj])
    thus M\<delta>: "\<delta> \<in> borel_measurable N" by (simp cong: measurable_cong add: inv)
    from dens have "embed_measure M f = density (embed_measure N f) (\<delta> \<circ> f')" by (rule has_densityD)
    also have "... = embed_measure (density N (\<delta> \<circ> f' \<circ> f)) f"
      by (simp only: density_embed_measure[OF inj M\<delta>f'])
    also have "density N (\<delta> \<circ> f' \<circ> f) = density N \<delta>"
      by (intro density_cong[OF M\<delta>f'f M\<delta>]) (simp_all add: inv)
    finally show "M = density N \<delta>" by (simp add: embed_measure_eq_iff[OF inj])
  qed
next
  assume dens: "has_density M N \<delta>"
  show "has_density ?M' ?N' ?\<delta>'"
  proof
    from dens show "space ?N' \<noteq> {}" by (auto simp: space_embed_measure dest: has_densityD)
    have Mf'f: "(\<lambda>x. f' (f x)) \<in> measurable N N" by (subst measurable_cong[OF inv]) simp_all
    from dens have M\<delta>: "\<delta> \<in> borel_measurable N" by (auto dest: has_densityD)
    from Mf'f and dens show M\<delta>f': "\<delta> \<circ> f' \<in> borel_measurable (embed_measure N f)"
      by (intro measurable_comp) (erule measurable_embed_measure1, rule has_densityD)
    have "embed_measure M f = embed_measure (density N \<delta>) f"
      by (simp only: has_densityD[OF dens])
    also from inv and dens and measurable_comp[OF Mf'f M\<delta>]
      have "density N \<delta> = density N (?\<delta>' \<circ> f)"
      by (intro density_cong[OF M\<delta>]) (simp add: o_def, simp add: inv o_def)
    also have "embed_measure (density N (?\<delta>' \<circ> f)) f = density (embed_measure N f) (\<delta> \<circ> f')"
      by (simp only: density_embed_measure[OF inj M\<delta>f', symmetric])
    finally show "embed_measure M f = density (embed_measure N f) (\<delta> \<circ> f')" .
  qed
qed

lemma has_density_embed_measure':
  assumes inj: "inj f" and inv: "\<And>x. x \<in> space N \<Longrightarrow> f' (f x) = x" and
          sets_M: "sets M = sets (embed_measure N f)"
  shows "has_density (distr M N f') N (\<delta> \<circ> f) \<longleftrightarrow> has_density M (embed_measure N f) \<delta>"
proof-
  have sets': "sets (embed_measure (distr M N f') f) = sets (embed_measure N f)"
    by (simp add: sets_embed_measure[OF inj])
  have Mff': "(\<lambda>x. f' (f x)) \<in> measurable N N" by (subst measurable_cong[OF inv]) simp_all
  have inv': "\<And>x. x \<in> space M \<Longrightarrow> f (f' x) = x"
    by (subst (asm) sets_eq_imp_space_eq[OF sets_M]) (auto simp: space_embed_measure inv)
  have "M = distr M (embed_measure (distr M N f') f) (\<lambda>x. f (f' x))"
    by (subst distr_cong[OF refl _ inv', of _ M]) (simp_all add: sets_embed_measure inj sets_M)
  also have "... = embed_measure (distr M N f') f"
    apply (subst (2) embed_measure_eq_distr[OF inj], subst distr_distr)
    apply (subst measurable_cong_sets[OF refl sets'], rule measurable_embed_measure2[OF inj])
    apply (subst measurable_cong_sets[OF sets_M refl], rule measurable_embed_measure1, rule Mff')
    apply (simp cong: distr_cong add: inv)
    done
  finally have M: "M = embed_measure (distr M N f') f" .
  show ?thesis by (subst (2) M, subst has_density_embed_measure[OF inj inv, symmetric])
                  (auto simp: space_embed_measure inv intro!: has_density_cong)
qed

lemma has_density_embed_measure'':
  assumes inj: "inj f" and inv: "\<And>x. x \<in> space N \<Longrightarrow> f' (f x) = x" and
          "has_density M (embed_measure N f) \<delta>"
  shows "has_density (distr M N f') N (\<delta> \<circ> f)"
proof (subst has_density_embed_measure')
  from assms(3) show "sets M = sets (embed_measure N f)" by (auto dest: has_densityD)
qed (insert assms)

lemma has_subprob_density_embed_measure'':
  assumes inj: "inj f" and inv: "\<And>x. x \<in> space N \<Longrightarrow> f' (f x) = x" and
          "has_subprob_density M (embed_measure N f) \<delta>"
  shows "has_subprob_density (distr M N f') N (\<delta> \<circ> f)"
proof (unfold has_subprob_density_def, intro conjI)
  from assms show "has_density (distr M N f') N (\<delta> \<circ> f)"
    by (intro has_density_embed_measure'' has_subprob_density_imp_has_density)
  from assms(3) have "sets M = sets (embed_measure N f)" by (auto dest: has_subprob_densityD)
  hence M: "measurable M = measurable (embed_measure N f)"
    by (intro ext measurable_cong_sets) simp_all
  have "(\<lambda>x. f' (f x)) \<in> measurable N N" by (simp cong: measurable_cong add: inv)
  moreover from assms have "space (embed_measure N f) \<noteq> {}"
    unfolding has_subprob_density_def has_density_def by simp
  ultimately show "subprob_space (distr M N f')" using assms
    by (intro subprob_space.subprob_space_distr has_subprob_densityD)
       (auto simp: M space_embed_measure intro!: measurable_embed_measure1 dest: has_subprob_densityD)
qed (insert assms)

end


theory P05
imports Main
begin

primrec p05_1 :: "'a list \<Rightarrow> 'a list" where
"p05_1 [] = []"|
"p05_1 (x#xs) = p05_1 xs @ [x]"

value "p05_1 [1,2,3,4] :: int list"

lemma [simp] : "p05_1 (ls @ [b]) = b # p05_1 ls "
apply (induct ls)
apply auto
done

lemma "p05_1 (p05_1 xs)  = xs"
proof (induct xs)
  case Nil
  show ?case by simp
 next
  fix a xs ls b
  case (Cons a xs)
  assume "p05_1 (p05_1 xs) = xs"
  thus "p05_1 (p05_1 (a # xs)) = a # xs " by simp
qed

lemma "p05_1 ls = rev ls"
  apply (induct ls)
   apply simp_all
  done

lemma "length ls = length (p05_1 ls)"
  apply (induct ls)
   apply simp_all
  done

lemma "p05_1 (p05_1 ls ) = ls" by (induct ls; simp_all)

lemma "\<forall>x .x \<in> set ls \<Longrightarrow> x \<in> set (p05_1 ls)  "
proof (induct ls)
  case Nil
  then show ?case by simp
next
  case (Cons a ls)
  assume a:" \<forall>x. x \<in> set (a # ls)"
     and b:"(\<forall>x. x \<in> set ls \<Longrightarrow> x \<in> set (p05_1 ls))"
  with a  show ?case
qed

lemma "set ls = set (p05_1 ls)"
proof (induct ls)
  case Nil
  then show ?case by simp
next
  case (Cons a ls)
  then show ?case
  proof (cases "a \<in> set ls")
    case True
    then show ?thesis by (simp add: Cons.hyps)
  next
    case False
    then show ?thesis by (simp add : Cons.hyps)
  qed
qed


(*  Title:      HOL/Metis_Examples/Trans_Closure.thy
    Author:     Lawrence C. Paulson, Cambridge University Computer Laboratory
    Author:     Jasmin Blanchette, TU Muenchen

Metis example featuring the transitive closure.
*)

section {* Metis Example Featuring the Transitive Closure *}

theory Trans_Closure
imports Main
begin

declare [[metis_new_skolem]]

type_synonym addr = nat

datatype val
  = Unit        -- "dummy result value of void expressions"
  | Null        -- "null reference"
  | Bool bool   -- "Boolean value"
  | Intg int    -- "integer value"
  | Addr addr   -- "addresses of objects in the heap"

consts R :: "(addr \<times> addr) set"

consts f :: "addr \<Rightarrow> val"

lemma "\<lbrakk>f c = Intg x; \<forall>y. f b = Intg y \<longrightarrow> y \<noteq> x; (a, b) \<in> R\<^sup>*; (b, c) \<in> R\<^sup>*\<rbrakk>
       \<Longrightarrow> \<exists>c. (b, c) \<in> R \<and> (a, c) \<in> R\<^sup>*"
(* sledgehammer *)
proof -
  assume A1: "f c = Intg x"
  assume A2: "\<forall>y. f b = Intg y \<longrightarrow> y \<noteq> x"
  assume A3: "(a, b) \<in> R\<^sup>*"
  assume A4: "(b, c) \<in> R\<^sup>*"
  have F1: "f c \<noteq> f b" using A2 A1 by metis
  have F2: "\<forall>u. (b, u) \<in> R \<longrightarrow> (a, u) \<in> R\<^sup>*" using A3 by (metis transitive_closure_trans(6))
  have F3: "\<exists>x. (b, x b c R) \<in> R \<or> c = b" using A4 by (metis converse_rtranclE)
  have "c \<noteq> b" using F1 by metis
  hence "\<exists>u. (b, u) \<in> R" using F3 by metis
  thus "\<exists>c. (b, c) \<in> R \<and> (a, c) \<in> R\<^sup>*" using F2 by metis
qed

lemma "\<lbrakk>f c = Intg x; \<forall>y. f b = Intg y \<longrightarrow> y \<noteq> x; (a, b) \<in> R\<^sup>*; (b,c) \<in> R\<^sup>*\<rbrakk>
       \<Longrightarrow> \<exists>c. (b, c) \<in> R \<and> (a, c) \<in> R\<^sup>*"
(* sledgehammer [isar_proofs, compress = 2] *)
proof -
  assume A1: "f c = Intg x"
  assume A2: "\<forall>y. f b = Intg y \<longrightarrow> y \<noteq> x"
  assume A3: "(a, b) \<in> R\<^sup>*"
  assume A4: "(b, c) \<in> R\<^sup>*"
  have "b \<noteq> c" using A1 A2 by metis
  hence "\<exists>x\<^sub>1. (b, x\<^sub>1) \<in> R" using A4 by (metis converse_rtranclE)
  thus "\<exists>c. (b, c) \<in> R \<and> (a, c) \<in> R\<^sup>*" using A3 by (metis transitive_closure_trans(6))
qed

lemma "\<lbrakk>f c = Intg x; \<forall>y. f b = Intg y \<longrightarrow> y \<noteq> x; (a, b) \<in> R\<^sup>*; (b, c) \<in> R\<^sup>*\<rbrakk>
       \<Longrightarrow> \<exists>c. (b, c) \<in> R \<and> (a, c) \<in> R\<^sup>*"
apply (erule_tac x = b in converse_rtranclE)
 apply metis
by (metis transitive_closure_trans(6))

end


theory PALandWiseMenPuzzle2021_New_Defs imports Main    (* Sebastian Reiche and Christoph Benzmüller, 2021 *)

begin
 (* Parameter settings for Nitpick *) nitpick_params[user_axioms=true, format=4, show_all]

 typedecl i (* Type of possible worlds *)
 type_synonym \<sigma> = "i\<Rightarrow>bool" (* \<D> *)
 type_synonym \<tau> = "\<sigma>\<Rightarrow>i\<Rightarrow>bool" (* Type of world depended formulas (truth sets) *)
 type_synonym \<alpha> = "i\<Rightarrow>i\<Rightarrow>bool" (* Type of accessibility relations between world *)

 (* Some useful relations (for constraining accessibility relations) *)
 definition reflexive::"\<alpha>\<Rightarrow>bool" where "reflexive R \<equiv> \<forall>x. R x x"
 definition symmetric::"\<alpha>\<Rightarrow>bool" where "symmetric R \<equiv> \<forall>x y. R x y \<longrightarrow> R y x"
 definition transitive::"\<alpha>\<Rightarrow>bool" where "transitive R \<equiv> \<forall>x y z. R x y \<and> R y z \<longrightarrow> R x z"
 definition euclidean::"\<alpha>\<Rightarrow>bool" where "euclidean R \<equiv> \<forall>x y z. R x y \<and> R x z \<longrightarrow> R y z"
 definition intersection_rel::"\<alpha>\<Rightarrow>\<alpha>\<Rightarrow>\<alpha>" where "intersection_rel R Q \<equiv> \<lambda>u v. R u v \<and> Q u v"
 definition union_rel::"\<alpha>\<Rightarrow>\<alpha>\<Rightarrow>\<alpha>" where "union_rel R Q \<equiv> \<lambda>u v. R u v \<or> Q u v"
 definition sub_rel::"\<alpha>\<Rightarrow>\<alpha>\<Rightarrow>bool" where "sub_rel R Q \<equiv> \<forall>u v. R u v \<longrightarrow> Q u v"
 definition inverse_rel::"\<alpha>\<Rightarrow>\<alpha>" where "inverse_rel R \<equiv> \<lambda>u v. R v u"
 definition bigunion_rel::"(\<alpha>\<Rightarrow>bool)\<Rightarrow>\<alpha>" ("\<^bold>\<Union>_") where "\<^bold>\<Union> X \<equiv> \<lambda>u v. \<exists>R. (X R) \<and> (R u v)"
 definition bigintersection_rel::"(\<alpha>\<Rightarrow>bool)\<Rightarrow>\<alpha>" ("\<^bold>\<Inter>_") where "\<^bold>\<Inter> X \<equiv> \<lambda>u v. \<forall>R. (X R) \<longrightarrow> (R u v)"

 (*In HOL the transitive closure of a relation can be defined in a single line.*)
 definition tc::"\<alpha>\<Rightarrow>\<alpha>" where "tc R \<equiv> \<lambda>x y.\<forall>Q. transitive Q \<longrightarrow> (sub_rel R Q \<longrightarrow> Q x y)"

 (* Lifted HOMML connectives for PAL *)
 definition patom::"\<sigma>\<Rightarrow>\<tau>" ("\<^sup>A_"[79]80) where "\<^sup>Ap \<equiv> \<lambda>W w. W w \<and> p w"
 definition ptop::"\<tau>" ("\<^bold>\<top>") where "\<^bold>\<top> \<equiv> \<lambda>W w. True"
 definition pneg::"\<tau>\<Rightarrow>\<tau>" ("\<^bold>\<not>_"[52]53) where "\<^bold>\<not>\<phi> \<equiv> \<lambda>W w. \<not>(\<phi> W w)"
 definition pand::"\<tau>\<Rightarrow>\<tau>\<Rightarrow>\<tau>" (infixr"\<^bold>\<and>"51) where "\<phi>\<^bold>\<and>\<psi> \<equiv> \<lambda>W w. (\<phi> W w) \<and> (\<psi> W w)"
 definition por::"\<tau>\<Rightarrow>\<tau>\<Rightarrow>\<tau>" (infixr"\<^bold>\<or>"50) where "\<phi>\<^bold>\<or>\<psi> \<equiv> \<lambda>W w. (\<phi> W w) \<or> (\<psi> W w)"
 definition pimp::"\<tau>\<Rightarrow>\<tau>\<Rightarrow>\<tau>" (infixr"\<^bold>\<rightarrow>"49) where "\<phi>\<^bold>\<rightarrow>\<psi> \<equiv> \<lambda>W w. (\<phi> W w) \<longrightarrow> (\<psi> W w)"
 definition pequ::"\<tau>\<Rightarrow>\<tau>\<Rightarrow>\<tau>" (infixr"\<^bold>\<leftrightarrow>"48) where "\<phi>\<^bold>\<leftrightarrow>\<psi> \<equiv> \<lambda>W w. (\<phi> W w) \<longleftrightarrow> (\<psi> W w)"
 definition pknow::"\<alpha>\<Rightarrow>\<tau>\<Rightarrow>\<tau>" ("\<^bold>K_ _") where "\<^bold>K r \<phi> \<equiv> \<lambda>W w.\<forall>v. (W v \<and> r w v) \<longrightarrow> (\<phi> W v)"
 definition ppal::"\<tau>\<Rightarrow>\<tau>\<Rightarrow>\<tau>" ("\<^bold>[\<^bold>!_\<^bold>]_") where "\<^bold>[\<^bold>!\<phi>\<^bold>]\<psi> \<equiv> \<lambda>W w. (\<phi> W w) \<longrightarrow> (\<psi> (\<lambda>z. W z \<and> \<phi> W z) w)"

 (* Validity of \<tau>-type lifted PAL formulas *)
 definition pvalid::"\<tau> \<Rightarrow> bool" ("\<^bold>\<lfloor>_\<^bold>\<rfloor>"[7]8) where "\<^bold>\<lfloor>\<phi>\<^bold>\<rfloor> \<equiv> \<forall>W.\<forall>w. W w \<longrightarrow> \<phi> W w"

 (* Agent Knowledge, Mutual Knowledge, Common Knowledge *)
 definition  "EVR A \<equiv> \<^bold>\<Union> A"
 definition  "DIS A \<equiv> \<^bold>\<Inter> A"
 definition agttknows::"\<alpha>\<Rightarrow>\<tau>\<Rightarrow>\<tau>" ("\<^bold>K\<^sub>_ _") where "\<^bold>K\<^sub>r \<phi> \<equiv>  \<^bold>K r \<phi>"
 definition evrknows::"(\<alpha>\<Rightarrow>bool)\<Rightarrow>\<tau>\<Rightarrow>\<tau>" ("\<^bold>E\<^sub>_ _") where "\<^bold>E\<^sub>A \<phi> \<equiv>  \<^bold>K (EVR A) \<phi>"
 definition prck::"(\<alpha>\<Rightarrow>bool)\<Rightarrow>\<tau>\<Rightarrow>\<tau>\<Rightarrow>\<tau>" ("\<^bold>C\<^sub>_\<^bold>\<lparr>_\<^bold>|_\<^bold>\<rparr>")
   where "\<^bold>C\<^sub>A\<^bold>\<lparr>\<phi>\<^bold>|\<psi>\<^bold>\<rparr> \<equiv> \<lambda>W w. \<forall>v. \<not>(tc (intersection_rel (EVR A) (\<lambda>u v. W v \<and> \<phi> W v)) w v) \<or> (\<psi> W v)"
 definition pcmn::"(\<alpha>\<Rightarrow>bool)\<Rightarrow>\<tau>\<Rightarrow>\<tau>" ("\<^bold>C\<^sub>_ _") where "\<^bold>C\<^sub>A \<phi> \<equiv>  \<^bold>C\<^sub>A\<^bold>\<lparr>\<^bold>\<top>\<^bold>|\<phi>\<^bold>\<rparr>"
 definition disknows :: "(\<alpha>\<Rightarrow>bool)\<Rightarrow>\<tau>\<Rightarrow>\<tau>" ("\<^bold>D\<^sub>_ _") where "\<^bold>D\<^sub>A \<phi> \<equiv> \<^bold>K (DIS A) \<phi>"

 (* Introducing "Defs" as the set of the above definitions; useful for convenient unfolding *)
 named_theorems Defs
 declare
   patom_def[Defs] ptop_def[Defs] pneg_def[Defs] pand_def[Defs] por_def[Defs] pimp_def[Defs] pequ_def[Defs] pknow_def[Defs] ppal_def[Defs]
   EVR_def[Defs] DIS_def[Defs] prck_def[Defs] pvalid_def[Defs]
   agttknows_def[Defs] evrknows_def[Defs] pcmn_def[Defs] disknows_def[Defs]
   reflexive_def[Defs] symmetric_def[Defs] transitive_def[Defs] euclidean_def[Defs]
   intersection_rel_def[Defs] union_rel_def[Defs] sub_rel_def[Defs] inverse_rel_def[Defs]
   bigunion_rel_def[Defs] tc_def[Defs]

 (***********************************************************************************************)
 (*****                         Experiments                                                 *****)
 (***********************************************************************************************)
 (*Some useful lemmata *)
 lemma trans_tc: "transitive (tc R)" unfolding Defs by metis
 lemma trans_inv_tc: "transitive (inverse_rel (tc R))" unfolding Defs by metis
 lemma sub_rel_tc: "symmetric R \<longrightarrow> (sub_rel R (inverse_rel (tc R)))" unfolding Defs by smt
 lemma sub_rel_tc_tc: "symmetric R \<longrightarrow> (sub_rel (tc R) (inverse_rel (tc R)))"
   using sub_rel_def sub_rel_tc tc_def trans_inv_tc by fastforce
 lemma symm_tc: "symmetric R \<longrightarrow> symmetric (tc R)"
   using inverse_rel_def sub_rel_def sub_rel_tc_tc symmetric_def by auto

 (* System K: is implied by the semantical embedding *)
 lemma tautologies: "\<^bold>\<lfloor>\<^bold>\<top>\<^bold>\<rfloor>" unfolding Defs by auto
 lemma axiom_K: "\<A> i \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>K\<^sub>i (\<phi> \<^bold>\<rightarrow> \<psi>)) \<^bold>\<rightarrow> ((\<^bold>K\<^sub>i \<phi>) \<^bold>\<rightarrow> (\<^bold>K\<^sub>i \<psi>))\<^bold>\<rfloor>" unfolding Defs by auto
 lemma modusponens: assumes 1: "\<^bold>\<lfloor>\<phi> \<^bold>\<rightarrow> \<psi>\<^bold>\<rfloor>" and 2: "\<^bold>\<lfloor>\<phi>\<^bold>\<rfloor>" shows "\<^bold>\<lfloor>\<psi>\<^bold>\<rfloor>" using 1 2 unfolding Defs by auto
 lemma necessitation: assumes 1: "\<^bold>\<lfloor>\<phi>\<^bold>\<rfloor>" shows "\<A> i \<Longrightarrow> \<^bold>\<lfloor>\<^bold>K\<^sub>i \<phi>\<^bold>\<rfloor>" using 1 unfolding Defs by auto
 (* More axioms: implied by the semantical embedding  *)
 lemma axiom_T: "reflexive i \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>K\<^sub>i \<phi>) \<^bold>\<rightarrow> \<phi>\<^bold>\<rfloor>" using reflexive_def unfolding Defs by auto
 lemma axiom_4: "transitive i \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>K\<^sub>i \<phi>) \<^bold>\<rightarrow> (\<^bold>K\<^sub>i (\<^bold>K\<^sub>i \<phi>))\<^bold>\<rfloor>" using transitive_def unfolding Defs by meson
 lemma axiom_5: "euclidean i \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>\<not>\<^bold>K\<^sub>i \<phi>) \<^bold>\<rightarrow> (\<^bold>K\<^sub>i (\<^bold>\<not>\<^bold>K\<^sub>i \<phi>))\<^bold>\<rfloor>" using euclidean_def unfolding Defs by meson
 (*Reduction axioms: implied by the semantical embedding *)
 lemma atomic_permanence: "\<^bold>\<lfloor>(\<^bold>[\<^bold>!\<phi>\<^bold>]\<^sup>Ap) \<^bold>\<leftrightarrow> (\<phi> \<^bold>\<rightarrow> \<^sup>Ap)\<^bold>\<rfloor>" unfolding Defs by auto
 lemma conjunction: "\<^bold>\<lfloor>(\<^bold>[\<^bold>!\<phi>\<^bold>](\<psi> \<^bold>\<and> \<chi>)) \<^bold>\<rightarrow> ((\<^bold>[\<^bold>!\<phi>\<^bold>]\<psi>) \<^bold>\<and> (\<^bold>[\<^bold>!\<phi>\<^bold>]\<chi>))\<^bold>\<rfloor>" unfolding Defs by auto
 lemma part_func: "\<^bold>\<lfloor>(\<^bold>[\<^bold>!\<phi>\<^bold>]\<^bold>\<not>\<psi>) \<^bold>\<leftrightarrow> (\<phi> \<^bold>\<rightarrow> (\<^bold>\<not>\<^bold>[\<^bold>!\<phi>\<^bold>]\<psi>))\<^bold>\<rfloor>" unfolding Defs by auto
 lemma action_knowledge: "\<^bold>\<lfloor>(\<^bold>[\<^bold>!\<phi>\<^bold>](\<^bold>K\<^sub>i \<psi>)) \<^bold>\<leftrightarrow> (\<phi> \<^bold>\<rightarrow> (\<^bold>K\<^sub>i (\<phi> \<^bold>\<rightarrow> (\<^bold>[\<^bold>!\<phi>\<^bold>]\<psi>))))\<^bold>\<rfloor>" unfolding Defs by auto
 lemma "\<^bold>\<lfloor>(\<^bold>[\<^bold>!\<phi>\<^bold>](\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<psi>\<^bold>\<rparr>)) \<^bold>\<leftrightarrow> (\<phi> \<^bold>\<rightarrow> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<phi>\<^bold>\<and>(\<^bold>[\<^bold>!\<phi>\<^bold>]\<chi>)\<^bold>|\<^bold>[\<^bold>!\<phi>\<^bold>]\<psi>\<^bold>\<rparr>))\<^bold>\<rfloor>"
   (* sledgehammer finds proof, reconstruction fails *) oops

 declare [[smt_solver=cvc4,smt_oracle]]

 definition "S5Agent i \<equiv> reflexive i \<and> transitive i \<and> euclidean i"
 definition "S5Agents A \<equiv> \<forall>i. (A i \<longrightarrow> S5Agent i)"

 declare S5Agent_def[Defs] S5Agents_def[Defs]

 (* Axiom schemes for RCK: implied by the semantical embedding *)
 lemma \<C>_normality: "\<^bold>\<lfloor>\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rightarrow>\<psi>\<^bold>\<rparr> \<^bold>\<rightarrow>(\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr> \<^bold>\<rightarrow> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<psi>\<^bold>\<rparr>)\<^bold>\<rfloor>" unfolding Defs by blast

 lemma mix_axiom1: "\<^bold>\<lfloor>\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr> \<^bold>\<rightarrow> \<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> (\<phi> \<^bold>\<and> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)))\<^bold>\<rfloor>" unfolding Defs by smt

 lemma mix_axiom2': "A = (\<lambda>x. False) \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> (\<phi> \<^bold>\<and> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)))) \<^bold>\<rightarrow> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>\<^bold>\<rfloor>"
  unfolding Defs by (metis (full_types))
 lemma mix_axiom2'': "A = (\<lambda>x. True) \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> (\<phi> \<^bold>\<and> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)))) \<^bold>\<rightarrow> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>\<^bold>\<rfloor>"
  unfolding Defs by (metis (full_types)) (* takes long *)
 lemma mix_axiom2''': "A = (\<lambda>x. x = a) \<and> S5Agent a \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> (\<phi> \<^bold>\<and> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)))) \<^bold>\<rightarrow> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>\<^bold>\<rfloor>"
  unfolding Defs  (* sledgehammer finds proof, but reconstruction times✕out *) oops
 lemma mix_axiom2'''': "A = (\<lambda>x. x = a \<or> x = b) \<and> S5Agent a  \<and> S5Agent b \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> (\<phi> \<^bold>\<and> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)))) \<^bold>\<rightarrow> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>\<^bold>\<rfloor>"
  unfolding Defs sledgehammer (* sledgehammer and nitpick timeout *) oops
 lemma mix_axiom2_general: "\<^bold>\<lfloor>(\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> (\<phi> \<^bold>\<and> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)))) \<^bold>\<rightarrow> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>\<^bold>\<rfloor>" unfolding Defs  (* timeout *) oops

 lemma induction_axiom': "A = (\<lambda>x. False) \<Longrightarrow> \<^bold>\<lfloor>((\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>)) \<^bold>\<and> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi> \<^bold>\<rightarrow> (\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>))\<^bold>\<rparr>) \<^bold>\<rightarrow> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)\<^bold>\<rfloor>"
  unfolding Defs by (metis (full_types))
 lemma induction_axiom'': "A = (\<lambda>x. True) \<Longrightarrow> \<^bold>\<lfloor>((\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>)) \<^bold>\<and> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi> \<^bold>\<rightarrow> (\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>))\<^bold>\<rparr>) \<^bold>\<rightarrow> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)\<^bold>\<rfloor>"
  unfolding Defs (* sledgehammer finds proof, but reconstruction times✕out *) oops
 lemma induction_axiom''': "A = (\<lambda>x. x = a)  \<and> S5Agent a  \<Longrightarrow> \<^bold>\<lfloor>((\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>)) \<^bold>\<and> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi> \<^bold>\<rightarrow> (\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>))\<^bold>\<rparr>) \<^bold>\<rightarrow> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)\<^bold>\<rfloor>"
  unfolding Defs (* sledgehammer finds proof, but reconstruction times✕out *) oops
 lemma induction_axiom'''': "A = (\<lambda>x. x = a \<or> x = b) \<and> S5Agent a  \<and> S5Agent b  \<Longrightarrow> \<^bold>\<lfloor>((\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>)) \<^bold>\<and> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi> \<^bold>\<rightarrow> (\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>))\<^bold>\<rparr>) \<^bold>\<rightarrow> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)\<^bold>\<rfloor>"
   unfolding Defs (* sledgehammer and nitpick timeout *) oops
 lemma induction_axiom_general: "\<^bold>\<lfloor>((\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>)) \<^bold>\<and> \<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi> \<^bold>\<rightarrow> (\<^bold>E\<^sub>A(\<chi> \<^bold>\<rightarrow> \<phi>))\<^bold>\<rparr>) \<^bold>\<rightarrow> (\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)\<^bold>\<rfloor>"
   unfolding Defs (* sledgehammer and nitpick timeout *) oops

 (* Necessitation rules: implied by the semantical embedding *)
 lemma announcement_nec: assumes "\<^bold>\<lfloor>\<phi>\<^bold>\<rfloor>" shows "\<^bold>\<lfloor>\<^bold>[\<^bold>!\<psi>\<^bold>]\<phi>\<^bold>\<rfloor>" using assms unfolding Defs by simp
 lemma rkc_necessitation: assumes "\<^bold>\<lfloor>\<phi>\<^bold>\<rfloor>" shows "\<^bold>\<lfloor>(\<^bold>C\<^sub>A\<^bold>\<lparr>\<chi>\<^bold>|\<phi>\<^bold>\<rparr>)\<^bold>\<rfloor>" using assms unfolding Defs
   (* sledgehammer finds proof, but reconstruction times✕out *) oops

 lemma assumes "\<^bold>\<lfloor>p \<^bold>\<leftrightarrow> q\<^bold>\<rfloor>" shows "\<forall>W v. (p W v \<longleftrightarrow> q W v)" using assms unfolding Defs nitpick oops (* countermodel *)
 lemma assumes "\<forall>W v. (p W v \<longleftrightarrow> q W v)" shows "\<^bold>\<lfloor>p \<^bold>\<leftrightarrow> q\<^bold>\<rfloor>" using assms unfolding Defs by simp
 lemma assumes "\<^bold>\<lfloor>\<^sup>Ap \<^bold>\<leftrightarrow> \<^sup>Aq\<^bold>\<rfloor>"  shows "\<forall>v. (p v \<longleftrightarrow> q v)" using assms unfolding Defs by simp
 lemma assumes  "\<forall>v. (p v \<longleftrightarrow> q v)" shows "\<^bold>\<lfloor>\<^sup>Ap \<^bold>\<leftrightarrow> \<^sup>Aq\<^bold>\<rfloor>" using assms unfolding Defs by simp

 (* Further axioms: implied for atomic formulas, but not implied in general *)
 lemma "\<^bold>\<lfloor>\<^sup>Ap \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<^sup>Ap\<^bold>](\<^bold>\<not>\<^sup>Ap)\<^bold>\<rfloor>" unfolding Defs by simp
 lemma "\<^bold>\<lfloor>\<phi> \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<phi>\<^bold>](\<^bold>\<not>\<phi>)\<^bold>\<rfloor>" unfolding Defs nitpick oops (* countermodel found *)
 lemma "\<^bold>\<lfloor>\<^sup>Ap \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<^sup>Ap\<^bold>](\<^bold>\<not>\<^bold>K\<^sub>a \<^sup>Ap)\<^bold>\<rfloor>" unfolding Defs by simp
 lemma "\<^bold>\<lfloor>\<phi> \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<phi>\<^bold>](\<^bold>\<not>\<^bold>K\<^sub>a \<phi>)\<^bold>\<rfloor>" unfolding Defs nitpick oops (* countermodel found *)
 lemma "\<^bold>\<lfloor>\<^sup>Ap \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<^sup>Ap\<^bold>](\<^bold>\<not>\<^bold>K\<^sub>r \<^sup>Ap)\<^bold>\<rfloor>" unfolding Defs by simp
 lemma "\<^bold>\<lfloor>\<phi> \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<phi>\<^bold>](\<^bold>\<not>\<^bold>K\<^sub>r \<phi>)\<^bold>\<rfloor>" unfolding Defs nitpick oops (* countermodel found *)
 lemma "\<^bold>\<lfloor>\<^sup>Ap \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<^sup>Ap\<^bold>](\<^sup>Ap \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<^sup>Ap)\<^bold>\<rfloor>" unfolding Defs by simp
 lemma "\<^bold>\<lfloor>\<phi> \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<phi>\<^bold>](\<phi> \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<phi>)\<^bold>\<rfloor>" unfolding Defs nitpick oops (* countermodel found *)
 lemma "\<^bold>\<lfloor>(\<^sup>Ap \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<^sup>Ap) \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<^sup>Ap \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<^sup>Ap\<^bold>](\<^sup>Ap \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<^sup>Ap)\<^bold>\<rfloor>" unfolding Defs by blast
 lemma "\<^bold>\<lfloor>(\<phi> \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<phi>) \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<phi> \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<phi>\<^bold>](\<phi> \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<phi>)\<^bold>\<rfloor>" unfolding Defs nitpick oops (* countermodel found *)
 lemma "S5Agent r \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>K\<^sub>r \<^sup>Ap) \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<^sup>Ap\<^bold>](\<^bold>\<not>\<^bold>K\<^sub>r \<^sup>Ap)\<^bold>\<rfloor>" using reflexive_def unfolding Defs by meson
 lemma "S5Agent r \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>K\<^sub>r \<phi>) \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<phi>\<^bold>](\<^bold>\<not>\<^bold>K\<^sub>r \<phi>)\<^bold>\<rfloor>" unfolding Defs nitpick oops (* countermodel found *)
 lemma "S5Agent r \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>K\<^sub>r \<^sup>Ap) \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<^sup>Ap\<^bold>](\<^sup>Ap \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<^sup>Ap)\<^bold>\<rfloor>" using reflexive_def unfolding Defs by meson
 lemma "S5Agent r \<Longrightarrow> \<^bold>\<lfloor>(\<^bold>K\<^sub>r \<phi>) \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>[\<^bold>!\<phi>\<^bold>](\<phi> \<^bold>\<and> \<^bold>\<not>\<^bold>K\<^sub>r \<phi>)\<^bold>\<rfloor>" unfolding Defs nitpick oops (* countermodel found *)

 (***********************************************************************************************)
 (*****                         Wise Men Puzzle                                             *****)
 (***********************************************************************************************)
 (*** Encoding of the wise men puzzle in PAL ***)
 (* Agents *)
 consts a::"\<alpha>" b::"\<alpha>" c::"\<alpha>" (* Agents modeled as accessibility relations *)
 definition  Agent::"\<alpha>\<Rightarrow>bool" ("\<A>") where "\<A> x \<equiv> x = a \<or> x = b \<or> x = c"
 axiomatization where  group_S5: "S5Agents \<A>"

 (* Common knowledge: At least one of a, b and c has a white spot *)
 consts ws::"\<alpha>\<Rightarrow>\<sigma>"
 axiomatization where WM1: "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> (\<^sup>Aws a \<^bold>\<or> \<^sup>Aws b \<^bold>\<or> \<^sup>Aws c)\<^bold>\<rfloor>"

 axiomatization where
   (* Common knowledge: If x does not have a white spot then y know this *)
   WM2ab: "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> (\<^bold>\<not>(\<^sup>Aws a) \<^bold>\<rightarrow> (\<^bold>K\<^sub>b (\<^bold>\<not>(\<^sup>Aws a))))\<^bold>\<rfloor>" and
   WM2ac: "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> (\<^bold>\<not>(\<^sup>Aws a) \<^bold>\<rightarrow> (\<^bold>K\<^sub>c (\<^bold>\<not>(\<^sup>Aws a))))\<^bold>\<rfloor>" and
   WM2ba: "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> (\<^bold>\<not>(\<^sup>Aws b) \<^bold>\<rightarrow> (\<^bold>K\<^sub>a (\<^bold>\<not>(\<^sup>Aws b))))\<^bold>\<rfloor>" and
   WM2bc: "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> (\<^bold>\<not>(\<^sup>Aws b) \<^bold>\<rightarrow> (\<^bold>K\<^sub>c (\<^bold>\<not>(\<^sup>Aws b))))\<^bold>\<rfloor>" and
   WM2ca: "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> (\<^bold>\<not>(\<^sup>Aws c) \<^bold>\<rightarrow> (\<^bold>K\<^sub>a (\<^bold>\<not>(\<^sup>Aws c))))\<^bold>\<rfloor>" and
   WM2cb: "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> (\<^bold>\<not>(\<^sup>Aws c) \<^bold>\<rightarrow> (\<^bold>K\<^sub>b (\<^bold>\<not>(\<^sup>Aws c))))\<^bold>\<rfloor>"

 (* Positive introspection principles are implied *)
 lemma WM2ab': "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> ((\<^sup>Aws a) \<^bold>\<rightarrow> (\<^bold>K\<^sub>b (\<^sup>Aws a)))\<^bold>\<rfloor>" using WM2ab group_S5 unfolding Defs by metis
 lemma WM2ac': "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> ((\<^sup>Aws a) \<^bold>\<rightarrow> (\<^bold>K\<^sub>c (\<^sup>Aws a)))\<^bold>\<rfloor>" using WM2ac group_S5 unfolding Defs by metis
 lemma WM2ba': "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> ((\<^sup>Aws b) \<^bold>\<rightarrow> (\<^bold>K\<^sub>a (\<^sup>Aws b)))\<^bold>\<rfloor>" using WM2ba group_S5 unfolding Defs by metis
 lemma WM2bc': "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> ((\<^sup>Aws b) \<^bold>\<rightarrow> (\<^bold>K\<^sub>c (\<^sup>Aws b)))\<^bold>\<rfloor>" using WM2bc group_S5 unfolding Defs by metis
 lemma WM2ca': "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> ((\<^sup>Aws c) \<^bold>\<rightarrow> (\<^bold>K\<^sub>a (\<^sup>Aws c)))\<^bold>\<rfloor>" using WM2ca group_S5 unfolding Defs by metis
 lemma WM2cb': "\<^bold>\<lfloor>\<^bold>C\<^sub>\<A> ((\<^sup>Aws c) \<^bold>\<rightarrow> (\<^bold>K\<^sub>b (\<^sup>Aws c)))\<^bold>\<rfloor>" using WM2cb group_S5 unfolding Defs by metis

 (* Automated solutions of the Wise Men Puzzle *)
 theorem whitespot_c_1: "\<^bold>\<lfloor>\<^bold>[\<^bold>!\<^bold>\<not>\<^bold>K\<^sub>a(\<^sup>Aws a)\<^bold>](\<^bold>[\<^bold>!\<^bold>\<not>\<^bold>K\<^sub>b(\<^sup>Aws b)\<^bold>](\<^bold>K\<^sub>c (\<^sup>Aws c)))\<^bold>\<rfloor>"
   using WM1 WM2ba WM2ca WM2cb unfolding Defs by (smt (verit))

 theorem whitespot_c_2:
   "\<^bold>\<lfloor>\<^bold>[\<^bold>!\<^bold>\<not>((\<^bold>K\<^sub>a (\<^sup>Aws a)) \<^bold>\<or> (\<^bold>K\<^sub>a (\<^bold>\<not>\<^sup>Aws a)))\<^bold>](\<^bold>[\<^bold>!\<^bold>\<not>((\<^bold>K\<^sub>b (\<^sup>Aws b)) \<^bold>\<or> (\<^bold>K\<^sub>b (\<^bold>\<not>\<^sup>Aws b)))\<^bold>](\<^bold>K\<^sub>c (\<^sup>Aws c)))\<^bold>\<rfloor>"
   using WM1 WM2ba WM2ca WM2cb unfolding Defs by (smt (verit))

 (* Consistency confirmed by nitpick *)
 lemma True nitpick [satisfy,show_all] oops  (* model found *)
end


theory Exe4p4
  imports Main
begin

inductive ev :: "nat \<Rightarrow> bool" where
ev0: "ev 0" |
evSS : "ev n \<Longrightarrow> ev (Suc(Suc n))"

fun evn :: "nat \<Rightarrow> bool" where
"evn 0 = True" |
"evn (Suc 0) = False" |
"evn (Suc(Suc n)) = evn n"

lemma "\<not>ev(Suc(Suc(Suc 0)))"
proof
  assume "ev(Suc(Suc(Suc 0)))"
  thus "False"
  proof (induction "Suc(Suc(Suc 0))" rule: ev.induct)
    assume "ev(Suc 0)"
    thus "False"
    proof (induction "Suc 0" rule: ev.induct)
    qed
  qed
qed

end


(***********************************************************************
* HiVe theory files
*
* Copyright (C) 2015 Commonwealth of Australia as represented by Defence Science and Technology
* Group (DST Group)
*
* All rights reserved.
*
* The HiVe theory files are free software: released for redistribution and use, and/or modification,
* under the BSD License, details of which can be found in the LICENSE file included in the
* distribution.
************************************************************************)

theory Metric_Locale

imports
  Z_Toolkit
begin

text {*

This theory introduces metric space, shows instantiation for different
types and defines limits and continuity for functions in metric
spaces.  We develop a set-based approach.

A metric space has a distance function between its elements.
Note that by building this on carrier we assume that the space is not empty.
This is a change, so have to be sure that don't run into trouble!

*}

locale metric_sig = carrier X
  for X :: "'a set" +
  fixes
    distance :: "['a, 'a] \<rightarrow> \<real>" ("\<^mdist>{:_:}{:_:}")

locale metric_space = metric_sig +
  assumes
    nonneg: "\<And> x y \<bullet> \<lbrakk> x \<in> X; y \<in> X \<rbrakk> \<turnstile> 0 \<le> \<^mdist>{:x:}{:y:}" and
    strict: "\<And> x y \<bullet> \<lbrakk> x \<in> X; y \<in> X \<rbrakk> \<turnstile> \<^mdist>{:x:}{:y:} = 0 \<Leftrightarrow> x = y" and
    symmetric: "\<And> x y \<bullet> \<lbrakk> x \<in> X; y \<in> X \<rbrakk> \<turnstile> \<^mdist>{:x:}{:y:} = \<^mdist>{:y:}{:x:}" and
    subadd: "\<And> x y z \<bullet>\<lbrakk>  x \<in> X; y \<in> X; z \<in> X \<rbrakk> \<turnstile> \<^mdist>{:x:}{:z:} \<le> \<^mdist>{:x:}{:y:} + \<^mdist>{:y:}{:z:}"
begin

  lemma zero_dist:
  "\<And> x \<bullet> x \<in> X \<turnstile> \<^mdist>{:x:}{:x:} = 0"
  by (auto simp add: strict)

  lemma diff_triangle:
  "\<And> x y z \<bullet> \<lbrakk> x \<in> X; y \<in> X; z \<in> X \<rbrakk> \<turnstile> abs (\<^mdist>{:x:}{:z:} - \<^mdist>{:y:}{:z:}) \<le> \<^mdist>{:x:}{:y:}"
  proof-
    fix x y z :: 'a
    assume inX:  "x \<in> X" "y \<in> X" "z \<in> X"
    from inX have
    "\<^mdist>{:x:}{:z:} \<le> \<^mdist>{:x:}{:y:} + \<^mdist>{:y:}{:z:}"
    by (intro subadd, auto)
    then have R1:
    "\<^mdist>{:x:}{:z:} - \<^mdist>{:y:}{:z:} \<le> \<^mdist>{:x:}{:y:}"
    by (auto)
    from inX have
    "\<^mdist>{:z:}{:y:} \<le> \<^mdist>{:z:}{:x:} + \<^mdist>{:x:}{:y:}"
    by (intro subadd, auto)
    then have
    "- \<^mdist>{:x:}{:y:} \<le> \<^mdist>{:z:}{:x:} - \<^mdist>{:z:}{:y:}"
    by (auto)
    with inX have R2:
    "- \<^mdist>{:x:}{:y:} \<le> \<^mdist>{:x:}{:z:} - \<^mdist>{:y:}{:z:}"
    by (auto simp add: symmetric)
    from R1 R2 show
    "abs (\<^mdist>{:x:}{:z:} - \<^mdist>{:y:}{:z:}) \<le> \<^mdist>{:x:}{:y:}"
    by (auto simp add: abs_le_interval_iff)
  qed

end

lemmas metric_space_def' = metric_space_def metric_space_axioms_def metric_sig_def carrier_def'

notation (zed)
  metric_space ("\<^metricspace>{:_:}{:_:}")

end