(* License: LGPL *)
(* Author: Julian Parsert *)

theory Neumann_Morgenstern_Utility_Theorem
  imports
    "HOL-Probability.Probability"
    "First_Welfare_Theorem.Utility_Functions"
    Lotteries
begin

section \<open> Properties of Preferences \<close>

subsection \<open> Independent Preferences\<close>

text \<open> Independence is sometimes called substitution \<close>

text \<open> Notice how r is "added" to the right of mix-pmf and the element to the left q/p changes \<close>
definition independent_vnm
  where
    "independent_vnm C P =
    (\<forall>p \<in> C. \<forall>q \<in> C. \<forall>r \<in> C. \<forall>(\<alpha>::real) \<in> {0<..1}. p \<succeq>[P] q \<longleftrightarrow> mix_pmf \<alpha> p r \<succeq>[P] mix_pmf \<alpha> q r)"

lemma independent_vnmI1:
  assumes "(\<forall>p \<in> C. \<forall>q \<in> C. \<forall>r \<in> C. \<forall>\<alpha> \<in> {0<..1}. p \<succeq>[P] q \<longleftrightarrow> mix_pmf \<alpha> p r \<succeq>[P] mix_pmf \<alpha> q r)"
  shows "independent_vnm C P"
  using assms independent_vnm_def by blast

lemma independent_vnmI2:
  assumes "\<And>p q r \<alpha>. p \<in> C \<Longrightarrow> q \<in> C \<Longrightarrow> r \<in> C \<Longrightarrow> \<alpha> \<in> {0<..1} \<Longrightarrow> p \<succeq>[P] q \<longleftrightarrow> mix_pmf \<alpha> p r \<succeq>[P] mix_pmf \<alpha> q r"
  shows "independent_vnm C P"
  by (rule independent_vnmI1, standard, standard, standard,
      standard, simp add: assms) (meson assms greaterThanAtMost_iff)

lemma independent_vnm_alt_def:
  shows "independent_vnm C P \<longleftrightarrow> (\<forall>p \<in> C. \<forall>q \<in> C. \<forall>r \<in> C. \<forall>\<alpha> \<in> {0<..<1}.
  p \<succeq>[P] q \<longleftrightarrow> mix_pmf \<alpha> p r \<succeq>[P] mix_pmf \<alpha> q r)" (is "?L \<longleftrightarrow> ?R")
proof (rule iffI)
  assume a: "?R"
  have "independent_vnm C P"
    by(rule independent_vnmI2, simp add: a) (metis a greaterThanLessThan_iff
        linorder_neqE_linordered_idom not_le pmf_mix_1)
  then show "?L" by auto
qed (simp add: independent_vnm_def)

lemma independece_dest_alt:
  assumes "independent_vnm C P"
  shows "(\<forall>p \<in> C. \<forall>q \<in> C. \<forall>r \<in> C. \<forall>(\<alpha>::real) \<in> {0<..1}. p \<succeq>[P] q \<longleftrightarrow> mix_pmf \<alpha> p r \<succeq>[P] mix_pmf \<alpha> q r)"
proof (standard, standard, standard, standard)
  fix p q r \<alpha>
  assume as1: "p \<in> C"
  assume as2: "q \<in> C"
  assume as3: "r \<in> C"
  assume as4: "(\<alpha>::real) \<in> {0<..1}"
  then show "p \<succeq>[P] q = mix_pmf \<alpha> p r \<succeq>[P] mix_pmf \<alpha> q r"
    using as1 as2 as3 assms(1) independent_vnm_def by blast
qed

lemma independent_vnmD1:
  assumes "independent_vnm C P"
  shows "(\<forall>p \<in> C. \<forall>q \<in> C. \<forall>r \<in> C. \<forall>\<alpha> \<in> {0<..1}. p \<succeq>[P] q \<longleftrightarrow> mix_pmf \<alpha> p r \<succeq>[P] mix_pmf \<alpha> q r)"
  using assms independent_vnm_def by blast

lemma independent_vnmD2:
  fixes p q r \<alpha>
  assumes "\<alpha> \<in> {0<..1}"
    and "p \<in> C"
    and "q \<in> C"
    and "r \<in> C"
  assumes "independent_vnm C P"
  assumes "p \<succeq>[P] q"
  shows "mix_pmf \<alpha> p r \<succeq>[P] mix_pmf \<alpha> q r"
  using assms independece_dest_alt  by blast

lemma independent_vnmD3:
  fixes p q r \<alpha>
  assumes "\<alpha> \<in> {0<..1}"
    and "p \<in> C"
    and "q \<in> C"
    and "r \<in> C"
  assumes "independent_vnm C P"
  assumes "mix_pmf \<alpha> p r \<succeq>[P] mix_pmf \<alpha> q r"
  shows "p \<succeq>[P] q"
  using assms independece_dest_alt by blast

lemma approx_indep_ge:
  assumes "x \<approx>[\<R>] y"
  assumes "\<alpha> \<in> {0..(1::real)}"
  assumes rpr: "rational_preference (lotteries_on outcomes) \<R>"
    and ind: "independent_vnm (lotteries_on outcomes) \<R>"
  shows "\<forall>r \<in> lotteries_on outcomes. (mix_pmf \<alpha> y r) \<succeq>[\<R>] (mix_pmf \<alpha> x r)"
proof
  fix r
  assume a: "r \<in> lotteries_on outcomes" (is "r \<in> ?lo")
  have clct: "y \<succeq>[\<R>] x \<and> independent_vnm ?lo \<R> \<and> y \<in> ?lo \<and> x \<in> ?lo \<and> r \<in> ?lo"
    by (meson  a assms(1) assms(2) atLeastAtMost_iff greaterThanAtMost_iff
        ind preference_def rational_preference_def rpr)
  then have in_lo: "mix_pmf \<alpha> y r \<in> ?lo" "(mix_pmf \<alpha> x r) \<in> ?lo"
    by (metis  assms(2) atLeastAtMost_iff greaterThanLessThan_iff
        less_eq_real_def mix_pmf_in_lotteries pmf_mix_0 pmf_mix_1 a)+
  have "0 = \<alpha> \<or> 0 < \<alpha>"
    using assms by auto
  then show "mix_pmf \<alpha> y r \<succeq>[\<R>] mix_pmf \<alpha> x r"
    using in_lo(2) rational_preference.compl rpr
    by (auto,blast) (meson assms(2) atLeastAtMost_iff clct
        greaterThanAtMost_iff independent_vnmD2)
qed

lemma approx_imp_approx_ind:
  assumes "x \<approx>[\<R>] y"
  assumes "\<alpha> \<in> {0..(1::real)}"
  assumes rpr: "rational_preference (lotteries_on outcomes) \<R>"
    and ind: "independent_vnm (lotteries_on outcomes) \<R>"
  shows "\<forall>r \<in> lotteries_on outcomes. (mix_pmf \<alpha> y r) \<approx>[\<R>] (mix_pmf \<alpha> x r)"
  using approx_indep_ge assms(1) assms(2) ind rpr by blast

lemma geq_imp_mix_geq_right:
  assumes "x \<succeq>[\<R>] y"
  assumes rpr: "rational_preference (lotteries_on outcomes) \<R>"
  assumes ind: "independent_vnm (lotteries_on outcomes) \<R>"
  assumes "\<alpha> \<in> {0..(1::real)}"
  shows "(mix_pmf \<alpha> x y) \<succeq>[\<R>] y"
proof -
  have xy_p: "x \<in> (lotteries_on outcomes)" "y \<in> (lotteries_on outcomes)"
    by (meson assms(1) preference.not_outside rational_preference_def rpr)
      (meson assms(1) preference_def rational_preference_def rpr)
  have "(mix_pmf \<alpha> x y) \<in> (lotteries_on outcomes)" (is "?mpf \<in> ?lot")
    using mix_pmf_in_lotteries [of x outcomes y \<alpha>] xy_p assms(2)
    by (meson approx_indep_ge assms(4) ind preference.not_outside
        rational_preference.compl rational_preference_def)
  have all: "\<forall>r \<in> ?lot. (mix_pmf \<alpha> x r) \<succeq>[\<R>] (mix_pmf \<alpha> y r)"
    by (metis assms assms(2) atLeastAtMost_iff greaterThanAtMost_iff independece_dest_alt
        less_eq_real_def pmf_mix_0 rational_preference.compl rpr ind xy_p)
  thus ?thesis
    by (metis all assms(4) set_pmf_mix_eq xy_p(2))
qed

lemma geq_imp_mix_geq_left:
  assumes "x \<succeq>[\<R>] y"
  assumes rpr: "rational_preference (lotteries_on outcomes) \<R>"
  assumes ind: "independent_vnm (lotteries_on outcomes) \<R>"
  assumes "\<alpha> \<in> {0..(1::real)}"
  shows "(mix_pmf \<alpha> y x) \<succeq>[\<R>] y"
proof -
  define \<beta> where
    b: "\<beta> = 1 - \<alpha>"
  have "\<beta> \<in> {0..1}"
    using assms(4) b by auto
  then have "mix_pmf \<beta> x y \<succeq>[\<R>] y"
    using geq_imp_mix_geq_right[OF assms] assms(1) geq_imp_mix_geq_right ind rpr by blast
  moreover have "mix_pmf \<beta> x y = mix_pmf \<alpha> y x"
    by (metis assms(4) b pmf_inverse_switch_eqals)
  ultimately show ?thesis
    by simp
qed

lemma sg_imp_mix_sg:
  assumes "x \<succ>[\<R>] y"
  assumes rpr: "rational_preference (lotteries_on outcomes) \<R>"
  assumes ind: "independent_vnm (lotteries_on outcomes) \<R>"
  assumes "\<alpha> \<in> {0<..(1::real)}"
  shows "(mix_pmf \<alpha> x y) \<succ>[\<R>] y"
proof -
  have xy_p: "x \<in> (lotteries_on outcomes)" "y \<in> (lotteries_on outcomes)"
    by (meson assms(1) preference.not_outside rational_preference_def rpr)
      (meson assms(1) preference_def rational_preference_def rpr)
  have "(mix_pmf \<alpha> x y) \<in> (lotteries_on outcomes)" (is "?mpf \<in> ?lot")
    using mix_pmf_in_lotteries [of x outcomes y \<alpha>] xy_p assms(2)
    using assms(4) by fastforce
  have all: "\<forall>r \<in> ?lot. (mix_pmf \<alpha> x r) \<succeq>[\<R>] (mix_pmf \<alpha> y r)"
    by (metis assms(1,3,4)  independece_dest_alt ind xy_p)
  have "(mix_pmf \<alpha> x y) \<succeq>[\<R>] y"
    by (metis all assms(4) atLeastAtMost_iff greaterThanAtMost_iff
        less_eq_real_def set_pmf_mix_eq xy_p(2))
  have all2: "\<forall>r \<in> ?lot. (mix_pmf \<alpha> x r) \<succ>[\<R>] (mix_pmf \<alpha> y r)"
    using assms(1) assms(4) ind independece_dest_alt xy_p(1) xy_p(2) by blast
  then show ?thesis
    by (metis assms(4) atLeastAtMost_iff greaterThanAtMost_iff
        less_eq_real_def set_pmf_mix_eq xy_p(2))
qed

subsection \<open> Continuity \<close>

text \<open> Continuity is sometimes called Archimedean Axiom\<close>
definition continuous_vnm
  where
    "continuous_vnm C P = (\<forall>p \<in> C. \<forall>q \<in> C. \<forall>r \<in> C. p \<succeq>[P] q \<and> q \<succeq>[P] r \<longrightarrow>
    (\<exists>\<alpha> \<in> {0..1}. (mix_pmf \<alpha> p r) \<approx>[P] q))"

lemma continuous_vnmD:
  assumes "continuous_vnm C P"
  shows "(\<forall>p \<in> C. \<forall>q \<in> C. \<forall>r \<in> C. p \<succeq>[P] q \<and> q \<succeq>[P] r \<longrightarrow>
    (\<exists>\<alpha> \<in> {0..1}. (mix_pmf \<alpha> p r) \<approx>[P] q))"
  using continuous_vnm_def assms by blast

lemma continuous_vnmI:
  assumes "\<And>p q r. p \<in> C \<Longrightarrow> q \<in> C \<Longrightarrow> r \<in> C \<Longrightarrow> p \<succeq>[P] q \<and> q \<succeq>[P] r \<Longrightarrow>
    \<exists>\<alpha> \<in> {0..1}. (mix_pmf \<alpha> p r) \<approx>[P] q"
  shows "continuous_vnm C P"
  by (simp add: assms continuous_vnm_def)

lemma mix_in_lot:
  assumes "x \<in> lotteries_on outcomes"
    and "y \<in> lotteries_on outcomes"
    and "\<alpha> \<in> {0..1}"
  shows "(mix_pmf \<alpha> x y) \<in> lotteries_on outcomes"
  using assms(1) assms(2) assms(3) less_eq_real_def mix_pmf_in_lotteries by fastforce

lemma non_unique_continuous_unfolding:
  assumes cnt: "continuous_vnm (lotteries_on outcomes) \<R>"
  assumes "rational_preference (lotteries_on outcomes) \<R>"
  assumes "p \<succeq>[\<R>] q"
    and "q \<succeq>[\<R>] r"
    and "p \<succ>[\<R>] r"
  shows "\<exists>\<alpha> \<in> {0..1}. q \<approx>[\<R>] mix_pmf \<alpha> p r"
  using assms(1) assms(2) cnt continuous_vnmD assms
proof -
  have "\<forall>p q. p\<in> (lotteries_on outcomes) \<and> q \<in> (lotteries_on outcomes) \<longleftrightarrow> p \<succeq>[\<R>] q \<or> q \<succeq>[\<R>] p"
    using assms rational_preference.compl[of "lotteries_on outcomes" \<R>]
    by (metis (no_types, hide_lams) preference_def rational_preference_def)
  then show ?thesis
    using continuous_vnmD[OF assms(1)] by (metis assms(3) assms(4))
qed

section \<open> System U start, as per vNM\<close>

text \<open> These are the first two assumptions which we use to derive the first results.
       We assume rationality and independence. In this system U the von-Neumann-Morgenstern
        Utility Theorem is proven. \<close>
context
  fixes outcomes :: "'a set"
  fixes \<R>
  assumes rpr: "rational_preference (lotteries_on outcomes) \<R>"
  assumes ind: "independent_vnm (lotteries_on outcomes) \<R>"
begin

abbreviation "\<P> \<equiv> lotteries_on outcomes"

lemma relation_in_carrier:
  "x \<succeq>[\<R>] y \<Longrightarrow> x \<in> \<P> \<and> y \<in> \<P>"
  by (meson preference_def rational_preference_def rpr)

lemma mix_pmf_preferred_independence:
  assumes "r \<in> \<P>"
    and "\<alpha> \<in> {0..1}"
  assumes "p \<succeq>[\<R>] q"
  shows "mix_pmf \<alpha> p r \<succeq>[\<R>] mix_pmf \<alpha> q r"
  using ind by (metis relation_in_carrier antisym_conv1 assms atLeastAtMost_iff
      greaterThanAtMost_iff independece_dest_alt pmf_mix_0
      rational_preference.no_better_thansubset_rel rpr subsetI)

lemma mix_pmf_preferred_independence_rev:
  assumes "p \<in> \<P>"
    and "q \<in> \<P>"
    and "r \<in> \<P>"
    and "\<alpha> \<in> {0<..1}"
  assumes "mix_pmf \<alpha> p r \<succeq>[\<R>] mix_pmf \<alpha> q r"
  shows "p \<succeq>[\<R>] q"
proof -
  have "mix_pmf \<alpha> p r \<in> \<P>"
    using assms mix_in_lot relation_in_carrier by blast
  moreover have "mix_pmf \<alpha> q r \<in> \<P>"
    using assms mix_in_lot assms(2) relation_in_carrier by blast
  ultimately show ?thesis
    using ind independent_vnmD3[of \<alpha> p \<P> q r \<R>] assms by blast
qed

lemma x_sg_y_sg_mpmf_right:
  assumes "x \<succ>[\<R>] y"
  assumes "b \<in> {0<..(1::real)}"
  shows "x \<succ>[\<R>] mix_pmf b y x"
proof -
  consider "b = 1" | "b \<noteq> 1"
    by blast
  then show ?thesis
  proof (cases)
    case 2
    have sg: "(mix_pmf b x y) \<succ>[\<R>] y"
      using assms(1) assms(2) assms ind rpr sg_imp_mix_sg "2" by fastforce
    have "mix_pmf b x y \<in> \<P>"
      by (meson sg preference_def rational_preference_def rpr)
    have "mix_pmf b x x \<in> \<P>"
      using relation_in_carrier assms(2) mix_in_lot assms by fastforce
    have "b \<in> {0<..<1}"
      using "2" assms(2)  by auto
    have "mix_pmf b x x \<succ>[\<R>] mix_pmf b y x"
      using mix_pmf_preferred_independence[of x b] assms
      by (meson \<open>b \<in> {0<..<1}\<close> greaterThanAtMost_iff greaterThanLessThan_iff ind
          independece_dest_alt less_eq_real_def preference_def
          rational_preference.axioms(1) relation_in_carrier rpr)
    then show ?thesis
      using mix_pmf_preferred_independence
      by (metis assms(2) atLeastAtMost_iff greaterThanAtMost_iff less_eq_real_def set_pmf_mix_eq)
  qed (simp add: assms(1))
qed

lemma neumann_3B_b:
  assumes "u \<succ>[\<R>] v"
  assumes "\<alpha> \<in> {0<..<1}"
  shows "u \<succ>[\<R>] mix_pmf \<alpha> u v"
proof -
  have *: "preorder_on \<P> \<R> \<and> rational_preference_axioms \<P> \<R>"
    by (metis (no_types) preference_def rational_preference_def rpr)
  have "1 - \<alpha> \<in> {0<..1}"
    using assms(2) by auto
  then show ?thesis
    using * assms by (metis atLeastAtMost_iff greaterThanLessThan_iff
        less_eq_real_def pmf_inverse_switch_eqals x_sg_y_sg_mpmf_right)
qed

lemma neumann_3B_b_non_strict:
  assumes "u \<succeq>[\<R>] v"
  assumes "\<alpha> \<in> {0..1}"
  shows "u \<succeq>[\<R>] mix_pmf \<alpha> u v"
proof -
  have f2: "mix_pmf \<alpha> (u::'a pmf) v = mix_pmf (1 - \<alpha>) v u"
    using pmf_inverse_switch_eqals assms(2) by auto
  have "1 - \<alpha> \<in> {0..1}"
    using assms(2) by force
  then show ?thesis
    using f2 relation_in_carrier
    by (metis (no_types) assms(1) mix_pmf_preferred_independence set_pmf_mix_eq)
qed

lemma greater_mix_pmf_greater_step_1_aux:
  assumes "v \<succ>[\<R>] u"
  assumes "\<alpha> \<in> {0<..<(1::real)}"
    and "\<beta> \<in> {0<..<(1::real)}"
  assumes "\<beta> > \<alpha>"
  shows "(mix_pmf \<beta> v u) \<succ>[\<R>] (mix_pmf \<alpha> v u)"
proof -
  define t where
    t: "t = mix_pmf \<beta> v u"
  obtain \<gamma> where
    g: "\<alpha> = \<beta> * \<gamma>"
    by (metis assms(2) assms(4) greaterThanLessThan_iff
        mult.commute nonzero_eq_divide_eq not_less_iff_gr_or_eq)
  have g1: "\<gamma> > 0 \<and> \<gamma> < 1"
    by (metis (full_types) assms(2) assms(4) g greaterThanLessThan_iff
        less_trans mult.right_neutral mult_less_cancel_left_pos not_le
        sgn_le_0_iff sgn_pos zero_le_one zero_le_sgn_iff zero_less_mult_iff)
  have t_in: "mix_pmf \<beta> v u \<in> \<P>"
    by (meson assms(1) assms(3) mix_pmf_in_lotteries preference_def rational_preference_def rpr)
  have "v \<succ>[\<R>] mix_pmf (1 - \<beta>) v u"
    using x_sg_y_sg_mpmf_right[of u v "1-\<beta>"] assms
    by (metis atLeastAtMost_iff greaterThanAtMost_iff greaterThanLessThan_iff
        less_eq_real_def pmf_inverse_switch_eqals x_sg_y_sg_mpmf_right)
  have "t \<succ>[\<R>] u"
    using assms(1) assms(3) ind rpr sg_imp_mix_sg t by fastforce
  hence t_s: "t \<succ>[\<R>] (mix_pmf \<gamma> t u)"
  proof -
    have "(mix_pmf \<gamma> t u) \<in> \<P>"
      by (metis assms(1) assms(3) atLeastAtMost_iff g1 mix_in_lot mix_pmf_in_lotteries
          not_less order.asym preference_def rational_preference_def rpr t)
    have "t \<succ>[\<R>] mix_pmf \<gamma> (mix_pmf \<beta> v u) u"
      using neumann_3B_b[of t u \<gamma>] assms t g1
      by (meson greaterThanAtMost_iff greaterThanLessThan_iff
          ind less_eq_real_def rpr sg_imp_mix_sg)
    thus ?thesis
      using t by blast
  qed
  from product_mix_pmf_prob_distrib[of _ \<beta> v u] assms
  have "mix_pmf \<beta> v u \<succ>[\<R>] mix_pmf \<alpha> v u"
    by (metis t_s atLeastAtMost_iff g g1 greaterThanLessThan_iff less_eq_real_def mult.commute t)
  then show ?thesis by blast
qed

section \<open> This lemma is in called step 1 in literature.
In Von Neumann and Morgenstern's book this is A:A (albeit more general) \<close>

lemma step_1_most_general:
  assumes "x \<succ>[\<R>] y"
  assumes "\<alpha> \<in> {0..(1::real)}"
    and "\<beta> \<in> {0..(1::real)}"
  assumes "\<alpha> > \<beta>"
  shows "(mix_pmf \<alpha> x y) \<succ>[\<R>] (mix_pmf \<beta> x y)"
proof -
  consider (ex) "\<alpha> = 1 \<and> \<beta> = 0" | (m) "\<alpha> \<noteq> 1 \<or> \<beta> \<noteq> 0"
    by blast
  then show ?thesis
  proof (cases)
    case m
    consider  "\<beta> = 0" |  "\<beta> \<noteq> 0"
      by blast
    then show ?thesis
    proof (cases)
      case 1
      then show ?thesis
        using assms(1) assms(2) assms(4) ind rpr sg_imp_mix_sg by fastforce
    next
      case 2
      let ?d = "(\<beta>/\<alpha>)"
      have sg: "(mix_pmf \<alpha> x y) \<succ>[\<R>] y"
        using assms(1) assms(2) assms(3) assms(4) ind rpr sg_imp_mix_sg by fastforce
      have a: "\<alpha> > 0"
        using assms(3) assms(4) by auto
      then have div_in: "?d \<in> {0<..1}"
        using assms(3) assms(4) 2 by auto
      have mx_p: "(mix_pmf \<alpha> x y) \<in> \<P>"
        by (meson sg preference_def rational_preference_def rpr)
      have y_P: "y \<in> \<P>"
        by (meson assms(1) preference_def rational_preference_def rpr)
      hence "(mix_pmf ?d (mix_pmf \<alpha> x y) y) \<in> \<P>"
        using div_in mx_p by (simp add: mix_in_lot)
      have " mix_pmf \<beta> (mix_pmf \<alpha> x y) y \<succ>[\<R>] y"
        using sg_imp_mix_sg[of "(mix_pmf \<alpha> x y)" y \<R> outcomes \<beta>] sg div_in rpr ind
          a assms(2) "2" assms(3) by auto
      have al1: "\<forall>r \<in> \<P>. (mix_pmf \<alpha> x r) \<succ>[\<R>] (mix_pmf \<alpha> y r)"
        by (meson a assms(1) assms(2) atLeastAtMost_iff greaterThanAtMost_iff ind
            independece_dest_alt preference.not_outside rational_preference_def rpr y_P)
      then show ?thesis
        using greater_mix_pmf_greater_step_1_aux assms
        by (metis a div_in divide_less_eq_1_pos greaterThanAtMost_iff
            greaterThanLessThan_iff mix_pmf_comp_with_dif_equiv neumann_3B_b sg)
    qed
  qed (simp add: assms(1))
qed

text \<open> Kreps refers to this lemma as 5.6 c.
       The lemma after that is also significant.\<close>
lemma approx_remains_after_same_comp:
  assumes "p \<approx>[\<R>] q"
    and "r \<in> \<P>"
    and "\<alpha> \<in> {0..1}"
  shows "mix_pmf \<alpha> p r \<approx>[\<R>] mix_pmf \<alpha> q r"
  using approx_indep_ge assms(1) assms(2) assms(3) ind rpr by blast

text \<open> This lemma is the symmetric version of the previous lemma.
       This lemma is never mentioned in literature anywhere.
       Even though it looks trivial now, due to the asymmetric nature of the
       independence axiom, it is not so trivial, and definitely worth mentioning. \<close>
lemma approx_remains_after_same_comp_left:
  assumes "p \<approx>[\<R>] q"
    and "r \<in> \<P>"
    and "\<alpha> \<in> {0..1}"
  shows "mix_pmf \<alpha> r p \<approx>[\<R>] mix_pmf \<alpha> r q"
proof -
  have 1: "\<alpha> \<le> 1 \<and> \<alpha> \<ge> 0" "1 - \<alpha> \<in> {0..1}"
    using assms(3) by auto+
  have fst: "mix_pmf \<alpha> r p \<approx>[\<R>] mix_pmf (1-\<alpha>) p r"
    using assms  by (metis mix_in_lot pmf_inverse_switch_eqals
    rational_preference.compl relation_in_carrier rpr)
  moreover have "mix_pmf \<alpha> r p \<approx>[\<R>] mix_pmf \<alpha> r q"
    using approx_remains_after_same_comp[of _ _ _ \<alpha>] pmf_inverse_switch_eqals[of \<alpha> p q] 1
      pmf_inverse_switch_eqals rpr mix_pmf_preferred_independence[of _ \<alpha> _ _]
    by (metis assms(1) assms(2) assms(3) mix_pmf_preferred_independence)
  thus ?thesis
    by blast
qed

lemma mix_of_preferred_is_preferred:
  assumes "p \<succeq>[\<R>] w"
  assumes "q \<succeq>[\<R>] w"
  assumes "\<alpha> \<in> {0..1}"
  shows "mix_pmf \<alpha> p q \<succeq>[\<R>] w"
proof -
  consider "p \<succeq>[\<R>] q" | "q \<succeq>[\<R>] p"
    using rpr assms(1) assms(2) rational_preference.compl relation_in_carrier by blast
  then show ?thesis
  proof (cases)
    case 1
    have "mix_pmf \<alpha> p q \<succeq>[\<R>] q"
      using "1" assms(3) geq_imp_mix_geq_right ind rpr by blast
    moreover have "q \<succeq>[\<R>] w"
      using assms by auto
    ultimately show ?thesis using rpr preference.transitivity[of \<P> \<R>]
      by (meson rational_preference_def transE)
  next
    case 2
    have "mix_pmf \<alpha> p q \<succeq>[\<R>] p"
      using "2" assms geq_imp_mix_geq_left ind rpr by blast
    moreover have "p \<succeq>[\<R>] w"
      using assms by auto
    ultimately show ?thesis using rpr preference.transitivity[of \<P> \<R>]
      by (meson rational_preference_def transE)
  qed
qed

lemma mix_of_not_preferred_is_not_preferred:
  assumes "w \<succeq>[\<R>] p"
  assumes "w \<succeq>[\<R>] q"
  assumes "\<alpha> \<in> {0..1}"
  shows "w \<succeq>[\<R>] mix_pmf \<alpha> p q"
proof -
  consider "p \<succeq>[\<R>] q" | "q \<succeq>[\<R>] p"
    using rpr assms(1) assms(2) rational_preference.compl relation_in_carrier by blast
  then show ?thesis
  proof (cases)
    case 1
    moreover have "p \<succeq>[\<R>] mix_pmf \<alpha> p q"
      using assms(3) neumann_3B_b_non_strict calculation by blast
    moreover show ?thesis
      using rpr preference.transitivity[of \<P> \<R>]
      by (meson assms(1) calculation(2) rational_preference_def transE)
  next
    case 2
    moreover have "q \<succeq>[\<R>] mix_pmf \<alpha> p q"
      using assms(3) neumann_3B_b_non_strict calculation
      by (metis mix_pmf_preferred_independence relation_in_carrier set_pmf_mix_eq)
    moreover show ?thesis
      using rpr preference.transitivity[of \<P> \<R>]
      by (meson assms(2) calculation(2) rational_preference_def transE)
  qed
qed

private definition degenerate_lotteries where
  "degenerate_lotteries = {x \<in> \<P>. card (set_pmf x) = 1}"

private definition best where
  "best = {x \<in> \<P>. (\<forall>y \<in> \<P>. x \<succeq>[\<R>] y)}"

private definition worst where
  "worst = {x \<in> \<P>. (\<forall>y \<in> \<P>. y \<succeq>[\<R>] x)}"

lemma degenerate_total:
  "\<forall>e \<in> degenerate_lotteries. \<forall>m \<in> \<P>. e \<succeq>[\<R>] m \<or> m \<succeq>[\<R>] e"
  using degenerate_lotteries_def rational_preference.compl rpr by fastforce

lemma degen_outcome_cardinalities:
  "card degenerate_lotteries = card outcomes"
  using card_degen_lotteries_equals_outcomes degenerate_lotteries_def by auto

lemma degenerate_lots_subset_all: "degenerate_lotteries \<subseteq> \<P>"
  by (simp add: degenerate_lotteries_def)

lemma alt_definition_of_degenerate_lotteries[iff]:
  "{return_pmf x |x. x\<in> outcomes} = degenerate_lotteries"
proof (standard, goal_cases)
  case 1
  have "\<forall>x \<in> {return_pmf x |x. x \<in> outcomes}. x \<in> degenerate_lotteries"
  proof
    fix x
    assume a: "x \<in> {return_pmf x |x. x \<in> outcomes}"
    then have "card (set_pmf x) = 1"
      by auto
    moreover have "set_pmf x \<subseteq> outcomes"
      using a set_pmf_subset_singleton by auto
    moreover have "x \<in> \<P>"
      by (simp add: lotteries_on_def calculation)
    ultimately show "x \<in> degenerate_lotteries"
      by (simp add: degenerate_lotteries_def)
  qed
  then show ?case by blast
next
  case 2
  have "\<forall>x \<in> degenerate_lotteries. x \<in> {return_pmf x |x. x \<in> outcomes}"
  proof
    fix x
    assume a: "x \<in> degenerate_lotteries"
    hence "card (set_pmf x) = 1"
      using degenerate_lotteries_def by blast
    moreover have "set_pmf x \<subseteq> outcomes"
      by (meson a degenerate_lots_subset_all subset_iff support_in_outcomes)
    moreover obtain e where "{e} = set_pmf x"
      using calculation
      by (metis card_1_singletonE)
    moreover have "e \<in> outcomes"
      using calculation(2) calculation(3) by blast
    moreover have "x = return_pmf e"
      using calculation(3) set_pmf_subset_singleton by fastforce
    ultimately show "x \<in> {return_pmf x |x. x \<in> outcomes}"
      by blast
  qed
  then show ?case by blast
qed

lemma best_indifferent:
  "\<forall>x \<in> best. \<forall>y \<in> best. x \<approx>[\<R>] y"
  by (simp add: best_def)

lemma worst_indifferent:
  "\<forall>x \<in> worst. \<forall>y \<in> worst. x \<approx>[\<R>] y"
  by (simp add: worst_def)

lemma best_worst_indiff_all_indiff:
  assumes "b \<in> best"
    and "w \<in> worst"
    and "b \<approx>[\<R>] w"
  shows "\<forall>e \<in> \<P>. e \<approx>[\<R>] w" "\<forall>e \<in> \<P>. e \<approx>[\<R>] b"
proof -
  show "\<forall>e \<in> \<P>. e \<approx>[\<R>] w"
  proof (standard)
    fix e
    assume a: "e \<in> \<P>"
    then have "b \<succeq>[\<R>] e"
      using a best_def assms  by blast
    moreover have "e \<succeq>[\<R>] w"
      using a assms worst_def by auto
    moreover have "b \<succeq>[\<R>] e"
      by (simp add: calculation(1))
    moreover show "e \<approx>[\<R>] w"
    proof (rule ccontr)
      assume "\<not> e \<approx>[\<R>] w"
      then consider "e \<succ>[\<R>] w" | "w \<succ>[\<R>] e"
        by (simp add: calculation(2))
      then show False
      proof (cases)
        case 2
        then show ?thesis
          using calculation(2) by blast
      qed (meson assms(3) calculation(1)
          rational_preference.strict_is_neg_transitive relation_in_carrier rpr)
    qed
  qed
  then show "\<forall>e\<in>local.\<P>. e \<approx>[\<R>] b"
    using assms  by (meson rational_preference.compl
        rational_preference.strict_is_neg_transitive relation_in_carrier rpr)
qed

text \<open> Like Step 1 most general but with IFF. \<close>
lemma mix_pmf_pref_iff_more_likely [iff]:
  assumes "b \<succ>[\<R>] w"
  assumes "\<alpha> \<in> {0..1}"
    and "\<beta> \<in> {0..1}"
  shows "\<alpha> > \<beta> \<longleftrightarrow> mix_pmf \<alpha> b w \<succ>[\<R>] mix_pmf \<beta> b w" (is "?L \<longleftrightarrow> ?R")
  using assms step_1_most_general[of b w \<alpha> \<beta>]
  by (metis linorder_neqE_linordered_idom step_1_most_general)

lemma better_worse_good_mix_preferred[iff]:
  assumes "b \<succeq>[\<R>] w"
  assumes "\<alpha> \<in> {0..1}"
    and "\<beta> \<in> {0..1}"
  assumes "\<alpha> \<ge> \<beta>"
  shows "mix_pmf \<alpha> b w \<succeq>[\<R>] mix_pmf \<beta> b w"
proof-
  have "(0::real) \<le> 1"
    by simp
  then show ?thesis
    by (metis (no_types) assms assms(1) assms(2) assms(3) atLeastAtMost_iff
        less_eq_real_def mix_of_not_preferred_is_not_preferred
        mix_of_preferred_is_preferred mix_pmf_preferred_independence
        pmf_mix_0 relation_in_carrier step_1_most_general)
qed

subsection \<open> Add finiteness and non emptyness of outcomes \<close>
context
  assumes fnt: "finite outcomes"
  assumes nempty: "outcomes \<noteq> {}"
begin

lemma finite_degenerate_lotteries:
  "finite degenerate_lotteries"
  using degen_outcome_cardinalities fnt nempty by fastforce

lemma degenerate_has_max_preferred:
  "{x \<in> degenerate_lotteries. (\<forall>y \<in> degenerate_lotteries. x \<succeq>[\<R>] y)} \<noteq> {}" (is "?l \<noteq> {}")
proof
  assume a: "?l = {}"
  let ?DG = "degenerate_lotteries"
  obtain R where
    R: "rational_preference ?DG R" "R \<subseteq> \<R>"
    using degenerate_lots_subset_all rational_preference.all_carrier_ex_sub_rel rpr by blast
  then have "\<exists>e \<in> ?DG. \<forall>e' \<in> ?DG. e \<succeq>[\<R>] e'"
    by (metis R(1) R(2) card_0_eq degen_outcome_cardinalities
        finite_degenerate_lotteries fnt nempty subset_eq
        rational_preference.finite_nonempty_carrier_has_maximum )
  then show False
    using a by auto
qed

lemma degenerate_has_min_preferred:
  "{x \<in> degenerate_lotteries. (\<forall>y \<in> degenerate_lotteries. y \<succeq>[\<R>] x)} \<noteq> {}" (is "?l \<noteq> {}")
proof
  assume a: "?l = {}"
  let ?DG = "degenerate_lotteries"
  obtain R where
    R: "rational_preference ?DG R" "R \<subseteq> \<R>"
    using degenerate_lots_subset_all rational_preference.all_carrier_ex_sub_rel rpr by blast
  have "\<exists>e \<in> ?DG. \<forall>e' \<in> ?DG. e' \<succeq>[\<R>] e"
    by (metis R(1) R(2) card_0_eq degen_outcome_cardinalities
        finite_degenerate_lotteries fnt nempty subset_eq
        rational_preference.finite_nonempty_carrier_has_minimum )
  then show False
    using a by auto
qed

lemma exists_best_degenerate:
  "\<exists>x \<in> degenerate_lotteries. \<forall>y \<in> degenerate_lotteries. x \<succeq>[\<R>] y"
  using degenerate_has_max_preferred by blast

lemma exists_worst_degenerate:
  "\<exists>x \<in> degenerate_lotteries. \<forall>y \<in> degenerate_lotteries. y \<succeq>[\<R>] x"
  using degenerate_has_min_preferred by blast

lemma best_degenerate_in_best_overall:
  "\<exists>x \<in> degenerate_lotteries. \<forall>y \<in> \<P>. x \<succeq>[\<R>] y"
proof -
  obtain b where
    b: "b \<in> degenerate_lotteries" "\<forall>y \<in> degenerate_lotteries. b \<succeq>[\<R>] y"
    using exists_best_degenerate by blast
  have asm: "finite outcomes" "set_pmf b \<subseteq> outcomes"
    by (simp add: fnt) (meson b(1) degenerate_lots_subset_all subset_iff support_in_outcomes)
  obtain B where B: "set_pmf b = {B}"
    using b card_1_singletonE degenerate_lotteries_def by blast
  have deg: "\<forall>d\<in>outcomes. b \<succeq>[\<R>] return_pmf d"
    using alt_definition_of_degenerate_lotteries b(2) by blast
  define P where
    "P = (\<lambda>p. p \<in> \<P> \<longrightarrow> return_pmf B \<succeq>[\<R>] p)"
  have "P p" for p
  proof -
    consider "set_pmf p \<subseteq> outcomes" | "\<not>set_pmf p \<subseteq> outcomes"
      by blast
    then show ?thesis
    proof (cases)
      case 1
      have "finite outcomes" "set_pmf p \<subseteq> outcomes"
        by (auto simp: 1 asm)
      then show ?thesis
      proof (induct  rule: pmf_mix_induct')
        case (degenerate x)
        then show ?case
          using B P_def deg set_pmf_subset_singleton by fastforce
      qed (simp add: P_def lotteries_on_def mix_of_not_preferred_is_not_preferred
               mix_of_not_preferred_is_not_preferred[of b p q a])
    qed  (simp add: lotteries_on_def P_def)
  qed
  moreover have "\<forall>e \<in> \<P>. b \<succeq>[\<R>] e"
    using calculation B P_def set_pmf_subset_singleton by fastforce
  ultimately show ?thesis
    using b degenerate_lots_subset_all by blast
qed

lemma worst_degenerate_in_worst_overall:
  "\<exists>x \<in> degenerate_lotteries. \<forall>y \<in> \<P>. y \<succeq>[\<R>] x"
proof -
  obtain b where
    b: "b \<in> degenerate_lotteries" "\<forall>y \<in> degenerate_lotteries. y \<succeq>[\<R>] b"
    using exists_worst_degenerate by blast
  have asm: "finite outcomes" "set_pmf b \<subseteq> outcomes"
    by (simp add: fnt) (meson b(1) degenerate_lots_subset_all subset_iff support_in_outcomes)
  obtain B where B: "set_pmf b = {B}"
    using b card_1_singletonE degenerate_lotteries_def by blast
  have deg: "\<forall>d\<in>outcomes. return_pmf d \<succeq>[\<R>] b"
    using alt_definition_of_degenerate_lotteries b(2) by blast
  define P where
    "P = (\<lambda>p. p \<in> \<P> \<longrightarrow> p \<succeq>[\<R>] return_pmf B)"
  have "P p" for p
  proof -
    consider "set_pmf p \<subseteq> outcomes" | "\<not>set_pmf p \<subseteq> outcomes"
      by blast
    then show ?thesis
    proof (cases)
      case 1
      have "finite outcomes" "set_pmf p \<subseteq> outcomes"
        by (auto simp: 1 asm)
      then show ?thesis
      proof (induct rule: pmf_mix_induct')
        case (degenerate x)
        then show ?case
          using B P_def deg set_pmf_subset_singleton by fastforce
      next
      qed (simp add: P_def lotteries_on_def mix_of_preferred_is_preferred
          mix_of_not_preferred_is_not_preferred[of b p])
    qed (simp add: lotteries_on_def P_def)
  qed
  moreover have "\<forall>e \<in> \<P>. e \<succeq>[\<R>] b"
    using calculation B P_def set_pmf_subset_singleton by fastforce
  ultimately show ?thesis
    using b degenerate_lots_subset_all by blast
qed

lemma overall_best_nonempty:
  "best \<noteq> {}"
  using best_def best_degenerate_in_best_overall degenerate_lots_subset_all by blast

lemma overall_worst_nonempty:
  "worst \<noteq> {}"
  using degenerate_lots_subset_all worst_def worst_degenerate_in_worst_overall by auto

lemma trans_approx:
  assumes "x\<approx>[\<R>] y"
    and " y \<approx>[\<R>] z"
  shows "x \<approx>[\<R>] z"
  using preference.indiff_trans[of \<P> \<R> x y z] assms rpr rational_preference_def by blast

text \<open> First EXPLICIT use of the axiom of choice \<close>

private definition some_best where
  "some_best = (SOME x. x \<in> degenerate_lotteries \<and> x \<in> best)"

private definition some_worst where
  "some_worst = (SOME x. x \<in> degenerate_lotteries \<and> x \<in> worst)"

private definition my_U :: "'a pmf \<Rightarrow> real"
  where
    "my_U p = (SOME \<alpha>. \<alpha>\<in>{0..1} \<and> p \<approx>[\<R>] mix_pmf \<alpha> some_best some_worst)"

lemma exists_best_and_degenerate: "degenerate_lotteries \<inter> best \<noteq> {}"
  using best_def best_degenerate_in_best_overall degenerate_lots_subset_all by blast

lemma exists_worst_and_degenerate: "degenerate_lotteries \<inter> worst \<noteq> {}"
  using worst_def worst_degenerate_in_worst_overall degenerate_lots_subset_all by blast

lemma some_best_in_best: "some_best \<in> best"
  using exists_best_and_degenerate some_best_def
  by (metis (mono_tags, lifting) Int_emptyI some_eq_ex)

lemma some_worst_in_worst: "some_worst \<in> worst"
  using exists_worst_and_degenerate some_worst_def
  by (metis (mono_tags, lifting) Int_emptyI some_eq_ex)

lemma best_always_at_least_as_good_mix:
  assumes "\<alpha> \<in> {0..1}"
    and "p \<in> \<P>"
  shows "mix_pmf \<alpha> some_best p \<succeq>[\<R>] p"
  using assms(1) assms(2) best_def mix_of_preferred_is_preferred
    rational_preference.compl rpr some_best_in_best by fastforce

lemma geq_mix_imp_weak_pref:
  assumes "\<alpha> \<in> {0..1}"
    and "\<beta> \<in> {0..1}"
  assumes "\<alpha> \<ge> \<beta>"
  shows "mix_pmf \<alpha> some_best some_worst \<succeq>[\<R>] mix_pmf \<beta> some_best some_worst"
  using assms(1) assms(2) assms(3) best_def some_best_in_best some_worst_in_worst worst_def by auto

lemma gamma_inverse:
  assumes "\<alpha> \<in> {0<..<1}"
    and "\<beta> \<in> {0<..<1}"
  shows "(1::real) - (\<alpha> - \<beta>) / (1 - \<beta>) = (1 - \<alpha>) / (1 - \<beta>)"
proof -
  have "1 - (\<alpha> - \<beta>) / (1 - \<beta>) =  (1 - \<beta>)/(1 - \<beta>) - (\<alpha> - \<beta>) / (1 - \<beta>)"
    using assms(2) by auto
  also have "... = (1 - \<beta> - (\<alpha> - \<beta>)) / (1 - \<beta>)"
    by (metis diff_divide_distrib)
  also have "... = (1 - \<alpha>) / (1 - \<beta>)"
    by simp
  finally show ?thesis .
qed

lemma all_mix_pmf_indiff_indiff_best_worst:
  assumes "l \<in> \<P>"
  assumes "b \<in> best"
  assumes "w \<in> worst"
  assumes "b \<approx>[\<R>] w"
  shows "\<forall>\<alpha> \<in>{0..1}. l \<approx>[\<R>] mix_pmf \<alpha> b w"
  by (meson assms best_worst_indiff_all_indiff(1) mix_of_preferred_is_preferred
      best_worst_indiff_all_indiff(2) mix_of_not_preferred_is_not_preferred)

lemma indiff_imp_same_utility_value:
  assumes "some_best \<succ>[\<R>] some_worst"
  assumes "\<alpha> \<in> {0..1}"
  assumes "\<beta> \<in> {0..1}"
  assumes "mix_pmf \<beta> some_best some_worst \<approx>[\<R>] mix_pmf \<alpha> some_best some_worst"
  shows "\<beta> = \<alpha>"
  using assms(1) assms(2) assms(3) assms(4) linorder_neqE_linordered_idom by blast

lemma leq_mix_imp_weak_inferior:
  assumes "some_best \<succ>[\<R>] some_worst"
  assumes "\<alpha> \<in> {0..1}"
    and "\<beta> \<in> {0..1}"
  assumes "mix_pmf \<beta> some_best some_worst \<succeq>[\<R>] mix_pmf \<alpha> some_best some_worst"
  shows "\<beta> \<ge> \<alpha>"
proof -
  have *: "mix_pmf \<beta> some_best some_worst \<approx>[\<R>] mix_pmf \<alpha> some_best some_worst \<Longrightarrow> \<alpha> \<le> \<beta>"
    using assms(1) assms(2) assms(3) indiff_imp_same_utility_value by blast
  consider "mix_pmf \<beta> some_best some_worst \<succ>[\<R>] mix_pmf \<alpha> some_best some_worst" |
    "mix_pmf \<beta> some_best some_worst \<approx>[\<R>] mix_pmf \<alpha> some_best some_worst"
    using assms(4) by blast
  then show ?thesis
    by(cases) (meson assms(2) assms(3) geq_mix_imp_weak_pref le_cases *)+
qed

lemma ge_mix_pmf_preferred:
  assumes "x \<succ>[\<R>] y"
  assumes "\<alpha> \<in> {0..1}"
    and "\<beta> \<in> {0..1}"
  assumes "\<alpha> \<ge> \<beta>"
  shows "(mix_pmf \<alpha> x y) \<succeq>[\<R>] (mix_pmf \<beta> x y)"
  using assms(1) assms(2) assms(3) assms(4) by blast

subsection \<open> Add continuity to assumptions \<close>
context
  assumes cnt: "continuous_vnm (lotteries_on outcomes) \<R>"
begin

text \<open> In Literature this is referred to as step 2. \<close>
lemma step_2_unique_continuous_unfolding:
  assumes "p \<succeq>[\<R>] q"
    and "q \<succeq>[\<R>] r"
    and "p \<succ>[\<R>] r"
  shows "\<exists>!\<alpha> \<in> {0..1}. q \<approx>[\<R>] mix_pmf \<alpha> p r"
proof (rule ccontr)
  assume neg_a: "\<nexists>!\<alpha>. \<alpha> \<in> {0..1} \<and> q \<approx>[\<R>] mix_pmf \<alpha> p r"
  have "\<exists>\<alpha> \<in> {0..1}. q \<approx>[\<R>] mix_pmf \<alpha> p r"
    using non_unique_continuous_unfolding[of outcomes \<R> p q r]
      assms cnt rpr by blast
  then obtain \<alpha> \<beta> :: real where
    a_b: "\<alpha>\<in>{0..1}" "\<beta> \<in>{0..1}" "q \<approx>[\<R>] mix_pmf \<alpha> p r" "q \<approx>[\<R>] mix_pmf \<beta> p r" "\<alpha> \<noteq> \<beta>"
    using neg_a by blast
  consider "\<alpha> > \<beta>" | "\<beta> > \<alpha>"
    using a_b by linarith
  then show False
  proof (cases)
    case 1
    with step_1_most_general[of p r \<alpha> \<beta>] assms
    have "mix_pmf \<alpha> p r \<succ>[\<R>] mix_pmf \<beta> p r"
      using a_b(1) a_b(2) by blast
    then show ?thesis using a_b
      by (meson rational_preference.strict_is_neg_transitive relation_in_carrier rpr)
  next
    case 2
    with step_1_most_general[of p r \<beta> \<alpha>] assms have "mix_pmf \<beta> p r \<succ>[\<R>]mix_pmf \<alpha> p r"
      using a_b(1) a_b(2) by blast
    then show ?thesis using a_b
      by (meson rational_preference.strict_is_neg_transitive relation_in_carrier rpr)
  qed
qed

text \<open> These folowing two lemmas are referred to sometimes called step 2. \<close>
lemma create_unique_indiff_using_distinct_best_worst:
  assumes "l \<in> \<P>"
  assumes "b \<in> best"
  assumes "w \<in> worst"
  assumes "b \<succ>[\<R>] w"
  shows "\<exists>!\<alpha> \<in>{0..1}. l \<approx>[\<R>] mix_pmf \<alpha> b w"
proof -
  have "b \<succeq>[\<R>] l"
    using best_def
    using assms by blast
  moreover have "l \<succeq>[\<R>] w"
    using worst_def assms by blast
  ultimately show "\<exists>!\<alpha>\<in>{0..1}. l \<approx>[\<R>] mix_pmf \<alpha> b w"
    using step_2_unique_continuous_unfolding[of b l w] assms by linarith
qed

lemma exists_element_bw_mix_is_approx:
  assumes "l \<in> \<P>"
  assumes "b \<in> best"
  assumes "w \<in> worst"
  shows "\<exists>\<alpha> \<in>{0..1}. l \<approx>[\<R>] mix_pmf \<alpha> b w"
proof -
  consider "b \<succ>[\<R>] w" | "b \<approx>[\<R>] w"
    using assms(2) assms(3) best_def worst_def by auto
  then show ?thesis
  proof (cases)
    case 1
    then show ?thesis
      using create_unique_indiff_using_distinct_best_worst assms by blast
  qed (auto simp: all_mix_pmf_indiff_indiff_best_worst assms)
qed

lemma my_U_is_defined:
  assumes "p \<in> \<P>"
  shows "my_U p \<in> {0..1}" "p \<approx>[\<R>] mix_pmf (my_U p) some_best some_worst"
proof -
  have "some_best \<in> best"
    by (simp add: some_best_in_best)
  moreover have "some_worst \<in> worst"
    by (simp add: some_worst_in_worst)
  with exists_element_bw_mix_is_approx[of p "some_best" "some_worst"] calculation assms
  have e: "\<exists>\<alpha>\<in>{0..1}. p \<approx>[\<R>] mix_pmf \<alpha> some_best some_worst" by blast
  then show "my_U p \<in> {0..1}"
    by (metis (mono_tags, lifting) my_U_def someI_ex)
  show "p \<approx>[\<R>] mix_pmf (my_U p) some_best some_worst"
    by (metis (mono_tags, lifting) e my_U_def someI_ex)
qed

lemma weak_pref_mix_with_my_U_weak_pref:
  assumes "p \<succeq>[\<R>] q"
  shows "mix_pmf (my_U p) some_best some_worst \<succeq>[\<R>] mix_pmf (my_U q) some_best some_worst"
  by (meson assms my_U_is_defined(2) relation_in_carrier rpr
      rational_preference.weak_is_transitive)

lemma preferred_greater_my_U:
  assumes "p \<in> \<P>"
    and "q \<in> \<P>"
  assumes "mix_pmf (my_U p) some_best some_worst \<succ>[\<R>] mix_pmf (my_U q) some_best some_worst"
  shows "my_U p > my_U q"
proof (rule ccontr)
  assume "\<not> my_U p > my_U q"
  then consider "my_U p = my_U q" | "my_U p < my_U q"
    by linarith
  then show False
  proof (cases)
    case 1
    then have "mix_pmf (my_U p) some_best some_worst \<approx>[\<R>] mix_pmf (my_U q) some_best some_worst"
      using assms by auto
    then show ?thesis using assms by blast
  next
    case 2
    moreover have "my_U q \<in> {0..1}"
      using assms(2) my_U_is_defined(1) by blast
    moreover have "my_U p \<in> {0..1}"
      using assms(1) my_U_is_defined(1) by blast
    moreover have "mix_pmf (my_U q) some_best some_worst \<succeq>[\<R>] mix_pmf (my_U p) some_best some_worst"
      using calculation geq_mix_imp_weak_pref by auto
    then show ?thesis using assms by blast
  qed
qed

lemma geq_my_U_imp_weak_preference:
  assumes "p \<in> \<P>"
    and "q \<in> \<P>"
  assumes "some_best \<succ>[\<R>] some_worst"
  assumes "my_U p \<ge> my_U q"
  shows "p \<succeq>[\<R>] q"
proof -
  have p_q: "my_U p \<in> {0..1}" "my_U q \<in> {0..1}"
    using assms my_U_is_defined(1) by blast+
  with ge_mix_pmf_preferred[of "some_best" "some_worst" "my_U p" "my_U q"]
    p_q assms(1) assms(3) assms(4)
  have "mix_pmf (my_U p) some_best some_worst \<succeq>[\<R>] mix_pmf (my_U q) some_best some_worst"  by blast
  consider "my_U p = my_U q" | "my_U p > my_U q"
    using assms by linarith
  then show ?thesis
  proof (cases)
    case 2
    then show ?thesis
      by (meson assms(1) assms(2) assms(3) p_q(1) p_q(2) rational_preference.compl
          rpr step_1_most_general weak_pref_mix_with_my_U_weak_pref)
  qed (metis assms(1) assms(2) my_U_is_defined(2) trans_approx)
qed

lemma my_U_represents_pref:
  assumes "some_best \<succ>[\<R>] some_worst"
  assumes "p \<in> \<P>"
    and "q \<in> \<P>"
  shows "p \<succeq>[\<R>] q \<longleftrightarrow> my_U p \<ge> my_U q" (is "?L \<longleftrightarrow> ?R")
proof -
  have p_def: "my_U p\<in> {0..1}" "my_U q \<in> {0..1}"
    using assms my_U_is_defined by blast+
  show ?thesis
  proof
    assume a: ?L
    hence "mix_pmf (my_U p) some_best some_worst \<succeq>[\<R>] mix_pmf (my_U q) some_best some_worst"
      using weak_pref_mix_with_my_U_weak_pref by auto
    then show ?R using leq_mix_imp_weak_inferior[of "my_U p" "my_U q"] p_def a
        assms(1) leq_mix_imp_weak_inferior by blast
  next
    assume ?R
    then show ?L using geq_my_U_imp_weak_preference
      using assms(1) assms(2) assms(3) by blast
  qed
qed

lemma first_iff_u_greater_strict_preff:
  assumes "p \<in> \<P>"
    and "q \<in> \<P>"
  assumes "some_best \<succ>[\<R>] some_worst"
  shows "my_U p > my_U q \<longleftrightarrow> mix_pmf (my_U p) some_best some_worst \<succ>[\<R>] mix_pmf (my_U q) some_best some_worst"
proof
  assume a: "my_U p > my_U q"
  have "my_U p \<in> {0..1}" "my_U q \<in> {0..1}"
    using assms my_U_is_defined(1) by blast+
  then show "mix_pmf (my_U p) some_best some_worst \<succ>[\<R>] mix_pmf (my_U q) some_best some_worst"
    using a assms(3) by blast
next
  assume a: "mix_pmf (my_U p) some_best some_worst \<succ>[\<R>] mix_pmf (my_U q) some_best some_worst"
  have "my_U p \<in> {0..1}" "my_U q \<in> {0..1}"
    using assms my_U_is_defined(1) by blast+
  then show "my_U p > my_U q "
    using preferred_greater_my_U[of p q] assms a by blast
qed

lemma second_iff_calib_mix_pref_strict_pref:
  assumes "p \<in> \<P>"
    and "q \<in> \<P>"
  assumes "some_best \<succ>[\<R>] some_worst"
  shows "mix_pmf (my_U p) some_best some_worst \<succ>[\<R>] mix_pmf (my_U q) some_best some_worst \<longleftrightarrow> p \<succ>[\<R>] q"
proof
  assume a: "mix_pmf (my_U p) some_best some_worst \<succ>[\<R>] mix_pmf (my_U q) some_best some_worst"
  have "my_U p \<in> {0..1}" "my_U q \<in> {0..1}"
    using assms my_U_is_defined(1) by blast+
  then show "p \<succ>[\<R>] q"
    using a assms(3) assms(1) assms(2) geq_my_U_imp_weak_preference
      leq_mix_imp_weak_inferior weak_pref_mix_with_my_U_weak_pref by blast
next
  assume a: "p \<succ>[\<R>] q"
  have "my_U p \<in> {0..1}" "my_U q \<in> {0..1}"
    using assms my_U_is_defined(1) by blast+
  then show "mix_pmf (my_U p) some_best some_worst \<succ>[\<R>] mix_pmf (my_U q) some_best some_worst"
    using a assms(1) assms(2) assms(3) leq_mix_imp_weak_inferior my_U_represents_pref by blast
qed

lemma my_U_is_linear_function:
  assumes "p \<in> \<P>"
    and "q \<in> \<P>"
    and "\<alpha> \<in> {0..1}"
  assumes "some_best \<succ>[\<R>] some_worst"
  shows "my_U (mix_pmf \<alpha> p q) = \<alpha> * my_U p + (1 - \<alpha>) * my_U q"
proof -
  define B where B: "B = some_best"
  define W where W:"W = some_worst"
  define Up where Up: "Up = my_U p"
  define Uq where Uq: "Uq = my_U q"
  have long_in: "(\<alpha> * Up + (1 - \<alpha>) * Uq) \<in> {0..1}"
  proof -
    have "Up \<in> {0..1}"
      using assms Up my_U_is_defined(1) by blast
    moreover have "Uq \<in> {0..1}"
      using assms Uq my_U_is_defined(1) by blast
    moreover have "\<alpha> * Up \<in> {0..1}"
      using \<open>Up \<in> {0..1}\<close> assms(3) mult_le_one by auto
    moreover have "1-\<alpha> \<in> {0..1}"
      using assms(3) by auto
    moreover  have "(1 - \<alpha>) * Uq \<in> {0..1}"
      using mult_le_one[of "1-\<alpha>" Uq] calculation(2) calculation(4) by auto
    ultimately show ?thesis
      using add_nonneg_nonneg[of "\<alpha> * Up" "(1 - \<alpha>) * Uq"]
        convex_bound_le[of Up 1 Uq \<alpha> "1-\<alpha>"] by simp
  qed
  have fst: "p \<approx>[\<R>] (mix_pmf Up B W)"
    using assms my_U_is_defined[of p] B W Up by simp
  have snd: "q \<approx>[\<R>] (mix_pmf Uq B W)"
    using assms my_U_is_defined[of q] B W Uq by simp
  have mp_in: "(mix_pmf Up B W) \<in> \<P>"
    using fst relation_in_carrier by blast
  have f2: "mix_pmf \<alpha> p q \<approx>[\<R>] mix_pmf \<alpha> (mix_pmf Up B W) q"
    using fst assms(2) assms(3) mix_pmf_preferred_independence by blast
  have **: "mix_pmf \<alpha> (mix_pmf Up B W) (mix_pmf Uq B W) =
            mix_pmf (\<alpha> * Up + (1-\<alpha>) * Uq) B W" (is "?L = ?R")
  proof -
    let ?mixPQ = "(mix_pmf (\<alpha> * Up + (1 - \<alpha>) * Uq) B W)"
    have "\<forall>e\<in>set_pmf ?L. pmf (?L) e = pmf ?mixPQ e"
    proof
      fix e
      assume asm: "e \<in> set_pmf ?L"
      have i1: "pmf (?L) e = \<alpha> * pmf (mix_pmf Up B W) e +
        pmf (mix_pmf Uq B W) e - \<alpha> * pmf (mix_pmf Uq B W) e"
        using pmf_mix_deeper[of \<alpha> "mix_pmf Up B W" "(mix_pmf Uq B W)" e] assms(3) by blast
      have i3: "... = \<alpha> * Up * pmf B e + \<alpha> * pmf W e - \<alpha> * Up * pmf W e + Uq * pmf B e +
        pmf W e - Uq * pmf W e - \<alpha> * Uq * pmf B e - \<alpha> * pmf W e + \<alpha> * Uq * pmf W e"
        using left_diff_distrib' pmf_mix_deeper[of Up B W e] pmf_mix_deeper[of Uq B W e]
          assms Up Uq my_U_is_defined(1) by (simp add: distrib_left right_diff_distrib)
      have j4: "pmf ?mixPQ e = (\<alpha> * Up + (1 - \<alpha>) * Uq) * pmf B e +
        pmf W e - (\<alpha> * Up + (1 - \<alpha>) * Uq) * pmf W e"
        using pmf_mix_deeper[of "(\<alpha> * Up + (1 - \<alpha>) * Uq)" B W e] long_in by blast
      then show "pmf (?L) e = pmf ?mixPQ e"
        by (simp add: i1 i3 mult.commute right_diff_distrib' ring_class.ring_distribs(1))
    qed
    then show ?thesis using pmf_equiv_intro1 by blast
  qed
  have "mix_pmf \<alpha> (mix_pmf Up B W) q \<approx>[\<R>] ?L"
    using approx_remains_after_same_comp_left assms(3) mp_in snd by blast
  hence *: "mix_pmf \<alpha> p q \<approx>[\<R>] mix_pmf \<alpha> (mix_pmf (my_U p) B W) (mix_pmf (my_U q) B W)"
    using Up Uq f2 trans_approx by blast
  have "mix_pmf \<alpha> (mix_pmf (my_U p) B W) (mix_pmf (my_U q) B W) = ?R"
    using Up Uq ** by blast
  hence "my_U (mix_pmf \<alpha> p q) = \<alpha> * Up + (1-\<alpha>) * Uq"
    by (metis * B W assms(4) indiff_imp_same_utility_value long_in
        my_U_is_defined(1) my_U_is_defined(2) my_U_represents_pref relation_in_carrier)
  then show ?thesis
    using Up Uq by blast
qed

text \<open> Now we define a more general Utility
       function that also takes the degenerate case into account \<close>
private definition general_U
  where
    "general_U p = (if some_best \<approx>[\<R>] some_worst then 1 else my_U p)"

lemma general_U_is_linear_function:
  assumes "p \<in> \<P>"
    and "q \<in> \<P>"
    and "\<alpha> \<in> {0..1}"
  shows "general_U (mix_pmf \<alpha> p q) = \<alpha> * (general_U p) + (1 - \<alpha>) * (general_U q)"
proof -
  consider "some_best \<succ>[\<R>] some_worst" | "some_best \<approx>[\<R>] some_worst"
    using best_def some_best_in_best some_worst_in_worst worst_def by auto
  then show ?thesis
  proof (cases, goal_cases)
    case 1
    then show ?case
      using assms(1) assms(2) assms(3) general_U_def my_U_is_linear_function by auto
  next
    case 2
    then show ?case
      using assms(1) assms(2) assms(3) general_U_def by auto
  qed
qed

lemma general_U_ordinal_Utility:
  shows "ordinal_utility \<P> \<R> general_U"
proof (standard, goal_cases)
  case (1 x y)
  consider (a) "some_best \<succ>[\<R>] some_worst" | (b) "some_best \<approx>[\<R>] some_worst"
    using best_def some_best_in_best some_worst_in_worst worst_def by auto
  then show ?case
  proof (cases, goal_cases)
    case a
    have "some_best \<succ>[\<R>] some_worst"
      using a by auto
    then show "x \<succeq>[\<R>] y = (general_U y \<le> general_U x)"
      using 1 my_U_represents_pref[of x y] general_U_def by simp
  next
    case b
    have "general_U x = 1" "general_U y = 1"
      by (simp add: b general_U_def)+
    moreover have "x \<approx>[\<R>] y" using b
      by (meson "1"(1) "1"(2) best_worst_indiff_all_indiff(1)
          some_best_in_best some_worst_in_worst trans_approx)
    ultimately show "x \<succeq>[\<R>] y = (general_U y \<le> general_U x)"
      using general_U_def by linarith
  qed
next
  case (2 x y)
  then show ?case
    using relation_in_carrier by blast
next
  case (3 x y)
  then show ?case
    using relation_in_carrier by blast
qed

text \<open>  Proof of the linearity of general-U.
        If we consider the definition of expected utility
        functions from Maschler, Solan, Zamir we are done. \<close>

theorem is_linear:
  assumes "p \<in> \<P>"
    and "q \<in> \<P>"
    and "\<alpha> \<in> {0..1}"
  shows "\<exists>u. u (mix_pmf \<alpha> p q) = \<alpha> * (u p) + (1-\<alpha>) * (u q)"
proof
  let ?u = "general_U"
  consider "some_best \<succ>[\<R>] some_worst" | "some_best \<approx>[\<R>] some_worst"
    using best_def some_best_in_best some_worst_in_worst worst_def by auto
  then show "?u (mix_pmf \<alpha> p q) = \<alpha> * ?u p + (1 - \<alpha>) * ?u q"
  proof (cases)
    case 1
    then show ?thesis
      using assms(1) assms(2) assms(3) general_U_def my_U_is_linear_function by auto
  next
    case 2
    then show ?thesis
      by (simp add: general_U_def)
  qed
qed

text \<open> Now I define a Utility function that assigns a utility to all outcomes.
       These are only finitely many \<close>
private definition ocU
  where
    "ocU p = general_U (return_pmf p)"

lemma geral_U_is_expected_value_of_ocU:
  assumes "set_pmf p \<subseteq> outcomes"
  shows "general_U p = measure_pmf.expectation p ocU"
  using fnt assms
proof (induct rule: pmf_mix_induct')
  case (mix p q a)
  hence "general_U (mix_pmf a p q) = a * general_U p + (1-a) * general_U q"
    using general_U_is_linear_function[of p q a] mix.hyps assms lotteries_on_def mix.hyps by auto
  also have "... = a * measure_pmf.expectation p ocU + (1-a) * measure_pmf.expectation q ocU"
    by (simp add: mix.hyps(4) mix.hyps(5))
  also have "... = measure_pmf.expectation (mix_pmf a p q) ocU"
    using general_U_is_linear_function expected_value_mix_pmf_distrib fnt infinite_super mix.hyps(1)
    by (metis fnt mix.hyps(2) mix.hyps(3))
  finally show ?case .
qed (auto simp: support_in_outcomes assms fnt integral_measure_pmf_real ocU_def)

lemma ordinal_utility_expected_value:
  "ordinal_utility \<P> \<R> (\<lambda>x. measure_pmf.expectation x ocU)"
proof (standard, goal_cases)
  case (1 x y)
  have ocs: "set_pmf x \<subseteq> outcomes" "set_pmf y \<subseteq> outcomes"
    by (meson "1" subsetI support_in_outcomes)+
  have "x \<succeq>[\<R>] y \<Longrightarrow> (measure_pmf.expectation y ocU \<le> measure_pmf.expectation x ocU)"
  proof -
    assume "x \<succeq>[\<R>] y"
    have "general_U x \<ge> general_U y"
      by (meson \<open>x \<succeq>[\<R>] y\<close> general_U_ordinal_Utility ordinal_utility_def)
    then show "(measure_pmf.expectation y ocU \<le> measure_pmf.expectation x ocU)"
      using geral_U_is_expected_value_of_ocU ocs by auto
  qed
  moreover have "(measure_pmf.expectation y ocU \<le> measure_pmf.expectation x ocU) \<Longrightarrow> x \<succeq>[\<R>] y"
  proof -
    assume "(measure_pmf.expectation y ocU \<le> measure_pmf.expectation x ocU)"
    then have "general_U x \<ge> general_U y"
      by (simp add:  geral_U_is_expected_value_of_ocU ocs(1) ocs(2))
    then show "x \<succeq>[\<R>] y"
      by (meson "1"(1) "1"(2) general_U_ordinal_Utility ordinal_utility.util_def)
  qed
  ultimately show ?case
    by blast
next
  case (2 x y)
  then show ?case
    using relation_in_carrier by blast
next
  case (3 x y)
  then show ?case
    using relation_in_carrier by auto
qed

lemma ordinal_utility_expected_value':
  "\<exists>u. ordinal_utility \<P> \<R> (\<lambda>x. measure_pmf.expectation x u)"
  using ordinal_utility_expected_value by blast

lemma ocU_is_expected_utility_bernoulli:
  shows "\<forall>x \<in> \<P>. \<forall>y \<in> \<P>. x \<succeq>[\<R>] y \<longleftrightarrow>
  measure_pmf.expectation x ocU \<ge> measure_pmf.expectation y ocU"
  using ordinal_utility_expected_value by (meson ordinal_utility.util_def)

end  (* continuous *)

end(* finite outcomes *)

end (* system U *)

lemma expected_value_is_utility_function:
  assumes fnt: "finite outcomes" and "outcomes \<noteq> {}"
  assumes "x \<in> lotteries_on outcomes" and "y \<in> lotteries_on outcomes"
  assumes "ordinal_utility (lotteries_on outcomes) \<R> (\<lambda>x. measure_pmf.expectation x u)"
  shows "measure_pmf.expectation x u \<ge> measure_pmf.expectation y u \<longleftrightarrow> x \<succeq>[\<R>] y" (is "?L \<longleftrightarrow> ?R")
  using assms(3) assms(4) assms(5) ordinal_utility.util_def_conf
    ordinal_utility.ordinal_utility_left iffI  by (metis (no_types, lifting))

lemma system_U_implies_vNM_utility:
  assumes fnt: "finite outcomes" and "outcomes \<noteq> {}"
  assumes rpr: "rational_preference (lotteries_on outcomes) \<R>"
  assumes ind: "independent_vnm (lotteries_on outcomes) \<R>"
  assumes cnt: "continuous_vnm (lotteries_on outcomes) \<R>"
  shows "\<exists>u. ordinal_utility (lotteries_on outcomes) \<R> (\<lambda>x. measure_pmf.expectation x u)"
  using ordinal_utility_expected_value'[of outcomes \<R>] assms by blast

lemma vNM_utility_implies_rationality:
  assumes fnt: "finite outcomes" and "outcomes \<noteq> {}"
  assumes "\<exists>u. ordinal_utility (lotteries_on outcomes) \<R> (\<lambda>x. measure_pmf.expectation x u)"
  shows "rational_preference (lotteries_on outcomes) \<R>"
  using assms(3) ordinal_util_imp_rat_prefs by blast

theorem vNM_utility_implies_independence:
  assumes fnt: "finite outcomes" and "outcomes \<noteq> {}"
  assumes "\<exists>u. ordinal_utility (lotteries_on outcomes) \<R> (\<lambda>x. measure_pmf.expectation x u)"
  shows "independent_vnm (lotteries_on outcomes) \<R>"
proof (rule independent_vnmI2)
  fix p  q r
    and \<alpha>::real
  assume a1: "p \<in> \<P> outcomes"
  assume a2: "q \<in> \<P> outcomes"
  assume a3: "r \<in> \<P> outcomes"
  assume a4: "\<alpha> \<in> {0<..1}"
  have in_lots: "mix_pmf \<alpha> p r \<in> lotteries_on outcomes" "mix_pmf \<alpha> q r \<in> lotteries_on outcomes"
    using a1 a3 a4 mix_in_lot apply fastforce
    using a2 a3 a4 mix_in_lot by fastforce
  have fnts: "finite (set_pmf p)" "finite (set_pmf q)" "finite (set_pmf r)"
    using a1 a2 a3 fnt infinite_super lotteries_on_def by blast+
  obtain u where
    u: "ordinal_utility (lotteries_on outcomes) \<R> (\<lambda>x. measure_pmf.expectation x u)"
    using assms by blast
  have "p \<succeq>[\<R>] q \<Longrightarrow> mix_pmf \<alpha> p r \<succeq>[\<R>] mix_pmf \<alpha> q r"
  proof -
    assume "p \<succeq>[\<R>] q"
    hence f: "measure_pmf.expectation p u \<ge> measure_pmf.expectation q u"
      using u a1 a2 ordinal_utility.util_def by fastforce
    have "measure_pmf.expectation (mix_pmf \<alpha> p r) u \<ge> measure_pmf.expectation (mix_pmf \<alpha> q r) u"
    proof -
      have "measure_pmf.expectation (mix_pmf \<alpha> p r) u =
        \<alpha> * measure_pmf.expectation p u + (1 - \<alpha>) * measure_pmf.expectation r u"
        using expected_value_mix_pmf_distrib[of p r \<alpha> u] assms fnts a4 by fastforce
      moreover have "measure_pmf.expectation (mix_pmf \<alpha> q r) u =
        \<alpha> * measure_pmf.expectation q u + (1 - \<alpha>) * measure_pmf.expectation r u"
        using expected_value_mix_pmf_distrib[of q r \<alpha> u] assms fnts a4 by fastforce
      ultimately show ?thesis using f using a4 by auto
    qed
    then show "mix_pmf \<alpha> p r \<succeq>[\<R>] mix_pmf \<alpha> q r"
      using u ordinal_utility_expected_value' ocU_is_expected_utility_bernoulli in_lots
      by (simp add: in_lots ordinal_utility_def)
  qed
  moreover have "mix_pmf \<alpha> p r \<succeq>[\<R>] mix_pmf \<alpha> q r \<Longrightarrow> p \<succeq>[\<R>] q"
  proof -
    assume "mix_pmf \<alpha> p r \<succeq>[\<R>] mix_pmf \<alpha> q r"
    hence f:"measure_pmf.expectation (mix_pmf \<alpha> p r) u \<ge> measure_pmf.expectation (mix_pmf \<alpha> q r) u"
      using ordinal_utility.ordinal_utility_left u by fastforce
    hence "measure_pmf.expectation p u \<ge> measure_pmf.expectation q u"
    proof -
      have "measure_pmf.expectation (mix_pmf \<alpha> p r) u =
        \<alpha> * measure_pmf.expectation p u + (1 - \<alpha>) * measure_pmf.expectation r u"
        using expected_value_mix_pmf_distrib[of p r \<alpha> u] assms fnts a4 by fastforce
      moreover have "measure_pmf.expectation (mix_pmf \<alpha> q r) u =
        \<alpha> * measure_pmf.expectation q u + (1 - \<alpha>) * measure_pmf.expectation r u"
        using expected_value_mix_pmf_distrib[of q r \<alpha> u] assms fnts a4 by fastforce
      ultimately show ?thesis using f using a4 by auto
    qed
    then show "p \<succeq>[\<R>] q"
      using a1 a2 ordinal_utility.util_def_conf u by fastforce
  qed
  ultimately show "p \<succeq>[\<R>] q = mix_pmf \<alpha> p r \<succeq>[\<R>] mix_pmf \<alpha> q r"
    by blast
qed

lemma exists_weight_for_equality:
  assumes "a > c" and "a \<ge> b" and "b \<ge> c"
  shows   "\<exists>(e::real) \<in> {0..1}. (1-e) * a + e * c = b"
proof -
  from assms have "b \<in> closed_segment a c"
    by (simp add: closed_segment_eq_real_ivl)
  thus ?thesis by (auto simp: closed_segment_def)
qed

theorem Von_Neumann_Morgenstern_Utility_Theorem:
  assumes fnt: "finite outcomes" and "outcomes \<noteq> {}"
  shows "rational_preference (lotteries_on outcomes) \<R> \<and>
         independent_vnm (lotteries_on outcomes) \<R> \<and>
         continuous_vnm (lotteries_on outcomes) \<R> \<longleftrightarrow>
   (\<exists>u. ordinal_utility (lotteries_on outcomes) \<R> (\<lambda>x. measure_pmf.expectation x u))"
  using vNM_utility_implies_independence[OF assms, of \<R>]
    system_U_implies_vNM_utility[OF assms, of \<R>]
    vNM_utilty_implies_continuity[OF assms, of \<R>]
    ordinal_util_imp_rat_prefs[of "lotteries_on outcomes" \<R>] by auto

end


(*
    Title:      Fundamental_Subspaces.thy
    Author:     Jose Divasón <jose.divasonm at unirioja.es>
    Author:     Jesús Aransay <jesus-maria.aransay at unirioja.es>
    Maintainer: Jose Divasón <jose.divasonm at unirioja.es>
*)

section\<open>Fundamental Subspaces\<close>

theory Fundamental_Subspaces
imports
    Miscellaneous
begin

subsection\<open>The fundamental subspaces of a matrix\<close>

subsubsection\<open>Definitions\<close>

definition left_null_space :: "'a::{semiring_1}^'n^'m => ('a^'m) set"
  where "left_null_space A = {x. x v* A = 0}"

definition null_space :: "'a::{semiring_1}^'n^'m => ('a^'n) set"
  where "null_space A = {x. A *v x = 0}"

definition row_space :: "'a::{field}^'n^'m=>('a^'n) set"
  where "row_space A = vec.span (rows A)"

definition col_space :: "'a::{field}^'n^'m=>('a^'m) set"
  where "col_space A = vec.span (columns A)"

subsubsection\<open>Relationships among them\<close>

lemma left_null_space_eq_null_space_transpose: "left_null_space A = null_space (transpose A)"
  unfolding null_space_def left_null_space_def transpose_vector ..

lemma null_space_eq_left_null_space_transpose: "null_space A = left_null_space (transpose A)"
  using left_null_space_eq_null_space_transpose[of "transpose A"]
  unfolding transpose_transpose ..

lemma row_space_eq_col_space_transpose:
  fixes A::"'a::{field}^'columns^'rows"
  shows "row_space A = col_space (transpose A)"
  unfolding col_space_def row_space_def columns_transpose[of A] ..

lemma col_space_eq_row_space_transpose:
  fixes A::"'a::{field}^'n^'m"
  shows "col_space A = row_space (transpose A)"
  unfolding col_space_def row_space_def unfolding rows_transpose[of A] ..

subsection\<open>Proving that they are subspaces\<close>

lemma subspace_null_space:
  fixes A::"'a::{field}^'n^'m"
  shows "vec.subspace (null_space A)"
  by (auto simp: vec.subspace_def null_space_def vec.scale vec.add)

lemma subspace_left_null_space:
  fixes A::"'a::{field}^'n^'m"
  shows "vec.subspace (left_null_space A)"
  unfolding left_null_space_eq_null_space_transpose using subspace_null_space .

lemma subspace_row_space:
  shows "vec.subspace (row_space A)" by (metis row_space_def vec.subspace_span)

lemma subspace_col_space:
  shows "vec.subspace (col_space A)" by (metis col_space_def vec.subspace_span)

subsection\<open>More useful properties and equivalences\<close>

lemma col_space_eq:
  fixes A::"'a::{field}^'m::{finite, wellorder}^'n"
  shows "col_space A = {y. \<exists>x. A *v x = y}"
proof (unfold col_space_def vec.span_finite[OF finite_columns], auto)
  fix x
  show "A *v x \<in> range (\<lambda>u. \<Sum>v\<in>columns A. u v *s v)" using matrix_vmult_column_sum[of A x] by auto
next
  fix u::"('a, 'n) vec \<Rightarrow> 'a"
  let ?g="\<lambda>y. {i. y=column i A}"
  let ?x="(\<chi> i. if i=(LEAST a. a \<in> ?g (column i A)) then u (column i A) else 0)"
  show "\<exists>x. A *v x = (\<Sum>v\<in>columns A. u v *s v)"
  proof (unfold matrix_mult_sum, rule exI[of _ "?x"], auto)
    have inj: "inj_on ?g (columns A)" unfolding inj_on_def unfolding columns_def by auto
    have union_univ: "\<Union>(?g`(columns A)) = UNIV" unfolding columns_def by auto
    have "sum (\<lambda>i.(if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A) UNIV
        = sum (\<lambda>i. (if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A) (\<Union>(?g`(columns A)))"
      unfolding union_univ ..
    also have "... = sum (sum (\<lambda>i.(if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A)) (?g`(columns A))"
      by (rule sum.Union_disjoint[unfolded o_def], auto)
    also have "... = sum ((sum (\<lambda>i.(if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A)) \<circ> ?g)
        (columns A)" by (rule sum.reindex, simp add: inj)
    also have "... = sum (\<lambda>y. u y *s y) (columns A)"
    proof (rule sum.cong, auto)
      fix x
      assume x_in_cols: "x \<in> columns A"
      obtain b where b: "x=column b A" using x_in_cols unfolding columns_def by blast
      let ?f="(\<lambda>i. (if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A)"
      have sum_rw: "sum ?f ({i. x = column i A} - {LEAST a. x = column a A}) = 0"
        by (rule sum.neutral, auto)
      have "sum ?f {i. x = column i A} = ?f (LEAST a. x = column a A) + sum ?f ({i. x = column i A} - {LEAST a. x = column a A})"
        apply (rule sum.remove, auto, rule LeastI_ex)
        using x_in_cols unfolding columns_def by auto
      also have "... = ?f (LEAST a. x = column a A)" unfolding sum_rw by simp
      also have "... = u x *s x"
      proof (auto, rule LeastI2)
        show "x = column b A" using b .
        fix xa
        assume x: "x = column xa A"
        show "u (column xa A) *s column xa A = u x *s x" unfolding x ..
      next
        assume "(LEAST a. x = column a A) \<noteq> (LEAST a. column (LEAST c. x = column c A) A = column a A)"
        moreover have "(LEAST a. x = column a A) = (LEAST a. column (LEAST c. x = column c A) A = column a A)"
          by (rule Least_equality[symmetric], rule LeastI2, simp_all add: b, rule Least_le, metis (lifting, full_types) LeastI)
        ultimately show "u x = 0" by contradiction
      qed
      finally show " (\<Sum>i | x = column i A. (if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A) = u x *s x" .
    qed
    finally show "(\<Sum>i\<in>UNIV. (if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A) = (\<Sum>y\<in>columns A. u y *s y)" .
  qed
qed

corollary col_space_eq':
  fixes A::"'a::{field}^'m::{finite, wellorder}^'n"
  shows "col_space A = range (\<lambda>x. A *v x)"
  unfolding col_space_eq by auto

lemma row_space_eq:
  fixes A::"'a::{field}^'m^'n::{finite, wellorder}"
  shows "row_space A = {w. \<exists>y. (transpose A) *v y = w}"
  unfolding row_space_eq_col_space_transpose col_space_eq ..

lemma null_space_eq_ker:
  fixes f::"('a::field^'n) => ('a^'m)"
  assumes lf: "Vector_Spaces.linear (*s) (*s) f"
  shows "null_space (matrix f) = {x. f x = 0}"
  unfolding null_space_def using matrix_works [OF lf] by auto

lemma col_space_eq_range:
  fixes f::"('a::field^'n::{finite, wellorder}) \<Rightarrow> ('a^'m)"
  assumes lf: "Vector_Spaces.linear (*s) (*s) f"
  shows "col_space (matrix f) = range f"
  unfolding col_space_eq unfolding matrix_works[OF lf] by blast

lemma null_space_is_preserved:
  fixes A::"'a::{field}^'cols^'rows"
  assumes P: "invertible P"
  shows "null_space (P**A) = null_space A"
  unfolding null_space_def
  using P matrix_inv_left matrix_left_invertible_ker matrix_vector_mul_assoc matrix_vector_mult_0_right
  by metis

lemma row_space_is_preserved:
  fixes A::"'a::{field}^'cols^'rows::{finite, wellorder}"
    and P::"'a::{field}^'rows::{finite, wellorder}^'rows::{finite, wellorder}"
  assumes P: "invertible P"
  shows "row_space (P**A) = row_space A"
proof (auto)
  fix w
  assume w: "w \<in> row_space (P**A)"
  from this obtain y where w_By: "w=(transpose (P**A)) *v y"
    unfolding row_space_eq[of "P ** A" ] by fast
  have "w = (transpose (P**A)) *v y" using w_By .
  also have "... = ((transpose A) ** (transpose P)) *v y" unfolding matrix_transpose_mul ..
  also have "... = (transpose A) *v ((transpose P) *v y)" unfolding matrix_vector_mul_assoc ..
  finally show "w \<in> row_space A" unfolding row_space_eq by blast
next
  fix w
  assume w: "w \<in> row_space A"
  from this obtain y where w_Ay: "w=(transpose A) *v y" unfolding row_space_eq by fast
  have "w = (transpose A) *v y" using w_Ay .
  also have "... = (transpose ((matrix_inv P) ** (P**A))) *v y"
    by (metis P matrix_inv_left matrix_mul_assoc matrix_mul_lid)
  also have "... = (transpose (P**A) ** (transpose (matrix_inv P))) *v y"
    unfolding matrix_transpose_mul ..
  also have "... = transpose (P**A) *v (transpose (matrix_inv P) *v y)"
    unfolding matrix_vector_mul_assoc ..
  finally show "w \<in> row_space (P**A)"  unfolding row_space_eq by blast
qed
end


(*  Title:      HOL/Library/Function_Algebras.thy
    Author:     Jeremy Avigad and Kevin Donnelly; Florian Haftmann, TUM
*)

section {* Pointwise instantiation of functions to algebra type classes *}

theory Function_Algebras
imports Main
begin

text {* Pointwise operations *}

instantiation "fun" :: (type, plus) plus
begin

definition "f + g = (\<lambda>x. f x + g x)"
instance ..

end

lemma plus_fun_apply [simp]:
  "(f + g) x = f x + g x"
  by (simp add: plus_fun_def)

instantiation "fun" :: (type, zero) zero
begin

definition "0 = (\<lambda>x. 0)"
instance ..

end

lemma zero_fun_apply [simp]:
  "0 x = 0"
  by (simp add: zero_fun_def)

instantiation "fun" :: (type, times) times
begin

definition "f * g = (\<lambda>x. f x * g x)"
instance ..

end

lemma times_fun_apply [simp]:
  "(f * g) x = f x * g x"
  by (simp add: times_fun_def)

instantiation "fun" :: (type, one) one
begin

definition "1 = (\<lambda>x. 1)"
instance ..

end

lemma one_fun_apply [simp]:
  "1 x = 1"
  by (simp add: one_fun_def)

text {* Additive structures *}

instance "fun" :: (type, semigroup_add) semigroup_add
  by default (simp add: fun_eq_iff add.assoc)

instance "fun" :: (type, cancel_semigroup_add) cancel_semigroup_add
  by default (simp_all add: fun_eq_iff)

instance "fun" :: (type, ab_semigroup_add) ab_semigroup_add
  by default (simp add: fun_eq_iff add.commute)

instance "fun" :: (type, cancel_ab_semigroup_add) cancel_ab_semigroup_add
  by default simp

instance "fun" :: (type, monoid_add) monoid_add
  by default (simp_all add: fun_eq_iff)

instance "fun" :: (type, comm_monoid_add) comm_monoid_add
  by default simp

instance "fun" :: (type, cancel_comm_monoid_add) cancel_comm_monoid_add ..

instance "fun" :: (type, group_add) group_add
  by default
    (simp_all add: fun_eq_iff)

instance "fun" :: (type, ab_group_add) ab_group_add
  by default simp_all

text {* Multiplicative structures *}

instance "fun" :: (type, semigroup_mult) semigroup_mult
  by default (simp add: fun_eq_iff mult.assoc)

instance "fun" :: (type, ab_semigroup_mult) ab_semigroup_mult
  by default (simp add: fun_eq_iff mult.commute)

instance "fun" :: (type, monoid_mult) monoid_mult
  by default (simp_all add: fun_eq_iff)

instance "fun" :: (type, comm_monoid_mult) comm_monoid_mult
  by default simp

text {* Misc *}

instance "fun" :: (type, "Rings.dvd") "Rings.dvd" ..

instance "fun" :: (type, mult_zero) mult_zero
  by default (simp_all add: fun_eq_iff)

instance "fun" :: (type, zero_neq_one) zero_neq_one
  by default (simp add: fun_eq_iff)

text {* Ring structures *}

instance "fun" :: (type, semiring) semiring
  by default (simp_all add: fun_eq_iff algebra_simps)

instance "fun" :: (type, comm_semiring) comm_semiring
  by default (simp add: fun_eq_iff  algebra_simps)

instance "fun" :: (type, semiring_0) semiring_0 ..

instance "fun" :: (type, comm_semiring_0) comm_semiring_0 ..

instance "fun" :: (type, semiring_0_cancel) semiring_0_cancel ..

instance "fun" :: (type, comm_semiring_0_cancel) comm_semiring_0_cancel ..

instance "fun" :: (type, semiring_1) semiring_1 ..

lemma of_nat_fun: "of_nat n = (\<lambda>x::'a. of_nat n)"
proof -
  have comp: "comp = (\<lambda>f g x. f (g x))"
    by (rule ext)+ simp
  have plus_fun: "plus = (\<lambda>f g x. f x + g x)"
    by (rule ext, rule ext) (fact plus_fun_def)
  have "of_nat n = (comp (plus (1::'b)) ^^ n) (\<lambda>x::'a. 0)"
    by (simp add: of_nat_def plus_fun zero_fun_def one_fun_def comp)
  also have "... = comp ((plus 1) ^^ n) (\<lambda>x::'a. 0)"
    by (simp only: comp_funpow)
  finally show ?thesis by (simp add: of_nat_def comp)
qed

lemma of_nat_fun_apply [simp]:
  "of_nat n x = of_nat n"
  by (simp add: of_nat_fun)

instance "fun" :: (type, comm_semiring_1) comm_semiring_1 ..

instance "fun" :: (type, semiring_1_cancel) semiring_1_cancel ..

instance "fun" :: (type, comm_semiring_1_cancel) comm_semiring_1_cancel ..

instance "fun" :: (type, semiring_char_0) semiring_char_0
proof
  from inj_of_nat have "inj (\<lambda>n (x::'a). of_nat n :: 'b)"
    by (rule inj_fun)
  then have "inj (\<lambda>n. of_nat n :: 'a \<Rightarrow> 'b)"
    by (simp add: of_nat_fun)
  then show "inj (of_nat :: nat \<Rightarrow> 'a \<Rightarrow> 'b)" .
qed

instance "fun" :: (type, ring) ring ..

instance "fun" :: (type, comm_ring) comm_ring ..

instance "fun" :: (type, ring_1) ring_1 ..

instance "fun" :: (type, comm_ring_1) comm_ring_1 ..

instance "fun" :: (type, ring_char_0) ring_char_0 ..

text {* Ordered structures *}

instance "fun" :: (type, ordered_ab_semigroup_add) ordered_ab_semigroup_add
  by default (auto simp add: le_fun_def intro: add_left_mono)

instance "fun" :: (type, ordered_cancel_ab_semigroup_add) ordered_cancel_ab_semigroup_add ..

instance "fun" :: (type, ordered_ab_semigroup_add_imp_le) ordered_ab_semigroup_add_imp_le
  by default (simp add: le_fun_def)

instance "fun" :: (type, ordered_comm_monoid_add) ordered_comm_monoid_add ..

instance "fun" :: (type, ordered_ab_group_add) ordered_ab_group_add ..

instance "fun" :: (type, ordered_semiring) ordered_semiring
  by default
    (auto simp add: le_fun_def intro: mult_left_mono mult_right_mono)

instance "fun" :: (type, ordered_comm_semiring) ordered_comm_semiring
  by default (fact mult_left_mono)

instance "fun" :: (type, ordered_cancel_semiring) ordered_cancel_semiring ..

instance "fun" :: (type, ordered_cancel_comm_semiring) ordered_cancel_comm_semiring ..

instance "fun" :: (type, ordered_ring) ordered_ring ..

instance "fun" :: (type, ordered_comm_ring) ordered_comm_ring ..

lemmas func_plus = plus_fun_def
lemmas func_zero = zero_fun_def
lemmas func_times = times_fun_def
lemmas func_one = one_fun_def

end


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

section \<open>The Category of Measurable Spaces is not Cartesian Closed\<close>

theory Measure_Not_CCC
  imports "HOL-Probability.Probability"
begin

text \<open>
  We show that the category of measurable spaces with measurable functions as morphisms is not a
  Cartesian closed category. While the category has products and terminal objects, the exponential
  does not exist for each pair of measurable spaces.

  We show that the exponential $\mathbb{B}^\mathbb{C}$ does not exist, where $\mathbb{B}$ is the
  discrete measurable space on boolean values, and $\mathbb{C}$ is the $\sigma$-algebra consisting
  of all countable and co-countable real sets. We also define $\mathbb{R}$ to be the discrete
  measurable space on the reals.

  Now, the diagonal predicate \<^term>\<open>\<lambda>x y. x = y\<close> is $\mathbb{R}$-$\mathbb{B}^\mathbb{C}$-measurable,
  but \<^term>\<open>\<lambda>(x, y). x = y\<close> is not $(\mathbb{R} \times \mathbb{C})$-$\mathbb{B}$-measurable.
\<close>

definition COCOUNT :: "real measure" where
  "COCOUNT = sigma UNIV {{x} | x. True}"

abbreviation POW :: "real measure" where
  "POW \<equiv> count_space UNIV"

abbreviation BOOL :: "bool measure" where
  "BOOL \<equiv> count_space UNIV"

lemma measurable_const_iff: "(\<lambda>x. c) \<in> measurable A B \<longleftrightarrow> (space A = {} \<or> c \<in> space B)"
  by (auto simp: measurable_def)

lemma measurable_eq[measurable]: "((=) x) \<in> measurable COCOUNT BOOL"
  unfolding pred_def by (auto simp: COCOUNT_def)

lemma COCOUNT_eq: "A \<in> COCOUNT \<longleftrightarrow> countable A \<or> countable (UNIV - A)"
proof
  fix A assume "A \<in> COCOUNT"
  then have "A \<in> sigma_sets UNIV {{x} | x. True}"
    by (auto simp: COCOUNT_def)
  then show "countable A \<or> countable (UNIV - A)"
  proof induction
    case (Union F)
    moreover
    { fix i assume "countable (UNIV - F i)"
      then have "countable (UNIV - (\<Union>i. F i))"
        by (rule countable_subset[rotated]) auto }
    ultimately show "countable (\<Union>i. F i) \<or> countable (UNIV - (\<Union>i. F i))"
      by blast
  qed (auto simp: Diff_Diff_Int)
next
  assume "countable A \<or> countable (UNIV - A)"
  moreover
  { fix A :: "real set" assume A: "countable A"
    have "A = (\<Union>a\<in>A. {a})"
      by auto
    also have "\<dots> \<in> COCOUNT"
      by (intro sets.countable_UN' A) (auto simp: COCOUNT_def)
    finally have "A \<in> COCOUNT" . }
  note A = this
  note A[of A]
  moreover
  { assume "countable (UNIV - A)"
    with A have "space COCOUNT - (UNIV - A) \<in> COCOUNT" by simp
    then have "A \<in> COCOUNT"
      by (auto simp: COCOUNT_def Diff_Diff_Int) }
  ultimately show "A \<in> COCOUNT"
    by blast
qed

lemma pair_COCOUNT:
  assumes A: "A \<in> sets (COCOUNT \<Otimes>\<^sub>M M)"
  shows "\<exists>J F X. X \<in> sets M \<and> F \<in> J \<rightarrow> sets M \<and> countable J \<and> A = (UNIV - J) \<times> X \<union> (SIGMA j:J. F j)"
  using A unfolding sets_pair_measure
proof induction
  case (Basic X)
  then obtain a b where X: "X = a \<times> b" and b: "b \<in> sets M" and a: "countable a \<or> countable (UNIV - a)"
    by (auto simp: COCOUNT_eq)
  from a show ?case
  proof
    assume "countable a" with X b show ?thesis
      by (intro exI[of _ a] exI[of _ "\<lambda>_. b"] exI[of _ "{}"]) auto
  next
    assume "countable (UNIV - a)" with X b show ?thesis
      by (intro exI[of _ "UNIV - a"] exI[of _ "\<lambda>_. {}"] exI[of _ "b"]) auto
  qed
next
  case Empty then show ?case
    by (intro exI[of _ "{}"] exI[of _ "\<lambda>_. {}"] exI[of _ "{}"]) auto
next
  case (Compl A)
  then obtain J F X where XFJ: "X \<in> sets M" "F \<in> J \<rightarrow> sets M" "countable J"
    and A: "A = (UNIV - J) \<times> X \<union> Sigma J F"
    by auto
  have *: "space COCOUNT \<times> space M - A = (UNIV - J) \<times> (space M - X) \<union> (SIGMA j:J. space M - F j)"
    unfolding A by (auto simp: COCOUNT_def)
  show ?case
    using XFJ unfolding *
    by (intro exI[of _ J] exI[of _ "space M - X"] exI[of _ "\<lambda>j. space M - F j"]) auto
next
  case (Union A)
  obtain J F X where XFJ: "\<And>i. X i \<in> sets M" "\<And>i. F i \<in> J i \<rightarrow> sets M" "\<And>i. countable (J i)"
    and A_eq: "A = (\<lambda>i. (UNIV - J i) \<times> X i \<union> Sigma (J i) (F i))"
    unfolding fun_eq_iff using Union.IH by metis
  show ?case
  proof (intro exI conjI)
    define G where "G j = (\<Union>i. if j \<in> J i then F i j else X i)" for j
    show "(\<Union>i. X i) \<in> sets M" "countable (\<Union>i. J i)" "G \<in> (\<Union>i. J i) \<rightarrow> sets M"
      using XFJ by (auto simp: G_def Pi_iff)
    show "\<Union>(A ` UNIV) = (UNIV - (\<Union>i. J i)) \<times> (\<Union>i. X i) \<union> (SIGMA j:\<Union>i. J i. \<Union>i. if j \<in> J i then F i j else X i)"
      unfolding A_eq by (auto split: if_split_asm)
  qed
qed

context
  fixes EXP :: "(real \<Rightarrow> bool) measure"
  assumes eq: "\<And>P. case_prod P \<in> measurable (POW \<Otimes>\<^sub>M COCOUNT) BOOL \<longleftrightarrow> P \<in> measurable POW EXP"
begin

lemma space_EXP: "space EXP = measurable COCOUNT BOOL"
proof -
  { fix f
    have "f \<in> space EXP \<longleftrightarrow> (\<lambda>(a, b). f b) \<in> measurable (POW \<Otimes>\<^sub>M COCOUNT) BOOL"
      using eq[of "\<lambda>x. f"] by (simp add: measurable_const_iff)
    also have "\<dots> \<longleftrightarrow> f \<in> measurable COCOUNT BOOL"
      by auto
    finally have "f \<in> space EXP \<longleftrightarrow> f \<in> measurable COCOUNT BOOL" . }
  then show ?thesis by auto
qed

lemma measurable_eq_EXP: "(\<lambda>x y. x = y) \<in> measurable POW EXP"
  unfolding measurable_def by (auto simp: space_EXP)

lemma measurable_eq_pair: "(\<lambda>(y, x). x = y) \<in> measurable (COCOUNT \<Otimes>\<^sub>M POW) BOOL"
  using measurable_eq_EXP unfolding eq[symmetric]
  by (subst measurable_pair_swap_iff) simp

lemma ce: False
proof -
  have "{(y, x) \<in> space (COCOUNT \<Otimes>\<^sub>M POW). x = y} \<in> sets (COCOUNT \<Otimes>\<^sub>M POW)"
    using measurable_eq_pair unfolding pred_def by (simp add: split_beta')
  also have "{(y, x) \<in> space (COCOUNT \<Otimes>\<^sub>M POW). x = y} = (SIGMA j:UNIV. {j})"
    by (auto simp: space_pair_measure COCOUNT_def)
  finally obtain X F J where "countable (J::real set)"
    and eq: "(SIGMA j:UNIV. {j}) = (UNIV - J) \<times> X \<union> (SIGMA j:J. F j)"
    using pair_COCOUNT[of "SIGMA j:UNIV. {j}" POW] by auto
  have X_single: "\<And>x. x \<notin> J \<Longrightarrow> X = {x}"
    using eq[unfolded set_eq_iff] by force

  have "uncountable (UNIV - J)"
    using \<open>countable J\<close> uncountable_UNIV_real uncountable_minus_countable by blast
  then have "infinite (UNIV - J)"
    by (auto intro: countable_finite)
  then have "\<exists>A. finite A \<and> card A = 2 \<and> A \<subseteq> UNIV - J"
    by (rule infinite_arbitrarily_large)
  then obtain i j where ij: "i \<in> UNIV - J" "j \<in> UNIV - J" "i \<noteq> j"
    by (auto simp add: card_Suc_eq numeral_2_eq_2)
  have "{(i, i), (j, j)} \<subseteq> (SIGMA j:UNIV. {j})" by auto
  with ij X_single[of i] X_single[of j] show False
    by auto
qed

end

corollary "\<not> (\<exists>EXP. \<forall>P. case_prod P \<in> measurable (POW \<Otimes>\<^sub>M COCOUNT) BOOL \<longleftrightarrow> P \<in> measurable POW EXP)"
  using ce by blast

end


(* Property from Case-Analysis for Rippling and Inductive Proof,
   Moa Johansson, Lucas Dixon and Alan Bundy, ITP 2010.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_prop_31
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun min :: "Nat => Nat => Nat" where
"min (Z) y = Z"
| "min (S z) (Z) = Z"
| "min (S z) (S y1) = S (min z y1)"

theorem property0 :
  "((min (min a b) c) = (min a (min b c)))"
  oops

end


theory deMorgan2
  imports Main

begin

lemma de_morgan_2 : "(\<not>p \<and> \<not>q) \<longrightarrow> \<not>(p \<or> q)"
  apply (rule impI)
  apply (rule notI)
  apply (erule disjE)
  apply (erule conjE)
   apply (erule notE)
     apply assumption
  apply (erule conjE)
  apply (erule notE)
  apply (erule notE)
  apply assumption
  done

end


(*
  Author: Fred Kurz
*)
theory Map_Supplement
imports Main
begin

lemma map_of_defined_if_constructed_from_list_of_constant_assignments:
  "l = map (\<lambda>x. (x, a)) xs \<Longrightarrow> \<forall>x \<in> set xs. (map_of l) x = Some a"
proof (induction xs arbitrary: l)
  case (Cons x xs)
  let ?l' = "map (\<lambda>v. (v, a)) xs"
  from Cons.prems(1) have "l = (x, a) # map (\<lambda>v. (v, a)) xs"
    by force
  moreover have "\<forall>v \<in> set xs. (map_of ?l') v = Some a"
    using Cons.IH[where l="?l'"]
    by blast
  ultimately show ?case
    by auto
qed auto

\<comment> \<open> NOTE Function graph is the set of pairs (x, f x) for a (total) function f. \<close>
\<comment> \<open> TODO Remove the first premise (follows from the second). \<close>
lemma map_of_from_function_graph_is_some_if:
  fixes f :: "'a \<Rightarrow> 'b"
  assumes "set xs \<noteq> {}"
   and "x \<in> set xs"
  shows "(map_of (map (\<lambda>x. (x, f x)) xs)) x = Some (f x)"
  using assms
proof (induction xs arbitrary: f x)
  \<comment> \<open> NOTE Base case follows trivially from violation of assumption \<open>set xs \<noteq> {}\<close>. \<close>
  case (Cons a xs)
    thm Cons
    let ?m = "map_of (map (\<lambda>x. (x, f x)) xs)"
    have a: "map_of (map (\<lambda>x. (x, f x)) (Cons a xs)) = ?m(a \<mapsto> f a)"
      unfolding map_of_def
      by simp
    thus ?case
      proof(cases "x = a")
        case False
        thus ?thesis
        proof (cases "set xs = {}")
            \<comment> \<open> NOTE Follows from contradiction (\<open>x \<in> set (Cons a xs) \<and> set xs = {} \<and> x \<noteq> a \<equiv> \<bottom>\<close>)\<close>
            case True
            thus ?thesis
              using Cons.prems(2)
              by fastforce
          next
            case False
            then have "x \<in> set xs"
              using \<open>x \<noteq> a\<close> Cons.prems(2)
              by fastforce
            moreover have "map_of (map (\<lambda>x. (x, f x)) (Cons a xs)) x = ?m x"
              using \<open>x \<noteq> a\<close>
              by fastforce
            ultimately show ?thesis
              using Cons.IH[OF False]
              by presburger
          qed
      qed force
    qed blast

lemma foldl_map_append_is_some_if:
  assumes "b x = Some y \<or> (\<exists>m \<in> set ms. m x = Some y)"
    and "\<forall>m' \<in> set ms. m' x = Some y \<or> m' x = None"
  shows "foldl (++) b ms x = Some y"
using assms
proof (induction ms arbitrary: b)
  \<comment> \<open> NOTE Induction base case violates first assumption (we have at least one element in ms
    and hence \<open>ms \<noteq> []\<close>). \<close>
  case (Cons a ms)
  consider (b_is_some_y) "b x = Some y"
    | (m_is_some_y) "\<exists>m \<in> set (a # ms). m x = Some y"
    using Cons.prems(1)
    by blast
  hence "(b ++ a) x = Some y \<or> (\<exists>m\<in>set ms. m x = Some y)"
    proof (cases)
      case b_is_some_y
      moreover have "a x = Some y \<or> a x = None"
        using Cons.prems(2)
        by simp
      ultimately show ?thesis
        using map_add_Some_iff[of b a x y]
        by blast
    next
      case m_is_some_y
      then show ?thesis
        proof (cases "a x = Some y")
          case False
          then obtain m where "m \<in> set ms" and "m x = Some y"
            using m_is_some_y try0
            by auto
          thus ?thesis
            by blast
        qed simp
    qed
  moreover have "\<forall>m' \<in> set ms. m' x = Some y \<or> m' x = None"
    using Cons.prems(2)
    by fastforce
  ultimately show ?case using Cons.IH[where b="b ++ a"]
    by simp
qed auto

(* TODO "\<forall>(v, a) \<in> set l. \<forall>(v', a') \<in> set l. v \<noteq> v' \<or> a = a'" \<leadsto>
  "\<forall>(v', a') \<in> set l. v \<noteq> v' \<or> a = a'" (this is too strong; we only consider (v, a), i.e. fixed v)
*)
(* TODO isn't this the same as map_of_is_SomeI? *)
lemma map_of_constant_assignments_defined_if:
  assumes "\<forall>(v, a) \<in> set l. \<forall>(v', a') \<in> set l. v \<noteq> v' \<or> a = a'"
    and "(v, a) \<in> set l"
  shows "map_of l v = Some a"
  using assms
proof (induction l)
  case (Cons x l)
  thm Cons
  then show ?case
    proof (cases "x = (v, a)")
      case False
      have v_a_in_l: "(v, a) \<in> set l"
        using Cons.prems(2) False
        by fastforce
      {
        have "\<forall>(v, a) \<in> set l. \<forall>(v', a') \<in> set l. v \<noteq> v' \<or> a = a'"
          using Cons.prems(1)
          by auto
        hence "map_of l v = Some a"
          using Cons.IH v_a_in_l
          by linarith
      } note ih = this
      {
        have "x \<in> set (x # l)"
          by auto
        hence "fst x \<noteq> v \<or> snd x = a"
          using Cons.prems(1) v_a_in_l
          by fastforce
      } note nb = this
      \<comment> \<open> NOTE If @{text "fst x = v"} then @{text "snd x = a"} by fact @{text "nb"}; moreover if
        on the other hand @{text "fst x \<noteq> v"}, then the proposition follows from the induction
        hypothesis since @{text "map_of (x # l) v = map_of l v"} in that case. \<close>
      thus ?thesis
        using ih nb
        by (cases "fst x = v") fastforce+
    qed simp
qed fastforce

end