chapter \<open>Ordinals, Sequences and Ordinal Recursion\<close>

theory Ordinal imports HF
begin

section \<open>Ordinals\<close>

subsection \<open>Basic Definitions\<close>

text \<open>Definition 2.1. We say that x is transitive if every element of x is a subset of x.\<close>
definition
  Transset  :: "hf \<Rightarrow> bool"  where
    "Transset(x) \<equiv> \<forall>y. y \<^bold>\<in> x \<longrightarrow> y \<le> x"

lemma Transset_sup: "Transset x \<Longrightarrow> Transset y \<Longrightarrow> Transset (x \<squnion> y)"
  by (auto simp: Transset_def)

lemma Transset_inf: "Transset x \<Longrightarrow> Transset y \<Longrightarrow> Transset (x \<sqinter> y)"
  by (auto simp: Transset_def)

lemma Transset_hinsert: "Transset x \<Longrightarrow> y \<le> x \<Longrightarrow> Transset (x \<triangleleft> y)"
  by (auto simp: Transset_def)

text \<open>In HF, the ordinals are simply the natural numbers. But the definitions are the same
      as for transfinite ordinals.\<close>
definition
  Ord  :: "hf \<Rightarrow> bool"  where
    "Ord(k)      \<equiv> Transset(k) \<and> (\<forall>x \<^bold>\<in> k. Transset(x))"

subsection \<open>Definition 2.2 (Successor).\<close>
definition
  succ  :: "hf \<Rightarrow> hf"  where
    "succ(x)      \<equiv> hinsert x x"

lemma succ_iff [simp]: "x \<^bold>\<in> succ y \<longleftrightarrow> x=y \<or> x \<^bold>\<in> y"
  by (simp add: succ_def)

lemma succ_ne_self [simp]: "i \<noteq> succ i"
  by (metis hmem_ne succ_iff)

lemma succ_notin_self: "succ i \<^bold>\<notin> i"
  by (metis hmem_ne succ_iff)

lemma succE [elim?]: assumes "x \<^bold>\<in> succ y" obtains "x=y" | "x \<^bold>\<in> y"
  by (metis assms succ_iff)

lemma hmem_succ_ne: "succ x \<^bold>\<in> y \<Longrightarrow> x \<noteq> y"
  by (metis hmem_not_refl succ_iff)

lemma hball_succ [simp]: "(\<forall>x \<^bold>\<in> succ k. P x) \<longleftrightarrow> P k \<and> (\<forall>x \<^bold>\<in> k. P x)"
  by (auto simp: HBall_def)

lemma hbex_succ [simp]: "(\<exists>x \<^bold>\<in> succ k. P x) \<longleftrightarrow> P k \<or> (\<exists>x \<^bold>\<in> k. P x)"
  by (auto simp: HBex_def)

lemma One_hf_eq_succ: "1 = succ 0"
  by (metis One_hf_def succ_def)

lemma zero_hmem_one [iff]: "x \<^bold>\<in> 1 \<longleftrightarrow> x = 0"
  by (metis One_hf_eq_succ hmem_hempty succ_iff)

lemma hball_One [simp]: "(\<forall>x\<^bold>\<in>1. P x) = P 0"
  by (simp add: One_hf_eq_succ)

lemma hbex_One [simp]: "(\<exists>x\<^bold>\<in>1. P x) = P 0"
  by (simp add: One_hf_eq_succ)

lemma hpair_neq_succ [simp]: "\<langle>x,y\<rangle> \<noteq> succ k"
  by (auto simp: succ_def hpair_def) (metis hemptyE hmem_hinsert hmem_ne)

lemma hpair_neq_one [simp]: "\<langle>x,y\<rangle> \<noteq> 1"
  by (metis One_hf_eq_succ hpair_neq_succ)

lemma one_neq_hpair [simp]: "1 \<noteq> \<langle>x,y\<rangle>"
  by (metis hpair_neq_one)

lemma hmem_succ: "l \<^bold>\<in> k \<Longrightarrow> l \<^bold>\<in> succ k"
  by (metis succ_iff)

text \<open>Theorem 2.3.\<close>
lemma Ord_0 [iff]: "Ord 0"
  by (simp add: Ord_def Transset_def)

lemma Ord_succ: "Ord(k) \<Longrightarrow> Ord(succ(k))"
  by (simp add: Ord_def Transset_def succ_def less_eq_insert2_iff HBall_def)

lemma Ord_1 [iff]: "Ord 1"
  by (metis One_hf_def Ord_0 Ord_succ succ_def)

lemma OrdmemD: "Ord(k) \<Longrightarrow> j \<^bold>\<in> k \<Longrightarrow> j \<le> k"
  by (simp add: Ord_def Transset_def HBall_def)

lemma Ord_trans: "\<lbrakk> i\<^bold>\<in>j;  j\<^bold>\<in>k;  Ord(k) \<rbrakk>  \<Longrightarrow> i\<^bold>\<in>k"
  by (blast dest: OrdmemD)

lemma hmem_0_Ord:
  assumes k: "Ord(k)" and knz: "k \<noteq> 0" shows "0 \<^bold>\<in> k"
  by (metis foundation [OF knz] Ord_trans hempty_iff hinter_iff k)

lemma Ord_in_Ord: "\<lbrakk> Ord(k);  m \<^bold>\<in> k \<rbrakk>  \<Longrightarrow> Ord(m)"
  by (auto simp: Ord_def Transset_def)

subsection \<open>Induction, Linearity, etc.\<close>

lemma Ord_induct [consumes 1, case_names step]:
  assumes k: "Ord(k)"
      and step: "\<And>x.\<lbrakk> Ord(x);  \<And>y. y \<^bold>\<in> x \<Longrightarrow> P(y) \<rbrakk>  \<Longrightarrow> P(x)"
  shows "P(k)"
proof -
  have "\<forall>m \<^bold>\<in> k. Ord(m) \<longrightarrow> P(m)"
    proof (induct k rule: hf_induct)
      case 0 thus ?case  by simp
    next
      case (hinsert a b)
      thus ?case
        by (auto intro: Ord_in_Ord step)
    qed
  thus ?thesis using k
    by (auto intro: Ord_in_Ord step)
qed

text \<open>Theorem 2.4 (Comparability of ordinals).\<close>
lemma Ord_linear: "Ord(k) \<Longrightarrow> Ord(l) \<Longrightarrow> k\<^bold>\<in>l \<or> k=l \<or> l\<^bold>\<in>k"
proof (induct k arbitrary: l rule: Ord_induct)
  case (step k)
  note step_k = step
  show ?case using \<open>Ord(l)\<close>
    proof (induct l rule: Ord_induct)
      case (step l)
      thus ?case using step_k
        by (metis Ord_trans hf_equalityI)
    qed
qed

text \<open>The trichotomy law for ordinals\<close>
lemma Ord_linear_lt:
  assumes o: "Ord(k)" "Ord(l)"
  obtains (lt) "k\<^bold>\<in>l" | (eq) "k=l" | (gt) "l\<^bold>\<in>k"
by (metis Ord_linear o)

lemma Ord_linear2:
  assumes o: "Ord(k)" "Ord(l)"
  obtains (lt) "k\<^bold>\<in>l" | (ge) "l \<le> k"
by (metis Ord_linear OrdmemD order_eq_refl o)

lemma Ord_linear_le:
  assumes o: "Ord(k)" "Ord(l)"
  obtains (le) "k \<le> l" | (ge) "l \<le> k"
by (metis Ord_linear2 OrdmemD o)

lemma hunion_less_iff [simp]: "\<lbrakk>Ord i; Ord j\<rbrakk> \<Longrightarrow> i \<squnion> j < k \<longleftrightarrow> i<k \<and> j<k"
  by (metis Ord_linear_le le_iff_sup sup.order_iff sup.strict_boundedE)

text \<open>Theorem 2.5\<close>
lemma Ord_mem_iff_lt: "Ord(k) \<Longrightarrow> Ord(l) \<Longrightarrow> k\<^bold>\<in>l \<longleftrightarrow> k < l"
  by (metis Ord_linear OrdmemD hmem_not_refl less_hf_def less_le_not_le)

lemma le_succE: "succ i \<le> succ j \<Longrightarrow> i \<le> j"
  by (simp add: less_eq_hf_def) (metis hmem_not_sym)

lemma le_succ_iff: "Ord i \<Longrightarrow> Ord j \<Longrightarrow> succ i \<le> succ j \<longleftrightarrow> i \<le> j"
  by (metis Ord_linear_le Ord_succ le_succE order_antisym)

lemma succ_inject_iff [iff]: "succ i = succ j \<longleftrightarrow> i = j"
  by (metis succ_def hmem_hinsert hmem_not_sym)

lemma mem_succ_iff [simp]: "Ord j \<Longrightarrow> succ i \<^bold>\<in> succ j \<longleftrightarrow> i \<^bold>\<in> j"
  by (metis Ord_in_Ord Ord_mem_iff_lt Ord_succ succ_def less_eq_insert1_iff less_hf_def succ_iff)

lemma Ord_mem_succ_cases:
  assumes "Ord(k)" "l \<^bold>\<in> k"
  shows "succ l = k \<or> succ l \<^bold>\<in> k"
  by (metis assms mem_succ_iff succ_iff)

subsection \<open>Supremum and Infimum\<close>

lemma Ord_Union [intro,simp]: "\<lbrakk> \<And>i. i\<^bold>\<in>A \<Longrightarrow> Ord(i) \<rbrakk>  \<Longrightarrow> Ord(\<Squnion> A)"
  by (auto simp: Ord_def Transset_def) blast

lemma Ord_Inter [intro,simp]: "\<lbrakk> \<And>i. i\<^bold>\<in>A \<Longrightarrow> Ord(i) \<rbrakk>  \<Longrightarrow> Ord(\<Sqinter> A)"
  apply (case_tac "A=0", auto simp: Ord_def Transset_def)
  apply (force simp add: hf_ext)+
  done

text \<open>Theorem 2.7. Every set x of ordinals is ordered by the binary relation <.
      Moreover if x = 0 then x has a smallest and a largest element.\<close>

lemma hmem_Sup_Ords: "\<lbrakk>A\<noteq>0; \<And>i. i\<^bold>\<in>A \<Longrightarrow> Ord(i)\<rbrakk> \<Longrightarrow> \<Squnion>A \<^bold>\<in> A"
proof (induction A rule: hf_induct)
  case 0 thus ?case  by simp
next
  case (hinsert x A)
  show ?case
    proof (cases A rule: hf_cases)
      case 0 thus ?thesis by simp
    next
      case (hinsert y A')
      hence UA: "\<Squnion>A \<^bold>\<in> A"
        by (metis hinsert.IH(2) hinsert.prems(2) hinsert_nonempty hmem_hinsert)
      hence "\<Squnion>A \<le> x \<or> x \<le> \<Squnion>A"
        by (metis Ord_linear2 OrdmemD hinsert.prems(2) hmem_hinsert)
      thus ?thesis
        by (metis HUnion_hinsert UA le_iff_sup less_eq_insert1_iff order_refl sup.commute)
    qed
qed

lemma hmem_Inf_Ords: "\<lbrakk>A\<noteq>0; \<And>i. i\<^bold>\<in>A \<Longrightarrow> Ord(i)\<rbrakk> \<Longrightarrow> \<Sqinter>A \<^bold>\<in> A"
proof (induction A rule: hf_induct)
  case 0 thus ?case  by simp
next
  case (hinsert x A)
  show ?case
    proof (cases A rule: hf_cases)
      case 0 thus ?thesis by auto
    next
      case (hinsert y A')
      hence IA: "\<Sqinter>A \<^bold>\<in> A"
        by (metis hinsert.IH(2) hinsert.prems(2) hinsert_nonempty hmem_hinsert)
      hence "\<Sqinter>A \<le> x \<or> x \<le> \<Sqinter>A"
        by (metis Ord_linear2 OrdmemD hinsert.prems(2) hmem_hinsert)
      thus ?thesis
        by (metis HInter_hinsert IA hmem_hempty hmem_hinsert inf_absorb2 le_iff_inf)
    qed
qed

lemma Ord_pred: "\<lbrakk>Ord(k); k \<noteq> 0\<rbrakk> \<Longrightarrow> succ(\<Squnion>k) = k"
by (metis (full_types) HUnion_iff Ord_in_Ord Ord_mem_succ_cases hmem_Sup_Ords hmem_ne succ_iff)

lemma Ord_cases [cases type: hf, case_names 0 succ]:
  assumes Ok: "Ord(k)"
  obtains "k = 0" | l where "Ord l" "succ l = k"
by (metis Ok Ord_in_Ord Ord_pred succ_iff)

lemma Ord_induct2 [consumes 1, case_names 0 succ, induct type: hf]:
  assumes k: "Ord(k)"
      and P: "P 0" "\<And>k. Ord k \<Longrightarrow> P k \<Longrightarrow> P (succ k)"
  shows "P k"
using k
proof (induction k rule: Ord_induct)
  case (step k) thus ?case
    by (metis Ord_cases P hmem_succ_self)
qed

lemma Ord_succ_iff [iff]: "Ord (succ k) = Ord k"
  by (metis Ord_in_Ord Ord_succ less_eq_insert1_iff order_refl succ_def)

lemma Ord_Sup_succ_eq [simp]: "Ord k \<Longrightarrow> \<Squnion>(succ k) = k"
  by (metis Ord_pred Ord_succ_iff succ_inject_iff hinsert_nonempty succ_def)

lemma Ord_lt_succ_iff_le: "Ord k \<Longrightarrow> Ord l \<Longrightarrow> k < succ l \<longleftrightarrow> k \<le> l"
  by (metis Ord_mem_iff_lt Ord_succ_iff less_le_not_le order_eq_iff succ_iff)

lemma zero_in_Ord: "Ord k \<Longrightarrow> k=0 \<or> 0 \<^bold>\<in> k"
  by (induct k) auto

lemma hpair_neq_Ord: "Ord k \<Longrightarrow> \<langle>x,y\<rangle> \<noteq> k"
  by (cases k) auto

lemma hpair_neq_Ord': assumes k: "Ord k" shows "k \<noteq> \<langle>x,y\<rangle>"
  by (metis k hpair_neq_Ord)

lemma Not_Ord_hpair [iff]: "\<not> Ord \<langle>x,y\<rangle>"
  by (metis hpair_neq_Ord)

lemma is_hpair [simp]: "is_hpair \<langle>x,y\<rangle>"
  by (force simp add: is_hpair_def)

lemma Ord_not_hpair: "Ord x \<Longrightarrow> \<not> is_hpair x"
  by (metis Not_Ord_hpair is_hpair_def)

lemma zero_in_succ [simp,intro]: "Ord i \<Longrightarrow> 0 \<^bold>\<in> succ i"
  by (metis succ_iff zero_in_Ord)

subsection \<open>Converting Between Ordinals and Natural Numbers\<close>

fun ord_of :: "nat \<Rightarrow> hf"
  where
   "ord_of 0 = 0"
 | "ord_of (Suc k) = succ (ord_of k)"

lemma Ord_ord_of [simp]: "Ord (ord_of k)"
  by (induct k, auto)

lemma ord_of_inject [iff]: "ord_of i = ord_of j \<longleftrightarrow> i=j"
proof (induct i arbitrary: j)
  case 0 show ?case
    by (metis Zero_neq_Suc hempty_iff hmem_succ_self ord_of.elims)
next
  case (Suc i) show ?case
    by (cases j) (auto simp: Suc)
qed

lemma ord_of_minus_1: "n > 0 \<Longrightarrow> ord_of n = succ (ord_of (n - 1))"
  by (metis Suc_diff_1 ord_of.simps(2))

definition nat_of_ord :: "hf \<Rightarrow> nat"
  where "nat_of_ord x = (THE n. x = ord_of n)"

lemma nat_of_ord_ord_of [simp]: "nat_of_ord (ord_of n) = n"
  by (auto simp: nat_of_ord_def)

lemma nat_of_ord_0 [simp]: "nat_of_ord 0 = 0"
  by (metis (mono_tags) nat_of_ord_ord_of ord_of.simps(1))

lemma ord_of_nat_of_ord [simp]: "Ord x \<Longrightarrow> ord_of (nat_of_ord x) = x"
  apply (erule Ord_induct2, simp)
  apply (metis nat_of_ord_ord_of ord_of.simps(2))
  done

lemma nat_of_ord_inject: "Ord x \<Longrightarrow> Ord y \<Longrightarrow> nat_of_ord x = nat_of_ord y \<longleftrightarrow> x = y"
  by (metis ord_of_nat_of_ord)

lemma nat_of_ord_succ [simp]: "Ord x \<Longrightarrow> nat_of_ord (succ x) = Suc (nat_of_ord x)"
  by (metis nat_of_ord_ord_of ord_of.simps(2) ord_of_nat_of_ord)

lemma inj_ord_of: "inj_on ord_of A"
  by (simp add: inj_on_def)

lemma hfset_ord_of: "hfset (ord_of n) = ord_of ` {0..<n}"
  by (induct n) (auto simp: hfset_hinsert succ_def)

lemma bij_betw_ord_of: "bij_betw ord_of {0..<n} (hfset (ord_of n))"
  by (simp add: bij_betw_def inj_ord_of hfset_ord_of)

lemma bij_betw_ord_ofI: "bij_betw h A {0..<n} \<Longrightarrow> bij_betw (ord_of \<circ> h) A (hfset (ord_of n))"
  by (blast intro: bij_betw_ord_of bij_betw_trans)

section \<open>Sequences and Ordinal Recursion\<close>

text \<open>Definition 3.2 (Sequence).\<close>

definition Seq :: "hf \<Rightarrow> hf \<Rightarrow> bool"
  where "Seq s k \<longleftrightarrow> hrelation s \<and> hfunction s \<and> k \<le> hdomain s"

lemma Seq_0 [iff]: "Seq 0 0"
  by (auto simp: Seq_def hrelation_def hfunction_def)

lemma Seq_succ_D: "Seq s (succ k) \<Longrightarrow> Seq s k"
  by (simp add: Seq_def succ_def)

lemma Seq_Ord_D: "Seq s k \<Longrightarrow> l \<^bold>\<in> k \<Longrightarrow> Ord k \<Longrightarrow> Seq s l"
  by (auto simp: Seq_def intro: Ord_trans)

lemma Seq_restr: "Seq s (succ k) \<Longrightarrow> Seq (hrestrict s k) k"
  by (simp add: Seq_def hfunction_restr succ_def)

lemma Seq_Ord_restr: "\<lbrakk>Seq s k; l \<^bold>\<in> k; Ord k\<rbrakk> \<Longrightarrow> Seq (hrestrict s l) l"
  by (auto simp: Seq_def hfunction_restr intro: Ord_trans)

lemma Seq_ins: "\<lbrakk>Seq s k; k \<^bold>\<notin> hdomain s\<rbrakk> \<Longrightarrow> Seq (s \<triangleleft> \<langle>k, y\<rangle>) (succ k)"
  by (auto simp: Seq_def hrelation_def succ_def hfunction_def hdomainI)

definition insf :: "hf \<Rightarrow> hf \<Rightarrow> hf \<Rightarrow> hf"
  where "insf s k y \<equiv> nonrestrict s \<lbrace>k\<rbrace> \<triangleleft> \<langle>k, y\<rangle>"

lemma hfunction_insf: "hfunction s \<Longrightarrow> hfunction (insf s k y)"
  by (auto simp: insf_def hfunction_def nonrestrict_def hmem_not_refl)

lemma Seq_succ_iff: "Seq s (succ k) \<longleftrightarrow> Seq s k \<and> (\<exists>y. \<langle>k, y\<rangle> \<^bold>\<in> s)"
  apply (auto simp: Seq_def hdomain_def)
  apply (metis hfst_conv, blast)
  done

lemma nonrestrictD: "a \<^bold>\<in> nonrestrict s X \<Longrightarrow> a \<^bold>\<in> s"
  by (auto simp: nonrestrict_def)

lemma hpair_in_nonrestrict_iff [simp]: "\<langle>a,b\<rangle> \<^bold>\<in> nonrestrict s X \<longleftrightarrow> \<langle>a,b\<rangle> \<^bold>\<in> s \<and> \<not> a \<^bold>\<in> X"
  by (auto simp: nonrestrict_def)

lemma app_nonrestrict_Seq: "Seq s k \<Longrightarrow> z \<^bold>\<notin> X \<Longrightarrow> app (nonrestrict s X) z = app s z"
  by (auto simp: Seq_def nonrestrict_def app_def HBall_def) (metis)

lemma app_insf_Seq: "Seq s k \<Longrightarrow> app (insf s k y) k = y"
  by (metis Seq_def hfunction_insf app_equality hmem_hinsert insf_def)

lemma app_insf2_Seq: "Seq s k \<Longrightarrow> k' \<noteq> k \<Longrightarrow> app (insf s k y) k' = app s k'"
  by (simp add: app_nonrestrict_Seq insf_def app_ins2)

lemma app_insf_Seq_if: "Seq s k \<Longrightarrow> app (insf s k y) k' = (if k' = k then y else app s k')"
  by (metis app_insf2_Seq app_insf_Seq)

lemma Seq_imp_eq_app: "\<lbrakk>Seq s d; \<langle>x,y\<rangle> \<^bold>\<in> s\<rbrakk> \<Longrightarrow> app s x = y"
  by (metis Seq_def app_equality)

lemma Seq_iff_app: "\<lbrakk>Seq s d; x \<^bold>\<in> d\<rbrakk> \<Longrightarrow> \<langle>x,y\<rangle> \<^bold>\<in> s \<longleftrightarrow> app s x = y"
  by (auto simp: Seq_def hdomain_def app_equality)

lemma Exists_iff_app: "Seq s d \<Longrightarrow> x \<^bold>\<in> d \<Longrightarrow> (\<exists>y. \<langle>x, y\<rangle> \<^bold>\<in> s \<and> P y) = P (app s x)"
  by (metis Seq_iff_app)

definition ord_rec_Seq :: "hf \<Rightarrow> (hf \<Rightarrow> hf) \<Rightarrow> hf \<Rightarrow> hf \<Rightarrow> hf \<Rightarrow> bool"
  where
   "ord_rec_Seq T G s k y \<longleftrightarrow>
        (Seq s k \<and> y = G (app s (\<Squnion>k)) \<and> app s 0 = T \<and>
                   (\<forall>n. succ n \<^bold>\<in> k \<longrightarrow> app s (succ n) = G (app s n)))"

lemma Seq_succ_insf:
  assumes s: "Seq s (succ k)"  shows "\<exists> y. s = insf s k y"
proof -
  obtain y where y: "\<langle>k, y\<rangle> \<^bold>\<in> s" by (metis Seq_succ_iff s)
  hence yuniq: "\<forall> y'. \<langle>k, y'\<rangle> \<^bold>\<in> s \<longrightarrow> y' = y" using s
    by (simp add: Seq_def hfunction_def)
  { fix z
    assume z: "z \<^bold>\<in> s"
    then obtain u v where uv: "z = \<langle>u, v\<rangle>" using s
      by (metis Seq_def hrelation_def is_hpair_def)
    hence "z \<^bold>\<in> insf s k y"
      by (metis hemptyE hmem_hinsert hpair_in_nonrestrict_iff insf_def yuniq z)
  }
  note left2right = this
  show ?thesis
    proof
      show "s = insf s k y"
        by (rule hf_equalityI) (metis hmem_hinsert insf_def left2right nonrestrictD y)
    qed
qed

lemma ord_rec_Seq_succ_iff:
  assumes k: "Ord k" and knz: "k \<noteq> 0"
  shows "ord_rec_Seq T G s (succ k) z \<longleftrightarrow> (\<exists> s' y. ord_rec_Seq T G s' k y \<and> z = G y \<and> s = insf s' k y)"
proof
  assume os: "ord_rec_Seq T G s (succ k) z"
  show "\<exists>s' y. ord_rec_Seq T G s' k y \<and> z = G y \<and> s = insf s' k y"
    apply (rule_tac x=s in exI)  using os k knz
    apply (auto simp: Seq_insf ord_rec_Seq_def app_insf_Seq app_insf2_Seq
                          hmem_succ_ne hmem_ne hmem_Sup_ne Seq_succ_iff hmem_0_Ord)
    apply (metis Ord_pred)
    apply (metis Ord_pred Seq_succ_iff Seq_succ_insf app_insf_Seq)
    done
next
  assume ok: "\<exists>s' y. ord_rec_Seq T G s' k y \<and> z = G y \<and> s = insf s' k y"
  thus "ord_rec_Seq T G s (succ k) z" using ok k knz
    by (auto simp: ord_rec_Seq_def app_insf_Seq_if hmem_ne hmem_succ_ne Seq_insf)
qed

lemma ord_rec_Seq_functional:
   "Ord k \<Longrightarrow> k \<noteq> 0 \<Longrightarrow> ord_rec_Seq T G s k y \<Longrightarrow> ord_rec_Seq T G s' k y' \<Longrightarrow> y' = y"
proof (induct k arbitrary: y y' s s' rule: Ord_induct2)
  case 0 thus ?case
    by (simp add: ord_rec_Seq_def)
next
  case (succ k) show ?case
    proof (cases "k=0")
      case True thus ?thesis using succ
        by (auto simp: ord_rec_Seq_def)
    next
      case False
      thus ?thesis using succ
        by (auto simp: ord_rec_Seq_succ_iff)
    qed
qed

definition ord_recp :: "hf \<Rightarrow> (hf \<Rightarrow> hf) \<Rightarrow> (hf \<Rightarrow> hf) \<Rightarrow> hf \<Rightarrow> hf \<Rightarrow> bool"
  where
   "ord_recp T G H x y =
    (if x=0 then y = T
     else
       if Ord(x) then \<exists> s. ord_rec_Seq T G s x y
       else y = H x)"

lemma ord_recp_functional: "ord_recp T G H x y \<Longrightarrow> ord_recp T G H x y' \<Longrightarrow> y' = y"
  by (auto simp: ord_recp_def ord_rec_Seq_functional split: if_split_asm)

lemma ord_recp_succ_iff:
  assumes k: "Ord k" shows "ord_recp T G H (succ k) z \<longleftrightarrow> (\<exists>y. z = G y \<and> ord_recp T G H k y)"
proof (cases "k=0")
  case True thus ?thesis
    by (simp add: ord_recp_def ord_rec_Seq_def) (metis Seq_0 Seq_insf app_insf_Seq)
next
  case False
  thus ?thesis using k
    by (auto simp: ord_recp_def ord_rec_Seq_succ_iff)
qed

definition ord_rec :: "hf \<Rightarrow> (hf \<Rightarrow> hf) \<Rightarrow> (hf \<Rightarrow> hf) \<Rightarrow> hf \<Rightarrow> hf"
  where
   "ord_rec T G H x = (THE y. ord_recp T G H x y)"

lemma ord_rec_0 [simp]: "ord_rec T G H 0 = T"
  by (simp add: ord_recp_def ord_rec_def)

lemma ord_recp_total: "\<exists>y. ord_recp T G H x y"
proof (cases "Ord x")
  case True thus ?thesis
  proof (induct x rule: Ord_induct2)
    case 0 thus ?case
      by (simp add: ord_recp_def)
  next
    case (succ x) thus ?case
      by (metis ord_recp_succ_iff)
  qed
next
  case False thus ?thesis
    by (auto simp: ord_recp_def)
qed

lemma ord_rec_succ [simp]:
  assumes k: "Ord k" shows "ord_rec T G H (succ k) = G (ord_rec T G H k)"
proof -
  from ord_recp_total [of T G H k]
  obtain y where "ord_recp T G H k y" by auto
  thus ?thesis using k
    apply (simp add: ord_rec_def ord_recp_succ_iff)
    apply (rule theI2)
    apply (auto dest: ord_recp_functional)
    done
qed

lemma ord_rec_non [simp]: "\<not> Ord x \<Longrightarrow> ord_rec T G H x = H x"
  by (metis Ord_0 ord_rec_def ord_recp_def the_equality)

end


(* Title: Matrix_Vector_Extras.thy
   Author: Chelsea Edmonds
*)
section \<open> Matrix and Vector Additions \<close>

theory Matrix_Vector_Extras imports Set_Multiset_Extras Jordan_Normal_Form.Matrix
Design_Theory.Multisets_Extras "Groebner_Bases.Macaulay_Matrix" "Polynomial_Factorization.Missing_List"
begin

subsection \<open>Vector Extras\<close>
text \<open>For ease of use, a number of additions to the existing vector library as initially developed
in the JNF AFP Entry, are given below\<close>

text \<open>We define the concept of summing up elements of a vector \<close>

definition (in comm_monoid_add) sum_vec :: "'a vec \<Rightarrow> 'a" where
"sum_vec v \<equiv> sum (\<lambda> i . v $ i) {0..<dim_vec v}"

lemma sum_vec_vNil[simp]: "sum_vec vNil = 0"
  by (simp add: sum_vec_def)

lemma sum_vec_vCons: "sum_vec (vCons a v) = a + sum_vec v"
proof -
  have 0: "a = (vCons a v) $ 0"
    by simp
  have "sum_vec v = sum (\<lambda> i . v $ i) {0..<dim_vec v}" by (simp add: sum_vec_def)
  also have "... = sum (\<lambda> i . (vCons a v) $ Suc i) {0..< dim_vec v}"
    by force
  also have "... = sum (\<lambda> i . (vCons a v) $ i) {Suc 0..< (Suc (dim_vec v))}"
    by (metis sum.shift_bounds_Suc_ivl)
  finally have sum: "sum_vec v = sum (\<lambda> i . (vCons a v) $ i) {Suc 0..< dim_vec (vCons a v)}" by simp
  have "sum_vec (vCons a v) = sum (\<lambda> i . (vCons a v) $ i){0..< dim_vec (vCons a v)}"
    by (simp add: sum_vec_def)
  then have "sum_vec (vCons a v) = (vCons a v) $ 0 + sum (\<lambda> i . (vCons a v) $ i){Suc 0..< dim_vec (vCons a v)}"
    by (metis dim_vec_vCons sum.atLeast_Suc_lessThan zero_less_Suc)
  thus ?thesis using sum 0 by simp
qed

lemma sum_vec_list: "sum_list (list_of_vec v) = sum_vec v"
  by (induct v)(simp_all add: sum_vec_vCons)

lemma sum_vec_mset: "sum_vec v = (\<Sum> x \<in># (mset (list_of_vec v)) . x)"
  by (simp add: sum_vec_list)

lemma dim_vec_vCons_ne_0: "dim_vec (vCons a v) > 0"
  by (cases v) simp_all

lemma sum_vec_vCons_lt:
  assumes "\<And> i. i < dim_vec (vCons a v) \<Longrightarrow> (vCons a v) $ i \<le> (n ::int)"
  assumes "sum_vec v \<le> m"
  shows "sum_vec (vCons a v) \<le> n + m"
proof -
  have split: "sum_vec (vCons a v) = a + sum_vec v" by (simp add: sum_vec_vCons)
  have a: "(vCons a v) $ 0 = a" by simp
  then have "0 < dim_vec (vCons a v)" using dim_vec_vCons_ne_0 by simp
  then have "a \<le> n" using assms by (metis a)
  thus ?thesis using split assms
    by (simp add: add_mono)
qed

lemma sum_vec_one_zero:
  assumes "\<And> i. i < dim_vec (v :: int vec) \<Longrightarrow> v $ i \<le> (1 ::int)"
  shows "sum_vec v \<le> dim_vec v"
  using assms
proof (induct v)
  case vNil
  then show ?case by simp
next
  case (vCons a v)
  then have "(\<And> i. i < dim_vec v \<Longrightarrow> v $ i \<le> (1 ::int))"
    using vCons.prems by force
  then have lt: "sum_vec v \<le> int (dim_vec v)" by (simp add: vCons.hyps)
  then show ?case using sum_vec_vCons_lt lt vCons.prems by simp
qed

text \<open>Definition to convert a vector to a multiset \<close>

definition vec_mset:: "'a vec \<Rightarrow> 'a multiset" where
"vec_mset v \<equiv> image_mset (vec_index v) (mset_set {..<dim_vec v})"

lemma vec_elem_exists_mset: "(\<exists> i \<in> {..<dim_vec v}. v $ i = x) \<longleftrightarrow> x \<in># vec_mset v"
  by (auto simp add: vec_mset_def)

lemma mset_vec_same_size: "dim_vec v = size (vec_mset v)"
  by (simp add: vec_mset_def)

lemma mset_vec_eq_mset_list: "vec_mset v = mset (list_of_vec v)"
  by (auto simp add: vec_mset_def)
  (metis list_of_vec_map mset_map mset_set_upto_eq_mset_upto)

lemma vec_mset_img_map: "image_mset f (mset (xs)) = vec_mset (map_vec f (vec_of_list xs))"
  by (metis list_vec mset_map mset_vec_eq_mset_list vec_of_list_map)

lemma vec_mset_vNil: "vec_mset vNil = {#}"
  by (simp add: vec_mset_def)

lemma vec_mset_vCons: "vec_mset (vCons x v) = add_mset x (vec_mset v)"
proof -
  have "vec_mset (vCons x v) = mset (list_of_vec (vCons x v))"
    by (simp add: mset_vec_eq_mset_list)
  then have "mset (list_of_vec (vCons x v)) = add_mset x (mset (list_of_vec v))"
    by simp
  thus ?thesis
    by (metis mset_vec_eq_mset_list)
qed

lemma vec_mset_set: "vec_set v = set_mset (vec_mset v)"
  by (simp add: mset_vec_eq_mset_list set_list_of_vec)

lemma vCons_set_contains_in: "a \<in> set\<^sub>v v \<Longrightarrow> set\<^sub>v (vCons a v) = set\<^sub>v v"
  by (metis remdups_mset_singleton_sum set_mset_remdups_mset vec_mset_set vec_mset_vCons)

lemma vCons_set_contains_add: "a \<notin> set\<^sub>v v \<Longrightarrow> set\<^sub>v (vCons a v) = set\<^sub>v v \<union> {a}"
  using vec_mset_set vec_mset_vCons
  by (metis Un_insert_right set_mset_add_mset_insert sup_bot_right)

lemma setv_vec_mset_not_in_iff: "a \<notin> set\<^sub>v v \<longleftrightarrow> a \<notin># vec_mset v"
  by (simp add: vec_mset_set)

text \<open>Abbreviation for counting occurrences of an element in a vector \<close>

abbreviation "count_vec v a \<equiv> count (vec_mset v) a"

lemma vec_count_lt_dim: "count_vec v a \<le> dim_vec v"
  by (metis mset_vec_same_size order_refl set_count_size_min)

lemma count_vec_empty: "dim_vec v = 0 \<Longrightarrow> count_vec v a = 0"
  by (simp add: mset_vec_same_size)

lemma count_vec_vNil: "count_vec vNil a = 0"
  by (simp add: vec_mset_def)

lemma count_vec_vCons: "count_vec (vCons aa v) a = (if (aa = a) then count_vec v a + 1 else count_vec v a)"
  by(simp add: vec_mset_vCons)

lemma elem_exists_count_min: "\<exists> i \<in>{..<dim_vec v}. v $ i = x \<Longrightarrow> count_vec v x \<ge> 1"
  by (simp add: vec_elem_exists_mset)

lemma count_vec_count_mset: "vec_mset v = image_mset f A \<Longrightarrow> count_vec v a = count (image_mset f A) a"
  by (simp)

lemma count_vec_alt_list: "count_vec v a = length (filter (\<lambda>y. a = y) (list_of_vec v))"
  by (simp add: mset_vec_eq_mset_list) (metis count_mset)

lemma count_vec_alt: "count_vec v x = card { i. v $ i = x \<and> i< dim_vec v}"
proof -
  have "count_vec v x = count (image_mset (($) v) (mset_set {..<dim_vec v})) x" by (simp add: vec_mset_def)
  also have "... = size {#a \<in># (image_mset (($) v) (mset_set {..<dim_vec v})) . x = a#}"
    by (simp add: filter_mset_eq)
  also have "... = size {#a \<in># (mset_set {..<dim_vec v}) . x = (v $ a) #}"
    by (simp add: filter_mset_image_mset)
  finally have "count_vec v x = card {a \<in> {..<dim_vec v} . x = (v $ a)}" by simp
  thus ?thesis by (smt (verit) Collect_cong lessThan_iff)
qed

lemma count_vec_sum_ones:
  fixes v :: "'a :: {ring_1} vec"
  assumes "\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v $ i = 0"
  shows "of_nat (count_vec v 1) = sum_vec v"
  using assms
proof (induct v)
  case vNil
  then show ?case
     by (simp add: vec_mset_vNil)
 next
  case (vCons a v)
  then have lim: "dim_vec (vCons a v) \<ge> 1"
    by simp
  have "(\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v$ i = 0)"
    using vCons.prems by force
  then have hyp: "of_nat (count_vec v 1) = sum_vec v"
    using vCons.hyps by blast
  have "sum (($) (vCons a v)) {0..<dim_vec (vCons a v)} = sum_vec (vCons a v)"
    by (simp add: sum_vec_def)
  then have sv: "sum (($) (vCons a v)) {0..<dim_vec (vCons a v)} = sum_vec (v) + a"
    by (simp add: sum_vec_vCons)
  then show ?case using count_vec_vCons dim_vec_vCons_ne_0 sum_vec_vCons vCons.prems
    by (metis add.commute add_0 hyp of_nat_1 of_nat_add vec_index_vCons_0)
qed

lemma count_vec_two_elems:
  fixes v :: "'a :: {zero_neq_one} vec"
  assumes "\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v $ i = 0"
  shows "count_vec v 1 + count_vec v 0 = dim_vec v"
proof -
  have ss: "vec_set v \<subseteq> {0, 1}" using assms by (auto simp add: vec_set_def)
  have "dim_vec v = size (vec_mset v)"
    by (simp add: mset_vec_same_size)
  have "size (vec_mset v) = (\<Sum> x \<in> (vec_set v) . count (vec_mset v) x)"
    by (simp add: vec_mset_set size_multiset_overloaded_eq)
  also have  "... = (\<Sum> x \<in> {0, 1} . count (vec_mset v) x)"
    using size_count_mset_ss ss
    by (metis calculation finite.emptyI finite.insertI vec_mset_set)
  finally have "size (vec_mset v) = count (vec_mset v) 0 + count (vec_mset v) 1" by simp
  thus ?thesis
    by (simp add: \<open>dim_vec v = size (vec_mset v)\<close>)
qed

lemma count_vec_sum_zeros:
  fixes v :: "'a :: {ring_1} vec"
  assumes "\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v $ i = 0"
  shows "of_nat (count_vec v 0) = of_nat (dim_vec v) - sum_vec v"
  using count_vec_two_elems assms count_vec_sum_ones
  by (metis add_diff_cancel_left' of_nat_add)

lemma count_vec_sum_ones_alt:
  fixes v :: "'a :: {ring_1} vec"
  assumes "vec_set v \<subseteq> {0, 1}"
  shows "of_nat (count_vec v 1) = sum_vec v"
proof -
  have "\<And> i. i < dim_vec v \<Longrightarrow> v $ i = 1 \<or> v $ i = 0" using assms
    by (meson insertE singletonD subsetD vec_setI)
  thus ?thesis using count_vec_sum_ones
    by blast
qed

lemma setv_not_in_count0_iff: "a \<notin> set\<^sub>v v \<longleftrightarrow> count_vec v a = 0"
  using setv_vec_mset_not_in_iff
  by (metis count_eq_zero_iff)

lemma sum_count_vec:
  assumes "finite (set\<^sub>v v)"
  shows "(\<Sum> i \<in> set\<^sub>v v. count_vec v i) = dim_vec v"
using assms proof (induct "v")
  case vNil
  then show ?case
    by (simp add: count_vec_empty)
next
  case (vCons a v)
  then show ?case proof (cases "a \<in> set\<^sub>v v")
    case True
    have cv: "\<And> x. x \<in>(set\<^sub>v v) - {a} \<Longrightarrow> count_vec (vCons a v) x = count_vec v x"
      using count_vec_vCons by (metis DiffD2 singletonI)
    then have "sum (count_vec (vCons a v)) (set\<^sub>v (vCons a v)) =  sum (count_vec (vCons a v)) (set\<^sub>v v)"
      using vCons_set_contains_in True by metis
    also have "... = count_vec (vCons a v) a + sum (count_vec (vCons a v)) ((set\<^sub>v v) - {a})"
      using sum.remove True vCons.prems(1) by (metis vCons_set_contains_in)
    also have "... = count_vec v a + 1 + sum (count_vec v) ((set\<^sub>v v) - {a})"
      using cv count_vec_vCons by (metis sum.cong)
    also have "... = 1 + sum (count_vec v) ((set\<^sub>v v))"
      using sum.remove add.commute vCons.prems vCons_set_contains_in True
      by (metis (no_types, opaque_lifting) ab_semigroup_add_class.add_ac(1))
    also have "... = 1 + dim_vec v" using vCons.hyps
      by (metis True vCons.prems vCons_set_contains_in)
    finally show ?thesis by simp
  next
    case False
    then have cv: "\<And> x. x \<in>(set\<^sub>v v) \<Longrightarrow> count_vec (vCons a v) x = count_vec v x"
      using count_vec_vCons by (metis)
    have f: "finite (set\<^sub>v v)"
      using vCons.prems False vCons_set_contains_add by (metis Un_infinite)
    have "sum (count_vec (vCons a v)) (set\<^sub>v (vCons a v)) =
        count_vec (vCons a v) a + sum (count_vec (vCons a v)) (set\<^sub>v v)"
      using False vCons_set_contains_add
      by (metis Un_insert_right finite_Un sum.insert sup_bot_right vCons.prems )
    also have "... = count_vec v a + 1 + sum (count_vec v) ((set\<^sub>v v) )"
      using cv count_vec_vCons by (metis sum.cong)
    also have "... = 1 + sum (count_vec v) ((set\<^sub>v v))"
      using False setv_not_in_count0_iff by (metis add_0)
    finally show ?thesis using vCons.hyps f by simp
  qed
qed

lemma sum_setv_subset_eq:
  assumes "finite A"
  assumes "set\<^sub>v v \<subseteq> A"
  shows "(\<Sum> i \<in> set\<^sub>v v. count_vec v i) = (\<Sum> i \<in> A. count_vec v i)"
proof -
  have ni: "\<And> x. x \<notin> set\<^sub>v v \<Longrightarrow> count_vec v x = 0"
    by (simp add: setv_not_in_count0_iff)
  have "(\<Sum> i \<in> A. count_vec v i) = (\<Sum> i \<in> A - (set\<^sub>v v). count_vec v i) + (\<Sum> i \<in> (set\<^sub>v v). count_vec v i)"
    using sum.subset_diff assms by auto
  then show ?thesis using ni
    by simp
qed

lemma sum_count_vec_subset:  "finite A \<Longrightarrow> set\<^sub>v v \<subseteq> A \<Longrightarrow> (\<Sum> i \<in> A. count_vec v i) = dim_vec v"
  using sum_setv_subset_eq sum_count_vec finite_subset by metis

text \<open>An abbreviation for checking if an element is in a vector \<close>

abbreviation vec_contains :: "'a \<Rightarrow> 'a vec \<Rightarrow> bool" (infix "\<in>$" 50)where
"a \<in>$ v \<equiv> a \<in> set\<^sub>v v"

lemma vec_set_mset_contains_iff: "a \<in>$ v \<longleftrightarrow> a \<in># vec_mset v"
  by (simp add: vec_mset_def vec_set_def)

lemma vec_contains_count_gt1_iff: "a \<in>$ v \<longleftrightarrow> count_vec v a \<ge> 1"
  by (simp add: vec_set_mset_contains_iff)

lemma vec_contains_obtains_index:
  assumes "a \<in>$ v"
  obtains i where "i < dim_vec v" and "v $ i = a"
  by (metis assms vec_setE)

lemma vec_count_eq_list_count: "count (mset xs) a = count_vec (vec_of_list xs) a"
  by (simp add: list_vec mset_vec_eq_mset_list)

lemma vec_contains_col_elements_mat:
  assumes "j < dim_col M"
  assumes "a \<in>$ col M j"
  shows "a \<in> elements_mat M"
proof -
  have "dim_vec (col M j) = dim_row M" by simp
  then obtain i where ilt: "i < dim_row M" and "(col M j) $ i = a"
    using vec_setE by (metis assms(2))
  then have "M $$ (i, j) = a"
    by (simp add: assms(1))
  thus ?thesis using assms(1) ilt
    by blast
qed

lemma vec_contains_row_elements_mat:
  assumes "i < dim_row M"
  assumes "a \<in>$ row M i"
  shows "a \<in> elements_mat M"
proof -
  have "dim_vec (row M i) = dim_col M" by simp
  then obtain j where jlt: "j < dim_col M" and "(row M i) $ j = a" using vec_setE
    by (metis assms(2))
  then have "M $$ (i, j) = a"
    by (simp add: assms(1))
  thus ?thesis using assms(1) jlt
    by blast
qed

lemma vec_contains_img: "a \<in>$ v \<Longrightarrow> f a \<in>$ (map_vec f v)"
  by (metis index_map_vec(1) index_map_vec(2) vec_contains_obtains_index vec_setI)

text \<open> The existing vector library contains the identity and zero vectors, but no definition
of a vector where all elements are 1, as defined below \<close>

definition all_ones_vec ::  "nat \<Rightarrow> 'a :: {zero,one} vec" ("u\<^sub>v") where
  "u\<^sub>v n \<equiv> vec n (\<lambda> i. 1)"

lemma dim_vec_all_ones[simp]: "dim_vec (u\<^sub>v n) = n"
  by (simp add: all_ones_vec_def)

lemma all_ones_index [simp]: "i < n \<Longrightarrow> u\<^sub>v n $ i = 1"
  by (simp add: all_ones_vec_def)

lemma dim_vec_mult_vec_mat [simp]: "dim_vec (v \<^sub>v* A) = dim_col A"
  unfolding mult_vec_mat_def by simp

lemma all_ones_vec_smult[simp]: "i < n \<Longrightarrow> ((k :: ('a :: {one, zero, monoid_mult})) \<cdot>\<^sub>v (u\<^sub>v n)) $ i = k"
  by (simp add: smult_vec_def)

text \<open>Extra lemmas on existing vector operations \<close>

lemma smult_scalar_prod_sum:
  fixes x :: "'a :: {comm_ring_1}"
  assumes "vx \<in> carrier_vec n"
  assumes "vy \<in> carrier_vec n"
  shows "(\<Sum> i \<in> {0..<n} .((x \<cdot>\<^sub>v vx) $ i) * ((y \<cdot>\<^sub>v vy) $ i)) = x * y * (vx \<bullet> vy)"
proof -
  have "\<And> i . i < n \<Longrightarrow> ((x \<cdot>\<^sub>v vx) $ i) * ((y \<cdot>\<^sub>v vy) $ i) = x * y * (vx $ i) * (vy $ i)"
    using assms by simp
  then have "(\<Sum> i \<in> {0..<n} .((x \<cdot>\<^sub>v vx) $ i) * ((y \<cdot>\<^sub>v vy) $ i)) =
      (\<Sum> i \<in> {0..<n} .x * y * (vx $ i) * (vy $ i))"
    by simp
  also have "... = x * y * (\<Sum> i \<in> {0..<n} . (vx $ i) * (vy $ i))"
    using sum_distrib_left[of "x * y" "(\<lambda> i. (vx $ i) * (vy $ i))" "{0..<n}"]
    by (metis (no_types, lifting) mult.assoc sum.cong)
  finally have "(\<Sum> i \<in> {0..<n} .((x \<cdot>\<^sub>v vx) $ i) * ((y \<cdot>\<^sub>v vy) $ i)) = x * y * (vx \<bullet> vy)"
    using scalar_prod_def assms by (metis carrier_vecD)
  thus ?thesis by simp
qed

lemma scalar_prod_double_sum_fn_vec:
  fixes c :: "nat \<Rightarrow> ('a :: {comm_semiring_0})"
  fixes f :: "nat \<Rightarrow> 'a vec"
  assumes "\<And> j . j < k \<Longrightarrow> dim_vec (f j) = n"
  shows "(vec n (\<lambda>i. \<Sum>j = 0..<k. c j * (f j) $ i)) \<bullet> (vec n (\<lambda>i. \<Sum>j = 0..<k. c j * (f j) $ i)) =
    (\<Sum> j1 \<in> {0..<k} . c j1 * c j1 * ((f j1) \<bullet> (f j1))) +
    (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> ({0..< k} - {j1}) . c j1 * c j2 * ((f j1) \<bullet> (f j2))))"
proof -
  have sum_simp: "\<And> j1 j2. (\<Sum>l \<in> {0..<n} . c j1 * (f j1) $ l * (c j2 * (f j2) $ l)) =
    c j1 * c j2 *(\<Sum>l \<in> {0..<n} .  (f j1) $ l * (f j2) $ l)"
  proof -
    fix j1 j2
    have "(\<Sum>l \<in> {0..<n} . c j1 * (f j1) $ l * (c j2 * (f j2) $ l)) =
        (\<Sum>l \<in> {0..<n} . c j1  * c j2 * (f j1) $ l * (f j2) $ l)"
      using mult.commute sum.cong
      by (smt (z3) ab_semigroup_mult_class.mult_ac(1)) (* SLOW *)
    then show "(\<Sum>l \<in> {0..<n} . c j1 * (f j1) $ l * (c j2 * (f j2) $ l)) =
        c j1 * c j2 *(\<Sum>l \<in> {0..<n} .  (f j1) $ l * (f j2) $ l)"
      using sum_distrib_left[of " c j1 * c j2" "\<lambda> l. (f j1) $ l * (f j2) $ l" "{0..<n}"]
      by (metis (no_types, lifting) mult.assoc sum.cong)
  qed
  have "(vec n (\<lambda>i. \<Sum>j = 0..<k. c j * (f j) $ i)) \<bullet> (vec n (\<lambda>i. \<Sum>j = 0..<k. c j * (f j) $ i))
       = (\<Sum> l = 0..<n. (\<Sum>j1 = 0..<k. c j1 * (f j1) $ l) * (\<Sum>j2 = 0..<k. c j2 * (f j2) $ l))"
    unfolding scalar_prod_def by simp
  also have "... = (\<Sum> l \<in> {0..<n} . (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> {0..< k}. c j1 * (f j1) $ l *  (c j2 * (f j2) $ l))))"
    by (metis (no_types) sum_product)
  also have "... = (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> {0..<k} . (\<Sum>l \<in> {0..<n} . c j1 * (f j1) $ l * (c j2 * (f j2) $ l))))"
    using sum_reorder_triple[of "\<lambda> l j1 j2 .(c j1 * (f j1) $ l * (c j2 * (f j2) $ l))" "{0..<k}" "{0..<k}" "{0..<n}"]
    by simp
  also have "... = (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> {0..<k} . c j1 * c j2 * (\<Sum>l \<in> {0..<n} . (f j1) $ l * (f j2) $ l)))"
    using sum_simp by simp
  also have "... = (\<Sum> j1 \<in> {0..<k} . (\<Sum> j2 \<in> {0..<k} . c j1 * c j2 * ((f j1) \<bullet> (f j2))))"
    unfolding scalar_prod_def using dim_col assms by simp
  finally show ?thesis
    using double_sum_split_case by fastforce
qed

lemma vec_prod_zero: "(0\<^sub>v n) \<bullet> (0\<^sub>v n) = 0"
  by simp

lemma map_vec_compose: "map_vec f (map_vec g v) = map_vec (f \<circ> g) v"
  by auto

subsection \<open>Matrix Extras\<close>

text \<open>As with vectors, the all ones mat definition defines the concept of a matrix where all
elements are 1 \<close>

definition all_ones_mat :: "nat \<Rightarrow> 'a :: {zero,one} mat" ("J\<^sub>m") where
  "J\<^sub>m n \<equiv> mat n n (\<lambda> (i,j). 1)"

lemma all_ones_mat_index[simp]: "i < dim_row (J\<^sub>m n) \<Longrightarrow> j < dim_col (J\<^sub>m n) \<Longrightarrow> J\<^sub>m n $$ (i, j)= 1"
  by (simp add: all_ones_mat_def)

lemma all_ones_mat_dim_row[simp]: "dim_row (J\<^sub>m n) = n"
  by (simp add: all_ones_mat_def)

lemma all_ones_mat_dim_col[simp]: "dim_col (J\<^sub>m n) = n"
  by (simp add: all_ones_mat_def)

text \<open>Basic lemmas on existing matrix operations \<close>
lemma index_mult_vec_mat[simp]: "j < dim_col A \<Longrightarrow> (v \<^sub>v* A) $ j = v \<bullet> col A j"
  by (auto simp: mult_vec_mat_def)

lemma transpose_mat_mult_entries: "i < dim_row A \<Longrightarrow> j < dim_row A \<Longrightarrow>
    (A * A\<^sup>T) $$ (i, j) = (\<Sum>k\<in> {0..<(dim_col A)}. (A $$ (i, k)) * (A $$ (j, k)))"
  by (simp add: times_mat_def scalar_prod_def)

lemma transpose_mat_elems: "elements_mat A = elements_mat A\<^sup>T"
  by fastforce

lemma row_elems_subset_mat: "i < dim_row N \<Longrightarrow> vec_set (row N i) \<subseteq> elements_mat N"
  by (auto simp add: vec_set_def elements_matI)

lemma col_elems_subset_mat: "i < dim_col N \<Longrightarrow> vec_set (col N i) \<subseteq> elements_mat N"
  by (auto simp add: vec_set_def elements_matI)

lemma obtain_row_index:
  assumes "r \<in> set (rows M)"
  obtains i where "row M i = r" and "i < dim_row M"
  by (metis assms in_set_conv_nth length_rows nth_rows)

lemma row_prop_cond: "(\<And> i. i < dim_row M \<Longrightarrow> P (row M i)) \<Longrightarrow> r \<in> set (rows M) \<Longrightarrow> P r"
  using obtain_row_index by metis

lemma obtain_col_index:
  assumes "c \<in> set (cols M)"
  obtains j where "col M j = c" and "j < dim_col M"
  by (metis assms cols_length cols_nth obtain_set_list_item)

lemma col_prop_cond: "(\<And> j. j < dim_col M \<Longrightarrow> P (col M j)) \<Longrightarrow> c \<in> set (cols M) \<Longrightarrow> P c"
  using obtain_col_index by metis

text \<open> Lemmas on the @{term "map_mat"} definition \<close>

lemma row_map_mat[simp]:
  assumes "i < dim_row A" shows "row (map_mat f A) i = map_vec f (row A i)"
  unfolding map_mat_def map_vec_def using assms by auto

lemma map_vec_mat_rows: "map (map_vec f) (rows M) = rows ((map_mat f) M)"
  by (simp add: map_nth_eq_conv)

lemma map_vec_mat_cols: "map (map_vec f) (cols M) = cols ((map_mat f) M)"
  by (simp add: map_nth_eq_conv)

lemma map_mat_compose: "map_mat f (map_mat g A) = map_mat (f \<circ> g) A"
  by (auto)

lemmas map_mat_elements = elements_mat_map

text \<open> Reasoning on sets and multisets of matrix elements \<close>
lemma set_cols_carrier: "A \<in> carrier_mat m n \<Longrightarrow> v \<in> set (cols A) \<Longrightarrow> v \<in> carrier_vec m"
  by (auto simp: cols_def)

lemma mset_cols_index_map:  "image_mset (\<lambda> j. col M j) (mset_set {0..< dim_col M}) = mset (cols M)"
  by (simp add: cols_def)

lemma mset_rows_index_map:  "image_mset (\<lambda> i. row M i) (mset_set {0..< dim_row M}) = mset (rows M)"
  by (simp add: rows_def)

lemma index_to_col_card_size_prop:
  assumes "i < dim_row M"
  assumes "\<And> j. j < dim_col M \<Longrightarrow> P j \<longleftrightarrow> Q (col M j)"
  shows "card {j . j < dim_col M \<and> P j} = size {#c \<in># (mset (cols M)) . Q c #}"
proof -
  have "card {j . j < dim_col M \<and> P j} = size (mset_set({j \<in> {0..<dim_col M}.  P j}))"
    by simp
  also have "... = size (mset_set({j \<in> {0..<dim_col M}.  Q (col M j)}))"
    using assms(2)
    by (metis lessThan_atLeast0 lessThan_iff)
  also have "... = size (image_mset (\<lambda> j. col M j)  {# j \<in># mset_set {0..< dim_col M} . Q (col M j) #})"
    by simp
  also have "... = size ({# c \<in># (image_mset (\<lambda> j. col M j) (mset_set {0..< dim_col M})) .  Q c #})"
    using image_mset_filter_swap[of "(\<lambda> j. col M j)"  "Q" "(mset_set {0..< dim_col M})"] by simp
  finally have "card {j . j < dim_col M \<and> P j} = size ({# c \<in># (mset (cols M)) .  Q c #})"
    using mset_cols_index_map by metis
  thus ?thesis by simp
qed

lemma index_to_row_card_size_prop:
  assumes "j < dim_col M"
  assumes "\<And> i. i < dim_row M \<Longrightarrow> P i \<longleftrightarrow> Q (row M i)"
  shows "card {i . i < dim_row M \<and> P i} = size {#r \<in># (mset (rows M)) . Q r #}"
proof -
  have "card {i . i < dim_row M \<and> P i} = size (mset_set({i \<in> {0..<dim_row M}.  P i}))"
    by simp
  also have "... = size (mset_set({i \<in> {0..<dim_row M}.  Q (row M i)}))"
    using assms(2)
    by (metis lessThan_atLeast0 lessThan_iff)
  also have "... = size (image_mset (\<lambda> i. row M i)  {# i \<in># mset_set {0..< dim_row M} . Q (row M i) #})"
    by simp
  also have "... = size ({# r \<in># (image_mset (\<lambda> i. row M i) (mset_set {0..< dim_row M})) .  Q r #})"
    using image_mset_filter_swap[of "(\<lambda> j. row M j)"  "Q" "(mset_set {0..< dim_row M})"] by simp
  finally have "card {j . j < dim_row M \<and> P j} = size ({# c \<in># (mset (rows M)) .  Q c #})"
    using mset_rows_index_map by metis
  thus ?thesis by simp
qed

lemma setv_row_subset_mat_elems:
  assumes "v \<in> set (rows M)"
  shows "set\<^sub>v v \<subseteq> elements_mat M"
proof (intro subsetI)
  fix x assume "x \<in>$ v"
  then obtain i where "v = row M i" and "i < dim_row M"
    by (metis assms obtain_row_index)
  then show "x \<in> elements_mat M"
    by (metis \<open>x \<in>$ v\<close> vec_contains_row_elements_mat)
qed

lemma setv_col_subset_mat_elems:
  assumes "v \<in> set (cols M)"
  shows "set\<^sub>v v \<subseteq> elements_mat M"
proof (intro subsetI)
  fix x assume "x \<in>$ v"
  then obtain i where "v = col M i" and "i < dim_col M"
    by (metis assms obtain_col_index)
  then show "x \<in> elements_mat M"
    by (metis \<open>x \<in>$ v\<close> vec_contains_col_elements_mat)
qed

subsection \<open> Vector and Matrix Homomorphism \<close>

text \<open>We extend on the existing lemmas on homomorphism mappings as applied to vectors and matrices \<close>

context semiring_hom
begin

lemma  vec_hom_smult2:
  assumes "dim_vec v2 \<le> dim_vec v1"
  shows "hom (v1 \<bullet> v2) = vec\<^sub>h v1 \<bullet> vec\<^sub>h v2"
  unfolding scalar_prod_def using index_map_vec assms by (auto simp add: hom_distribs)

end

lemma map_vec_vCons: "vCons (f a) (map_vec f v) = map_vec f (vCons a v)"
  by (intro eq_vecI, simp_all add: vec_index_vCons)

context inj_zero_hom
begin

lemma  vec_hom_zero_iff[simp]: "(map_vec hom x = 0\<^sub>v n) = (x = 0\<^sub>v n)"
proof -
  {
    fix i
    assume i: "i < n" "dim_vec x = n"
    hence "map_vec hom x $ i = 0 \<longleftrightarrow> x $ i = 0"
      using index_map_vec(1)[of i x] by simp
  } note main = this
  show ?thesis unfolding vec_eq_iff by (simp, insert main, auto)
qed

lemma  mat_hom_inj: "map_mat hom A = map_mat hom B \<Longrightarrow> A = B"
  unfolding mat_eq_iff by auto

lemma  vec_hom_inj: "map_vec hom v = map_vec hom w \<Longrightarrow> v = w"
  unfolding vec_eq_iff by auto

lemma  vec_hom_set_distinct_iff:
  fixes xs :: "'a vec list"
  shows "distinct xs \<longleftrightarrow> distinct (map (map_vec hom) xs)"
  using vec_hom_inj by (induct xs) (auto)

lemma vec_hom_mset: "image_mset hom (vec_mset v) = vec_mset (map_vec hom v)"
  apply (induction v)
   apply (metis mset.simps(1) vec_mset_img_map vec_mset_vNil vec_of_list_Nil)
  by (metis mset_vec_eq_mset_list vec_list vec_mset_img_map)

lemma vec_hom_set: "hom ` set\<^sub>v v = set\<^sub>v (map_vec hom v)"
proof (induct v)
  case vNil
  then show ?case by (metis image_mset_empty set_image_mset vec_hom_zero_iff vec_mset_set vec_mset_vNil zero_vec_zero)
next
  case (vCons a v)
  have "hom ` set\<^sub>v (vCons a v) = hom ` ({a} \<union> set\<^sub>v v)"
    by (metis Un_commute insert_absorb insert_is_Un vCons_set_contains_add vCons_set_contains_in)
  also have "... = {hom a} \<union> (hom ` (set\<^sub>v v))" by simp
  also have "... = {hom a} \<union> (set\<^sub>v (map_vec hom v))" using vCons.hyps by simp
  also have "... = set\<^sub>v (vCons (hom a) (map_vec hom v))"
    by (metis Un_commute insert_absorb insert_is_Un vCons_set_contains_add vCons_set_contains_in)
  finally show ?case using map_vec_vCons
    by metis
qed

end

subsection \<open> Zero One injections and homomorphisms \<close>

text \<open>Define a locale to encapsulate when a function is injective on a certain set (i.e. not
a universal homomorphism for the type\<close>
locale injective_lim =
  fixes A :: "'a set"
  fixes f :: "'a \<Rightarrow> 'b" assumes injectivity_lim: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f x = f y \<Longrightarrow> x = y"
begin
  lemma eq_iff[simp]: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f x = f y \<longleftrightarrow> x = y" using injectivity_lim by auto
lemma inj_on_f: "inj_on f A" by (auto intro: inj_onI)

end

sublocale injective \<subseteq> injective_lim Univ
  by(unfold_locales) simp

context injective_lim
begin

lemma mat_hom_inj_lim:
  assumes "elements_mat M \<subseteq> A" and "elements_mat N \<subseteq> A"
  shows "map_mat f M = map_mat f N \<Longrightarrow> M = N"
  unfolding mat_eq_iff apply auto
  using assms injectivity_lim by blast

lemma vec_hom_inj_lim: assumes "set\<^sub>v v \<subseteq> A" "set\<^sub>v w \<subseteq> A"
  shows "map_vec f v = map_vec f w \<Longrightarrow> v = w"
  unfolding vec_eq_iff apply (auto)
  using vec_setI in_mono assms injectivity_lim by metis

lemma lim_inj_hom_count_vec:
  assumes "set\<^sub>v v \<subseteq> A"
  assumes "x \<in> A"
  shows "count_vec v x = count_vec (map_vec f v) (f x)"
using assms proof (induct v)
  case vNil
  have "(map_vec f vNil) = vNil" by auto
  then show ?case
    by (smt (verit) count_vec_vNil)
next
  case (vCons a v)
  have 1: "map_vec f (vCons a v) = vCons (f a) (map_vec f v)"
    by (simp add: map_vec_vCons)
  then show ?case proof (cases "a = x")
    case True
    have "count_vec (vCons a v) x = count_vec v x + 1"
      by (simp add: True count_vec_vCons)
    then show ?thesis using Un_subset_iff 1 count_vec_vCons vCons.hyps vCons.prems(1)
          vCons.prems(2) vCons_set_contains_add vCons_set_contains_in
      by metis
  next
    case False
    then have "count_vec (vCons a v) x = count_vec v x"
      by (simp add: count_vec_vCons)
    then show ?thesis using "1" Un_empty_right Un_insert_right count_vec_vCons insert_absorb insert_subset
          vCons.hyps vCons.prems(1) vCons.prems(2) vCons_set_contains_add vCons_set_contains_in
      by (metis (no_types, lifting) injectivity_lim)
  qed
qed

lemma vec_hom_lim_set_distinct_iff:
  fixes xs :: "'a vec list"
  assumes "\<And> v . v \<in> set (xs) \<Longrightarrow> set\<^sub>v v \<subseteq> A"
  shows "distinct xs \<longleftrightarrow> distinct (map (map_vec f) xs)"
  using assms vec_hom_inj_lim by (induct xs, simp_all) (metis (no_types, lifting) image_iff)

lemma mat_rows_hom_lim_distinct_iff:
  assumes "elements_mat M \<subseteq> A"
  shows "distinct (rows M) \<longleftrightarrow> distinct (map (map_vec f) (rows M))"
  apply (intro vec_hom_lim_set_distinct_iff)
  using setv_row_subset_mat_elems assms by blast

lemma mat_cols_hom_lim_distinct_iff:
  assumes "elements_mat M \<subseteq> A"
  shows "distinct (cols M) \<longleftrightarrow> distinct (map (map_vec f) (cols M))"
  apply (intro vec_hom_lim_set_distinct_iff)
  using setv_col_subset_mat_elems assms by blast

end

locale inj_on_01_hom = zero_hom + one_hom + injective_lim "{0, 1}" hom
begin

lemma inj_0_iff: "x \<in> {0, 1} \<Longrightarrow> hom x = 0 \<longleftrightarrow> x = 0"
  by (metis hom_zero insertI1 local.eq_iff)

lemma inj_1_iff: "x \<in> {0, 1} \<Longrightarrow> hom x = 1 \<longleftrightarrow> x = 1"
  using inj_0_iff by fastforce

end

context zero_neq_one
begin

definition of_zero_neq_one :: "'b :: {zero_neq_one} \<Rightarrow> 'a" where
"of_zero_neq_one x \<equiv> if (x = 0) then 0 else 1"

lemma of_zero_neq_one_1 [simp]: "of_zero_neq_one 1 = 1"
  by (simp add: of_zero_neq_one_def)

lemma of_zero_neq_one_0 [simp]:  "of_zero_neq_one 0 = 0"
  by (simp add: of_zero_neq_one_def)

lemma of_zero_neq_one_0_iff[iff]: "of_zero_neq_one x = 0 \<longleftrightarrow> x = 0"
  by (simp add: of_zero_neq_one_def)

lemma of_zero_neq_one_lim_eq: "x \<in> {0, 1} \<Longrightarrow> y \<in> {0, 1} \<Longrightarrow> of_zero_neq_one x = of_zero_neq_one y \<longleftrightarrow> x = y"
  by (auto simp add: of_zero_neq_one_def)

end

interpretation of_zero_hom: zero_hom_0 of_zero_neq_one
  by(unfold_locales) (simp_all)

interpretation of_injective_lim: injective_lim "{0, 1}" of_zero_neq_one
  by (unfold_locales)(simp_all add: of_zero_neq_one_lim_eq)

interpretation of_inj_on_01_hom: inj_on_01_hom of_zero_neq_one
  by (unfold_locales)(simp_all add: of_zero_neq_one_lim_eq)

text \<open>We want the ability to transform any 0-1 vector or matrix to another @{typ "'c :: zero_neq_one"} type \<close>
definition lift_01_vec :: "'b :: {zero_neq_one} vec \<Rightarrow> 'c :: {zero_neq_one} vec" where
"lift_01_vec v \<equiv> map_vec of_zero_neq_one v"

lemma lift_01_vec_simp[simp]: "dim_vec (lift_01_vec v) = dim_vec v"
"i < dim_vec v \<Longrightarrow> (lift_01_vec v) $ i = of_zero_neq_one (v $ i)"
  by (simp_all add: lift_01_vec_def)

lemma lift_01_vec_count:
  assumes "set\<^sub>v v \<subseteq> {0, 1}"
  assumes "x \<in> {0, 1}"
  shows "count_vec v x = count_vec (lift_01_vec v) (of_zero_neq_one x)"
  using of_injective_lim.lim_inj_hom_count_vec
  by (metis assms(1) assms(2) lift_01_vec_def)

definition lift_01_mat :: "'b :: {zero_neq_one} mat \<Rightarrow> 'c :: {zero_neq_one} mat" where
"lift_01_mat M \<equiv> map_mat of_zero_neq_one M"

lemma lift_01_mat_simp[simp]: "dim_row (lift_01_mat M) = dim_row M"
  "dim_col (lift_01_mat M) = dim_col M"
  "i < dim_row M \<Longrightarrow> j < dim_col M \<Longrightarrow> (lift_01_mat M) $$ (i, j) = of_zero_neq_one (M $$ (i, j))"
  by (simp_all add: lift_01_mat_def)

lemma lift_01_mat_carrier: "lift_01_mat M \<in> carrier_mat (dim_row M) (dim_col M)"
  using lift_01_mat_def by auto

end


theory AExp imports Main begin

type_synonym vname = string
type_synonym val = int
type_synonym state = "vname \<Rightarrow> val"

datatype aexp = N int | V vname | Plus aexp aexp

fun aval :: "aexp \<Rightarrow> state \<Rightarrow> val" where
"aval (N n) s        = n                    " |
"aval (V x) s        = s x                  " |
"aval (Plus a1 a2) s = aval a1 s + aval a2 s"

value "aval (Plus (N 3) (V ''x'')) (\<lambda>x. 7)"
value "aval (Plus (N 3) (V ''x'')) ((\<lambda>x. 0) (''x'' := 7))"

definition null_state ("<>") where
  "null_state \<equiv> \<lambda>x. 0"
syntax
  "_State" :: "updbinds => 'a" ("<_>")
translations
  "_State ms" == "_Update <> ms"
  "_State (_updbinds b bs)" <= "_Update (_State b) bs"

value "aval (Plus (V ''x'') (N 3)) <''x'' := 7>"

(* Constant Folding *)

(* Constant folding in a bottom-up manner: *)
fun asimp_const :: "aexp \<Rightarrow> aexp" where
"asimp_const (N n) = N n" |
"asimp_const (V x) = V x" |
"asimp_const (Plus a1 a2) =
  (case (asimp_const a1, asimp_const a2) of
    (N n1, N n2) \<Rightarrow> N (n1 + n2) |
    (b1, b2) \<Rightarrow> Plus b1 b2)"

(* Correctness meas that asimp_const does not change the semantics,
   that is, the value of its argument: *)
theorem aval_asimp_const:
    "aval (asimp_const a) s = aval a s"
  apply (induction a)
  apply (auto split: aexp.split)
done

(* Eliminate all occurrences of 0 in additions.
   Method: optimised versions of the constructors: *)
fun plus :: "aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
"plus (N i1) (N i2) = N (i1 + i2)" |
"plus (N i) a = (if i=0 then a else Plus (N i) a)" |
"plus a (N i) = (if i=0 then a else Plus a (N i))" |
"plus a1 a2 = Plus a1 a2"

(* It behaves like Plus under evaluation: *)
lemma aval_plus [simp]:
    "aval (plus a1 a2) s = aval a1 s + aval a2 s"
  apply (induction a1 a2 rule: plus.induct)
  apply auto
done

(* Replace Plus by plus in a bottom-up manner: *)
fun asimp :: "aexp \<Rightarrow> aexp" where
"asimp (N n) = N n" |
"asimp (V x) = V x" |
"asimp (Plus a1 a2) = plus (asimp a1) (asimp a2)"

value "asimp (Plus (Plus (N 0) (N 0)) (Plus (V ''x'') (N 0)))"

theorem aval_asimp [simp]:
    "aval (asimp a) s = aval a s"
  apply (induction a)
  apply auto
done

end