(*
Authors:

  Dominique Unruh, University of Tartu, unruh@ut.ee
  Jose Manuel Rodriguez Caballero, University of Tartu, jose.manuel.rodriguez.caballero@ut.ee

*)

theory Free_Vector_Spaces
  imports
    "Complex_Bounded_Operators.Complex_Inner_Product"
    "HOL-Library.Adhoc_Overloading"
    Preliminaries_Tensor_Product
begin

typedef 'a free = \<open>{f::'a \<Rightarrow> complex. finite {x | x. f x \<noteq> 0}}\<close>
  morphisms times_free_vec Abs_free
  apply auto
  using not_finite_existsD by fastforce

setup_lifting type_definition_free

bundle free_notation begin
notation times_free_vec (infixr "\<down>" 70)
end

bundle no_free_notation begin
no_notation times_free_vec (infixr "\<down>" 70)
end

unbundle free_notation

instantiation free :: (type) complex_vector
begin

lift_definition zero_free :: "'a free"
  is \<open>\<lambda> _. 0\<close>
  by auto

lift_definition scaleC_free :: "complex \<Rightarrow> 'a free \<Rightarrow> 'a free"
  is \<open>\<lambda> c::complex. \<lambda> f::'a\<Rightarrow>complex. (\<lambda> x. c *\<^sub>C (f x))\<close>
  by auto

lift_definition scaleR_free :: "real \<Rightarrow> 'a free \<Rightarrow> 'a free"
  is \<open>\<lambda> c::real. \<lambda> f::'a\<Rightarrow>complex. (\<lambda> x. c *\<^sub>C (f x))\<close>
  by auto

lift_definition uminus_free :: "'a free \<Rightarrow> 'a free"
  is \<open>\<lambda> f::'a\<Rightarrow>complex. (\<lambda> x. - (f x))\<close>
  by auto

lift_definition plus_free :: "'a free \<Rightarrow> 'a free \<Rightarrow> 'a free"
  is \<open>\<lambda> f g ::'a\<Rightarrow>complex. (\<lambda> x. f x + g x)\<close>
proof-
  fix f1 f2 :: \<open>'a \<Rightarrow> complex\<close>
  assume \<open>finite {x |x. f1 x \<noteq> 0}\<close> and \<open>finite {x |x. f2 x \<noteq> 0}\<close>
  moreover have \<open>{x |x. f1 x + f2 x \<noteq> 0} \<subseteq> {x |x. f1 x \<noteq> 0} \<union> {x |x. f2 x \<noteq> 0}\<close>
  proof-
    have \<open>{x |x. f1 x = 0} \<inter> {x |x. f2 x = 0} \<subseteq> {x |x. f1 x + f2 x = 0}\<close>
      by (simp add: Collect_mono_iff Int_def)
    thus ?thesis
      by auto
  qed
  ultimately show \<open>finite {x |x. f1 x + f2 x \<noteq> 0}\<close>
    by (simp add: finite_subset)
qed

lift_definition minus_free :: "'a free \<Rightarrow> 'a free \<Rightarrow> 'a free"
  is \<open>\<lambda> f g ::'a\<Rightarrow>complex. (\<lambda> x. f x - g x)\<close>
proof-
  fix f1 f2 :: \<open>'a \<Rightarrow> complex\<close>
  assume \<open>finite {x |x. f1 x \<noteq> 0}\<close> and \<open>finite {x |x. f2 x \<noteq> 0}\<close>
  moreover have \<open>{x |x. f1 x - f2 x \<noteq> 0} \<subseteq> {x |x. f1 x \<noteq> 0} \<union> {x |x. f2 x \<noteq> 0}\<close>
  proof-
    have \<open>{x |x. f1 x = 0} \<inter> {x |x. f2 x = 0} \<subseteq> {x |x. f1 x - f2 x = 0}\<close>
      by (simp add: Collect_mono_iff Int_def)
    thus ?thesis
      by auto
  qed
  ultimately show \<open>finite {x |x. f1 x - f2 x \<noteq> 0}\<close>
    by (simp add: finite_subset)
qed

instance
proof
  show "((*\<^sub>R) r::'a free \<Rightarrow> _) = (*\<^sub>C) (complex_of_real r)"
    for r :: real
    unfolding scaleR_free_def scaleC_free_def by auto
  show "(a::'a free) + b + c = a + (b + c)"
    for a :: "'a free"
      and b :: "'a free"
      and c :: "'a free"
    apply transfer
    by (simp add: add.commute add.left_commute)
  show "(a::'a free) + b = b + a"
    for a :: "'a free"
      and b :: "'a free"
    apply transfer
    by (simp add: add.commute)
  show "(0::'a free) + a = a"
    for a :: "'a free"
    apply transfer by auto
  show "- (a::'a free) + a = 0"
    for a :: "'a free"
    apply transfer by auto
  show "(a::'a free) - b = a + - b"
    for a :: "'a free"
      and b :: "'a free"
    apply transfer by auto
  show "a *\<^sub>C ((x::'a free) + y) = a *\<^sub>C x + a *\<^sub>C y"
    for a :: complex
      and x :: "'a free"
      and y :: "'a free"
    apply transfer
    using scaleC_add_right by blast
  show "(a + b) *\<^sub>C (x::'a free) = a *\<^sub>C x + b *\<^sub>C x"
    for a :: complex
      and b :: complex
      and x :: "'a free"
    apply transfer
    using scaleC_add_left by blast
  show "a *\<^sub>C b *\<^sub>C (x::'a free) = (a * b) *\<^sub>C x"
    for a :: complex
      and b :: complex
      and x :: "'a free"
    apply transfer by auto
  show "1 *\<^sub>C (x::'a free) = x"
    for x :: "'a free"
    apply transfer by auto
qed
end

lift_definition inclusion_free:: \<open>'a \<Rightarrow> 'a free\<close>
  is \<open>\<lambda> a::'a. (\<lambda> x. if x = a then 1 else 0)\<close>
  by simp

definition clinear_iso::\<open>('a::complex_vector \<Rightarrow> 'b::complex_vector) \<Rightarrow> bool\<close> where
  \<open>clinear_iso f = ( clinear f \<and> (\<exists> g::'b\<Rightarrow>'a. clinear g \<and> f \<circ> g = id \<and> g \<circ> f = id )  ) \<close>

lemma clinear_iso_bij_I:
  \<open>clinear f \<Longrightarrow> bij f \<Longrightarrow> clinear_iso f\<close>
  unfolding clinear_iso_def
  by (meson bij_clinear_imp_inv_clinear bij_is_inj bij_is_surj inv_o_cancel surj_iff)

lemma clinear_iso_bij_D1:
  \<open>clinear_iso f \<Longrightarrow> bij f\<close>
  unfolding clinear_iso_def
  using o_bij by auto

lemma clinear_iso_bij_D2:
  \<open>clinear_iso f \<Longrightarrow> clinear f\<close>
  unfolding clinear_iso_def by blast

lemma clinear_iso_bij_iff:
  \<open>clinear_iso f \<longleftrightarrow> clinear f \<and> bij f\<close>
proof
  show "clinear f \<and> bij f"
    if "clinear_iso f"
    using that
    by (simp add: clinear_iso_bij_D1 clinear_iso_bij_D2)
  show "clinear_iso f"
    if "clinear f \<and> bij f"
    using that
    by (simp add: clinear_iso_bij_I)
qed

text\<open>A type TYPE('a) is a free vector space over the type TYPE('b) if and only if ...\<close>
definition is_free_over::\<open>('a::complex_vector) itself \<Rightarrow> 'b itself \<Rightarrow> bool\<close> where
  \<open>is_free_over (TYPE('a)) (TYPE('b)) = (\<exists> f :: 'a \<Rightarrow> 'b free. clinear_iso f)\<close>

lemma free_regular_for_sum:
  fixes x y :: \<open>'a free\<close>
  shows \<open>(x + y) \<down> t = x \<down> t + y \<down> t\<close>
  apply transfer
  by auto

lemma free_regular_for_sum_general_induction:
  fixes x :: \<open>'a free\<close>
  shows \<open>\<forall> S. finite S \<and> card S = n \<longrightarrow> ( \<Sum> u \<in> S. (x \<down> u) *\<^sub>C (inclusion_free u) ) \<down> t
  = (\<Sum> u \<in> S. ( (x \<down> u) *\<^sub>C (inclusion_free u) ) \<down> t )\<close>
proof (induction n)
  show "\<forall>S. finite S \<and> card S = 0 \<longrightarrow> (\<Sum>u\<in>S. (x \<down> u) *\<^sub>C inclusion_free u) \<down> t = (\<Sum>u\<in>S. ((x \<down> u) *\<^sub>C inclusion_free u) \<down> t)"
    by (metis (no_types, lifting) card_0_eq sum_clauses(1) zero_free.rep_eq)
  show "\<forall>S. finite S \<and> card S = Suc n \<longrightarrow> (\<Sum>u\<in>S. (x \<down> u) *\<^sub>C inclusion_free u) \<down> t = (\<Sum>u\<in>S. ((x \<down> u) *\<^sub>C inclusion_free u) \<down> t)"
    if "\<forall>S. finite S \<and> card S = n \<longrightarrow>  (\<Sum>u\<in>S. (x \<down> u) *\<^sub>C inclusion_free u) \<down> t = (\<Sum>u\<in>S. ( (x \<down> u) *\<^sub>C inclusion_free u) \<down> t)"
    for n :: nat
  proof-
    have \<open>finite S \<Longrightarrow> card S = Suc n \<Longrightarrow> (\<Sum>u\<in>S. (x \<down> u) *\<^sub>C inclusion_free u) \<down> t = (\<Sum>u\<in>S. ( (x \<down> u) *\<^sub>C inclusion_free u) \<down> t)\<close>
      for S
    proof-
      fix S::\<open>'a set\<close>
      assume \<open>finite S\<close> and \<open>card S = Suc n\<close>
      hence \<open>\<exists> R r. S = insert r R \<and> r \<notin> R\<close>
        by (meson card_Suc_eq)
      then obtain R r where \<open>S = insert r R\<close> and \<open>r \<notin> R\<close>
        by blast
      have \<open>finite R\<close>
        using \<open>finite S\<close> \<open>S = insert r R\<close>
        by simp
      moreover have \<open>card R = n\<close>
        using \<open>card S = Suc n\<close> \<open>S = insert r R\<close>  \<open>r \<notin> R\<close> \<open>finite R\<close> by auto
      ultimately have \<open>(\<Sum>u\<in>R. (x \<down> u) *\<^sub>C inclusion_free u) \<down> t = (\<Sum>u\<in>R. ((x \<down> u) *\<^sub>C inclusion_free u) \<down> t)\<close>
        by (simp add: that)
      hence \<open>(\<Sum>u\<in>R. (x \<down> u) *\<^sub>C inclusion_free u) \<down> t + ((x \<down> r) *\<^sub>C inclusion_free r) \<down> t
         = (\<Sum>u\<in>R. ((x \<down> u) *\<^sub>C inclusion_free u) \<down> t) + ((x \<down> r) *\<^sub>C inclusion_free r) \<down> t\<close>
        by simp
      moreover have \<open>(\<Sum>u\<in>R. (x \<down> u) *\<^sub>C inclusion_free u) \<down> t + ((x \<down> r) *\<^sub>C inclusion_free r) \<down> t
          = (\<Sum>u\<in>S. (x \<down> u) *\<^sub>C inclusion_free u) \<down> t\<close>
        by (simp add: \<open>S = insert r R\<close> \<open>finite R\<close> \<open>r \<notin> R\<close> plus_free.rep_eq)
      moreover have \<open>(\<Sum>u\<in>R.  ( (x \<down> u) *\<^sub>C inclusion_free u) \<down> t) +  ( (x \<down> r) *\<^sub>C inclusion_free r) \<down> t
          =  (\<Sum>u\<in>S. ((x \<down> u) *\<^sub>C inclusion_free u) \<down> t)\<close>
        by (simp add: \<open>S = insert r R\<close> \<open>finite R\<close> \<open>r \<notin> R\<close>)
      ultimately show \<open>(\<Sum>u\<in>S. (x \<down> u) *\<^sub>C inclusion_free u) \<down> t = (\<Sum>u\<in>S. ((x \<down> u) *\<^sub>C inclusion_free u) \<down> t)\<close>
        by simp
    qed
    thus ?thesis by blast
  qed
qed

lemma free_regular_for_sum_general:
  fixes x :: \<open>'a free\<close>
  assumes \<open>finite S\<close>
  shows \<open>( \<Sum> u \<in> S. (x \<down> u) *\<^sub>C (inclusion_free u) ) \<down> t
  = (\<Sum> u \<in> S. ((x \<down> u) *\<^sub>C (inclusion_free u) ) \<down> t )\<close>
  using free_regular_for_sum_general_induction assms
  by (simp add: free_regular_for_sum_general_induction)

lemma free_explicit:
  fixes X :: \<open>'a free\<close>
  shows \<open>X = (\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}. (X \<down> z) *\<^sub>C (inclusion_free z))\<close>
proof-
  have \<open>X \<down> t = (\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}. (X \<down> z) *\<^sub>C (inclusion_free z)) \<down> t\<close>
    for t
  proof (cases \<open>t \<in> {u | u. X \<down> u \<noteq> 0}\<close>)
    show "X \<down> t = (\<Sum>z\<in>{u |u. (X \<down> u) \<noteq> 0}. (X \<down> z) *\<^sub>C inclusion_free z) \<down> t"
      if "t \<in> {u |u. X \<down> u \<noteq> 0}"
    proof-
      have \<open>finite {u | u. X \<down> u \<noteq> 0}\<close>
        using times_free_vec by force
      hence \<open>(\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}. ((X \<down> z) *\<^sub>C (inclusion_free z))) \<down> t
        = (\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}. ( (X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t ) \<close>
        using free_regular_for_sum_general[where S = "{u | u. X \<down> u \<noteq> 0}" and x = "X" and t = "t"]
        by blast
      moreover have \<open>(\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}.  ( ((X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t )) =  X \<down> t\<close>
      proof-
        have \<open>(\<Sum>z\<in>{t}. ( ( X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t ) = X \<down> t\<close>
        proof-
          have \<open>(\<Sum>z\<in>{t}. ( (X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t )
            = ( ( X \<down> t) *\<^sub>C (inclusion_free t) ) \<down> t \<close>
            by simp
          also have \<open>\<dots> = X \<down> t\<close>
            apply transfer
            by auto
          finally show ?thesis by blast
        qed
        moreover have \<open>(\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0} - {t}. ( (X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t ) = 0\<close>
        proof-
          have \<open>z\<in>{u | u.  X \<down> u \<noteq> 0} - {t} \<Longrightarrow>
                ( (X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t  = 0\<close>
            for z
          proof-
            assume \<open>z\<in>{u | u. X \<down> u \<noteq> 0} - {t}\<close>
            hence \<open>z \<noteq> t\<close>
              by simp
            hence \<open>(inclusion_free z) \<down> t = 0\<close>
              apply transfer by auto
            thus \<open>( (X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t  = 0\<close>
              by (simp add: scaleC_free.rep_eq)
          qed
          thus ?thesis by simp
        qed
        moreover have \<open>(\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}.  ( ( X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t )
      = (\<Sum>z\<in>{t}. ( ( X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t )
      + (\<Sum>z\<in>{u | u.  X \<down> u \<noteq> 0} - {t}. ( (X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t )\<close>
          using \<open>finite {u |u. X \<down> u \<noteq> 0}\<close> empty_iff sum.remove that by fastforce
        ultimately show ?thesis by simp
      qed
      ultimately show \<open>X \<down> t = (\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}. (X \<down> z) *\<^sub>C (inclusion_free z)) \<down> t\<close>
        by simp
    qed
    show "X \<down> t =  (\<Sum>z\<in>{u |u. X \<down> u \<noteq> 0}. (X \<down> z) *\<^sub>C inclusion_free z) \<down> t"
      if "t \<notin> {u |u. X \<down> u \<noteq> 0}"
    proof-
      have \<open>X \<down> t = 0\<close>
        using that by simp
      moreover have \<open>(\<Sum>z\<in>{u |u. X \<down> u \<noteq> 0}. (X \<down> z) *\<^sub>C inclusion_free z) \<down> t = 0\<close>
      proof-
        have \<open>(\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}. (X \<down> z) *\<^sub>C (inclusion_free z)) \<down> t
        = (\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}.  ( (X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t ) \<close>
          using free_regular_for_sum_general[where S = "{u | u. X \<down> u \<noteq> 0}" and x = "X" and t = "t"]
          by (metis (no_types, lifting) sum.infinite zero_free.rep_eq)
        also have \<open>\<dots> = 0\<close>
        proof-
          have \<open>z\<in>{u | u. X \<down> u \<noteq> 0} \<Longrightarrow> ( (X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t = 0\<close>
            for z
          proof-
            assume \<open>z\<in>{u | u. X \<down> u \<noteq> 0}\<close>
            hence \<open>(inclusion_free z) \<down> t = 0\<close>
              by (metis inclusion_free.rep_eq that)
            thus \<open>( ( X \<down> z) *\<^sub>C (inclusion_free z) ) \<down> t = 0\<close>
              by (simp add: scaleC_free.rep_eq)
          qed
          thus ?thesis by simp
        qed
        finally show ?thesis by blast
      qed
      ultimately show ?thesis by simp
    qed
  qed
  thus \<open>X = (\<Sum>z\<in>{u | u. X \<down> u \<noteq> 0}. (X \<down> z) *\<^sub>C (inclusion_free z))\<close>
    using times_free_vec_inject by blast
qed

lemma free_span:
  \<open>complex_vector.span (range inclusion_free) = UNIV\<close>
proof
  show "complex_vector.span (range inclusion_free) \<subseteq> (UNIV::'a free set)"
    by simp
  show "(UNIV::'a free set) \<subseteq> complex_vector.span (range inclusion_free)"
  proof
    show "(x::'a free) \<in> complex_vector.span (range inclusion_free)"
      if "(x::'a free) \<in> UNIV"
      for x :: "'a free"
    proof-
      have \<open>x = (\<Sum>z\<in>{u | u. x \<down> u \<noteq> 0}. ( x \<down> z) *\<^sub>C (inclusion_free z))\<close>
        using free_explicit by blast
      thus ?thesis
        by (metis (no_types, lifting) complex_vector.span_scale complex_vector.span_sum complex_vector.span_superset rangeI subset_iff)
    qed
  qed
qed

lemma support_superset:
  fixes f :: \<open>'a \<Rightarrow> 'b::complex_vector\<close>
  assumes \<open>{u |u. x \<down> u \<noteq> 0} \<subseteq> S\<close> and \<open>finite S\<close>
  shows \<open>(\<Sum>z\<in>S. (x \<down> z) *\<^sub>C f z) =
     (\<Sum>z\<in>{u |u. x \<down> u \<noteq> 0}. (x \<down> z) *\<^sub>C f z)\<close>
proof-
  have \<open>{u |u. x \<down> u \<noteq> 0} \<union> (S-{u |u. x \<down> u \<noteq> 0}) = S\<close>
    using assms(1) by auto
  moreover have \<open>{u |u. x \<down> u \<noteq> 0} \<inter> (S-{u |u. x \<down> u \<noteq> 0}) = {}\<close>
    by simp
  ultimately have \<open>(\<Sum>z\<in>S. (x \<down> z) *\<^sub>C f z) =
   (\<Sum>z\<in>{u |u. x \<down> u \<noteq> 0}. (x \<down> z) *\<^sub>C f z)
 + (\<Sum>z\<in>S-{u |u. x \<down> u \<noteq> 0}. (x \<down> z) *\<^sub>C f z)\<close>
    using  \<open>finite S\<close>
    by (metis (no_types, lifting) add.commute assms(1) sum.subset_diff)
  moreover have \<open>(\<Sum>z\<in>S-{u |u. x \<down> u \<noteq> 0}. (x \<down> z) *\<^sub>C f z) = 0\<close>
  proof-
    have \<open>z\<in>S-{u |u. x \<down> u \<noteq> 0} \<Longrightarrow> (x \<down> z) *\<^sub>C f z = 0\<close>
      for z
    proof-
      assume \<open>z\<in>S-{u |u. x \<down> u \<noteq> 0}\<close>
      hence \<open>x \<down> z = 0\<close>
        by auto
      hence \<open>(x \<down> z) *\<^sub>C f z = 0 *\<^sub>C f z\<close>
        by simp
      also have \<open>0 *\<^sub>C (f z) = 0\<close>
        by simp
      finally show ?thesis by simp
    qed
    thus ?thesis
      by simp
  qed
  ultimately show \<open>(\<Sum>z\<in>S. (x \<down> z) *\<^sub>C f z) =
     (\<Sum>z\<in>{u |u. x \<down> u \<noteq> 0}. (x \<down> z) *\<^sub>C f z)\<close>
    by simp
qed

text\<open>Universal property of the free vector space\<close>

definition universal_free::\<open>('a \<Rightarrow> 'b::complex_vector) \<Rightarrow> ('a free \<Rightarrow> 'b)\<close>
  where \<open>universal_free f x = (\<Sum>z\<in>{u | u. x \<down> u \<noteq> 0}. (x \<down> z) *\<^sub>C ( f z ) )\<close>

lemma inclusion_free_comp:
  \<open>f = (universal_free f) \<circ> inclusion_free\<close>
proof-
  have \<open>f t = ((universal_free f) \<circ> inclusion_free) t\<close>
    for t
  proof-
    have \<open>((universal_free f) \<circ> inclusion_free) t = (universal_free f) (inclusion_free t)\<close>
      by simp
    also have \<open>\<dots> = (\<Sum>z\<in>{u | u. (inclusion_free t) \<down> u \<noteq> 0}. ((inclusion_free t) \<down> z) *\<^sub>C ( f z ) )\<close>
      using universal_free_def by blast
    also have  \<open>\<dots> = (\<Sum>z\<in>{t}. ((inclusion_free t) \<down> z) *\<^sub>C ( f z ) )\<close>
    proof-
      have \<open>{u | u. (inclusion_free t) \<down> u \<noteq> 0} = {t}\<close>
        by (smt Collect_cong inclusion_free.rep_eq singleton_conv zero_neq_one)
      thus ?thesis by simp
    qed
    also have  \<open>\<dots> = ((inclusion_free t) \<down> t) *\<^sub>C ( f t )\<close>
      by simp
    also have  \<open>\<dots> =  f t \<close>
    proof-
      have \<open>(inclusion_free t) \<down> t = 1\<close>
        by (simp add: inclusion_free.rep_eq)
      thus ?thesis by simp
    qed
    finally have \<open>((universal_free f) \<circ> inclusion_free) t = f t\<close>
      by blast
    thus ?thesis by simp
  qed
  thus ?thesis by blast
qed

lemma universal_free_clinear:
  "clinear (universal_free f)"
proof-
  have \<open>clinear (\<lambda> x. x \<down> z)\<close>
    for z::'a
    unfolding clinear_def
    by (meson clinearI clinear_def free_regular_for_sum scaleC_free.rep_eq)
  have \<open>clinear (\<lambda> x. (x \<down> z) *\<^sub>C ( f z ))\<close>
    for z
    unfolding clinear_def
  proof
    show "((b1 + b2) \<down> z) *\<^sub>C f z = (b1 \<down> z) *\<^sub>C f z + (b2 \<down> z) *\<^sub>C f z"
      for b1 :: "'a free"
        and b2 :: "'a free"
      unfolding clinear_def
      by (simp add: free_regular_for_sum scaleC_left.add)
    show "((r *\<^sub>C b) \<down> z) *\<^sub>C f z = r *\<^sub>C (b \<down> z) *\<^sub>C f z"
      for r :: complex
        and b :: "'a free"
      using \<open>clinear (\<lambda> x. (x \<down> z))\<close>
      unfolding clinear_def
      by (simp add: scaleC_free.rep_eq)
  qed
  show ?thesis unfolding universal_free_def clinear_def
  proof
    show "(\<Sum>z\<in>{u |u. (b1 + b2) \<down> u \<noteq> 0}. ( (b1 + b2) \<down> z ) *\<^sub>C f z) = (\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0}. (b1 \<down> z) *\<^sub>C f z) + (\<Sum>z\<in>{u |u. b2 \<down> u \<noteq> 0}. (b2 \<down> z) *\<^sub>C f z)"
      for b1 :: "'a free"
        and b2 :: "'a free"
    proof-
      have \<open>{u |u. (b1 + b2) \<down> u \<noteq> 0} \<subseteq>
              {u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0}\<close>
        by (smt Collect_mono_iff Un_def add.left_neutral free_regular_for_sum sup.cobounded2)
      moreover have \<open>finite ({u |u. b1 \<down> u \<noteq> 0} \<union> {u |u.  b2 \<down> u \<noteq> 0})\<close>
      proof-
        have \<open>finite {u |u. b1 \<down> u \<noteq> 0}\<close>
          using times_free_vec by blast
        moreover have \<open>finite {u |u. b2 \<down> u \<noteq> 0}\<close>
          using times_free_vec by blast
        ultimately show ?thesis by blast
      qed
      ultimately have \<open>(\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0}. ((b1 + b2) \<down> z) *\<^sub>C f z)
                    = (\<Sum>z\<in>{u |u. (b1 + b2) \<down> u \<noteq> 0}.  ((b1 + b2) \<down> z) *\<^sub>C f z)\<close>
        using support_superset[where S = "{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0}"
            and x = "(b1 + b2)" and f = "f" ]
        by blast
      hence \<open>(\<Sum>z\<in>{u |u. (b1 + b2) \<down> u \<noteq> 0}. ((b1 + b2) \<down> z) *\<^sub>C f z)
                = (\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0}.
                      ((b1 + b2) \<down> z) *\<^sub>C f z)\<close>
        by auto
      also have \<open>\<dots> = (\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u.  b2 \<down> u \<noteq> 0}.
               (b1 \<down> z + b2 \<down> z ) *\<^sub>C f z)\<close>
        by (metis free_regular_for_sum)
      also have \<open>\<dots> = (\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u.  b2 \<down> u \<noteq> 0}.
               (b1 \<down> z) *\<^sub>C f z + (b2 \<down> z) *\<^sub>C f z)\<close>
        by (meson scaleC_add_left)
      also have \<open>\<dots> = (\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u.  b2 \<down> u \<noteq> 0}.
               (b1 \<down> z) *\<^sub>C f z)
          +  (\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0}.
               (b2 \<down> z) *\<^sub>C f z)\<close>
        using sum.distrib by force
      finally have \<open>(\<Sum>z\<in>{u |u. (b1 + b2) \<down> u \<noteq> 0}. ((b1 + b2) \<down> z) *\<^sub>C f z)
            = (\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0}.
               (b1 \<down> z) *\<^sub>C f z)
          +  (\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0}.
               (b2 \<down> z) *\<^sub>C f z)\<close>
        by blast
      moreover have \<open>(\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u.  b2 \<down> u \<noteq> 0}.
               (b1 \<down> z) *\<^sub>C f z)
                = (\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0}. (b1 \<down> z) *\<^sub>C f z)\<close>
      proof-
        have \<open>{u |u. b1 \<down> u \<noteq> 0} \<subseteq> {u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0}\<close>
          by blast
        thus ?thesis
          by (metis (mono_tags) \<open>finite ({u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0})\<close> support_superset)
      qed
      moreover have \<open>(\<Sum>z\<in>{u |u. b1 \<down> u \<noteq> 0} \<union> {u |u.  b2 \<down> u \<noteq> 0}. (b2 \<down> z) *\<^sub>C f z)
                = (\<Sum>z\<in>{u |u. b2 \<down> u \<noteq> 0}. (b2 \<down> z) *\<^sub>C f z)\<close>
      proof-
        have \<open>{u |u. b2 \<down> u \<noteq> 0} \<subseteq> {u |u. b1 \<down> u \<noteq> 0} \<union> {u |u.  b2 \<down> u \<noteq> 0}\<close>
          by blast
        thus ?thesis
          by (metis (mono_tags) \<open>finite ({u |u. b1 \<down> u \<noteq> 0} \<union> {u |u. b2 \<down> u \<noteq> 0})\<close> support_superset)
      qed
      ultimately show ?thesis by simp
    qed
    show "(\<Sum>z\<in>{u |u.  (r *\<^sub>C b) \<down> u \<noteq> 0}.  ((r *\<^sub>C b) \<down> z) *\<^sub>C f z) = r *\<^sub>C (\<Sum>z\<in>{u |u. b \<down> u \<noteq> 0}. (b \<down> z) *\<^sub>C f z)"
      for r :: complex
        and b :: "'a free"
    proof (cases \<open>r = 0\<close>)
      show "(\<Sum>z\<in>{u |u. (r *\<^sub>C b) \<down> u \<noteq> 0}. ( (r *\<^sub>C b) \<down> z ) *\<^sub>C f z) = r *\<^sub>C (\<Sum>z\<in>{u |u. b \<down> u \<noteq> 0}. (b \<down> z) *\<^sub>C f z)"
        if "r = 0"
        using that
        by (metis (no_types, lifting) add.left_neutral add_cancel_left_right complex_vector.scale_eq_0_iff free_regular_for_sum sum.not_neutral_contains_not_neutral)
      show "(\<Sum>z\<in>{u |u. (r *\<^sub>C b) \<down> u \<noteq> 0}. ( (r *\<^sub>C b) \<down> z ) *\<^sub>C f z) = r *\<^sub>C (\<Sum>z\<in>{u |u. b \<down> u \<noteq> 0}. (b \<down> z) *\<^sub>C f z)"
        if "r \<noteq> 0"
        using that
      proof-
        have \<open>{u |u.  (r *\<^sub>C b) \<down> u \<noteq> 0} = {u |u.  b \<down> u \<noteq> 0}\<close>
          by (metis complex_vector.scale_eq_0_iff scaleC_free.rep_eq that)
        hence \<open>(\<Sum>z\<in>{u |u. (r *\<^sub>C b) \<down> u \<noteq> 0}.  ((r *\<^sub>C b) \<down> z) *\<^sub>C f z)
                   = (\<Sum>z\<in>{u |u. b \<down> u \<noteq> 0}. ((r *\<^sub>C b) \<down> z) *\<^sub>C f z)\<close>
          by simp
        moreover have \<open>(r *\<^sub>C b) \<down> u = r *\<^sub>C (b \<down> u)\<close>
          for u
          by (simp add: scaleC_free.rep_eq)
        ultimately have \<open>(\<Sum>z\<in>{u |u. (r *\<^sub>C b) \<down> u \<noteq> 0}.  ((r *\<^sub>C b) \<down> z) *\<^sub>C f z)
                   = (\<Sum>z\<in>{u |u. b \<down> u \<noteq> 0}. r *\<^sub>C (b \<down> z) *\<^sub>C f z)\<close>
          by simp
        thus ?thesis
          by (metis (mono_tags, lifting) scaleC_right.sum sum.cong)
      qed
    qed
  qed
qed

lemma universal_free_uniq:
  assumes \<open>clinear G\<close> and \<open>f = G \<circ> inclusion_free\<close>
  shows \<open>G = universal_free f\<close>
proof-
  have \<open>clinear (universal_free f)\<close>
    by (simp add: universal_free_clinear)
  moreover have \<open>f = (universal_free f) \<circ> inclusion_free\<close>
    by (simp add: inclusion_free_comp)
  ultimately have \<open>x \<in> (range inclusion_free) \<Longrightarrow> G x = (universal_free f) x\<close>
    for x
    using \<open>f = G \<circ> inclusion_free\<close>
    by (metis comp_eq_elim f_inv_into_f)
  hence \<open>x \<in> complex_vector.span (range inclusion_free) \<Longrightarrow> G x = (universal_free f) x\<close>
    for x
    using \<open>clinear (universal_free f)\<close> assms(1) complex_vector.module_hom_eq_on_span
    by (metis (mono_tags, lifting) cspan_raw_def)

  hence \<open>G x = (universal_free f) x\<close>
    for x
    by (simp add: free_span)
  thus ?thesis by blast
qed

theorem free_universal_property:
  fixes f:: \<open>'a \<Rightarrow> 'b::complex_vector\<close>
  shows \<open>\<exists>!F::'a free \<Rightarrow> 'b. clinear F \<and> f = F \<circ> inclusion_free\<close>
proof
  show "clinear (universal_free f) \<and> f = (universal_free f) \<circ> inclusion_free"
    by (simp add: inclusion_free_comp universal_free_clinear)

  show "F = (universal_free f)"
    if "clinear F \<and> f = F \<circ> inclusion_free"
    for F :: "'a free \<Rightarrow> 'b"
    using that
    by (simp add: universal_free_uniq)
qed

lemma inclusion_free_inj:
  assumes \<open>inclusion_free x = inclusion_free y\<close>
  shows \<open>x = y\<close>
  by (metis assms inclusion_free.rep_eq zero_neq_one)

(* TODO: I wonder if it is easier to use when defining it as
  lift_definition ... is
      "\<lambda>f x b. \<Sum>a\<in>{a|a. x a \<noteq> 0 \<and> f a = b}. x a"
  (It should be the same in the end.)
*)
definition free_map :: \<open>('a\<Rightarrow>'b) \<Rightarrow> ('a free\<Rightarrow>'b free)\<close>
  where \<open>free_map f x = (\<Sum>a\<in>{a|a. x\<down>a \<noteq> 0}. (x\<down>a) *\<^sub>C inclusion_free (f a))\<close>

lemma free_map_clinear:
  \<open>clinear (free_map f)\<close>
  unfolding clinear_def
proof
  show "free_map f (b1 + b2) = free_map f b1 + free_map f b2"
    for b1 :: "'a free"
      and b2 :: "'a free"
  proof-
    have \<open>free_map f (b1 + b2) =
          (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}.
       ((b1 + b2) \<down> a) *\<^sub>C inclusion_free (f a))\<close>
      unfolding free_map_def
      by blast
    also have \<open>\<dots> =
          (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}.
       (b1 \<down> a) *\<^sub>C inclusion_free (f a) + (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
      by (metis (no_types, lifting) plus_free.rep_eq scaleC_left.add)
    also have \<open>\<dots> =
          (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))
        + (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
      using sum.distrib by force
    also have \<open>\<dots> =
    (\<Sum>a\<in>{a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a)) +
    (\<Sum>a\<in>{a |a. b2 \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
    proof-
      have  \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a)) =
            (\<Sum>a\<in>{a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a)) -
            (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b1 \<down> a \<noteq> 0}.
           (b1 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
      proof-
        have \<open>finite {a |a. (b1 + b2) \<down> a \<noteq> 0}\<close>
          using times_free_vec by fastforce
        hence \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))
             = (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}\<inter>{a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))
             + (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}-{a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
          using sum.Int_Diff by blast
        moreover have \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}-{a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a)) = 0\<close>
        proof-
          have \<open>i\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}-{a |a. b1 \<down> a \<noteq> 0} \<Longrightarrow> (b1 \<down> i) *\<^sub>C inclusion_free (f i) = 0\<close>
            for i
          proof-
            assume \<open>i\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}-{a |a. b1 \<down> a \<noteq> 0}\<close>
            hence  \<open>(b1 \<down> i) = 0\<close>
              by simp
            thus ?thesis
              by simp
          qed
          thus ?thesis
            by simp
        qed
        ultimately have \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))
             = (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}\<inter>{a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
          by simp
        also have \<open>\<dots> = (\<Sum>a\<in>{a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))
                      - (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a = 0}\<inter>{a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
        proof-
          have \<open>{a |a. (b1 + b2) \<down> a \<noteq> 0}\<inter>{a |a. b1 \<down> a \<noteq> 0}
              = {a |a. b1 \<down> a \<noteq> 0}-({a |a. (b1 + b2) \<down> a = 0}\<inter>{a |a. b1 \<down> a \<noteq> 0})\<close>
            by auto
          moreover have \<open>{a |a. (b1 + b2) \<down> a = 0}\<inter>{a |a. b1 \<down> a \<noteq> 0} \<subseteq> {a |a. b1 \<down> a \<noteq> 0}\<close>
            by auto
          moreover have \<open>finite  {a |a. b1 \<down> a \<noteq> 0}\<close>
            using times_free_vec by auto
          ultimately show ?thesis
            by (simp add: sum_diff)
        qed
        finally show \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a)) =
  (\<Sum>a\<in>{a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a)) -
  (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b1 \<down> a \<noteq> 0}.
     (b1 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
          by blast
      qed
      moreover have \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a)) =
            (\<Sum>a\<in>{a |a. b2 \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a)) -
            (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b2 \<down> a \<noteq> 0}.
           (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
      proof-
        have \<open>finite {a |a. (b1 + b2) \<down> a \<noteq> 0}\<close>
          using times_free_vec by fastforce
        hence \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a))
             = (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}\<inter>{a |a. b2 \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a))
             + (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}-{a |a. b2 \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
          using sum.Int_Diff by blast
        moreover have \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}-{a |a. b2 \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a)) = 0\<close>
        proof-
          have \<open>i\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}-{a |a. b2 \<down> a \<noteq> 0} \<Longrightarrow> (b2 \<down> i) *\<^sub>C inclusion_free (f i) = 0\<close>
            for i
          proof-
            assume \<open>i\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}-{a |a. b2 \<down> a \<noteq> 0}\<close>
            hence  \<open>(b2 \<down> i) = 0\<close>
              by simp
            thus ?thesis
              by simp
          qed
          thus ?thesis
            by simp
        qed
        ultimately have \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a))
             = (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}\<inter>{a |a. b2 \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
          by simp
        also have \<open>\<dots> = (\<Sum>a\<in>{a |a. b2 \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a))
                      - (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a = 0}\<inter>{a |a. b2 \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
        proof-
          have \<open>{a |a. (b1 + b2) \<down> a \<noteq> 0}\<inter>{a |a. b2 \<down> a \<noteq> 0}
              = {a |a. b2 \<down> a \<noteq> 0}-({a |a. (b1 + b2) \<down> a = 0}\<inter>{a |a. b2 \<down> a \<noteq> 0})\<close>
            by auto
          moreover have \<open>{a |a. (b1 + b2) \<down> a = 0}\<inter>{a |a. b2 \<down> a \<noteq> 0} \<subseteq> {a |a. b2 \<down> a \<noteq> 0}\<close>
            by auto
          moreover have \<open>finite  {a |a. b2 \<down> a \<noteq> 0}\<close>
            using times_free_vec by auto
          ultimately show ?thesis
            by (simp add: sum_diff)
        qed
        finally show \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a)) =
  (\<Sum>a\<in>{a |a. b2 \<down> a \<noteq> 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a)) -
  (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b2 \<down> a \<noteq> 0}.
     (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
          by blast
      qed
      moreover have \<open>(\<Sum>a\<in>{a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b1 \<down> a \<noteq> 0}.
           (b1 \<down> a) *\<^sub>C inclusion_free (f a)) + (\<Sum>a\<in>{a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b2 \<down> a \<noteq> 0}.
           (b2 \<down> a) *\<^sub>C inclusion_free (f a)) = 0\<close>
      proof-
        have \<open>finite S \<Longrightarrow> (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b1 \<down> a \<noteq> 0}.
           (b1 \<down> a) *\<^sub>C inclusion_free (f a)) =
              (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
          for S
        proof-
          assume \<open>finite S\<close>
          have \<open>(\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))
              = (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))
              + (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0} - {a |a. b1 \<down> a \<noteq> 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
            using \<open>finite S\<close> finite_Int sum.Int_Diff by blast
          moreover have \<open>(\<Sum>a\<in>S\<inter>{a |a. (b1 + b2) \<down> a = 0}-{a |a. b1 \<down> a \<noteq> 0}.
                        (b1 \<down> a) *\<^sub>C inclusion_free (f a)) = 0\<close>
          proof-
            have \<open>i\<in>S\<inter>{a |a. (b1 + b2) \<down> a = 0}-{a |a. b1 \<down> a \<noteq> 0} \<Longrightarrow> (b1 \<down> i) = 0\<close>
              for i
              by auto
            thus ?thesis
              by (metis (mono_tags, lifting) complex_vector.scale_eq_0_iff sum.not_neutral_contains_not_neutral)
          qed
          ultimately have \<open>(\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b1 \<down> a \<noteq> 0}.
           (b1 \<down> a) *\<^sub>C inclusion_free (f a)) =
              (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
            by auto
          thus ?thesis
            by blast
        qed
        moreover have \<open>finite S \<Longrightarrow> (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b2 \<down> a \<noteq> 0}.
           (b2 \<down> a) *\<^sub>C inclusion_free (f a)) =
              (\<Sum>a\<in>S \<inter>{a |a. (b1 + b2) \<down> a = 0}.
           (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
          for S
          by (smt complex_vector.scale_eq_0_iff finite_Int mem_Collect_eq sum.cong sum.inter_restrict)
            (* > 1 s *)
        moreover have \<open>finite S \<Longrightarrow> (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))
           + (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a)) = 0\<close>
          for S
        proof-
          assume \<open>finite S\<close>
          have \<open>(\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a))
          + (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. (b2 \<down> a) *\<^sub>C inclusion_free (f a)) =
            (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. (b1 \<down> a) *\<^sub>C inclusion_free (f a)
          + (b2 \<down> a) *\<^sub>C inclusion_free (f a))\<close>
            by (simp add: sum.distrib)
          also have \<open>\<dots> = (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}.
              ( (b1 \<down> a) + (b2 \<down> a) ) *\<^sub>C inclusion_free (f a))\<close>
            by (metis (no_types, lifting) scaleC_add_left)
          also have \<open>\<dots> = (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. 0 *\<^sub>C inclusion_free (f a))\<close>
            by (simp add: free_regular_for_sum)
          also have \<open>\<dots> = (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0}. 0)\<close>
            by simp
          also have \<open>\<dots> = 0\<close>
            by simp
          finally show ?thesis by blast
        qed
        ultimately have finite_thesis: \<open>finite S \<Longrightarrow> (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b1 \<down> a \<noteq> 0}.
       (b1 \<down> a) *\<^sub>C inclusion_free (f a)) +
    (\<Sum>a\<in>S \<inter> {a |a. (b1 + b2) \<down> a = 0} \<inter> {a |a. b2 \<down> a \<noteq> 0}.
       (b2 \<down> a) *\<^sub>C inclusion_free (f a)) = 0\<close>
          for S
          by simp
        have \<open>finite ({a |a. b1 \<down> a \<noteq> 0} \<union> {a |a. b2 \<down> a \<noteq> 0})\<close>
          using times_free_vec by force
        thus ?thesis
          using finite_thesis[where S = "{a |a. b1 \<down> a \<noteq> 0} \<union> {a |a. b2 \<down> a \<noteq> 0}"]
          by (smt inf_sup_absorb inf_sup_aci(1) inf_sup_aci(3) inf_sup_aci(5))
      qed
      ultimately show ?thesis
        by (metis (no_types, lifting) add_diff_add diff_zero)
    qed
    also have \<open>\<dots> = free_map f b1 + free_map f b2\<close>
      unfolding free_map_def
      by blast
    finally show ?thesis by simp
  qed

  show "free_map f (r *\<^sub>C b) = r *\<^sub>C free_map f b"
    for r :: complex
      and b :: "'a free"
  proof (cases \<open>r = 0\<close>)
    show "free_map f (r *\<^sub>C b) = r *\<^sub>C free_map f b"
      if "r = 0"
      using that unfolding free_map_def
      by (metis (no_types, lifting) complex_vector.scale_eq_0_iff scaleC_free.rep_eq sum.not_neutral_contains_not_neutral)

    show "free_map f (r *\<^sub>C b) = r *\<^sub>C free_map f b"
      if "r \<noteq> 0"
    proof-
      have \<open>{a |a. r *\<^sub>C b \<down> a \<noteq> 0} = {a |a. b \<down> a \<noteq> 0}\<close>
        by (metis  complex_vector.scale_eq_0_iff scaleC_free.rep_eq that)
      moreover have \<open>(r *\<^sub>C b) \<down> a = r *\<^sub>C (b \<down> a)\<close>
        for a
        by (simp add: scaleC_free.rep_eq)
      moreover have \<open> (\<Sum>a\<in>{a |a. b \<down> a \<noteq> 0}. r *\<^sub>C (b \<down> a) *\<^sub>C inclusion_free (f a)) =
        r *\<^sub>C (\<Sum>a\<in>{a |a. b \<down> a \<noteq> 0}. (b \<down> a) *\<^sub>C inclusion_free (f a))\<close>
        by (metis (mono_tags, lifting) scaleC_right.sum sum.cong)
      ultimately show ?thesis
        using that unfolding free_map_def
        by auto
    qed
  qed
qed

functor free_map
proof
  show "(free_map (f::'b \<Rightarrow> 'c) \<circ> free_map g) (x::'a free) = free_map (f \<circ> g) x"
    for f :: "'b \<Rightarrow> 'c"
      and g :: "'a \<Rightarrow> 'b"
      and x :: "'a free"
  proof-
    have \<open>clinear (free_map f)\<close>
      by (simp add: free_map_clinear)
    have \<open>(free_map f \<circ> free_map g) x = free_map f (free_map g x)\<close>
      by simp
    also have \<open>\<dots> = free_map f (\<Sum>a\<in>{a|a. x\<down>a \<noteq> 0}. (x\<down>a) *\<^sub>C inclusion_free (g a))\<close>
      using free_map_def
      by metis
    also have \<open>\<dots> = (\<Sum>a\<in>{a|a. x\<down>a \<noteq> 0}. (x\<down>a) *\<^sub>C ((free_map f) (inclusion_free (g a))))\<close>
      using  \<open>clinear (free_map f)\<close>
      by (smt complex_vector.linear_scale complex_vector.linear_sum sum.cong)
    also have \<open>\<dots> = (\<Sum>a\<in>{a|a. x\<down>a \<noteq> 0}. (x\<down>a) *\<^sub>C inclusion_free ((f \<circ> g) a))\<close>
    proof-
      have \<open>(free_map f) (inclusion_free (g i)) = inclusion_free ((f \<circ> g) i)\<close>
        for i
      proof-
        have \<open>(free_map f) (inclusion_free (g i)) =
         (\<Sum>a\<in>{a |a. inclusion_free (g i) \<down> a \<noteq> 0}.
                (inclusion_free (g i) \<down> a) *\<^sub>C inclusion_free (f a))\<close>
          unfolding free_map_def
          by blast
        also have \<open>\<dots> = (\<Sum>a\<in>{a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}.
                (inclusion_free ((f \<circ> g) i) \<down> a) *\<^sub>C (inclusion_free a))\<close>
        proof-
          have \<open>(\<Sum>a\<in>{a |a. inclusion_free (g i) \<down> a \<noteq> 0}.
       (inclusion_free (g i) \<down> a) *\<^sub>C inclusion_free (f a))
          = inclusion_free (f (g i))\<close>
          proof-
            have \<open>finite {a |a. inclusion_free (g i) \<down> a \<noteq> 0}\<close>
              using times_free_vec
              by blast
            moreover have \<open>g i \<in> {a |a. inclusion_free (g i) \<down> a \<noteq> 0}\<close>
              apply transfer
              by simp
            ultimately have \<open>(\<Sum>a\<in>{a |a. inclusion_free (g i) \<down> a \<noteq> 0}.
       (inclusion_free (g i) \<down> a) *\<^sub>C inclusion_free (f a))
          = ((inclusion_free (g i) \<down> (g i)) *\<^sub>C inclusion_free (f (g i)))
          + (\<Sum>a\<in>{a |a. inclusion_free (g i) \<down> a \<noteq> 0}-{g i}.
       (inclusion_free (g i) \<down> a) *\<^sub>C inclusion_free (f a))\<close>
              by (simp add: sum.remove)
            also have \<open>\<dots> = ((inclusion_free (g i) \<down> (g i)) *\<^sub>C inclusion_free (f (g i)))\<close>
            proof-
              have \<open>j\<in>{a |a. inclusion_free (g i) \<down> a \<noteq> 0}-{g i} \<Longrightarrow>
                     (inclusion_free (g i) \<down> j) *\<^sub>C inclusion_free (f j) = 0\<close>
                for j
              proof-
                assume \<open>j\<in>{a |a. inclusion_free (g i) \<down> a \<noteq> 0}-{g i}\<close>
                hence \<open>j \<noteq> g i\<close>
                  by simp
                hence \<open>inclusion_free (g i) \<down> j = 0\<close>
                  by (simp add: inclusion_free.rep_eq)
                thus ?thesis by simp
              qed
              hence \<open>(\<Sum>a\<in>{a |a. inclusion_free (g i) \<down> a \<noteq> 0}-{g i}.
              (inclusion_free (g i) \<down> a) *\<^sub>C inclusion_free (f a)) = 0\<close>
                by simp
              thus ?thesis by simp
            qed
            also have \<open>\<dots> = inclusion_free (f (g i))\<close>
            proof-
              have \<open>inclusion_free (g i) \<down> (g i) = 1\<close>
                by (simp add: inclusion_free.rep_eq)
              thus ?thesis by simp
            qed
            finally show ?thesis by blast
          qed
          moreover have \<open>(\<Sum>a\<in>{a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}.
                     (inclusion_free ((f \<circ> g) i) \<down> a) *\<^sub>C inclusion_free a)
          = inclusion_free (f (g i))\<close>
          proof-
            have \<open>finite {a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}\<close>
              using times_free_vec by simp
            moreover have \<open>(f \<circ> g) i \<in> {a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}\<close>
              by (simp add: inclusion_free.rep_eq)
            ultimately have \<open>(\<Sum>a\<in>{a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}.
                     (inclusion_free ((f \<circ> g) i) \<down> a) *\<^sub>C inclusion_free a)
              = (inclusion_free ((f \<circ> g) i) \<down> ((f \<circ> g) i)) *\<^sub>C inclusion_free ((f \<circ> g) i)
                  + (\<Sum>a\<in>{a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}-{(f \<circ> g) i}.
                     (inclusion_free ((f \<circ> g) i) \<down> a) *\<^sub>C inclusion_free a)\<close>
              by (simp add: sum.remove)
            also have \<open>\<dots> = (inclusion_free ((f \<circ> g) i) \<down> ((f \<circ> g) i)) *\<^sub>C inclusion_free ((f \<circ> g) i)\<close>
            proof-
              have \<open>j\<in>{a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}-{(f \<circ> g) i} \<Longrightarrow>
                  (inclusion_free ((f \<circ> g) i) \<down> j) *\<^sub>C inclusion_free j = 0\<close>
                for j
              proof-
                assume \<open>j\<in>{a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}-{(f \<circ> g) i}\<close>
                hence \<open>j \<noteq> (f \<circ> g) i\<close>
                  by simp
                hence \<open>inclusion_free ((f \<circ> g) i) \<down> j = 0\<close>
                  by (simp add: inclusion_free.rep_eq)
                thus ?thesis by simp
              qed
              hence \<open>(\<Sum>a\<in>{a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}-{(f \<circ> g) i}.
                     (inclusion_free ((f \<circ> g) i) \<down> a) *\<^sub>C inclusion_free a) = 0\<close>
                by simp
              thus ?thesis by simp
            qed
            also have  \<open>\<dots> = inclusion_free ((f \<circ> g) i)\<close>
            proof-
              have \<open>(inclusion_free ((f \<circ> g) i) \<down> ((f \<circ> g) i)) = 1\<close>
                by (simp add: inclusion_free.rep_eq)
              thus ?thesis by simp
            qed
            finally show ?thesis by simp
          qed
          ultimately show \<open>(\<Sum>a\<in>{a |a. inclusion_free (g i) \<down> a \<noteq> 0}.
       (inclusion_free (g i) \<down> a) *\<^sub>C inclusion_free (f a)) =
                (\<Sum>a\<in>{a |a. inclusion_free ((f \<circ> g) i) \<down> a \<noteq> 0}.
       (inclusion_free ((f \<circ> g) i) \<down> a) *\<^sub>C inclusion_free a)\<close>
            by simp
        qed
        also have \<open>\<dots> =  inclusion_free ((f \<circ> g) i)\<close>
          by (metis (no_types) free_explicit)
        finally show ?thesis by blast
      qed
      thus ?thesis by simp
    qed
    also have \<open>\<dots> = free_map (f \<circ> g) x\<close>
      by (metis free_map_def)
    finally have \<open>(free_map f \<circ> free_map g) x = free_map (f \<circ> g) x\<close>
      by blast
    thus ?thesis by blast
  qed
  show "free_map (id::'a \<Rightarrow> _) = id"
  proof
    show "free_map id (x::'a free) = id x"
      for x :: "'a free"
    proof-
      have \<open>(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free (id a)) \<down> i = x \<down> i\<close>
        for i
      proof-
        have \<open>(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free (id a)) \<down> i =
            (\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free a) \<down> i \<close>
          by simp
        also have \<open>\<dots> = (\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. ((x \<down> a) *\<^sub>C inclusion_free a) \<down> i)\<close>
        proof-
          define f::\<open>'a free \<Rightarrow> complex\<close> where \<open>f t = t \<down> i\<close> for t
          define \<gamma> where \<open>\<gamma> a = ((x \<down> a) *\<^sub>C inclusion_free a)\<close> for a
          define S where \<open>S = \<gamma> ` {a |a. x \<down> a \<noteq> 0}\<close>
          have \<open>f (p + q) = f p + f q\<close>
            for p q
            by (simp add: \<open>f \<equiv> \<lambda>t. t \<down> i\<close> free_regular_for_sum)
          moreover have \<open>finite {a |a. x \<down> a \<noteq> 0}\<close>
            using times_free_vec by force
          ultimately have \<open>f (\<Sum>a\<in>S. a) = (\<Sum>a\<in>S. f a)\<close>
            sorry
          thus ?thesis unfolding S_def f_def \<gamma>_def
            using \<open>finite {a |a. x \<down> a \<noteq> 0}\<close> free_regular_for_sum_general
            by fastforce
        qed
        also have \<open>\<dots> = ((x \<down> i) *\<^sub>C inclusion_free i) \<down> i\<close>
        proof (cases \<open>i \<in> {a |a. x \<down> a \<noteq> 0}\<close>)
          show "(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free a \<down> i) = (x \<down> i) *\<^sub>C inclusion_free i \<down> i"
            if "i \<in> {a |a. x \<down> a \<noteq> 0}"
          proof-
            have \<open>finite {a |a. x \<down> a \<noteq> 0}\<close>
              using times_free_vec by fastforce
            hence \<open>(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free a \<down> i) = (x \<down> i) *\<^sub>C inclusion_free i \<down> i
              + (\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}-{i}. (x \<down> a) *\<^sub>C inclusion_free a \<down> i)\<close>
              using sum.remove that by fastforce
            moreover have \<open>(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}-{i}. (x \<down> a) *\<^sub>C inclusion_free a \<down> i) = 0\<close>
            proof-
              have \<open>j\<in>{a |a. x \<down> a \<noteq> 0}-{i} \<Longrightarrow> (x \<down> j) *\<^sub>C inclusion_free j \<down> i = 0\<close>
                for j
              proof-
                assume \<open>j\<in>{a |a. x \<down> a \<noteq> 0}-{i}\<close>
                hence \<open>j \<noteq> i\<close>
                  by auto
                thus ?thesis
                  by (metis complex_vector.scale_eq_0_iff inclusion_free.rep_eq scaleC_free.rep_eq)
              qed
              thus ?thesis
                by simp
            qed
            ultimately show ?thesis by simp
          qed
          show "(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free a \<down> i) = (x \<down> i) *\<^sub>C inclusion_free i \<down> i"
            if "i \<notin> {a |a. x \<down> a \<noteq> 0}"
          proof-
            have \<open>(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free a \<down> i) = 0\<close>
            proof-
              have \<open>j\<in>{a |a. x \<down> a \<noteq> 0} \<Longrightarrow> (x \<down> j) *\<^sub>C inclusion_free j \<down> i = 0\<close>
                for j
              proof-
                assume \<open>j\<in>{a |a. x \<down> a \<noteq> 0}\<close>
                hence \<open>j \<noteq> i\<close>
                  using that by auto
                thus ?thesis
                  by (metis complex_vector.scale_eq_0_iff inclusion_free.rep_eq scaleC_free.rep_eq)
              qed
              thus ?thesis
                by simp
            qed
            moreover have \<open>(x \<down> i) *\<^sub>C inclusion_free i \<down> i = 0\<close>
              by (metis (mono_tags, lifting) complex_vector.scale_eq_0_iff mem_Collect_eq scaleC_free.rep_eq that)
            ultimately show ?thesis by simp
          qed
        qed
        also have \<open>\<dots> = (x \<down> i)\<close>
          by (metis \<open>(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free a \<down> i) = (x \<down> i) *\<^sub>C inclusion_free i \<down> i\<close> \<open>(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free a) \<down> i = (\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free a \<down> i)\<close> free_explicit)
        finally show ?thesis by blast
      qed
      hence \<open>times_free_vec (\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free (id a))
        = times_free_vec x\<close>
        by blast
      hence \<open>(\<Sum>a\<in>{a |a. x \<down> a \<noteq> 0}. (x \<down> a) *\<^sub>C inclusion_free (id a)) = x\<close>
        using times_free_vec_inject by auto
      thus ?thesis
        unfolding free_map_def
        by auto
    qed
  qed
qed

unbundle no_free_notation

end


(* Author: Maximilian Schäffeler *)

theory Splitting_Methods
  imports
    Value_Iteration
    Policy_Iteration
begin

section \<open>Value Iteration using Splitting Methods\<close>

subsection \<open>Regular Splittings for Matrices and Bounded Linear Functions\<close>

definition "is_splitting_blin X Q R \<longleftrightarrow>
  X = Q - R \<and> invertible\<^sub>L Q \<and> nonneg_blinfun (inv\<^sub>L Q) \<and> nonneg_blinfun R"

lemma is_splitting_blinD[dest]:
  assumes "is_splitting_blin X Q R"
  shows "X = Q - R" "invertible\<^sub>L Q" "nonneg_blinfun (inv\<^sub>L Q)" "nonneg_blinfun R"
  using is_splitting_blin_def assms by auto

lemma is_splitting_blinI[intro]:
  assumes "X = Q - R" "invertible\<^sub>L Q" "nonneg_blinfun (inv\<^sub>L Q)" "nonneg_blinfun R"
  shows "is_splitting_blin X Q R"
  using is_splitting_blin_def assms by auto

subsection \<open>Splitting Methods for MDPs\<close>

locale MDP_QR = MDP_att_\<L> A K r l
  for A :: "'s::countable \<Rightarrow> 'a::countable set"
    and K :: "('s \<times> 'a) \<Rightarrow> 's pmf"
    and r l +
  fixes Q R :: "('s \<Rightarrow> 'a) \<Rightarrow> ('s \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('s \<Rightarrow>\<^sub>b real)"
  assumes is_splitting: "\<And>d. d \<in> D\<^sub>D \<Longrightarrow> is_splitting_blin (id_blinfun - l *\<^sub>R \<P>\<^sub>1 (mk_dec_det d)) (Q d) (R d)"
  and QR_contraction: "(\<Squnion>d\<in>D\<^sub>D. norm (inv\<^sub>L (Q d) o\<^sub>L R d)) < 1"
  and QR_bdd: "bdd_above ((\<lambda>d. norm (inv\<^sub>L (Q d) o\<^sub>L R d)) ` D\<^sub>D)"
  and Q_bdd: "bounded ((\<lambda>d. norm (inv\<^sub>L (Q d))) ` D\<^sub>D)"
  and arg_max_ex_split: "\<exists>d. \<forall>s. is_arg_max (\<lambda>d. inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v) s) (\<lambda>d. d \<in> D\<^sub>D) d"
begin

lemma inv_Q_mono: "d \<in> D\<^sub>D \<Longrightarrow> u \<le> v \<Longrightarrow> (inv\<^sub>L (Q d)) u \<le> (inv\<^sub>L (Q d)) v"
  using is_splitting
  by (auto intro!: nonneg_blinfun_mono)

lemma splitting_eq: "d \<in> D\<^sub>D \<Longrightarrow> Q d - R d = (id_blinfun - l *\<^sub>R \<P>\<^sub>1 (mk_dec_det d))"
  using is_splitting
  by fastforce

lemma Q_nonneg: "d \<in> D\<^sub>D \<Longrightarrow> 0 \<le> v \<Longrightarrow> 0 \<le> inv\<^sub>L (Q d) v"
  using is_splitting nonneg_blinfun_nonneg
  by auto

lemma Q_invertible: "d \<in> D\<^sub>D \<Longrightarrow> invertible\<^sub>L (Q d)"
  using is_splitting
  by auto

lemma R_nonneg: "d \<in> D\<^sub>D \<Longrightarrow> 0 \<le> v \<Longrightarrow> 0 \<le> R d v"
  using is_splitting_blinD[OF is_splitting]
  by (fastforce simp: nonneg_blinfun_nonneg intro: nonneg_blinfun_mono)

lemma R_mono: "d \<in> D\<^sub>D \<Longrightarrow> u \<le> v \<Longrightarrow> (R d) u \<le> (R d) v"
  using R_nonneg[of d "v - u"]
  by (auto simp: blinfun.bilinear_simps)

lemma QR_nonneg: "d \<in> D\<^sub>D \<Longrightarrow> 0 \<le> v \<Longrightarrow> 0 \<le> (inv\<^sub>L (Q d) o\<^sub>L R d) v"
  by (simp add: Q_nonneg R_nonneg)

lemma QR_mono: "d \<in> D\<^sub>D \<Longrightarrow> u \<le> v \<Longrightarrow> (inv\<^sub>L (Q d) o\<^sub>L R d) u \<le> (inv\<^sub>L (Q d) o\<^sub>L R d) v"
  using QR_nonneg[of d "v - u"]
  by (auto simp: blinfun.bilinear_simps)

lemma norm_QR_less_one: "d \<in> D\<^sub>D \<Longrightarrow> norm (inv\<^sub>L (Q d) o\<^sub>L R d) < 1"
  using QR_bdd
  by (auto intro: cSUP_lessD[OF _ QR_contraction])

lemma splitting: "d \<in> D\<^sub>D \<Longrightarrow> id_blinfun - l *\<^sub>R \<P>\<^sub>1 (mk_dec_det d) = Q d - R d"
  using is_splitting
  by auto

subsection \<open>Discount Factor @{term "QR_disc"}\<close>
abbreviation "QR_disc \<equiv> (\<Squnion>d \<in> D\<^sub>D. norm (inv\<^sub>L (Q d) o\<^sub>L R d))"

lemma QR_le_QR_disc: "d \<in> D\<^sub>D \<Longrightarrow> norm (inv\<^sub>L (Q d) o\<^sub>L (R d)) \<le> QR_disc"
  using QR_bdd
  by (auto intro!: cSUP_upper)

lemma a_nonneg: "0 \<le> QR_disc"
  using QR_contraction norm_ge_zero ex_dec_det QR_bdd
  by (fastforce intro!: cSUP_upper2)

subsection \<open>Bellman-Operator\<close>
abbreviation "L_split d v \<equiv> inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v)"

definition "\<L>_split v s = (\<Squnion>d \<in> D\<^sub>D. L_split d v s)"

lemma \<L>_split_bfun_aux:
  assumes "d \<in> D\<^sub>D"
  shows "norm (L_split d v) \<le> (\<Squnion>d \<in> D\<^sub>D. norm (inv\<^sub>L (Q d))) * r\<^sub>M + norm v"
proof -
  have "norm (L_split d v) \<le> norm (inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d))) + norm (inv\<^sub>L (Q d) (R d v))"
    by (simp add: blinfun.add_right norm_triangle_ineq)
  also have "\<dots> \<le> norm (inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d))) + norm (inv\<^sub>L (Q d) o\<^sub>L R d) * norm v"
    by (auto simp: blinfun_apply_blinfun_compose[symmetric] norm_blinfun simp del: blinfun_apply_blinfun_compose)
  also have "\<dots> \<le> norm (inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d))) + norm v"
    using norm_QR_less_one assms
    by (fastforce intro!: mult_left_le_one_le)
  also have "\<dots> \<le> norm (inv\<^sub>L (Q d)) * r\<^sub>M + norm v"
    by (auto intro!: order.trans[OF norm_blinfun] mult_left_mono simp:  norm_r_dec_le)
  also have "\<dots> \<le> (\<Squnion>d \<in> D\<^sub>D. norm (inv\<^sub>L (Q d))) * r\<^sub>M + norm v"
    using Q_bdd bounded_imp_bdd_above
    by (auto intro!: mult_right_mono cSUP_upper assms simp: r\<^sub>M_nonneg)
  finally show ?thesis.
qed

lemma L_split_le: "d \<in> D\<^sub>D \<Longrightarrow> L_split d v s \<le> (\<Squnion>d \<in> D\<^sub>D. norm (inv\<^sub>L (Q d))) * r\<^sub>M + norm v"
  using le_norm_bfun order.trans[OF le_norm_bfun \<L>_split_bfun_aux]
  by auto

lift_definition \<L>\<^sub>b_split :: "('s \<Rightarrow>\<^sub>b real) \<Rightarrow> ('s \<Rightarrow>\<^sub>b real)" is \<L>_split
  unfolding \<L>_split_def bfun_def
  using order.trans[OF abs_le_norm_bfun \<L>_split_bfun_aux] ex_dec_det
  by (fastforce intro!: boundedI cSup_abs_le)

lemma \<L>\<^sub>b_split_def': "\<L>\<^sub>b_split v s = (\<Squnion>d\<in>D\<^sub>D. L_split d v s)"
  unfolding \<L>\<^sub>b_split.rep_eq \<L>_split_def
  by auto

lemma \<L>\<^sub>b_split_contraction: "dist (\<L>\<^sub>b_split v) (\<L>\<^sub>b_split u) \<le> QR_disc * dist v u"
proof -
  have
    "\<L>\<^sub>b_split v s - \<L>\<^sub>b_split u s \<le> QR_disc * norm (v - u)" if h: "\<L>\<^sub>b_split u s \<le> \<L>\<^sub>b_split v s" for u v s
  proof -
    obtain d where d: "is_arg_max (\<lambda>d. inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v) s) (\<lambda>d. d \<in> D\<^sub>D) d"
      using arg_max_ex_split by blast
    hence *: "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d u) s \<le> \<L>\<^sub>b_split u s"
      by (fastforce simp: \<L>\<^sub>b_split_def' is_arg_max_linorder intro!: cSUP_upper2 L_split_le)
    have "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v) s = \<L>\<^sub>b_split v s"
      by (auto simp: \<L>\<^sub>b_split_def' arg_max_SUP[OF d])
    hence "\<L>\<^sub>b_split v s - \<L>\<^sub>b_split u s = inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d v) s - \<L>\<^sub>b_split u s"
      by auto
    also have "\<dots> \<le> (inv\<^sub>L (Q d) o\<^sub>L R d) (v - u) s"
      using * by (auto simp: blinfun.bilinear_simps)
    also have "\<dots> \<le> norm ((inv\<^sub>L (Q d) o\<^sub>L R d)) * norm (v - u)"
      by (fastforce intro: order.trans[OF le_norm_bfun norm_blinfun])
    also have "\<dots> \<le> QR_disc * norm (v - u)"
      using QR_contraction d QR_bdd
      by (auto simp: is_arg_max_linorder intro!: mult_right_mono cSUP_upper2)
    finally show ?thesis.
  qed
  hence "\<bar>(\<L>\<^sub>b_split v - \<L>\<^sub>b_split u) s\<bar> \<le> QR_disc * dist v u" for s
    by (cases "\<L>\<^sub>b_split v s \<le> \<L>\<^sub>b_split u s") (fastforce simp: dist_norm norm_minus_commute)+
  thus ?thesis
    by (auto intro!: cSUP_least simp: dist_bfun.rep_eq dist_real_def)
qed

lemma \<L>\<^sub>b_lim:
  "\<exists>!v. \<L>\<^sub>b_split v = v"
  "(\<lambda>n. (\<L>\<^sub>b_split ^^ n) v) \<longlonglongrightarrow> (THE v. \<L>\<^sub>b_split v = v)"
  using banach'[of \<L>\<^sub>b_split] a_nonneg QR_contraction \<L>\<^sub>b_split_contraction
  unfolding is_contraction_def
  by auto

lemma \<L>\<^sub>b_split_tendsto_opt: "(\<lambda>n. (\<L>\<^sub>b_split ^^ n) v) \<longlonglongrightarrow> \<nu>\<^sub>b_opt"
proof -
  obtain L where l_fix: "\<L>\<^sub>b_split L = L"
    using \<L>\<^sub>b_lim(1) by auto
  have "\<nu>\<^sub>b (mk_stationary_det d) \<le> L" if d: "d \<in> D\<^sub>D" for d
  proof -
    let ?QR = "inv\<^sub>L (Q d) o\<^sub>L R d"
    have "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d L) \<le> \<L>\<^sub>b_split L"
      unfolding less_eq_bfun_def \<L>\<^sub>b_split_def'
      using d L_split_le by (auto intro!: bdd_aboveI cSUP_upper2)
    hence "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d L) \<le> L"
      using l_fix by auto
    hence aux: "inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d)) \<le> (id_blinfun - ?QR) L"
      using that by (auto simp: blinfun.bilinear_simps le_diff_eq)
    have inv_eq: "inv\<^sub>L (id_blinfun - ?QR) = (\<Sum>i. ?QR ^^ i)"
      using QR_contraction d norm_QR_less_one
      by (auto intro!: inv\<^sub>L_inf_sum)
    have summable_QR:"summable (\<lambda>i. norm (?QR ^^ i))"
      using QR_contraction QR_bdd d
      by (auto simp: a_nonneg
          intro!: summable_comparison_test'[of "\<lambda>i. QR_disc^i" 0 "\<lambda>n. norm ((inv\<^sub>L (Q d) o\<^sub>L R d) ^^n)"]
            cSUP_upper2 power_mono order.trans[OF norm_blinfunpow_le])
    have "summable (\<lambda>i. (?QR ^^ i) v s)" for v s
      by (rule summable_comparison_test'[where g = "\<lambda>i. norm (?QR ^^ i) * norm v"])
        (auto intro!: summable_QR summable_norm_cancel order.trans[OF abs_le_norm_bfun] order.trans[OF norm_blinfun] summable_mult2)
    moreover have "0 \<le> v \<Longrightarrow> 0 \<le> (\<Sum>i<n. (?QR ^^ i) v s)" for n v s
      using blinfunpow_nonneg[OF QR_nonneg[OF d]]
      by (induction n) (auto simp add: less_eq_bfun_def)
    ultimately have "0 \<le> v \<Longrightarrow> 0 \<le> (\<Sum>i. ((?QR ^^ i) v s)) " for v s
      by (auto intro!: summable_LIMSEQ LIMSEQ_le)
    hence "0 \<le> v \<Longrightarrow> 0 \<le> (\<Sum>i. ((?QR ^^ i))) v s" for v s
      using bounded_linear_apply_bfun summable_QR summable_comparison_test'
      by (subst bounded_linear.suminf[where f = "(\<lambda>i. apply_bfun (blinfun_apply i v) s)"])
        (fastforce intro: bounded_linear_compose[of "\<lambda>s. apply_bfun s _"])+
    hence "0 \<le> v \<Longrightarrow> 0 \<le> inv\<^sub>L (id_blinfun - ?QR) v" for v
      by (simp add: inv_eq less_eq_bfun_def)
    hence "(inv\<^sub>L (id_blinfun - ?QR)) ((inv\<^sub>L (Q d)) (r_dec\<^sub>b (mk_dec_det d)))
    \<le> (inv\<^sub>L (id_blinfun - ?QR)) ((id_blinfun - ?QR) L)"
      by (metis aux blinfun.diff_right diff_ge_0_iff_ge)
    hence "(inv\<^sub>L (id_blinfun - ?QR) o\<^sub>L inv\<^sub>L (Q d)) (r_dec\<^sub>b (mk_dec_det d)) \<le> L"
      using invertible\<^sub>L_inf_sum[OF norm_QR_less_one[OF that]] by auto
    hence "(inv\<^sub>L (Q d o\<^sub>L (id_blinfun - ?QR))) (r_dec\<^sub>b (mk_dec_det d)) \<le> L"
      using d norm_QR_less_one
      by (auto simp: inv\<^sub>L_compose[OF Q_invertible invertible\<^sub>L_inf_sum])
    hence "(inv\<^sub>L (Q d - R d)) (r_dec\<^sub>b (mk_dec_det d)) \<le> L"
      using Q_invertible d
      by (auto simp: blinfun_compose_diff_right blinfun_compose_assoc[symmetric])
    thus "\<nu>\<^sub>b (mk_stationary_det d) \<le> L"
      by (auto simp: \<nu>_stationary splitting[OF that, symmetric] inv\<^sub>L_inf_sum blincomp_scaleR_right)
  qed
  hence opt_le: "\<nu>\<^sub>b_opt \<le> L"
    by (metis \<nu>_conserving_def conserving_imp_opt' ex_improving_det)
  obtain d where d: "is_arg_max (\<lambda>d. inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d L) s) (\<lambda>d. d \<in> D\<^sub>D) d" for s
    using arg_max_ex_split by blast
  hence "d \<in> D\<^sub>D"
    unfolding is_arg_max_linorder by auto
  have "L = inv\<^sub>L (Q d) (r_dec\<^sub>b (mk_dec_det d) + R d L)"
    by (subst l_fix[symmetric]) (fastforce simp: \<L>\<^sub>b_split_def' arg_max_SUP[OF d])
  hence "Q d L = r_dec\<^sub>b (mk_dec_det d) + R d L"
    by (metis Q_invertible \<open>d \<in> D\<^sub>D\<close> inv_app2')
  hence "(id_blinfun - l *\<^sub>R \<P>\<^sub>1 (mk_dec_det d)) L = r_dec\<^sub>b (mk_dec_det d)"
    using splitting[OF \<open>d \<in> D\<^sub>D\<close>] by (simp add: blinfun.diff_left)
  hence "L = inv\<^sub>L ((id_blinfun - l *\<^sub>R \<P>\<^sub>1 (mk_dec_det d))) (r_dec\<^sub>b (mk_dec_det d))"
    using invertible\<^sub>L_inf_sum[OF norm_\<P>\<^sub>1_l_less] inv_app1' by metis
  hence "L = \<nu>\<^sub>b (mk_stationary_det d)"
    by (auto simp: inv\<^sub>L_inf_sum \<nu>_stationary blincomp_scaleR_right)
  hence "\<nu>\<^sub>b_opt = L"
    using opt_le \<open>d \<in> D\<^sub>D\<close> is_markovian_def
    by (auto intro: order.antisym[OF _ \<nu>\<^sub>b_le_opt])
  thus ?thesis
    using \<L>\<^sub>b_lim l_fix the1_equality[OF \<L>\<^sub>b_lim(1)] by auto
qed

lemma \<L>\<^sub>b_split_fix[simp]: "\<L>\<^sub>b_split \<nu>\<^sub>b_opt = \<nu>\<^sub>b_opt"
  using \<L>\<^sub>b_lim \<L>\<^sub>b_split_tendsto_opt the_equality limI
  by (metis (mono_tags, lifting))

lemma dist_\<L>\<^sub>b_split_opt_eps:
  assumes "eps > 0" "2 * QR_disc * dist v (\<L>\<^sub>b_split v) < eps * (1-QR_disc)"
  shows "dist (\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt < eps / 2"
proof -
  have "(1 - QR_disc) * dist v \<nu>\<^sub>b_opt \<le> dist v (\<L>\<^sub>b_split v)"
    using dist_triangle \<L>\<^sub>b_split_contraction[of v "\<nu>\<^sub>b_opt"]
    by (fastforce simp: algebra_simps intro: order.trans[OF _ add_left_mono[of "dist (\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt"]])
  hence "dist v \<nu>\<^sub>b_opt \<le> dist v (\<L>\<^sub>b_split v) / (1 - QR_disc)"
    using QR_contraction
    by (simp add: mult.commute pos_le_divide_eq)
  hence "2 * QR_disc * dist v \<nu>\<^sub>b_opt \<le> 2 * QR_disc * (dist v (\<L>\<^sub>b_split v) / (1 - QR_disc))"
    using \<L>\<^sub>b_split_contraction assms mult_le_cancel_left_pos[of "2 * QR_disc"] a_nonneg
    by (fastforce intro!: mult_left_mono[of _ _ "2 * QR_disc"])
  hence "2 * QR_disc * dist v \<nu>\<^sub>b_opt < eps"
    using a_nonneg QR_contraction
    by (auto simp: assms(2) pos_divide_less_eq intro: order.strict_trans1)
  hence "dist v \<nu>\<^sub>b_opt * QR_disc < eps / 2"
    by argo
  thus "dist (\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt < eps / 2"
    using \<L>\<^sub>b_split_contraction[of v \<nu>\<^sub>b_opt]
    by (auto simp: algebra_simps)
qed

lemma L_split_fix:
  assumes "d \<in> D\<^sub>D"
  shows "L_split d (\<nu>\<^sub>b (mk_stationary_det d)) = \<nu>\<^sub>b (mk_stationary_det d)"
proof -
  let ?d = "mk_dec_det d"
  let ?p = "mk_stationary_det d"
  have "(Q d - R d) (\<nu>\<^sub>b ?p) = r_dec\<^sub>b ?d"
    using L_\<nu>_fix[of "mk_dec_det d"]
    by (simp add: L_def splitting[OF assms, symmetric] blinfun.bilinear_simps diff_eq_eq)
  thus ?thesis
    using assms
    by (auto simp: blinfun.bilinear_simps diff_eq_eq inv\<^sub>L_cancel_iff[OF Q_invertible])
qed

lemma L_split_contraction:
  assumes "d \<in> D\<^sub>D"
  shows "dist (L_split d v) (L_split d u) \<le> QR_disc * dist v u"
proof -
  have aux: "L_split d v s - L_split d u s \<le> QR_disc * dist v u" if lea: "(L_split d u s) \<le> (L_split d v s)" for v s u
  proof -
    have "L_split d v s - L_split d u s = (inv\<^sub>L (Q d) o\<^sub>L (R d)) (v - u) s"
      by (auto simp: blinfun.bilinear_simps)
    also have "\<dots> \<le> norm ((inv\<^sub>L (Q d) o\<^sub>L (R d)) (v - u))"
      by (simp add: le_norm_bfun)
    also have "\<dots> \<le> norm ((inv\<^sub>L (Q d) o\<^sub>L (R d))) * dist v u"
      by (auto simp only: dist_norm norm_blinfun)
    also have "\<dots> \<le> QR_disc * dist v u"
      using assms QR_le_QR_disc
      by (auto intro!: mult_right_mono)
    finally show ?thesis
      by auto
  qed
  have "dist (L_split d v s) (L_split d u s) \<le> QR_disc * dist v u" for v s u
    using aux aux[of v _ u]
    by (cases "L_split d v s \<ge> L_split d u s") (auto simp: dist_real_def dist_commute)
  thus "dist (L_split d v) (L_split d u) \<le> QR_disc * dist v u"
    by (simp add: dist_bound)
qed

lemma argmax_policy_error_bound:
  assumes am: "\<And>s. is_arg_max (\<lambda>d. L (mk_dec_det d) (\<L>\<^sub>b v) s) (\<lambda>d. d \<in> D\<^sub>D) d"
  shows "(1 - l) * dist (\<nu>\<^sub>b (mk_stationary_det d)) (\<L>\<^sub>b v) \<le> l * dist (\<L>\<^sub>b v) v"
proof -
  have "dist (\<nu>\<^sub>b (mk_stationary_det d)) (\<L>\<^sub>b v) = dist (L (mk_dec_det d) (\<nu>\<^sub>b (mk_stationary_det d))) (\<L>\<^sub>b v)"
    using L_\<nu>_fix by presburger
  also have "\<dots> \<le> dist (L (mk_dec_det d) (\<nu>\<^sub>b (mk_stationary_det d))) (\<L>\<^sub>b (\<L>\<^sub>b v)) + dist (\<L>\<^sub>b (\<L>\<^sub>b v)) (\<L>\<^sub>b v)"
    using dist_triangle by blast
  also have "\<dots> = dist (L (mk_dec_det d) (\<nu>\<^sub>b (mk_stationary_det d))) (L (mk_dec_det d) (\<L>\<^sub>b v)) + dist (\<L>\<^sub>b (\<L>\<^sub>b v)) (\<L>\<^sub>b v)"
    using \<L>\<^sub>b_eq_SUP_det using arg_max_SUP[OF assms, symmetric]
    by (auto simp: dist_bfun_def)
  also have "\<dots> \<le> l * dist (\<nu>\<^sub>b (mk_stationary_det d)) (\<L>\<^sub>b v) + l * dist (\<L>\<^sub>b v) v"
    by (meson add_mono contraction_L contraction_\<L>)
  finally show ?thesis
    by (auto simp: algebra_simps)
qed

lemma find_policy_QR_error_bound:
  assumes "eps > 0" "2 * QR_disc * dist v (\<L>\<^sub>b_split v) < eps * (1-QR_disc)"
  assumes am: "\<And>s. is_arg_max (\<lambda>d. L_split d (\<L>\<^sub>b_split v) s) (\<lambda>d. d \<in> D\<^sub>D) d"
  shows "dist (\<nu>\<^sub>b (mk_stationary_det d)) \<nu>\<^sub>b_opt < eps"
proof -
  let ?p = "mk_stationary_det d"
  have L_eq_\<L>\<^sub>b: "L_split d (\<L>\<^sub>b_split v) = \<L>\<^sub>b_split (\<L>\<^sub>b_split v)"
    by (auto simp: \<L>\<^sub>b_split_def' arg_max_SUP[OF am])
  have "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) = dist (L_split d (\<nu>\<^sub>b ?p)) (\<L>\<^sub>b_split v)"
    using am
    by (auto simp: is_arg_max_linorder L_split_fix)
  also have "\<dots> \<le> dist (L_split d (\<nu>\<^sub>b ?p)) (\<L>\<^sub>b_split (\<L>\<^sub>b_split v)) + dist (\<L>\<^sub>b_split (\<L>\<^sub>b_split v)) (\<L>\<^sub>b_split v)"
    by (auto intro: dist_triangle)
  also have "\<dots> = dist (L_split d (\<nu>\<^sub>b ?p)) (L_split d (\<L>\<^sub>b_split v)) + dist (\<L>\<^sub>b_split (\<L>\<^sub>b_split v)) (\<L>\<^sub>b_split v)"
    by (auto simp: L_eq_\<L>\<^sub>b)
  also have "\<dots> \<le> QR_disc * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) + QR_disc * dist (\<L>\<^sub>b_split v) v"
    using \<L>\<^sub>b_split_contraction L_split_contraction am unfolding is_arg_max_def
    by (auto intro!: add_mono)
  finally have aux: "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) \<le> QR_disc * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) + QR_disc * dist (\<L>\<^sub>b_split v) v" .
  hence "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) - QR_disc * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) \<le> QR_disc * dist (\<L>\<^sub>b_split v) v"
    by auto
  hence "dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) * (1 - QR_disc) \<le> QR_disc * dist (\<L>\<^sub>b_split v) v"
    by argo
  hence  "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) * (1-QR_disc) \<le> 2 * (QR_disc * dist (\<L>\<^sub>b_split v) v)"
    using mult_left_mono
    by auto
  hence "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) * (1 - QR_disc) \<le> eps * (1 - QR_disc)"
    using assms
    by (auto intro!: mult_left_mono simp: dist_commute pos_divide_le_eq)
  hence "2 * dist (\<nu>\<^sub>b ?p) (\<L>\<^sub>b_split v) \<le> eps"
    using QR_contraction mult_right_le_imp_le
    by auto
  moreover have "2 * dist (\<L>\<^sub>b_split v) \<nu>\<^sub>b_opt < eps"
    using dist_\<L>\<^sub>b_split_opt_eps assms
    by fastforce
  ultimately show ?thesis
    using dist_triangle[of "\<nu>\<^sub>b ?p" \<nu>\<^sub>b_opt "\<L>\<^sub>b_split v"]
    by auto
qed

end
context MDP_att_\<L>
begin

lemma inv_one_sub_Q':
  fixes f :: "'c :: banach \<Rightarrow>\<^sub>L 'c"
  assumes onorm_le: "norm (id_blinfun - f) < 1"
  shows "inv\<^sub>L f = (\<Sum>i. (id_blinfun - f)^^i)"
  by (metis inv\<^sub>L_I inv_one_sub_Q assms)

lemma blinfun_le_trans: "blinfun_le X Y \<Longrightarrow> blinfun_le Y Z \<Longrightarrow> blinfun_le X Z"
  unfolding blinfun_le_def nonneg_blinfun_def
  by (fastforce simp: blinfun.diff_left)

lemma blinfun_leI[intro]: "(\<And>v. v \<ge> 0 \<Longrightarrow> blinfun_apply C v \<le> blinfun_apply D v) \<Longrightarrow> blinfun_le C D"
  unfolding blinfun_le_def nonneg_blinfun_def
  by (auto simp: algebra_simps blinfun.diff_left)

lemma blinfun_pow_mono: "nonneg_blinfun (C :: ('c \<Rightarrow>\<^sub>b real) \<Rightarrow>\<^sub>L ('c \<Rightarrow>\<^sub>b real)) \<Longrightarrow> blinfun_le C D \<Longrightarrow> blinfun_le (C ^^ n) (D ^^ n)"
proof (induction n)
  case 0
  then show ?case by (simp add: blinfun_le_def nonneg_blinfun_def)
next
  case (Suc n)
  have *: "\<And>v. 0 \<le> v \<Longrightarrow> blinfun_apply (D ^^ n) (blinfun_apply C v) \<le> blinfun_apply (D ^^ n) (blinfun_apply D v)"
    by (metis (no_types, opaque_lifting) Suc.prems(1) Suc.prems(2) blinfun_apply_mono blinfunpow_nonneg le_left_mono nonneg_blinfun_def nonneg_blinfun_mono)
  thus ?case
    using blinfun_apply_mono Suc
    by (intro blinfun_leI) (auto simp: blinfunpow_assoc blinfunpow_nonneg nonneg_blinfun_def simp del: blinfunpow.simps intro!: blinfun_apply_mono order.trans[OF _ *])
qed

lemma blinfun_le_iff: "blinfun_le X Y \<longleftrightarrow> (\<forall>v \<ge> 0. X v \<le> Y v)"
  unfolding blinfun_le_def nonneg_blinfun_def
  by (auto simp: blinfun.diff_left)

text \<open>An important theorem: allows to compare the rate of convergence for different splittings\<close>
lemma norm_splitting_le:
  assumes "is_splitting_blin (id_blinfun - l *\<^sub>R \<P>\<^sub>1 d) Q1 R1"
    and "is_splitting_blin (id_blinfun - l *\<^sub>R \<P>\<^sub>1 d) Q2 R2"
    and "blinfun_le R2 R1"
    and "blinfun_le R1 (l *\<^sub>R \<P>\<^sub>1 d)"
  shows "norm (inv\<^sub>L Q2 o\<^sub>L R2) \<le> norm (inv\<^sub>L Q1 o\<^sub>L R1)"
proof -
  have
    inv_Q: "inv\<^sub>L Q = (\<Sum>i. (id_blinfun - Q)^^i)" "norm (id_blinfun - Q) < 1" and
    splitting_eq: "id_blinfun - Q = l *\<^sub>R \<P>\<^sub>1 d - R" and
    nonneg_Q: "nonneg_blinfun (id_blinfun - Q)"
    if "blinfun_le R (l *\<^sub>R \<P>\<^sub>1 d)"
      and "is_splitting_blin (id_blinfun - l *\<^sub>R \<P>\<^sub>1 d) Q R" for Q R
  proof -
    show splitting_eq: "id_blinfun - Q = l *\<^sub>R \<P>\<^sub>1 d - R"
      using that unfolding is_splitting_blin_def
      by (auto simp: algebra_simps)
    have R_nonneg: "nonneg_blinfun R"
      using that by blast
    show nonneg_Q:  "nonneg_blinfun (id_blinfun - Q)"
      using that by (simp add: blinfun_le_def splitting_eq)
    moreover have "blinfun_le (id_blinfun - Q) (l *\<^sub>R \<P>\<^sub>1 d)"
      using R_nonneg by (simp add: splitting_eq blinfun_le_def)
    ultimately have "norm (id_blinfun - Q) \<le> norm (l *\<^sub>R \<P>\<^sub>1 d)"
      using blinfun_le_def matrix_le_norm_mono by fast
    thus "norm (id_blinfun - Q) < 1"
      using norm_\<P>\<^sub>1_l_less by (simp add: order.strict_trans1)
    thus "inv\<^sub>L Q = (\<Sum>i. (id_blinfun - Q) ^^ i)"
      using inv\<^sub>L_inf_sum by fastforce
  qed

  have i1: "inv\<^sub>L Q1 = (\<Sum>i. (id_blinfun - Q1) ^^ i)" "norm (id_blinfun - Q1) < 1"
    and i2: "inv\<^sub>L Q2 = (\<Sum>i. (id_blinfun - Q2) ^^ i)" "norm (id_blinfun - Q2) < 1"
    using assms by (auto intro: blinfun_le_trans inv_Q[of R2 Q2] inv_Q[of R1 Q1])

  have Q1_le_Q2: "blinfun_le (id_blinfun - Q1) (id_blinfun - Q2)"
    using assms unfolding is_splitting_blin_def blinfun_le_def eq_diff_eq
    by fastforce

  have "(inv\<^sub>L Q1) = ((\<Sum>i. (id_blinfun - Q1) ^^ i))"
    using i1 by auto
  also have "\<dots> =  ((\<Sum>i. ((id_blinfun - Q1) ^^ i)))"
    using summable_inv_Q i1(2)
    by auto
  have "blinfun_le ((\<Sum>i. ((id_blinfun - Q1) ^^ i))) (\<Sum>i. ((id_blinfun - Q2) ^^ i))"
  proof -
    have le_n: "\<And>n v. 0 \<le> v \<Longrightarrow> (\<Sum>i<n. ((id_blinfun - Q1) ^^ i) v) \<le> (\<Sum>i<n. ((id_blinfun - Q2) ^^ i) v)"
      using nonneg_Q blinfun_pow_mono[OF _ Q1_le_Q2] assms
      by (auto intro!: sum_mono simp: blinfun_le_iff)
    hence le_n_elem: "\<And>n v. 0 \<le> v \<Longrightarrow> (\<Sum>i<n. ((id_blinfun - Q1) ^^ i) v s) \<le> (\<Sum>i<n. ((id_blinfun - Q2) ^^ i) v s)" for s
      unfolding less_eq_bfun_def
      by (simp add: sum_apply_bfun)
    have tt: "(\<lambda>n. (\<Sum>i<n. ((id_blinfun - Q1) ^^ i) v s)) \<longlonglongrightarrow> (\<Sum>i. ((id_blinfun - Q1) ^^ i)) v s"
              "(\<lambda>n. (\<Sum>i<n. ((id_blinfun - Q2) ^^ i) v s)) \<longlonglongrightarrow> (\<Sum>i. ((id_blinfun - Q2) ^^ i)) v s" for v s
      unfolding blinfun.sum_left[symmetric] sum_apply_bfun[symmetric]
      using summable_inv_Q[OF i1(2)] summable_inv_Q[OF i2(2)]
      by (fastforce intro: bfun_tendsto_apply_bfun tendsto_blinfun_apply summable_LIMSEQ)+
    show ?thesis
      unfolding blinfun_le_iff less_eq_bfun_def
      using le_n_elem
      by (auto simp add: less_eq_bfunI intro: Topological_Spaces.lim_mono[OF _ tt(1) tt(2)])
  qed
  also have "\<dots> = (inv\<^sub>L Q2)"
    using summable_inv_Q i2(2) i2 by auto
  finally have Q1_le_Q2: "blinfun_le (inv\<^sub>L Q1) (inv\<^sub>L Q2)".

  have *: "nonneg_blinfun ((inv\<^sub>L Q1) o\<^sub>L R1)" "nonneg_blinfun ((inv\<^sub>L Q2) o\<^sub>L R2)"
    using assms is_splitting_blin_def
    by (metis blinfun_apply_blinfun_compose nonneg_blinfun_def)+
  have "0 \<le> (id_blinfun - l *\<^sub>R \<P>\<^sub>1 d) 1"
    using less_imp_le[OF disc_lt_one]
    by (auto simp: blinfun.diff_left less_eq_bfun_def blinfun.scaleR_left)
  hence "(inv\<^sub>L Q1) ((id_blinfun - l *\<^sub>R \<P>\<^sub>1 d) 1) \<le> (inv\<^sub>L Q2) ((id_blinfun - l *\<^sub>R \<P>\<^sub>1 d) 1)"
    using Q1_le_Q2
    by (simp add: blinfun_le_iff)
  hence "(inv\<^sub>L Q1) ((Q1 - R1) 1) \<le> (inv\<^sub>L Q2) ((Q2 - R2) 1)"
    by (metis (no_types, opaque_lifting) assms(1) assms(2) is_splitting_blin_def)
  hence "(inv\<^sub>L Q1 o\<^sub>L Q1) 1 - (inv\<^sub>L Q1 o\<^sub>L R1) 1 \<le> (inv\<^sub>L Q2 o\<^sub>L Q2) 1 - (inv\<^sub>L Q2 o\<^sub>L R2) 1"
    by (auto simp: blinfun.add_left blinfun.diff_right blinfun.diff_left)
  hence "(inv\<^sub>L Q2 o\<^sub>L R2) 1 \<le> (inv\<^sub>L Q1 o\<^sub>L R1) 1"
    using assms unfolding is_splitting_blin_def by auto
  moreover have "0 \<le> (inv\<^sub>L Q2 o\<^sub>L R2) 1"
    using * assms(2) by (fastforce simp: less_eq_bfunI intro!: nonneg_blinfun_nonneg)
  ultimately have "norm ((inv\<^sub>L Q2 o\<^sub>L R2) 1) \<le> norm ((inv\<^sub>L Q1 o\<^sub>L R1) 1)"
    by (auto simp: less_eq_bfun_def norm_bfun_def' intro!: abs_le_norm_bfun abs_ge_self cSUP_mono bdd_above.I2 intro: order.trans)
  thus "norm ((inv\<^sub>L Q2 o\<^sub>L R2)) \<le> norm ((inv\<^sub>L Q1 o\<^sub>L R1))"
    by (simp add: * norm_nonneg_blinfun_one)
qed

end

end