theory "CoCallGraph-TTree"
imports CoCallGraph "TTree-HOLCF"
begin

lemma interleave_ccFromList:
  "xs \<in> interleave ys zs \<Longrightarrow> ccFromList xs = ccFromList ys \<squnion> ccFromList zs \<squnion> ccProd (set ys) (set zs)"
  by (induction rule: interleave_induct)
     (auto simp add: interleave_set ccProd_comm ccProd_insert2[where S' = "set xs" for xs]  ccProd_insert1[where S' = "set xs" for xs] )

lift_definition ccApprox :: "var ttree \<Rightarrow> CoCalls"
  is "\<lambda> xss .  lub (ccFromList ` xss)".

lemma ccApprox_paths: "ccApprox t = lub (ccFromList ` (paths t))" by transfer simp

lemma ccApprox_strict[simp]: "ccApprox \<bottom> = \<bottom>"
  by (simp add: ccApprox_paths empty_is_bottom[symmetric])

lemma in_ccApprox: "(x--y\<in>(ccApprox t)) \<longleftrightarrow> (\<exists> xs \<in> paths t. (x--y\<in>(ccFromList xs)))"
  unfolding ccApprox_paths
  by transfer auto

lemma ccApprox_mono': "t \<sqsubseteq>  t' \<Longrightarrow> ccApprox t \<sqsubseteq> ccApprox t'"
  by (metis below_set_def ccApprox_mono paths_mono_iff)

lemma ccApprox_belowI: "(\<And> xs. xs \<in> paths t \<Longrightarrow> ccFromList xs \<sqsubseteq> G) \<Longrightarrow> ccApprox t \<sqsubseteq> G"
  unfolding ccApprox_paths
  by transfer auto

lemma ccApprox_below_iff: "ccApprox t \<sqsubseteq> G \<longleftrightarrow> (\<forall> xs \<in> paths t. ccFromList xs \<sqsubseteq> G)"
  unfolding ccApprox_paths by transfer auto

lemma cc_restr_ccApprox_below_iff: "cc_restr S (ccApprox t) \<sqsubseteq> G \<longleftrightarrow> (\<forall> xs \<in> paths t. cc_restr S (ccFromList xs) \<sqsubseteq> G)"
  unfolding ccApprox_paths cc_restr_lub
  by transfer auto

lemma ccFromList_below_ccApprox:
  "xs \<in> paths t \<Longrightarrow> ccFromList xs \<sqsubseteq> ccApprox t"
by (rule below_CoCallsI)(auto simp add: in_ccApprox)

lemma ccApprox_nxt_below:
  "ccApprox (nxt t x) \<sqsubseteq> ccApprox t"
by (rule below_CoCallsI)(auto simp add: in_ccApprox paths_nxt_eq elim!:  bexI[rotated])

lemma ccApprox_ttree_restr_nxt_below:
  "ccApprox (ttree_restr S (nxt t x)) \<sqsubseteq> ccApprox (ttree_restr S t)"
by (rule below_CoCallsI)
   (auto simp add: in_ccApprox filter_paths_conv_free_restr[symmetric] paths_nxt_eq  elim!:  bexI[rotated])

lemma ccApprox_ttree_restr[simp]: "ccApprox (ttree_restr S t) = cc_restr S (ccApprox t)"
  by (rule CoCalls_eqI) (auto simp add: in_ccApprox filter_paths_conv_free_restr[symmetric] )

lemma ccApprox_both: "ccApprox (t \<otimes>\<otimes> t') = ccApprox t \<squnion> ccApprox t' \<squnion> ccProd (carrier t) (carrier t')"
proof (rule below_antisym)
  show "ccApprox (t \<otimes>\<otimes> t') \<sqsubseteq> ccApprox t \<squnion> ccApprox t' \<squnion> ccProd (carrier t) (carrier t')"
  by (rule below_CoCallsI)
     (auto 4 4  simp add: in_ccApprox paths_both Union_paths_carrier[symmetric]  interleave_ccFromList)
next
  have "ccApprox t \<sqsubseteq> ccApprox (t \<otimes>\<otimes> t')"
    by (rule ccApprox_mono[OF both_contains_arg1])
  moreover
  have "ccApprox t' \<sqsubseteq> ccApprox (t \<otimes>\<otimes> t')"
    by (rule ccApprox_mono[OF both_contains_arg2])
  moreover
  have "ccProd (carrier t) (carrier t') \<sqsubseteq> ccApprox (t \<otimes>\<otimes> t')"
  proof(rule ccProd_belowI)
    fix x y
    assume "x \<in> carrier t" and "y \<in> carrier t'"
    then obtain xs ys where "x \<in> set xs" and "y \<in> set ys"
      and "xs \<in> paths t" and "ys \<in> paths t'" by (auto simp add: Union_paths_carrier[symmetric])
    hence "xs @ ys \<in> paths (t \<otimes>\<otimes> t')" by (metis paths_both append_interleave)
    moreover
    from \<open>x \<in> set xs\<close> \<open>y \<in> set ys\<close>
    have "x--y\<in>(ccFromList (xs@ys))" by simp
    ultimately
    show "x--y\<in>(ccApprox (t \<otimes>\<otimes> t'))" by (auto simp add: in_ccApprox simp del: ccFromList_append)
  qed
  ultimately
  show "ccApprox t \<squnion> ccApprox t' \<squnion> ccProd (carrier t) (carrier t') \<sqsubseteq> ccApprox (t \<otimes>\<otimes> t')"
    by (simp add: join_below_iff)
qed

lemma ccApprox_many_calls[simp]:
  "ccApprox (many_calls x) = ccProd {x} {x}"
  by transfer' (rule CoCalls_eqI, auto)

lemma ccApprox_single[simp]:
  "ccApprox (TTree.single y) = \<bottom>"
  by transfer' auto

lemma ccApprox_either[simp]: "ccApprox (t \<oplus>\<oplus> t') = ccApprox t \<squnion> ccApprox t'"
  by transfer' (rule CoCalls_eqI, auto)

(* could work, but tricky
lemma ccApprox_lub_nxt: "ccApprox t = (\<Squnion> x \<in>UNIV. ccApprox (nxt t x) \<squnion> (ccProd {x} (carrier (nxt t x))))"
*)

lemma wild_recursion:
  assumes "ccApprox  t \<sqsubseteq> G"
  assumes "\<And> x. x \<notin> S \<Longrightarrow> f x = empty"
  assumes "\<And> x. x \<in> S \<Longrightarrow> ccApprox (f x) \<sqsubseteq> G"
  assumes "\<And> x. x \<in> S \<Longrightarrow> ccProd (ccNeighbors x G) (carrier (f x)) \<sqsubseteq> G"
  shows "ccApprox (ttree_restr (-S) (substitute f T t)) \<sqsubseteq> G"
proof(rule ccApprox_belowI)
  fix xs
  define seen :: "var set" where "seen = {}"

  assume "xs \<in> paths (ttree_restr (- S) (substitute f T t))"
  then obtain xs' xs'' where "xs = [x\<leftarrow>xs' . x \<notin> S]" and "substitute'' f T xs'' xs'" and "xs'' \<in> paths t"
    by (auto simp add: filter_paths_conv_free_restr2[symmetric] substitute_substitute'')

  note this(2)
  moreover
  from \<open>ccApprox t \<sqsubseteq> G\<close> and \<open>xs'' \<in> paths t\<close>
  have  "ccFromList xs'' \<sqsubseteq> G"
    by (auto simp add: ccApprox_below_iff)
  moreover
  note assms(2)
  moreover
  from assms(3,4)
  have "\<And> x ys. x \<in> S \<Longrightarrow> ys \<in> paths (f x) \<Longrightarrow> ccFromList ys \<sqsubseteq> G"
    and "\<And> x ys. x \<in> S \<Longrightarrow> ys \<in> paths (f x) \<Longrightarrow> ccProd (ccNeighbors x G) (set ys) \<sqsubseteq> G"
    by (auto simp add: ccApprox_below_iff Union_paths_carrier[symmetric] cc_lub_below_iff)
  moreover
  have "ccProd seen (set xs'') \<sqsubseteq> G" unfolding seen_def by simp
  ultimately
  have "ccFromList [x\<leftarrow>xs' . x \<notin> S] \<sqsubseteq> G \<and> ccProd (seen) (set xs') \<sqsubseteq> G"
  proof(induction f T xs'' xs' arbitrary: seen rule: substitute''.induct[case_names Nil Cons])
  case Nil thus ?case by simp
  next
  case (Cons zs f x xs' xs T ys)

    have seen_x: "ccProd seen {x} \<sqsubseteq> G"
      using \<open>ccProd seen (set (x # xs)) \<sqsubseteq> G\<close>
      by (auto simp add: ccProd_insert2[where S' = "set xs" for xs] join_below_iff)

    show ?case
    proof(cases "x \<in> S")
      case True

      from \<open>ccFromList (x # xs) \<sqsubseteq> G\<close>
      have "ccProd {x} (set xs) \<sqsubseteq> G" by (auto simp add: join_below_iff)
      hence subset1: "set xs \<subseteq> ccNeighbors x G" by transfer auto

      from \<open>ccProd seen (set (x # xs)) \<sqsubseteq> G\<close>
      have subset2: "seen  \<subseteq> ccNeighbors x G"
        by (auto simp add: subset_ccNeighbors ccProd_insert2[where S' = "set xs" for xs] join_below_iff ccProd_comm)

      from subset1 and subset2
      have "seen \<union> set xs \<subseteq> ccNeighbors x G" by auto
      hence "ccProd (seen \<union> set xs) (set zs) \<sqsubseteq> ccProd (ccNeighbors x G) (set zs)"
        by (rule ccProd_mono1)
      also
      from \<open>x \<in> S\<close>  \<open>zs \<in> paths (f x)\<close>
      have "\<dots> \<sqsubseteq> G"
        by (rule Cons.prems(4))
      finally
      have "ccProd (seen \<union> set xs) (set zs) \<sqsubseteq> G" by this simp

      with \<open>x \<in> S\<close> Cons.prems Cons.hyps
      have "ccFromList [x\<leftarrow>ys . x \<notin> S] \<sqsubseteq> G \<and> ccProd (seen) (set ys) \<sqsubseteq> G"
          apply -
          apply (rule Cons.IH)
          apply (auto simp add: f_nxt_def  join_below_iff  interleave_ccFromList interleave_set  ccProd_insert2[where S' = "set xs" for xs]
                  split: if_splits)
          done
      with  \<open>x \<in> S\<close>  seen_x
      show "ccFromList [x\<leftarrow>x # ys . x \<notin> S] \<sqsubseteq> G  \<and> ccProd seen (set (x#ys)) \<sqsubseteq> G"
          by (auto simp add: ccProd_insert2[where S' = "set xs" for xs] join_below_iff)
    next
      case False

      from False Cons.prems Cons.hyps
      have *: "ccFromList [x\<leftarrow>ys . x \<notin> S] \<sqsubseteq> G \<and> ccProd ((insert x seen)) (set ys) \<sqsubseteq> G"
        apply -
        apply (rule Cons.IH[where seen = "insert x seen"])
        apply (auto simp add: ccApprox_both join_below_iff ttree_restr_both interleave_ccFromList insert_Diff_if
                   simp add:  ccProd_insert2[where S' = "set xs" for xs]
                   simp add:  ccProd_insert1[where S' = "seen"])
        done
      moreover
      from False *
      have "ccProd {x} (set ys) \<sqsubseteq>  G"
        by (auto simp add: insert_Diff_if ccProd_insert1[where S' = "seen"] join_below_iff)
      hence "ccProd {x} {x \<in> set ys. x \<notin> S} \<sqsubseteq> G"
        by (rule below_trans[rotated, OF _ ccProd_mono2]) auto
      moreover
      note False seen_x
      ultimately
      show "ccFromList [x\<leftarrow>x # ys . x \<notin> S] \<sqsubseteq> G \<and> ccProd (seen) (set (x # ys)) \<sqsubseteq> G"
        by (auto simp add: join_below_iff  simp add: insert_Diff_if  ccProd_insert2[where S' = "set xs" for xs]   ccProd_insert1[where S' = "seen"])
    qed
  qed
  with \<open>xs = _\<close>
  show "ccFromList xs \<sqsubseteq> G" by simp
qed

lemma wild_recursion_thunked:
  assumes "ccApprox  t \<sqsubseteq> G"
  assumes "\<And> x. x \<notin> S \<Longrightarrow> f x = empty"
  assumes "\<And> x. x \<in> S \<Longrightarrow> ccApprox (f x) \<sqsubseteq> G"
  assumes "\<And> x. x \<in> S \<Longrightarrow> ccProd (ccNeighbors x G - {x} \<inter> T) (carrier (f x)) \<sqsubseteq> G"
  shows "ccApprox (ttree_restr (-S) (substitute f T t)) \<sqsubseteq> G"
proof(rule ccApprox_belowI)
  fix xs

  define seen :: "var set" where "seen = {}"
  define seen_T :: "var set" where "seen_T = {}"

  assume "xs \<in> paths (ttree_restr (- S) (substitute f T t))"
  then obtain xs' xs'' where "xs = [x\<leftarrow>xs' . x \<notin> S]" and "substitute'' f T xs'' xs'" and "xs'' \<in> paths t"
    by (auto simp add: filter_paths_conv_free_restr2[symmetric] substitute_substitute'')

  note this(2)
  moreover
  from \<open>ccApprox t \<sqsubseteq> G\<close> and \<open>xs'' \<in> paths t\<close>
  have  "ccFromList xs'' \<sqsubseteq> G"
    by (auto simp add: ccApprox_below_iff)
  hence  "ccFromList xs'' G|` (- seen_T) \<sqsubseteq> G"
    by (rule rev_below_trans[OF _ cc_restr_below_arg])
  moreover
  note assms(2)
  moreover
  from assms(3,4)
  have "\<And> x ys. x \<in> S \<Longrightarrow> ys \<in> paths (f x) \<Longrightarrow> ccFromList ys \<sqsubseteq> G"
    and "\<And> x ys. x \<in> S \<Longrightarrow> ys \<in> paths (f x) \<Longrightarrow> ccProd (ccNeighbors x G - {x} \<inter> T) (set ys) \<sqsubseteq> G"
    by (auto simp add: ccApprox_below_iff seen_T_def Union_paths_carrier[symmetric] cc_lub_below_iff)
  moreover
  have "ccProd seen (set xs'' - seen_T) \<sqsubseteq> G" unfolding seen_def seen_T_def by simp
  moreover
  have "seen \<inter> S = {}" unfolding seen_def by simp
  moreover
  have "seen_T \<subseteq> S" unfolding seen_T_def by simp
  moreover
  have "\<And> x. x \<in> seen_T \<Longrightarrow> f x = empty"  unfolding seen_T_def by simp
  ultimately
  have "ccFromList [x\<leftarrow>xs' . x \<notin> S] \<sqsubseteq> G \<and> ccProd (seen) (set xs' - seen_T) \<sqsubseteq> G"
  proof(induction f T xs'' xs' arbitrary: seen seen_T rule: substitute''.induct[case_names Nil Cons])
  case Nil thus ?case by simp
  next
  case (Cons zs f x xs' xs T ys)

    let  ?seen_T = "if x \<in> T then insert x seen_T else seen_T"
    have subset: "- insert x seen_T \<subseteq> - seen_T" by auto
    have subset2: "set xs \<inter> - insert x seen_T \<subseteq> insert x (set xs) \<inter> - seen_T" by auto
    have subset3: "set zs \<inter> - insert x seen_T \<subseteq> set zs" by auto
    have subset4: "set xs \<inter> - seen_T \<subseteq> insert x (set xs) \<inter> - seen_T" by auto
    have subset5: "set zs \<inter> - seen_T \<subseteq> set zs" by auto
    have subset6: "set ys - seen_T \<subseteq> (set ys - ?seen_T) \<union> {x}" by auto

    show ?case
    proof(cases "x \<in> seen_T")
      assume "x \<in> seen_T"

      have [simp]: "f x = empty" using \<open>x \<in> seen_T\<close> Cons.prems by auto
      have [simp]: "f_nxt f T x = f" by (auto simp add: f_nxt_def split:if_splits)
      have [simp]: "zs = []" using \<open>zs \<in> paths (f x)\<close> by simp
      have [simp]: "xs' = xs" using \<open>xs' \<in> xs \<otimes> zs\<close> by simp
      have [simp]: "x \<in> S" using \<open>x \<in> seen_T\<close> Cons.prems by auto

      from Cons.hyps Cons.prems
      have "ccFromList [x\<leftarrow>ys . x \<notin> S] \<sqsubseteq> G \<and> ccProd seen (set ys - seen_T) \<sqsubseteq> G"
        apply -
        apply (rule Cons.IH[where seen_T = seen_T])
        apply (auto simp add: join_below_iff Diff_eq)
        apply (erule below_trans[OF ccProd_mono[OF order_refl subset4]])
        done
      thus ?thesis using \<open>x \<in> seen_T\<close> by simp
    next
      assume "x \<notin> seen_T"

      have seen_x: "ccProd seen {x} \<sqsubseteq> G"
        using \<open>ccProd seen (set (x # xs) - seen_T) \<sqsubseteq> G\<close> \<open>x \<notin> seen_T\<close>
        by (auto simp add: insert_Diff_if ccProd_insert2[where S' = "set xs - seen_T" for xs] join_below_iff)

      show ?case
      proof(cases "x \<in> S")
        case True

        from \<open>cc_restr (- seen_T) (ccFromList (x # xs)) \<sqsubseteq> G\<close>
        have "ccProd {x} (set xs - seen_T) \<sqsubseteq> G" using \<open>x \<notin> seen_T\<close>  by (auto simp add: join_below_iff Diff_eq)
        hence "set xs - seen_T \<subseteq> ccNeighbors x G" by transfer auto
        moreover

        from seen_x
        have "seen  \<subseteq> ccNeighbors x G" by (simp add: subset_ccNeighbors   ccProd_comm)
        moreover
        have "x \<notin> seen" using True \<open>seen \<inter> S = {}\<close> by auto

        ultimately
        have "seen \<union> (set xs \<inter> - ?seen_T) \<subseteq> ccNeighbors x G - {x}\<inter>T" by auto
        hence "ccProd (seen \<union> (set xs \<inter> - ?seen_T)) (set zs) \<sqsubseteq> ccProd (ccNeighbors x G - {x}\<inter>T) (set zs)"
          by (rule ccProd_mono1)
        also
        from \<open>x \<in> S\<close>  \<open>zs \<in> paths (f x)\<close>
        have "\<dots> \<sqsubseteq> G"
          by (rule Cons.prems(4))
        finally
        have "ccProd (seen \<union> (set xs \<inter> - ?seen_T)) (set zs) \<sqsubseteq> G" by this simp

        with \<open>x \<in> S\<close> Cons.prems Cons.hyps(1,2)
        have "ccFromList [x\<leftarrow>ys . x \<notin> S] \<sqsubseteq> G \<and> ccProd (seen) (set ys - ?seen_T) \<sqsubseteq> G"
            apply -
            apply (rule Cons.IH[where seen_T = "?seen_T"])
            apply (auto simp add: Un_Diff Int_Un_distrib2 Diff_eq f_nxt_def  join_below_iff  interleave_ccFromList interleave_set  ccProd_insert2[where S' = "set xs" for xs]
                    split: if_splits)
            apply (erule below_trans[OF cc_restr_mono1[OF subset]])
            apply (rule below_trans[OF cc_restr_below_arg], simp)
            apply (erule below_trans[OF ccProd_mono[OF order_refl Int_lower1]])
            apply (rule below_trans[OF cc_restr_below_arg], simp)
            apply (erule below_trans[OF ccProd_mono[OF order_refl Int_lower1]])
            apply (erule below_trans[OF ccProd_mono[OF order_refl subset2]])
            apply (erule below_trans[OF ccProd_mono[OF order_refl subset3]])
            apply (erule below_trans[OF ccProd_mono[OF order_refl subset4]])
            apply (erule below_trans[OF ccProd_mono[OF order_refl subset5]])
            done
        with  \<open>x \<in> S\<close>  seen_x \<open>x \<notin> seen_T\<close>
        show "ccFromList [x\<leftarrow>x # ys . x \<notin> S] \<sqsubseteq> G  \<and> ccProd seen (set (x#ys) - seen_T) \<sqsubseteq> G"
            apply (auto simp add: insert_Diff_if ccProd_insert2[where S' = "set ys - seen_T" for xs] join_below_iff)
            apply (rule below_trans[OF ccProd_mono[OF order_refl subset6]])
            apply (subst ccProd_union2)
            apply (auto simp add: join_below_iff)
            done
      next
        case False

        from False Cons.prems Cons.hyps
        have *: "ccFromList [x\<leftarrow>ys . x \<notin> S] \<sqsubseteq> G \<and> ccProd ((insert x seen)) (set ys - seen_T) \<sqsubseteq> G"
          apply -
          apply (rule Cons.IH[where seen = "insert x seen" and seen_T = seen_T])
          apply (auto simp add: \<open>x \<notin> seen_T\<close> Diff_eq ccApprox_both join_below_iff ttree_restr_both interleave_ccFromList insert_Diff_if
                     simp add:  ccProd_insert2[where S' = "set xs \<inter> - seen_T" for xs]
                     simp add:  ccProd_insert1[where S' = "seen"])
          done
        moreover
        {
        from False *
        have "ccProd {x} (set ys - seen_T) \<sqsubseteq>  G"
          by (auto simp add: insert_Diff_if ccProd_insert1[where S' = "seen"] join_below_iff)
        hence "ccProd {x} {x \<in> set ys - seen_T. x \<notin> S} \<sqsubseteq> G"
          by (rule below_trans[rotated, OF _ ccProd_mono2]) auto
        also have "{x \<in> set ys - seen_T. x \<notin> S} =  {x \<in> set ys. x \<notin> S}"
          using \<open>seen_T \<subseteq> S\<close> by auto
        finally
        have "ccProd {x} {x \<in> set ys. x \<notin> S} \<sqsubseteq> G".
        }
        moreover
        note False seen_x
        ultimately
        show "ccFromList [x\<leftarrow>x # ys . x \<notin> S] \<sqsubseteq> G \<and> ccProd (seen) (set (x # ys) - seen_T) \<sqsubseteq> G"
          by (auto simp add: join_below_iff  simp add: insert_Diff_if  ccProd_insert2[where S' = "set ys - seen_T" for xs]   ccProd_insert1[where S' = "seen"])
      qed
    qed
  qed
  with \<open>xs = _\<close>
  show "ccFromList xs \<sqsubseteq> G" by simp
qed

inductive_set valid_lists :: "var set \<Rightarrow> CoCalls \<Rightarrow> var list set"
  for S G
  where  "[] \<in> valid_lists S G"
  | "set xs \<subseteq> ccNeighbors x G \<Longrightarrow> xs \<in> valid_lists S G \<Longrightarrow> x \<in> S \<Longrightarrow> x#xs \<in> valid_lists S G"

inductive_simps valid_lists_simps[simp]: "[] \<in> valid_lists S G" "(x#xs) \<in> valid_lists S G"
inductive_cases vald_lists_ConsE: "(x#xs) \<in> valid_lists S G"

lemma  valid_lists_downset_aux:
  "xs \<in> valid_lists S CoCalls \<Longrightarrow> butlast xs \<in> valid_lists S CoCalls"
  by (induction xs) (auto dest: in_set_butlastD)

lemma valid_lists_subset: "xs \<in> valid_lists S G \<Longrightarrow> set xs \<subseteq> S"
  by (induction rule: valid_lists.induct) auto

lemma valid_lists_mono1:
  assumes "S \<subseteq> S'"
  shows "valid_lists S G \<subseteq> valid_lists S' G"
proof
  fix xs
  assume "xs \<in> valid_lists S G"
  thus "xs \<in> valid_lists S' G"
    by (induction rule: valid_lists.induct) (auto dest: subsetD[OF assms])
qed

lemma valid_lists_chain1:
   assumes "chain Y"
   assumes "xs \<in> valid_lists (\<Union>(Y ` UNIV)) G"
   shows "\<exists> i. xs \<in> valid_lists (Y i) G"
proof-
  note \<open>chain Y\<close>
  moreover
  from assms(2)
  have "set xs \<subseteq> \<Union>(Y ` UNIV)" by (rule valid_lists_subset)
  moreover
  have "finite (set xs)" by simp
  ultimately
  have "\<exists>i. set xs \<subseteq> Y i" by (rule finite_subset_chain)
  then obtain i where "set xs \<subseteq> Y i"..

  from assms(2) this
  have "xs \<in> valid_lists (Y i) G" by (induction rule:valid_lists.induct) auto
  thus ?thesis..
qed

lemma valid_lists_chain2:
   assumes "chain Y"
   assumes "xs \<in> valid_lists S (\<Squnion>i. Y i)"
   shows "\<exists> i. xs \<in> valid_lists S  (Y i)"
using assms(2)
proof(induction rule:valid_lists.induct[case_names Nil Cons])
  case Nil thus ?case by simp
next
  case (Cons xs x)

  from \<open>chain Y\<close>
  have "chain (\<lambda> i. ccNeighbors x (Y i))"
    apply (rule ch2ch_monofun[OF monofunI, rotated])
    unfolding below_set_def
    by (rule ccNeighbors_mono)
  moreover
  from \<open>set xs \<subseteq> ccNeighbors x (\<Squnion> i. Y i)\<close>
  have "set xs \<subseteq> (\<Union> i. ccNeighbors x (Y i))"
    by (simp add:  lub_set)
  moreover
  have "finite (set xs)" by simp
  ultimately
  have "\<exists>i. set xs \<subseteq> ccNeighbors x (Y i)" by (rule finite_subset_chain)
  then obtain i where i: "set xs \<subseteq> ccNeighbors x (Y i)"..

  from Cons.IH
  obtain j where j: "xs \<in> valid_lists S (Y j)"..

  from i
  have "set xs \<subseteq> ccNeighbors x (Y (max i j))"
    by (rule order_trans[OF _ ccNeighbors_mono[OF chain_mono[OF \<open>chain Y\<close> max.cobounded1]]])
  moreover
  from j
  have "xs \<in> valid_lists S (Y (max i j))"
    by (induction rule: valid_lists.induct)
       (auto del: subsetI elim: order_trans[OF _ ccNeighbors_mono[OF chain_mono[OF \<open>chain Y\<close> max.cobounded2]]])
  moreover
  note \<open>x \<in> S\<close>
  ultimately
  have "x # xs \<in> valid_lists S (Y (max i j))" by rule
  thus ?case..
qed

lemma valid_lists_cc_restr: "valid_lists S G = valid_lists S (cc_restr S G)"
proof(rule set_eqI)
  fix xs
  show "(xs \<in> valid_lists S G) = (xs \<in> valid_lists S (cc_restr S G))"
    by (induction xs) (auto dest: subsetD[OF valid_lists_subset])
qed

lemma interleave_valid_list:
  "xs \<in> ys \<otimes> zs \<Longrightarrow> ys \<in> valid_lists S G \<Longrightarrow> zs \<in> valid_lists S' G' \<Longrightarrow> xs \<in> valid_lists (S \<union> S') (G \<squnion> (G' \<squnion> ccProd S S'))"
proof (induction rule:interleave_induct)
  case Nil
  show ?case by simp
next
  case (left ys zs xs x)

  from \<open>x # ys \<in> valid_lists S G\<close>
  have "x \<in> S" and "set ys \<subseteq> ccNeighbors x G" and "ys \<in> valid_lists S G"
    by auto

  from \<open>xs \<in> ys \<otimes> zs\<close>
  have "set xs = set ys \<union> set zs" by (rule interleave_set)
  with \<open>set ys \<subseteq> ccNeighbors x G\<close> valid_lists_subset[OF \<open>zs \<in> valid_lists S' G'\<close>]
  have "set xs \<subseteq> ccNeighbors x (G \<squnion> (G' \<squnion> ccProd S S'))"
    by (auto simp add: ccNeighbors_ccProd \<open>x \<in> S\<close>)
  moreover
  from \<open>ys \<in> valid_lists S G\<close> \<open>zs \<in> valid_lists S' G'\<close>
  have "xs \<in> valid_lists (S \<union> S') (G \<squnion> (G' \<squnion> ccProd S S'))"
    by (rule left.IH)
  moreover
  from \<open>x \<in> S\<close>
  have "x \<in> S \<union> S'" by simp
  ultimately
  show ?case..
next
  case (right ys zs xs x)

  from \<open>x # zs \<in> valid_lists S' G'\<close>
  have "x \<in> S'" and "set zs \<subseteq> ccNeighbors x G'" and "zs \<in> valid_lists S' G'"
    by auto

  from \<open>xs \<in> ys \<otimes> zs\<close>
  have "set xs = set ys \<union> set zs" by (rule interleave_set)
  with \<open>set zs \<subseteq> ccNeighbors x G'\<close> valid_lists_subset[OF \<open>ys \<in> valid_lists S G\<close>]
  have "set xs \<subseteq> ccNeighbors x (G \<squnion> (G' \<squnion> ccProd S S'))"
    by (auto simp add: ccNeighbors_ccProd \<open>x \<in> S'\<close>)
  moreover
  from \<open>ys \<in> valid_lists S G\<close> \<open>zs \<in> valid_lists S' G'\<close>
  have "xs \<in> valid_lists (S \<union> S') (G \<squnion> (G' \<squnion> ccProd S S'))"
    by (rule right.IH)
  moreover
  from \<open>x \<in> S'\<close>
  have "x \<in> S \<union> S'" by simp
  ultimately
  show ?case..
qed

lemma interleave_valid_list':
  "xs \<in> valid_lists (S \<union> S') G \<Longrightarrow> \<exists> ys zs. xs \<in> ys \<otimes> zs \<and> ys \<in> valid_lists S G \<and> zs \<in> valid_lists S' G"
proof(induction rule: valid_lists.induct[case_names Nil Cons])
  case Nil show ?case by simp
next
  case (Cons xs x)
  then obtain ys zs where "xs \<in> ys \<otimes> zs" "ys \<in> valid_lists S G" "zs \<in> valid_lists S' G" by auto

    from \<open>xs \<in> ys \<otimes> zs\<close> have "set xs = set ys \<union> set zs" by (rule interleave_set)
    with \<open>set xs \<subseteq> ccNeighbors x G\<close>
    have "set ys \<subseteq> ccNeighbors x G" and "set zs \<subseteq> ccNeighbors x G"  by auto

  from \<open>x \<in> S \<union> S'\<close>
  show ?case
  proof
    assume "x \<in> S"
    with \<open>set ys \<subseteq> ccNeighbors x G\<close> \<open>ys \<in> valid_lists S G\<close>
    have "x # ys \<in> valid_lists S G"
      by rule
    moreover
    from \<open>xs \<in> ys \<otimes> zs\<close>
    have "x#xs \<in> x#ys \<otimes> zs"..
    ultimately
    show ?thesis using \<open>zs \<in> valid_lists S' G\<close> by blast
  next
    assume "x \<in> S'"
    with \<open>set zs \<subseteq> ccNeighbors x G\<close> \<open>zs \<in> valid_lists S' G\<close>
    have "x # zs \<in> valid_lists S' G"
      by rule
    moreover
    from \<open>xs \<in> ys \<otimes> zs\<close>
    have "x#xs \<in> ys \<otimes> x#zs"..
    ultimately
    show ?thesis using \<open>ys \<in> valid_lists S G\<close> by blast
  qed
qed

lemma many_calls_valid_list:
  "xs \<in> valid_lists {x} (ccProd {x} {x}) \<Longrightarrow> xs \<in> range (\<lambda>n. replicate n x)"
  by (induction rule: valid_lists.induct) (auto, metis UNIV_I image_iff replicate_Suc)

lemma filter_valid_lists:
  "xs \<in> valid_lists S G \<Longrightarrow> filter P xs \<in> valid_lists {a \<in> S. P a} G"
by (induction rule:valid_lists.induct) auto

lift_definition ccTTree :: "var set \<Rightarrow> CoCalls \<Rightarrow> var ttree" is "\<lambda> S G. valid_lists S G"
  by (auto intro: valid_lists_downset_aux)

lemma paths_ccTTree[simp]: "paths (ccTTree S G) = valid_lists S G" by transfer auto

lemma carrier_ccTTree[simp]: "carrier (ccTTree S G) = S"
  apply transfer
  apply (auto dest: valid_lists_subset)
  apply (rule_tac x = "[x]" in bexI)
  apply auto
  done

lemma valid_lists_ccFromList:
  "xs \<in> valid_lists S G \<Longrightarrow> ccFromList xs \<sqsubseteq> cc_restr S G"
by (induction rule:valid_lists.induct)
   (auto simp add: join_below_iff subset_ccNeighbors ccProd_below_cc_restr elim: subsetD[OF valid_lists_subset])

lemma ccApprox_ccTTree[simp]: "ccApprox (ccTTree S G) = cc_restr S G"
proof (transfer' fixing: S G, rule below_antisym)
  show "lub (ccFromList ` valid_lists S G) \<sqsubseteq> cc_restr S G"
    apply (rule is_lub_thelub_ex)
    apply (metis coCallsLub_is_lub)
    apply (rule is_ubI)
    apply clarify
    apply (erule valid_lists_ccFromList)
    done
next
  show "cc_restr S G \<sqsubseteq> lub (ccFromList ` valid_lists S G)"
  proof (rule below_CoCallsI)
    fix x y
    have "x--y\<in>(ccFromList [y,x])" by simp
    moreover
    assume "x--y\<in>(cc_restr S G)"
    hence "[y,x] \<in> valid_lists S G"  by (auto simp add: elem_ccNeighbors)
    ultimately
    show "x--y\<in>(lub (ccFromList ` valid_lists S G))"
      by (rule in_CoCallsLubI[OF _ imageI])
  qed
qed

lemma below_ccTTreeI:
  assumes "carrier t \<subseteq> S" and "ccApprox t \<sqsubseteq> G"
  shows "t \<sqsubseteq> ccTTree S G"
unfolding paths_mono_iff[symmetric] below_set_def
proof
  fix xs
  assume "xs \<in> paths t"
  with assms
  have "xs \<in> valid_lists S G"
  proof(induction xs arbitrary : t)
  case Nil thus ?case by simp
  next
  case (Cons x xs)
    from \<open>x # xs \<in> paths t\<close>
    have "possible t x" and "xs \<in> paths (nxt t x)" by (auto simp add: Cons_path)

    have "ccProd {x} (set xs) \<sqsubseteq> ccFromList (x # xs)" by simp
    also
    from \<open>x # xs \<in> paths t\<close>
    have "\<dots> \<sqsubseteq> ccApprox t"
      by (rule ccFromList_below_ccApprox)
    also
    note \<open>ccApprox t \<sqsubseteq> G\<close>
    finally
    have "ccProd {x} (set xs) \<sqsubseteq> G" by this simp_all
    hence "set xs \<subseteq> ccNeighbors x G" unfolding subset_ccNeighbors.
    moreover
    have "xs \<in> valid_lists S G"
    proof(rule Cons.IH)
      show "xs \<in> paths (nxt t x)" by fact
    next
      from \<open>carrier t \<subseteq> S\<close>
      show "carrier (nxt t x) \<subseteq> S"
        by (rule order_trans[OF carrier_nxt_subset])
    next
      from \<open>ccApprox t \<sqsubseteq> G\<close>
      show "ccApprox (nxt t x) \<sqsubseteq> G"
        by (rule below_trans[OF ccApprox_nxt_below])
    qed
    moreover
    from  \<open>carrier t \<subseteq> S\<close> and \<open>possible t x\<close>
    have "x \<in> S" by (rule carrier_possible_subset)
    ultimately
    show ?case..
  qed

  thus "xs \<in> paths (ccTTree S G)" by (metis paths_ccTTree)
qed

lemma ccTTree_mono1:
  "S \<subseteq> S' \<Longrightarrow> ccTTree S G \<sqsubseteq> ccTTree S' G"
  by (rule below_ccTTreeI) (auto simp add:  cc_restr_below_arg)

lemma cont_ccTTree1:
  "cont (\<lambda> S. ccTTree S G)"
  apply (rule contI2)
  apply (rule monofunI)
  apply (erule ccTTree_mono1[folded below_set_def])

  apply (rule ttree_belowI)
  apply (simp add: paths_Either lub_set lub_is_either)
  apply (drule (1) valid_lists_chain1[rotated])
  apply simp
  done

lemma ccTTree_mono2:
  "G \<sqsubseteq> G' \<Longrightarrow> ccTTree S G \<sqsubseteq> ccTTree S G'"
  apply (rule ttree_belowI)
  apply simp
  apply (induct_tac  rule:valid_lists.induct) apply assumption
  apply simp
  apply simp
  apply (erule (1) order_trans[OF _ ccNeighbors_mono])
  done

lemma ccTTree_mono:
  "S \<subseteq> S' \<Longrightarrow> G \<sqsubseteq> G' \<Longrightarrow> ccTTree S G \<sqsubseteq> ccTTree S' G'"
  by (metis below_trans[OF ccTTree_mono1 ccTTree_mono2])

lemma cont_ccTTree2:
  "cont (ccTTree S)"
  apply (rule contI2)
  apply (rule monofunI)
  apply (erule ccTTree_mono2)

  apply (rule ttree_belowI)
  apply (simp add: paths_Either lub_set lub_is_either)
  apply (drule (1) valid_lists_chain2)
  apply simp
  done

lemmas cont_ccTTree = cont_compose2[where c = ccTTree, OF cont_ccTTree1 cont_ccTTree2, simp, cont2cont]

lemma ccTTree_below_singleI:
  assumes "S \<inter> S' = {}"
  shows "ccTTree S G \<sqsubseteq> singles S'"
proof-
  {
  fix xs x
  assume "xs \<in> valid_lists S G" and "x \<in> S'"
  from this assms
  have "length [x'\<leftarrow>xs . x' = x] \<le> Suc 0"
  by(induction rule: valid_lists.induct[case_names Nil Cons]) auto
  }
  thus ?thesis by transfer auto
qed

lemma ccTTree_cc_restr: "ccTTree S G = ccTTree S (cc_restr S G)"
  by transfer' (rule valid_lists_cc_restr)

lemma ccTTree_cong_below: "cc_restr S G \<sqsubseteq> cc_restr S G' \<Longrightarrow> ccTTree S G \<sqsubseteq> ccTTree S G'"
  by (metis ccTTree_mono2 ccTTree_cc_restr)

lemma ccTTree_cong: "cc_restr S G = cc_restr S G' \<Longrightarrow> ccTTree S G = ccTTree S G'"
  by (metis ccTTree_cc_restr)

lemma either_ccTTree:
  "ccTTree S G \<oplus>\<oplus> ccTTree S' G' \<sqsubseteq> ccTTree (S \<union> S') (G \<squnion> G')"
  by (auto intro!: either_belowI ccTTree_mono)

lemma interleave_ccTTree:
   "ccTTree S G \<otimes>\<otimes> ccTTree S' G' \<sqsubseteq> ccTTree (S \<union> S') (G \<squnion> G' \<squnion> ccProd S S')"
   by transfer' (auto, erule (2) interleave_valid_list)

lemma interleave_ccTTree':
   "ccTTree (S \<union> S') G \<sqsubseteq> ccTTree S G \<otimes>\<otimes> ccTTree S' G"
   by transfer' (auto dest!:  interleave_valid_list')

lemma many_calls_ccTTree:
  shows "many_calls x = ccTTree {x} (ccProd {x} {x})"
  apply(transfer')
  apply (auto intro: many_calls_valid_list)
  apply (induct_tac n)
  apply (auto simp add: ccNeighbors_ccProd)
  done

lemma filter_valid_lists':
  "xs \<in> valid_lists {x' \<in> S. P x'} G \<Longrightarrow> xs \<in> filter P ` valid_lists S G"
proof (induction xs )
  case Nil thus ?case by auto  (metis filter.simps(1) image_iff valid_lists_simps(1))
next
  case (Cons x xs)
  from Cons.prems
  have "set xs \<subseteq> ccNeighbors x G" and "xs \<in> valid_lists {x' \<in> S. P x'} G" and "x \<in> S" and "P x" by auto

  from this(2) have "set xs \<subseteq> {x' \<in> S. P x'}" by (rule valid_lists_subset)
  hence "\<forall>x \<in> set xs. P x" by auto
  hence [simp]: "filter P xs = xs" by (rule filter_True)

  from Cons.IH[OF \<open>xs \<in> _\<close>]
  have "xs \<in> filter P ` valid_lists S G".

  from  \<open>xs \<in> valid_lists {x' \<in> S. P x'} G\<close>
  have "xs \<in> valid_lists S G" by (rule subsetD[OF valid_lists_mono1, rotated]) auto

  from \<open>set xs \<subseteq> ccNeighbors x G\<close> this \<open>x \<in> S\<close>
  have "x # xs \<in> valid_lists S G" by rule

  hence "filter P (x # xs) \<in> filter P ` valid_lists S G" by (rule imageI)
  thus ?case using \<open>P x\<close> \<open>filter P xs =xs\<close> by simp
qed

lemma without_ccTTree[simp]:
   "without x (ccTTree S G) = ccTTree (S - {x}) G"
by (transfer' fixing: x) (auto dest: filter_valid_lists'  filter_valid_lists[where P = "(\<lambda> x'. x'\<noteq> x)"]  simp add: set_diff_eq)

lemma ttree_restr_ccTTree[simp]:
   "ttree_restr S' (ccTTree S G) = ccTTree (S \<inter> S') G"
by (transfer' fixing: S') (auto dest: filter_valid_lists'  filter_valid_lists[where P = "(\<lambda> x'. x' \<in> S')"]  simp add:Int_def)

lemma repeatable_ccTTree_ccSquare: "S \<subseteq> S' \<Longrightarrow> repeatable (ccTTree S (ccSquare S'))"
   unfolding repeatable_def
   by transfer (auto simp add:ccNeighbors_ccSquare dest: subsetD[OF valid_lists_subset])

text \<open>An alternative definition\<close>

inductive valid_lists' :: "var set \<Rightarrow> CoCalls \<Rightarrow> var set \<Rightarrow> var list \<Rightarrow> bool"
  for S G
  where  "valid_lists' S G prefix []"
  | "prefix \<subseteq> ccNeighbors x G \<Longrightarrow> valid_lists' S G (insert x prefix) xs \<Longrightarrow> x \<in> S \<Longrightarrow> valid_lists' S G prefix (x#xs)"

inductive_simps valid_lists'_simps[simp]: "valid_lists' S G prefix []" "valid_lists' S G prefix (x#xs)"
inductive_cases vald_lists'_ConsE: "valid_lists' S G prefix (x#xs)"

lemma valid_lists_valid_lists':
  "xs \<in> valid_lists S G \<Longrightarrow> ccProd prefix (set xs) \<sqsubseteq> G \<Longrightarrow> valid_lists' S G prefix xs"
proof(induction arbitrary: prefix rule: valid_lists.induct[case_names Nil Cons])
  case Nil thus ?case by simp
next
  case (Cons xs x)

  from Cons.prems Cons.hyps Cons.IH[where prefix = "insert x prefix"]
  show ?case
  by (auto simp add: insert_is_Un[where A = "set xs"]  insert_is_Un[where A = prefix]
                     join_below_iff subset_ccNeighbors elem_ccNeighbors ccProd_comm simp del: Un_insert_left )
qed

lemma valid_lists'_valid_lists_aux:
  "valid_lists' S G prefix xs \<Longrightarrow>  x \<in> prefix \<Longrightarrow> ccProd (set xs) {x} \<sqsubseteq> G"
proof(induction  rule: valid_lists'.induct[case_names Nil Cons])
  case Nil thus ?case by simp
next
  case (Cons prefix x xs)
  thus ?case
    apply (auto simp add: ccProd_insert2[where S' = prefix] ccProd_insert1[where S' = "set xs"] join_below_iff subset_ccNeighbors)
    by (metis Cons.hyps(1) dual_order.trans empty_subsetI insert_subset subset_ccNeighbors)
qed

lemma valid_lists'_valid_lists:
  "valid_lists' S G prefix xs \<Longrightarrow> xs \<in> valid_lists S G"
proof(induction  rule: valid_lists'.induct[case_names Nil Cons])
  case Nil thus ?case by simp
next
  case (Cons prefix x xs)
  thus ?case
    by (auto simp add: insert_is_Un[where A = "set xs"]  insert_is_Un[where A = prefix]
                   join_below_iff subset_ccNeighbors elem_ccNeighbors ccProd_comm simp del: Un_insert_left
         intro: valid_lists'_valid_lists_aux)
qed

text \<open>Yet another definition\<close>

lemma valid_lists_characterization:
  "xs \<in> valid_lists S G \<longleftrightarrow> set xs \<subseteq> S \<and> (\<forall>n. ccProd (set (take n xs)) (set (drop n xs)) \<sqsubseteq> G)"
proof(safe)
  fix x
  assume "xs \<in> valid_lists S G"
  from  valid_lists_subset[OF this]
  show "x \<in> set xs \<Longrightarrow> x \<in> S" by auto
next
  fix n
  assume "xs \<in> valid_lists S G"
  thus "ccProd (set (take n xs)) (set (drop n xs)) \<sqsubseteq> G"
  proof(induction arbitrary: n rule: valid_lists.induct[case_names Nil Cons])
    case Nil thus ?case by simp
  next
    case (Cons xs x)
    show ?case
    proof(cases n)
      case 0 thus ?thesis by simp
    next
      case (Suc n)
      with Cons.hyps Cons.IH[where n = n]
      show ?thesis
      apply (auto simp add: ccProd_insert1[where S' = "set xs" for xs] join_below_iff subset_ccNeighbors)
      by (metis dual_order.trans set_drop_subset subset_ccNeighbors)
    qed
  qed
next
  assume "set xs \<subseteq> S"
  and "\<forall> n. ccProd (set (take n xs)) (set (drop n xs)) \<sqsubseteq> G"
  thus "xs \<in> valid_lists S G"
  proof (induction xs)
    case Nil thus ?case by simp
  next
    case (Cons x xs)
    from \<open>\<forall>n. ccProd (set (take n (x # xs))) (set (drop n (x # xs))) \<sqsubseteq> G\<close>
    have "\<forall>n. ccProd (set (take n xs)) (set (drop n xs)) \<sqsubseteq> G"
      by -(rule, erule_tac x = "Suc n" in allE, auto simp add: ccProd_insert1[where S' = "set xs" for xs] join_below_iff)
    from Cons.prems Cons.IH[OF _ this]
    have "xs \<in> valid_lists S G" by auto
    with Cons.prems(1)  spec[OF \<open>\<forall>n. ccProd (set (take n (x # xs))) (set (drop n (x # xs))) \<sqsubseteq> G\<close>, where x = 1]
    show ?case by (simp add: subset_ccNeighbors)
  qed
qed

end


(*
Author: Anthony Bordg
Affiliation: University of Cambridge
email: apdb3@cam.ac.uk
Date: October 2018
*)

theory Interval
imports
  Main
  "HOL-Analysis.Analysis"
begin

section \<open>The Invariance of the Interval\<close>

text
\<open>
We work in units where the value of the speed of light is 1.
We define the interval between any two events
(not necessarily two events that belong to the world line of a beam of light).
\<close>

definition interval :: "[real^4, real^4] \<Rightarrow> real" where
"interval u w \<equiv> -(w $ 4 - u $ 4)\<^sup>2 + (w $ 1 - u $ 1)\<^sup>2 + (w $ 2 - u $ 2)\<^sup>2 + (w $ 3 - u $ 3)\<^sup>2"

text \<open>We define a boost of velocity v in the u$1 direction.\<close>

definition boost_1 :: "[real^4, real] \<Rightarrow> real^4" where
"boost_1 u v \<equiv>
vector
[
u $ 1 / sqrt(1 - v\<^sup>2) - (v * u $ 4) / sqrt(1 - v\<^sup>2),
u $ 2,
u $ 3,
u $ 4 / sqrt(1 - v\<^sup>2) - (v * u $ 1) / sqrt(1 - v\<^sup>2)
]
"
text \<open>We define a boost of velocity v in the u$2 direction.\<close>

definition boost_2 :: "[real^4, real] \<Rightarrow> real^4" where
"boost_2 u v \<equiv>
vector
[
u $ 1,
u $ 2 / sqrt(1 - v\<^sup>2) - (v * u $ 4) / sqrt(1 - v\<^sup>2),
u $ 3,
u $ 4 / sqrt(1 - v\<^sup>2) - (v * u $ 2) / sqrt(1 - v\<^sup>2)
]
"
text \<open>We define a boost of velocity v in the u$3 direction.\<close>

definition boost_3 :: "[real^4, real] \<Rightarrow> real^4" where
"boost_3 u v \<equiv>
vector
[
u $ 1,
u $ 2,
u $ 3 / sqrt(1 - v\<^sup>2) - (v * u $ 4) / sqrt(1 - v\<^sup>2),
u $ 4 / sqrt(1 - v\<^sup>2) - (v * u $ 3) / sqrt(1 - v\<^sup>2)
]
"

text \<open>We prove the invariance of the interval with respect to a boost.\<close>

lemma vector_4 [simp]:
 "(vector [x1, x2, x3, x4] ::('a::zero)^4) $ 1 = x1"
 "(vector [x1, x2, x3, x4] ::('a)^4) $ 2 = x2"
 "(vector [x1, x2, x3, x4] ::('a)^4) $ 3 = x3"
 "(vector [x1, x2, x3, x4] ::('a)^4) $ 4 = x4"
  unfolding vector_def
  by auto

lemma invar_1:
  fixes v:: "real" and u w::"real^4"
  assumes "v\<^sup>2 < 1"
  shows "interval u w = interval (boost_1 u v) (boost_1 w v)"
proof-
  have "interval (boost_1 u v) (boost_1 w v) =
-((w $ 4 / sqrt(1 - v\<^sup>2) - (v * w $ 1) / sqrt(1 - v\<^sup>2)) - u $ 4 / sqrt(1 - v\<^sup>2) + (v * u $ 1) / sqrt(1 - v\<^sup>2))\<^sup>2
+ ((w $ 1 / sqrt(1 - v\<^sup>2) - (v * w $ 4) / sqrt(1 - v\<^sup>2)) - u $ 1 / sqrt(1 - v\<^sup>2) + (v * u $ 4) / sqrt(1 - v\<^sup>2))\<^sup>2
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by (simp add: interval_def boost_1_def diff_add_eq diff_diff_eq2)
  then have f1:"interval (boost_1 u v) (boost_1 w v) =
-((w $ 4 - v * w $ 1 - u $ 4 + v * u $ 1) / sqrt(1 - v\<^sup>2))\<^sup>2
+ ((w $ 1 - v * w $ 4 - u $ 1 + v * u $ 4) / sqrt(1 - v\<^sup>2))\<^sup>2
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by (simp add: add_divide_distrib diff_divide_distrib)
  have f2:"1 - v\<^sup>2 \<ge> 0"
    using assms
    by simp
  from f1 f2 have "interval (boost_1 u v) (boost_1 w v) =
1/(1 - v\<^sup>2) * ((w $ 1 - v * w $ 4 - u $ 1 + v * u $ 4)\<^sup>2 -(w $ 4 - v * w $ 1 - u $ 4 + v * u $ 1)\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by (simp add: diff_divide_distrib power_divide)
  then have "interval (boost_1 u v) (boost_1 w v) =
1/(1 - v\<^sup>2) * ((w $ 1 - u $ 1 - v * (w $ 4 - u $ 4))\<^sup>2 - (w $ 4 - u $ 4 - v * (w $ 1 - u $ 1))\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    apply (simp add: right_diff_distrib')
    by smt
  then have "interval (boost_1 u v) (boost_1 w v) =
1/(1 - v\<^sup>2) * ((w $ 1 - u $ 1)\<^sup>2 - 2 * v * (w $ 1 - u $ 1) * (w $ 4 - u $ 4) + v\<^sup>2 * (w $ 4 - u $ 4)\<^sup>2
             - (w $ 4 - u $ 4)\<^sup>2 + 2 * v * (w $ 4 - u $ 4) * (w $ 1 - u $ 1) - v\<^sup>2 * (w $ 1 - u $ 1)\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    apply (simp add: power2_diff power_mult_distrib)
    by (metis (no_types, hide_lams) mult.assoc mult.commute mult.left_commute right_diff_distrib_numeral)
  then have f2:"interval (boost_1 u v) (boost_1 w v) =
1/(1 - v\<^sup>2) * ((w $ 1 - u $ 1)\<^sup>2 + v\<^sup>2 * (w $ 4 - u $ 4)\<^sup>2 - (w $ 4 - u $ 4)\<^sup>2 - v\<^sup>2 * (w $ 1 - u $ 1)\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by simp
  have f3:"(w $ 1 - u $ 1)\<^sup>2 - v\<^sup>2 * (w $ 1 - u $ 1)\<^sup>2 = (w $ 1 - u $ 1)\<^sup>2 * (1 - v\<^sup>2)"
    by (simp add: right_diff_distrib)
  have f4:"v\<^sup>2 * (w $ 4 - u $ 4)\<^sup>2 - (w $ 4 - u $ 4)\<^sup>2 = -(w $ 4 - u $ 4)\<^sup>2 * (1 - v\<^sup>2)"
    by (simp add: right_diff_distrib)
  from f2 f3 f4 have "interval (boost_1 u v) (boost_1 w v) =
1/(1 - v\<^sup>2) * (- (w $ 4 - u $ 4)\<^sup>2 * (1 - v\<^sup>2) + (w $ 1 - u $ 1)\<^sup>2 * (1 - v\<^sup>2))
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by simp
  then have "interval (boost_1 u v) (boost_1 w v) =
1/(1 - v\<^sup>2) * (1 - v\<^sup>2) * (- (w $ 4 - u $ 4)\<^sup>2 + (w $ 1 - u $ 1)\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    using ring_distribs(2) Groups.mult_ac
    by (metis (no_types, hide_lams))
  thus ?thesis
    using assms interval_def[of u w]
    by simp
qed

lemma invar_2:
  fixes v:: "real" and u w::"real^4"
  assumes "v\<^sup>2 < 1"
  shows "interval u w = interval (boost_2 u v) (boost_2 w v)"
proof-
have "interval (boost_2 u v) (boost_2 w v) =
-((w $ 4 / sqrt(1 - v\<^sup>2) - (v * w $ 2) / sqrt(1 - v\<^sup>2)) - u $ 4 / sqrt(1 - v\<^sup>2) + (v * u $ 2) / sqrt(1 - v\<^sup>2))\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2
+ ((w $ 2 / sqrt(1 - v\<^sup>2) - (v * w $ 4) / sqrt(1 - v\<^sup>2)) - u $ 2 / sqrt(1 - v\<^sup>2) + (v * u $ 4) / sqrt(1 - v\<^sup>2))\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by (simp add: interval_def boost_2_def diff_add_eq diff_diff_eq2)
  then have f1:"interval (boost_2 u v) (boost_2 w v) =
-((w $ 4 - v * w $ 2 - u $ 4 + v * u $ 2) / sqrt(1 - v\<^sup>2))\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2
+ ((w $ 2 - v * w $ 4 - u $ 2 + v * u $ 4) / sqrt(1 - v\<^sup>2))\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by (simp add: add_divide_distrib diff_divide_distrib)
  have f2:"1 - v\<^sup>2 \<ge> 0"
    using assms
    by simp
  from f1 f2 have "interval (boost_2 u v) (boost_2 w v) =
1/(1 - v\<^sup>2) * ((w $ 2 - v * w $ 4 - u $ 2 + v * u $ 4)\<^sup>2 -(w $ 4 - v * w $ 2 - u $ 4 + v * u $ 2)\<^sup>2)
+ (w $ 1 - u $ 1)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by (simp add: diff_divide_distrib power_divide)
  then have "interval (boost_2 u v) (boost_2 w v) =
1/(1 - v\<^sup>2) * ((w $ 2 - u $ 2 - v * (w $ 4 - u $ 4))\<^sup>2 - (w $ 4 - u $ 4 - v * (w $ 2 - u $ 2))\<^sup>2)
+ (w $ 1 - u $ 1)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    apply (simp add: right_diff_distrib')
    by smt
  then have "interval (boost_2 u v) (boost_2 w v) =
1/(1 - v\<^sup>2) * ((w $ 2 - u $ 2)\<^sup>2 - 2 * v * (w $ 2 - u $ 2) * (w $ 4 - u $ 4) + v\<^sup>2 * (w $ 4 - u $ 4)\<^sup>2
             - (w $ 4 - u $ 4)\<^sup>2 + 2 * v * (w $ 4 - u $ 4) * (w $ 2 - u $ 2) - v\<^sup>2 * (w $ 2 - u $ 2)\<^sup>2)
+ (w $ 1 - u $ 1)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    apply (simp add: power2_diff power_mult_distrib)
    by (metis (no_types, hide_lams) mult.commute mult.left_commute right_diff_distrib_numeral)
  then have f2:"interval (boost_2 u v) (boost_2 w v) =
1/(1 - v\<^sup>2) * ((w $ 2 - u $ 2)\<^sup>2 + v\<^sup>2 * (w $ 4 - u $ 4)\<^sup>2 - (w $ 4 - u $ 4)\<^sup>2 - v\<^sup>2 * (w $ 2 - u $ 2)\<^sup>2)
+ (w $ 1 - u $ 1)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by simp
  have f3:"(w $ 2 - u $ 2)\<^sup>2 - v\<^sup>2 * (w $ 2 - u $ 2)\<^sup>2 = (w $ 2 - u $ 2)\<^sup>2 * (1 - v\<^sup>2)"
    by (simp add: right_diff_distrib)
  have f4:"v\<^sup>2 * (w $ 4 - u $ 4)\<^sup>2 - (w $ 4 - u $ 4)\<^sup>2 = -(w $ 4 - u $ 4)\<^sup>2 * (1 - v\<^sup>2)"
    by (simp add: right_diff_distrib)
  from f2 f3 f4 have "interval (boost_2 u v) (boost_2 w v) =
1/(1 - v\<^sup>2) * (- (w $ 4 - u $ 4)\<^sup>2 * (1 - v\<^sup>2) + (w $ 2 - u $ 2)\<^sup>2 * (1 - v\<^sup>2))
+ (w $ 1 - u $ 1)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    by simp
  then have "interval (boost_2 u v) (boost_2 w v) =
1/(1 - v\<^sup>2) * (1 - v\<^sup>2) * (- (w $ 4 - u $ 4)\<^sup>2 + (w $ 2 - u $ 2)\<^sup>2)
+ (w $ 1 - u $ 1)\<^sup>2
+ (w $ 3 - u $ 3)\<^sup>2"
    using ring_distribs(2) Groups.mult_ac
    by (metis (no_types, hide_lams))
  thus ?thesis
    using assms interval_def[of u w]
    by simp
qed

lemma invar_3:
  fixes v:: "real" and u w::"real^4"
  assumes "v\<^sup>2 < 1"
  shows "interval u w = interval (boost_3 u v) (boost_3 w v)"
proof-
 have "interval (boost_3 u v) (boost_3 w v) =
-((w $ 4 / sqrt(1 - v\<^sup>2) - (v * w $ 3) / sqrt(1 - v\<^sup>2)) - u $ 4 / sqrt(1 - v\<^sup>2) + (v * u $ 3) / sqrt(1 - v\<^sup>2))\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2
+ (w $ 2 - u $ 2)\<^sup>2
+ ((w $ 3 / sqrt(1 - v\<^sup>2) - (v * w $ 4) / sqrt(1 - v\<^sup>2)) - u $ 3 / sqrt(1 - v\<^sup>2) + (v * u $ 4) / sqrt(1 - v\<^sup>2))\<^sup>2"
    by (simp add: interval_def boost_3_def diff_add_eq diff_diff_eq2)
  then have f1:"interval (boost_3 u v) (boost_3 w v) =
-((w $ 4 - v * w $ 3 - u $ 4 + v * u $ 3) / sqrt(1 - v\<^sup>2))\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2
+ (w $ 2 - u $ 2)\<^sup>2
+ ((w $ 3 - v * w $ 4 - u $ 3 + v * u $ 4) / sqrt(1 - v\<^sup>2))\<^sup>2"
    by (simp add: add_divide_distrib diff_divide_distrib)
  have f2:"1 - v\<^sup>2 \<ge> 0"
    using assms
    by simp
  from f1 f2 have "interval (boost_3 u v) (boost_3 w v) =
1/(1 - v\<^sup>2) * ((w $ 3 - v * w $ 4 - u $ 3 + v * u $ 4)\<^sup>2 -(w $ 4 - v * w $ 3 - u $ 4 + v * u $ 3)\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2"
    by (simp add: diff_divide_distrib power_divide)
  then have "interval (boost_3 u v) (boost_3 w v) =
1/(1 - v\<^sup>2) * ((w $ 3 - u $ 3 - v * (w $ 4 - u $ 4))\<^sup>2 - (w $ 4 - u $ 4 - v * (w $ 3 - u $ 3))\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2"
    apply (simp add: right_diff_distrib')
    by smt
  then have "interval (boost_3 u v) (boost_3 w v) =
1/(1 - v\<^sup>2) * ((w $ 3 - u $ 3)\<^sup>2 - 2 * v * (w $ 3 - u $ 3) * (w $ 4 - u $ 4) + v\<^sup>2 * (w $ 4 - u $ 4)\<^sup>2
             - (w $ 4 - u $ 4)\<^sup>2 + 2 * v * (w $ 4 - u $ 4) * (w $ 3 - u $ 3) - v\<^sup>2 * (w $ 3 - u $ 3)\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2"
    apply (simp add: power2_diff power_mult_distrib)
    by (metis (no_types, hide_lams) mult.commute mult.left_commute right_diff_distrib_numeral)
  then have f2:"interval (boost_3 u v) (boost_3 w v) =
1/(1 - v\<^sup>2) * ((w $ 3 - u $ 3)\<^sup>2 + v\<^sup>2 * (w $ 4 - u $ 4)\<^sup>2 - (w $ 4 - u $ 4)\<^sup>2 - v\<^sup>2 * (w $ 3 - u $ 3)\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2"
    by simp
  have f3:"(w $ 3 - u $ 3)\<^sup>2 - v\<^sup>2 * (w $ 3 - u $ 3)\<^sup>2 = (w $ 3 - u $ 3)\<^sup>2 * (1 - v\<^sup>2)"
    by (simp add: right_diff_distrib)
  have f4:"v\<^sup>2 * (w $ 4 - u $ 4)\<^sup>2 - (w $ 4 - u $ 4)\<^sup>2 = -(w $ 4 - u $ 4)\<^sup>2 * (1 - v\<^sup>2)"
    by (simp add: right_diff_distrib)
  from f2 f3 f4 have "interval (boost_3 u v) (boost_3 w v) =
1/(1 - v\<^sup>2) * (- (w $ 4 - u $ 4)\<^sup>2 * (1 - v\<^sup>2) + (w $ 3 - u $ 3)\<^sup>2 * (1 - v\<^sup>2))
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2"
    by simp
  then have "interval (boost_3 u v) (boost_3 w v) =
1/(1 - v\<^sup>2) * (1 - v\<^sup>2) * (- (w $ 4 - u $ 4)\<^sup>2 + (w $ 3 - u $ 3)\<^sup>2)
+ (w $ 2 - u $ 2)\<^sup>2
+ (w $ 1 - u $ 1)\<^sup>2"
    using ring_distribs(2) Groups.mult_ac
    by (metis (no_types, hide_lams))
  thus ?thesis
    using assms interval_def[of u w]
    by simp
qed

end


(* 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_sort_nat_QSortSorts
  imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun lt :: "Nat => Nat => bool" where
  "lt y (Z) = False"
| "lt (Z) (S z2) = True"
| "lt (S n) (S z2) = lt n z2"

fun le :: "Nat => Nat => bool" where
  "le (Z) z = True"
| "le (S z2) (Z) = False"
| "le (S z2) (S x2) = le z2 x2"

fun ordered :: "Nat list => bool" where
  "ordered (nil2) = True"
| "ordered (cons2 z (nil2)) = True"
| "ordered (cons2 z (cons2 y2 xs)) =
     ((le z y2) & (ordered (cons2 y2 xs)))"

fun gt :: "Nat => Nat => bool" where
  "gt y z = lt z y"

fun filter :: "('a => bool) => 'a list => 'a list" where
  "filter q (nil2) = nil2"
| "filter q (cons2 z xs) =
     (if q z then cons2 z (filter q xs) else filter q xs)"

(*fun did not finish the proof*)
function qsort :: "Nat list => Nat list" where
  "qsort (nil2) = nil2"
| "qsort (cons2 z xs) =
     x (qsort (filter (% (z2 :: Nat) => le z2 z) xs))
       (x (cons2 z (nil2))
          (qsort (filter (% (x2 :: Nat) => gt x2 z) xs)))"
  by pat_completeness auto

theorem property0 :
  "ordered (qsort xs)"
  oops

end


theory prop_45
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun le :: "Nat => Nat => bool" where
  "le (Z) y = True"
  | "le (S z) (Z) = False"
  | "le (S z) (S x2) = le z x2"
  fun insert2 :: "Nat => Nat list => Nat list" where
  "insert2 x (Nil2) = Cons2 x (Nil2)"
  | "insert2 x (Cons2 z xs) =
       (if le x z then Cons2 x (Cons2 z xs) else Cons2 z (insert2 x xs))"
  fun equal2 :: "Nat => Nat => bool" where
  "equal2 (Z) (Z) = True"
  | "equal2 (Z) (S z) = False"
  | "equal2 (S x2) (Z) = False"
  | "equal2 (S x2) (S y2) = equal2 x2 y2"
  fun elem :: "Nat => Nat list => bool" where
  "elem x (Nil2) = False"
  | "elem x (Cons2 z xs) = (if equal2 x z then True else elem x xs)"
  (*hipster le insert2 equal2 elem *)

lemma lemma_a [thy_expl]: "equal2 x2 y2 = equal2 y2 x2"
by (hipster_induct_schemes equal2.simps)

lemma lemma_aa [thy_expl]: "equal2 x2 x2 = True"
by (hipster_induct_schemes equal2.simps)

lemma lemma_ab [thy_expl]: "equal2 x2 (S x2) = False"
by (hipster_induct_schemes equal2.simps)

  theorem x0 :
    "elem x (insert2 x y)"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


theory rlm_13_02_lemma
  imports "RLM_learn"
begin

context learning_basics1
begin

lemma S_index_similar : "\<forall>i. \<forall> j \<noteq> i. l v (S' j) = l v ((S_index S' i z) j)"
  by (simp add: S_index_def)

lemma sum_split :"\<forall>i \<in>{0..<n}. sum f {0..<n} = sum f {0..<i} + f i + sum f {i+1..<n}"
  for f :: "nat \<Rightarrow> real"
  by (smt Suc_eq_plus1 ab_semigroup_add_class.add_ac(1)
      atLeastLessThan_iff le_eq_less_or_eq sum.atLeastLessThan_concat sum.atLeast_Suc_lessThan)

lemma S_index_eq_without_i : " i \<notin> A \<Longrightarrow>
     sum (\<lambda> j.  l v (S' j)) A = sum (\<lambda> j. l v ((S_index S' i z) j)) A"
  by (metis (mono_tags, lifting) S_index_similar  sum.cong)

lemma restrict_integral: "integral\<^sup>L M f = integral\<^sup>L M   (restrict f (space M))"
  by (metis Bochner_Integration.integral_cong restrict_apply)

lemma restrict_nn_integral: "integral\<^sup>N M f = integral\<^sup>N M   (restrict f (space M))"
  by (metis nn_integral_cong restrict_apply)

lemma integral_measure_pmf_real_indicator:
  fixes f :: "'e \<Rightarrow> real"
  shows "(\<integral>x. f x \<partial>measure_pmf M) =  (\<integral>x. f x * indicator M x \<partial>measure_pmf M)"
  by (intro integral_cong_AE)
    (auto split: split_indicator simp: AE_measure_pmf_iff)

lemma nn_integral_measure_pmf_real_indicator:
  fixes f :: "'e \<Rightarrow> real"
  shows "(\<integral>\<^sup>+ x. f x \<partial>measure_pmf M) =  (\<integral>\<^sup>+ x. f x * indicator M x \<partial>measure_pmf M)"
  by (intro nn_integral_cong_AE)
    (auto split: split_indicator simp: AE_measure_pmf_iff)

lemma integral_restrict_space_same:
  fixes f :: "'e \<Rightarrow> real"
  fixes M :: " 'e pmf"
  shows "integral\<^sup>L (restrict_space M M) f = integral\<^sup>L M f"
  by (simp add: integral_pmf_restrict)

lemma integral_restrict_space_eq_restrict_fun:
  fixes f :: "'e \<Rightarrow> real"
  fixes M :: " 'e pmf"
  shows "integral\<^sup>L (restrict_space M M) f = integral\<^sup>L M (restrict f (set_pmf M))"
  using  integral_restrict_space_same restrict_integral
  by (metis FuncSet.restrict_restrict space_restrict_space)

lemma pmf_restrict:
  fixes f :: "'e \<Rightarrow> real"
  shows "measure_pmf.expectation M (\<lambda> x. f x) = measure_pmf.expectation M (\<lambda> x\<in>M. f x)"
  by (metis integral_restrict_space_eq_restrict_fun integral_restrict_space_same)

lemma nn_integral_pmf_restrict:
  fixes f::"'e \<Rightarrow> real"
  shows "(\<integral>\<^sup>+ x. f x \<partial>measure_pmf M) = (\<integral>\<^sup>+ x. f x \<partial>restrict_space M M)"
  by (auto intro!: nn_integral_cong_AE simp add: nn_integral_restrict_space AE_measure_pmf_iff)

lemma nn_integral_restrict_space_same:
  fixes f :: "'e \<Rightarrow> real"
  fixes M :: " 'e pmf"
  shows "integral\<^sup>N (restrict_space M M) f = integral\<^sup>N M (restrict f (set_pmf M))"
  by (smt UNIV_I nn_integral_cong nn_integral_pmf_restrict restrict_apply'
      sets_measure_pmf space_restrict_space2)

lemma nn_integral_restrict_space_eq_restrict_fun:
  fixes f :: "'e \<Rightarrow> real"
  fixes M :: " 'e pmf"
  shows "integral\<^sup>N M (restrict f (set_pmf M)) = integral\<^sup>N M f"
  using nn_integral_pmf_restrict nn_integral_restrict_space_same by metis

lemma min_in_H: "S \<in> (Samples n D) \<longrightarrow>  (ridge_mine S k) \<in> H"
proof
  assume "S \<in> (Samples n D)"
  then have "(ridge_mine S k) \<in> (ridge_argmin S k)"
    using in_argmin  k_pos by blast
  then show "(ridge_mine S k) \<in> H"
    by (simp add: is_arg_min_linorder ridge_argmin_def)
qed

lemma truncated_same_min:
  shows "\<forall> S. (ridge_mine (truncated_S S n) k)  =  (ridge_mine S k)"
proof
  fix S
  show "(ridge_mine (truncated_S S n) k)  =  (ridge_mine  S k)"
  proof -
    let ?S' = "(S(n:=undefined))"

    have "ridge_fun S k = ridge_fun ?S' k"
    proof
      fix xa
      have "train_err_loss S n l xa =  train_err_loss ?S' n l xa"
        unfolding train_err_loss_def by auto
      then show "ridge_fun S k xa = ridge_fun ?S' k xa"
        by simp
    qed
    then show ?thesis
      using ridge_argmin_def ridge_mine_def truncated_S_def by auto
  qed
qed

lemma pmf_swapped_same:
    assumes m_pos: "m > 0"
    shows "\<forall> i \<in> {0..<m}. pmf (Samples m D) f  = pmf (Samples m D) (f(i:=(f (m-1)),(m-1):=(f i)))"
proof
  fix i
  assume "i \<in> {0..<m}"
  let ?f' = "(f(i:=(f (m-1)),(m-1):=(f i)))"
  let ?Dn1 = "Samples (m) D"
  let ?I = "{0..<m}"
  have "finite ?I" by auto
  have "finite {i,(m-1)}" by auto

  have 1: "pmf ?Dn1 f = (if (\<forall>x. x \<notin> ?I \<longrightarrow> f x = undefined) then
           \<Prod>x\<in>?I. pmf ((\<lambda>_. D) x) (f x) else 0)"
    unfolding Samples_def
    using pmf_Pi[of ?I undefined "(\<lambda>_. D)" f] by blast

  have 2: "pmf ?Dn1 ?f' =
        (if (\<forall>x. x \<notin> ?I \<longrightarrow> ?f' x = undefined) then
           \<Prod>x\<in>?I. pmf ((\<lambda>_. D) x) (?f' x) else 0)"
    unfolding Samples_def
    using pmf_Pi[of ?I undefined "(\<lambda>_. D)" "?f'"] by blast

  show "pmf ?Dn1 f  = pmf ?Dn1 ?f'"
  proof (cases "(\<forall>x. x \<notin> ?I \<longrightarrow> f x = undefined)")
    case True
    have "(\<Prod>x\<in>?I. pmf D (f x)) = (\<Prod>x\<in>?I. pmf D (?f' x))"
    proof(cases "i=(m-1)")
      case True
      then show ?thesis by auto
    next
      case False
      have inter_empty: "(?I - {i,(m-1)}) \<inter> {i,(m-1)} = {}" by auto
      have union_I : "(?I - {i,(m-1)}) \<union> {i,(m-1)} = ?I"
        using Diff_cancel \<open>i \<in> ?I\<close> by auto

      have " (\<Prod>x\<in>(?I - {i,(m-1)}). pmf D (?f' x)) * (\<Prod>x\<in>{i,(m-1)}.(pmf D (?f' x))) =
                (\<Prod>x\<in>(?I - {i,(m-1)}). pmf D (f x)) * (\<Prod>x\<in>{i,(m-1)}.(pmf D (f x)))"
        using prod.union_disjoint False by auto
      then show ?thesis  using `finite {i,(m-1)}` `finite ?I`
          inter_empty union_I prod.union_disjoint  finite_Diff by metis
    qed
    then show ?thesis using 1 2 True
      using \<open>i \<in> {0..<m}\<close> fun_upd_other by auto
  next
    case False
    have "pmf ?Dn1 f = 0"  using False "1" by auto
    also have "pmf ?Dn1 ?f' = 0"
      using 2 False fun_upd_other  \<open>i \<in> ?I\<close> by auto
    finally  show ?thesis  by linarith
  qed
qed

lemma inj_swapped: "inj (\<lambda> S. swapped_S S i m)"
proof (rule)
  fix x
  fix y
  show " x \<in> UNIV \<Longrightarrow> y \<in> UNIV \<Longrightarrow> swapped_S x i m = swapped_S y i m \<Longrightarrow> x = y"
  proof
    fix xa
    assume "x \<in> UNIV"
    assume "y \<in> UNIV"
    assume "swapped_S x i m = swapped_S y i m"
    then have "x (i:= x m, m:= x i) = y(i:= y m, m:= y i)"
      using swapped_S_def by auto
    show "x xa = y xa"
      by (smt \<open>x(i := x m, m := x i) = y(i := y m, m := y i)\<close> fun_upd_eqD fun_upd_triv fun_upd_twist)
  qed
qed

lemma map_pmf_swap_same:
    assumes m_pos: "m > 0"
    shows "\<forall>i \<in> {0..<m}. pmf (Samples m D) x =
         pmf (map_pmf (\<lambda> S. swapped_S S i (m-1)) (Samples m D)) x"
proof
  fix i
  assume "i \<in> {0..<m}"
  let ?M = "(Samples m D)"
  let ?f = "(\<lambda> S. swapped_S S i (m-1))"

  have "pmf ?M x =pmf ?M (?f x) "
    using  pmf_swapped_same[of m x] swapped_S_def m_pos  by (metis \<open>i \<in> {0..<m}\<close>)
  also have "\<dots> = pmf (map_pmf ?f ?M) (?f (swapped_S x i (m-1)))"
    using  inj_swapped[of i "(m-1)"] pmf_map_inj' by metis
  also have " \<dots> =  pmf (map_pmf ?f ?M) x"
    by (simp add: swapped_S_def)
  then show "pmf ?M x = pmf (map_pmf ?f ?M) x"
    using calculation by linarith
qed

lemma expect_sample_swap_same:
  fixes f :: "_ \<Rightarrow> real"
  fixes m :: "nat"
   assumes m_pos: "m > 0"
  assumes i_le_n: "i \<in> {0..<m}"
  shows "measure_pmf.expectation (Samples m D) f  =
           measure_pmf.expectation (map_pmf (\<lambda> S. swapped_S S i (m-1)) (Samples m D)) f"
proof -
  let ?M = "(Samples m D)"
  let ?M_swap = "(map_pmf (\<lambda> S. swapped_S S i (m-1)) (Samples m D))"

  have "integral\<^sup>L ?M f  =  infsetsum (\<lambda>x. pmf ?M x * f x) UNIV"
    using pmf_expectation_eq_infsetsum by auto
  also have " infsetsum (\<lambda>x. pmf ?M x * f x) UNIV = infsetsum (\<lambda>x. pmf  ?M_swap x * f x) UNIV"
    using  map_pmf_swap_same i_le_n  by simp
  also have " infsetsum (\<lambda>x. pmf ?M_swap x * f x) UNIV = integral\<^sup>L ?M_swap f "
    using pmf_expectation_eq_infsetsum[of "?M_swap" f] by auto
  finally show ?thesis  by auto
qed

lemma integrable_f_swap_same:
  fixes f :: "_ \<Rightarrow> real"
  fixes m :: "nat"
  assumes m_pos: "m > 0"
  assumes f_nn: "\<forall>x\<in> (Samples m D). f x \<ge> 0"
  assumes i_le_n: "i \<in> {0..<m}"
  shows "integrable (Samples m D) f  =
          integrable  (Samples m D) (\<lambda> x. f (swapped_S x i (m-1)))"
proof -
  let ?M = "Samples m D"
  let ?g = "(\<lambda> x. f (swapped_S x i (m-1)))"
  have "\<forall>x\<in>?M. (swapped_S x i (m-1)) \<in> ?M"
    by (metis i_le_n m_pos pmf_eq_0_set_pmf pmf_swapped_same swapped_S_def)
  then have 1:"\<forall>x \<in> ?M. ennreal (norm (?g x)) = ?g x" using f_nn
    by simp
  have "\<forall>x \<in> ?M. ennreal (norm (f x)) = f x" using f_nn by simp
  then have "integral\<^sup>N ?M (\<lambda> x. ennreal (norm (f x))) = integral\<^sup>N ?M f"
    by (simp add: AE_measure_pmf_iff nn_integral_cong_AE)
  also have "integral\<^sup>N (Samples m D) f =
    integral\<^sup>N (map_pmf (\<lambda>f. swapped_S f i (m-1)) (Samples m D)) f"
    using expect_sample_swap_same[of m i f] i_le_n m_pos
    by (metis map_pmf_swap_same pmf_eqI)
  also have " integral\<^sup>N (map_pmf (\<lambda>f. swapped_S f i (m-1)) (Samples m D)) f =
         integral\<^sup>N (Samples m D) (\<lambda> x. f (swapped_S x i (m-1)))" by auto
  also have " \<dots> =  integral\<^sup>N (Samples m D) (\<lambda> x. ennreal( norm(f (swapped_S x i (m-1)))))"
    using 1  by (simp add: AE_measure_pmf_iff nn_integral_cong_AE)
  finally have "integral\<^sup>N ?M (\<lambda> x. ennreal (norm (f x))) =
              integral\<^sup>N (Samples m D) (\<lambda> x. ennreal( norm(f (swapped_S x i (m-1)))))" by auto
  then have 2: "integral\<^sup>N ?M (\<lambda> x. ennreal (norm (f x))) < \<infinity> \<longleftrightarrow>
       integral\<^sup>N (Samples m D) (\<lambda> x. ennreal( norm(f (swapped_S x i (m-1))))) < \<infinity>" by auto
  have 3: "f \<in> borel_measurable ?M" by auto
  have "(\<lambda> x. f (swapped_S x i (m-1))) \<in> borel_measurable ?M" by auto
  then show ?thesis using 2 3 integrable_iff_bounded
    by (metis (mono_tags, lifting) nn_integral_cong)
qed

lemma expect_f_swap_same:
  fixes f :: "_ \<Rightarrow> real"
  fixes m :: "nat"
  assumes m_pos: "m > 0"
  assumes i_le_n: "i \<in> {0..<m}"
  shows "measure_pmf.expectation (Samples m D) f  =
           measure_pmf.expectation  (Samples m D) (\<lambda> x. f (swapped_S x i (m-1)))"
proof -
  have "measure_pmf.expectation (Samples m D) f =
    measure_pmf.expectation (map_pmf (\<lambda>f. swapped_S f i (m-1)) (Samples m D)) f"
    using expect_sample_swap_same[of m i f] i_le_n m_pos  by blast
  then show ?thesis by auto
qed

lemma ridge_mine_swap:
  "\<forall> i\<in>{0..<n+1}. measure_pmf.expectation (Samples (n+1) D) (\<lambda> Sz. l (ridge_mine  Sz k) (Sz n)) =
       measure_pmf.expectation (Samples (n+1) D) (\<lambda> Sz. l (ridge_mine  (swapped_S Sz i n) k) (Sz i))"
proof
  fix i
  assume "i\<in>{0..<n+1}"
  let ?M = " (Samples (n+1) D)"
  let ?f = "(\<lambda> Sz. l (ridge_mine  Sz k) (Sz n))"

  have " measure_pmf.expectation ?M ?f =
       measure_pmf.expectation ?M (\<lambda> x. ?f (swapped_S x i n))"
    using expect_f_swap_same[of "n+1" i ?f] `i\<in> {0..<n+1}`  by auto

  then show " measure_pmf.expectation ?M ?f =
       measure_pmf.expectation ?M (\<lambda> Sz. l (ridge_mine (swapped_S Sz i n) k) (Sz i))"
    unfolding swapped_S_def
    by (metis (no_types, lifting) Bochner_Integration.integral_cong fun_upd_same)

qed

lemma same_integral_restricted[simp]:
  fixes f ::"(  _ \<Rightarrow> real)"
  fixes g ::"(  _ \<Rightarrow> real)"
  assumes "\<forall> x \<in> set_pmf M. f x = g x"
  shows "integral\<^sup>L M f = integral\<^sup>L M g"
  by (metis (no_types, lifting) Bochner_Integration.integral_cong assms indicator_simps(2)
      integral_measure_pmf_real_indicator mult_not_zero)

lemma same_nn_integral_restricted:
  fixes f ::"(  _ \<Rightarrow> real)"
  fixes g ::"(  _ \<Rightarrow> real)"
  assumes "\<forall> x \<in> set_pmf M. f x = g x"
  shows "integral\<^sup>N M f = integral\<^sup>N M g"
  by (metis (mono_tags, lifting) assms ennreal_0 mult_not_zero nn_integral_cong
      nn_integral_measure_pmf pmf_eq_0_set_pmf)

lemma same_nn_integral_restricted1:
  fixes f ::"(  _ \<Rightarrow> ennreal)"
  fixes g ::"(  _ \<Rightarrow> ennreal)"
  assumes "\<forall> x \<in> set_pmf M. f x = g x"
  shows "integral\<^sup>N M f = integral\<^sup>N M g"
  by (metis (mono_tags, lifting) assms ennreal_0 mult_not_zero nn_integral_cong
      nn_integral_measure_pmf pmf_eq_0_set_pmf)

lemma integrable_pair_pmf:
  fixes f ::"( _ \<times> _ \<Rightarrow> real)"
  assumes f_nn: "AE S in (measure_pmf p). AE z in (measure_pmf q). f (S, z) \<ge> 0"
  assumes integrable_q: "\<forall> S \<in> p. integrable q (\<lambda> x. f (S, x))"
  shows "integrable p  (\<lambda> S.  enn2real (\<integral>\<^sup>+ x. f (S,x) \<partial>q)) \<longleftrightarrow>
      integrable (pair_pmf p q) f"
proof -
  let ?N = "(pair_pmf p q)"

  have 1:" \<integral>\<^sup>+ x. f x \<partial> ?N =  \<integral>\<^sup>+ x. \<integral>\<^sup>+ y.(f (x,y)) \<partial>q \<partial>p"
    using nn_integral_pair_pmf' by auto

  have "\<integral>\<^sup>+ x. \<integral>\<^sup>+ y. ennreal (norm (f (x,y))) \<partial>q \<partial>p  =
    \<integral>\<^sup>+ x. \<integral>\<^sup>+ y. f (x,y) \<partial>q \<partial>p"
  proof -
    have "AE S in p. AE z in q. (\<lambda> x. ennreal (norm (f x)) =  f x ) (S,z)"
      using f_nn  by (simp add: AE_measure_pmf_iff)
    then have "AE x in p. \<integral>\<^sup>+ y. ennreal (norm (f (x,y))) \<partial>q =
          \<integral>\<^sup>+ y.(f (x,y)) \<partial>q"
    proof
      have "\<forall> x \<in> p.
       (AE z in  q. ennreal (norm (f (x, z))) = ennreal (f (x, z))) \<longrightarrow>
                   \<integral>\<^sup>+ y. ennreal (norm (f (x, y))) \<partial> q =
                   \<integral>\<^sup>+ xa. ennreal (f (x, xa)) \<partial> q" using nn_integral_cong_AE by auto

      then show " AE x in p. (AE z in  q. ennreal (norm (f (x, z))) = (f (x, z))) \<longrightarrow>
    \<integral>\<^sup>+ y. ennreal (norm (f (x, y))) \<partial> q = \<integral>\<^sup>+ xa.  (f (x, xa)) \<partial> q"
        using AE_measure_pmf_iff nn_integral_cong_AE by blast
    qed

    then show ?thesis
      by (simp add: nn_integral_cong_AE)
  qed
  then have 2: "\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial> ?N = \<integral>\<^sup>+ x. f x \<partial> ?N"
    using nn_integral_pair_pmf'  by (smt nn_integral_cong)

  have " \<forall> S \<in> p. (\<integral>\<^sup>+ x. (f (S,x)) \<partial>q) < top"
    using integrable_q
    by (metis (mono_tags, lifting) AE_measure_pmf_iff ennreal_less_top
        f_nn nn_integral_cong nn_integral_eq_integral)

  then have "integral\<^sup>N p ((\<lambda> S.  (enn2real (\<integral>\<^sup>+ x. f (S, x) \<partial>q)))) =
               integral\<^sup>N p (\<lambda> S.  (\<integral>\<^sup>+ x. f (S, x) \<partial>q))"
    by (simp add:  AE_measure_pmf_iff nn_integral_cong_AE)

  then have " ((\<lambda> S.  enn2real (\<integral>\<^sup>+ x. f (S,x) \<partial>q)) \<in> borel_measurable p \<and>
      ( \<integral>\<^sup>+ S. ennreal (norm ((\<lambda> S.  enn2real (\<integral>\<^sup>+ x. f (S,x) \<partial>q)) S ))\<partial>p) < \<infinity>) \<longleftrightarrow>
       (f \<in> borel_measurable ?N \<and> (\<integral>\<^sup>+ x. ennreal (norm (f x)) \<partial>?N) < \<infinity>)"
    using 1 2 by auto

  then show ?thesis  using integrable_iff_bounded
    by (metis (mono_tags, lifting) nn_integral_cong)
qed

lemma integrable_pair_pmf':
  fixes f ::"( _ \<Rightarrow> _ \<Rightarrow> real)"
  assumes f_nn: "AE S in (measure_pmf p) . AE z in (measure_pmf q). f S z \<ge> 0"
  assumes integrable_D: "\<forall> S \<in> p. integrable q (f S)"
  shows "integrable p  (\<lambda> S.  enn2real (\<integral>\<^sup>+ x. f S x \<partial>q)) \<longleftrightarrow>
      integrable (pair_pmf p q) (\<lambda> (S,z). f S z)"
  using integrable_pair_pmf[of  "(\<lambda> (S,z). f S z)"] assms by auto

lemma expectation_pair_pmf:
  fixes f ::"( _ \<times> _ \<Rightarrow> real)"
  assumes f_nn: "\<forall> S \<in> (set_pmf p). \<forall> z \<in> (set_pmf q). f (S,z) \<ge> 0"
  assumes integrable_D: "\<forall> S \<in> p. integrable q (\<lambda> z. f (S, z))"
  shows  "measure_pmf.expectation (pair_pmf p q) f
      = measure_pmf.expectation p (\<lambda>x. measure_pmf.expectation q (\<lambda>y. f (x, y)))"
proof -
  let ?pair = "(pair_pmf p q)"
  have 1:"\<forall>S\<in> p.  ennreal (integral\<^sup>L  q (\<lambda> z. f (S, z))) =
        (\<integral>\<^sup>+ x. f (S, x) \<partial>q)"
  proof
    fix S
    assume "S \<in> p"
    then have "AE x in q. 0 \<le> f (S,x)" using  f_nn  by (simp add: AE_measure_pmf_iff)
    then have "(\<integral>\<^sup>+ x.  f (S,x) \<partial>q) = (integral\<^sup>L  q (\<lambda> z. f (S,z)))"
      using  nn_integral_eq_integral `S \<in> p`  integrable_D by blast
    then show "  ennreal (integral\<^sup>L q (\<lambda> z. f (S,z))) = (\<integral>\<^sup>+ x. f (S, x) \<partial>q)" by auto
  qed
  then have 2: "\<forall>S \<in> p. (integral\<^sup>L  q (\<lambda> z. f (S,z))) =
        enn2real (\<integral>\<^sup>+ x. f (S, x) \<partial>q)" using  enn2real_ennreal
    by (metis (mono_tags, lifting) AE_measure_pmf_iff f_nn integral_nonneg_AE)
  then have 3: " (integral\<^sup>L p (\<lambda> S. integral\<^sup>L q (\<lambda> z. f (S,z)))) =
         (integral\<^sup>L p (\<lambda> S. enn2real (\<integral>\<^sup>+ x. f (S, x) \<partial>q)))"
    using pmf_restrict same_integral_restricted by fastforce
  have "\<forall>S. enn2real (\<integral>\<^sup>+ x. f (S, x) \<partial>q) \<ge> 0" by auto
  then have 4: "AE S in p. (\<lambda> S. enn2real (\<integral>\<^sup>+ x. f (S, x) \<partial>q)) S \<ge> 0"
    by blast

  show ?thesis
  proof(cases "integrable p  (\<lambda> S. enn2real (\<integral>\<^sup>+ x. f (S, x) \<partial>q))")
    case True
    have "AE S in p. AE z in q. f (S, z) \<ge> 0" using f_nn
      by (simp add: AE_measure_pmf_iff)
    then have integrable_pair: "integrable ?pair f"
      using  integrable_pair_pmf integrable_D True  by auto

    have 11: "integral\<^sup>N p ((\<lambda> S. ennreal (enn2real (\<integral>\<^sup>+ x. f (S, x) \<partial>q)))) =
               integral\<^sup>N p (\<lambda> S. (\<integral>\<^sup>+ x. f (S, x) \<partial>q))"
      by (smt "1" "2" AE_measure_pmf_iff nn_integral_cong_AE)

    have 12: " integral\<^sup>N ?pair f =
         (\<integral>\<^sup>+ S. (\<integral>\<^sup>+ x. f (S,x) \<partial>q) \<partial>p)"
      using nn_integral_pair_pmf'[of "p" q "f"] by blast

    have "\<forall> Sx \<in> ?pair.  f Sx \<ge> 0"
      using map_fst_pair_pmf  map_snd_pair_pmf f_nn by fastforce
    then  have "AE Sx in ?pair.  f Sx \<ge> 0"
      using  AE_measure_pmf_iff by blast
    then show ?thesis
      by (metis "11" "12" "3" "4" True ennreal_inj integrable_pair
          integral_nonneg_AE  nn_integral_eq_integral)
  next
    case False
    have "AE S in p. AE z in q. f (S, z) \<ge> 0" using f_nn
      by (simp add: AE_measure_pmf_iff)
    then have not_integrable_pair: "\<not> integrable ?pair f"
      using integrable_pair_pmf  integrable_D False  by auto
    then show ?thesis
      using "3" False integral_eq_cases by auto
  qed
qed

lemma expectation_pair_pmf':
  fixes f ::"( _ \<Rightarrow> _ \<Rightarrow> real)"
  assumes f_nn: "\<forall> S \<in> (set_pmf p). \<forall> z \<in> (set_pmf q). f S z \<ge> 0"
  assumes integrable_D: "\<forall> S \<in> p. integrable q (\<lambda> z. f S z)"
  shows  "measure_pmf.expectation (pair_pmf p q) (\<lambda> (x,y). f x y)
      = measure_pmf.expectation p (\<lambda>x. measure_pmf.expectation q (\<lambda> y. f x y))"
  using expectation_pair_pmf[of p q "(\<lambda> (x,y). f x y)"] assms by auto

lemma add_sample_expectation:
  fixes f ::"( _  \<Rightarrow> _ \<Rightarrow> real)"
  fixes m :: "nat"
  assumes f_nn: "\<forall>S\<in> (Samples m D). \<forall>z\<in>D. f S z \<ge> 0"
  assumes integrable_D: "\<forall> S \<in> (Samples m D). integrable D (f S)"
  shows    "measure_pmf.expectation (Samples m D) (\<lambda> S. measure_pmf.expectation D (\<lambda> z. f S z)) =
      measure_pmf.expectation (Samples (m+1) D) (\<lambda> Sz. f (truncated_S Sz m) (Sz m))"
proof -
  let ?pair = "(pair_pmf (Samples m D) D)"
  let ?Dm = "Samples m D"
  have "finite {0..<m}" by auto
  have " m \<notin> {0..<m}" by auto
  have insert_m:"(insert m {0..<m}) = {0..<m+1}"
    using atLeast0LessThan by auto

  have 1:" integral\<^sup>L ?Dm (\<lambda> S. integral\<^sup>L D (\<lambda> z. f S z)) =
  integral\<^sup>L ?pair  (\<lambda> (S,z). f S z)"
    using expectation_pair_pmf'[of ?Dm D f]  f_nn integrable_D by linarith

  have 2: "\<forall>x\<in> ?pair. ((fst x)(m:=undefined)) = (fst x)"
  proof
    fix x
    assume "x\<in>?pair"
    have "pmf (Samples m D) (fst x) > 0" using \<open>x \<in> ?pair\<close>
      using pmf_positive by fastforce
    then have "\<forall>y. y \<notin> {0..<m} \<longrightarrow> (fst x) y = undefined"
      unfolding Samples_def using pmf_Pi_outside
      by (metis finite_atLeastLessThan less_numeral_extra(3))
    then show "((fst x)(m:=undefined)) = (fst x)" by auto
  qed

  have "(map_pmf (\<lambda>(f,y). f(m:=y)) ( map_pmf (\<lambda>(x, y). (y, x)) (pair_pmf D (Samples m D)))) =
    (map_pmf (\<lambda>(y,f). f(m:=y)) ((pair_pmf D (Samples m D))))" using map_pmf_comp
    by (smt Pair_inject map_pmf_cong prod.collapse split_beta)

  also have "\<dots> = Samples (m+1) D" unfolding Samples_def
    using  `finite {0..<m}` `m \<notin> {0..<m}`  Pi_pmf_insert[of "{0..<m}" m undefined "(\<lambda>_. D)"]
      insert_m by auto

  finally have "integral\<^sup>L ?Dm (\<lambda> S. integral\<^sup>L D (\<lambda> z. f S z)) =
   integral\<^sup>L (Samples (m+1) D) (\<lambda> Sz. f (Sz(m:=undefined))  (Sz m))"
    using `finite {0..<m}` `m \<notin> {0..<m}` same_integral_restricted
    by (smt 1 2  fun_upd_same fun_upd_upd integral_map_pmf pair_commute_pmf prod.case_eq_if)

  then show ?thesis using truncated_S_def by auto
qed

lemma integrable_uniform : "\<forall> S \<in> (Samples n D). integrable D (\<lambda> _.
       measure_pmf.expectation (pmf_of_set {0..<n}) (\<lambda>i. l (ridge_mine S k) (S i)))"
  by blast

lemma integrable_train_err : "integrable (Samples n D)
          (\<lambda> S. train_err_loss S n l (ridge_mine S k))"
  unfolding train_err_loss_def oops

lemma uniform_nn: "\<forall>S\<in> (Samples n D). \<forall>z\<in>D. (\<lambda> _.
       measure_pmf.expectation (pmf_of_set {0..<n}) (\<lambda>i. l (ridge_mine S k) (S i))) z \<ge> 0"
proof (rule)
  fix S
  assume "S\<in> Samples n D"
  have "finite {0..<n}" by auto
  have "{0..<n} \<noteq> {}" using n_pos by auto
  have "\<forall> i \<in> {0..<n}. l (ridge_mine S k) (S i) \<ge> 0"
    using l_pos min_in_H \<open>S \<in> (Samples n D)\<close> sample_in_D by blast
  then have " sum (\<lambda>i. l (ridge_mine S k) (S i)) {0..<n} / card {0..<n} \<ge> 0"
    by (meson divide_nonneg_nonneg of_nat_0_le_iff sum_nonneg)
  then show "\<forall>z\<in>D. (\<lambda> _.
       measure_pmf.expectation (pmf_of_set {0..<n}) (\<lambda>i. l (ridge_mine S k) (S i))) z \<ge> 0"
    using `finite {0..<n}` `{0..<n} \<noteq> {}`
    by (metis card_atLeastLessThan finite_atLeastLessThan integral_pmf_of_set)
qed

lemma not_integrable_sum:
  fixes f ::"( _ \<Rightarrow> _ \<Rightarrow> real)"
  assumes f_nn: "\<forall> S \<in> (set_pmf M). \<forall> i \<in> I. f i S \<ge> 0"
  assumes fin : "finite I"
  assumes not_int: "\<exists> i \<in> I. \<not> integrable M (f i)"
  shows  " \<not> integrable (measure_pmf M) (\<lambda> x. (\<Sum>i\<in>I. f i x))"
proof -
  have 0: "\<forall> i \<in> I. f i \<in> borel_measurable M" by auto

  then have 1:" (\<Sum>i\<in>I. \<integral>\<^sup>+ x. (f i x) \<partial> M) =
   \<integral>\<^sup>+ x. (\<Sum>i\<in>I. ennreal (f i x))  \<partial> M " using nn_integral_sum[of I f M] by auto
  have "\<forall> x \<in> M. ennreal (\<Sum>i\<in>I. f i x) = (\<Sum>i\<in>I. ennreal (f i x))"
    using f_nn by auto

  then have 2: " \<integral>\<^sup>+ x. (\<Sum>i\<in>I. (f i x)) \<partial>M = (\<Sum>i\<in>I. integral\<^sup>N M (f i))"
    using 1 same_nn_integral_restricted
    by (smt ennreal_mult_left_cong ennreal_neg nn_integral_cong nn_integral_measure_pmf pmf_eq_0_set_pmf)

  have "\<exists> i \<in> I. integral\<^sup>N M (f i) = \<infinity>"
  proof -
    obtain i where "i\<in>I" and " \<not> integrable M (f i)" using not_int by auto
    have " (\<lambda> x \<in> M. f i x) = (\<lambda> x \<in> M. norm (f i x))" using f_nn `i \<in> I` by auto
    then have " integral\<^sup>N M (f i) =  integral\<^sup>N M (\<lambda> x. norm ((f i) x))"
      by (metis nn_integral_restrict_space_eq_restrict_fun)
    then have "\<not> integral\<^sup>N M (f i) < \<infinity>"
      using `\<not> integrable M (f i)` 0 integrableI_bounded `i \<in> I` by metis
    then have "integral\<^sup>N M (f i) = \<infinity>"
      by (metis ennreal_cases ennreal_less_top infinity_ennreal_def)
    then show ?thesis using `i\<in>I` by auto
  qed

  then have "(\<Sum>i\<in>I. integral\<^sup>N M (f i)) = \<infinity>" using sum_Inf[of "(\<lambda> i. enn2ereal ( integral\<^sup>N M (f i)))" I]
      fin  by simp
  then have "\<integral>\<^sup>+ x. (\<Sum>i\<in>I. f i x) \<partial>M = \<infinity>" using 2 by auto

  then show "\<not> integrable M (\<lambda> x. (\<Sum>i\<in>I. f i x))" by auto
qed

lemma pmf_pos:
  fixes m :: nat
  assumes m_pos: "m>0"
  assumes pmf_pos: "pmf (Samples m D) f > 0"
  shows " \<forall> i. i \<notin> {0..<m} \<longrightarrow> f i = undefined"
proof -
  have "pmf (Pi_pmf {0..<m} undefined (\<lambda> _.D)) f > 0"  using pmf_pos  unfolding Samples_def by auto
  then show ?thesis using pmf_Pi_outside[of "{0..<m}" f undefined "(\<lambda> _. D)"] by auto
qed

lemma integrable_sum_iff:
  fixes f ::"( _ \<Rightarrow> _ \<Rightarrow> real)"
  assumes f_nn: "\<forall> S \<in> (set_pmf M). \<forall> i \<in> I. f i S \<ge> 0"
  assumes fin_I : "finite I"
  shows "(\<forall> i \<in> I.  integrable M (f i)) \<longleftrightarrow>
      integrable (measure_pmf M) (\<lambda> x. (\<Sum>i\<in>I. f i x))"
proof(cases "(\<forall> i \<in> I.  integrable M (f i))")
  case True
  then show ?thesis using integrable_sum by auto
next
  case False
  then have "\<exists> i \<in> I. \<not> integrable M (f i)" by auto
  then show ?thesis using not_integrable_sum[of M I f] assms by blast
qed

lemma swap_set_expectation:
  fixes f ::"( _ \<Rightarrow> _ \<Rightarrow> real)"
  assumes f_nn: "\<forall> S \<in> (set_pmf M). \<forall> i \<in> I. f i S \<ge> 0"
  assumes fin_I : "finite I"
  assumes non_empty : " I \<noteq> {}"
  assumes I_swap:
    "\<forall> i\<in> I. \<forall> j \<in> I. measure_pmf.expectation M (\<lambda> S. f i S) =
       measure_pmf.expectation M (\<lambda> S. f j S)"
  shows " integral\<^sup>L M  (\<lambda> S. integral\<^sup>L (pmf_of_set I)  (\<lambda> i. f i S)) =
      integral\<^sup>L (pmf_of_set I) (\<lambda> i. integral\<^sup>L M (\<lambda> S. f i S))"
proof -
  have 1: "(\<forall> i \<in> I.  integrable M (f i)) \<longleftrightarrow>
      integrable (measure_pmf M) (\<lambda> x. (\<Sum>i\<in>I. f i x))"
    using f_nn fin_I integrable_sum_iff[of M I f] by auto
  have " integral\<^sup>L M  (\<lambda> S. sum (\<lambda> i. f i S) I) = sum (\<lambda> i. integral\<^sup>L M (\<lambda> S. f i S)) I "
  proof (cases "(\<forall> i \<in> I.  integrable M (f i))")
    case True
    then show ?thesis using integrable_sum by auto
  next
    case False
    have 2: "\<not> integrable ( M) (\<lambda> x. (\<Sum>i\<in>I. f i x))"
      using False 1 by blast
    then have 3: "measure_pmf.expectation M
          (\<lambda> Sz. sum (\<lambda> i. f i Sz) I) = 0"
      by (simp add: not_integrable_integral_eq)
    then  have "\<forall> i\<in> I. integral\<^sup>L M (f i) = 0" using False
      by (metis "1" I_swap integral_eq_cases)
    then have "sum (\<lambda> i. measure_pmf.expectation M (f i)) I = 0"
      by simp
    then show ?thesis
      using 3 by linarith
  qed
  then show ?thesis using  non_empty fin_I
    by (simp add: integral_pmf_of_set)
qed

lemma truncated_S_in_Dn: "\<forall> S \<in> (Samples (m+1) D). truncated_S S m \<in> Samples m D"
proof
  let ?M = "(Samples (m+1) D)"
  let ?I = "{0..<m}"
  fix S
  assume "S \<in> ?M"
  have "finite {0..<m+1}" by auto
  have "finite ?I" by auto
  then have 1: " pmf ?M S > 0" using pmf_positive_iff `S \<in> ?M` by fast
  then have "\<forall> i. i \<notin> {0..<m+1} \<longrightarrow> S i = undefined" using pmf_pos[of "(m+1)" S] n_pos by auto
  then have "pmf ?M S = (\<Prod>x\<in>{0..<m+1}. pmf D (S x))"
    using pmf_Pi'[of "{0..<m+1}" S undefined "(\<lambda> _. D)"] `finite {0..<m+1}`
    by (metis Samples_def)
  then have "\<forall>x \<in> {0..<m+1}.  pmf D (S x) > 0 "
    by (meson \<open>S \<in> ?M\<close> pmf_positive sample_in_D)
  then have 2: "(\<Prod>x\<in>?I. pmf D (S x)) > 0"
    by (simp add: prod_pos)
  have "\<And>x. x \<notin> ?I \<Longrightarrow> (truncated_S S m) x = undefined"
    by (simp add: \<open>\<forall>i. i \<notin> {0..<m + 1} \<longrightarrow> S i = undefined\<close> truncated_S_def)
  then have "pmf (Samples m D) (truncated_S S m) = (\<Prod>x\<in>?I. pmf D (S x))" unfolding Samples_def
    using pmf_Pi'[of ?I "truncated_S S m" undefined "(\<lambda> _. D)"]  `finite ?I`
    using truncated_S_def by auto
  then have "pmf (Samples m D) (truncated_S S m) > 0" using 2 by auto

  then show "truncated_S S m \<in> Samples m D"
    by (simp add: set_pmf_iff)
qed

lemma min_of_Dn1_in_H: "\<forall> S \<in> (Samples (n+1) D). (ridge_mine S k) \<in> H"
proof
  let ?M = "(Samples (n+1) D)"
  fix S
  assume "S \<in> ?M"
  then have "truncated_S S n \<in> Samples n D" using truncated_S_in_Dn `S \<in> ?M`  by auto
  then have "(ridge_mine (truncated_S S n) k) \<in> H" using min_in_H by auto
  then show "(ridge_mine S k) \<in> H"
    using truncated_same_min by auto
qed

lemma train_val_diff :
  assumes integrable_D:"\<forall> S \<in> (Samples n D). integrable D (\<lambda> z. l (ridge_mine S k) z)"
  assumes  pred_err_integrable: "integrable (Samples n D)  (\<lambda> S. pred_err_loss D l (ridge_mine S k))"
  assumes  train_err_integrable: " integrable (Samples n D)  (\<lambda> S. train_err_loss S n l (ridge_mine S k)) "
  assumes integrable_swapped_Si: " integrable (Samples (n+1) D)
                        (\<lambda> S.  measure_pmf.expectation (pmf_of_set {0..<n})
                     (\<lambda> i.  (l (ridge_mine (swapped_S S i n) k) (S i))))"
  assumes integrable_Si: " integrable (Samples (n+1) D)
                        (\<lambda> S.  measure_pmf.expectation (pmf_of_set {0..<n})
                     (\<lambda> i.  (l  (ridge_mine S k) (S i))))"
  shows"  measure_pmf.expectation (Samples n D)
          (\<lambda> S. pred_err_loss D l (ridge_mine S k) - train_err_loss S n l (ridge_mine S k))
            =  measure_pmf.expectation (Samples (n+1) D)
                        (\<lambda> S.  measure_pmf.expectation (pmf_of_set {0..<n})
                     (\<lambda> i. (l (ridge_mine (swapped_S S i n) k) (S i)) -  (l  (ridge_mine S k) (S i))))"
proof -
  let ?Dn = "Samples n D"
  let ?Dn1 = "Samples (n+1) D"
  let ?I = "{0..<n}"
  let ?pmfI = "(pmf_of_set ?I)"
  let ?l_swapped = "(\<lambda> i. (\<lambda> S. l (ridge_mine (swapped_S S i n) k) (S i)))"
  let ?l_trunc = "(\<lambda> S. (\<lambda> z. l (ridge_mine (truncated_S S n) k) z))"
  let ?l_Si = "(\<lambda> S. (\<lambda>i. l (ridge_mine S k) (S i)))"
  let ?pred_err = "(\<lambda> S. pred_err_loss D l (ridge_mine S k))"
  have fin_I:"finite ?I" by auto
  have non_empty_I:"?I \<noteq> {}"
    using n_pos by auto

  have pred_err_Dn1: "\<forall> i  \<in> ?I. integral\<^sup>L ?Dn  (\<lambda> S. ?pred_err S) =
        integral\<^sup>L ?Dn1 (\<lambda> Sz. ?l_swapped i Sz)"
  proof
    fix i
    assume "i\<in> ?I"
    have " integral\<^sup>L ?Dn (\<lambda> S. ?pred_err S) =
        integral\<^sup>L ?Dn (\<lambda> S. integral\<^sup>L D (\<lambda> z. (l (ridge_mine S k) z)))"
      unfolding pred_err_loss_def by auto
    also have " \<dots> = integral\<^sup>L ?Dn1 (\<lambda> S. ?l_trunc S (S n))"
      using l_pos min_in_H  integrable_D add_sample_expectation n_pos by auto
    also  have " \<dots> =  integral\<^sup>L ?Dn1 (\<lambda> S. ?l_Si S n)"
      using truncated_same_min by auto
    also have " \<dots> =  integral\<^sup>L ?Dn1 (\<lambda> Sz. ?l_swapped i Sz)"
      using ridge_mine_swap  `i \<in> ?I` by auto
    finally show " integral\<^sup>L ?Dn  (\<lambda> S. ?pred_err S) = integral\<^sup>L ?Dn1 (\<lambda> Sz. ?l_swapped i Sz)"
      by auto
  qed

  then have 1: "integral\<^sup>L ?pmfI (\<lambda> i. integral\<^sup>L ?Dn  (\<lambda> S. ?pred_err S)) =
                integral\<^sup>L ?pmfI (\<lambda> i. integral\<^sup>L ?Dn1 (\<lambda> S. ?l_swapped i S))"
    using pmf_restrict fin_I non_empty_I set_pmf_of_set
    by (smt same_integral_restricted)

  have " integral\<^sup>L ?pmfI  (\<lambda> i.  integral\<^sup>L ?Dn1 (\<lambda> Sz. ?l_swapped i Sz)) =
   integral\<^sup>L ?Dn1  (\<lambda> Sz. integral\<^sup>L ?pmfI (\<lambda> i. ?l_swapped i Sz) )"
  proof -
    have "\<forall> S \<in> (set_pmf ?Dn1). \<forall> i \<in> ?I.(ridge_mine (swapped_S S i n) k) \<in> H"
      using min_of_Dn1_in_H pmf_swapped_same n_pos
      by (smt add_diff_cancel_right' add_gr_0 atLeastLessThan_iff less_add_same_cancel1 less_trans set_pmf_iff swapped_S_def zero_less_one)
    then have l_swapped_nn: "\<forall> S \<in> (set_pmf ?Dn1). \<forall> i \<in> ?I. ?l_swapped i S \<ge> 0"
      using l_pos  sample_in_D by auto

    have I_swap:
      "\<forall> i\<in> ?I. \<forall> j \<in> ?I. integral\<^sup>L ?Dn1 (\<lambda> S. ?l_swapped i S) =
       integral\<^sup>L ?Dn1 (\<lambda> S. ?l_swapped j S)"
      using ridge_mine_swap
      by (metis (no_types, lifting) pred_err_Dn1)
    then show ?thesis using fin_I non_empty_I
        l_swapped_nn swap_set_expectation[of ?Dn1 ?I ?l_swapped]
      by linarith
  qed

  then have 2: "integral\<^sup>L ?Dn  (\<lambda> S. ?pred_err S) =
       integral\<^sup>L ?Dn1  (\<lambda> Sz. integral\<^sup>L ?pmfI (\<lambda> i. ?l_swapped i Sz) )"
    using 1 by simp

  have "\<forall>S. \<forall>i\<in>?I. (truncated_S S n) i = S i"  using  truncated_S_def by auto

  then  have 4: "\<forall>S. integral\<^sup>L ?pmfI (\<lambda>i. ?l_trunc S (truncated_S S n i)) =
               integral\<^sup>L ?pmfI (\<lambda>i. ?l_trunc S (S i))"
    by (metis (no_types, lifting) fin_I non_empty_I same_integral_restricted set_pmf_of_set)

  have "n>0" using n_pos by auto
  then have 5: "integral\<^sup>L ?Dn (\<lambda> S. integral\<^sup>L D (\<lambda> _.
       integral\<^sup>L ?pmfI (?l_Si S))) =
      integral\<^sup>L ?Dn1  (\<lambda> S.  integral\<^sup>L ?pmfI (\<lambda>i. ?l_trunc S (truncated_S S n i)))"
    using
      integrable_uniform uniform_nn add_sample_expectation[of n " (\<lambda> S. (\<lambda> _.
       integral\<^sup>L ?pmfI (?l_Si S)))"]   by blast

  have "card ?I = n" by auto
  then have "\<forall> S. integral\<^sup>L ?pmfI (\<lambda>i. l (ridge_mine S k) (S i) ) =
      (sum (?l_Si S) ?I) / card ?I"
    using integral_pmf_of_set `finite ?I` `?I \<noteq> {}` by blast
  then have "\<forall> S. train_err_loss S n l (ridge_mine S k) =
      integral\<^sup>L ?pmfI (?l_Si S)"
    using `card ?I = n` train_err_loss_def by force

  then have 6:" integral\<^sup>L ?Dn  (\<lambda> S. train_err_loss S n l (ridge_mine S k))
            =  integral\<^sup>L ?Dn1  (\<lambda> S.  integral\<^sup>L ?pmfI (?l_Si S))"
    using 4 5 truncated_same_min  by auto

  have "integral\<^sup>L ?Dn
          (\<lambda> S.   ?pred_err S - train_err_loss S n l (ridge_mine S k)) =
       integral\<^sup>L ?Dn  (\<lambda> S. ?pred_err S) -
       integral\<^sup>L ?Dn  (\<lambda> S. train_err_loss S n l (ridge_mine S k))   "
    using train_err_integrable  pred_err_integrable by simp

  also have " \<dots>  =
   integral\<^sup>L ?Dn1 (\<lambda> S.  integral\<^sup>L ?pmfI
   (\<lambda> i. (l (ridge_mine (swapped_S S i n) k) (S i)))) -
   integral\<^sup>L ?Dn1 (\<lambda> S.  integral\<^sup>L ?pmfI (?l_Si S))" using 2 6 by auto
  also have " \<dots> =   integral\<^sup>L ?Dn1 (\<lambda> S.
   integral\<^sup>L ?pmfI (\<lambda> i. (l (ridge_mine (swapped_S S i n) k) (S i)) ) -
  integral\<^sup>L ?pmfI (?l_Si S)  )"
    using integrable_Si integrable_swapped_Si  by simp
  also have " \<dots> =
     integral\<^sup>L ?Dn1 (\<lambda> S.  integral\<^sup>L ?pmfI (\<lambda> i.
   (l (ridge_mine (swapped_S S i n) k) (S i)) - (?l_Si S i) ) )"
  proof -
    have "\<forall> S. sum (\<lambda> i. (l (ridge_mine (swapped_S S i n) k) (S i)) ) ?I -  sum (?l_Si S) ?I  =
    sum (\<lambda> i. (l (ridge_mine (swapped_S S i n) k) (S i)) - (?l_Si S i) ) ?I"
      by (simp add: sum_subtractf)
    then  have "\<forall> S.
   integral\<^sup>L ?pmfI (\<lambda> i. (l (ridge_mine (swapped_S S i n) k) (S i)) )  -
 integral\<^sup>L ?pmfI (?l_Si S) =
    integral\<^sup>L ?pmfI (\<lambda> i.
   (l (ridge_mine (swapped_S S i n) k) (S i)) -  (?l_Si S i) )" using non_empty_I
      by (metis (no_types, lifting) diff_divide_distrib fin_I integral_pmf_of_set)
    then show ?thesis by auto
  qed
  finally show ?thesis by blast
qed

lemma ridge_index_swap_same: "\<forall> S. ridge_mine (S_index S i (S n)) k =
                    ridge_mine (swapped_S S i n) k"
  using truncated_same_min using S_index_swap_same
  by metis

lemma add_sample_integrable:
  fixes f ::"( _  \<Rightarrow> _ \<Rightarrow> real)"
  fixes m :: "nat"
  assumes f_nn: "\<forall>S\<in> (Samples m D). \<forall>z\<in>D. f S z \<ge> 0"
  assumes integrable_D: "\<forall> S \<in> (Samples m D). integrable D (f S)"
  shows    "integrable (Samples m D) (\<lambda> S. measure_pmf.expectation D (\<lambda> z. f S z)) =
      integrable (Samples (m+1) D) (\<lambda> Sz. f (truncated_S Sz m) (Sz m))"
proof -
  let ?pair = "(pair_pmf (Samples m D) D)"
  let ?Dm = "Samples m D"
  have "finite {0..<m}" by auto
  have " m \<notin> {0..<m}" by auto
  have insert_m:"(insert m {0..<m}) = {0..<m+1}"
    using atLeast0LessThan by auto
  have 01:"\<forall> S \<in> ?Dm. integral\<^sup>L D (\<lambda> z. f S z) =  enn2real (integral\<^sup>N D (\<lambda> z. f S z))"
    using integrable_D f_nn
    by (metis (mono_tags, lifting) AE_measure_pmf_iff enn2real_ennreal integral_nonneg_AE nn_integral_cong nn_integral_eq_integral)

 have 02: "\<forall> S \<in> ?Dm. ennreal (integral\<^sup>L D (\<lambda> z. f S z)) =  (integral\<^sup>N D (\<lambda> z. f S z))"
    using integrable_D f_nn
    by (metis (mono_tags, lifting) AE_measure_pmf_iff  nn_integral_cong nn_integral_eq_integral)
  then have 03:"integral\<^sup>N (Samples m D) (\<lambda> S. integral\<^sup>N D (\<lambda> z. f S z)) =
      integral\<^sup>N (Samples m D) (\<lambda> S. integral\<^sup>L D (\<lambda> z. f S z))"
   using same_nn_integral_restricted1[of ?Dm "(\<lambda> S. ( integral\<^sup>N D (\<lambda> z. f S z)))"
                    "(\<lambda> S. integral\<^sup>L D (\<lambda> z. f S z))"]
   using "02" by auto

  have 1:" integral\<^sup>L ?Dm (\<lambda> S. integral\<^sup>L D (\<lambda> z. f S z)) =
  integral\<^sup>L ?pair  (\<lambda> (S,z). f S z)"
    using expectation_pair_pmf'[of ?Dm D f]  f_nn integrable_D by linarith

   have 11:" integral\<^sup>N ?Dm (\<lambda> S. integral\<^sup>N D (\<lambda> z. f S z)) =
  integral\<^sup>N ?pair  (\<lambda> (S,z). f S z)"
     using nn_integral_pair_pmf'[of ?Dm D "(\<lambda> (S,z). f S z)"]
     by auto

have "integral\<^sup>N (map_pmf (\<lambda>(f,y). f(m:=y)) (pair_pmf (Samples m D) D))
       (\<lambda> Sz. f (Sz(m:=undefined))  (Sz m)) =
     integral\<^sup>N (pair_pmf (Samples m D) D) (\<lambda>x. (\<lambda> Sz. f (Sz(m:=undefined))  (Sz m))
         ( (\<lambda>(f,y). f(m:=y)) x))"
    using integral_map_pmf by simp

  have "integral\<^sup>N (pair_pmf (Samples m D) D)
         (\<lambda>x. (\<lambda> Sz. f (Sz(m:=undefined)) (Sz m)) ( (\<lambda>(f,y). f(m:=y)) x)) =
      integral\<^sup>N (pair_pmf (Samples m D) D)
    (\<lambda>x. (\<lambda> Sz. f (Sz(m:=undefined))  (Sz m)) ( (\<lambda> f. (fst f)(m:=(snd f))) x))"
    by (simp add: case_prod_beta)

  have " integral\<^sup>N (pair_pmf (Samples m D) D)
    (\<lambda>x. (\<lambda> Sz. f (Sz(m:=undefined))  (Sz m)) ( (\<lambda> f. (fst f)(m:=(snd f))) x)) =
     integral\<^sup>N (pair_pmf (Samples m D) D)
    (\<lambda>x. (\<lambda> Sz. f (Sz(m:=undefined))  (Sz m)) ((fst x)(m:=(snd x))))" by auto

  have " integral\<^sup>N (pair_pmf (Samples m D) D)
    (\<lambda>x. (\<lambda> Sz. f (Sz(m:=undefined)) (Sz m)) ((fst x)(m:=(snd x)))) =
     integral\<^sup>N (pair_pmf (Samples m D) D)
    (\<lambda>x.  f (((fst x)(m:=(snd x)))(m:=undefined))  (((fst x)(m:=(snd x))) m))"
    by auto

  have " integral\<^sup>N (pair_pmf (Samples m D) D)
    (\<lambda>x. f (((fst x)(m:=(snd x)))(m:=undefined))  (((fst x)(m:=(snd x))) m)) =
     integral\<^sup>N (pair_pmf (Samples m D) D)
    (\<lambda>x. f ((fst x)(m:=undefined)) (((fst x)(m:=(snd x))) m))" by auto

  have " integral\<^sup>N (pair_pmf (Samples m D) D)
    (\<lambda>x.  f ((fst x)(m:=undefined))  (((fst x)(m:=(snd x))) m)) =
      integral\<^sup>N (pair_pmf (Samples m D) D) (\<lambda>x.  f ((fst x)(m:=undefined)) (snd x))" by auto

  then have "integral\<^sup>L (map_pmf (\<lambda>(f,y). f(m:=y)) (pair_pmf (Samples m D) D))
       (\<lambda> Sz. f (Sz(m:=undefined)) (Sz m)) =
   integral\<^sup>L (pair_pmf (Samples m D) D) (\<lambda>x.  f ((fst x)(m:=undefined))  (snd x))"
    by simp

  have 2: "\<forall>x\<in> ?pair. ((fst x)(m:=undefined)) = (fst x)"
  proof
    fix x
    assume "x\<in>?pair"
    have "pmf (Samples m D) (fst x) > 0" using \<open>x \<in> ?pair\<close>
      using pmf_positive by fastforce
    then have "\<forall>y. y \<notin> {0..<m} \<longrightarrow> (fst x) y = undefined"
      unfolding Samples_def using pmf_Pi_outside
      by (metis finite_atLeastLessThan less_numeral_extra(3))
    then show "((fst x)(m:=undefined)) = (fst x)" by auto
  qed

   then have "(\<lambda>x \<in> (pair_pmf (Samples m D) D).  f ((fst x)(m:=undefined))  (snd x)) =
    (\<lambda>x \<in> (pair_pmf (Samples m D) D).  f (fst x) (snd x))" by auto

  have " integral\<^sup>N (pair_pmf (Samples m D) D) (\<lambda>x.  f ((fst x)(m:=undefined))  (snd x)) =
     integral\<^sup>N (pair_pmf (Samples m D) D)
     (\<lambda>x \<in>(pair_pmf (Samples m D) D).  f ((fst x)(m:=undefined))  (snd x))"

    by (metis nn_integral_restrict_space_eq_restrict_fun)

  have "integral\<^sup>N (pair_pmf (Samples m D) D) (\<lambda>x \<in> (pair_pmf (Samples m D) D).  f (fst x) (snd x)) =
      integral\<^sup>N (pair_pmf (Samples m D) D) (\<lambda>x.  f (fst x) (snd x))"
  using nn_integral_restrict_space_eq_restrict_fun by metis
  then have " integral\<^sup>N (pair_pmf (Samples m D) D) (\<lambda>x.  f ((fst x)(m:=undefined))  (snd x)) =
     integral\<^sup>N (pair_pmf (Samples m D) D) (\<lambda>x.  f (fst x) (snd x))"
    using \<open>(\<lambda>x\<in>set_pmf (pair_pmf (Samples m D) D). f ((fst x)(m := undefined)) (snd x)) = (\<lambda>x\<in>set_pmf (pair_pmf (Samples m D) D). f (fst x) (snd x))\<close> \<open>\<integral>\<^sup>+ x. ennreal (f ((fst x)(m := undefined)) (snd x)) \<partial>measure_pmf (pair_pmf (Samples m D) D) = \<integral>\<^sup>+ x. ennreal ((\<lambda>x\<in>set_pmf (pair_pmf (Samples m D) D). f ((fst x)(m := undefined)) (snd x)) x) \<partial>measure_pmf (pair_pmf (Samples m D) D)\<close> by auto

  have "   integral\<^sup>N ?pair  (\<lambda> (S,z). f S z) =
      integral\<^sup>N ( ( map_pmf (\<lambda>(x, y). (y, x)) (pair_pmf D (Samples m D))))
         (\<lambda> (S,z). f S z) "
    by (metis pair_commute_pmf)

  have "(map_pmf (\<lambda>(f,y). f(m:=y)) ( map_pmf (\<lambda>(x, y). (y, x)) (pair_pmf D (Samples m D)))) =
    (map_pmf (\<lambda>(y,f). f(m:=y)) ((pair_pmf D (Samples m D))))" using map_pmf_comp
    by (smt Pair_inject map_pmf_cong prod.collapse split_beta)

  also have "\<dots> = Samples (m+1) D" unfolding Samples_def
    using  `finite {0..<m}` `m \<notin> {0..<m}`  Pi_pmf_insert[of "{0..<m}" m undefined "(\<lambda>_. D)"]
      insert_m by auto

   finally have " integral\<^sup>N ?pair  (\<lambda> (S,z). f S z) =
       integral\<^sup>N (Samples (m+1) D) (\<lambda> Sz. f (Sz(m:=undefined))  (Sz m))"
    using `finite {0..<m}` `m \<notin> {0..<m}` same_integral_restricted
     2 11 fun_upd_same fun_upd_upd nn_integral_map_pmf pair_commute_pmf prod.case_eq_if
    by (smt \<open>\<integral>\<^sup>+ x. ennreal (f ((fst x)(m := undefined)) (snd x)) \<partial>measure_pmf (pair_pmf (Samples m D) D) = \<integral>\<^sup>+ x. ennreal (f (fst x) (snd x)) \<partial>measure_pmf (pair_pmf (Samples m D) D)\<close> nn_integral_cong)

  then have "integral\<^sup>N (Samples m D) (\<lambda> S. integral\<^sup>N D (\<lambda> z. f S z)) =
      integral\<^sup>N (Samples (m+1) D) (\<lambda> Sz. f (truncated_S Sz m) (Sz m))" unfolding truncated_S_def
    using 11  by simp
  then have "integral\<^sup>N (Samples m D) (\<lambda> S. integral\<^sup>L D (\<lambda> z. f S z)) =
      integral\<^sup>N (Samples (m+1) D) (\<lambda> Sz. f (truncated_S Sz m) (Sz m))" using 03
    by simp
  have "\<forall>S \<in> ?Dm. (integral\<^sup>N D (\<lambda> z. f S z)) = ennreal( norm ( integral\<^sup>L D (\<lambda> z. f S z)))"
    using "01" "02" by auto
  then have "integral\<^sup>N (Samples m D) (\<lambda> S. integral\<^sup>L D (\<lambda> z. f S z)) =
      integral\<^sup>N (Samples m D) (\<lambda> S. ennreal( norm ( integral\<^sup>L D (\<lambda> z. f S z))))"
    using "03" same_nn_integral_restricted1 by force

  have "\<forall>S \<in> (Samples (m+1) D). f (truncated_S S m) (S m) =
             (norm (f (truncated_S S m) (S m)))" using truncated_S_in_Dn[of m]
    by (simp add: f_nn sample_in_D)
  then have "integral\<^sup>N (Samples (m+1) D) (\<lambda> Sz. f (truncated_S Sz m) (Sz m)) =
      integral\<^sup>N (Samples (m+1) D) (\<lambda> Sz. (norm (f (truncated_S Sz m) (Sz m))))"
using same_nn_integral_restricted1
  by (metis (no_types, lifting))
  then have 10: " integral\<^sup>N (Samples m D) (\<lambda> S. ennreal( norm ( integral\<^sup>L D (\<lambda> z. f S z)))) =
       integral\<^sup>N (Samples (m+1) D) (\<lambda> Sz. (norm (f (truncated_S Sz m) (Sz m))))"
    using \<open>\<integral>\<^sup>+ x. ennreal (measure_pmf.expectation D (f x)) \<partial>measure_pmf (Samples m D) = \<integral>\<^sup>+ S. ennreal (norm (measure_pmf.expectation D (f S))) \<partial>measure_pmf (Samples m D)\<close> \<open>\<integral>\<^sup>+ x. ennreal (measure_pmf.expectation D (f x)) \<partial>measure_pmf (Samples m D) = \<integral>\<^sup>+ x. ennreal (f (truncated_S x m) (x m)) \<partial>measure_pmf (Samples (m + 1) D)\<close> by auto

  have 11: "(\<lambda> S. measure_pmf.expectation D (\<lambda> z. f S z)) \<in> borel_measurable ?Dm" by auto
  have 12: "(\<lambda> Sz. f (truncated_S Sz m) (Sz m)) \<in> borel_measurable (Samples (m+1) D)" by auto

  then show ?thesis using truncated_S_def using 10 11 12
   integrable_iff_bounded
    by (metis (mono_tags, lifting) nn_integral_cong)
qed

end
end