section {* Preliminaries *}

theory Preliminaries imports "HOL-Cardinals.Cardinals"
begin

text {* This section discusses preliminaries on families of items (technically,
partial functions from a type of {\em indexes})
that we call {\em inputs} because they will be inputs to the binding operations.
For inputs, we define some monad-like lifting operators.
We also define simple infinitely branching trees (with no info attached
to the nodes and with branching given by partial functions from
indexes) -- these will be used as ``skeletons'' for terms, giving a size
on which we can induct.
 *}

abbreviation regular where "regular \<equiv> stable"
lemmas regular_UNION = stable_UNION

subsection {* Trivia  *}

type_synonym 'a pair = "'a * 'a"

type_synonym 'a triple = "'a * 'a *'a"

type_synonym 'a rel = "'a pair set"

(* Selectors for triples *)

definition fst3 where "fst3 == fst"
definition snd3 where "snd3 == fst o snd"
definition trd3 where "trd3 == snd o snd"

lemma fst3_simp[simp]: "fst3 (a,b,c) = a"
unfolding fst3_def by simp

lemma snd3_simp[simp]: "snd3 (a,b,c) = b"
unfolding snd3_def by simp

lemma trd3_simp[simp]: "trd3 (a,b,c) = c"
unfolding trd3_def by simp

lemma fst3_snd3_trd3: "abc = (fst3 abc, snd3 abc, trd3 abc)"
unfolding fst3_def snd3_def trd3_def by auto

lemma fst3_snd3_trd3_rev[simp]:
"(fst3 abc, snd3 abc, trd3 abc) = abc"
using fst3_snd3_trd3[of abc] by simp

lemma map_id[simp]: "map id l = l"
unfolding id_def by simp

abbreviation max3 where
"max3 x y z == max (max x y) z"

lemmas map_id_cong = map_idI

lemma ext2:
"(f \<noteq> g) = (\<exists> x. f x \<noteq> g x)"
using ext by auto

lemma not_equals_and_not_equals_not_in:
"(y \<noteq> x \<and> y \<noteq> x' \<and> phi) =
 (y \<notin> {x,x'} \<and> phi)"
by simp

lemma mp2:
assumes "!! x y. phi x y \<Longrightarrow> chi x y" and "phi x y"
shows "chi x y"
using assms by simp

lemma mp3:
assumes "!! x y z. phi x y z \<Longrightarrow> chi x y z" and "phi x y z"
shows "chi x y z"
using assms by simp

lemma all_lt_Suc:
"(\<forall> i < Suc n. phi i) = ((\<forall> i < n. phi i) \<and> phi n)"
using less_Suc_eq by auto

declare hd_map[simp]
lemmas tl_map[simp] = list.map_sel
declare last_map[simp]

lemma tl_last_hd:
assumes "L \<noteq> []" and "tl L = []"
shows "last L = hd L"
using assms apply - by(induct L, auto)

subsection {* Lexicographic induction *}

definition lt2 where
"lt2 == less_than <*lex*> less_than"

definition lt3 where
"lt3 == less_than <*lex*> lt2"

lemma wf_lt2:
"wf lt2"
unfolding lt2_def by auto

lemma wf_lt3:
"wf lt3"
unfolding lt3_def by (auto simp add: wf_lt2)

lemma lt2[intro]:
"!! k1 k2 j1 j2. k1 < j1 \<Longrightarrow> ((k1,k2),(j1,j2)) \<in> lt2"
"!! k1 k2 j1 j2. \<lbrakk>k1 \<le> j1; k2 < j2\<rbrakk> \<Longrightarrow> ((k1,k2),(j1,j2)) \<in> lt2"
unfolding lt2_def by auto

lemma measure_lex2_induct:
fixes h1 :: "'a1 \<Rightarrow> nat" and h2 :: "'a2 \<Rightarrow> nat"
assumes
"!! x1 x2.
  \<lbrakk>(!! y1 y2. h1 y1 < h1 x1 \<Longrightarrow> phi y1 y2);
   (!! y1 y2. \<lbrakk>h1 y1 \<le> h1 x1; h2 y2 < h2 x2\<rbrakk> \<Longrightarrow> phi y1 y2)\<rbrakk>
  \<Longrightarrow> phi x1 x2"
shows "phi x1 x2"
proof-
  let ?chi = "%(n1,n2). ALL x1 x2. h1 x1 = n1 \<and> h2 x2 = n2 \<longrightarrow> phi x1 x2"
  {fix n1 n2
   have "?chi (n1,n2)"
   apply(rule wf_induct[of lt2 ?chi]) using wf_lt2 assms by blast+
  }
  thus ?thesis by blast
qed

lemma measure_lex3_induct:
fixes h1 :: "'a1 \<Rightarrow> nat" and h2 :: "'a2 \<Rightarrow> nat" and h3 :: "'a3 \<Rightarrow> nat"
assumes
"!! x1 x2 x3.
  \<lbrakk>(!! y1 y2 y3. h1 y1 < h1 x1 \<Longrightarrow> phi y1 y2 y3);
   (!! y1 y2 y3. \<lbrakk>h1 y1 \<le> h1 x1; h2 y2 < h2 x2\<rbrakk> \<Longrightarrow> phi y1 y2 y3);
   (!! y1 y2 y3. \<lbrakk>h1 y1 \<le> h1 x1; h2 y2 \<le> h2 x2; h3 y3 < h3 x3\<rbrakk> \<Longrightarrow> phi y1 y2 y3)\<rbrakk>
  \<Longrightarrow> phi x1 x2 x3"
shows "phi x1 x2 x3"
proof-
  let ?chi = "%(n1,n2,n3). ALL x1 x2 x3. h1 x1 = n1 \<and> h2 x2 = n2 \<and> h3 x3 = n3 \<longrightarrow> phi x1 x2 x3"
  {fix n1 n2 n3
   have "?chi (n1,n2,n3)"
   apply(rule wf_induct[of lt3 ?chi]) using wf_lt3 assms by blast+
  }
  thus ?thesis by blast
qed

subsection {* Inputs and lifting operators  *}

type_synonym ('index,'val)input = "'index \<Rightarrow> 'val option"

definition
lift :: "('val1 \<Rightarrow> 'val2) \<Rightarrow> ('index,'val1)input \<Rightarrow> ('index,'val2)input"
where
"lift h inp == \<lambda>i. case inp i of None \<Rightarrow> None
                                |Some v \<Rightarrow> Some (h v)"

definition
liftAll :: "('val \<Rightarrow> bool) \<Rightarrow> ('index,'val)input \<Rightarrow> bool"
where
"liftAll phi inp == \<forall> i v. inp i = Some v \<longrightarrow> phi v"

definition
lift2 ::
"('val1' \<Rightarrow> 'val1 \<Rightarrow> 'val2) \<Rightarrow> ('index,'val1')input \<Rightarrow> ('index,'val1)input \<Rightarrow> ('index,'val2)input"
where
"lift2 h inp' inp ==
 \<lambda>i. case (inp' i, inp i) of
   (Some v',Some v) \<Rightarrow> Some (h v' v)
  |_ \<Rightarrow> None"

definition
sameDom ::  "('index,'val1)input \<Rightarrow> ('index,'val2)input \<Rightarrow> bool"
where "sameDom inp1 inp2 == \<forall> i. (inp1 i = None) = (inp2 i = None)"

definition
liftAll2 :: "('val1 \<Rightarrow> 'val2 \<Rightarrow> bool) \<Rightarrow> ('index,'val1)input \<Rightarrow> ('index,'val2)input \<Rightarrow> bool"
where
"liftAll2 phi inp1 inp2 == (\<forall> i v1 v2. inp1 i = Some v1 \<and> inp2 i = Some v2 \<longrightarrow> phi v1 v2)"

lemma lift_None: "(lift h inp i = None) = (inp i = None)"
unfolding lift_def by (cases "inp i", auto)

lemma lift_Some:
"(\<exists> v. lift h inp i = Some v) = (\<exists> v'. inp i = Some v')"
using lift_None[of h inp i] by force

lemma lift_cong[fundef_cong]:
assumes "\<And> i v. inp i = Some v \<Longrightarrow>  h v = h' v"
shows "lift h inp = lift h' inp"
unfolding lift_def apply(rule ext)+
using assms by (case_tac "inp i", auto)

lemma lift_preserves_inj:
assumes "inj f"
shows "inj (lift f)"
unfolding inj_on_def apply auto proof(rule ext)
  fix inp inp' i assume *: "lift f inp = lift f inp'"
  show "inp i = inp' i"
  proof(cases "inp i")
    assume inp: "inp i = None"
    hence "lift f inp i = None" unfolding lift_def by simp
    hence "lift f inp' i = None" using * by simp
    hence "inp' i = None" by(auto simp add: lift_None)
    thus ?thesis using inp by simp
  next
    fix v assume inp: "inp i = Some v"
    hence "lift f inp i = Some (f v)" unfolding lift_def by simp
    hence "lift f inp' i = Some (f v)" using * by simp
    then obtain v' where inp': "inp' i = Some v'" and "f v' = f v"
    unfolding lift_def by(case_tac "inp' i", auto)
    hence "v = v'" using assms unfolding inj_on_def by simp
    thus ?thesis using inp inp' by simp
  qed
qed

lemma liftAll_cong[fundef_cong]:
assumes "\<And> i v. inp i = Some v \<Longrightarrow> phi v = phi' v"
shows "liftAll phi inp = liftAll phi' inp"
unfolding liftAll_def apply((rule iff_allI)+) using assms by simp

lemma liftAll2_cong[fundef_cong]:
assumes "\<And> i v1 v2. \<lbrakk>inp1 i = Some v1; inp2 i = Some v2\<rbrakk> \<Longrightarrow> phi v1 v2 = phi' v1 v2"
shows "liftAll2 phi inp1 inp2 = liftAll2 phi' inp1 inp2"
unfolding liftAll2_def apply((rule iff_allI)+) using assms by blast

lemma lift_ident: "lift (\<lambda>v. v) inp = inp"
by(unfold lift_def, rule ext, case_tac "inp i", auto)

lemma lift_id[simp]:
"lift id inp = inp"
unfolding lift_def apply (rule ext) by(case_tac "inp i", auto)

lemma lift_comp: "lift g (lift f inp) = lift (g o f) inp"
by(unfold lift_def o_def, rule ext, case_tac "inp i", auto)

lemma liftAll_mono:
assumes "\<And> v. phi v \<Longrightarrow> chi v" and "liftAll phi inp"
shows "liftAll chi inp"
using assms unfolding liftAll_def by blast

lemma liftAll_True: "liftAll (\<lambda>v. True) inp"
unfolding liftAll_def by auto

lemma liftAll_lift_comp:  "liftAll phi (lift f inp) = liftAll (phi o f) inp"
unfolding liftAll_def o_def
by (metis (mono_tags, lifting) lift_Some lift_def option.inject option.simps(5))

lemma liftAll_lift_ext:
"liftAll (\<lambda> x. f x = g x) inp = (lift f inp = lift g inp)"
unfolding lift_def liftAll_def
by (auto simp: fun_eq_iff option.case_eq_if)

lemma liftAll_and:
"liftAll (\<lambda> x. phi x \<and> chi x) inp = (liftAll phi inp \<and> liftAll chi inp)"
unfolding liftAll_def by blast

lemma liftAll_mp:
assumes "liftAll (\<lambda> v. phi v \<longrightarrow> chi v) inp" and "liftAll phi inp"
shows "liftAll chi inp"
using assms unfolding liftAll_def by auto

lemma sameDom_refl: "sameDom inp inp"
unfolding sameDom_def by auto

lemma sameDom_sym:
"sameDom inp inp' = sameDom inp' inp"
unfolding sameDom_def by auto

lemma sameDom_trans:
"\<lbrakk>sameDom inp inp'; sameDom inp' inp''\<rbrakk> \<Longrightarrow> sameDom inp inp''"
unfolding sameDom_def by auto

lemma sameDom_lift1:
"sameDom inp (lift f inp)"
unfolding sameDom_def lift_def
by (auto simp: option.case_eq_if)

lemma sameDom_lift2:
"sameDom (lift f inp) inp"
unfolding sameDom_def lift_def
by (auto simp: option.case_eq_if)

lemma sameDom_lift_simp1[simp]:
"sameDom inp (lift f inp') = sameDom inp inp'"
unfolding sameDom_def lift_def by (force simp: fun_eq_iff option.case_eq_if)

lemma sameDom_lift_simp2[simp]:
"sameDom (lift f inp) inp' = sameDom inp inp'"
unfolding sameDom_def lift_def by (force simp: fun_eq_iff option.case_eq_if)

lemma lift_preserves_sameDom:
assumes "sameDom inp inp'"
shows "sameDom (lift f inp) (lift g inp')"
using assms unfolding sameDom_def lift_def
by (force simp: fun_eq_iff option.case_eq_if)

definition comp2 ::
"('b1 \<Rightarrow> 'b2 \<Rightarrow> 'c) \<Rightarrow> ('a1 \<Rightarrow> 'b1) \<Rightarrow> ('a2 \<Rightarrow> 'b2) \<Rightarrow> ('a1 \<Rightarrow> 'a2 \<Rightarrow> 'c)"
("_ o2 '(_,_')" 55)
where "h o2 (f,g) == \<lambda> x y. h (f x) (g y)"

lemma comp2_simp[simp]:
"(h o2 (f,g)) x y = h (f x) (g y)"
unfolding comp2_def by simp

lemma comp2_comp:
"((h o2 (f,g)) o2 (f',g')) = (h o2 (f o f', g o g'))"
unfolding comp_def[abs_def] comp2_def[abs_def] by auto

lemma liftAll_imp_liftAll2:
assumes "liftAll (\<lambda>v. \<forall> v'. phi v v') inp"
shows "liftAll2 phi inp inp'"
using assms unfolding liftAll_def liftAll2_def by auto

lemma liftAll2_mono:
assumes "\<And> v v'. phi v v' \<Longrightarrow> chi v v'" and "liftAll2 phi inp inp'"
shows "liftAll2 chi inp inp'"
using assms unfolding liftAll2_def by blast

lemma liftAll2_True: "liftAll2 (\<lambda> v v'. True) inp inp'"
unfolding liftAll2_def by auto

lemma liftAll2_lift_comp2:
"liftAll2 phi (lift f1 inp1) (lift f2 inp2) =
 liftAll2 (phi o2 (f1,f2)) inp1 inp2"
unfolding liftAll2_def lift_def
by (auto simp: fun_eq_iff option.case_eq_if)

lemma lift_imp_sameDom:
"lift f inp = lift f inp' \<Longrightarrow> sameDom inp inp'"
unfolding lift_def sameDom_def
by (force simp: fun_eq_iff option.case_eq_if split: if_splits)

lemma lift_lift2:
"lift f (lift2 g inp' inp) =
 lift2 (\<lambda> v' v. f (g v' v)) inp' inp"
unfolding lift_def lift2_def
by (force simp: option.case_eq_if split: if_splits)

lemma lift2_left[simp]:
assumes "sameDom inp' inp"
shows "lift2 (\<lambda> v' v. v') inp' inp = inp'"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if) metis

lemma lift2_right[simp]:
assumes "sameDom inp' inp"
shows "lift2 (\<lambda> v' v. v) inp' inp = inp"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if)

lemma sameDom_lift2_1:
assumes "sameDom inp' inp"
shows
"sameDom inp' (lift2 f inp' inp) \<and>
 sameDom inp (lift2 f inp' inp)"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if)

lemma sameDom_lift2_2:
assumes "sameDom inp' inp"
shows
"sameDom (lift2 f inp' inp) inp' \<and>
 sameDom (lift2 f inp' inp) inp"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if)

lemma sameDom_lift2_simp2[simp]:
assumes "sameDom inp' inp"
shows "sameDom (lift2 f inp' inp) inp1 = sameDom inp' inp1"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if) (metis not_Some_eq)

lemma liftAll2_lift_ext:
"(sameDom inp inp' \<and> liftAll2 (\<lambda> v v'. f v = f v') inp inp') =
 (lift f inp = lift f inp')"
unfolding sameDom_def lift_def liftAll2_def
by (force simp add: fun_eq_iff option.case_eq_if)

lemma liftAll2_and:
"liftAll2 (\<lambda> v v'. phi v v' \<and> chi v v') inp inp' =
(liftAll2 phi inp inp' \<and> liftAll2 chi inp inp')"
unfolding liftAll2_def by force

lemma liftAll2_mp:
assumes "liftAll2 (\<lambda> v v'. phi v v' \<longrightarrow> chi v v') inp inp'" and "liftAll2 phi inp inp'"
shows "liftAll2 chi inp inp'"
using assms unfolding liftAll2_def by auto

lemma sameDom_and_liftAll2_iff:
"(sameDom inp inp' \<and> liftAll2 phi inp inp') =
 (\<forall> i. (inp i = None \<and> inp' i = None) \<or>
         (\<exists> v v'. inp i = Some v \<and> inp' i = Some v' \<and> phi v v'))"
unfolding sameDom_def liftAll2_def
apply (auto simp add: fun_eq_iff option.case_eq_if)
using option.sel by fastforce

subsection {* Doubly infinitely-branching trees *}

text "These simple infinitary trees shall be used for measuring the sizes
  of possibly infinitary terms."

datatype ('index,'bindex)tree =
  Branch "('index,('index,'bindex)tree) input" "('bindex,('index,'bindex)tree) input"

(* The natural induction principle for (infinitary) trees:  *)
lemma tree_induct:
fixes phi::"('index,'bindex)tree \<Rightarrow> bool" and T::"('index,'bindex)tree"
assumes
  "\<And> inp binp. \<lbrakk>liftAll phi inp; liftAll phi binp\<rbrakk> \<Longrightarrow> phi (Branch inp binp)"
shows "phi T"
using assms unfolding liftAll_def
by (induct T) (simp, metis rangeI)

definition treeLess :: "('index,'bindex)tree rel"
where
"treeLess ==
 {(T,T'). \<exists> inp binp i j. T' = Branch inp binp \<and> (inp i = Some T \<or> binp j = Some T)}"

lemma treeLess_induct:
fixes phi::"('index,'bindex)tree \<Rightarrow> bool" and
      T::"('index,'bindex)tree"
assumes "\<And> T'. (\<And> T. (T,T') \<in> treeLess \<Longrightarrow> phi T) \<Longrightarrow> phi T'"
shows "phi T"
apply(induct rule: tree_induct)
using assms unfolding treeLess_def liftAll_def
by simp (metis tree.inject)

lemma treeLess_wf: "wf treeLess"
unfolding wf_def using treeLess_induct by blast

subsection {* Ordering  *}

lemma Least_Max:
assumes phi: "phi (n::nat)" and fin: "finite {n. phi n}"
shows "(LEAST m. \<forall> n. phi n \<longrightarrow> n \<le> m) =
       Max {n. phi n}"
using assms Max_in by (intro Least_equality) auto

end


theory LinearPredictor
  imports VCDim
begin

definition "linear_predictor w = (\<lambda>x. minner w x > 0)"

definition "all_linear V = image linear_predictor V"

lemma dimsub: "0 < dim T \<Longrightarrow> S \<subseteq> T \<Longrightarrow> dim S \<le> dim T"
proof -
  assume a1: "S \<subseteq> T"
  assume a2: "0 < dim T"
  obtain B where o1: "B \<subseteq> T" "independent B" "T \<subseteq> span B" "card B = dim T"
    using basis_exists by auto
  have "finite B" using a2
    by (simp add: o1(4) card_ge_0_finite)
  then have "dim S \<le> card B" using dim_le_card a1 o1(3) by auto
  then show "dim S \<le> dim T" using o1(4) by auto
qed

lemma fixes V::"(movec) set" (* euclidean_space*)
  assumes "dim V < card B"
          and "B\<subseteq>V"
          and "0 < dim V"
        shows upper_dim: "\<not> shatters (image mapify (all_linear V)) B {True, False}"
proof(rule ccontr)
  have fB: "finite B" using assms card_infinite by fastforce
  moreover have "dim B < card B" using assms dimsub
    by (metis dim_le_card' fB leD le_neq_implies_less)
  ultimately obtain f x1 where o3: "sum (\<lambda>x. scaleR (f x)  x) B = 0" "(f x1 \<noteq> 0)" "x1\<in>B"
    by (metis assms dependent_finite dim_eq_card_independent nat_neq_iff)
  moreover have "{b\<in>B. f b \<ge> 0} \<union> {b\<in>B. f b < 0} = B" by auto
  moreover have "{b\<in>B. f b \<ge> 0} \<inter> {b\<in>B. f b < 0} = {}" by auto
  moreover have "finite {b\<in>B. f b \<ge> 0}" using fB by auto
  moreover have "finite {b\<in>B. f b < 0}" using fB by auto
  ultimately have "sum (\<lambda>x. scaleR (f x)  x) {b\<in>B. f b \<ge> 0} = - sum (\<lambda>x. scaleR ((f x))  x) {b\<in>B. f b < 0}"
    using sum.union_disjoint
    by (metis (mono_tags, lifting) add.inverse_inverse add_eq_0_iff)
  also have "... = sum (\<lambda>x. scaleR (abs(f x))  x) {b\<in>B. f b < 0}"
      proof -
        have f1: "\<forall>a. (a \<in> {a \<in> B. f a < 0}) = (a \<in> B \<and> \<not> 0 \<le> f a)"
          by fastforce
      have f2: "\<forall>a. if 0 \<le> f a then (if f a < 0 then - f a else f a) *\<^sub>R a = f a *\<^sub>R a else (if f a < 0 then - f a else f a) *\<^sub>R a = (- 1 * f a) *\<^sub>R a"
      by force
        { assume "- (f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) *\<^sub>R v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) \<noteq> (if f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) < 0 then - f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) else f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0})) *\<^sub>R v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}"
          then have "(if f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) < 0 then - f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) else f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0})) *\<^sub>R v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0} \<noteq> (- 1 * f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0})) *\<^sub>R v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}"
            by simp
          then have "v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0} \<notin> {a \<in> B. f a < 0} \<or> - (f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) *\<^sub>R v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) = (if f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) < 0 then - f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}) else f (v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0})) *\<^sub>R v4_0 (\<lambda>a. (if f a < 0 then - f a else f a) *\<^sub>R a) (\<lambda>a. - (f a *\<^sub>R a)) {a \<in> B. f a < 0}"
            using f2 f1 by meson }
        then show ?thesis
          by (simp add: sum_negf)
      qed
  finally have f1: "sum (\<lambda>x. scaleR (f x)  x) {b\<in>B. f b \<ge> 0} = sum (\<lambda>x. scaleR (abs(f x))  x) {b\<in>B. f b < 0}"
    by auto
  have "{b\<in>B. f b \<ge> 0} = {b\<in>B. f b > 0} \<union> {b\<in>B. f b = 0}" by auto
  moreover have "{} = {b\<in>B. f b > 0} \<inter> {b\<in>B. f b = 0}" by auto
  moreover have "finite {b\<in>B. f b > 0}" using fB by auto
  moreover have "finite {b\<in>B. f b = 0}"using fB by auto
  ultimately have "sum (\<lambda>x. scaleR (f x)  x) {b\<in>B. f b \<ge> 0} = sum (\<lambda>x. scaleR (f x)  x) {b\<in>B. f b > 0} +
            sum (\<lambda>x. scaleR (f x)  x) {b\<in>B. f b = 0}" using sum.union_disjoint by (metis (no_types, lifting))
  from f1 this have f4: "sum (\<lambda>x. scaleR (f x)  x) {b\<in>B. f b > 0} = sum (\<lambda>x. scaleR (abs(f x))  x) {b\<in>B. f b < 0}"
    by auto

  let ?T = "f x1 > 0"
  let ?F = "\<not>?T"
  let ?TS = "(if ?T then {b\<in>B. f b > 0} else {b\<in>B. f b < 0})"
  let ?FS = "(if ?F then {b\<in>B. f b > 0} else {b\<in>B. f b < 0})"

  have f5: "x1\<in>?TS" using o3 by auto
  obtain m where o1: "\<forall>x. m x = (if x\<in>B then (if f x > 0 then Some ?T else Some ?F) else None)" by fastforce
  then have f2: "\<forall>x\<in>{b\<in>B. f b > 0}. m x = Some ?T" "\<forall>x\<in>{b\<in>B. f b < 0}. m x = Some ?F"
    by auto
  from o1 have "ran m \<subseteq> {True, False}" by blast
  moreover from o1 have f3: "dom m = B"
    by (meson domI domIff subsetI subset_antisym)
  moreover have "B\<noteq>{}" using \<open>dim B < card B\<close> by auto
  ultimately have "m \<in> (allmaps B {True, False})"
    by (simp add: allmaps_def)
  moreover assume "\<not> \<not> shatters (mapify ` all_linear V) B {True, False}"
  ultimately obtain h where o2: "h\<in>(mapify ` all_linear V)" "m \<subseteq>\<^sub>m h" using alt_shatters by blast
  then obtain w where o3: "mapify (linear_predictor w) = h" using all_linear_def
    by (metis (mono_tags, hide_lams) image_iff)
  have "\<forall>x\<in>?TS. minner w x > 0"
    using f2 o2(2) o3 f3 linear_predictor_def map_le_def mapify_def
    by (metis (no_types, lifting) mem_Collect_eq option.inject)
  moreover from this f5 have "(abs(f x1)) * (minner w x1) > 0"
    using zero_less_mult_iff by fastforce
  ultimately have "sum (\<lambda>x. (abs(f x)) * (minner w x)) ?TS  > 0" using f5
    by (smt \<open>finite {b \<in> B. 0 < f b}\<close> \<open>finite {b \<in> B. f b < 0}\<close> mult_nonneg_nonneg sum_nonneg sum_nonneg_0)
  then have "sum (\<lambda>x. minner w (scaleR (abs(f x)) x)) ?TS  > 0" using minner_scale minner_comm by auto
  moreover have "finite ?TS"  by (simp add: \<open>finite {b \<in> B. 0 < f b}\<close> \<open>finite {b \<in> B. f b < 0}\<close>)
  ultimately have "minner w (sum (\<lambda>x. scaleR (abs(f x)) x) ?TS) > 0"
    by (simp add: minner_sum)
  moreover from f4 have "sum (\<lambda>x. scaleR (abs(f x)) x) ?TS = sum (\<lambda>x. scaleR (abs(f x))  x) ?FS"
    by auto
  ultimately have "minner w (sum (\<lambda>x. scaleR (abs(f x)) x) ?FS) > 0" by auto
  moreover have "finite ?FS"  by (simp add: \<open>finite {b \<in> B. 0 < f b}\<close> \<open>finite {b \<in> B. f b < 0}\<close>)
  ultimately have "sum (\<lambda>x. minner w (scaleR (abs(f x)) x)) ?FS  > 0"
    by (simp add: minner_sum)
  then have "sum (\<lambda>x. (abs(f x)) * (minner w x)) ?FS  > 0" using minner_scale minner_comm by auto
  moreover have "\<forall>x\<in>?FS. minner w x \<le> 0"
    using f2 o2(2) o3 f3 linear_predictor_def map_le_def mapify_def
    by (smt domI option.inject)
  ultimately show False
    by (smt sum_nonpos zero_less_mult_iff)
qed

lemma aux41: "ran m \<subseteq> R \<Longrightarrow> x \<in> dom m \<Longrightarrow> m x \<in> image Some R"
  by (metis domD imageI ranI subsetCE)

(*remove unnecessary parts*)
lemma lower_dim: "shatters (image mapify (all_linear (myroom d))) (mybasis d) {True, False}"
proof -
  let ?B = "(image (\<lambda>k. vec_lambda (\<lambda>i. if i = k then 1 else 0)) {..<d})"
  have f1: "\<forall>(k::nat). (\<lambda>i. if i = k then 1 else 0) \<in> {f. \<exists>j. \<forall>q>j. f q = 0}"
     by auto
  then have "\<forall>k j. k = j \<longleftrightarrow> vec_lambda (\<lambda>i. if i = k then 1 else 0) = vec_lambda (\<lambda>i. if i = j then 1 else 0)"
    using fun_eq_iff movec.vec_lambda_inject by smt
  then have "inj (\<lambda>k. vec_lambda (\<lambda>i. if i = k then 1 else 0))" by (meson injI)
  then have "card ?B = d"
    by (metis (no_types, lifting) card_image card_lessThan injD inj_on_def)
  moreover have "?B \<subseteq> (myroom d)" using myroom_def f1
    by (smt image_subset_iff leD lessThan_iff mem_Collect_eq movec.vec_lambda_inverse)
  moreover have "(\<forall>m\<in>(allmaps ?B {True, False}).\<exists>h\<in>(image mapify (all_linear (myroom d))). m \<subseteq>\<^sub>m h)"
  proof
    fix m
    assume a1: "m\<in>(allmaps ?B {True, False})"
    then have f15: "\<forall>k\<in>{..<d}. m ((\<lambda>k. vec_lambda (\<lambda>i. if i = k then 1 else 0)) k) \<in> image Some {True, False}"
    proof(cases "d = 0")
      case True
      then show ?thesis by auto
    next
      case False
      then have "?B \<noteq> {}" by auto
      then show ?thesis using allmaps_def aux41 a1
        by (smt image_eqI mem_Collect_eq)
    qed
    let ?v = "(\<lambda>x. (if x = Some True then 1 else -1))"
    obtain w where o0: "\<forall>k<d. vec_nth w k = (?v \<circ> m \<circ> (\<lambda>k. vec_lambda (\<lambda>i. if i = k then 1 else 0))) k" "w\<in>(myroom d)"
      using exmovec myroom_def by blast
    have "\<forall>x\<in>?B. mapify (linear_predictor w) x = m x"
    proof
      fix x
      assume a1: "x \<in> (\<lambda>k. movec.vec_lambda (\<lambda>i. if i = k then 1 else 0)) ` {..<d}"
      then obtain k where o1: "x = (\<lambda>k. movec.vec_lambda (\<lambda>i. if i = k then 1 else 0)) k" "k < d"
        by auto
      then have f2: "\<forall>j\<noteq>k. vec_nth x j = 0" using movec.vec_lambda_cases f1 movec.vec_lambda_inverse
              proof -
                { fix nn :: nat
                  obtain rr :: "movec \<Rightarrow> nat \<Rightarrow> real" where
                    ff1: "\<forall>m. movec.vec_nth m = rr m"
                    by blast
                  then have "\<forall>f. rr (movec.vec_lambda f) = f \<or> f \<notin> {f. \<exists>n. \<forall>na>n. f na = 0}"
                    by (metis (no_types) movec.vec_lambda_inverse)
                  then have "\<forall>n. rr (movec.vec_lambda (\<lambda>na. if na = n then 1 else 0)) = (\<lambda>na. if na = n then 1 else 0)"
                    using f1 by blast
                  then have "nn = k \<or> movec.vec_nth x nn = 0"
                    using ff1 o1(1) by presburger }
                then show ?thesis
                  by meson
              qed
      have f3: "vec_nth x k = 1" using movec.vec_lambda_cases f1 movec.vec_lambda_inverse
        by (smt \<open>\<And>thesis. (\<And>k. \<lbrakk>x = movec.vec_lambda (\<lambda>i. if i = k then 1 else 0); k < d\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> f2)

      then have f4: "minner w x = vec_nth w k"
          proof (cases "vec_nth w k = 0")
            case True
            then have "{q. movec.vec_nth w q \<noteq> 0 \<and> movec.vec_nth x q \<noteq> 0} = {}"
              using f2 by fastforce
            then show ?thesis using minner_def sum.neutral
              by (metis (no_types, lifting) Collect_cong True empty_iff)
          next
            case False
            then have "{q. movec.vec_nth w q \<noteq> 0 \<and> movec.vec_nth x q \<noteq> 0} = {k}"
              using f2 f3 by fastforce
            then show ?thesis using minner_def f2 f3 by auto
          qed
      show "mapify (linear_predictor w) x = m x"
      proof(cases "m x = Some True")
        case True
        then have "vec_nth w k = 1" using o0 o1 by simp
        (*then have "minner w x = 1"*)
      then show ?thesis using f4 linear_predictor_def True
        by (simp add: mapify_def)
      next
        case False
        then have "m x = Some False" using f15 a1 by auto
        moreover from this have "vec_nth w k = -1" using o0 o1 by simp
        ultimately show ?thesis using f4 linear_predictor_def
          by (simp add: mapify_def)
      qed
    qed
      then have "m \<subseteq>\<^sub>m (mapify (linear_predictor w))" using a1 map_le_def allmaps_def
            proof -
            have f1: "\<forall>f fa. (fa \<in> Collect ((\<subseteq>\<^sub>m) f)) = (\<forall>m. (m::movec) \<notin> dom f \<or> (f m::bool option) = fa m)"
            by (simp add: Ball_def_raw map_le_def)
            have f2: "m \<in> ( {f. dom f = (\<lambda>n. movec.vec_lambda (\<lambda>na. if na = n then 1 else 0)) ` {..<d} \<and> ran f \<subseteq> {True, False}})"
              using a1 allmaps_def by (simp add: allmaps_def)(* by blast *)
              have f3: "\<forall>F f. F \<noteq> {} \<or> (f::movec \<Rightarrow> bool option) \<notin> F"
                by blast
              have "\<forall>M B f. (f \<in> {f. dom f = (M::movec set) \<and> ran f \<subseteq> (B::bool set)}) = (dom f = M \<and> ran f \<subseteq> B)"
                by simp
              then have "mapify (linear_predictor w) \<in> Collect ((\<subseteq>\<^sub>m) m)"
                using f3 f2 f1 \<open>\<forall>x\<in>(\<lambda>k. movec.vec_lambda (\<lambda>i. if i = k then 1 else 0)) ` {..<d}. mapify (linear_predictor w) x = m x\<close> by presburger
              then show ?thesis
                by blast
            qed
            moreover have "mapify (linear_predictor w) \<in> (image mapify (all_linear (myroom d)))"
              using o0(2) all_linear_def by blast
            ultimately show "\<exists>h\<in>(image mapify (all_linear (myroom d))). m \<subseteq>\<^sub>m h" by auto
          qed
          ultimately show ?thesis
            using alt_shatters mybasis_def unit_vec_def
            by (metis (no_types, lifting) image_cong)

 qed

locale linpred =
  fixes d::nat
  assumes dgone: "d>1"
begin

lemma dgz: "d>0" using dgone by auto

interpretation vcd "myroom d" "{True, False}" "all_linear (myroom d)"
proof
  show "infinite (myroom d)" using dgz infiniteroom by auto
  show "card {True, False} = 2" by auto
  show "\<forall>h x. h \<in> all_linear (myroom d) \<longrightarrow> h x \<in> {True, False}" by auto
  show "all_linear (myroom d) \<noteq> {}"
    using \<open>infinite (myroom d)\<close> all_linear_def by force
qed

\<comment> \<open>Theorem 9.2\<close>
lemma linvcd: "VCDim = Some d" unfolding VCDim_alt
proof
  have "mybasis d \<subseteq> myroom d" using roomSpan
    by (simp add: span_superset)
  then show "\<exists>C\<subseteq>myroom d. card C = d \<and> shatters H_map C {True, False}"
    using lower_dim cardbasis by metis
  show "\<not> (\<exists>C\<subseteq>myroom d. d < card C \<and> shatters H_map C {True, False})"
    using upper_dim dim_room
    by (simp add: dgz)
qed

lemma vaux: "(\<lambda>h. h |` C) ` H_map = (\<lambda>h. restrict_map (mapify h) C) ` (all_linear (myroom d))" by auto

lemma vmain: "card C \<le> m \<Longrightarrow> finite C \<Longrightarrow> d \<le> m \<Longrightarrow> C \<subseteq> (myroom d) \<Longrightarrow> card ((\<lambda>h. restrict_map (mapify h) C) ` (all_linear (myroom d))) \<le> m^d"
  using resforboost[of C d m] vaux linvcd dgone by auto

lemma vfinite: "finite C \<Longrightarrow> finite ((\<lambda>h. restrict_map (mapify h) C) ` (all_linear (myroom d)))"
  using finiteres[of C "{True, False}" "H_map"] restrictH_map_conv[of C] vaux[of C] by simp

lemma "0<(m::nat) \<Longrightarrow> growth m \<le> sum (\<lambda>x. m choose x) {0..d}"
  using lem610 linvcd by auto

end

end


subsection \<open> Quicksort \<close>

theory quicksort
  imports "UTP.utp"
begin

declare length_list_augment_2 [simp]

abbreviation rforloop :: "('a::{ord,plus,one} \<Longrightarrow> 's) \<Rightarrow> ('a, 's) uexpr \<Rightarrow> ('a, 's) uexpr \<Rightarrow> 's hrel \<Rightarrow> 's hrel"
  ("for _ := _ to _ do _ od")
  where "rforloop x i j P \<equiv> x := i ;; while &x \<le> j do P ;; x := &x + 1 od"

abbreviation rforloop_inv :: "('a::{ord,plus,one} \<Longrightarrow> 's) \<Rightarrow> ('a, 's) uexpr \<Rightarrow> ('a, 's) uexpr \<Rightarrow> 's upred \<Rightarrow> 's hrel \<Rightarrow> 's hrel"
  ("for _ := _ to _ invr _ do _ od")
  where "rforloop_inv x i j I P \<equiv> x := i ;; while &x \<le> j invr I do P ;; x := &x + 1 od"

utp_lift_notation rforloop (1 2)

utp_lift_notation rforloop_inv (1 2 3)

utp_lit_vars

alphabet global =
  A :: "int list"
  pivot :: int
  i :: nat
  j :: nat

(*
alphabet local = global +
  pivot :: int
  i :: nat
  j :: nat

abbreviation lv :: "<global, _> \<Longleftrightarrow> local" where
"lv \<equiv> \<lparr> view = (global.base\<^sub>L :: (global \<Longrightarrow> local)), coview = global.more\<^sub>L \<rparr>"

lemma sym_lens_lv [simp]: "sym_lens lv"
  by (rule sym_lens.intro, simp_all)
*)

abbreviation "partition_inv p r \<equiv>
             U(i < j \<and> j \<le> p \<and> p \<le> r \<and> r < length A \<and> (\<forall> k. k < length A \<Rightarrow>
               (p \<le> k \<and> k \<le> i \<Rightarrow> A!k \<le> pivot)
             \<and> (i + 1 \<le> k \<and> k \<le> j - 1 \<Rightarrow> pivot < A!k)
             \<and> (k = r \<Rightarrow> A!k = pivot)))"

abbreviation partition :: "nat \<Rightarrow> nat \<Rightarrow> global hrel" where
"partition p r \<equiv>
   pivot := A!r ;;
   i := (p - 1) ;;
   for j := p to r - 1
   invr @(partition_inv p r)
   do
     if (A ! j) \<le> pivot then
       i := i + 1 ;;
       (A[j], A[i]) := (A!i, A!j)
     fi
   od ;;
   (A[i+1], A[r]) := (A!r, A!i+1)"

lemma "\<lbrace>@(partition_inv p r)\<rbrace>
   while j \<le> r - 1
   invr @(partition_inv p r)
   do
     if (A ! j) \<le> pivot then
       i := i + 1 ;;
       (A[j], A[i]) := (A!i, A!j)
     fi ;;
     j := j + 1
   od
   \<lbrace>@(partition_inv p r)\<rbrace>\<^sub>u"
  apply (rule while_invr_hoare_r)
    apply (hoare_split)
      apply (rel_auto')
  oops

end