diff --git a/thys/DynamicArchitectures/Configuration_Traces.thy b/thys/DynamicArchitectures/Configuration_Traces.thy
--- a/thys/DynamicArchitectures/Configuration_Traces.thy
+++ b/thys/DynamicArchitectures/Configuration_Traces.thy
@@ -1,1803 +1,1804 @@
 (*
   Title:      Configuration_Traces.thy
   Author:     Diego Marmsoler
 *)
 section "A Theory of Dynamic Architectures"
 text \<open>
   The following theory formalizes configuration traces~\cite{Marmsoler2016a,Marmsoler2016} as a model for dynamic architectures.
   Since configuration traces may be finite as well as infinite, the theory depends on Lochbihler's theory of co-inductive lists~\cite{Lochbihler2010}.
 \<close>
 theory Configuration_Traces
   imports Coinductive.Coinductive_List
 begin
 text \<open>
   In the following we first provide some preliminary results for natural numbers, extended natural numbers, and lazy lists.
   Then, we introduce a locale @text{dynamic\_architectures} which introduces basic definitions and corresponding properties for dynamic architectures.
 \<close>
   
 subsection "Natural Numbers"
 text \<open>
   We provide one additional property for natural numbers.
 \<close>
 lemma boundedGreatest:
   assumes "P (i::nat)"
     and "\<forall>n' > n. \<not> P n'"
   shows "\<exists>i'\<le>n. P i' \<and> (\<forall>n'. P n' \<longrightarrow> n'\<le>i')"
 proof -
   have "P (i::nat) \<Longrightarrow> n\<ge>i \<Longrightarrow> \<forall>n' > n. \<not> P n' \<Longrightarrow> (\<exists>i'\<le>n. P i' \<and> (\<forall>n'\<le>n. P n' \<longrightarrow> n'\<le>i'))"
   proof (induction n)
     case 0
     then show ?case by auto
   next
     case (Suc n)
     then show ?case
     proof cases
       assume "i = Suc n"
       then show ?thesis using Suc.prems by auto
     next
       assume "\<not>(i = Suc n)"
       thus ?thesis
       proof cases
         assume "P (Suc n)"
         thus ?thesis by auto
       next
         assume "\<not> P (Suc n)"
         with Suc.prems have "\<forall>n' > n. \<not> P n'" using Suc_lessI by blast
         moreover from \<open>\<not>(i = Suc n)\<close> have "i \<le> n" and "P i" using Suc.prems by auto
         ultimately obtain i' where "i'\<le>n \<and> P i' \<and> (\<forall>n'\<le>n. P n' \<longrightarrow> n' \<le> i')" using Suc.IH by blast
         hence "i' \<le> n" and "P i'" and "(\<forall>n'\<le>n. P n' \<longrightarrow> n' \<le> i')" by auto
         thus ?thesis by (metis le_SucI le_Suc_eq)
       qed
     qed
   qed
   moreover have "n\<ge>i"
   proof (rule ccontr)
     assume "\<not> (n \<ge> i)"
     hence "n < i" by arith
     thus False using assms by blast
   qed
   ultimately obtain i' where "i'\<le>n" and "P i'" and "\<forall>n'\<le>n. P n' \<longrightarrow> n' \<le> i'" using assms by blast
   with assms have "\<forall>n'. P n' \<longrightarrow> n' \<le> i'" using not_le_imp_less by blast
   with \<open>i' \<le> n\<close> and \<open>P i'\<close> show ?thesis by auto
 qed
 
 subsection "Extended Natural Numbers"
 text \<open>
   We provide one simple property for the \emph{strict} order over extended natural numbers.
 \<close>
 lemma enat_min:
   assumes "m \<ge> enat n'"
     and "enat n < m - enat n'"
   shows "enat n + enat n' < m" 
   using assms by (metis add.commute enat.simps(3) enat_add_mono enat_add_sub_same le_iff_add)
 
 subsection "Lazy Lists"
 text \<open>
   In the following we provide some additional notation and properties for lazy lists.
 \<close>
 notation LNil ("[]\<^sub>l")
 notation LCons (infixl "#\<^sub>l" 60)
 notation lappend (infixl "@\<^sub>l" 60)
 
 lemma lnth_lappend[simp]:
   assumes "lfinite xs"
     and "\<not> lnull ys"
   shows "lnth (xs @\<^sub>l ys) (the_enat (llength xs)) = lhd ys"
 proof -
   from assms have "\<exists>k. llength xs = enat k" using lfinite_conv_llength_enat by auto
   then obtain k where "llength xs = enat k" by blast
   hence "lnth (xs @\<^sub>l ys) (the_enat (llength xs)) = lnth ys 0"
     using lnth_lappend2[of xs k k ys] by simp
   with assms show ?thesis using lnth_0_conv_lhd by simp
 qed
 
 lemma lfilter_ltake:
   assumes "\<forall>(n::nat)\<le>llength xs. n\<ge>i \<longrightarrow> (\<not> P (lnth xs n))"
   shows "lfilter P xs = lfilter P (ltake i xs)"
 proof -
   have "lfilter P xs = lfilter P ((ltake i xs) @\<^sub>l (ldrop i xs))"
     using lappend_ltake_ldrop[of "(enat i)" xs] by simp
   hence "lfilter P xs = (lfilter P ((ltake i) xs)) @\<^sub>l (lfilter P (ldrop i xs))" by simp
   show ?thesis
   proof cases
     assume "enat i \<le> llength xs"
   
     have "\<forall>x<llength (ldrop i xs). \<not> P (lnth (ldrop i xs) x)"
     proof (rule allI)
       fix x show "enat x < llength (ldrop (enat i) xs) \<longrightarrow> \<not> P (lnth (ldrop (enat i) xs) x)"
       proof
         assume "enat x < llength (ldrop (enat i) xs)"
         moreover have "llength (ldrop (enat i) xs) = llength xs - enat i"
           using llength_ldrop[of "enat i"] by simp
         ultimately have "enat x < llength xs - enat i" by simp
         with \<open>enat i \<le> llength xs\<close> have "enat x + enat i < llength xs"
           using enat_min[of i "llength xs" x] by simp
         moreover have "enat i + enat x = enat x + enat i" by simp
         ultimately have "enat i + enat x < llength xs" by arith
         hence "i + x < llength xs" by simp
         hence "lnth (ldrop i xs) x = lnth xs (x + the_enat i)" using lnth_ldrop[of "enat i" "x" xs] by simp
         moreover have "x + i \<ge> i" by simp
         with assms \<open>i + x < llength xs\<close> have "\<not> P (lnth xs (x + the_enat i))"
           by (simp add: assms(1) add.commute)
         ultimately show "\<not> P (lnth (ldrop i xs) x)" using assms by simp
       qed
     qed
     hence "lfilter P (ldrop i xs) = []\<^sub>l" by (metis diverge_lfilter_LNil in_lset_conv_lnth)
     with \<open>lfilter P xs = (lfilter P ((ltake i) xs)) @\<^sub>l (lfilter P (ldrop i xs))\<close>
       show "lfilter P xs = lfilter P (ltake i xs)" by simp
   next
     assume "\<not> enat i \<le> llength xs"
     hence "enat i > llength xs" by simp
     hence "ldrop i xs = []\<^sub>l" by simp
     hence "lfilter P (ldrop i xs) = []\<^sub>l" using lfilter_LNil[of P] by arith
     with \<open>lfilter P xs = (lfilter P ((ltake i) xs)) @\<^sub>l (lfilter P (ldrop i xs))\<close>
       show "lfilter P xs = lfilter P (ltake i xs)" by simp        
   qed
 qed
 
 lemma lfilter_lfinite[simp]:
   assumes "lfinite (lfilter P t)"
     and "\<not> lfinite t"
   shows "\<exists>n. \<forall>n'>n. \<not> P (lnth t n')"
 proof -
   from assms have "finite {n. enat n < llength t \<and> P (lnth t n)}" using lfinite_lfilter by auto
   then obtain k
     where sset: "{n. enat n < llength t \<and> P (lnth t n)} \<subseteq> {n. n<k \<and> enat n < llength t \<and> P (lnth t n)}"
     using finite_nat_bounded[of "{n. enat n < llength t \<and> P (lnth t n)}"] by auto
   show ?thesis
   proof (rule ccontr)
     assume "\<not>(\<exists>n. \<forall>n'>n. \<not> P (lnth t n'))"
     hence "\<forall>n. \<exists>n'>n. P (lnth t n')" by simp
     then obtain n' where "n'>k" and "P (lnth t n')" by auto
     moreover from \<open>\<not> lfinite t\<close> have "n' < llength t" by (simp add: not_lfinite_llength)
     ultimately have "n' \<notin> {n. n<k \<and> enat n < llength t \<and> P (lnth t n)}" and
       "n'\<in>{n. enat n < llength t \<and> P (lnth t n)}" by auto
     with sset show False by auto
   qed
 qed
 
 subsection "Specifying Dynamic Architectures"
 text \<open>
   In the following we formalize dynamic architectures in terms of configuration traces, i.e., sequences of architecture configurations.
   Moreover, we introduce definitions for operations to support the specification of configuration traces.
 \<close>
 typedecl cnf
 type_synonym trace = "nat \<Rightarrow> cnf"
 consts arch:: "trace set"
 
 type_synonym cta = "trace \<Rightarrow> nat \<Rightarrow> bool"
 
 subsubsection "Implication"
 
 definition imp :: "cta \<Rightarrow> cta \<Rightarrow> cta" (infixl "\<longrightarrow>\<^sup>c" 10)
   where "\<gamma> \<longrightarrow>\<^sup>c \<gamma>' \<equiv> \<lambda> t n. \<gamma> t n \<longrightarrow> \<gamma>' t n"
 
 declare imp_def[simp]
 
 lemma impI[intro!]:
   fixes t n
   assumes "\<gamma> t n \<Longrightarrow> \<gamma>' t n"
   shows "(\<gamma> \<longrightarrow>\<^sup>c \<gamma>') t n" using assms by simp
 
 lemma impE[elim!]:
   fixes t n
   assumes "(\<gamma> \<longrightarrow>\<^sup>c \<gamma>') t n" and "\<gamma> t n" and "\<gamma>' t n \<Longrightarrow> \<gamma>'' t n"
   shows "\<gamma>'' t n" using assms by simp
 
 subsubsection "Disjunction"  
     
 definition disj :: "cta \<Rightarrow> cta \<Rightarrow> cta" (infixl "\<or>\<^sup>c" 15)
   where "\<gamma> \<or>\<^sup>c \<gamma>' \<equiv> \<lambda> t n. \<gamma> t n \<or> \<gamma>' t n"
 
 declare disj_def[simp]
 
 lemma disjI1[intro]:
   assumes "\<gamma> t n"
   shows "(\<gamma> \<or>\<^sup>c \<gamma>') t n" using assms by simp
 
 lemma disjI2[intro]:
   assumes "\<gamma>' t n"
   shows "(\<gamma> \<or>\<^sup>c \<gamma>') t n" using assms by simp
 
 lemma disjE[elim!]:
   assumes "(\<gamma> \<or>\<^sup>c \<gamma>') t n"
     and "\<gamma> t n \<Longrightarrow> \<gamma>'' t n"
     and "\<gamma>' t n \<Longrightarrow> \<gamma>'' t n"
   shows "\<gamma>'' t n" using assms by auto
 
 subsubsection "Conjunction"
   
 definition conj :: "cta \<Rightarrow> cta \<Rightarrow> cta" (infixl "\<and>\<^sup>c" 20)
   where "\<gamma> \<and>\<^sup>c \<gamma>' \<equiv> \<lambda> t n. \<gamma> t n \<and> \<gamma>' t n"
 
 declare conj_def[simp]
 
 lemma conjI[intro!]:
   fixes n
   assumes "\<gamma> t n" and "\<gamma>' t n"
   shows "(\<gamma> \<and>\<^sup>c \<gamma>') t n" using assms by simp
 
 lemma conjE[elim!]:
   fixes n
   assumes "(\<gamma> \<and>\<^sup>c \<gamma>') t n" and "\<gamma> t n \<Longrightarrow> \<gamma>' t n \<Longrightarrow> \<gamma>'' t n"
   shows "\<gamma>'' t n" using assms by simp
 
 subsubsection "Negation"
   
 definition neg :: "cta \<Rightarrow> cta" ("\<not>\<^sup>c _" [19] 19)
   where "\<not>\<^sup>c \<gamma> \<equiv> \<lambda> t n. \<not> \<gamma> t n"
 
 declare neg_def[simp]
 
 lemma negI[intro!]:
   assumes "\<gamma> t n \<Longrightarrow> False"
   shows "(\<not>\<^sup>c \<gamma>) t n" using assms by auto
 
 lemma negE[elim!]:
   assumes "(\<not>\<^sup>c \<gamma>) t n"
     and "\<gamma> t n"
   shows "\<gamma>' t n" using assms by simp
 
 subsubsection "Quantifiers"
 
 definition all :: "('a \<Rightarrow> cta)
   \<Rightarrow> cta" (binder "\<forall>\<^sub>c" 10)
   where "all P \<equiv> \<lambda>t n. (\<forall>y. (P y t n))"
 
 declare all_def[simp]
 
 lemma allI[intro!]:
   assumes "\<And>x. \<gamma> x t n"
   shows "(\<forall>\<^sub>cx. \<gamma> x) t n" using assms by simp
 
 lemma allE[elim!]:
   fixes n
   assumes "(\<forall>\<^sub>cx. \<gamma> x) t n" and "\<gamma> x t n \<Longrightarrow> \<gamma>' t n"
   shows "\<gamma>' t n" using assms by simp
 
 definition ex :: "('a \<Rightarrow> cta)
   \<Rightarrow> cta" (binder "\<exists>\<^sub>c" 10)
   where "ex P \<equiv> \<lambda>t n. (\<exists>y. (P y t n))"
 
 declare ex_def[simp]
 
 lemma exI[intro!]:
   assumes "\<gamma> x t n"
   shows "(\<exists>\<^sub>cx. \<gamma> x) t n" using assms HOL.exI by simp
 
 lemma exE[elim!]:
   assumes "(\<exists>\<^sub>cx. \<gamma> x) t n" and "\<And>x. \<gamma> x t n \<Longrightarrow> \<gamma>' t n"
   shows "\<gamma>' t n" using assms HOL.exE by auto
 
 subsubsection "Atomic Assertions"
 text \<open>
   First we provide rules for basic behavior assertions.
 \<close>
 
 definition ca :: "(cnf \<Rightarrow> bool) \<Rightarrow> cta"
   where "ca \<phi> \<equiv> \<lambda> t n. \<phi> (t n)"
 
 lemma caI[intro]:
   fixes n
   assumes "\<phi> (t n)"
   shows "(ca \<phi>) t n" using assms ca_def by simp
 
 lemma caE[elim]:
   fixes n
   assumes "(ca \<phi>) t n"
   shows "\<phi> (t n)" using assms ca_def by simp
 
 subsubsection "Next Operator"
 
 definition nxt :: "cta \<Rightarrow> cta" ("\<circle>\<^sub>c(_)" 24)
   where "\<circle>\<^sub>c(\<gamma>) \<equiv> \<lambda>(t::(nat \<Rightarrow> cnf)) n. \<gamma> t (Suc n)"
 
 subsubsection "Eventually Operator"  
 
 definition evt :: "cta \<Rightarrow> cta" ("\<diamond>\<^sub>c(_)" 23)
   where "\<diamond>\<^sub>c(\<gamma>) \<equiv> \<lambda>(t::(nat \<Rightarrow> cnf)) n. \<exists>n'\<ge>n. \<gamma> t n'"
 
 subsubsection "Globally Operator"
 
 definition glob :: "cta \<Rightarrow> cta" ("\<box>\<^sub>c(_)" 22)
   where "\<box>\<^sub>c(\<gamma>) \<equiv> \<lambda>(t::(nat \<Rightarrow> cnf)) n. \<forall>n'\<ge>n. \<gamma> t n'"
 
 lemma globI[intro!]:
   fixes n'
   assumes "\<forall>n\<ge>n'. \<gamma> t n"
   shows "(\<box>\<^sub>c(\<gamma>)) t n'" using assms glob_def by simp
 
 lemma globE[elim!]:
   fixes n n'
   assumes "(\<box>\<^sub>c(\<gamma>)) t n" and "n'\<ge>n"
   shows "\<gamma> t n'" using assms glob_def by simp
 
 subsubsection "Until Operator"
 
 definition until :: "cta \<Rightarrow> cta \<Rightarrow> cta" (infixl "\<UU>\<^sub>c" 21)
   where "\<gamma>' \<UU>\<^sub>c \<gamma> \<equiv> \<lambda>(t::(nat \<Rightarrow> cnf)) n. \<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>' t n')"
 
 lemma untilI[intro]:
   fixes n
   assumes "\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n'<n'' \<longrightarrow> \<gamma>' t n')"
   shows "(\<gamma>' \<UU>\<^sub>c \<gamma>) t n" using assms until_def by simp
 
 lemma untilE[elim]:
   fixes n
   assumes "(\<gamma>' \<UU>\<^sub>c \<gamma>) t n"
   shows "\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n'<n'' \<longrightarrow> \<gamma>' t n')" using assms until_def by simp
 
 subsubsection "Weak Until"
 
 definition wuntil :: "cta \<Rightarrow> cta \<Rightarrow> cta" (infixl "\<WW>\<^sub>c" 20)
   where "\<gamma>' \<WW>\<^sub>c \<gamma> \<equiv> \<gamma>' \<UU>\<^sub>c \<gamma> \<or>\<^sup>c \<box>\<^sub>c(\<gamma>')"
 
 lemma wUntilI[intro]:
   fixes n
   assumes "(\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n'<n'' \<longrightarrow> \<gamma>' t n')) \<or> (\<forall>n'\<ge>n. \<gamma>' t n')"
   shows "(\<gamma>' \<WW>\<^sub>c \<gamma>) t n" using assms wuntil_def by auto
 
 lemma wUntilE[elim]:
   fixes n n'
   assumes "(\<gamma>' \<WW>\<^sub>c \<gamma>) t n"
   shows "(\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n'<n'' \<longrightarrow> \<gamma>' t n')) \<or> (\<forall>n'\<ge>n. \<gamma>' t n')"
 proof -
   from assms have "(\<gamma>' \<UU>\<^sub>c \<gamma> \<or>\<^sup>c \<box>\<^sub>c(\<gamma>')) t n" using wuntil_def by simp
   hence "(\<gamma>' \<UU>\<^sub>c \<gamma>) t n \<or> (\<box>\<^sub>c(\<gamma>')) t n" by simp
   thus ?thesis
   proof
     assume "(\<gamma>' \<UU>\<^sub>c \<gamma>) t n"
     hence "\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>' t n')" by auto
     thus ?thesis by auto
   next
     assume "(\<box>\<^sub>c\<gamma>') t n"
     hence "\<forall>n'\<ge>n. \<gamma>' t n'" by auto
     thus ?thesis by auto
   qed
 qed
 
 lemma wUntil_Glob:
   assumes "(\<gamma>' \<WW>\<^sub>c \<gamma>) t n"
     and "(\<box>\<^sub>c(\<gamma>' \<longrightarrow>\<^sup>c \<gamma>'')) t n"
   shows "(\<gamma>'' \<WW>\<^sub>c \<gamma>) t n"
 proof
   from assms(1) have "(\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>' t n')) \<or> (\<forall>n'\<ge>n. \<gamma>' t n')" using wUntilE by simp
   thus "(\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>'' t n')) \<or> (\<forall>n'\<ge>n. \<gamma>'' t n')"
   proof
     assume "\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>' t n')"
     show "(\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>'' t n')) \<or> (\<forall>n'\<ge>n. \<gamma>'' t n')"
     proof -
       from \<open>\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>' t n')\<close> obtain n'' where "n''\<ge>n" and "\<gamma> t n''" and a1: "\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>' t n'" by auto
       moreover have "\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>'' t n'"
       proof
         fix n'
         show "n'\<ge>n \<longrightarrow> n'< n'' \<longrightarrow> \<gamma>'' t n'"
         proof (rule HOL.impI[OF HOL.impI])
           assume "n'\<ge>n" and "n'<n''"
           with assms(2) have "(\<gamma>' \<longrightarrow>\<^sup>c \<gamma>'') t n'" using globE by simp
           hence "\<gamma>' t n' \<longrightarrow> \<gamma>'' t n'" using impE by auto
           moreover from a1 \<open>n'\<ge>n\<close> \<open>n'<n''\<close> have "\<gamma>' t n'" by simp
           ultimately show "\<gamma>'' t n'" by simp
         qed
       qed
       ultimately show ?thesis by auto
     qed
   next
     assume a1: "\<forall>n'\<ge>n. \<gamma>' t n'"
     have "\<forall>n'\<ge>n. \<gamma>'' t n'"
     proof
       fix n'
       show "n'\<ge>n \<longrightarrow> \<gamma>'' t n'"
       proof
         assume "n'\<ge>n"
         with assms(2) have "(\<gamma>' \<longrightarrow>\<^sup>c \<gamma>'') t n'" using globE by simp
         hence "\<gamma>' t n' \<longrightarrow> \<gamma>'' t n'" using impE by auto
         moreover from a1 \<open>n'\<ge>n\<close> have "\<gamma>' t n'" by simp
         ultimately show "\<gamma>'' t n'" by simp
       qed
     qed
     thus "(\<exists>n''\<ge>n. \<gamma> t n'' \<and> (\<forall>n'\<ge>n. n' < n'' \<longrightarrow> \<gamma>'' t n')) \<or> (\<forall>n'\<ge>n. \<gamma>'' t n')" by simp
   qed
 qed
 
 subsection "Dynamic Components"
 text \<open>
   To support the specification of patterns over dynamic architectures we provide a locale for dynamic components.
   It takes the following type parameters:
   \begin{itemize}
     \item id: a type for component identifiers
     \item cmp: a type for components
     \item cnf: a type for architecture configurations
   \end{itemize}
 \<close>
 locale dynamic_component =
   fixes tCMP :: "'id \<Rightarrow> cnf \<Rightarrow> 'cmp" ("\<sigma>\<^bsub>_\<^esub>(_)" [0,110]60)
     and active :: "'id \<Rightarrow> cnf \<Rightarrow> bool" ("\<parallel>_\<parallel>\<^bsub>_\<^esub>" [0,110]60)
 begin
   
 text \<open>
   The locale requires two parameters:
   \begin{itemize}
     \item @{term tCMP} is an operator to obtain a component with a certain identifier from an architecture configuration.
     \item @{term active} is a predicate to assert whether a certain component is activated within an architecture configuration.
   \end{itemize}
 \<close>
 
 text \<open>
   The locale provides some general properties about its parameters and introduces six important operators over configuration traces:
   \begin{itemize}
     \item An operator to extract the behavior of a certain component out of a given configuration trace.
     \item An operator to obtain the number of activations of a certain component within a given configuration trace.
     \item An operator to obtain the least point in time (before a certain point in time) from which on a certain component is not activated anymore.
     \item An operator to obtain the latest point in time where a certain component was activated.
     \item Two operators to map time-points between configuration traces and behavior traces.
   \end{itemize}
   Moreover, the locale provides several properties about the operators and their relationships.
 \<close>
 
 lemma nact_active:
   fixes t::"nat \<Rightarrow> cnf"
     and n::nat
     and n''
     and id
   assumes "\<parallel>id\<parallel>\<^bsub>t n\<^esub>"
     and "n'' \<ge> n"    
     and "\<not> (\<exists>n'\<ge>n. n' < n'' \<and> \<parallel>id\<parallel>\<^bsub>t n'\<^esub>)"    
   shows "n=n''"
   using assms le_eq_less_or_eq by auto
 
 lemma nact_exists:
   fixes t::"nat \<Rightarrow> cnf"
   assumes "\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
   shows "\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub> \<and> (\<nexists>k. n\<le>k \<and> k<i \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
 proof -
   let ?L = "LEAST i. (i\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t i\<^esub>)"
   from assms have "?L\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t ?L\<^esub>" using LeastI[of "\<lambda>x::nat. (x\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t x\<^esub>)"] by auto
   moreover have "\<nexists>k. n\<le>k \<and> k<?L \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>" using not_less_Least by auto
   ultimately show ?thesis by blast
 qed
 
 lemma lActive_least:
   assumes "\<exists>i\<ge>n. i < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
   shows "\<exists>i\<ge>n. (i < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub> \<and> (\<nexists>k. n\<le>k \<and> k<i \<and> k<llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>))"
 proof -
   let ?L = "LEAST i. (i\<ge>n \<and> i < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>)"
   from assms have "?L\<ge>n \<and> ?L < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t ?L\<^esub>"
     using LeastI[of "\<lambda>x::nat.(x\<ge>n \<and> x<llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t x\<^esub>)"] by auto
   moreover have "\<nexists>k. n\<le>k \<and> k<llength t \<and> k<?L \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>" using not_less_Least by auto
   ultimately show ?thesis by blast
 qed
 
 subsection "Projection"
 text \<open>
   In the following we introduce an operator which extracts the behavior of a certain component out of a given configuration trace.
 \<close>
 
 definition proj:: "'id \<Rightarrow> (cnf llist) \<Rightarrow> ('cmp llist)" ("\<pi>\<^bsub>_\<^esub>(_)" [0,110]60) 
   where "proj c = lmap (\<lambda>cnf. (\<sigma>\<^bsub>c\<^esub>(cnf))) \<circ> (lfilter (active c))"
 
 lemma proj_lnil [simp,intro]:
   "\<pi>\<^bsub>c\<^esub>([]\<^sub>l) = []\<^sub>l" using proj_def by simp
 
 lemma proj_lnull [simp]:
   "\<pi>\<^bsub>c\<^esub>(t) = []\<^sub>l \<longleftrightarrow> (\<forall>k \<in> lset t. \<not> \<parallel>c\<parallel>\<^bsub>k\<^esub>)"
 proof
   assume "\<pi>\<^bsub>c\<^esub>(t) = []\<^sub>l"
   hence "lfilter (active c) t = []\<^sub>l" using proj_def lmap_eq_LNil by auto
   thus "\<forall>k \<in> lset t. \<not> \<parallel>c\<parallel>\<^bsub>k\<^esub>" using lfilter_eq_LNil[of "active c"] by simp
 next
   assume "\<forall>k\<in>lset t. \<not> \<parallel>c\<parallel>\<^bsub>k\<^esub>"
   hence "lfilter (active c) t = []\<^sub>l" by simp
   thus "\<pi>\<^bsub>c\<^esub>(t) = []\<^sub>l" using proj_def by simp
 qed
   
 lemma proj_LCons [simp]:
   "\<pi>\<^bsub>i\<^esub>(x #\<^sub>l xs) = (if \<parallel>i\<parallel>\<^bsub>x\<^esub> then (\<sigma>\<^bsub>i\<^esub>(x)) #\<^sub>l (\<pi>\<^bsub>i\<^esub>(xs)) else \<pi>\<^bsub>i\<^esub>(xs))"
   using proj_def by simp
     
 lemma proj_llength[simp]:
   "llength (\<pi>\<^bsub>c\<^esub>(t)) \<le> llength t"
   using llength_lfilter_ile proj_def by simp
 
 lemma proj_ltake:
   assumes "\<forall>(n'::nat)\<le>llength t. n'\<ge>n \<longrightarrow> (\<not> \<parallel>c\<parallel>\<^bsub>lnth t n'\<^esub>)"
   shows "\<pi>\<^bsub>c\<^esub>(t) = \<pi>\<^bsub>c\<^esub>(ltake n t)" using lfilter_ltake proj_def assms by (metis comp_apply)
     
 lemma proj_finite_bound:
   assumes "lfinite (\<pi>\<^bsub>c\<^esub>(inf_llist t))"
   shows "\<exists>n. \<forall>n'>n. \<not> \<parallel>c\<parallel>\<^bsub>t n'\<^esub>"
   using assms lfilter_lfinite[of "active c" "inf_llist t"] proj_def by simp
 
 subsubsection "Monotonicity and Continuity"
 
 lemma proj_mcont:
   shows "mcont lSup lprefix lSup lprefix (proj c)"
 proof -
   have "mcont lSup lprefix lSup lprefix (\<lambda>x. lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf)) (lfilter (active c) x))"
     by simp
   moreover have "(\<lambda>x. lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf)) (lfilter (active c) x)) =
     lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf)) \<circ> lfilter (active c)" by auto
   ultimately show ?thesis using proj_def by simp
 qed
 
 lemma proj_mcont2mcont:
   assumes "mcont lub ord lSup lprefix f"
   shows "mcont lub ord lSup lprefix (\<lambda>x. \<pi>\<^bsub>c\<^esub>(f x))"
 proof -
   have "mcont lSup lprefix lSup lprefix (proj c)" using proj_mcont by simp
   with assms show ?thesis using llist.mcont2mcont[of lSup lprefix "proj c"] by simp
 qed
     
 lemma proj_mono_prefix[simp]:
   assumes "lprefix t t'"
   shows "lprefix (\<pi>\<^bsub>c\<^esub>(t)) (\<pi>\<^bsub>c\<^esub>(t'))"
 proof -
   from assms have "lprefix (lfilter (active c) t) (lfilter (active c) t')" using lprefix_lfilterI by simp
   hence "lprefix (lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf)) (lfilter (active c) t))
     (lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf)) (lfilter (active c) t'))" using lmap_lprefix by simp
   thus ?thesis using proj_def by simp
 qed
  
 subsubsection "Finiteness"
     
 lemma proj_finite[simp]:
   assumes "lfinite t"
   shows "lfinite (\<pi>\<^bsub>c\<^esub>(t))"
   using assms proj_def by simp
 
 lemma proj_finite2:
   assumes "\<forall>(n'::nat)\<le>llength t. n'\<ge>n \<longrightarrow> (\<not> \<parallel>c\<parallel>\<^bsub>lnth t n'\<^esub>)"
   shows "lfinite (\<pi>\<^bsub>c\<^esub>(t))" using assms proj_ltake proj_finite by simp
 
 lemma proj_append_lfinite[simp]:
   fixes t t'
   assumes "lfinite t"
   shows "\<pi>\<^bsub>c\<^esub>(t @\<^sub>l t') = (\<pi>\<^bsub>c\<^esub>(t)) @\<^sub>l (\<pi>\<^bsub>c\<^esub>(t'))" (is "?lhs=?rhs")
 proof -
   have "?lhs = (lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf)) \<circ> (lfilter (active c))) (t @\<^sub>l t')" using proj_def by simp
   also have "\<dots> = lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf)) (lfilter (active c) (t @\<^sub>l t'))" by simp
   also from assms have "\<dots> = lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf))
     ((lfilter (active c) t) @\<^sub>l (lfilter (active c) t'))" by simp
   also have "\<dots> = (@\<^sub>l) (lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf)) (lfilter (active c) t))
     (lmap (\<lambda>cnf. \<sigma>\<^bsub>c\<^esub>(cnf)) (lfilter (active c) t'))" using lmap_lappend_distrib by simp
   also have "\<dots> = ?rhs" using proj_def by simp
   finally show ?thesis .
 qed
   
 lemma proj_one:
   assumes "\<exists>i. i < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
   shows "llength (\<pi>\<^bsub>c\<^esub>(t)) \<ge> 1"
 proof -
   from assms have "\<exists>x\<in>lset t. \<parallel>c\<parallel>\<^bsub>x\<^esub>" using lset_conv_lnth by force
   hence "\<not> lfilter (\<lambda>k. \<parallel>c\<parallel>\<^bsub>k\<^esub>) t = []\<^sub>l" using lfilter_eq_LNil[of "(\<lambda>k. \<parallel>c\<parallel>\<^bsub>k\<^esub>)"] by blast
   hence "\<not> \<pi>\<^bsub>c\<^esub>(t) = []\<^sub>l" using proj_def by fastforce
   thus ?thesis by (simp add: ileI1 lnull_def one_eSuc)
 qed
 
 subsubsection "Projection not Active"
   
 lemma proj_not_active[simp]:
   assumes "enat n < llength t"
     and "\<not> \<parallel>c\<parallel>\<^bsub>lnth t n\<^esub>"
   shows "\<pi>\<^bsub>c\<^esub>(ltake (Suc n) t) = \<pi>\<^bsub>c\<^esub>(ltake n t)" (is "?lhs = ?rhs")
 proof -
   from assms have "ltake (enat (Suc n)) t = (ltake (enat n) t) @\<^sub>l ((lnth t n) #\<^sub>l []\<^sub>l)"
     using ltake_Suc_conv_snoc_lnth by blast
   hence "?lhs = \<pi>\<^bsub>c\<^esub>((ltake (enat n) t) @\<^sub>l ((lnth t n) #\<^sub>l []\<^sub>l))" by simp
   moreover have "\<dots> = (\<pi>\<^bsub>c\<^esub>(ltake (enat n) t)) @\<^sub>l (\<pi>\<^bsub>c\<^esub>((lnth t n) #\<^sub>l []\<^sub>l))" by simp
   moreover from assms have "\<pi>\<^bsub>c\<^esub>((lnth t n) #\<^sub>l []\<^sub>l) = []\<^sub>l" by simp
   ultimately show ?thesis by simp
 qed
 
 lemma proj_not_active_same:
   assumes "enat n \<le> (n'::enat)"
       and "\<not> lfinite t \<or> n'-1 < llength t"
       and "\<nexists>k. k\<ge>n \<and> k<n' \<and> k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
     shows "\<pi>\<^bsub>c\<^esub>(ltake n' t) = \<pi>\<^bsub>c\<^esub>(ltake n t)"
 proof -
   have "\<pi>\<^bsub>c\<^esub>(ltake (n + (n' - n)) t) = \<pi>\<^bsub>c\<^esub>((ltake n t) @\<^sub>l (ltake (n'-n) (ldrop n t)))"
     by (simp add: ltake_plus_conv_lappend)
   hence "\<pi>\<^bsub>c\<^esub>(ltake (n + (n' - n)) t) =
     (\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l (\<pi>\<^bsub>c\<^esub>(ltake (n'-n) (ldrop n t)))" by simp
   moreover have "\<pi>\<^bsub>c\<^esub>(ltake (n'-n) (ldrop n t)) = []\<^sub>l"
   proof -
     have "\<forall>k\<in>{lnth (ltake (n' - enat n) (ldrop (enat n) t)) na |
       na. enat na < llength (ltake (n' - enat n) (ldrop (enat n) t))}. \<not> \<parallel>c\<parallel>\<^bsub>k\<^esub>"
     proof
       fix k assume "k\<in>{lnth (ltake (n' - enat n) (ldrop (enat n) t)) na |
         na. enat na < llength (ltake (n' - enat n) (ldrop (enat n) t))}"
       then obtain k' where "enat k' < llength (ltake (n' - enat n) (ldrop (enat n) t))"
         and "k=lnth (ltake (n' - enat n) (ldrop (enat n) t)) k'" by auto
       have "enat (k' + n) < llength t"
       proof -
         from \<open>enat k' < llength (ltake (n' - enat n) (ldrop (enat n) t))\<close> have "enat k' < n'-n" by simp
         hence "enat k' + n < n'" using assms(1) enat_min by auto
         show ?thesis
         proof cases
           assume "lfinite t"
           with \<open>\<not> lfinite t \<or> n'-1 < llength t\<close> have "n'-1<llength t" by simp
           hence "n'< eSuc (llength t)" by (metis eSuc_minus_1 enat_minus_mono1 leD leI)
           hence "n'\<le> llength t" using eSuc_ile_mono ileI1 by blast
           with \<open>enat k' + n < n'\<close> show ?thesis by (simp add: add.commute)
         next
           assume "\<not> lfinite t"
           hence "llength t = \<infinity>" using not_lfinite_llength by auto
           thus ?thesis by simp
         qed
       qed
       moreover have "k = lnth t (k' + n)"
       proof -
         from \<open>enat k' < llength (ltake (n' - enat n) (ldrop (enat n) t))\<close>
           have "enat k'<n' - enat n" by auto
         hence "lnth (ltake (n' - enat n) (ldrop (enat n) t)) k' = lnth (ldrop (enat n) t) k'"
           using lnth_ltake[of k' "n' - enat n"] by simp
         with \<open>enat (k' + n) < llength t\<close> show ?thesis using lnth_ldrop[of n k' t ]
           using \<open>k = lnth (ltake (n' - enat n) (ldrop (enat n) t)) k'\<close> by (simp add: add.commute)
       qed
       moreover from \<open>enat n \<le> (n'::enat)\<close> have "k' + the_enat n\<ge>n" by auto
       moreover from \<open>enat k' < llength (ltake (n' - enat n) (ldrop (enat n) t))\<close> have "k' + n<n'"
         using assms(1) enat_min by auto
       ultimately show "\<not> \<parallel>c\<parallel>\<^bsub>k\<^esub>" using \<open>\<nexists>k. k\<ge>n \<and> k<n' \<and> k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>\<close> by simp
     qed
     hence "\<forall>k\<in>lset (ltake (n'-n) (ldrop n t)). \<not> \<parallel>c\<parallel>\<^bsub>k\<^esub>"
       using lset_conv_lnth[of "(ltake (n' - enat n) (ldrop (enat n) t))"] by simp
     thus ?thesis using proj_lnull by auto
   qed
   moreover from assms have "n + (n' - n) = n'"
     by (meson enat.distinct(1) enat_add_sub_same enat_diff_cancel_left enat_le_plus_same(1) less_imp_le)
   ultimately show ?thesis by simp
 qed
   
 subsubsection "Projection Active"
 
 lemma proj_active[simp]:
   assumes "enat i < llength t" "\<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
   shows "\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t) = (\<pi>\<^bsub>c\<^esub>(ltake i t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)" (is "?lhs = ?rhs")
 proof -
   from assms have "ltake (enat (Suc i)) t = (ltake (enat i) t) @\<^sub>l ((lnth t i) #\<^sub>l []\<^sub>l)"
     using ltake_Suc_conv_snoc_lnth by blast
   hence "?lhs = \<pi>\<^bsub>c\<^esub>((ltake (enat i) t) @\<^sub>l ((lnth t i) #\<^sub>l []\<^sub>l))" by simp
   moreover have "\<dots> = (\<pi>\<^bsub>c\<^esub>(ltake (enat i) t)) @\<^sub>l (\<pi>\<^bsub>c\<^esub>((lnth t i) #\<^sub>l []\<^sub>l))" by simp
   moreover from assms have "\<pi>\<^bsub>c\<^esub>((lnth t i) #\<^sub>l []\<^sub>l) = (\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l" by simp
   ultimately show ?thesis by simp
 qed
   
 lemma proj_active_append:
   assumes a1: "(n::nat) \<le> i"
       and a2: "enat i < (n'::enat)"
       and a3: "\<not> lfinite t \<or> n'-1 < llength t"
       and a4: "\<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
       and "\<forall>i'. (n \<le> i' \<and> enat i'<n' \<and> i' < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i'\<^esub>) \<longrightarrow> (i' = i)"
     shows "\<pi>\<^bsub>c\<^esub>(ltake n' t) = (\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)" (is "?lhs = ?rhs")
 proof -
   have "?lhs = \<pi>\<^bsub>c\<^esub>(ltake (Suc i) t)"
   proof -
     from a2 have "Suc i \<le> n'" by (simp add: Suc_ile_eq)
     moreover from a3 have "\<not> lfinite t \<or> n'-1 < llength t" by simp
     moreover have "\<nexists>k. enat k\<ge>enat (Suc i) \<and> k<n' \<and> k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
     proof
       assume "\<exists>k. enat k\<ge>enat (Suc i) \<and> k<n' \<and> k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
       then obtain k where "enat k\<ge>enat (Suc i)" and "k<n'" and "k < llength t" and "\<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>" by blast
       moreover from \<open>enat k\<ge>enat (Suc i)\<close> have "enat k\<ge>n"
         using assms by (meson dual_order.trans enat_ord_simps(1) le_SucI)
       ultimately have "enat k=enat i" using assms using enat_ord_simps(1) by blast
       with \<open>enat k\<ge>enat (Suc i)\<close> show False by simp
     qed
     ultimately show ?thesis using proj_not_active_same[of "Suc i" n' t c] by simp
   qed
   also have "\<dots> = (\<pi>\<^bsub>c\<^esub>(ltake i t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)"
   proof -
     have "i < llength t"
     proof cases
       assume "lfinite t"
       with a3 have "n'-1 < llength t" by simp
       hence "n' \<le> llength t" by (metis eSuc_minus_1 enat_minus_mono1 ileI1 not_le)
       with a2 show "enat i < llength t" by simp
     next
       assume "\<not> lfinite t"
       thus ?thesis by (metis enat_ord_code(4) llength_eq_infty_conv_lfinite)
     qed
     with a4 show ?thesis by simp
   qed
   also have "\<dots> = ?rhs"
   proof -
     from a1 have "enat n \<le> enat i" by simp
     moreover from a2 a3 have "\<not> lfinite t \<or> enat i-1 < llength t"
       using enat_minus_mono1 less_imp_le order.strict_trans1 by blast
     moreover have "\<nexists>k. k\<ge>n \<and> enat k<enat i \<and> enat k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
     proof
       assume "\<exists>k. k\<ge>n \<and> enat k<enat i \<and> enat k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
       then obtain k where "k\<ge>n" and "enat k<enat i" and "enat k < llength t" and "\<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>" by blast
       moreover from \<open>enat k<enat i\<close> have "enat k<n'" using assms dual_order.strict_trans by blast
       ultimately have "enat k=enat i" using assms by simp
       with \<open>enat k<enat i\<close> show False by simp
     qed
     ultimately show ?thesis using proj_not_active_same[of n i t c] by simp
   qed    
   finally show ?thesis by simp
 qed
   
 subsubsection "Same and not Same"
 
 lemma proj_same_not_active:
   assumes "n \<le> n'"
     and "enat (n'-1) < llength t"
     and "\<pi>\<^bsub>c\<^esub>(ltake n' t) = \<pi>\<^bsub>c\<^esub>(ltake n t)"
   shows "\<nexists>k. k\<ge>n \<and> k<n' \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
 proof
   assume "\<exists>k. k\<ge>n \<and> k<n' \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
   then obtain i where "i\<ge>n" and "i<n'" and "\<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>" by blast
   moreover from \<open>enat (n'-1)<llength t\<close> and \<open>i<n'\<close> have "i<llength t"
     by (metis diff_Suc_1 dual_order.strict_trans enat_ord_simps(2) lessE)
   ultimately have "\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t) =
     (\<pi>\<^bsub>c\<^esub>(ltake i t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)" by simp
   moreover from \<open>i<n'\<close> have "Suc i \<le> n'" by simp
     hence "lprefix(\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t)) (\<pi>\<^bsub>c\<^esub>(ltake n' t))" by simp
     then obtain "tl" where "\<pi>\<^bsub>c\<^esub>(ltake n' t) = (\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t)) @\<^sub>l tl"
       using lprefix_conv_lappend by auto
   moreover from \<open>n\<le>i\<close> have "lprefix(\<pi>\<^bsub>c\<^esub>(ltake n t)) (\<pi>\<^bsub>c\<^esub>(ltake i t))" by simp
     hence "lprefix(\<pi>\<^bsub>c\<^esub>(ltake n t)) (\<pi>\<^bsub>c\<^esub>(ltake i t))" by simp
     then obtain "hd" where "\<pi>\<^bsub>c\<^esub>(ltake i t) = (\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l hd"
       using lprefix_conv_lappend by auto
   ultimately have "\<pi>\<^bsub>c\<^esub>(ltake n' t) =
     (((\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l hd) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)) @\<^sub>l tl" by simp
   also have "\<dots> = ((\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l hd) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l tl)"
     using lappend_snocL1_conv_LCons2[of "(\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l hd" "\<sigma>\<^bsub>c\<^esub>(lnth t i)"] by simp
   also have "\<dots> = (\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l (hd @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l tl))"
     using lappend_assoc by auto
   also have "\<pi>\<^bsub>c\<^esub>(ltake n' t) = (\<pi>\<^bsub>c\<^esub>(ltake n' t)) @\<^sub>l []\<^sub>l" by simp
   finally have "(\<pi>\<^bsub>c\<^esub>(ltake n' t)) @\<^sub>l []\<^sub>l = (\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l (hd @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l tl))" .
   moreover from assms(3) have "llength (\<pi>\<^bsub>c\<^esub>(ltake n' t)) = llength (\<pi>\<^bsub>c\<^esub>(ltake n t))" by simp
   ultimately have "lfinite (\<pi>\<^bsub>c\<^esub>(ltake n' t)) \<longrightarrow> []\<^sub>l = hd @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l tl)"
     using assms(3) lappend_eq_lappend_conv[of "\<pi>\<^bsub>c\<^esub>(ltake n' t)" "\<pi>\<^bsub>c\<^esub>(ltake n t)" "[]\<^sub>l"] by simp
   moreover have "lfinite (\<pi>\<^bsub>c\<^esub>(ltake n' t))" by simp
   ultimately have "[]\<^sub>l = hd @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l tl)" by simp
   hence "(\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l tl = []\<^sub>l" using LNil_eq_lappend_iff by auto
   thus False by simp
 qed
 
 lemma proj_not_same_active:
   assumes "enat n \<le> (n'::enat)"
     and "(\<not> lfinite t) \<or> n'-1 < llength t"
     and "\<not>(\<pi>\<^bsub>c\<^esub>(ltake n' t) = \<pi>\<^bsub>c\<^esub>(ltake n t))"
   shows "\<exists>k. k\<ge>n \<and> k<n' \<and> enat k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
 proof (rule ccontr)
   assume "\<not>(\<exists>k. k\<ge>n \<and> k<n' \<and> enat k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>)"
   have "\<pi>\<^bsub>c\<^esub>(ltake n' t) = \<pi>\<^bsub>c\<^esub>(ltake (enat n) t)"
   proof cases
     assume "lfinite t"
     hence "llength t\<noteq>\<infinity>" by (simp add: lfinite_llength_enat) 
     hence "enat (the_enat (llength t)) = llength t" by auto
     with assms \<open>\<not> (\<exists>k\<ge>n. k < n' \<and> enat k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>)\<close>
       show ?thesis using proj_not_active_same[of n n' t c] by simp
   next
     assume "\<not> lfinite t"
     with assms \<open>\<not> (\<exists>k\<ge>n. k < n' \<and> enat k < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>)\<close>
       show ?thesis using proj_not_active_same[of n n' t c] by simp
   qed
   with assms show False by simp
 qed
 
 subsection "Activations"
 text \<open>
   We also introduce an operator to obtain the number of activations of a certain component within a given configuration trace.
 \<close>
 
 definition nAct :: "'id \<Rightarrow> enat \<Rightarrow> (cnf llist) \<Rightarrow> enat" ("\<langle>_ #\<^bsub>_\<^esub>_\<rangle>") where
 "\<langle>c #\<^bsub>n\<^esub> t\<rangle> \<equiv> llength (\<pi>\<^bsub>c\<^esub>(ltake n t))"
 
 lemma nAct_0[simp]:
   "\<langle>c #\<^bsub>0\<^esub> t\<rangle> = 0" by (simp add: nAct_def)
 
 lemma nAct_NIL[simp]:
   "\<langle>c #\<^bsub>n\<^esub> []\<^sub>l\<rangle> = 0" by (simp add: nAct_def)    
 
 lemma nAct_Null:
   assumes "llength t \<ge> n"
       and "\<langle>c #\<^bsub>n\<^esub> t\<rangle> = 0"
     shows "\<forall>i<n. \<not> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
 proof -
   from assms have "lnull (\<pi>\<^bsub>c\<^esub>(ltake n t))" using nAct_def lnull_def by simp
   hence "\<pi>\<^bsub>c\<^esub>(ltake n t) = []\<^sub>l" using lnull_def by blast
   hence "(\<forall>k\<in>lset (ltake n t). \<not> \<parallel>c\<parallel>\<^bsub>k\<^esub>)" by simp
   show ?thesis
   proof (rule ccontr)
     assume "\<not> (\<forall>i<n. \<not> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>)"
     then obtain i where "i<n" and "\<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>" by blast
     moreover have "enat i < llength (ltake n t)  \<and> lnth (ltake n t) i = (lnth t i)"
     proof
       from \<open>llength t \<ge> n\<close> have "n = min n (llength t)" using min.orderE by auto
       hence "llength (ltake n t) = n" by simp
       with \<open>i<n\<close> show "enat i < llength (ltake n t)" by auto
       from \<open>i<n\<close> show "lnth (ltake n t) i = (lnth t i)" using lnth_ltake by auto
     qed
     hence "(lnth t i \<in> lset (ltake n t))" using in_lset_conv_lnth[of "lnth t i" "ltake n t"] by blast
     ultimately show False using \<open>(\<forall>k\<in>lset (ltake n t). \<not> \<parallel>c\<parallel>\<^bsub>k\<^esub>)\<close> by simp
   qed
 qed
 
 lemma nAct_ge_one[simp]:
   assumes "llength t \<ge> n"
       and "i < n"
       and "\<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
     shows "\<langle>c #\<^bsub>n\<^esub> t\<rangle> \<ge> enat 1"
 proof (rule ccontr)
   assume "\<not> (\<langle>c #\<^bsub>n\<^esub> t\<rangle> \<ge> enat 1)"
   hence "\<langle>c #\<^bsub>n\<^esub> t\<rangle> < enat 1" by simp
   hence "\<langle>c #\<^bsub>n\<^esub> t\<rangle> < 1" using enat_1 by simp
   hence "\<langle>c #\<^bsub>n\<^esub> t\<rangle> = 0" using Suc_ile_eq \<open>\<not> enat 1 \<le> \<langle>c #\<^bsub>n\<^esub> t\<rangle>\<close> zero_enat_def by auto
   with \<open>llength t \<ge> n\<close> have "\<forall>i<n. \<not> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>" using nAct_Null by simp
   with assms show False by simp
 qed
     
 lemma nAct_finite[simp]:
   assumes "n \<noteq> \<infinity>"
   shows "\<exists>n'. \<langle>c #\<^bsub>n\<^esub> t\<rangle> = enat n'"
 proof -
   from assms have "lfinite (ltake n t)" by simp
   hence "lfinite (\<pi>\<^bsub>c\<^esub>(ltake n t))" by simp
   hence "\<exists>n'. llength (\<pi>\<^bsub>c\<^esub>(ltake n t)) = enat n'" using lfinite_llength_enat[of "\<pi>\<^bsub>c\<^esub>(ltake n t)"] by simp
   thus ?thesis using nAct_def by simp
 qed
 
 lemma nAct_enat_the_nat[simp]:
   assumes "n \<noteq> \<infinity>"
   shows "enat (the_enat (\<langle>c #\<^bsub>n\<^esub> t\<rangle>)) = \<langle>c #\<^bsub>n\<^esub> t\<rangle>"
 proof -
   from assms have "\<langle>c #\<^bsub>n\<^esub> t\<rangle> \<noteq> \<infinity>" by simp
   thus ?thesis using enat_the_enat by simp
 qed
   
 subsubsection "Monotonicity and Continuity"
   
 lemma nAct_mcont:
   shows "mcont lSup lprefix Sup (\<le>) (nAct c n)"
 proof -
   have "mcont lSup lprefix lSup lprefix (ltake n)" by simp
   hence "mcont lSup lprefix lSup lprefix (\<lambda>t. \<pi>\<^bsub>c\<^esub>(ltake n t))"
     using proj_mcont2mcont[of lSup lprefix "(ltake n)"] by simp
   hence "mcont lSup lprefix Sup (\<le>) (\<lambda>t. llength (\<pi>\<^bsub>c\<^esub>(ltake n t)))" by simp
   moreover have "nAct c n = (\<lambda>t. llength (\<pi>\<^bsub>c\<^esub>(ltake n t)))" using nAct_def by auto
   ultimately show ?thesis by simp
 qed
   
 lemma nAct_mono:
   assumes "n \<le> n'"
     shows "\<langle>c #\<^bsub>n\<^esub> t\<rangle> \<le> \<langle>c #\<^bsub>n'\<^esub> t\<rangle>"
 proof -
   from assms have "lprefix (ltake n t) (ltake n' t)" by simp
   hence "lprefix (\<pi>\<^bsub>c\<^esub>(ltake n t)) (\<pi>\<^bsub>c\<^esub>(ltake n' t))" by simp
   hence "llength (\<pi>\<^bsub>c\<^esub>(ltake n t)) \<le> llength (\<pi>\<^bsub>c\<^esub>(ltake n' t))"
     using lprefix_llength_le[of "(\<pi>\<^bsub>c\<^esub>(ltake n t))"] by simp
   thus ?thesis using nAct_def by simp
 qed
   
 lemma nAct_strict_mono_back:
   assumes "\<langle>c #\<^bsub>n\<^esub> t\<rangle> < \<langle>c #\<^bsub>n'\<^esub> t\<rangle>"
     shows "n < n'"
 proof (rule ccontr)
   assume "\<not> n<n'"
   hence "n\<ge>n'" by simp
   hence "\<langle>c #\<^bsub>n\<^esub> t\<rangle> \<ge> \<langle>c #\<^bsub>n'\<^esub> t\<rangle>" using nAct_mono by simp
   thus False using assms by simp
 qed
 
 subsubsection "Not Active"
 
 lemma nAct_not_active[simp]:
   fixes n::nat
     and n'::nat
     and t::"(cnf llist)"
     and c::'id
   assumes "enat i < llength t"
     and "\<not> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
   shows "\<langle>c #\<^bsub>Suc i\<^esub> t\<rangle> = \<langle>c #\<^bsub>i\<^esub> t\<rangle>"
 proof -
   from assms have "\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t) = \<pi>\<^bsub>c\<^esub>(ltake i t)" by simp
   hence "llength (\<pi>\<^bsub>c\<^esub>(ltake (enat (Suc i)) t)) = llength (\<pi>\<^bsub>c\<^esub>(ltake i t))" by simp
   moreover have "llength (\<pi>\<^bsub>c\<^esub>(ltake i t)) \<noteq> \<infinity>"
     using llength_eq_infty_conv_lfinite[of "\<pi>\<^bsub>c\<^esub>(ltake (enat i) t)"] by simp
   ultimately have "llength (\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t)) = llength (\<pi>\<^bsub>c\<^esub>(ltake i t))"
     using the_enat_eSuc by simp
   with nAct_def show ?thesis by simp
 qed
   
 lemma nAct_not_active_same:
   assumes "enat n \<le> (n'::enat)"
       and "n'-1 < llength t"
       and "\<nexists>k. enat k\<ge>n \<and> k<n' \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
     shows "\<langle>c #\<^bsub>n'\<^esub> t\<rangle> = \<langle>c #\<^bsub>n\<^esub> t\<rangle>"
   using assms proj_not_active_same nAct_def by simp
     
 subsubsection "Active"
   
 lemma nAct_active[simp]:
   fixes n::nat
     and n'::nat
     and t::"(cnf llist)"
     and c::'id
   assumes "enat i < llength t"
     and "\<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
   shows "\<langle>c #\<^bsub>Suc i\<^esub> t\<rangle> = eSuc (\<langle>c #\<^bsub>i\<^esub> t\<rangle>)"
 proof -
   from assms have "\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t) =
     (\<pi>\<^bsub>c\<^esub>(ltake i t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)" by simp
   hence "llength (\<pi>\<^bsub>c\<^esub>(ltake (enat (Suc i)) t)) = eSuc (llength (\<pi>\<^bsub>c\<^esub>(ltake i t)))"
     using plus_1_eSuc one_eSuc by simp
   moreover have "llength (\<pi>\<^bsub>c\<^esub>(ltake i t)) \<noteq> \<infinity>"
     using llength_eq_infty_conv_lfinite[of "\<pi>\<^bsub>c\<^esub>(ltake (enat i) t)"] by simp
   ultimately have "llength (\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t)) = eSuc (llength (\<pi>\<^bsub>c\<^esub>(ltake i t)))"
     using the_enat_eSuc by simp
   with nAct_def show ?thesis by simp
 qed
 
 lemma nAct_active_suc:
   fixes n::nat
     and n'::enat
     and t::"(cnf llist)"
     and c::'id
   assumes "\<not> lfinite t \<or> n'-1 < llength t"
     and "n \<le> i"
     and "enat i < n'"
     and "\<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
     and "\<forall>i'. (n \<le> i' \<and> enat i'<n' \<and> i' < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i'\<^esub>) \<longrightarrow> (i' = i)"
   shows "\<langle>c #\<^bsub>n'\<^esub> t\<rangle> = eSuc (\<langle>c #\<^bsub>n\<^esub> t\<rangle>)"
 proof -
   from assms have "\<pi>\<^bsub>c\<^esub>(ltake n' t) = (\<pi>\<^bsub>c\<^esub>(ltake (enat n) t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)"
     using proj_active_append[of n i n' t c] by blast
   moreover have "llength ((\<pi>\<^bsub>c\<^esub>(ltake (enat n) t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)) =
     eSuc (llength (\<pi>\<^bsub>c\<^esub>(ltake (enat n) t)))" using one_eSuc eSuc_plus_1 by simp
   ultimately show ?thesis using nAct_def by simp
 qed
   
 lemma nAct_less:
   assumes "enat k < llength t"
     and "n \<le> k"
     and "k < (n'::enat)"
     and "\<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>"
   shows "\<langle>c #\<^bsub>n\<^esub> t\<rangle> < \<langle>c #\<^bsub>n'\<^esub> t\<rangle>"
 proof -
   have "\<langle>c #\<^bsub>k\<^esub> t\<rangle> \<noteq> \<infinity>" by simp
   then obtain en where en_def: "\<langle>c #\<^bsub>k\<^esub> t\<rangle> = enat en" by blast  
   moreover have "eSuc (enat en) \<le> \<langle>c #\<^bsub>n'\<^esub> t\<rangle>"
   proof -
     from assms have "Suc k \<le> n'" using Suc_ile_eq by simp
     hence "\<langle>c #\<^bsub>Suc k\<^esub> t\<rangle> \<le> \<langle>c #\<^bsub>n'\<^esub> t\<rangle>" using nAct_mono by simp
     moreover from assms have "\<langle>c #\<^bsub>Suc k\<^esub> t\<rangle> = eSuc (\<langle>c #\<^bsub>k\<^esub> t\<rangle>)" by simp
     ultimately have "eSuc (\<langle>c #\<^bsub>k\<^esub> t\<rangle>) \<le> \<langle>c #\<^bsub>n'\<^esub> t\<rangle>" by simp
     thus ?thesis using en_def by simp
   qed
   moreover have "enat en < eSuc (enat en)" by simp
   ultimately have "enat en < \<langle>c #\<^bsub>n'\<^esub> t\<rangle>" using less_le_trans[of "enat en" "eSuc (enat en)"] by simp
   moreover have "\<langle>c #\<^bsub>n\<^esub> t\<rangle> \<le> enat en"
   proof -
     from assms have "\<langle>c #\<^bsub>n\<^esub> t\<rangle> \<le> \<langle>c #\<^bsub>k\<^esub> t\<rangle>" using nAct_mono by simp
     thus ?thesis using en_def by simp
   qed
   ultimately show ?thesis using le_less_trans[of "\<langle>c #\<^bsub>n\<^esub> t\<rangle>"] by simp
 qed
   
 lemma nAct_less_active:
   assumes "n' - 1 < llength t"
       and "\<langle>c #\<^bsub>enat n\<^esub> t\<rangle> < \<langle>c #\<^bsub>n'\<^esub> t\<rangle>"
   shows "\<exists>i\<ge>n. i<n' \<and> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
 proof (rule ccontr)
   assume "\<not> (\<exists>i\<ge>n. i<n' \<and> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>)"
   moreover have "enat n \<le> n'" using assms(2) less_imp_le nAct_strict_mono_back by blast
   ultimately have "\<langle>c #\<^bsub>n\<^esub> t\<rangle> = \<langle>c #\<^bsub>n'\<^esub> t\<rangle>" using \<open>n' - 1 < llength t\<close> nAct_not_active_same by simp
   thus False using assms by simp
 qed
 
 subsubsection "Same and Not Same"
   
 lemma nAct_same_not_active:
   assumes "\<langle>c #\<^bsub>n'\<^esub> inf_llist t\<rangle> = \<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>"
   shows "\<forall>k\<ge>n. k<n' \<longrightarrow> \<not> \<parallel>c\<parallel>\<^bsub>t k\<^esub>"
 proof (rule ccontr)
   assume "\<not>(\<forall>k\<ge>n. k<n' \<longrightarrow> \<not> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
   then obtain k where "k\<ge>n" and "k<n'" and "\<parallel>c\<parallel>\<^bsub>t k\<^esub>" by blast
   hence "\<langle>c #\<^bsub>Suc k\<^esub> inf_llist t\<rangle> = eSuc (\<langle>c #\<^bsub>k\<^esub> inf_llist t\<rangle>)" by simp
   moreover have "\<langle>c #\<^bsub>k\<^esub> inf_llist t\<rangle>\<noteq>\<infinity>" by simp
   ultimately have "\<langle>c #\<^bsub>k\<^esub> inf_llist t\<rangle> < \<langle>c #\<^bsub>Suc k\<^esub> inf_llist t\<rangle>" by fastforce
   moreover from \<open>n\<le>k\<close> have "\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle> \<le> \<langle>c #\<^bsub>k\<^esub> inf_llist t\<rangle>" using nAct_mono by simp
   moreover from \<open>k<n'\<close> have "Suc k \<le> n'" by (simp add: Suc_ile_eq)
   hence "\<langle>c #\<^bsub>Suc k\<^esub> inf_llist t\<rangle> \<le> \<langle>c #\<^bsub>n'\<^esub> inf_llist t\<rangle>" using nAct_mono by simp
   ultimately show False using assms by simp
 qed
   
 lemma nAct_not_same_active:
   assumes "\<langle>c #\<^bsub>enat n\<^esub> t\<rangle> < \<langle>c #\<^bsub>n'\<^esub> t\<rangle>"
     and "\<not> lfinite t \<or> n' - 1 < llength t"
   shows "\<exists>(i::nat)\<ge>n. enat i< n' \<and> i<llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
 proof -
   from assms have "llength(\<pi>\<^bsub>c\<^esub>(ltake n t)) < llength (\<pi>\<^bsub>c\<^esub>(ltake n' t))" using nAct_def by simp
   hence "\<pi>\<^bsub>c\<^esub>(ltake n' t) \<noteq> \<pi>\<^bsub>c\<^esub>(ltake n t)" by auto
   moreover from assms have "enat n < n'" using nAct_strict_mono_back[of c "enat n" t n'] by simp
   ultimately show ?thesis using proj_not_same_active[of n n' t c] assms by simp
 qed
   
 lemma nAct_less_llength_active:
   assumes "x < llength (\<pi>\<^bsub>c\<^esub>(t))"
     and "enat x = \<langle>c #\<^bsub>enat n'\<^esub> t\<rangle>"
   shows "\<exists>(i::nat)\<ge>n'. i<llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
 proof -
   have "llength(\<pi>\<^bsub>c\<^esub>(ltake n' t)) < llength (\<pi>\<^bsub>c\<^esub>(t))" using assms(1) assms(2) nAct_def by auto
   hence "llength(\<pi>\<^bsub>c\<^esub>(ltake n' t)) < llength (\<pi>\<^bsub>c\<^esub>(ltake (llength t) t))" by (simp add: ltake_all)
   hence "\<langle>c #\<^bsub>enat n'\<^esub> t\<rangle> < \<langle>c #\<^bsub>llength t\<^esub> t\<rangle>" using nAct_def by simp
   moreover have "\<not> lfinite t \<or> llength t - 1 < llength t"
   proof (rule Meson.imp_to_disjD[OF HOL.impI])
     assume "lfinite t"
     hence "llength t \<noteq> \<infinity>" by (simp add: llength_eq_infty_conv_lfinite)
     moreover have "llength t>0"
     proof -
       from \<open>x < llength (\<pi>\<^bsub>c\<^esub>(t))\<close> have "llength (\<pi>\<^bsub>c\<^esub>(t))>0" by auto
       thus ?thesis using proj_llength order.strict_trans2 by blast
     qed
     ultimately show "llength t - 1 < llength t" by (metis One_nat_def \<open>lfinite t\<close> diff_Suc_less
       enat_ord_simps(2) idiff_enat_enat lfinite_conv_llength_enat one_enat_def zero_enat_def)
   qed
   ultimately show ?thesis using nAct_not_same_active[of c n' t "llength t"] by simp
 qed
 
 lemma nAct_exists:
   assumes "x < llength (\<pi>\<^bsub>c\<^esub>(t))"
   shows "\<exists>(n'::nat). enat x = \<langle>c #\<^bsub>n'\<^esub> t\<rangle>"
 proof -
   have "x < llength (\<pi>\<^bsub>c\<^esub>(t)) \<longrightarrow> (\<exists>(n'::nat). enat x = \<langle>c #\<^bsub>n'\<^esub> t\<rangle>)"
   proof (induction x)
     case 0
     thus ?case by (metis nAct_0 zero_enat_def)
   next
     case (Suc x)
     show ?case
     proof
       assume "Suc x < llength (\<pi>\<^bsub>c\<^esub>(t))"
       hence "x < llength (\<pi>\<^bsub>c\<^esub>(t))" using Suc_ile_eq less_imp_le by auto
       with Suc.IH obtain n' where "enat x = \<langle>c #\<^bsub>enat n'\<^esub> t\<rangle>" by blast
       with \<open>x < llength (\<pi>\<^bsub>c\<^esub>(t))\<close> have "\<exists>i\<ge>n'. i < llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
         using nAct_less_llength_active[of x c t n'] by simp
       then obtain i where "i\<ge>n'" and "i<llength t" and "\<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
         and "\<nexists>k. n'\<le>k \<and> k<i \<and> k<llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>" using lActive_least[of n' t c] by auto
       moreover from \<open>i<llength t\<close> have "\<not> lfinite t \<or> enat (Suc i) - 1 < llength t"
         by (simp add: one_enat_def)
       moreover have "enat i < enat (Suc i)" by simp
       moreover have "\<forall>i'. (n' \<le> i' \<and> enat i'<enat (Suc i) \<and> i'<llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i'\<^esub>) \<longrightarrow> (i' = i)"
       proof (rule HOL.impI[THEN HOL.allI])
         fix i' assume "n' \<le> i' \<and> enat i'<enat (Suc i) \<and> i'<llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t i'\<^esub>"
         with \<open>\<nexists>k. n'\<le>k \<and> k<i \<and> k<llength t \<and> \<parallel>c\<parallel>\<^bsub>lnth t k\<^esub>\<close> show "i'=i" by fastforce
       qed
       ultimately have "\<langle>c #\<^bsub>Suc i\<^esub> t\<rangle> = eSuc (\<langle>c #\<^bsub>n'\<^esub> t\<rangle>)" using nAct_active_suc[of t "Suc i" n' i c] by simp
       with \<open>enat x = \<langle>c #\<^bsub>enat n'\<^esub> t\<rangle>\<close> have "\<langle>c #\<^bsub>Suc i\<^esub> t\<rangle> = eSuc (enat x)" by simp
       thus "\<exists>n'. enat (Suc x) = \<langle>c #\<^bsub>enat n'\<^esub> t\<rangle>" by (metis eSuc_enat)
     qed
   qed
   with assms show ?thesis by simp
 qed
   
 subsection "Projection and Activation"
 text \<open>
   In the following we provide some properties about the relationship between the projection and activations operator.
 \<close>
   
 lemma nAct_le_proj:
   "\<langle>c #\<^bsub>n\<^esub> t\<rangle> \<le> llength (\<pi>\<^bsub>c\<^esub>(t))"
 proof -
   from nAct_def have "\<langle>c #\<^bsub>n\<^esub> t\<rangle> = llength (\<pi>\<^bsub>c\<^esub>(ltake n t))" by simp
   moreover have "llength (\<pi>\<^bsub>c\<^esub>(ltake n t)) \<le> llength (\<pi>\<^bsub>c\<^esub>(t))"
   proof -
     have "lprefix (ltake n t) t" by simp
     hence "lprefix (\<pi>\<^bsub>c\<^esub>(ltake n t)) (\<pi>\<^bsub>c\<^esub>(t))" by simp
     hence "llength (\<pi>\<^bsub>c\<^esub>(ltake n t)) \<le> llength (\<pi>\<^bsub>c\<^esub>(t))" using lprefix_llength_le by blast
     thus ?thesis by auto
   qed
   thus ?thesis using nAct_def by simp
 qed
   
 lemma proj_nAct:
   assumes "(enat n < llength t)"
   shows "\<pi>\<^bsub>c\<^esub>(ltake n t) = ltake (\<langle>c #\<^bsub>n\<^esub> t\<rangle>) (\<pi>\<^bsub>c\<^esub>(t))" (is "?lhs = ?rhs")
 proof -
   have "?lhs = ltake (llength (\<pi>\<^bsub>c\<^esub>(ltake n t))) (\<pi>\<^bsub>c\<^esub>(ltake n t))"
     using ltake_all[of "\<pi>\<^bsub>c\<^esub>(ltake n t)" "llength (\<pi>\<^bsub>c\<^esub>(ltake n t))"] by simp
   also have "\<dots> = ltake (llength (\<pi>\<^bsub>c\<^esub>(ltake n t))) ((\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l (\<pi>\<^bsub>c\<^esub>(ldrop n t)))"
     using ltake_lappend1[of "llength (\<pi>\<^bsub>c\<^esub>(ltake (enat n) t))" "\<pi>\<^bsub>c\<^esub>(ltake n t)" "(\<pi>\<^bsub>c\<^esub>(ldrop n t))"] by simp
   also have "\<dots> = ltake (\<langle>c #\<^bsub>n\<^esub> t\<rangle>) ((\<pi>\<^bsub>c\<^esub>(ltake n t)) @\<^sub>l (\<pi>\<^bsub>c\<^esub>(ldrop n t)))" using nAct_def by simp      
   also have "\<dots> = ltake (\<langle>c #\<^bsub>n\<^esub> t\<rangle>) (\<pi>\<^bsub>c\<^esub>((ltake (enat n) t) @\<^sub>l (ldrop n t)))" by simp
   also have "\<dots> = ltake (\<langle>c #\<^bsub>n\<^esub> t\<rangle>) (\<pi>\<^bsub>c\<^esub>(t))" using lappend_ltake_ldrop[of n t] by simp
   finally show ?thesis by simp
 qed
 
 lemma proj_active_nth:
   assumes "enat (Suc i) < llength t" "\<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>"
   shows "lnth (\<pi>\<^bsub>c\<^esub>(t)) (the_enat (\<langle>c #\<^bsub>i\<^esub> t\<rangle>)) = \<sigma>\<^bsub>c\<^esub>(lnth t i)"
 proof -
   from assms have "enat i < llength t" using Suc_ile_eq[of i "llength t"] by auto
   with assms have "\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t) = (\<pi>\<^bsub>c\<^esub>(ltake i t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)" by simp
   moreover have "lnth ((\<pi>\<^bsub>c\<^esub>(ltake i t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l))
     (the_enat (llength (\<pi>\<^bsub>c\<^esub>(ltake i t)))) = \<sigma>\<^bsub>c\<^esub>(lnth t i)"
   proof -
     have "\<not> lnull ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)" by simp
     moreover have "lfinite (\<pi>\<^bsub>c\<^esub>(ltake i t))" by simp
     ultimately have "lnth ((\<pi>\<^bsub>c\<^esub>(ltake i t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l))
       (the_enat (llength (\<pi>\<^bsub>c\<^esub>(ltake i t)))) = lhd ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l)" by simp
     also have "\<dots> = \<sigma>\<^bsub>c\<^esub>(lnth t i)" by simp
     finally show "lnth ((\<pi>\<^bsub>c\<^esub>(ltake i t)) @\<^sub>l ((\<sigma>\<^bsub>c\<^esub>(lnth t i)) #\<^sub>l []\<^sub>l))
       (the_enat (llength (\<pi>\<^bsub>c\<^esub>(ltake i t)))) = \<sigma>\<^bsub>c\<^esub>(lnth t i)" by simp
   qed
   ultimately have "\<sigma>\<^bsub>c\<^esub>(lnth t i) = lnth (\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t))
     (the_enat (llength (\<pi>\<^bsub>c\<^esub>(ltake i t))))" by simp
   also have "\<dots> = lnth (\<pi>\<^bsub>c\<^esub>(ltake (Suc i) t)) (the_enat (\<langle>c #\<^bsub>i\<^esub> t\<rangle>))" using nAct_def by simp
   also have "\<dots> = lnth (ltake (\<langle>c #\<^bsub>Suc i\<^esub> t\<rangle>) (\<pi>\<^bsub>c\<^esub>(t))) (the_enat (\<langle>c #\<^bsub>i\<^esub> t\<rangle>))"
     using proj_nAct[of "Suc i" t c] assms by simp
   also have "\<dots> = lnth (\<pi>\<^bsub>c\<^esub>(t)) (the_enat (\<langle>c #\<^bsub>i\<^esub> t\<rangle>))"
   proof -
     from assms have "\<langle>c #\<^bsub>Suc i\<^esub> t\<rangle> = eSuc (\<langle>c #\<^bsub>i\<^esub> t\<rangle>)" using \<open>enat i < llength t\<close> by simp
     moreover have "\<langle>c #\<^bsub>i\<^esub> t\<rangle> < eSuc (\<langle>c #\<^bsub>i\<^esub> t\<rangle>)" using iless_Suc_eq[of "the_enat (\<langle>c #\<^bsub>enat i\<^esub> t\<rangle>)"] by simp
     ultimately have "\<langle>c #\<^bsub>i\<^esub> t\<rangle> < (\<langle>c #\<^bsub>Suc i\<^esub> t\<rangle>)" by simp
     hence "enat (the_enat (\<langle>c #\<^bsub>Suc i\<^esub> t\<rangle>)) > enat (the_enat (\<langle>c #\<^bsub>i\<^esub> t\<rangle>))" by simp
     thus ?thesis using lnth_ltake[of "the_enat (\<langle>c #\<^bsub>i\<^esub> t\<rangle>)" "the_enat (\<langle>c #\<^bsub>enat (Suc i)\<^esub> t\<rangle>)" "\<pi>\<^bsub>c\<^esub>(t)"] by simp
   qed
   finally show ?thesis ..
 qed
 
 lemma nAct_eq_proj:
   assumes "\<not>(\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>lnth t i\<^esub>)"
   shows "\<langle>c #\<^bsub>n\<^esub> t\<rangle> = llength (\<pi>\<^bsub>c\<^esub>(t))" (is "?lhs = ?rhs")
 proof -
   from nAct_def have "?lhs = llength (\<pi>\<^bsub>c\<^esub>(ltake n t))" by simp
   moreover from assms have "\<forall>(n'::nat)\<le>llength t. n'\<ge>n \<longrightarrow> (\<not> \<parallel>c\<parallel>\<^bsub>lnth t n'\<^esub>)" by simp
   hence "\<pi>\<^bsub>c\<^esub>(t) = \<pi>\<^bsub>c\<^esub>(ltake n t)" using proj_ltake by simp
   ultimately show ?thesis by simp
 qed
 
 lemma nAct_llength_proj:
   assumes "\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
   shows "llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)) \<ge> eSuc (\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>)"
 proof -
   from \<open>\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub>\<close> obtain i where "i\<ge>n" and "\<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "\<not> (\<exists>k\<ge>n. k < i \<and> k < llength (inf_llist t) \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
     using lActive_least[of n "inf_llist t" c] by auto
   moreover have "llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)) \<ge> \<langle>c #\<^bsub>Suc i\<^esub> inf_llist t\<rangle>" using nAct_le_proj by simp
   moreover have "eSuc (\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>) = \<langle>c #\<^bsub>Suc i\<^esub> inf_llist t\<rangle>"
   proof -
     have "enat (Suc i) < llength (inf_llist t)" by simp
     moreover have "i < Suc i" by simp
     moreover from \<open>\<not> (\<exists>k\<ge>n. k < i \<and> k < llength (inf_llist t) \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)\<close>
       have "\<forall>i'. n \<le> i' \<and> i' < Suc i \<and> \<parallel>c\<parallel>\<^bsub>lnth (inf_llist t) i'\<^esub> \<longrightarrow> i' = i" by fastforce
     ultimately show ?thesis using nAct_active_suc \<open>i\<ge>n\<close> \<open>\<parallel>c\<parallel>\<^bsub>t i\<^esub>\<close> by simp
   qed
   ultimately show ?thesis by simp
 qed
   
 subsection "Least not Active"
 text \<open>
   In the following, we introduce an operator to obtain the least point in time before a certain point in time where a component was deactivated.
 \<close>
 
 definition lNAct :: "'id \<Rightarrow> (nat \<Rightarrow> cnf) \<Rightarrow> nat \<Rightarrow> nat" ("\<langle>_ \<Leftarrow> _\<rangle>\<^bsub>_\<^esub>")
   where "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<equiv> (LEAST n'. n=n' \<or> (n'<n \<and> (\<nexists>k. k\<ge>n' \<and> k<n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)))"
 
 lemma lNact0[simp]:
   "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>0\<^esub> = 0"
   by (simp add: lNAct_def)
     
 lemma lNact_least:
   assumes "n=n' \<or> n'<n \<and> (\<nexists>k. k\<ge>n' \<and> k<n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
   shows "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<le> n'"
 using Least_le[of "\<lambda>n'. n=n' \<or> (n'<n \<and> (\<nexists>k. k\<ge>n' \<and> k<n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>))" n'] lNAct_def using assms by auto
     
 lemma lNAct_ex: "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>=n \<or> \<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub><n \<and> (\<nexists>k. k\<ge>\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<and> k<n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
 proof -
   let ?P="\<lambda>n'. n=n' \<or> n'<n \<and> (\<nexists>k. k\<ge>n' \<and> k<n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
   from lNAct_def have "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> = (LEAST n'. ?P n')" by simp
   moreover have "?P n" by simp
   with LeastI have "?P (LEAST n'. ?P n')" .
   ultimately show ?thesis by auto
 qed
     
 lemma lNact_notActive:
   fixes c t n k
   assumes "k\<ge>\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>"
     and "k<n"
   shows "\<not>\<parallel>c\<parallel>\<^bsub>t k\<^esub>"
   by (metis assms lNAct_ex leD)
     
 lemma lNactGe:
   fixes c t n n'
   assumes "n' \<ge> \<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>" 
     and "\<parallel>c\<parallel>\<^bsub>t n'\<^esub>"
   shows "n' \<ge> n"
   using assms lNact_notActive leI by blast
 
 lemma lNactLe[simp]:
   fixes n n'
   shows "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<le> n"
   using lNAct_ex less_or_eq_imp_le by blast
     
 lemma lNactLe_nact:
   fixes n n'
   assumes "n'=n \<or> (n'<n \<and> (\<nexists>k. k\<ge>n' \<and> k<n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>))"
   shows "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<le> n'"
   using assms lNAct_def Least_le[of "\<lambda>n'. n=n' \<or> (n'<n \<and> (\<nexists>k. k\<ge>n' \<and> k<n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>))"] by auto
     
 lemma lNact_active:
   fixes cid t n
   assumes "\<forall>k<n. \<parallel>cid\<parallel>\<^bsub>t k\<^esub>"
   shows "\<langle>cid \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> = n"
   using assms lNAct_ex by blast
     
 lemma nAct_mono_back:
   fixes c t and n and n'
   assumes "\<langle>c #\<^bsub>n'\<^esub> inf_llist t\<rangle> \<ge> \<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>"
   shows "n'\<ge>\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>"
 proof cases
   assume "\<langle>c #\<^bsub>n'\<^esub> inf_llist t\<rangle> = \<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>"
   thus ?thesis
   proof cases
     assume "n'\<ge>n"
-    thus ?thesis using lNactLe by (metis HOL.no_atp(11))
+    thus ?thesis
+      by (rule order_trans[OF lNactLe])
   next
     assume "\<not> n'\<ge>n"
     hence "n'<n" by simp
     with \<open>\<langle>c #\<^bsub>n'\<^esub> inf_llist t\<rangle> = \<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>\<close> have "\<nexists>k. k\<ge>n' \<and> k<n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>"
       by (metis enat_ord_simps(1) enat_ord_simps(2) nAct_same_not_active)
     thus ?thesis using lNactLe_nact by (simp add: \<open>n' < n\<close>)
   qed
 next
   assume "\<not>\<langle>c #\<^bsub>n'\<^esub> inf_llist t\<rangle> = \<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>"
   with assms have "\<langle>c #\<^bsub>enat n'\<^esub> inf_llist t\<rangle> > \<langle>c #\<^bsub>enat n\<^esub> inf_llist t\<rangle>" by simp
   hence "n' > n" using nAct_strict_mono_back[of c "enat n" "inf_llist t" "enat n'"] by simp
   thus ?thesis by (meson dual_order.strict_implies_order lNactLe le_trans)
 qed
   
 lemma nAct_mono_lNact:
   assumes "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<le> n'"
   shows "\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle> \<le> \<langle>c #\<^bsub>n'\<^esub> inf_llist t\<rangle>"
 proof -
   have "\<nexists>k. k\<ge>\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<and> k<n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>" using lNact_notActive by auto
   moreover have "enat n - 1 < llength (inf_llist t)" by (simp add: one_enat_def)
   moreover from \<open>\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<le> n'\<close> have "enat \<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<le> enat n" by simp
   ultimately have "\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>=\<langle>c #\<^bsub>\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle>" using nAct_not_active_same by simp
   thus ?thesis using nAct_mono assms by simp
 qed
  
 subsection "Next Active"
 text \<open>
   In the following, we introduce an operator to obtain the next point in time when a component is activated.
 \<close>
   
 definition nxtAct :: "'id \<Rightarrow> (nat \<Rightarrow> cnf) \<Rightarrow> nat \<Rightarrow> nat" ("\<langle>_ \<rightarrow> _\<rangle>\<^bsub>_\<^esub>")
   where "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> \<equiv> (THE n'. n'\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t n'\<^esub> \<and> (\<nexists>k. k\<ge>n \<and> k<n' \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>))"
 
 lemma nxtActI:
   fixes n::nat
     and t::"nat \<Rightarrow> cnf"
     and c::'id
   assumes "\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
   shows "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> \<ge> n \<and> \<parallel>c\<parallel>\<^bsub>t \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> \<and> (\<nexists>k. k\<ge>n \<and> k<\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
 proof -
   let ?P = "THE n'. n'\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t n'\<^esub> \<and> (\<nexists>k. k\<ge>n \<and> k<n' \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
   from assms obtain i where "i\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t i\<^esub> \<and> (\<nexists>k. k\<ge>n \<and> k<i \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
     using lActive_least[of n "inf_llist t" c] by auto
   moreover have "(\<And>x. n \<le> x \<and> \<parallel>c\<parallel>\<^bsub>t x\<^esub> \<and> \<not> (\<exists>k\<ge>n. k < x \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>) \<Longrightarrow> x = i)"
   proof -
     fix x assume "n \<le> x \<and> \<parallel>c\<parallel>\<^bsub>t x\<^esub> \<and> \<not> (\<exists>k\<ge>n. k < x \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
     show "x = i"
     proof (rule ccontr)
       assume "\<not> (x = i)"
       thus False using \<open>i\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t i\<^esub> \<and> (\<nexists>k. k\<ge>n \<and> k<i \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)\<close>
         \<open>n \<le> x \<and> \<parallel>c\<parallel>\<^bsub>t x\<^esub> \<and> \<not> (\<exists>k\<ge>n. k < x \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)\<close> by fastforce
     qed
   qed
   ultimately have "(?P) \<ge> n \<and> \<parallel>c\<parallel>\<^bsub>t (?P)\<^esub> \<and> (\<nexists>k. k\<ge>n \<and> k<?P \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
     using theI[of "\<lambda>n'. n'\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t n'\<^esub> \<and> (\<nexists>k. k\<ge>n \<and> k<n' \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"] by blast
   thus ?thesis using nxtAct_def[of c t n] by metis
 qed
   
 lemma nxtActLe:
   fixes n n'
   assumes "\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
   shows "n \<le> \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>"
   by (simp add: assms nxtActI)
 
 lemma nxtAct_eq:
   assumes "n'\<ge>n"
     and "\<parallel>c\<parallel>\<^bsub>t n'\<^esub>"
     and "\<forall>n''\<ge>n. n''<n' \<longrightarrow> \<not> \<parallel>c\<parallel>\<^bsub>t n''\<^esub>"
   shows "n' = \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>"
   by (metis assms(1) assms(2) assms(3) nxtActI linorder_neqE_nat nxtActLe)
 
 lemma nxtAct_active:
   fixes i::nat
     and t::"nat \<Rightarrow> cnf"
     and c::'id
   assumes "\<parallel>c\<parallel>\<^bsub>t i\<^esub>"
   shows "\<langle>c \<rightarrow> t\<rangle>\<^bsub>i\<^esub> = i" by (metis assms le_eq_less_or_eq nxtActI)
     
 lemma nxtActive_no_active:
   assumes "\<exists>!i. i\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
   shows "\<not> (\<exists>i'\<ge>Suc \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>. \<parallel>c\<parallel>\<^bsub>t i'\<^esub>)"
 proof
   assume "\<exists>i'\<ge>Suc \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>. \<parallel>c\<parallel>\<^bsub>t i'\<^esub>"
   then obtain i' where "i'\<ge>Suc \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>" and "\<parallel>c\<parallel>\<^bsub>t i'\<^esub>" by auto
   moreover from assms(1) have "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<ge>n" using nxtActI by auto
   ultimately have "i'\<ge>n" and "\<parallel>c\<parallel>\<^bsub>t i'\<^esub>" and "i'\<noteq>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>" by auto
   moreover from assms(1) have "\<parallel>c\<parallel>\<^bsub>t \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub>" and "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<ge>n" using nxtActI by auto
   ultimately show False using assms(1) by auto
 qed
   
 lemma nxt_geq_lNact[simp]:
   assumes "\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
   shows "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<ge>\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>"
 proof -
   from assms have "n \<le> \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>" using nxtActLe by simp
   moreover have "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>\<le>n" by simp
   ultimately show ?thesis by arith
 qed
   
 lemma active_geq_nxtAct:
   assumes "\<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "the_enat (\<langle>c #\<^bsub>i\<^esub> inf_llist t\<rangle>)\<ge>the_enat (\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>)"
   shows "i\<ge>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>"
 proof cases
   assume "\<langle>c #\<^bsub>i\<^esub> inf_llist t\<rangle>=\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>"
   show ?thesis
   proof (rule ccontr)
     assume "\<not> i\<ge>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>"
     hence "i<\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>" by simp
     with \<open>\<langle>c #\<^bsub>i\<^esub> inf_llist t\<rangle>=\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>\<close> have "\<not> (\<exists>k\<ge>i. k < n \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)"
       by (metis enat_ord_simps(1) leD leI nAct_same_not_active)
     moreover have "\<not> (\<exists>k\<ge>n. k <\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)" using nxtActI by blast
     ultimately have "\<not> (\<exists>k\<ge>i. k <\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>)" by auto
     with \<open>i<\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<close> show False using \<open>\<parallel>c\<parallel>\<^bsub>t i\<^esub>\<close> by simp
   qed
 next
   assume "\<not>\<langle>c #\<^bsub>i\<^esub> inf_llist t\<rangle>=\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>"
   moreover from \<open>the_enat (\<langle>c #\<^bsub>i\<^esub> inf_llist t\<rangle>)\<ge>the_enat (\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>)\<close>
   have "\<langle>c #\<^bsub>i\<^esub> inf_llist t\<rangle>\<ge>\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>"
     by (metis enat.distinct(2) enat_ord_simps(1) nAct_enat_the_nat)
   ultimately have "\<langle>c #\<^bsub>i\<^esub> inf_llist t\<rangle>>\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>" by simp
   hence "i>n" using nAct_strict_mono_back[of c n "inf_llist t" i] by simp
   with \<open>\<parallel>c\<parallel>\<^bsub>t i\<^esub>\<close> show ?thesis by (meson dual_order.strict_implies_order leI nxtActI)
 qed
 
 lemma nAct_same:
   assumes "\<langle>c \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<le> n'" and "n' \<le> \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>"
   shows "the_enat (\<langle>c #\<^bsub>enat n'\<^esub> inf_llist t\<rangle>) = the_enat (\<langle>c #\<^bsub>enat n\<^esub> inf_llist t\<rangle>)"
 proof cases
   assume "n \<le> n'"
   moreover have "n' - 1 < llength (inf_llist t)" by simp
   moreover have "\<not> (\<exists>i\<ge>n. i <n' \<and> \<parallel>c\<parallel>\<^bsub>t i\<^esub>)" by (meson assms(2) less_le_trans nxtActI)
   ultimately show ?thesis using nAct_not_active_same by (simp add: one_enat_def)
 next
   assume "\<not> n \<le> n'"
   hence "n' < n" by simp
   moreover have "n - 1 < llength (inf_llist t)" by simp
   moreover have "\<not> (\<exists>i\<ge>n'. i < n \<and> \<parallel>c\<parallel>\<^bsub>t i\<^esub>)" by (metis \<open>\<not> n \<le> n'\<close> assms(1) dual_order.trans lNAct_ex)
   ultimately show ?thesis using nAct_not_active_same[of n' n] by (simp add: one_enat_def)
 qed
   
 lemma nAct_mono_nxtAct:
   assumes "\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> \<le> n'"
   shows "\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle> \<le> \<langle>c #\<^bsub>n'\<^esub> inf_llist t\<rangle>"
 proof -
   from assms have "\<langle>c #\<^bsub>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle> \<le> \<langle>c #\<^bsub>n'\<^esub> inf_llist t\<rangle>" using nAct_mono assms by simp
   moreover have "\<langle>c #\<^bsub>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle>=\<langle>c #\<^bsub>n\<^esub> inf_llist t\<rangle>"
   proof -
     from assms have "\<nexists>k. k\<ge>n \<and> k<\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> \<and> \<parallel>c\<parallel>\<^bsub>t k\<^esub>" and "n \<le> \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>" using nxtActI by auto
     moreover have "enat \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> - 1 < llength (inf_llist t)" by (simp add: one_enat_def)
     ultimately show ?thesis using nAct_not_active_same[of n "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>"] by auto
   qed
   ultimately show ?thesis by simp
 qed
 
 subsection "Latest Activation"
 text \<open>
   In the following, we introduce an operator to obtain the latest point in time when a component is activated.
 \<close>
 
 abbreviation latestAct_cond:: "'id \<Rightarrow> trace \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool"
   where "latestAct_cond c t n n' \<equiv> n'<n \<and> \<parallel>c\<parallel>\<^bsub>t n'\<^esub>"
 
 definition latestAct:: "'id \<Rightarrow> trace \<Rightarrow> nat \<Rightarrow> nat" ("\<langle>_ \<leftarrow> _\<rangle>\<^bsub>_\<^esub>")
   where "latestAct c t n = (GREATEST n'. latestAct_cond c t n n')"
 
 lemma latestActEx:
   assumes "\<exists>n'<n. \<parallel>nid\<parallel>\<^bsub>t n'\<^esub>"
   shows "\<exists>n'. latestAct_cond nid t n n' \<and> (\<forall>n''. latestAct_cond nid t n n'' \<longrightarrow> n'' \<le> n')"
 proof -
   from assms obtain n' where "latestAct_cond nid t n n'" by auto
   moreover have "\<forall>n''>n. \<not> latestAct_cond nid t n n''" by simp
   ultimately obtain n' where "latestAct_cond nid t n n' \<and> (\<forall>n''. latestAct_cond nid t n n'' \<longrightarrow> n'' \<le> n')"
     using boundedGreatest[of "latestAct_cond nid t n" n'] by blast
   thus ?thesis ..
 qed
 
 lemma latestAct_prop:
   assumes "\<exists>n'<n. \<parallel>nid\<parallel>\<^bsub>t n'\<^esub>"
   shows "\<parallel>nid\<parallel>\<^bsub>t (latestAct nid t n)\<^esub>" and "latestAct nid t n<n"
 proof -
   from assms latestActEx have "latestAct_cond nid t n (GREATEST x. latestAct_cond nid t n x)"
     using GreatestI_ex_nat[of "latestAct_cond nid t n"] by blast
   thus "\<parallel>nid\<parallel>\<^bsub>t \<langle>nid \<leftarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub>" and "latestAct nid t n<n" using latestAct_def by auto
 qed
 
 lemma latestAct_less:
   assumes "latestAct_cond nid t n n'"
   shows "n' \<le> \<langle>nid \<leftarrow> t\<rangle>\<^bsub>n\<^esub>"
 proof -
   from assms latestActEx have "n' \<le> (GREATEST x. latestAct_cond nid t n x)"
     using Greatest_le_nat[of "latestAct_cond nid t n"] by blast
   thus ?thesis using latestAct_def by auto
 qed
 
 lemma latestActNxt:
   assumes "\<exists>n'<n. \<parallel>nid\<parallel>\<^bsub>t n'\<^esub>"
   shows "\<langle>nid \<rightarrow> t\<rangle>\<^bsub>\<langle>nid \<leftarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub>=\<langle>nid \<leftarrow> t\<rangle>\<^bsub>n\<^esub>"
   using assms latestAct_prop(1) nxtAct_active by auto
 
 lemma latestActNxtAct:
   assumes "\<exists>n'\<ge>n. \<parallel>tid\<parallel>\<^bsub>t n'\<^esub>"
     and "\<exists>n'<n. \<parallel>tid\<parallel>\<^bsub>t n'\<^esub>"
   shows "\<langle>tid \<rightarrow> t\<rangle>\<^bsub>n\<^esub> > \<langle>tid \<leftarrow> t\<rangle>\<^bsub>n\<^esub>"
   by (meson assms latestAct_prop(2) less_le_trans nxtActI zero_le)
 
 lemma latestActless:
   assumes "\<exists>n'\<ge>n\<^sub>s. n'<n \<and> \<parallel>nid\<parallel>\<^bsub>t n'\<^esub>"
   shows "\<langle>nid \<leftarrow> t\<rangle>\<^bsub>n\<^esub>\<ge>n\<^sub>s"
   by (meson assms dual_order.trans latestAct_less)
 
 lemma latestActEq:
   fixes nid::'id
   assumes "\<parallel>nid\<parallel>\<^bsub>t n'\<^esub>" and "\<not>(\<exists>n''>n'. n''<n \<and> \<parallel>nid\<parallel>\<^bsub>t n'\<^esub>)" and "n'<n"
   shows "\<langle>nid \<leftarrow> t\<rangle>\<^bsub>n\<^esub> = n'"
   using latestAct_def
 proof
   have "(GREATEST n'. latestAct_cond nid t n n') = n'"
   proof (rule Greatest_equality[of "latestAct_cond nid t n" n'])
     from assms(1) assms (3) show "latestAct_cond nid t n n'" by simp
   next
     fix y assume "latestAct_cond nid t n y"
     hence "\<parallel>nid\<parallel>\<^bsub>t y\<^esub>" and "y<n" by auto
     thus "y \<le> n'" using assms(1) assms (2) leI by blast
   qed
   thus "n' = (GREATEST n'. latestAct_cond nid t n n')" by simp
 qed
   
 subsection "Last Activation"
 text \<open>
   In the following we introduce an operator to obtain the latest point in time where a certain component was activated within a certain configuration trace.
 \<close>
 
 definition lActive :: "'id \<Rightarrow> (nat \<Rightarrow> cnf) \<Rightarrow> nat" ("\<langle>_ \<and> _\<rangle>")
   where "\<langle>c \<and> t\<rangle> \<equiv> (GREATEST i. \<parallel>c\<parallel>\<^bsub>t i\<^esub>)"
 
 lemma lActive_active:
   assumes "\<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "\<forall>n' > n. \<not> (\<parallel>c\<parallel>\<^bsub>t n'\<^esub>)"
   shows "\<parallel>c\<parallel>\<^bsub>t (\<langle>c \<and> t\<rangle>)\<^esub>"
 proof -
   from assms obtain i' where "\<parallel>c\<parallel>\<^bsub>t i'\<^esub>" and "\<And>y. \<parallel>c\<parallel>\<^bsub>t y\<^esub> \<Longrightarrow> y \<le> i'"
     using boundedGreatest[of "\<lambda>i'. \<parallel>c\<parallel>\<^bsub>t i'\<^esub>" i n] by blast
   thus ?thesis using lActive_def Nat.GreatestI_nat[of "\<lambda>i'. \<parallel>c\<parallel>\<^bsub>t i'\<^esub>"] by metis
 qed
 
 lemma lActive_less:
   assumes "\<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "\<forall>n' > n. \<not> (\<parallel>c\<parallel>\<^bsub>t n'\<^esub>)"
   shows "\<langle>c \<and> t\<rangle> \<le> n"
 proof (rule ccontr)
   assume "\<not> \<langle>c \<and> t\<rangle> \<le> n"
   hence "\<langle>c \<and> t\<rangle> > n" by simp
   moreover from assms have "\<parallel>c\<parallel>\<^bsub>t (\<langle>c \<and> t\<rangle>)\<^esub>" using lActive_active by simp
   ultimately show False using assms by simp
 qed
 
 lemma lActive_greatest:
   assumes "\<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "\<forall>n' > n. \<not> (\<parallel>c\<parallel>\<^bsub>t n'\<^esub>)"
   shows "i \<le> \<langle>c \<and> t\<rangle>"
 proof -
   from assms obtain i' where "\<parallel>c\<parallel>\<^bsub>t i'\<^esub>" and "\<And>y. \<parallel>c\<parallel>\<^bsub>t y\<^esub> \<Longrightarrow> y \<le> i'"
     using boundedGreatest[of "\<lambda>i'. \<parallel>c\<parallel>\<^bsub>t i'\<^esub>" i n] by blast
   with assms show ?thesis using lActive_def Nat.Greatest_le_nat[of "\<lambda>i'. \<parallel>c\<parallel>\<^bsub>t i'\<^esub>" i] by metis
 qed
   
 lemma lActive_greater_active:
   assumes "n > \<langle>c \<and> t\<rangle>"
     and "\<forall>n'' > n'. \<not> \<parallel>c\<parallel>\<^bsub>t n''\<^esub>"
   shows "\<not> \<parallel>c\<parallel>\<^bsub>t n\<^esub>"
 proof (rule ccontr)
   assume "\<not> \<not> \<parallel>c\<parallel>\<^bsub>t n\<^esub>"
   with \<open>\<forall>n'' > n'. \<not> \<parallel>c\<parallel>\<^bsub>t n''\<^esub>\<close> have "n \<le> \<langle>c \<and> t\<rangle>" using lActive_greatest by simp
   thus False using assms by simp
 qed
   
 lemma lActive_greater_active_all:
   assumes "\<forall>n'' > n'. \<not> \<parallel>c\<parallel>\<^bsub>t n''\<^esub>"
   shows "\<not>(\<exists>n > \<langle>c \<and> t\<rangle>. \<parallel>c\<parallel>\<^bsub>t n\<^esub>)" 
 proof (rule ccontr)
   assume "\<not>\<not>(\<exists>n > \<langle>c \<and> t\<rangle>. \<parallel>c\<parallel>\<^bsub>t n\<^esub>)"
   then obtain "n" where "n>\<langle>c \<and> t\<rangle>" and "\<parallel>c\<parallel>\<^bsub>t n\<^esub>" by blast
   with \<open>\<forall>n'' > n'. \<not> (\<parallel>c\<parallel>\<^bsub>t n''\<^esub>)\<close> have "\<not> \<parallel>c\<parallel>\<^bsub>t n\<^esub>" using lActive_greater_active by simp
   with \<open>\<parallel>c\<parallel>\<^bsub>t n\<^esub>\<close> show False by simp
 qed
 
 lemma lActive_equality:
   assumes "\<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "(\<And>x. \<parallel>c\<parallel>\<^bsub>t x\<^esub> \<Longrightarrow> x \<le> i)"
   shows "\<langle>c \<and> t\<rangle> = i" unfolding lActive_def using assms Greatest_equality[of "\<lambda>i'. \<parallel>c\<parallel>\<^bsub>t i'\<^esub>"] by simp
     
 lemma nxtActive_lactive:
   assumes "\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "\<not> (\<exists>i>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>. \<parallel>c\<parallel>\<^bsub>t i\<^esub>)"
   shows "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>=\<langle>c \<and> t\<rangle>"
 proof -
   from assms(1) have "\<parallel>c\<parallel>\<^bsub>t \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub>" using nxtActI by auto
   moreover from assms have "\<not> (\<exists>i'\<ge>Suc \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>. \<parallel>c\<parallel>\<^bsub>t i'\<^esub>)" using nxtActive_no_active by simp
   hence "(\<And>x. \<parallel>c\<parallel>\<^bsub>t x\<^esub> \<Longrightarrow> x \<le> \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>)" using not_less_eq_eq by auto
   ultimately show ?thesis using \<open>\<not> (\<exists>i'\<ge>Suc \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>. \<parallel>c\<parallel>\<^bsub>t i'\<^esub>)\<close> lActive_equality by simp
 qed
     
 subsection "Mapping Time Points"
 text \<open>
   In the following we introduce two operators to map time-points between configuration traces and behavior traces.
 \<close>
 
 subsubsection "Configuration Trace to Behavior Trace"
 text \<open>
   First we provide an operator which maps a point in time of a configuration trace to the corresponding point in time of a behavior trace.
 \<close>
   
 definition cnf2bhv :: "'id \<Rightarrow> (nat \<Rightarrow> cnf) \<Rightarrow> nat \<Rightarrow> nat" ("\<^bsub>_\<^esub>\<down>\<^bsub>_\<^esub>(_)" [150,150,150] 110)
   where "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n) \<equiv> the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1 + (n - \<langle>c \<and> t\<rangle>)"
 
 lemma cnf2bhv_mono:
   assumes "n'\<ge>n"
   shows "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n') \<ge> \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n)"
   by (simp add: assms cnf2bhv_def diff_le_mono)
 
 lemma cnf2bhv_mono_strict:
   assumes "n\<ge>\<langle>c \<and> t\<rangle>" and "n'>n"
   shows "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n') > \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n)"
   using assms cnf2bhv_def by auto
 
 text "Note that the functions are nat, that means that also in the case the difference is negative they will return a 0!"
 lemma cnf2bhv_ge_llength[simp]:
   assumes "n\<ge>\<langle>c \<and> t\<rangle>"
   shows "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n) \<ge> the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1"
   using assms cnf2bhv_def by simp
 
 lemma cnf2bhv_greater_llength[simp]:
   assumes "n>\<langle>c \<and> t\<rangle>"
   shows "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n) > the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1"
   using assms cnf2bhv_def by simp
 
 lemma cnf2bhv_suc[simp]:
   assumes "n\<ge>\<langle>c \<and> t\<rangle>"
   shows "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(Suc n) = Suc (\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n))"
   using assms cnf2bhv_def by simp
 
 lemma cnf2bhv_lActive[simp]:
   shows "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(\<langle>c \<and> t\<rangle>) = the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1"
   using cnf2bhv_def by simp
     
 lemma cnf2bhv_lnth_lappend:
   assumes act: "\<exists>i. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and nAct: "\<nexists>i. i\<ge>n \<and> \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
   shows "lnth ((\<pi>\<^bsub>c\<^esub>(inf_llist t)) @\<^sub>l (inf_llist t')) (\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n)) = lnth (inf_llist t') (n - \<langle>c \<and> t\<rangle> - 1)"
     (is "?lhs = ?rhs")
 proof -
   from nAct have "lfinite (\<pi>\<^bsub>c\<^esub>(inf_llist t))" using proj_finite2 by auto
   then obtain k where k_def: "llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)) = enat k" using lfinite_llength_enat by blast
   moreover have "k \<le> \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n)"
   proof -
     from nAct have "\<nexists>i. i>n-1 \<and> \<parallel>c\<parallel>\<^bsub>t i\<^esub>" by simp
     with act have "\<langle>c \<and> t\<rangle> \<le> n-1" using lActive_less by auto
     moreover have "n>0" using act nAct by auto
     ultimately have "\<langle>c \<and> t\<rangle> < n" by simp
     hence "the_enat (llength (\<pi>\<^bsub>c\<^esub>inf_llist t)) - 1 < \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n)" using cnf2bhv_greater_llength by simp
     with k_def show ?thesis by simp
   qed
   ultimately have "?lhs = lnth (inf_llist t') (\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n) - k)" using lnth_lappend2 by blast
   moreover have "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n) - k = n - \<langle>c \<and> t\<rangle> - 1"
   proof -
     from cnf2bhv_def have "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n) - k = the_enat (llength (\<pi>\<^bsub>c\<^esub>inf_llist t)) - 1 + (n - \<langle>c \<and> t\<rangle>) - k"
       by simp
     also have "\<dots> = the_enat (llength (\<pi>\<^bsub>c\<^esub>inf_llist t)) - 1 + (n - \<langle>c \<and> t\<rangle>) -
       the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)))" using k_def by simp
     also have "\<dots> = the_enat (llength (\<pi>\<^bsub>c\<^esub>inf_llist t)) + (n - \<langle>c \<and> t\<rangle>) - 1 -
       the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)))"
     proof -
       have "\<exists>i. enat i < llength (inf_llist t) \<and> \<parallel>c\<parallel>\<^bsub>lnth (inf_llist t) i\<^esub>" by (simp add: act)
       hence "llength (\<pi>\<^bsub>c\<^esub>inf_llist t) \<ge> 1" using proj_one by simp
       moreover from k_def have "llength (\<pi>\<^bsub>c\<^esub>inf_llist t) \<noteq> \<infinity>" by simp
       ultimately have "the_enat (llength (\<pi>\<^bsub>c\<^esub>inf_llist t)) \<ge> 1" by (simp add: k_def one_enat_def)
       thus ?thesis by simp
     qed
     also have "\<dots> = the_enat (llength (\<pi>\<^bsub>c\<^esub>inf_llist t)) + (n - \<langle>c \<and> t\<rangle>) -
       the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1" by simp
     also have "\<dots> = n - \<langle>c \<and> t\<rangle> - 1" by simp
     finally show ?thesis .
   qed
   ultimately show ?thesis by simp
 qed
 
 lemma nAct_cnf2proj_Suc_dist:
   assumes "\<exists>i\<ge>n. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "\<not>(\<exists>i>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>. \<parallel>c\<parallel>\<^bsub>t i\<^esub>)"
   shows "Suc (the_enat \<langle>c #\<^bsub>enat n\<^esub>inf_llist t\<rangle>)=\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(Suc \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>)"
 proof -
   have "the_enat \<langle>c #\<^bsub>enat n\<^esub>inf_llist t\<rangle> = \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>)" (is "?LHS = ?RHS")
   proof -
     from assms have "?RHS = the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1"
       using nxtActive_lactive[of n c t] by simp
     also have "llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)) = eSuc (\<langle>c #\<^bsub>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle>)"
     proof -
       from assms have "\<not> (\<exists>i'\<ge> Suc (\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>). \<parallel>c\<parallel>\<^bsub>t i'\<^esub>)" using nxtActive_no_active by simp
       hence "\<langle>c #\<^bsub>Suc (\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>)\<^esub> inf_llist t\<rangle> = llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))"
         using nAct_eq_proj[of "Suc (\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>)" c "inf_llist t"] by simp
       moreover from assms(1) have "\<parallel>c\<parallel>\<^bsub>t (\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>)\<^esub>" using nxtActI by blast
       hence "\<langle>c #\<^bsub>Suc (\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>)\<^esub> inf_llist t\<rangle> = eSuc (\<langle>c #\<^bsub>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle>)" by simp
       ultimately show ?thesis by simp
     qed
     also have "the_enat(eSuc (\<langle>c #\<^bsub>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle>)) - 1 = (\<langle>c #\<^bsub>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle>)"
     proof -
       have "\<langle>c #\<^bsub>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle> \<noteq> \<infinity>" by simp
       hence "the_enat(eSuc (\<langle>c #\<^bsub>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle>)) = Suc(the_enat(\<langle>c #\<^bsub>\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub> inf_llist t\<rangle>))"
         using the_enat_eSuc by simp
       thus ?thesis by simp
     qed
     also have "\<dots> = ?LHS"
     proof -
       have "enat \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> - 1 < llength (inf_llist t)" by (simp add: one_enat_def)
       moreover from assms(1) have "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<ge>n" and
         "\<nexists>k. enat n \<le> enat k \<and> enat k < enat \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub> \<and> \<parallel>c\<parallel>\<^bsub>lnth (inf_llist t) k\<^esub>" using nxtActI by auto
       ultimately have "\<langle>c #\<^bsub>enat \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<^esub>inf_llist t\<rangle> = \<langle>c #\<^bsub>enat n\<^esub>inf_llist t\<rangle>"
         using nAct_not_active_same[of n "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>" "inf_llist t" c] by simp
       moreover have "\<langle>c #\<^bsub>enat n\<^esub>inf_llist t\<rangle>\<noteq>\<infinity>" by simp
       ultimately show ?thesis by auto
     qed
     finally show ?thesis by fastforce
   qed      
   moreover from assms have "\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>=\<langle>c \<and> t\<rangle>" using nxtActive_lactive by simp
   hence "Suc (\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>)) = \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(Suc \<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>)" using cnf2bhv_suc[where n="\<langle>c \<rightarrow> t\<rangle>\<^bsub>n\<^esub>"] by simp
   ultimately show ?thesis by simp
 qed
 
 subsubsection "Behavior Trace to Configuration Trace"
 text \<open>
   Next we define an operator to map a point in time of a behavior trace back to a corresponding point in time for a configuration trace.
 \<close>
 
 definition bhv2cnf :: "'id \<Rightarrow> (nat \<Rightarrow> cnf) \<Rightarrow> nat \<Rightarrow> nat" ("\<^bsub>_\<^esub>\<up>\<^bsub>_\<^esub>(_)" [150,150,150] 110)
   where "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n) \<equiv> \<langle>c \<and> t\<rangle> + (n - (the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1))"
 
 lemma bhv2cnf_mono:
   assumes "n'\<ge>n"
   shows "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n') \<ge> \<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n)"
   by (simp add: assms bhv2cnf_def diff_le_mono)    
 
 lemma bhv2cnf_mono_strict:
   assumes "n'>n"
     and "n \<ge> the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1"
   shows "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n') > \<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n)"
   using assms bhv2cnf_def by auto
 
 text "Note that the functions are nat, that means that also in the case the difference is negative they will return a 0!"
 lemma bhv2cnf_ge_lActive[simp]:
   shows "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n) \<ge> \<langle>c \<and> t\<rangle>"
   using bhv2cnf_def by simp
 
 lemma bhv2cnf_greater_lActive[simp]:
   assumes "n>the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1"
   shows "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n) > \<langle>c \<and> t\<rangle>"
   using assms bhv2cnf_def by simp
     
 lemma bhv2cnf_lActive[simp]:
   assumes "\<exists>i. \<parallel>c\<parallel>\<^bsub>t i\<^esub>"
     and "lfinite (\<pi>\<^bsub>c\<^esub>(inf_llist t))"
   shows "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)))) = Suc (\<langle>c \<and> t\<rangle>)"
 proof -
   from assms have "\<pi>\<^bsub>c\<^esub>(inf_llist t)\<noteq> []\<^sub>l" by simp
   hence "llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)) > 0" by (simp add: lnull_def)
   moreover from \<open>lfinite (\<pi>\<^bsub>c\<^esub>(inf_llist t))\<close> have "llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)) \<noteq> \<infinity>"
     using llength_eq_infty_conv_lfinite by auto
   ultimately have "the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) > 0" using enat_0_iff(1) by fastforce
   hence "the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - (the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1) = 1" by simp
   thus ?thesis using bhv2cnf_def by simp
 qed
   
 subsubsection "Relating the Mappings"
 text \<open>
   In the following we provide some properties about the relationship between the two mapping operators.
 \<close>
   
 lemma bhv2cnf_cnf2bhv:
   assumes "n \<ge> \<langle>c \<and> t\<rangle>"
   shows "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n)) = n" (is "?lhs = ?rhs")
 proof -
   have "?lhs = \<langle>c \<and> t\<rangle> + ((\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n)) - (the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1))"
     using bhv2cnf_def by simp
   also have "\<dots> = \<langle>c \<and> t\<rangle> + (((the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)))) - 1 + (n - \<langle>c \<and> t\<rangle>)) -
     (the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1))" using cnf2bhv_def by simp
   also have "(the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)))) - 1 + (n - (\<langle>c \<and> t\<rangle>)) -
     (the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1) = (the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)))) - 1 -
     ((the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t)))) - 1) + (n - (\<langle>c \<and> t\<rangle>))" by simp
   also have "\<dots> = n - (\<langle>c \<and> t\<rangle>)" by simp
   also have "(\<langle>c \<and> t\<rangle>) + (n - (\<langle>c \<and> t\<rangle>)) = (\<langle>c \<and> t\<rangle>) + n - \<langle>c \<and> t\<rangle>" using assms by simp
   also have "\<dots> = ?rhs" by simp
   finally show ?thesis .
 qed
     
 lemma cnf2bhv_bhv2cnf:
   assumes "n \<ge> the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1"
   shows "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n)) = n" (is "?lhs = ?rhs")
 proof -
   have "?lhs = the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1 + ((\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n)) - (\<langle>c \<and> t\<rangle>))"
     using cnf2bhv_def by simp
   also have "\<dots> = the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1 + (\<langle>c \<and> t\<rangle> +
     (n - (the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1)) - (\<langle>c \<and> t\<rangle>))" using bhv2cnf_def by simp
   also have "\<langle>c \<and> t\<rangle> + (n - (the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1)) - (\<langle>c \<and> t\<rangle>) =
     \<langle>c \<and> t\<rangle> - (\<langle>c \<and> t\<rangle>) + (n - (the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1))" by simp
   also have "\<dots> = n - (the_enat(llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1)" by simp      
   also have "the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1 + (n - (the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1)) =
     n - (the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1) + (the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1)" by simp
   also have "\<dots> = n + ((the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1) -
     (the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1))" using assms by simp
   also have "\<dots> = ?rhs" by simp
   finally show ?thesis .
 qed
   
 lemma p2c_mono_c2p:
   assumes "n \<ge> \<langle>c \<and> t\<rangle>"
       and "n' \<ge> \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n)"
     shows "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n') \<ge> n"
 proof -
   from \<open>n' \<ge> \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n)\<close> have "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n') \<ge> \<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n))" using bhv2cnf_mono by simp
   thus ?thesis using bhv2cnf_cnf2bhv \<open>n \<ge> \<langle>c \<and> t\<rangle>\<close> by simp
 qed
   
 lemma p2c_mono_c2p_strict:
   assumes "n \<ge> \<langle>c \<and> t\<rangle>"
       and "n<\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n')"
   shows "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n) < n'"
 proof (rule ccontr)
   assume "\<not> (\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n) < n')"
   hence "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n) \<ge> n'" by simp
   with \<open>n \<ge> \<langle>c \<and> t\<rangle>\<close> have "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(nat (\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n))) \<ge> \<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n')"
     using bhv2cnf_mono by simp
   hence "\<not>(\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(nat (\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n))) < \<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n'))" by simp
   with \<open>n \<ge> \<langle>c \<and> t\<rangle>\<close> have  "\<not>(n < \<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n'))"
     using "bhv2cnf_cnf2bhv" by simp
   with assms show False by simp
 qed
   
 lemma c2p_mono_p2c:
   assumes "n \<ge> the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1"
       and "n' \<ge> \<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n)"
     shows "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n') \<ge> n"
 proof -
   from \<open>n' \<ge> \<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n)\<close> have "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n') \<ge> \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n))" using cnf2bhv_mono by simp
   thus ?thesis using cnf2bhv_bhv2cnf \<open>n \<ge> the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1\<close> by simp
 qed
 
 lemma c2p_mono_p2c_strict:
   assumes "n \<ge> the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1"
       and "n<\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n')"
   shows "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n) < n'"
 proof (rule ccontr)
   assume "\<not> (\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n) < n')"
   hence "\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n) \<ge> n'" by simp
   with \<open>n \<ge> the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1\<close> have "\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(nat (\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n))) \<ge> \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n')"
     using cnf2bhv_mono by simp
   hence "\<not>(\<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(nat (\<^bsub>c\<^esub>\<up>\<^bsub>t\<^esub>(n))) < \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n'))" by simp
   with \<open>n \<ge> the_enat (llength (\<pi>\<^bsub>c\<^esub>(inf_llist t))) - 1\<close> have  "\<not>(n < \<^bsub>c\<^esub>\<down>\<^bsub>t\<^esub>(n'))"
     using "cnf2bhv_bhv2cnf" by simp
   with assms show False by simp
 qed
 
 end
 
 end
diff --git a/thys/QHLProver/Complex_Matrix.thy b/thys/QHLProver/Complex_Matrix.thy
--- a/thys/QHLProver/Complex_Matrix.thy
+++ b/thys/QHLProver/Complex_Matrix.thy
@@ -1,2351 +1,2352 @@
 section \<open>Complex matrices\<close>
 
 theory Complex_Matrix
   imports 
     "Jordan_Normal_Form.Matrix" 
     "Jordan_Normal_Form.Conjugate" 
     "Jordan_Normal_Form.Jordan_Normal_Form_Existence"
 begin
 
 subsection \<open>Trace of a matrix\<close>
 
 definition trace :: "'a::ring mat \<Rightarrow> 'a" where
   "trace A = (\<Sum> i \<in> {0 ..< dim_row A}. A $$ (i,i))"
 
 lemma trace_zero [simp]:
   "trace (0\<^sub>m n n) = 0"
   by (simp add: trace_def)
 
 lemma trace_id [simp]:
   "trace (1\<^sub>m n) = n"
   by (simp add: trace_def)
 
 lemma trace_comm:
   fixes A B :: "'a::comm_ring mat"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
   shows "trace (A * B) = trace (B * A)"
 proof (simp add: trace_def)
   have "(\<Sum>i = 0..<n. (A * B) $$ (i, i)) = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * B $$ (j,i))"
     apply (rule sum.cong) using assms by (auto simp add: scalar_prod_def)
   also have "\<dots> = (\<Sum>j = 0..<n. \<Sum>i = 0..<n. A $$ (i,j) * B $$ (j,i))"
     by (rule sum.swap)
   also have "\<dots> = (\<Sum>j = 0..<n. col A j \<bullet> row B j)"
     by (metis (no_types, lifting) A B atLeastLessThan_iff carrier_matD index_col index_row scalar_prod_def sum.cong)
   also have "\<dots> = (\<Sum>j = 0..<n. row B j \<bullet> col A j)"
     apply (rule sum.cong) apply auto
     apply (subst comm_scalar_prod[where n=n]) apply auto
     using assms by auto
   also have "\<dots> = (\<Sum>j = 0..<n. (B * A) $$ (j, j))"
     apply (rule sum.cong) using assms by auto
   finally show "(\<Sum>i = 0..<dim_row A. (A * B) $$ (i, i)) = (\<Sum>i = 0..<dim_row B. (B * A) $$ (i, i))"
     using A B by auto
 qed
 
 lemma trace_add_linear:
   fixes A B :: "'a::comm_ring mat"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
   shows "trace (A + B) = trace A + trace B" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>i=0..<n. A$$(i, i) + B$$(i, i))" unfolding trace_def using A B by auto
   also have "\<dots> = (\<Sum>i=0..<n. A$$(i, i)) + (\<Sum>i=0..<n. B$$(i, i))" by (auto simp add: sum.distrib)
   finally have l: "?lhs = (\<Sum>i=0..<n. A$$(i, i)) + (\<Sum>i=0..<n. B$$(i, i))".
   have r: "?rhs = (\<Sum>i=0..<n. A$$(i, i)) + (\<Sum>i=0..<n. B$$(i, i))" unfolding trace_def using A B by auto
   from l r show ?thesis by auto
 qed
 
 lemma trace_minus_linear:
   fixes A B :: "'a::comm_ring mat"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
   shows "trace (A - B) = trace A - trace B" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Sum>i=0..<n. A$$(i, i) - B$$(i, i))" unfolding trace_def using A B by auto
   also have "\<dots> = (\<Sum>i=0..<n. A$$(i, i)) - (\<Sum>i=0..<n. B$$(i, i))" by (auto simp add: sum_subtractf)
   finally have l: "?lhs = (\<Sum>i=0..<n. A$$(i, i)) - (\<Sum>i=0..<n. B$$(i, i))".
   have r: "?rhs = (\<Sum>i=0..<n. A$$(i, i)) - (\<Sum>i=0..<n. B$$(i, i))" unfolding trace_def using A B by auto
   from l r show ?thesis by auto
 qed
 
 lemma trace_smult: 
   assumes "A \<in> carrier_mat n n"
   shows "trace (c \<cdot>\<^sub>m A) = c * trace A"
 proof -
   have "trace (c \<cdot>\<^sub>m A) = (\<Sum>i = 0..<dim_row A. c * A $$ (i, i))" unfolding trace_def using assms by auto
   also have "\<dots> = c * (\<Sum>i = 0..<dim_row A. A $$ (i, i))"
     by (simp add: sum_distrib_left)
   also have "\<dots> = c * trace A" unfolding trace_def by auto
   ultimately show ?thesis by auto
 qed
 
 subsection \<open>Conjugate of a vector\<close>
 
 lemma conjugate_scalar_prod:
   fixes v w :: "'a::conjugatable_ring vec"
   assumes "dim_vec v = dim_vec w"
   shows "conjugate (v \<bullet> w) = conjugate v \<bullet> conjugate w"
   using assms by (simp add: scalar_prod_def sum_conjugate conjugate_dist_mul)
 
 subsection \<open>Inner product\<close>
 
 abbreviation inner_prod :: "'a vec \<Rightarrow> 'a vec \<Rightarrow> 'a :: conjugatable_ring"
   where "inner_prod v w \<equiv> w \<bullet>c v"
 
 lemma conjugate_scalar_prod_Im [simp]:
   "Im (v \<bullet>c v) = 0"
   by (simp add: scalar_prod_def conjugate_vec_def sum.neutral)
 
 lemma conjugate_scalar_prod_Re [simp]:
   "Re (v \<bullet>c v) \<ge> 0"
   by (simp add: scalar_prod_def conjugate_vec_def sum_nonneg)
 
 lemma self_cscalar_prod_geq_0:
   fixes v ::  "'a::conjugatable_ordered_field vec"
   shows "v \<bullet>c v \<ge> 0"
   by (auto simp add: scalar_prod_def, rule sum_nonneg, rule conjugate_square_positive)
 
 lemma inner_prod_distrib_left:
   fixes u v w :: "('a::conjugatable_field) vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv:"v \<in> carrier_vec n" and dimw: "w \<in> carrier_vec n" 
   shows "inner_prod (v + w) u = inner_prod v u + inner_prod w u" (is "?lhs = ?rhs")
 proof -
   have dimcv: "conjugate v \<in> carrier_vec n" and dimcw: "conjugate w \<in> carrier_vec n" using assms by auto
   have dimvw: "conjugate (v + w) \<in> carrier_vec n" using assms by auto
   have "u \<bullet> (conjugate (v + w)) = u \<bullet> conjugate v + u \<bullet> conjugate w"
     using dimv dimw dimu dimcv dimcw 
     by (metis conjugate_add_vec scalar_prod_add_distrib)
   then show ?thesis by auto
 qed
 
 lemma inner_prod_distrib_right:
   fixes u v w :: "('a::conjugatable_field) vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv:"v \<in> carrier_vec n" and dimw: "w \<in> carrier_vec n" 
   shows "inner_prod u (v + w) = inner_prod u v + inner_prod u w" (is "?lhs = ?rhs")
 proof -
   have dimvw: "v + w \<in> carrier_vec n" using assms by auto
   have dimcu: "conjugate u \<in> carrier_vec n" using assms by auto
   have "(v + w) \<bullet> (conjugate u) = v \<bullet> conjugate u + w \<bullet> conjugate u"
     apply (simp add: comm_scalar_prod[OF dimvw dimcu])
     apply (simp add: scalar_prod_add_distrib[OF dimcu dimv dimw])
     apply (insert dimv dimw dimcu, simp add: comm_scalar_prod[of _ n])
     done
   then show ?thesis by auto
 qed                
 
 lemma inner_prod_minus_distrib_right:
   fixes u v w :: "('a::conjugatable_field) vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv:"v \<in> carrier_vec n" and dimw: "w \<in> carrier_vec n" 
   shows "inner_prod u (v - w) = inner_prod u v - inner_prod u w" (is "?lhs = ?rhs")
 proof -
   have dimvw: "v - w \<in> carrier_vec n" using assms by auto
   have dimcu: "conjugate u \<in> carrier_vec n" using assms by auto
   have "(v - w) \<bullet> (conjugate u) = v \<bullet> conjugate u - w \<bullet> conjugate u"
     apply (simp add: comm_scalar_prod[OF dimvw dimcu])
     apply (simp add: scalar_prod_minus_distrib[OF dimcu dimv dimw])
     apply (insert dimv dimw dimcu, simp add: comm_scalar_prod[of _ n])
     done
   then show ?thesis by auto
 qed                
 
 lemma inner_prod_smult_right:
   fixes u v :: "complex vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv:"v \<in> carrier_vec n" 
   shows "inner_prod (a \<cdot>\<^sub>v u) v = conjugate a * inner_prod u v" (is "?lhs = ?rhs")
   using assms apply (simp add: scalar_prod_def conjugate_dist_mul) 
   apply (subst sum_distrib_left) by (rule sum.cong, auto)
 
 lemma inner_prod_smult_left:
   fixes u v :: "complex vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv: "v \<in> carrier_vec n" 
   shows "inner_prod u (a \<cdot>\<^sub>v v) = a * inner_prod u v" (is "?lhs = ?rhs")
   using assms apply (simp add: scalar_prod_def) 
   apply (subst sum_distrib_left) by (rule sum.cong, auto)
 
 lemma inner_prod_smult_left_right:
   fixes u v :: "complex vec"
   assumes dimu: "u \<in> carrier_vec n" and dimv: "v \<in> carrier_vec n" 
   shows "inner_prod (a \<cdot>\<^sub>v u) (b \<cdot>\<^sub>v v) = conjugate a * b  * inner_prod u v" (is "?lhs = ?rhs")
   using assms apply (simp add: scalar_prod_def) 
   apply (subst sum_distrib_left) by (rule sum.cong, auto)
 
 lemma inner_prod_swap:
   fixes x y :: "complex vec"
   assumes "y \<in> carrier_vec n" and "x \<in> carrier_vec n" 
   shows "inner_prod y x = conjugate (inner_prod x y)"
   apply (simp add: scalar_prod_def)
   apply (rule sum.cong) using assms by auto
 
 text \<open>Cauchy-Schwarz theorem for complex vectors. This is analogous to aux\_Cauchy
   and Cauchy\_Schwarz\_ineq in Generalizations2.thy in QR\_Decomposition. Consider
   merging and moving to Isabelle library.\<close>
 lemma aux_Cauchy:
   fixes x y :: "complex vec"
   assumes "x \<in> carrier_vec n" and "y \<in> carrier_vec n"
   shows "0 \<le> inner_prod x x + a * (inner_prod x y) + (cnj a) * ((cnj (inner_prod x y)) + a * (inner_prod y y))"
 proof -
   have "(inner_prod (x+ a \<cdot>\<^sub>v y) (x+a \<cdot>\<^sub>v y)) = (inner_prod (x+a \<cdot>\<^sub>v y) x) + (inner_prod (x+a \<cdot>\<^sub>v y) (a \<cdot>\<^sub>v y))" 
     apply (subst inner_prod_distrib_right) using assms by auto
   also have "\<dots> = inner_prod x x + (a) * (inner_prod x y) + cnj a * ((cnj (inner_prod x y)) + (a) * (inner_prod y y))"
     apply (subst (1 2) inner_prod_distrib_left[of _ n]) apply (auto simp add: assms)
     apply (subst (1 2) inner_prod_smult_right[of _ n]) apply (auto simp add: assms)
     apply (subst inner_prod_smult_left[of _ n]) apply (auto simp add: assms)
     apply (subst inner_prod_swap[of y n x]) apply (auto simp add: assms)
     unfolding distrib_left
     by auto
   finally show ?thesis by (metis self_cscalar_prod_geq_0)
 qed
 
 lemma Cauchy_Schwarz_complex_vec:
   fixes x y :: "complex vec"
   assumes "x \<in> carrier_vec n" and "y \<in> carrier_vec n"
   shows "inner_prod x y * inner_prod y x \<le> inner_prod x x * inner_prod y y"
 proof -
   define cnj_a where "cnj_a = - (inner_prod x y)/ cnj (inner_prod y y)"
   define a where "a = cnj (cnj_a)"
   have cnj_rw: "(cnj a) = cnj_a" 
     unfolding a_def by (simp)
   have rw_0: "cnj (inner_prod x y) + a * (inner_prod y y) = 0"
     unfolding a_def cnj_a_def using assms(1) assms(2) conjugate_square_eq_0_vec by fastforce
   have "0 \<le>  (inner_prod x x + a * (inner_prod x y) + (cnj a) * ((cnj (inner_prod x y)) + a * (inner_prod y y)))"
     using aux_Cauchy assms by auto
   also have "\<dots> =  (inner_prod x x + a * (inner_prod x y))" unfolding rw_0 by auto
   also have "\<dots> =  (inner_prod x x - (inner_prod x y) * cnj (inner_prod x y) / (inner_prod y y))" 
   unfolding a_def cnj_a_def by simp
   finally have " 0 \<le>  (inner_prod x x - (inner_prod x y) * cnj (inner_prod x y) / (inner_prod y y)) " .
   hence "0 \<le> (inner_prod x x - (inner_prod x y) * cnj (inner_prod x y) / (inner_prod y y)) * (inner_prod y y)"
     by (auto simp: less_eq_complex_def)
   also have "\<dots> = ((inner_prod x x)*(inner_prod y y) - (inner_prod x y) * cnj (inner_prod x y))"
     by (smt add.inverse_neutral add_diff_cancel diff_0 diff_divide_eq_iff divide_cancel_right mult_eq_0_iff nonzero_mult_div_cancel_right rw_0)
   finally have "(inner_prod x y) * cnj (inner_prod x y) \<le> (inner_prod x x)*(inner_prod y y)" by auto
   then show ?thesis 
     apply (subst inner_prod_swap[of y n x]) by (auto simp add: assms)
 qed
 
 subsection \<open>Hermitian adjoint of a matrix\<close>
 
 abbreviation adjoint where "adjoint \<equiv> mat_adjoint"
 
 lemma adjoint_dim_row [simp]:
   "dim_row (adjoint A) = dim_col A" by (simp add: mat_adjoint_def)
 
 lemma adjoint_dim_col [simp]:
   "dim_col (adjoint A) = dim_row A" by (simp add: mat_adjoint_def)
 
 lemma adjoint_dim:
   "A \<in> carrier_mat n n \<Longrightarrow> adjoint A \<in> carrier_mat n n"
   using adjoint_dim_col adjoint_dim_row by blast
 
 lemma adjoint_def:
   "adjoint A = mat (dim_col A) (dim_row A) (\<lambda>(i,j). conjugate (A $$ (j,i)))"
   unfolding mat_adjoint_def mat_of_rows_def by auto
 
 lemma adjoint_eval:
   assumes "i < dim_col A" "j < dim_row A"
   shows "(adjoint A) $$ (i,j) = conjugate (A $$ (j,i))"
   using assms by (simp add: adjoint_def)
 
 lemma adjoint_row:
   assumes "i < dim_col A"
   shows "row (adjoint A) i = conjugate (col A i)"
   apply (rule eq_vecI)
   using assms by (auto simp add: adjoint_eval)
 
 lemma adjoint_col:
   assumes "i < dim_row A"
   shows "col (adjoint A) i = conjugate (row A i)"
   apply (rule eq_vecI)
   using assms by (auto simp add: adjoint_eval)
 
 text \<open>The identity <v, A w> = <A* v, w>\<close>
 lemma adjoint_def_alter:
   fixes v w :: "'a::conjugatable_field vec"
     and A :: "'a::conjugatable_field mat"
   assumes dims: "v \<in> carrier_vec n" "w \<in> carrier_vec m" "A \<in> carrier_mat n m"
   shows "inner_prod v (A *\<^sub>v w) = inner_prod (adjoint A *\<^sub>v v) w" (is "?lhs = ?rhs")
 proof -
   from dims have "?lhs = (\<Sum>i=0..<dim_vec v. (\<Sum>j=0..<dim_vec w.
                 conjugate (v$i) * A$$(i, j) * w$j))"
     apply (simp add: scalar_prod_def sum_distrib_right )
     apply (rule sum.cong, simp)
     apply (rule sum.cong, auto)
     done
   moreover from assms have "?rhs = (\<Sum>i=0..<dim_vec v. (\<Sum>j=0..<dim_vec w.
                 conjugate (v$i) * A$$(i, j) * w$j))"
     apply (simp add: scalar_prod_def  adjoint_eval 
                      sum_conjugate conjugate_dist_mul sum_distrib_left)
     apply (subst sum.swap[where ?A = "{0..<n}"])
     apply (rule sum.cong, simp)
     apply (rule sum.cong, auto)
     done
   ultimately show ?thesis by simp
 qed
 
 lemma adjoint_one:
   shows "adjoint (1\<^sub>m n) = (1\<^sub>m n::complex mat)"
   apply (rule eq_matI) 
   by (auto simp add: adjoint_eval)
 
 lemma adjoint_scale:
   fixes A :: "'a::conjugatable_field mat"
   shows "adjoint (a \<cdot>\<^sub>m A) = (conjugate a) \<cdot>\<^sub>m adjoint A"
   apply (rule eq_matI) using conjugatable_ring_class.conjugate_dist_mul
   by (auto simp add: adjoint_eval)
 
 lemma adjoint_add:
   fixes A B :: "'a::conjugatable_field mat"
   assumes "A \<in> carrier_mat n m" "B \<in> carrier_mat n m"
   shows "adjoint (A + B) = adjoint A + adjoint B"
   apply (rule eq_matI)
   using assms conjugatable_ring_class.conjugate_dist_add 
   by( auto simp add: adjoint_eval)
 
 lemma adjoint_minus:
   fixes A B :: "'a::conjugatable_field mat"
   assumes "A \<in> carrier_mat n m" "B \<in> carrier_mat n m"
   shows "adjoint (A - B) = adjoint A - adjoint B"
   apply (rule eq_matI)
   using assms apply(auto simp add: adjoint_eval)
   by (metis add_uminus_conv_diff conjugate_dist_add conjugate_neg)
 
 lemma adjoint_mult:
   fixes A B :: "'a::conjugatable_field mat"
   assumes "A \<in> carrier_mat n m" "B \<in> carrier_mat m l"
   shows "adjoint (A * B) = adjoint B * adjoint A"
 proof (rule eq_matI, auto simp add: adjoint_eval adjoint_row adjoint_col)
   fix i j
   assume "i < dim_col B" "j < dim_row A"
   show "conjugate (row A j \<bullet> col B i) = conjugate (col B i) \<bullet> conjugate (row A j)"
     using assms apply (simp add: conjugate_scalar_prod)
     apply (subst comm_scalar_prod[where n="dim_row B"])
     by (auto simp add: carrier_vecI)
 qed
 
 lemma adjoint_adjoint:
   fixes A :: "'a::conjugatable_field mat"
   shows "adjoint (adjoint A) = A"
   by (rule eq_matI, auto simp add: adjoint_eval)
 
 lemma trace_adjoint_positive:
   fixes A :: "complex mat"
   shows "trace (A * adjoint A) \<ge> 0"
   apply (auto simp add: trace_def adjoint_col)
   apply (rule sum_nonneg) by auto
 
 subsection \<open>Algebraic manipulations on matrices\<close>
 
 lemma right_add_zero_mat[simp]:
   "(A :: 'a :: monoid_add mat) \<in> carrier_mat nr nc \<Longrightarrow> A + 0\<^sub>m nr nc = A"
   by (intro eq_matI, auto)
 
 lemma add_carrier_mat':
   "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> A + B \<in> carrier_mat nr nc"
   by simp
 
 lemma minus_carrier_mat':
   "A \<in> carrier_mat nr nc \<Longrightarrow> B \<in> carrier_mat nr nc \<Longrightarrow> A - B \<in> carrier_mat nr nc"
   by auto
 
 lemma swap_plus_mat:
   fixes A B C :: "'a::semiring_1 mat"
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n"
   shows "A + B + C = A + C + B"
   by (metis assms assoc_add_mat comm_add_mat)
 
 lemma uminus_mat:
   fixes A :: "complex mat"
   assumes "A \<in> carrier_mat n n"
   shows "-A = (-1) \<cdot>\<^sub>m A"
   by auto
 
 ML_file "mat_alg.ML"
 method_setup mat_assoc = \<open>mat_assoc_method\<close>
   "Normalization of expressions on matrices"
 
 lemma mat_assoc_test:
   fixes A B C D :: "complex mat"
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n" "D \<in> carrier_mat n n"
   shows
     "(A * B) * (C * D) = A * B * C * D"
     "adjoint (A * adjoint B) * C = B * (adjoint A * C)"
     "A * 1\<^sub>m n * 1\<^sub>m n * B * 1\<^sub>m n = A * B"
     "(A - B) + (B - C) = A + (-B) + B + (-C)"
     "A + (B - C) = A + B - C"
     "A - (B + C + D) = A - B - C - D"
     "(A + B) * (B + C) = A * B + B * B + A * C + B * C"
     "A - B = A + (-1) \<cdot>\<^sub>m B"
     "A * (B - C) * D = A * B * D - A * C * D"
     "trace (A * B * C) = trace (B * C * A)"
     "trace (A * B * C * D) = trace (C * D * A * B)"
     "trace (A + B * C) = trace A + trace (C * B)"
     "A + B = B + A"
     "A + B + C = C + B + A"
     "A + B + (C + D) = A + C + (B + D)"
   using assms by (mat_assoc n)+
 
 subsection \<open>Hermitian matrices\<close>
 
 text \<open>A Hermitian matrix is a matrix that is equal to its Hermitian adjoint.\<close>
 definition hermitian :: "'a::conjugatable_field mat \<Rightarrow> bool" where
   "hermitian A \<longleftrightarrow> (adjoint A = A)"
 
 lemma hermitian_one:
   shows "hermitian ((1\<^sub>m n)::('a::conjugatable_field mat))"
   unfolding hermitian_def 
 proof-
   have "conjugate (1::'a) = 1"   
     apply (subst mult_1_right[symmetric, of "conjugate 1"])
     apply (subst conjugate_id[symmetric, of "conjugate 1 * 1"])
     apply (subst conjugate_dist_mul)
     apply auto
     done
   then show "adjoint ((1\<^sub>m n)::('a::conjugatable_field mat)) = (1\<^sub>m n)" 
     by (auto simp add: adjoint_eval) 
 qed
 
 subsection \<open>Inverse matrices\<close>
 
 lemma inverts_mat_symm:
   fixes A B :: "'a::field mat"
   assumes dim: "A \<in> carrier_mat n n" "B \<in> carrier_mat n n"
     and AB: "inverts_mat A B"
   shows "inverts_mat B A"
 proof -
   have "A * B = 1\<^sub>m n" using dim AB unfolding inverts_mat_def by auto
   with dim have "B * A = 1\<^sub>m n"  by (rule mat_mult_left_right_inverse)
   then show "inverts_mat B A" using dim inverts_mat_def by auto
 qed
 
 lemma inverts_mat_unique:
   fixes A B C :: "'a::field mat"
   assumes dim: "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n" 
     and AB: "inverts_mat A B" and AC: "inverts_mat A C"
   shows "B = C"
 proof -
   have AB1: "A * B = 1\<^sub>m n" using AB dim unfolding inverts_mat_def by auto
   have "A * C = 1\<^sub>m n" using AC dim unfolding inverts_mat_def by auto
   then have CA1: "C * A = 1\<^sub>m n" using mat_mult_left_right_inverse[of A n C] dim by auto
   then have "C = C * 1\<^sub>m n" using dim by auto
   also have "\<dots> = C * (A * B)" using AB1 by auto
   also have "\<dots> = (C * A) * B" using dim by auto
   also have "\<dots> = 1\<^sub>m n * B" using CA1 by auto
   also have "\<dots> = B" using dim by auto
   finally show "B = C" ..
 qed
 
 subsection \<open>Unitary matrices\<close>
 
 text \<open>A unitary matrix is a matrix whose Hermitian adjoint is also its inverse.\<close>
 definition unitary :: "'a::conjugatable_field mat \<Rightarrow> bool" where
   "unitary A \<longleftrightarrow> A \<in> carrier_mat (dim_row A) (dim_row A) \<and> inverts_mat A (adjoint A)"
 
 lemma unitaryD2:
   assumes "A \<in> carrier_mat n n"
   shows "unitary A \<Longrightarrow> inverts_mat (adjoint A) A"
   using assms adjoint_dim inverts_mat_symm unitary_def by blast
 
 lemma unitary_simps [simp]:
   "A \<in> carrier_mat n n \<Longrightarrow> unitary A \<Longrightarrow> adjoint A * A = 1\<^sub>m n"
   "A \<in> carrier_mat n n \<Longrightarrow> unitary A \<Longrightarrow> A * adjoint A = 1\<^sub>m n"
   apply (metis adjoint_dim_row carrier_matD(2) inverts_mat_def unitaryD2)
   by (simp add: inverts_mat_def unitary_def)
 
 lemma unitary_adjoint [simp]:
   assumes "A \<in> carrier_mat n n" "unitary A"
   shows "unitary (adjoint A)" 
   unfolding unitary_def
   using  adjoint_dim[OF assms(1)] assms by (auto simp add: unitaryD2[OF assms] adjoint_adjoint)
 
 lemma unitary_one:
   shows "unitary ((1\<^sub>m n)::('a::conjugatable_field mat))"
   unfolding unitary_def 
 proof -
   define I where I_def[simp]: "I \<equiv> ((1\<^sub>m n)::('a::conjugatable_field mat))"
   have dim: "I \<in> carrier_mat n n" by auto
   have "hermitian I" using hermitian_one  by auto
   hence "adjoint I = I" using hermitian_def by auto
   with dim show "I \<in> carrier_mat (dim_row I) (dim_row I) \<and> inverts_mat I (adjoint I)" 
     unfolding inverts_mat_def using dim by auto
 qed
 
 lemma unitary_zero:
   fixes A :: "'a::conjugatable_field mat"
   assumes "A \<in> carrier_mat 0 0"
   shows "unitary A"
   unfolding unitary_def inverts_mat_def Let_def using assms by auto
 
 lemma unitary_elim:
   assumes dims: "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "P \<in> carrier_mat n n"
     and uP: "unitary P" and eq: "P * A * adjoint P = P * B * adjoint P"
   shows "A = B"
 proof -
   have dimaP: "adjoint P \<in> carrier_mat n n" using dims by auto
   have iv: "inverts_mat P (adjoint P)" using uP unitary_def by auto
   then have "P * (adjoint P) = 1\<^sub>m n" using inverts_mat_def dims by auto
   then have aPP: "adjoint P * P = 1\<^sub>m n" using mat_mult_left_right_inverse[OF dims(3) dimaP] by auto
   have "adjoint P * (P * A * adjoint P) * P = (adjoint P * P) * A * (adjoint P * P)" 
     using dims dimaP by (mat_assoc n)
   also have "\<dots> = 1\<^sub>m n * A * 1\<^sub>m n" using aPP by auto
   also have "\<dots> = A" using dims by auto
   finally have eqA: "A = adjoint P * (P * A * adjoint P) * P" ..
   have "adjoint P * (P * B * adjoint P) * P = (adjoint P * P) * B * (adjoint P * P)" 
     using dims dimaP by (mat_assoc n)
   also have "\<dots> = 1\<^sub>m n * B * 1\<^sub>m n" using aPP by auto
   also have "\<dots> = B" using dims by auto
   finally have eqB: "B = adjoint P * (P * B * adjoint P) * P" ..
   then show ?thesis using eqA eqB eq by auto
 qed
 
 lemma unitary_is_corthogonal:
   fixes U :: "'a::conjugatable_field mat"
   assumes dim: "U \<in> carrier_mat n n" 
     and U: "unitary U"
   shows "corthogonal_mat U"
   unfolding corthogonal_mat_def Let_def
 proof (rule conjI)
   have dima: "adjoint U \<in> carrier_mat n n" using dim by auto
   have aUU: "mat_adjoint U * U = (1\<^sub>m n)"
     apply (insert U[unfolded unitary_def] dim dima, drule conjunct2)
     apply (drule inverts_mat_symm[of "U", OF dim dima], unfold inverts_mat_def, auto)
     done
   then show "diagonal_mat (mat_adjoint U * U)"
     by (simp add: diagonal_mat_def)
   show "\<forall>i<dim_col U. (mat_adjoint U * U) $$ (i, i) \<noteq> 0" using dim by (simp add: aUU)
 qed
 
 lemma unitary_times_unitary:
   fixes P Q :: "'a:: conjugatable_field mat"
   assumes dim: "P \<in> carrier_mat n n" "Q \<in> carrier_mat n n"
     and uP: "unitary P" and uQ: "unitary Q"
   shows "unitary (P * Q)"
 proof -
   have dim_pq: "P * Q \<in> carrier_mat n n" using dim by auto
   have "(P * Q) * adjoint (P * Q) = P * (Q * adjoint Q) * adjoint P" using dim by (mat_assoc n)
   also have "\<dots> = P * (1\<^sub>m n) * adjoint P" using uQ dim by auto
   also have "\<dots> = P * adjoint P" using dim by (mat_assoc n)
   also have "\<dots> = 1\<^sub>m n" using uP dim by simp
   finally have "(P * Q) * adjoint (P * Q) = 1\<^sub>m n" by auto
   hence "inverts_mat (P * Q) (adjoint (P * Q))" 
     using inverts_mat_def dim_pq by auto
   thus "unitary (P*Q)" using unitary_def dim_pq by auto
 qed
 
 lemma unitary_operator_keep_trace:
   fixes U A :: "complex mat"
   assumes dU: "U \<in> carrier_mat n n" and dA: "A \<in> carrier_mat n n" and u: "unitary U"
   shows "trace A = trace (adjoint U * A * U)"
 proof -
   have u': "U * adjoint U = 1\<^sub>m n" using u unfolding unitary_def inverts_mat_def using dU by auto
   have "trace (adjoint U * A * U) = trace (U * adjoint U * A)" using dU dA by (mat_assoc n)
   also have "\<dots> = trace A" using u' dA by auto
   finally show ?thesis by auto
 qed
 
 subsection \<open>Normalization of vectors\<close>
 
 definition vec_norm :: "complex vec \<Rightarrow> complex" where
   "vec_norm v \<equiv> csqrt (v \<bullet>c v)"
 
 lemma vec_norm_geq_0:
   fixes v :: "complex vec"
   shows "vec_norm v \<ge> 0"
   unfolding vec_norm_def by (insert self_cscalar_prod_geq_0[of v], simp add: less_eq_complex_def)
 
 lemma vec_norm_zero:
   fixes v ::  "complex vec"
   assumes dim: "v \<in> carrier_vec n"
   shows "vec_norm v = 0 \<longleftrightarrow> v = 0\<^sub>v n"
   unfolding vec_norm_def
   by (subst conjugate_square_eq_0_vec[OF dim, symmetric], rule csqrt_eq_0)
 
 lemma vec_norm_ge_0:
   fixes v ::  "complex vec"
   assumes dim_v: "v \<in> carrier_vec n" and neq0: "v \<noteq> 0\<^sub>v n"
   shows "vec_norm v > 0"
 proof -
   have geq: "vec_norm v \<ge> 0" using vec_norm_geq_0 by auto
   have neq: "vec_norm v \<noteq> 0" 
     apply (insert dim_v neq0)
     apply (drule vec_norm_zero, auto)
     done
   show ?thesis using neq geq by (rule dual_order.not_eq_order_implies_strict)
 qed
 
 definition vec_normalize :: "complex vec \<Rightarrow> complex vec" where
   "vec_normalize v = (if (v = 0\<^sub>v (dim_vec v)) then v else 1 / (vec_norm v) \<cdot>\<^sub>v v)"
 
 lemma normalized_vec_dim[simp]:
   assumes "(v::complex vec) \<in> carrier_vec n"
   shows "vec_normalize v \<in> carrier_vec n"
   unfolding vec_normalize_def using assms by auto
 
 lemma vec_eq_norm_smult_normalized:
   shows "v = vec_norm v \<cdot>\<^sub>v vec_normalize v"
 proof (cases "v = 0\<^sub>v (dim_vec v)")
   define n where "n = dim_vec v"
   then have dimv: "v \<in> carrier_vec n" by auto
   then have dimnv: "vec_normalize v \<in> carrier_vec n" by auto
   {
     case True
     then have v0: "v = 0\<^sub>v n" using n_def by auto
     then have n0: "vec_norm v = 0" using vec_norm_def by auto
     have "vec_norm v \<cdot>\<^sub>v vec_normalize v = 0\<^sub>v n" 
       unfolding smult_vec_def by (auto simp add: n0 carrier_vecD[OF dimnv])
     then show ?thesis using v0 by auto
     next
     case False
     then have v: "v \<noteq> 0\<^sub>v n" using n_def by auto
     then have ge0: "vec_norm v > 0" using vec_norm_ge_0 dimv by auto
     have "vec_normalize v = (1 / vec_norm v) \<cdot>\<^sub>v v" using False vec_normalize_def by auto
     then have "vec_norm v \<cdot>\<^sub>v vec_normalize v = (vec_norm v * (1 / vec_norm v)) \<cdot>\<^sub>v v"
       using smult_smult_assoc by auto
     also have "\<dots> = v" using ge0 by auto
     finally have "v = vec_norm v \<cdot>\<^sub>v vec_normalize v"..
     then show "v = vec_norm v \<cdot>\<^sub>v vec_normalize v" using v by auto
   }
 qed
 
 lemma normalized_cscalar_prod:
   fixes v w :: "complex vec"
   assumes dim_v: "v \<in> carrier_vec n" and dim_w: "w \<in> carrier_vec n"
   shows "v \<bullet>c w = (vec_norm v * vec_norm w) * (vec_normalize v \<bullet>c vec_normalize w)"
   unfolding vec_normalize_def apply (split if_split, split if_split)
 proof (intro conjI impI)
   note dim0 = dim_v dim_w
   have dim: "dim_vec v = n" "dim_vec w = n" using dim0 by auto
   {
     assume "w = 0\<^sub>v n" "v = 0\<^sub>v n"
     then have lhs: "v \<bullet>c w = 0" by auto
     then moreover have rhs: "vec_norm v * vec_norm w * (v \<bullet>c w) = 0" by auto
     ultimately have "v \<bullet>c w = vec_norm v * vec_norm w * (v \<bullet>c w)" by auto
   }
   with dim show "w = 0\<^sub>v (dim_vec w) \<Longrightarrow> v = 0\<^sub>v (dim_vec v) \<Longrightarrow> v \<bullet>c w = vec_norm v * vec_norm w * (v \<bullet>c w)" by auto
   {
     assume asm: "w = 0\<^sub>v n" "v \<noteq> 0\<^sub>v n"
     then have w0: "conjugate w = 0\<^sub>v n" by auto
     with dim0 have "(1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c w = 0" by auto
     then moreover have rhs: "vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c w) = 0" by auto
     moreover have "v \<bullet>c w = 0" using w0 dim0 by auto
     ultimately have "v \<bullet>c w = vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c w)" by auto
   }
   with dim show "w = 0\<^sub>v (dim_vec w) \<Longrightarrow> v \<noteq> 0\<^sub>v (dim_vec v) \<Longrightarrow> v \<bullet>c w = vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c w)" by auto
   {
     assume asm: "w \<noteq> 0\<^sub>v n" "v = 0\<^sub>v n"
     with dim0 have "v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w) = 0" by auto
     then moreover have rhs: "vec_norm v * vec_norm w * (v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w)) = 0" by auto
     moreover have "v \<bullet>c w = 0" using asm dim0 by auto
     ultimately have "v \<bullet>c w = vec_norm v * vec_norm w * (v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w))" by auto
   }
   with dim show "w \<noteq> 0\<^sub>v (dim_vec w) \<Longrightarrow> v = 0\<^sub>v (dim_vec v) \<Longrightarrow> v \<bullet>c w = vec_norm v * vec_norm w * (v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w))" by auto
   {
     assume asmw: "w \<noteq> 0\<^sub>v n" and asmv: "v \<noteq> 0\<^sub>v n"
     have "vec_norm w > 0" by (insert asmw dim0, rule vec_norm_ge_0, auto)
     then have cw: "conjugate (1 / vec_norm w) = 1 / vec_norm w"
       by (simp add: complex_eq_iff complex_is_Real_iff less_complex_def) 
     from dim0 have 
       "((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w)) = 1 / vec_norm v * (v \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w))" by auto
     also have "\<dots> = 1 / vec_norm v * (v \<bullet> (conjugate (1 / vec_norm w) \<cdot>\<^sub>v conjugate w))"
       by (subst conjugate_smult_vec, auto)
     also have "\<dots> = 1 / vec_norm v * conjugate (1 / vec_norm w) * (v \<bullet> conjugate w)" using dim by auto
     also have "\<dots> = 1 / vec_norm v * (1 / vec_norm w) * (v \<bullet>c w)" using vec_norm_ge_0 cw by auto
     finally have eq1: "(1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w) = 1 / vec_norm v * (1 / vec_norm w) * (v \<bullet>c w)" .
     then have "vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w)) = (v \<bullet>c w)" 
       by (subst eq1, insert vec_norm_ge_0[of v n, OF dim_v asmv] vec_norm_ge_0[of w n, OF dim_w asmw], auto)
   }
   with dim show " w \<noteq> 0\<^sub>v (dim_vec w) \<Longrightarrow> v \<noteq> 0\<^sub>v (dim_vec v) \<Longrightarrow> v \<bullet>c w = vec_norm v * vec_norm w * ((1 / vec_norm v \<cdot>\<^sub>v v) \<bullet>c (1 / vec_norm w \<cdot>\<^sub>v w))" by auto
 qed
 
 lemma normalized_vec_norm :
   fixes v :: "complex vec"
   assumes dim_v: "v \<in> carrier_vec n" 
     and neq0: "v \<noteq> 0\<^sub>v n"
   shows "vec_normalize v \<bullet>c vec_normalize v = 1"
   unfolding vec_normalize_def
 proof (simp, rule conjI)
   show "v = 0\<^sub>v (dim_vec v) \<longrightarrow> v \<bullet>c v = 1" using neq0 dim_v by auto
   have dim_a: "(vec_normalize v) \<in> carrier_vec n" "conjugate (vec_normalize v) \<in> carrier_vec n" using dim_v vec_normalize_def by auto 
   note dim = dim_v dim_a
   have nvge0: "vec_norm v > 0" using vec_norm_ge_0 neq0 dim_v by auto
   then have vvvv: "v \<bullet>c v = (vec_norm v) * (vec_norm v)" unfolding vec_norm_def by (metis power2_csqrt power2_eq_square)
   from nvge0 have "conjugate (vec_norm v) = vec_norm v"
     by (simp add: complex_eq_iff complex_is_Real_iff less_complex_def) 
   then have "v \<bullet>c (1 / vec_norm v \<cdot>\<^sub>v v) = 1 / vec_norm v * (v \<bullet>c v)" 
     by (subst conjugate_smult_vec, auto)
   also have "\<dots> = 1 / vec_norm v * vec_norm v * vec_norm v" using vvvv by auto
   also have "\<dots> = vec_norm v" by auto
   finally have "v \<bullet>c (1 / vec_norm v \<cdot>\<^sub>v v) = vec_norm v".
   then show "v \<noteq> 0\<^sub>v (dim_vec v) \<longrightarrow> vec_norm v \<noteq> 0 \<and> v \<bullet>c (1 / vec_norm v \<cdot>\<^sub>v v) = vec_norm v" 
     using neq0 nvge0 by auto
 qed
 
 lemma normalize_zero:
   assumes "v \<in> carrier_vec n"
   shows "vec_normalize v = 0\<^sub>v n \<longleftrightarrow> v = 0\<^sub>v n"
 proof
   show "v = 0\<^sub>v n \<Longrightarrow> vec_normalize v = 0\<^sub>v n" unfolding vec_normalize_def by auto
 next
   have "v \<noteq> 0\<^sub>v n \<Longrightarrow> vec_normalize v \<noteq> 0\<^sub>v n" unfolding vec_normalize_def 
   proof (simp, rule impI)
     assume asm: "v \<noteq> 0\<^sub>v n"
     then have "vec_norm v > 0" using vec_norm_ge_0 assms by auto
     then have nvge0: "1 / vec_norm v > 0" by (simp add: complex_is_Real_iff less_complex_def)
     have "\<exists>k < n. v $ k \<noteq> 0" using asm assms by auto
     then obtain k where kn: "k < n" and  vkneq0: "v $ k \<noteq> 0" by auto
     then have "(1 / vec_norm v \<cdot>\<^sub>v v) $ k = (1 / vec_norm v) * (v $ k)" 
       using assms carrier_vecD index_smult_vec(1) by blast
     with nvge0 vkneq0 have "(1 / vec_norm v \<cdot>\<^sub>v v) $ k \<noteq> 0" by auto
     then show "1 / vec_norm v \<cdot>\<^sub>v v \<noteq> 0\<^sub>v n" using assms kn by fastforce
   qed
   then show "vec_normalize v = 0\<^sub>v n \<Longrightarrow> v = 0\<^sub>v n" by auto
 qed
 
 lemma normalize_normalize[simp]:
   "vec_normalize (vec_normalize v) = vec_normalize v"
 proof (rule disjE[of "v = 0\<^sub>v (dim_vec v)" "v \<noteq> 0\<^sub>v (dim_vec v)"], auto)
   let ?n = "dim_vec v"
 {
   assume "v = 0\<^sub>v ?n"
   then have "vec_normalize v = v" unfolding vec_normalize_def by auto
   then show "vec_normalize (vec_normalize v) = vec_normalize v" by auto
 }
   assume neq0: "v \<noteq> 0\<^sub>v ?n"
   have dim: "v \<in> carrier_vec ?n" by auto
   have "vec_norm (vec_normalize v) = 1" unfolding vec_norm_def
     using normalized_vec_norm[OF dim neq0] by auto
   then show "vec_normalize (vec_normalize v) = vec_normalize v" 
     by (subst (1) vec_normalize_def, simp)
 qed
 
 subsection \<open>Spectral decomposition of normal complex matrices\<close>
 
 lemma normalize_keep_corthogonal:
   fixes vs :: "complex vec list"
   assumes cor: "corthogonal vs" and dims: "set vs \<subseteq> carrier_vec n"
   shows "corthogonal (map vec_normalize vs)"
   unfolding corthogonal_def
 proof (rule allI, rule impI, rule allI, rule impI, goal_cases)
   case c: (1 i j)
   let ?m = "length vs"
   have len: "length (map vec_normalize vs) = ?m" by auto
   have dim: "\<And>k. k < ?m \<Longrightarrow> (vs ! k) \<in> carrier_vec n" using dims by auto
   have map: "\<And>k. k < ?m \<Longrightarrow>  map vec_normalize vs ! k = vec_normalize (vs ! k)" by auto
 
   have eq1: "\<And>j k. j < ?m \<Longrightarrow> k < ?m \<Longrightarrow> ((vs ! j) \<bullet>c (vs ! k) = 0) = (j \<noteq> k)" using assms unfolding corthogonal_def by auto
   then have "\<And>k. k < ?m \<Longrightarrow> (vs ! k) \<bullet>c (vs ! k) \<noteq> 0 " by auto
   then have "\<And>k. k < ?m \<Longrightarrow> (vs ! k) \<noteq> (0\<^sub>v n)" using dim 
     by (auto simp add: conjugate_square_eq_0_vec[of _ n, OF dim])
   then have vnneq0: "\<And>k. k < ?m \<Longrightarrow> vec_norm (vs ! k) \<noteq> 0" using vec_norm_zero[OF dim] by auto
   then have i0: "vec_norm (vs ! i) \<noteq> 0" and j0: "vec_norm (vs ! j) \<noteq> 0" using c by auto
   have "(vs ! i) \<bullet>c (vs ! j) = vec_norm (vs ! i) * vec_norm (vs ! j) * (vec_normalize (vs ! i) \<bullet>c vec_normalize (vs ! j))"
     by (subst normalized_cscalar_prod[of "vs ! i" n "vs ! j"], auto, insert dim c, auto)
   with i0 j0 have "(vec_normalize (vs ! i) \<bullet>c vec_normalize (vs ! j) = 0) = ((vs ! i) \<bullet>c (vs ! j) = 0)" by auto
   with eq1 c have "(vec_normalize (vs ! i) \<bullet>c vec_normalize (vs ! j) = 0) = (i \<noteq> j)" by auto
   with map c show "(map vec_normalize vs ! i \<bullet>c map vec_normalize vs ! j = 0) = (i \<noteq> j)" by auto
 qed
 
 lemma normalized_corthogonal_mat_is_unitary:
   assumes W: "set ws \<subseteq> carrier_vec n"
     and orth: "corthogonal ws"
     and len: "length ws = n"
   shows "unitary (mat_of_cols n (map vec_normalize ws))" (is "unitary ?W")
 proof -
   define vs where "vs = map vec_normalize ws"
   define W where "W = mat_of_cols n vs"
   have W': "set vs \<subseteq> carrier_vec n" using assms vs_def by auto
   then have W'': "\<And>k. k < length vs \<Longrightarrow> vs ! k \<in> carrier_vec n" by auto
   have orth': "corthogonal vs" using assms normalize_keep_corthogonal vs_def by auto
   have len'[simp]: "length vs = n" using assms vs_def by auto
   have dimW: "W \<in> carrier_mat n n" using W_def len by auto
   have "adjoint W \<in> carrier_mat n n" using dimW by auto
   then have dimaW: "mat_adjoint W \<in> carrier_mat n n" by auto
   {
     fix i j assume i: "i < n" and j: "j < n"
     have dimws: "(ws ! i) \<in> carrier_vec n" "(ws ! j) \<in> carrier_vec n" using W len i j by auto
     have "(ws ! i) \<bullet>c (ws ! i) \<noteq> 0" "(ws ! j) \<bullet>c (ws ! j) \<noteq> 0" using orth corthogonal_def[of ws] len i j by auto
     then have neq0: "(ws ! i) \<noteq> 0\<^sub>v n" "(ws ! j) \<noteq> 0\<^sub>v n"
       by (auto simp add: conjugate_square_eq_0_vec[of "ws ! i" n])
     then have "vec_norm (ws ! i) > 0" "vec_norm (ws ! j) > 0" using vec_norm_ge_0 dimws by auto
     then have ge0: "vec_norm (ws ! i) * vec_norm (ws ! j) > 0" by (auto simp: less_complex_def)
     have ws': "vs ! i = vec_normalize (ws ! i)" 
         "vs ! j = vec_normalize (ws ! j)" 
       using len i j vs_def by auto
     have ii1: "(vs ! i) \<bullet>c (vs ! i) = 1" 
       apply (simp add: ws')
       apply (rule normalized_vec_norm[of "ws ! i"], rule dimws, rule neq0)
       done
     have ij0: "i \<noteq> j \<Longrightarrow> (ws ! i)  \<bullet>c (ws ! j) = 0" using i j 
       by (insert orth, auto simp add: corthogonal_def[of ws] len)
     have "i \<noteq> j \<Longrightarrow> (ws ! i)  \<bullet>c (ws ! j) =  (vec_norm (ws ! i) * vec_norm (ws ! j)) * ((vs ! i) \<bullet>c (vs ! j))"
       apply (auto simp add: ws')
       apply (rule normalized_cscalar_prod)
        apply (rule dimws, rule dimws)
       done
     with ij0 have ij0': "i \<noteq> j \<Longrightarrow> (vs ! i) \<bullet>c (vs ! j) = 0" using ge0 by auto
     have cWk: "\<And>k. k < n \<Longrightarrow> col W k = vs ! k" unfolding W_def 
     apply (subst col_mat_of_cols)
       apply (auto simp add: W'')
       done
     have "(mat_adjoint W * W) $$ (j, i) = row (mat_adjoint W) j \<bullet> col W i"
       by (insert dimW i j dimaW, auto)
     also have "\<dots> = conjugate (col W j) \<bullet> col W i" 
       by (insert dimW i j dimaW, auto simp add: mat_adjoint_def)
     also have "\<dots> = col W i \<bullet> conjugate (col W j)" using comm_scalar_prod[of "col W i" n] dimW by auto
     also have "\<dots> = (vs ! i) \<bullet>c (vs ! j)" using W_def col_mat_of_cols i j len cWk by auto
     finally have "(mat_adjoint W * W) $$ (j, i) = (vs ! i) \<bullet>c (vs ! j)".
     then have "(mat_adjoint W * W) $$ (j, i) = (if (j = i) then 1 else 0)"
       by (auto simp add: ii1 ij0')
   }
   note maWW = this
   then have "mat_adjoint W * W = 1\<^sub>m n" unfolding one_mat_def using dimW dimaW
     by (auto simp add: maWW adjoint_def)
   then have iv0: "adjoint W * W = 1\<^sub>m n"  by auto
   have dimaW: "adjoint W \<in> carrier_mat n n" using dimaW by auto
   then have iv1: "W * adjoint W  = 1\<^sub>m n" using mat_mult_left_right_inverse dimW iv0 by auto
   then show "unitary W" unfolding unitary_def inverts_mat_def using dimW dimaW iv0 iv1 by auto 
 qed
 
 lemma normalize_keep_eigenvector:
   assumes ev: "eigenvector A v e" 
     and dim: "A \<in> carrier_mat n n" "v \<in> carrier_vec n"
   shows "eigenvector A (vec_normalize v) e"
   unfolding eigenvector_def
 proof 
   show "vec_normalize v \<in> carrier_vec (dim_row A)" using dim by auto
   have eg: "A *\<^sub>v v = e \<cdot>\<^sub>v v" using ev dim eigenvector_def by auto
   have vneq0: "v \<noteq> 0\<^sub>v n" using ev dim unfolding eigenvector_def by auto
   then have s0: "vec_normalize v \<noteq> 0\<^sub>v n" 
     by (insert dim, subst normalize_zero[of v], auto)
   from vneq0 have vvge0: "vec_norm v > 0" using vec_norm_ge_0 dim by auto
   have s1: "A *\<^sub>v vec_normalize v = e \<cdot>\<^sub>v vec_normalize v" unfolding vec_normalize_def 
     using vneq0 dim 
     apply (auto, simp add: mult_mat_vec)
     apply (subst eg, auto)
     done
   with s0 dim show "vec_normalize v \<noteq> 0\<^sub>v (dim_row A) \<and> A *\<^sub>v vec_normalize v = e \<cdot>\<^sub>v vec_normalize v" by auto
 qed
 
 lemma four_block_mat_adjoint:
   fixes A B C D :: "'a::conjugatable_field mat"
   assumes dim: "A \<in> carrier_mat nr1 nc1" "B \<in> carrier_mat nr1 nc2"
   "C \<in> carrier_mat nr2 nc1" "D \<in> carrier_mat nr2 nc2"
   shows "adjoint (four_block_mat A B C D) 
     = four_block_mat (adjoint A) (adjoint C) (adjoint B) (adjoint D)"
   by (rule eq_matI, insert dim, auto simp add: adjoint_eval)
 
 fun unitary_schur_decomposition :: "complex mat \<Rightarrow> complex list \<Rightarrow> complex mat \<times> complex mat \<times> complex mat" where 
   "unitary_schur_decomposition A [] = (A, 1\<^sub>m (dim_row A), 1\<^sub>m (dim_row A))"
 | "unitary_schur_decomposition A (e # es) = (let
        n = dim_row A;
        n1 = n - 1;
        v' = find_eigenvector A e;
        v = vec_normalize v';
        ws0 = gram_schmidt n (basis_completion v);
        ws = map vec_normalize ws0;
        W = mat_of_cols n ws;
        W' = corthogonal_inv W;
        A' = W' * A * W;
        (A1,A2,A0,A3) = split_block A' 1 1;
        (B,P,Q) = unitary_schur_decomposition A3 es;
        z_row = (0\<^sub>m 1 n1);
        z_col = (0\<^sub>m n1 1);
        one_1 = 1\<^sub>m 1
      in (four_block_mat A1 (A2 * P) A0 B, 
      W * four_block_mat one_1 z_row z_col P, 
      four_block_mat one_1 z_row z_col Q * W'))"
 
 theorem unitary_schur_decomposition:
   assumes A: "(A::complex mat) \<in> carrier_mat n n"
       and c: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])"
       and B: "unitary_schur_decomposition A es = (B,P,Q)"
   shows "similar_mat_wit A B P Q \<and> upper_triangular B \<and> diag_mat B = es \<and> unitary P \<and> (Q = adjoint P)"
   using assms
 proof (induct es arbitrary: n A B P Q)
   case Nil
   with degree_monic_char_poly[of A n] 
   show ?case by (auto intro: similar_mat_wit_refl simp: diag_mat_def unitary_zero)
 next
   case (Cons e es n A C P Q)
   let ?n1 = "n - 1"
   from Cons have A: "A \<in> carrier_mat n n" and dim: "dim_row A = n" by auto
   let ?cp = "char_poly A"
   from Cons(3)
   have cp: "?cp = [: -e, 1 :] * (\<Prod>e \<leftarrow> es. [:- e, 1:])" by auto
   have mon: "monic (\<Prod>e\<leftarrow> es. [:- e, 1:])" by (rule monic_prod_list, auto)
   have deg: "degree ?cp = Suc (degree (\<Prod>e\<leftarrow> es. [:- e, 1:]))" unfolding cp
     by (subst degree_mult_eq, insert mon, auto)
   with degree_monic_char_poly[OF A] have n: "n \<noteq> 0" by auto
   define v' where "v' = find_eigenvector A e"
   define v where "v = vec_normalize v'"
   define b where "b = basis_completion v"
   define ws0 where "ws0 = gram_schmidt n b"
   define ws where "ws = map vec_normalize ws0"
   define W where "W = mat_of_cols n ws"
   define W' where "W' = corthogonal_inv W"
   define A' where "A' = W' * A * W"
   obtain A1 A2 A0 A3 where splitA': "split_block A' 1 1 = (A1,A2,A0,A3)"
     by (cases "split_block A' 1 1", auto)
   obtain B P' Q' where schur: "unitary_schur_decomposition A3 es = (B,P',Q')" 
     by (cases "unitary_schur_decomposition A3 es", auto)
   let ?P' = "four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 ?n1) (0\<^sub>m ?n1 1) P'"
   let ?Q' = "four_block_mat (1\<^sub>m 1) (0\<^sub>m 1 ?n1) (0\<^sub>m ?n1 1) Q'"
   have C: "C = four_block_mat A1 (A2 * P') A0 B" and P: "P = W * ?P'" and Q: "Q = ?Q' * W'"
     using Cons(4) unfolding unitary_schur_decomposition.simps
     Let_def list.sel dim
     v'_def[symmetric] v_def[symmetric] b_def[symmetric] ws0_def[symmetric] ws_def[symmetric] W'_def[symmetric] W_def[symmetric]
     A'_def[symmetric] split splitA' schur by auto
   have e: "eigenvalue A e" 
     unfolding eigenvalue_root_char_poly[OF A] cp by simp
   from find_eigenvector[OF A e] have ev': "eigenvector A v' e" unfolding v'_def .
   then have "v' \<in> carrier_vec n" unfolding eigenvector_def using A by auto
   with ev' have ev: "eigenvector A v e" unfolding v_def using A dim normalize_keep_eigenvector by auto
   from this[unfolded eigenvector_def]
   have v[simp]: "v \<in> carrier_vec n" and v0: "v \<noteq> 0\<^sub>v n" using A by auto
   interpret cof_vec_space n "TYPE(complex)" .
   from basis_completion[OF v v0, folded b_def]
   have span_b: "span (set b) = carrier_vec n" and dist_b: "distinct b" 
     and indep: "\<not> lin_dep (set b)" and b: "set b \<subseteq> carrier_vec n" and hdb: "hd b = v" 
     and len_b: "length b = n" by auto
   from hdb len_b n obtain vs where bv: "b = v # vs" by (cases b, auto)
   from gram_schmidt_result[OF b dist_b indep refl, folded ws0_def]
   have ws0: "set ws0 \<subseteq> carrier_vec n" "corthogonal ws0" "length ws0 = n" 
     by (auto simp: len_b)
   then have ws: "set ws \<subseteq> carrier_vec n" "corthogonal ws" "length ws = n" unfolding ws_def
     using normalize_keep_corthogonal by auto
   have ws0ne: "ws0 \<noteq> []" using \<open>length ws0 = n\<close> n by auto
   from gram_schmidt_hd[OF v, of vs, folded bv] have hdws0: "hd ws0 = (vec_normalize v')" unfolding ws0_def v_def .
   have "hd ws = vec_normalize (hd ws0)" unfolding ws_def using hd_map[OF ws0ne]  by auto
   then have hdws: "hd ws = v" unfolding v_def using normalize_normalize[of v'] hdws0 by auto
   have orth_W: "corthogonal_mat W" using orthogonal_mat_of_cols ws unfolding W_def.
   have W: "W \<in> carrier_mat n n"
     using ws unfolding W_def using mat_of_cols_carrier(1)[of n ws] by auto
   have W': "W' \<in> carrier_mat n n" unfolding W'_def corthogonal_inv_def using W 
     by (auto simp: mat_of_rows_def)  
   from corthogonal_inv_result[OF orth_W] 
   have W'W: "inverts_mat W' W" unfolding W'_def .
   hence WW': "inverts_mat W W'" using mat_mult_left_right_inverse[OF W' W] W' W
     unfolding inverts_mat_def by auto
   have A': "A' \<in> carrier_mat n n" using W W' A unfolding A'_def by auto
   have A'A_wit: "similar_mat_wit A' A W' W"
     by (rule similar_mat_witI[of _ _ n], insert W W' A A' W'W WW', auto simp: A'_def
     inverts_mat_def)
   hence A'A: "similar_mat A' A" unfolding similar_mat_def by blast
   from similar_mat_wit_sym[OF A'A_wit] have simAA': "similar_mat_wit A A' W W'" by auto
   have eigen[simp]: "A *\<^sub>v v = e \<cdot>\<^sub>v v" and v0: "v \<noteq> 0\<^sub>v n"
     using v_def v'_def find_eigenvector[OF A e] A normalize_keep_eigenvector
     unfolding eigenvector_def by auto
   let ?f = "(\<lambda> i. if i = 0 then e else 0)"
   have col0: "col A' 0 = vec n ?f"
     unfolding A'_def W'_def W_def
     using corthogonal_col_ev_0[OF A v v0 eigen n hdws ws].
   from A' n have "dim_row A' = 1 + ?n1" "dim_col A' = 1 + ?n1" by auto
   from split_block[OF splitA' this] have A2: "A2 \<in> carrier_mat 1 ?n1"
     and A3: "A3 \<in> carrier_mat ?n1 ?n1" 
     and A'block: "A' = four_block_mat A1 A2 A0 A3" by auto
   have A1id: "A1 = mat 1 1 (\<lambda> _. e)"
     using splitA'[unfolded split_block_def Let_def] arg_cong[OF col0, of "\<lambda> v. v $ 0"] A' n
     by (auto simp: col_def)
   have A1: "A1 \<in> carrier_mat 1 1" unfolding A1id by auto
   {
     fix i
     assume "i < ?n1"
     with arg_cong[OF col0, of "\<lambda> v. v $ Suc i"] A'
     have "A' $$ (Suc i, 0) = 0" by auto
   } note A'0 = this
   have A0id: "A0 = 0\<^sub>m ?n1 1"
     using splitA'[unfolded split_block_def Let_def] A'0 A' by auto
   have A0: "A0 \<in> carrier_mat ?n1 1" unfolding A0id by auto
   from cp char_poly_similar[OF A'A]
   have cp: "char_poly A' = [: -e,1 :] * (\<Prod> e \<leftarrow> es. [:- e, 1:])" by simp
   also have "char_poly A' = char_poly A1 * char_poly A3" 
     unfolding A'block A0id
     by (rule char_poly_four_block_zeros_col[OF A1 A2 A3])
   also have "char_poly A1 = [: -e,1 :]"
     by (simp add: A1id char_poly_defs det_def)
   finally have cp: "char_poly A3 = (\<Prod> e \<leftarrow> es. [:- e, 1:])"
     by (metis mult_cancel_left pCons_eq_0_iff zero_neq_one)
   from Cons(1)[OF A3 cp schur]
   have simIH: "similar_mat_wit A3 B P' Q'" and ut: "upper_triangular B" and diag: "diag_mat B = es"
     and uP': "unitary P'" and Q'P': "Q' = adjoint P'"
     by auto
   from similar_mat_witD2[OF A3 simIH] 
   have B: "B \<in> carrier_mat ?n1 ?n1" and P': "P' \<in> carrier_mat ?n1 ?n1" and Q': "Q' \<in> carrier_mat ?n1 ?n1" 
     and PQ': "P' * Q' = 1\<^sub>m ?n1" by auto
   have A0_eq: "A0 = P' * A0 * 1\<^sub>m 1" unfolding A0id using P' by auto
   have simA'C: "similar_mat_wit A' C ?P' ?Q'" unfolding A'block C
     by (rule similar_mat_wit_four_block[OF similar_mat_wit_refl[OF A1] simIH _ A0_eq A1 A3 A0],
     insert PQ' A2 P' Q', auto)
   have ut1: "upper_triangular A1" unfolding A1id by auto
   have ut: "upper_triangular C" unfolding C A0id
     by (intro upper_triangular_four_block[OF _ B ut1 ut], auto simp: A1id)
   from A1id have diagA1: "diag_mat A1 = [e]" unfolding diag_mat_def by auto
   from diag_four_block_mat[OF A1 B] have diag: "diag_mat C = e # es" unfolding diag diagA1 C by simp
 
   have aW: "adjoint W \<in> carrier_mat n n" using W by auto
   have aW': "adjoint W' \<in> carrier_mat n n" using W' by auto
   have "unitary W" using W_def ws_def ws0 normalized_corthogonal_mat_is_unitary by auto
   then have ivWaW: "inverts_mat W (adjoint W)" using unitary_def W aW by auto
   with WW' have W'aW: "W' = (adjoint W)" using inverts_mat_unique W W' aW by auto
   then have "adjoint W' = W" using adjoint_adjoint by auto
   with ivWaW have "inverts_mat W' (adjoint W')" using inverts_mat_symm W aW W'aW by auto
   then have "unitary W'" using unitary_def W' by auto
 
   have newP': "P' \<in> carrier_mat (n - Suc 0) (n - Suc 0)" using P' by auto
   have rl: "\<And> x1 x2 x3 x4 y1 y2 y3 y4 f. x1 = y1 \<Longrightarrow> x2 = y2 \<Longrightarrow> x3 = y3 \<Longrightarrow> x4 = y4 \<Longrightarrow> f x1 x2 x3 x4 = f y1 y2 y3 y4" by simp
   have Q'aP': "?Q' = adjoint ?P'"
     apply (subst four_block_mat_adjoint, auto simp add: newP')
     apply (rule rl[where f2 = four_block_mat])
        apply (auto simp add: eq_matI adjoint_eval Q'P')
     done
   have "adjoint P = adjoint ?P' * adjoint W"  using W newP' n
     apply (simp add: P)
     apply (subst adjoint_mult[of W, symmetric])
      apply (auto simp add: W P' carrier_matD[of W n n])
     done
   also have "\<dots> = ?Q' * W'" using Q'aP' W'aW by auto
   also have "\<dots> = Q" using Q by auto
   finally have QaP: "Q = adjoint P" ..
 
   from similar_mat_wit_trans[OF simAA' simA'C, folded P Q] have smw: "similar_mat_wit A C P Q" by blast
   then have dimP: "P \<in> carrier_mat n n" and dimQ: "Q \<in> carrier_mat n n" unfolding similar_mat_wit_def using A by auto
   from smw have "P * Q = 1\<^sub>m n" unfolding similar_mat_wit_def using A  by auto
   then have "inverts_mat P Q" using inverts_mat_def dimP by auto
   then have uP: "unitary P" using QaP unitary_def dimP by auto
     
   from ut similar_mat_wit_trans[OF simAA' simA'C, folded P Q] diag uP QaP
   show ?case by blast
 qed
 
 lemma complex_mat_char_poly_factorizable:
   fixes A :: "complex mat"
   assumes "A \<in> carrier_mat n n"
   shows "\<exists>as. char_poly A =  (\<Prod> a \<leftarrow> as. [:- a, 1:]) \<and> length as = n"
 proof -
   let ?ca = "char_poly A"
   have ex0: "\<exists>bs. Polynomial.smult (lead_coeff ?ca) (\<Prod>b\<leftarrow>bs. [:- b, 1:]) = ?ca \<and>
      length bs = degree ?ca"
     by (simp add: fundamental_theorem_algebra_factorized)
   then obtain bs where " Polynomial.smult (lead_coeff ?ca) (\<Prod>b\<leftarrow>bs. [:- b, 1:]) = ?ca \<and>
      length bs = degree ?ca" by auto
   moreover have "lead_coeff ?ca = (1::complex)" 
     using assms degree_monic_char_poly by blast
   ultimately have ex1: "?ca = (\<Prod>b\<leftarrow>bs. [:- b, 1:]) \<and> length bs = degree ?ca" by auto
   moreover have "degree ?ca = n"
     by (simp add: assms degree_monic_char_poly)
   ultimately show ?thesis by auto
 qed
 
 lemma complex_mat_has_unitary_schur_decomposition:
   fixes A :: "complex mat"
   assumes "A \<in> carrier_mat n n"
   shows "\<exists>B P es. similar_mat_wit A B P (adjoint P) \<and> unitary P 
     \<and> char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:]) \<and> diag_mat B = es"
 proof -
   have "\<exists>es. char_poly A =  (\<Prod> e \<leftarrow> es. [:- e, 1:]) \<and> length es = n" 
     using assms by (simp add: complex_mat_char_poly_factorizable)
   then obtain es where es: "char_poly A =  (\<Prod> e \<leftarrow> es. [:- e, 1:]) \<and> length es = n" by auto
   obtain B P Q where B: "unitary_schur_decomposition A es = (B,P,Q)" by (cases "unitary_schur_decomposition A es", auto)
 
   have "similar_mat_wit A B P Q \<and> upper_triangular B \<and> unitary P \<and> (Q = adjoint P) \<and> 
    char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:]) \<and> diag_mat B = es" using assms es B
     by (auto simp add: unitary_schur_decomposition)
   then show ?thesis by auto
 qed
 
 lemma normal_upper_triangular_matrix_is_diagonal:
   fixes A :: "'a::conjugatable_ordered_field mat"
   assumes "A \<in> carrier_mat n n"
     and tri: "upper_triangular A"
     and norm: "A * adjoint A = adjoint A * A"
   shows "diagonal_mat A"
 proof (rule disjE[of "n = 0" "n > 0"], blast)
   have dim: "dim_row A = n" "dim_col A = n" using assms by auto
   from norm have eq0: "\<And>i j. (A * adjoint A)$$(i,j) = (adjoint A * A)$$(i,j)" by auto
   have nat_induct_strong: 
     "\<And>P. (P::nat\<Rightarrow>bool) 0 \<Longrightarrow> (\<And>i. i < n \<Longrightarrow> (\<And>k. k < i \<Longrightarrow> P k) \<Longrightarrow> P i) \<Longrightarrow> (\<And>i. i < n \<Longrightarrow> P i)"
     by (metis dual_order.strict_trans infinite_descent0 linorder_neqE_nat)
   show "n = 0 \<Longrightarrow> ?thesis" using dim unfolding diagonal_mat_def by auto
   show "n > 0 \<Longrightarrow> ?thesis" unfolding diagonal_mat_def dim
     apply (rule allI, rule impI)
     apply (rule nat_induct_strong)
   proof (rule allI, rule impI, rule impI)
     assume asm: "n > 0"
     from tri upper_triangularD[of A 0 j] dim have z0: "\<And>j. 0< j \<Longrightarrow> j < n \<Longrightarrow> A$$(j, 0) = 0" 
       by auto
     then have ada00: "(adjoint A * A)$$(0,0) = conjugate (A$$(0,0)) * A$$(0,0)"
       using asm dim by (auto simp add: scalar_prod_def adjoint_eval sum.atLeast_Suc_lessThan)
     have aad00: "(A * adjoint A)$$(0,0) = (\<Sum>k=0..<n. A$$(0, k) * conjugate (A$$(0, k)))"
       using asm dim by (auto simp add: scalar_prod_def adjoint_eval)
     moreover have 
       "\<dots> = A$$(0,0) * conjugate (A$$(0,0))
           + (\<Sum>k=1..<n. A$$(0, k) * conjugate (A$$(0, k)))"
       using dim asm by (subst sum.atLeast_Suc_lessThan[of 0 n "\<lambda>k. A$$(0, k) * conjugate (A$$(0, k))"], auto)
     ultimately have f1tneq0: "(\<Sum>k=(Suc 0)..<n. A$$(0, k) * conjugate (A$$(0, k))) = 0"
       using eq0 ada00 by (simp)
     have geq0: "\<And>k. k < n \<Longrightarrow> A$$(0, k) * conjugate (A$$(0, k)) \<ge> 0"  
       using conjugate_square_positive by auto
     have "\<And>k. 1 \<le> k \<Longrightarrow> k < n \<Longrightarrow> A$$(0, k) * conjugate (A$$(0, k)) = 0"
       by (rule sum_nonneg_0[of "{1..<n}"], auto, rule geq0, auto, rule f1tneq0)
     with dim asm show 
       case0: "\<And>j. 0 < n \<Longrightarrow> j < n \<Longrightarrow> 0 \<noteq> j \<Longrightarrow> A $$ (0, j) = 0"
       by auto
     {
       fix i
       assume asm: "n > 0" "i < n" "i > 0"
         and ih: "\<And>k. k < i \<Longrightarrow> \<forall>j<n. k \<noteq> j \<longrightarrow> A $$ (k, j) = 0"
       then have "\<And>j. j<n \<Longrightarrow> i \<noteq> j \<Longrightarrow> A $$ (i, j) = 0"
       proof -
         have inter_part: "\<And>b m e. (b::nat) < e \<Longrightarrow> b < m \<Longrightarrow> m < e \<Longrightarrow> {b..<m} \<union> {m..<e} = {b..<e}" by auto
         then have  
           "\<And>b m e f. (b::nat) < e \<Longrightarrow> b < m \<Longrightarrow> m < e 
             \<Longrightarrow> (\<Sum>k=b..<e. f k) = (\<Sum>k\<in>{b..<m}\<union>{m..<e}. f k)"
           using sum.union_disjoint by auto
         then have sum_part:
           "\<And>b m e f. (b::nat) < e \<Longrightarrow> b < m \<Longrightarrow> m < e 
                       \<Longrightarrow> (\<Sum>k=b..<e. f k) = (\<Sum>k=b..<m. f k) + (\<Sum>k=m..<e. f k)"
           by (auto simp add: sum.union_disjoint)
         from tri upper_triangularD[of A j i] asm dim have 
             zsi0: "\<And>j. j < i \<Longrightarrow> A$$(i, j) = 0" by auto
         from tri upper_triangularD[of A j i] asm dim have 
             zsi1: "\<And>k. i < k \<Longrightarrow> k < n \<Longrightarrow> A$$(k, i) = 0" by auto
         have 
           "(A * adjoint A)$$(i, i) 
           = (\<Sum>k=0..<n. conjugate (A$$(i, k)) * A$$(i, k))" using asm dim
           apply (auto simp add: scalar_prod_def adjoint_eval)
           apply (rule sum.cong, auto)
           done
         also have
           "\<dots> = (\<Sum>k=0..<i. conjugate (A$$(i, k)) * A$$(i, k))
               + (\<Sum>k=i..<n. conjugate (A$$(i, k)) * A$$(i, k))"
           using asm
           by (auto simp add: sum_part[of 0 n i])
         also have
           "\<dots> = (\<Sum>k=i..<n. conjugate (A$$(i, k)) * A$$(i, k))"
           using zsi0
           by auto
         also have
           "\<dots> = conjugate (A$$(i, i)) * A$$(i, i) 
             + (\<Sum>k=(Suc i)..<n. conjugate (A$$(i, k)) * A$$(i, k))"
           using asm
           by (auto simp add: sum.atLeast_Suc_lessThan)
         finally have
           adaii: "(A * adjoint A)$$(i, i) 
             = conjugate (A$$(i, i)) * A$$(i, i) 
             + (\<Sum>k=(Suc i)..<n. conjugate (A$$(i, k)) * A$$(i, k))" .
         have 
           "(adjoint A * A)$$(i, i) = (\<Sum>k=0..<n. conjugate (A$$(k, i)) * A$$(k, i))"
           using asm dim by (auto simp add: scalar_prod_def adjoint_eval)
         also have
           "\<dots> = (\<Sum>k=0..<i. conjugate (A$$(k, i)) * A$$(k, i))
               + (\<Sum>k=i..<n. conjugate (A$$(k, i)) * A$$(k, i))"
           using asm by (auto simp add: sum_part[of 0 n i])
         also have 
             "\<dots> = (\<Sum>k=i..<n. conjugate (A$$(k, i)) * A$$(k, i))"
           using asm ih by auto
         also have
             "\<dots> = conjugate (A$$(i, i)) * A$$(i, i)"
           using asm zsi1 by (auto simp add: sum.atLeast_Suc_lessThan)
         finally have "(adjoint A * A)$$(i, i) = conjugate (A$$(i, i)) * A$$(i, i)" .
         with adaii eq0 have 
           fsitoneq0: "(\<Sum>k=(Suc i)..<n. conjugate (A$$(i, k)) * A$$(i, k)) = 0" by auto
         have "\<And>k. k<n \<Longrightarrow> i < k \<Longrightarrow> conjugate (A$$(i, k)) * A$$(i, k) = 0"
           by (rule sum_nonneg_0[of "{(Suc i)..<n}"], auto, subst mult.commute, 
               rule conjugate_square_positive, rule fsitoneq0)
         then have "\<And>k. k<n  \<Longrightarrow> i<k \<Longrightarrow> A $$ (i, k) = 0" by auto
         with zsi0 show "\<And>j. j<n \<Longrightarrow> i \<noteq> j \<Longrightarrow> A $$ (i, j) = 0" 
           by (metis linorder_neqE_nat)
       qed
     }
     with case0 show "\<And>i ia.
        0 < n \<Longrightarrow>
        i < n \<Longrightarrow>
        ia < n \<Longrightarrow>
        (\<And>k. k < ia \<Longrightarrow> \<forall>j<n. k \<noteq> j \<longrightarrow> A $$ (k, j) = 0) \<Longrightarrow>
        \<forall>j<n. ia \<noteq> j \<longrightarrow> A $$ (ia, j) = 0" by auto
   qed
 qed
 
 lemma normal_complex_mat_has_spectral_decomposition:
   assumes A: "(A::complex mat) \<in> carrier_mat n n"
     and normal: "A * adjoint A  = adjoint A * A"
     and c: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])"
     and B: "unitary_schur_decomposition A es = (B,P,Q)"
   shows "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es \<and> unitary P"
 proof -
   have smw: "similar_mat_wit A B P (adjoint P)" 
     and ut: "upper_triangular B"
     and uP: "unitary P" 
     and dB: "diag_mat B = es"
     and "(Q = adjoint P)"
     using assms by (auto simp add: unitary_schur_decomposition)
   from smw have dimP: "P \<in> carrier_mat n n" and dimB: "B \<in> carrier_mat n n" 
     and dimaP: "adjoint P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def using A by auto
   have dimaB: "adjoint B \<in> carrier_mat n n" using dimB by auto
   note dims = dimP dimB dimaP dimaB
 
   have "inverts_mat P (adjoint P)" using unitary_def uP dims by auto
   then have iaPP: "inverts_mat (adjoint P) P" using inverts_mat_symm using dims by auto
   have aPP: "adjoint P * P = 1\<^sub>m n" using dims iaPP unfolding inverts_mat_def by auto
   from smw have A: "A = P * B * (adjoint P)" unfolding similar_mat_wit_def Let_def by auto
   then have aA: "adjoint A = P * adjoint B * adjoint P" 
     by (insert A dimP dimB dimaP, auto simp add: adjoint_mult[of _ n n _ n] adjoint_adjoint)
   have "A * adjoint A = (P * B * adjoint P) * (P * adjoint B * adjoint P)" using A aA by auto
   also have "\<dots> = P * B * (adjoint P * P) * (adjoint B * adjoint P)" using dims by (mat_assoc n)
   also have "\<dots> = P * B * 1\<^sub>m n * (adjoint B * adjoint P)" using dims aPP by (auto)
   also have "\<dots> = P * B * adjoint B * adjoint P" using dims by (mat_assoc n)
   finally have "A * adjoint A = P * B * adjoint B * adjoint P".
   then have "adjoint P * (A * adjoint A) * P = (adjoint P * P) * B * adjoint B * (adjoint P * P)"
     using dims by (simp add: assoc_mult_mat[of _ n n _ n _ n])
   also have "\<dots> = 1\<^sub>m n * B * adjoint B * 1\<^sub>m n" using aPP by auto
   also have "\<dots> = B * adjoint B" using dims by auto
   finally have eq0: "adjoint P * (A * adjoint A) * P = B * adjoint B".
 
   have "adjoint A * A = (P * adjoint B * adjoint P) * (P * B * adjoint P)" using A aA by auto
   also have "\<dots> = P * adjoint B * (adjoint P * P) * (B * adjoint P)" using dims by (mat_assoc n)
   also have "\<dots> = P * adjoint B * 1\<^sub>m n * (B * adjoint P)" using dims aPP by (auto)
   also have "\<dots> = P * adjoint B * B * adjoint P" using dims by (mat_assoc n)  
   finally have "adjoint A * A = P * adjoint B * B * adjoint P" by auto
   then have "adjoint P * (adjoint A * A) * P = (adjoint P * P) * adjoint B * B * (adjoint P * P)"
     using dims by (simp add: assoc_mult_mat[of _ n n _ n _ n])
   also have "\<dots> = 1\<^sub>m n * adjoint B * B * 1\<^sub>m n" using aPP by auto
   also have "\<dots> = adjoint B * B" using dims by auto
   finally have eq1: "adjoint P * (adjoint A * A) * P = adjoint B * B".
 
   from normal have "adjoint P * (adjoint A * A) * P = adjoint P * (A * adjoint A) * P" by auto
   with eq0 eq1 have "B * adjoint B = adjoint B * B" by auto
   with ut dims have "diagonal_mat B" using normal_upper_triangular_matrix_is_diagonal by auto
   with smw uP dB show "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es \<and> unitary P" by auto
 qed
 
 lemma complex_mat_has_jordan_nf:
   fixes A :: "complex mat"
   assumes "A \<in> carrier_mat n n"
   shows "\<exists>n_as. jordan_nf A n_as"
 proof -
   have "\<exists>as. char_poly A =  (\<Prod> a \<leftarrow> as. [:- a, 1:]) \<and> length as = n" 
     using assms by (simp add: complex_mat_char_poly_factorizable)
   then show ?thesis using assms
     by (auto simp add: jordan_nf_iff_linear_factorization)
 qed
 
 lemma hermitian_is_normal:
   assumes "hermitian A"
   shows "A * adjoint A = adjoint A * A"
   using assms by (auto simp add: hermitian_def)
 
 lemma hermitian_eigenvalue_real:
   assumes dim: "(A::complex mat) \<in> carrier_mat n n"
     and hA: "hermitian A"
     and c: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])"
     and B: "unitary_schur_decomposition A es = (B,P,Q)"
   shows "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
 proof -
   have normal: "A * adjoint A = adjoint A * A" using hA hermitian_is_normal by auto
   then have schur: "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es \<and> unitary P"
     using normal_complex_mat_has_spectral_decomposition[OF dim normal c B] by (simp)
   then have "similar_mat_wit A B P (adjoint P)" 
     and uP: "unitary P" and dB: "diag_mat B = es"
     using assms by auto
   then have A: "A = P * B * (adjoint P)" 
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def Let_def using dim by auto
   then have dimaB: "adjoint B \<in> carrier_mat n n" by auto
   have "adjoint A = adjoint (adjoint P) * adjoint (P * B)" 
     apply (subst A)
     apply (subst adjoint_mult[of "P * B" n n "adjoint P" n])
       apply (insert dimB dimP, auto)
     done
   also have "\<dots> = P * adjoint (P * B)" by (auto simp add: adjoint_adjoint)
   also have "\<dots> = P * (adjoint B * adjoint P)" using dimB dimP by (auto simp add: adjoint_mult)
   also have "\<dots> = P * adjoint B * adjoint P" using dimB dimP by (subst assoc_mult_mat[symmetric, of P n n "adjoint B" n "adjoint P" n], auto)
   finally have aA: "adjoint A = P * adjoint B * adjoint P" .
   have "A = adjoint A" using hA hermitian_def[of A] by auto
   then have "P * B * adjoint P = P * adjoint B * adjoint P" using A aA by auto
   then have BaB: "B = adjoint B" using unitary_elim[OF dimB dimaB dimP] uP by auto
   {
     fix i 
     assume "i < n"
     then have "B$$(i, i) = conjugate (B$$(i, i))" 
       apply (subst BaB)
       by (insert dimB, simp add: adjoint_eval)
     then have "B$$(i, i) \<in> Reals" unfolding conjugate_complex_def 
       using Reals_cnj_iff by auto
   }
   then have "\<forall>i<n. B$$(i, i) \<in> Reals" by auto
   with schur show ?thesis by auto
 qed
 
 lemma hermitian_inner_prod_real:
   assumes dimA: "(A::complex mat) \<in> carrier_mat n n"
     and dimv: "v \<in> carrier_vec n"
     and hA: "hermitian A"
   shows "inner_prod v (A *\<^sub>v v) \<in> Reals"
 proof -
   obtain es where es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])" 
     using complex_mat_char_poly_factorizable dimA by auto
   obtain B P Q where "unitary_schur_decomposition A es = (B,P,Q)" 
     by (cases "unitary_schur_decomposition A es", auto)
   then have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
     using hermitian_eigenvalue_real dimA es hA by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def Let_def using dimA by auto
   define w where "w = (adjoint P) *\<^sub>v v"
   then have dimw: "w \<in> carrier_vec n" using dimaP dimv by auto
   from A have "inner_prod v (A *\<^sub>v v) = inner_prod v ((P * B * (adjoint P)) *\<^sub>v v)" by auto
   also have "\<dots> = inner_prod v ((P * B) *\<^sub>v ((adjoint P) *\<^sub>v v))" using dimP dimB dimv
     by (subst assoc_mult_mat_vec[of _ n n "adjoint P" n], auto)
   also have "\<dots> = inner_prod v (P *\<^sub>v (B *\<^sub>v ((adjoint P) *\<^sub>v v)))" using dimP dimB dimv dimaP
     by (subst assoc_mult_mat_vec[of _ n n "B" n], auto)
   also have "\<dots> = inner_prod w (B *\<^sub>v w)" unfolding w_def 
     apply (rule adjoint_def_alter[OF _ _ dimP])
      apply (insert mult_mat_vec_carrier[OF dimB mult_mat_vec_carrier[OF dimaP dimv]], auto simp add: dimv)
     done
 
   also have "\<dots> = (\<Sum>i=0..<n. (\<Sum>j=0..<n.
                 conjugate (w$i) * B$$(i, j) * w$j))" unfolding scalar_prod_def using dimw dimB
     apply (simp add: scalar_prod_def sum_distrib_right)
     apply (rule sum.cong, auto, rule sum.cong, auto)
     done
   also have "\<dots> = (\<Sum>i=0..<n. B$$(i, i) *  conjugate (w$i) * w$i)" 
     apply (rule sum.cong, auto)
     apply (simp add: sum.remove)
     apply (insert dB[unfolded diagonal_mat_def] dimB, auto)
     done
   finally have sum: "inner_prod v (A *\<^sub>v v) = (\<Sum>i=0..<n. B$$(i, i) *  conjugate (w$i) * w$i)" .
   have "\<And>i. i < n \<Longrightarrow> B$$(i, i) *  conjugate (w$i) * w$i \<in> Reals" using Bii by (simp add: Reals_cnj_iff)
   then have "(\<Sum>i=0..<n. B$$(i, i) *  conjugate (w$i) * w$i) \<in> Reals" by auto
   then show ?thesis using sum by auto
 qed
 
 lemma unit_vec_bracket:
   fixes A :: "complex mat"
   assumes dimA: "A \<in> carrier_mat n n" and i: "i < n"
   shows "inner_prod (unit_vec n i) (A *\<^sub>v (unit_vec n i)) = A$$(i, i)"
 proof -
   define w where "(w::complex vec) = unit_vec n i"
   have "A *\<^sub>v w = col A i" using i dimA w_def by auto
   then have 1: "inner_prod w (A *\<^sub>v w) = inner_prod w (col A i)" using w_def by auto
   have "conjugate w = w" unfolding w_def unit_vec_def conjugate_vec_def using i by auto
   then have 2: "inner_prod w (col A i) = A$$(i, i)" using i dimA w_def by auto
   from 1 2 show "inner_prod w (A *\<^sub>v w) = A$$(i, i)" by auto
 qed
 
 lemma spectral_decomposition_extract_diag:
   fixes P B :: "complex mat"
   assumes dimP: "P \<in> carrier_mat n n" and dimB: "B \<in> carrier_mat n n"
     and uP: "unitary P" and dB: "diagonal_mat B" and i: "i < n"
   shows "inner_prod (col P i) (P * B * (adjoint P) *\<^sub>v (col P i)) = B$$(i, i)"
 proof -
   have dimaP: "adjoint P\<in> carrier_mat n n" using dimP by auto
   have uaP: "unitary (adjoint P)" using unitary_adjoint uP dimP by auto
   then have "inverts_mat (adjoint P) P" by (simp add: unitary_def adjoint_adjoint)
   then have iv: "(adjoint P) * P = 1\<^sub>m n" using dimaP inverts_mat_def by auto
   define v where "v = col P i"
   then have dimv: "v \<in> carrier_vec n" using dimP by auto
   define w where "(w::complex vec) = unit_vec n i"
   then have dimw: "w \<in> carrier_vec n" by auto
   have BaPv: "B *\<^sub>v (adjoint P *\<^sub>v v) \<in> carrier_vec n" using dimB dimaP dimv by auto
   have "(adjoint P) *\<^sub>v v = (col (adjoint P * P) i)" 
     by (simp add: col_mult2[OF dimaP dimP i, symmetric] v_def)
   then have aPv: "(adjoint P) *\<^sub>v v = w"
     by (auto simp add: iv i w_def)
   have "inner_prod v (P * B * (adjoint P) *\<^sub>v v) = inner_prod v ((P * B) *\<^sub>v ((adjoint P) *\<^sub>v v))" using dimP dimB dimv
     by (subst assoc_mult_mat_vec[of _ n n "adjoint P" n], auto)
   also have "\<dots> = inner_prod v (P *\<^sub>v (B *\<^sub>v ((adjoint P) *\<^sub>v v)))" using dimP dimB dimv dimaP
     by (subst assoc_mult_mat_vec[of _ n n "B" n], auto)
   also have "\<dots> = inner_prod (adjoint P *\<^sub>v v) (B *\<^sub>v (adjoint P *\<^sub>v v))" 
     by (simp add: adjoint_def_alter[OF dimv BaPv dimP])
   also have "\<dots> = inner_prod w (B *\<^sub>v w)" using aPv by auto
   also have "\<dots> = B$$(i, i)" using w_def unit_vec_bracket dimB i by auto
   finally show "inner_prod v (P * B * (adjoint P) *\<^sub>v v) = B$$(i, i)".
 qed
 
 lemma hermitian_inner_prod_zero:
   fixes A :: "complex mat"
   assumes dimA: "A \<in> carrier_mat n n" and hA: "hermitian A"
     and zero: "\<forall>v\<in>carrier_vec n. inner_prod v (A *\<^sub>v v) = 0"
   shows "A = 0\<^sub>m n n"
 proof -
   obtain es where es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])" 
     using complex_mat_char_poly_factorizable dimA by auto
   obtain B P Q where "unitary_schur_decomposition A es = (B,P,Q)" 
     by (cases "unitary_schur_decomposition A es", auto)
   then have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
     using hermitian_eigenvalue_real dimA es hA by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     and uP: "unitary P"
     unfolding similar_mat_wit_def Let_def unitary_def using dimA by auto
   then have uaP: "unitary (adjoint P)" using unitary_adjoint by auto
   then have "inverts_mat (adjoint P) P" by (simp add: unitary_def adjoint_adjoint)
   then have iv: "adjoint P * P = 1\<^sub>m n" using dimaP inverts_mat_def by auto
   have "B = 0\<^sub>m n n"
   proof-
     {
       fix i assume i: "i < n"
       define v where "v = col P i"
       then have dimv: "v \<in> carrier_vec n" using v_def dimP by auto
       have "inner_prod v (A *\<^sub>v v) = B$$(i, i)" unfolding A v_def
         using spectral_decomposition_extract_diag[OF dimP dimB uP dB i]  by auto
       moreover have "inner_prod v (A *\<^sub>v v) = 0" using dimv zero by auto
       ultimately have "B$$(i, i) = 0" by auto
     }
     note zB = this
     show "B = 0\<^sub>m n n" by (insert zB dB dimB, rule eq_matI, auto simp add: diagonal_mat_def)
   qed
   then show "A = 0\<^sub>m n n" using A dimB dimP dimaP by auto
 qed
 
 lemma complex_mat_decomposition_to_hermitian:
   fixes A :: "complex mat"
   assumes dim: "A \<in> carrier_mat n n"
   shows "\<exists>B C. hermitian B \<and> hermitian C \<and> A = B + \<i> \<cdot>\<^sub>m C \<and> B \<in> carrier_mat n n \<and> C \<in> carrier_mat n n"
 proof -
   obtain B C where B: "B = (1 / 2) \<cdot>\<^sub>m (A + adjoint A)" 
     and C: "C = (-\<i> / 2) \<cdot>\<^sub>m (A - adjoint A)" by auto
   then have dimB: "B \<in> carrier_mat n n" and dimC: "C \<in> carrier_mat n n" using dim by auto
   have "hermitian B" unfolding B hermitian_def using dim
     by (auto simp add: adjoint_eval)
   moreover have "hermitian C" unfolding C hermitian_def using dim
     apply (subst eq_matI)
        apply (auto simp add: adjoint_eval algebra_simps)
     done
   moreover have "A = B + \<i> \<cdot>\<^sub>m C" using dim B C 
     apply (subst eq_matI)
        apply (auto simp add: adjoint_eval algebra_simps)
     done
   ultimately show ?thesis using dimB dimC by auto
 qed
 
 subsection \<open>Outer product\<close>
 
 definition outer_prod :: "'a::conjugatable_field vec \<Rightarrow> 'a vec \<Rightarrow> 'a mat" where
   "outer_prod v w = mat (dim_vec v) 1 (\<lambda>(i, j). v $ i) * mat 1 (dim_vec w) (\<lambda>(i, j). (conjugate w) $ j)"
 
 lemma outer_prod_dim[simp]:
   fixes v w :: "'a::conjugatable_field vec"
   assumes v: "v \<in> carrier_vec n" and w: "w \<in> carrier_vec m"
   shows "outer_prod v w \<in> carrier_mat n m"
   unfolding outer_prod_def using assms mat_of_cols_carrier mat_of_rows_carrier by auto
 
 lemma mat_of_vec_mult_eq_scalar_prod:
   fixes v w :: "'a::conjugatable_field vec"
   assumes "v \<in> carrier_vec n" and "w \<in> carrier_vec n"
   shows "mat 1 (dim_vec v) (\<lambda>(i, j). (conjugate v) $ j) * mat (dim_vec w) 1 (\<lambda>(i, j). w $ i) 
     = mat 1 1 (\<lambda>k. inner_prod v w)"
   apply (rule eq_matI) using assms apply (simp add: scalar_prod_def) apply (rule sum.cong) by auto
 
 lemma one_dim_mat_mult_is_scale:
   fixes A B :: "('a::conjugatable_field mat)"
   assumes "B \<in> carrier_mat 1 n"
   shows "(mat 1 1 (\<lambda>k. a)) * B = a \<cdot>\<^sub>m B"
   apply (rule eq_matI) using assms by (auto simp add: scalar_prod_def)
 
 lemma outer_prod_mult_outer_prod:
   fixes a b c d :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec d1" and b: "b \<in> carrier_vec d2"
     and c: "c \<in> carrier_vec d2" and d: "d \<in> carrier_vec d3"
   shows "outer_prod a b * outer_prod c d = inner_prod b c \<cdot>\<^sub>m outer_prod a d"
 proof -
   let ?ma = "mat (dim_vec a) 1 (\<lambda>(i, j). a $ i)"
   let ?mb = "mat 1 (dim_vec b) (\<lambda>(i, j). (conjugate b) $ j)"
   let ?mc = "mat (dim_vec c) 1 (\<lambda>(i, j). c $ i)"
   let ?md = "mat 1 (dim_vec d) (\<lambda>(i, j). (conjugate d) $ j)"
   have "(?ma * ?mb) * (?mc * ?md) = ?ma * (?mb * (?mc * ?md))"
     apply (subst assoc_mult_mat[of "?ma" d1 1 "?mb" d2 "?mc * ?md" d3] )
     using assms by auto
   also have "\<dots> = ?ma * ((?mb * ?mc) * ?md)"
     apply (subst assoc_mult_mat[symmetric, of "?mb" 1 d2 "?mc" 1 "?md" d3])
     using assms by auto
   also have "\<dots> = ?ma * ((mat 1 1 (\<lambda>k. inner_prod b c)) * ?md)"
     apply (subst mat_of_vec_mult_eq_scalar_prod[of b d2 c]) using assms by auto
   also have "\<dots> = ?ma * (inner_prod b c \<cdot>\<^sub>m ?md)" 
     apply (subst one_dim_mat_mult_is_scale) using assms by auto
   also have "\<dots> = (inner_prod b c) \<cdot>\<^sub>m (?ma * ?md)" using assms by auto
   finally show ?thesis unfolding outer_prod_def by auto
 qed
 
 lemma index_outer_prod:
   fixes v w :: "'a::conjugatable_field vec"
   assumes v: "v \<in> carrier_vec n" and w: "w \<in> carrier_vec m"
     and ij: "i < n" "j < m"
   shows "(outer_prod v w)$$(i, j) = v $ i * conjugate (w $ j)"
   unfolding outer_prod_def using assms by (simp add: scalar_prod_def)
 
 lemma mat_of_vec_mult_vec:
   fixes a b c :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec d" and b: "b \<in> carrier_vec d"
   shows "mat 1 d (\<lambda>(i, j). (conjugate a) $ j) *\<^sub>v b = vec 1 (\<lambda>k. inner_prod a b)"
   apply (rule eq_vecI) 
    apply (simp add: scalar_prod_def carrier_vecD[OF a] carrier_vecD[OF b])
   apply (rule sum.cong) by auto
 
 lemma mat_of_vec_mult_one_dim_vec:
   fixes a b :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec d" 
   shows "mat d 1 (\<lambda>(i, j). a $ i) *\<^sub>v vec 1 (\<lambda>k. c) = c \<cdot>\<^sub>v a"
   apply (rule eq_vecI)
   by (auto simp add: scalar_prod_def carrier_vecD[OF a])
 
 lemma outer_prod_mult_vec:
   fixes a b c :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec d1" and b: "b \<in> carrier_vec d2"
     and c: "c \<in> carrier_vec d2"
   shows "outer_prod a b *\<^sub>v c = inner_prod b c \<cdot>\<^sub>v a"
 proof -
   have "outer_prod a b *\<^sub>v c 
     = mat d1 1 (\<lambda>(i, j). a $ i) 
     * mat 1 d2 (\<lambda>(i, j). (conjugate b) $ j)
     *\<^sub>v c" unfolding outer_prod_def using assms by auto
   also have "\<dots> = mat d1 1 (\<lambda>(i, j). a $ i) 
     *\<^sub>v (mat 1 d2 (\<lambda>(i, j). (conjugate b) $ j)
     *\<^sub>v c)" apply (subst assoc_mult_mat_vec) using assms by auto
   also have "\<dots> = mat d1 1 (\<lambda>(i, j). a $ i) 
     *\<^sub>v vec 1 (\<lambda>k. inner_prod b c)" using mat_of_vec_mult_vec[of b] assms by auto
   also have "\<dots> = inner_prod b c \<cdot>\<^sub>v a" using mat_of_vec_mult_one_dim_vec assms by auto
   finally show ?thesis by auto
 qed
 
 lemma trace_outer_prod_right:
   fixes A :: "'a::conjugatable_field mat" and v w :: "'a vec"
   assumes A: "A \<in> carrier_mat n n"
     and v: "v \<in> carrier_vec n" and w: "w \<in> carrier_vec n"
   shows "trace (A * outer_prod v w) = inner_prod w (A *\<^sub>v v)" (is "?lhs = ?rhs")
 proof -
   define B where "B = outer_prod v w"
   then have B: "B \<in> carrier_mat n n" using assms by auto
   have "trace(A * B) = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * B $$ (j,i))"
     unfolding trace_def using A B by (simp add: scalar_prod_def)
   also have "\<dots> = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * v $ j * conjugate (w $ i))"
     unfolding B_def
     apply (rule sum.cong, simp, rule sum.cong, simp)
     by (insert v w, auto simp add: index_outer_prod)
   finally have "?lhs = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * v $ j * conjugate (w $ i))" using B_def by auto
   moreover have "?rhs = (\<Sum>i = 0..<n. \<Sum>j = 0..<n. A $$ (i,j) * v $ j * conjugate (w $ i))" using A v w
     by (simp add: scalar_prod_def sum_distrib_right)
   ultimately show ?thesis by auto
 qed
 
 lemma trace_outer_prod:
   fixes v w :: "('a::conjugatable_field vec)"
   assumes v: "v \<in> carrier_vec n" and w: "w \<in> carrier_vec n"
   shows "trace (outer_prod v w) = inner_prod w v" (is "?lhs = ?rhs")
 proof -
   have "(1\<^sub>m n) * (outer_prod v w) = outer_prod v w" apply (subst left_mult_one_mat) using outer_prod_dim assms by auto
   moreover have "1\<^sub>m n *\<^sub>v v = v" using assms by auto
   ultimately show ?thesis using trace_outer_prod_right[of "1\<^sub>m n" n v w] assms by auto
 qed
 
 lemma inner_prod_outer_prod:
   fixes a b c d :: "'a::conjugatable_field vec"
   assumes a: "a \<in> carrier_vec n" and b: "b \<in> carrier_vec n"
     and c: "c \<in> carrier_vec m" and d: "d \<in> carrier_vec m"
   shows "inner_prod a (outer_prod b c *\<^sub>v d) = inner_prod a b * inner_prod c d" (is "?lhs = ?rhs")
 proof -
   define P where "P = outer_prod b c"
   then have dimP: "P \<in> carrier_mat n m" using assms by auto
   have "inner_prod a (P *\<^sub>v d) = (\<Sum>i=0..<n. (\<Sum>j=0..<m. conjugate (a$i) * P$$(i, j) * d$j))" using assms dimP
     apply (simp add: scalar_prod_def sum_distrib_right)
     apply (rule sum.cong, auto)
     apply (rule sum.cong, auto)
     done
   also have "\<dots> = (\<Sum>i=0..<n. (\<Sum>j=0..<m. conjugate (a$i) * b$i * conjugate(c$j) * d$j))"
     using P_def b c by(simp add: index_outer_prod algebra_simps)
   finally have eq: "?lhs = (\<Sum>i=0..<n. (\<Sum>j=0..<m. conjugate (a$i) * b$i * conjugate(c$j) * d$j))" using P_def by auto
 
   have "?rhs = (\<Sum>i=0..<n. conjugate (a$i) * b$i) * (\<Sum>j=0..<m. conjugate(c$j) * d$j)" using assms 
     by (auto simp add: scalar_prod_def algebra_simps)
   also have "\<dots> = (\<Sum>i=0..<n. (\<Sum>j=0..<m. conjugate (a$i) * b$i * conjugate(c$j) * d$j))"
     using assms by (simp add: sum_product algebra_simps)
   finally show "?lhs = ?rhs" using eq by auto
 qed
 
 subsection \<open>Semi-definite matrices\<close>
 
 definition positive :: "complex mat \<Rightarrow> bool" where
   "positive A \<longleftrightarrow>
      A \<in> carrier_mat (dim_col A) (dim_col A) \<and>
      (\<forall>v. dim_vec v = dim_col A \<longrightarrow> inner_prod v (A *\<^sub>v v) \<ge> 0)"
 
 lemma positive_iff_normalized_vec:
   "positive A \<longleftrightarrow>
     A \<in> carrier_mat (dim_col A) (dim_col A) \<and>
     (\<forall>v. (dim_vec v = dim_col A \<and> vec_norm v = 1) \<longrightarrow> inner_prod v (A *\<^sub>v v) \<ge> 0)"
 proof (rule)
   assume "positive A"
   then show "A \<in> carrier_mat (dim_col A) (dim_col A) \<and> 
     (\<forall>v. dim_vec v = dim_col A \<and> vec_norm v = 1 \<longrightarrow> 0 \<le> inner_prod v (A *\<^sub>v v))"
     unfolding positive_def by auto
 next
   define n where "n = dim_col A"
   assume "A \<in> carrier_mat (dim_col A) (dim_col A) \<and> (\<forall>v. dim_vec v = dim_col A \<and> vec_norm v = 1 \<longrightarrow> 0 \<le> inner_prod v (A *\<^sub>v v))"
   then have A: "A \<in> carrier_mat (dim_col A) (dim_col A)" and geq0: "\<forall>v. dim_vec v = dim_col A \<and> vec_norm v = 1 \<longrightarrow> 0 \<le> inner_prod v (A *\<^sub>v v)" by auto
   then have dimA: "A \<in> carrier_mat n n" using n_def[symmetric] by auto
   {
     fix v assume dimv: "(v::complex vec) \<in> carrier_vec n"
     have "0 \<le> inner_prod v (A *\<^sub>v v)"
     proof (cases "v = 0\<^sub>v n")
       case True
       then show "0 \<le> inner_prod v (A *\<^sub>v v)" using dimA by auto
     next
       case False
       then have 1: "vec_norm v > 0" using vec_norm_ge_0 dimv by auto
       then have cnv: "cnj (vec_norm v) = vec_norm v"
         using Reals_cnj_iff complex_is_Real_iff less_complex_def by auto
       define w where "w = vec_normalize v"
       then have dimw: "w \<in> carrier_vec n" using dimv by auto
       have nvw: "v = vec_norm v \<cdot>\<^sub>v w" using w_def vec_eq_norm_smult_normalized by auto
       have "vec_norm w = 1" using normalized_vec_norm[OF dimv False] vec_norm_def w_def by auto
       then have 2: "0 \<le> inner_prod w (A *\<^sub>v w)" using geq0 dimw dimA by auto
       have "inner_prod v (A *\<^sub>v v) = vec_norm v * vec_norm v * inner_prod w (A *\<^sub>v w)" using dimA dimv dimw
         apply (subst (1 2) nvw)
         apply (subst mult_mat_vec, simp, simp)
         apply (subst scalar_prod_smult_left[of "(A *\<^sub>v w)" "conjugate (vec_norm v \<cdot>\<^sub>v w)" "vec_norm v"], simp)
         apply (simp add: conjugate_smult_vec cnv)
         done
       also have "\<dots> \<ge> 0" using 1 2 by auto
       finally show "0 \<le> inner_prod v (A *\<^sub>v v)" by auto
     qed
   }
   then have geq: "\<forall>v. dim_vec v = dim_col A \<longrightarrow> 0 \<le> inner_prod v (A *\<^sub>v v)" using dimA by auto
   show "positive A" unfolding positive_def 
     by (rule, simp add: A, rule geq)
 qed
 
 lemma positive_is_hermitian:
   fixes A :: "complex mat"
   assumes pA: "positive A"
   shows "hermitian A"
 proof -
   define n where "n = dim_col A"
   then have dimA: "A \<in> carrier_mat n n" using positive_def pA by auto
   obtain B C where B: "hermitian B" and C: "hermitian C" and A: "A = B + \<i> \<cdot>\<^sub>m C"
     and dimB: "B \<in> carrier_mat n n" and dimC: "C \<in> carrier_mat n n" and dimiC: "\<i> \<cdot>\<^sub>m C \<in> carrier_mat n n"
     using complex_mat_decomposition_to_hermitian[OF dimA] by auto
   {
     fix v :: "complex vec" assume dimv: "v \<in> carrier_vec n"
     have dimvA: "dim_vec v = dim_col A" using dimv dimA by auto
     have "inner_prod v (A *\<^sub>v v) = inner_prod v (B *\<^sub>v v) + inner_prod v ((\<i> \<cdot>\<^sub>m C) *\<^sub>v v)"
       unfolding A using dimB dimiC dimv by (simp add: add_mult_distrib_mat_vec inner_prod_distrib_right)
     moreover have "inner_prod v ((\<i> \<cdot>\<^sub>m C) *\<^sub>v v) = \<i> * inner_prod v (C *\<^sub>v v)" using dimv dimC
       apply (simp add: scalar_prod_def sum_distrib_left cong: sum.cong)
       apply (rule sum.cong, auto)
       done
     ultimately have ABC: "inner_prod v (A *\<^sub>v v) = inner_prod v (B *\<^sub>v v) + \<i> * inner_prod v (C *\<^sub>v v)" by auto
     moreover have "inner_prod v (B *\<^sub>v v) \<in> Reals" using B dimB dimv hermitian_inner_prod_real by auto
     moreover have "inner_prod v (C *\<^sub>v v) \<in> Reals" using C dimC dimv hermitian_inner_prod_real by auto
     moreover have "inner_prod v (A *\<^sub>v v) \<in> Reals" using pA unfolding positive_def 
       apply (rule) 
       apply (fold n_def)
       apply (simp add: complex_is_Real_iff[of "inner_prod v (A *\<^sub>v v)"])
       apply (auto simp add: dimvA less_complex_def less_eq_complex_def)
       done
     ultimately have "inner_prod v (C *\<^sub>v v) = 0" using of_real_Re by fastforce
   } 
   then have "C = 0\<^sub>m n n" using hermitian_inner_prod_zero dimC C by auto
   then have "A = B" using A dimC dimB by auto
   then show "hermitian A" using B by auto
 qed
 
 lemma positive_eigenvalue_positive:
   assumes dimA: "(A::complex mat) \<in> carrier_mat n n"
     and pA: "positive A"
     and c: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])"
     and B: "unitary_schur_decomposition A es = (B,P,Q)"
   shows "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<ge> 0"
 proof -
   have hA: "hermitian A" using positive_is_hermitian pA by auto
   have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
     using hermitian_eigenvalue_real dimA hA B c by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     and uP: "unitary P" 
     unfolding similar_mat_wit_def Let_def unitary_def using dimA by auto
   {
     fix i assume i: "i < n"
     define v where "v = col P i"
     then have dimv: "v \<in> carrier_vec n" using v_def dimP by auto
     have "inner_prod v (A *\<^sub>v v) = B$$(i, i)" unfolding A v_def
       using spectral_decomposition_extract_diag[OF dimP dimB uP dB i]  by auto
     moreover have "inner_prod v (A *\<^sub>v v) \<ge> 0" using dimv pA dimA positive_def by auto
     ultimately show "B$$(i, i) \<ge> 0" by auto
   }
 qed
 
 lemma diag_mat_mult_diag_mat:
   fixes B D :: "'a::semiring_0 mat"
   assumes dimB: "B \<in> carrier_mat n n" and dimD: "D \<in> carrier_mat n n"
     and dB: "diagonal_mat B" and dD: "diagonal_mat D"
   shows "B * D = mat n n (\<lambda>(i,j). (if i = j then (B$$(i, i)) * (D$$(i, i)) else 0))"
 proof(rule eq_matI, auto)
   have Bij: "\<And>x y. x < n \<Longrightarrow> y < n \<Longrightarrow> x \<noteq> y \<Longrightarrow> B$$(x, y) = 0" using dB diagonal_mat_def dimB by auto
   have Dij: "\<And>x y. x < n \<Longrightarrow> y < n \<Longrightarrow> x \<noteq> y \<Longrightarrow> D$$(x, y) = 0" using dD diagonal_mat_def dimD by auto
 {
   fix i j assume ij: "i < n" "j < n"
   have "(B * D) $$ (i, j) = (\<Sum>k=0..<n. (B $$ (i, k)) * (D $$ (k, j)))" using dimB dimD
     by (auto simp add: scalar_prod_def ij)
   also have "\<dots> = B$$(i, i) * D$$(i, j)"
     apply (simp add: sum.remove[of _i] ij)
     apply (simp add: Bij Dij ij)
     done
   finally have "(B * D) $$ (i, j) = B$$(i, i) * D$$(i, j)".
 }
   note BDij = this
   from BDij show "\<And>j. j < n \<Longrightarrow> (B * D) $$ (j, j) = B $$ (j, j) * D $$ (j, j)" by auto
   from BDij show "\<And>i j. i < n \<Longrightarrow> j < n \<Longrightarrow> i \<noteq> j \<Longrightarrow> (B * D) $$ (i, j) = 0" using Bij Dij by auto
   from assms show "dim_row B = n" "dim_col D = n" by auto
 qed
 
 lemma positive_only_if_decomp:
   assumes dimA: "A \<in> carrier_mat n n" and pA: "positive A"
   shows "\<exists>M \<in> carrier_mat n n. M * adjoint M = A"
 proof -
   from pA have hA: "hermitian A" using positive_is_hermitian by auto
   obtain es where es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])" 
     using complex_mat_char_poly_factorizable dimA by auto
   obtain B P Q where schur: "unitary_schur_decomposition A es = (B,P,Q)" 
     by (cases "unitary_schur_decomposition A es", auto)
   then have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> diag_mat B = es 
     \<and> unitary P \<and> (\<forall>i < n. B$$(i, i) \<in> Reals)"
     using hermitian_eigenvalue_real dimA es hA by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B"
     and Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<in> Reals"
     and dimB: "B \<in> carrier_mat n n" and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def Let_def using dimA by auto
   have Bii: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<ge> 0" using pA dimA es schur positive_eigenvalue_positive by auto
   define D where "D = mat n n (\<lambda>(i, j). (if (i = j) then csqrt (B$$(i, i)) else 0))"
   then have dimD: "D \<in> carrier_mat n n" and dimaD: "adjoint D \<in> carrier_mat n n" using dimB by auto
   have dD: "diagonal_mat D" using dB D_def unfolding diagonal_mat_def by auto
   then have daD: "diagonal_mat (adjoint D)" by (simp add: adjoint_eval diagonal_mat_def)
   have Dii: "\<And>i. i < n \<Longrightarrow> D$$(i, i) = csqrt (B$$(i, i))" using dimD D_def by auto
   {
     fix i assume i: "i < n"
     define c where "c = csqrt (B$$(i, i))"
     have c: "c \<ge> 0" using Bii i c_def by (auto simp: less_complex_def less_eq_complex_def)
     then have "conjugate c = c" 
       using Reals_cnj_iff complex_is_Real_iff unfolding less_complex_def less_eq_complex_def by auto
     then have "c * cnj c = B$$(i, i)" using c_def c unfolding conjugate_complex_def by (metis power2_csqrt power2_eq_square)
   }  
   note cBii = this
   have "D * adjoint D = mat n n (\<lambda>(i,j). (if (i = j) then B$$(i, i) else 0))"
     apply (simp add: diag_mat_mult_diag_mat[OF dimD dimaD dD daD])
     apply (rule eq_matI, auto simp add: D_def adjoint_eval cBii)
     done
   also have "\<dots> = B" using dimB dB[unfolded diagonal_mat_def] by auto
   finally have DaDB: "D * adjoint D = B".
   define M where "M = P * D"
   then have dimM: "M \<in> carrier_mat n n" using dimP dimD by auto
   have "M * adjoint M = (P * D) * (adjoint D * adjoint P)" using M_def adjoint_mult[OF dimP dimD] by auto
   also have "\<dots> = P * (D * adjoint D) * (adjoint P)" using dimP dimD by (mat_assoc n)
   also have "\<dots> = P * B * (adjoint P)" using DaDB by auto
   finally have "M * adjoint M = A" using A by auto
   with dimM show "\<exists>M \<in> carrier_mat n n. M * adjoint M = A" by auto
 qed
 
 lemma positive_if_decomp:
   assumes dimA: "A \<in> carrier_mat n n" and "\<exists>M. M * adjoint M = A"
   shows "positive A"
 proof -
   from assms obtain M where M: "M * adjoint M = A" by auto
   define m where "m = dim_col M"
   have dimM: "M \<in> carrier_mat n m" using M dimA m_def by auto
 {
   fix v assume dimv: "(v::complex vec) \<in> carrier_vec n"
   have dimaM: "adjoint M \<in> carrier_mat m n" using dimM by auto
   have dimaMv: "(adjoint M) *\<^sub>v v \<in> carrier_vec m" using dimaM dimv by auto
   have "inner_prod v (A *\<^sub>v v) = inner_prod v (M * adjoint M *\<^sub>v v)" using M by auto
   also have "\<dots> = inner_prod v (M *\<^sub>v (adjoint M *\<^sub>v v))" using assoc_mult_mat_vec dimM dimaM dimv by auto
   also have "\<dots> = inner_prod (adjoint M *\<^sub>v v) (adjoint M *\<^sub>v v)" using adjoint_def_alter[OF dimv dimaMv dimM] by auto
   also have "\<dots> \<ge> 0" using self_cscalar_prod_geq_0 by auto
   finally have "inner_prod v (A *\<^sub>v v) \<ge> 0".
 }
   note geq0 = this
   from dimA geq0 show "positive A" using positive_def by auto
 qed
 
 lemma positive_iff_decomp:
   assumes dimA: "A \<in> carrier_mat n n"
   shows "positive A \<longleftrightarrow> (\<exists>M\<in>carrier_mat n n. M * adjoint M = A)"
 proof
   assume pA: "positive A"
   then show "\<exists>M\<in>carrier_mat n n. M * adjoint M = A" using positive_only_if_decomp assms by auto
 next
   assume "\<exists>M\<in>carrier_mat n n. M * adjoint M = A"
   then obtain M where M: "M * adjoint M = A" by auto
   then show "positive A" using M positive_if_decomp assms by auto
 qed
 
 lemma positive_dim_eq:
   assumes "positive A"
   shows "dim_row A = dim_col A"
   using carrier_matD(1)[of A "dim_col A" "dim_col A"]  assms[unfolded positive_def] by simp
 
 lemma positive_zero:
   "positive (0\<^sub>m n n)"
   by (simp add: positive_def zero_mat_def mult_mat_vec_def scalar_prod_def)
 
 lemma positive_one:
   "positive (1\<^sub>m n)"
 proof (rule positive_if_decomp)
   show "1\<^sub>m n \<in> carrier_mat n n" by auto
   have "adjoint (1\<^sub>m n) = 1\<^sub>m n" using hermitian_one hermitian_def by auto
   then have "1\<^sub>m n * adjoint (1\<^sub>m n) = 1\<^sub>m n" by auto
   then show "\<exists>M. M * adjoint M = 1\<^sub>m n" by fastforce
 qed
 
 lemma positive_antisym:
   assumes pA: "positive A" and pnA: "positive (-A)"
   shows "A = 0\<^sub>m (dim_col A) (dim_col A)"
 proof -
   define n where "n = dim_col A"
   from pA have dimA: "A \<in> carrier_mat n n" and dimnA: "-A \<in> carrier_mat n n"
     using positive_def n_def by auto
   from pA have hA: "hermitian A" using positive_is_hermitian by auto
   obtain es where es: "char_poly A = (\<Prod> (e :: complex) \<leftarrow> es. [:- e, 1:])" 
     using complex_mat_char_poly_factorizable dimA by auto
   obtain B P Q where schur: "unitary_schur_decomposition A es = (B,P,Q)" 
     by (cases "unitary_schur_decomposition A es", auto)
   then have "similar_mat_wit A B P (adjoint P) \<and> diagonal_mat B \<and> unitary P"
     using hermitian_eigenvalue_real dimA es hA by auto
   then have A: "A = P * B * (adjoint P)" and dB: "diagonal_mat B" and uP: "unitary P"
     and dimB: "B \<in> carrier_mat n n" and dimnB: "-B \<in> carrier_mat n n"
     and dimP: "P \<in> carrier_mat n n" and dimaP: "adjoint P \<in> carrier_mat n n"
     unfolding similar_mat_wit_def Let_def using dimA by auto
   from es schur have geq0: "\<And>i. i < n \<Longrightarrow> B$$(i, i) \<ge> 0" using positive_eigenvalue_positive dimA pA by auto
   from A have nA: "-A = P * (-B) * (adjoint P)" using mult_smult_assoc_mat dimB dimP dimaP by auto
   from dB have dnB: "diagonal_mat (-B)" by (simp add: diagonal_mat_def)
   {
     fix i assume i: "i < n"
     define v where "v = col P i"
     then have dimv: "v \<in> carrier_vec n" using v_def dimP by auto
     have "inner_prod v ((-A) *\<^sub>v v) = (-B)$$(i, i)" unfolding nA v_def
       using spectral_decomposition_extract_diag[OF dimP dimnB uP dnB i]  by auto
     moreover have "inner_prod v ((-A) *\<^sub>v v) \<ge> 0" using dimv pnA dimnA positive_def by auto
     ultimately have "B$$(i, i) \<le> 0" using dimB i by auto
     moreover have "B$$(i, i) \<ge> 0" using i geq0 by auto
-    ultimately have "B$$(i, i) = 0" by (metis no_atp(10))
+    ultimately have "B$$(i, i) = 0"
+      by (metis antisym)
   }
   then have "B = 0\<^sub>m n n" using dimB dB[unfolded diagonal_mat_def]
     by (subst eq_matI, auto)
   then show "A = 0\<^sub>m n n" using A dimB dimP dimaP by auto
 qed
 
 lemma positive_add:
   assumes pA: "positive A" and pB: "positive B"
     and dimA: "A \<in> carrier_mat n n" and dimB: "B \<in> carrier_mat n n"
   shows "positive (A + B)"
   unfolding positive_def
 proof
   have dimApB: "A + B \<in> carrier_mat n n" using dimA dimB by auto
   then show "A + B \<in> carrier_mat (dim_col (A + B)) (dim_col (A + B))" using carrier_matD[of "A+B"] by auto
   {
     fix v assume dimv: "(v::complex vec) \<in> carrier_vec n"
     have 1: "inner_prod v (A *\<^sub>v v) \<ge> 0" using dimv pA[unfolded positive_def] dimA by auto
     have 2: "inner_prod v (B *\<^sub>v v) \<ge> 0" using dimv pB[unfolded positive_def] dimB by auto
     have "inner_prod v ((A + B) *\<^sub>v v) = inner_prod v (A *\<^sub>v v) + inner_prod v (B *\<^sub>v v)"
       using dimA dimB dimv by (simp add: add_mult_distrib_mat_vec inner_prod_distrib_right) 
     also have "\<dots> \<ge> 0" using 1 2 by auto
     finally have "inner_prod v ((A + B) *\<^sub>v v) \<ge> 0".
   }
   note geq0 = this
   then have "\<And>v. dim_vec v = n \<Longrightarrow> 0 \<le> inner_prod v ((A + B) *\<^sub>v v)" by auto
   then show "\<forall>v. dim_vec v = dim_col (A + B) \<longrightarrow> 0 \<le> inner_prod v ((A + B) *\<^sub>v v)" using dimApB by auto
 qed
 
 lemma positive_trace:
   assumes "A \<in> carrier_mat n n" and "positive A"
   shows "trace A \<ge> 0"
   using assms positive_iff_decomp trace_adjoint_positive by auto
 
 lemma positive_close_under_left_right_mult_adjoint:
   fixes M A :: "complex mat"
   assumes dM: "M \<in> carrier_mat n n" and dA: "A \<in> carrier_mat n n" 
     and pA: "positive A"
   shows "positive (M * A * adjoint M)"
   unfolding positive_def
 proof (rule, simp add: mult_carrier_mat[OF mult_carrier_mat[OF dM dA] adjoint_dim[OF dM]] carrier_matD[OF dM], rule, rule)
   have daM: "adjoint M \<in> carrier_mat n n" using dM by auto
   fix v::"complex vec" assume "dim_vec v = dim_col (M * A * adjoint M)"
   then have dv: "v \<in> carrier_vec n" using assms by auto
   then have "adjoint M *\<^sub>v v \<in> carrier_vec n" using daM by auto
   have assoc: "M * A * adjoint M *\<^sub>v v = M *\<^sub>v (A *\<^sub>v (adjoint M *\<^sub>v v))"
     using dA dM daM dv by (auto simp add: assoc_mult_mat_vec[of _ n n _ n])
   have "inner_prod v (M * A * adjoint M *\<^sub>v v) = inner_prod (adjoint M *\<^sub>v v) (A *\<^sub>v (adjoint M *\<^sub>v v))"
     apply (subst assoc)
     apply (subst adjoint_def_alter[where ?A = "M"])
     by (auto simp add: dv dA daM dM carrier_matD[OF dM] mult_mat_vec_carrier[of _ n n])
   also have "\<dots> \<ge> 0" using dA dv daM pA positive_def by auto
   finally show "inner_prod v (M * A * adjoint M *\<^sub>v v) \<ge> 0" by auto
 qed
 
 lemma positive_same_outer_prod:
   fixes v w :: "complex vec"
   assumes v: "v \<in> carrier_vec n" 
   shows "positive (outer_prod v v)"
 proof -
   have d1: "adjoint (mat (dim_vec v) 1 (\<lambda>(i, j). v $ i)) \<in> carrier_mat 1 n" using assms by auto
   have d2: "mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y) \<in> carrier_mat 1 n" using assms by auto
   have dv: "dim_vec v = n" using assms by auto
   have "mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y) = adjoint (mat (dim_vec v) 1 (\<lambda>(i, j). v $ i))" (is "?r = adjoint ?l")
     apply (rule eq_matI) 
     subgoal for i j by (simp add: dv adjoint_eval)
     using d1 d2 by auto
   then have "outer_prod v v = ?l * adjoint ?l" unfolding outer_prod_def by auto
   then have "\<exists>M. M * adjoint M = outer_prod v v" by auto
   then show "positive (outer_prod v v)" using positive_if_decomp[OF outer_prod_dim[OF v v]] by auto
 qed
 
 lemma smult_smult_mat: 
   fixes k :: complex and l :: complex
   assumes "A \<in> carrier_mat nr n"
   shows "k \<cdot>\<^sub>m (l \<cdot>\<^sub>m A) = (k * l) \<cdot>\<^sub>m A" by auto
 
 lemma positive_smult: 
   assumes "A \<in> carrier_mat n n"
     and "positive A"
     and "c \<ge> 0"
   shows "positive (c \<cdot>\<^sub>m A)"
 proof -
   have sc: "csqrt c \<ge> 0" using assms(3) by (fastforce simp: less_eq_complex_def)
   obtain M where dimM: "M \<in> carrier_mat n n" and A: "M * adjoint M = A" using assms(1-2) positive_iff_decomp by auto
   have "c \<cdot>\<^sub>m A  = c \<cdot>\<^sub>m (M * adjoint M)" using A by auto
   have ccsq: "conjugate (csqrt c) = (csqrt c)" using sc Reals_cnj_iff[of "csqrt c"] complex_is_Real_iff 
     by (auto simp: less_eq_complex_def)
   have MM: "(M * adjoint M) \<in> carrier_mat n n" using A assms by fastforce
   have leftd: "c  \<cdot>\<^sub>m (M * adjoint M) \<in> carrier_mat n n" using A assms by fastforce
   have rightd: "(csqrt c \<cdot>\<^sub>m M) * (adjoint (csqrt c \<cdot>\<^sub>m M))\<in> carrier_mat n n" using A assms by fastforce
   have "(csqrt c \<cdot>\<^sub>m M) * (adjoint (csqrt c \<cdot>\<^sub>m M)) = (csqrt c \<cdot>\<^sub>m M) * ((conjugate (csqrt c)) \<cdot>\<^sub>m  adjoint M)"
     using adjoint_scale assms(1) by (metis adjoint_scale)
   also have "\<dots> = (csqrt c \<cdot>\<^sub>m M) * (csqrt c \<cdot>\<^sub>m adjoint M)" using sc ccsq by fastforce
   also have "\<dots> = csqrt c \<cdot>\<^sub>m (M * (csqrt c \<cdot>\<^sub>m adjoint M))"
     using mult_smult_assoc_mat index_smult_mat(2,3) by fastforce
   also have "\<dots> =  csqrt c \<cdot>\<^sub>m ((csqrt c) \<cdot>\<^sub>m (M * adjoint M))"
     using mult_smult_distrib by fastforce
   also have "\<dots> = c \<cdot>\<^sub>m (M * adjoint M)" 
     using smult_smult_mat[of "M * adjoint M" n n "(csqrt c)" "(csqrt c)"]  MM sc
     by (metis power2_csqrt power2_eq_square )   
   also have "\<dots> = c \<cdot>\<^sub>m A" using A by auto
   finally have "(csqrt c \<cdot>\<^sub>m M) * (adjoint (csqrt c \<cdot>\<^sub>m M)) = c \<cdot>\<^sub>m A" by auto
   moreover have "c \<cdot>\<^sub>m A \<in> carrier_mat n n" using assms(1) by auto
   moreover have "csqrt c \<cdot>\<^sub>m M \<in> carrier_mat n n" using dimM by auto
   ultimately show ?thesis using positive_iff_decomp by auto
 qed
 
 text \<open>Version of previous theorem for real numbers\<close>
 lemma positive_scale: 
   fixes c :: real
   assumes  "A \<in> carrier_mat n n"
     and "positive A"
     and "c \<ge> 0"
   shows "positive (c \<cdot>\<^sub>m A)"
   apply (rule positive_smult) using assms by (auto simp: less_eq_complex_def)
 
 subsection \<open>L\"{o}wner partial order\<close>
 
 definition lowner_le :: "complex mat \<Rightarrow> complex mat \<Rightarrow> bool"  (infix "\<le>\<^sub>L" 50) where
   "A \<le>\<^sub>L B \<longleftrightarrow> dim_row A = dim_row B \<and> dim_col A = dim_col B \<and> positive (B - A)"
 
 lemma lowner_le_refl:
   assumes "A \<in> carrier_mat n n"
   shows "A \<le>\<^sub>L A"
   unfolding lowner_le_def
   apply (simp add: minus_r_inv_mat[OF assms])
   by (rule positive_zero)
 
 lemma lowner_le_antisym:
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
     and L1: "A \<le>\<^sub>L B" and L2: "B \<le>\<^sub>L A"
   shows "A = B"
 proof -
   from L1 have P1: "positive (B - A)" by (simp add: lowner_le_def)
   from L2 have P2: "positive (A - B)" by (simp add: lowner_le_def)
   have "A - B = - (B - A)" using A B by auto
   then have P3: "positive (- (B - A))" using P2 by auto
   have BA: "B - A \<in> carrier_mat n n" using A B by auto
   have "B - A = 0\<^sub>m n n" using BA by (subst positive_antisym[OF P1 P3], auto)
   then have "B + (-A) + A = 0\<^sub>m n n + A" using A B minus_add_uminus_mat[OF B A] by auto
   then have "B + (-A + A) = 0\<^sub>m n n + A" using A B by auto
   then show "A = B" using A B BA uminus_l_inv_mat[OF A] by auto
 qed
 
 lemma lowner_le_inner_prod_le:
   fixes A B :: "complex mat" and v :: "complex vec"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n"
     and v: "v \<in> carrier_vec n"
     and "A \<le>\<^sub>L B"
   shows "inner_prod v (A *\<^sub>v v) \<le> inner_prod v (B *\<^sub>v v)"
 proof -
   from assms have "positive (B-A)" by (auto simp add: lowner_le_def)
   with assms have geq: "inner_prod v ((B-A) *\<^sub>v v) \<ge> 0" 
     unfolding positive_def by auto
   have "inner_prod v ((B-A) *\<^sub>v v) = inner_prod v (B *\<^sub>v v) - inner_prod v (A *\<^sub>v v)" 
     unfolding minus_add_uminus_mat[OF B A]
     by (subst add_mult_distrib_mat_vec[OF B _ v], insert A B v, auto simp add: inner_prod_distrib_right[OF v])
   then show ?thesis using geq by auto
 qed
 
 lemma lowner_le_trans:
   fixes A B C :: "complex mat"
   assumes A: "A \<in> carrier_mat n n" and B: "B \<in> carrier_mat n n" and C: "C \<in> carrier_mat n n"
     and L1: "A \<le>\<^sub>L B" and L2: "B \<le>\<^sub>L C"
   shows "A \<le>\<^sub>L C"
   unfolding lowner_le_def
 proof (auto simp add: carrier_matD[OF A] carrier_matD[OF C])
   have dim: "C - A \<in> carrier_mat n n" using A C by auto
   {
     fix v assume v: "(v::complex vec) \<in> carrier_vec n"
     from L1 have "inner_prod v (A *\<^sub>v v) \<le> inner_prod v (B *\<^sub>v v)" using lowner_le_inner_prod_le A B v by auto
     also from L2 have "\<dots> \<le> inner_prod v (C *\<^sub>v v)" using lowner_le_inner_prod_le B C v by auto
     finally have "inner_prod v (A *\<^sub>v v) \<le> inner_prod v (C *\<^sub>v v)".
     then have "inner_prod v (C *\<^sub>v v) - inner_prod v (A *\<^sub>v v) \<ge> 0" by auto
     then have "inner_prod v ((C - A) *\<^sub>v v) \<ge> 0" using A C v
       apply (subst minus_add_uminus_mat[OF C A])
       apply (subst add_mult_distrib_mat_vec[OF C _ v], simp)
       apply (simp add: inner_prod_distrib_right[OF v])
       done
   }
   note leq = this
   show "positive (C - A)" unfolding positive_def
     apply (rule, simp add: carrier_matD[OF A] dim)
     apply (subst carrier_matD[OF dim], insert leq, auto)
     done
 qed
 
 lemma lowner_le_imp_trace_le:
   assumes "A \<in> carrier_mat n n" and "B \<in> carrier_mat n n"
     and "A \<le>\<^sub>L B"
   shows "trace A \<le> trace B"
 proof -
   have "positive (B - A)" using assms lowner_le_def by auto
   moreover have "B - A \<in> carrier_mat n n" using assms by auto
   ultimately have "trace (B - A) \<ge> 0" using positive_trace by auto
   moreover have "trace (B - A) = trace B - trace A" using trace_minus_linear assms by auto
   ultimately have "trace B - trace A \<ge> 0" by auto
   then show "trace A \<le> trace B" by auto
 qed
 
 lemma lowner_le_add:
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n" "D \<in> carrier_mat n n"
     and "A \<le>\<^sub>L B" "C \<le>\<^sub>L D"
   shows "A + C \<le>\<^sub>L B + D"
 proof -
   have "B + D - (A + C) = B - A + (D - C) " using assms by auto
   then have "positive (B + D - (A + C))" using assms unfolding lowner_le_def using positive_add
     by (metis minus_carrier_mat)
   then show "A + C \<le>\<^sub>L B + D" unfolding lowner_le_def using assms by fastforce
 qed
 
 lemma lowner_le_swap:
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" 
     and "A \<le>\<^sub>L B" 
   shows "-B \<le>\<^sub>L -A"
 proof -
   have "positive (B - A)" using assms lowner_le_def by fastforce
   moreover have "B - A = (-A) - (-B)" using assms by fastforce
   ultimately have "positive ((-A) - (-B))" by auto
   then show ?thesis using lowner_le_def assms by fastforce
 qed
 
 lemma lowner_le_minus:
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "C \<in> carrier_mat n n" "D \<in> carrier_mat n n"
     and "A \<le>\<^sub>L B" "C \<le>\<^sub>L D"
   shows "A - D \<le>\<^sub>L B - C"
 proof -
   have "positive (D - C)" using assms lowner_le_def by auto
   then have "-D \<le>\<^sub>L -C" using lowner_le_swap assms by auto
   then have "A + (-D) \<le>\<^sub>L B + (-C)" using lowner_le_add[of "A" n  "B"] assms by auto
   moreover have "A + (-D) = A - D" and "B + (-C) = B - C" by auto
   ultimately show ?thesis by auto
 qed
 
 lemma outer_prod_le_one:
   assumes "v \<in> carrier_vec n"
     and "inner_prod v v \<le> 1"
   shows "outer_prod v v \<le>\<^sub>L 1\<^sub>m n"
 proof -
   let ?o = "outer_prod v v"
   have do: "?o \<in> carrier_mat n n" using assms by auto
   {
     fix u :: "complex vec" assume "dim_vec u = n"
     then have du: "u \<in> carrier_vec n" by auto
     have r: "inner_prod u u \<in> Reals" apply (simp add: scalar_prod_def carrier_vecD[OF du])
       using complex_In_mult_cnj_zero complex_is_Real_iff by blast
     have geq0: "inner_prod u u \<ge> 0" 
       using self_cscalar_prod_geq_0 by auto
 
     have "inner_prod u (?o *\<^sub>v u) = inner_prod u v * inner_prod v u"
       apply (subst inner_prod_outer_prod)
       using du assms by auto
     also have "\<dots> \<le> inner_prod u u * inner_prod v v" using Cauchy_Schwarz_complex_vec du assms by auto
     also have "\<dots> \<le> inner_prod u u" using assms(2) r geq0 
       by (simp add: mult_right_le_one_le less_eq_complex_def)
     finally have le: "inner_prod u (?o *\<^sub>v u) \<le> inner_prod u u".
 
     have "inner_prod u ((1\<^sub>m n - ?o) *\<^sub>v u) = inner_prod u ((1\<^sub>m n *\<^sub>v u) - ?o *\<^sub>v u)"
       apply (subst minus_mult_distrib_mat_vec) using do du by auto
     also have "\<dots> = inner_prod u u - inner_prod u (?o *\<^sub>v u)"
       apply (subst inner_prod_minus_distrib_right)
       using du do by auto
     also have "\<dots> \<ge> 0" using le by auto
     finally have "inner_prod u ((1\<^sub>m n - ?o) *\<^sub>v u) \<ge> 0" by auto
   }
   then have "positive (1\<^sub>m n - outer_prod v v)"
     unfolding positive_def using do by auto
   then show ?thesis unfolding lowner_le_def using do by auto
 qed
 
 lemma zero_lowner_le_positiveD:
   fixes A :: "complex mat"
   assumes dA: "A \<in> carrier_mat n n" and le: "0\<^sub>m n n \<le>\<^sub>L A"
   shows "positive A"
   using assms unfolding lowner_le_def by (subgoal_tac "A - 0\<^sub>m n n = A", auto)
 
 lemma zero_lowner_le_positiveI:
   fixes A :: "complex mat"
   assumes dA: "A \<in> carrier_mat n n" and le: "positive A"
   shows "0\<^sub>m n n \<le>\<^sub>L A"
   using assms unfolding lowner_le_def by (subgoal_tac "A - 0\<^sub>m n n = A", auto)
 
 lemma lowner_le_trans_positiveI:
   fixes A B :: "complex mat"
   assumes dA: "A \<in> carrier_mat n n" and pA: "positive A" and le: "A \<le>\<^sub>L B"
   shows "positive B"
 proof -
   have dB: "B \<in> carrier_mat n n" using le dA lowner_le_def by auto
   have "0\<^sub>m n n \<le>\<^sub>L A" using zero_lowner_le_positiveI dA pA by auto
   then have "0\<^sub>m n n \<le>\<^sub>L B" using dA dB le by (simp add: lowner_le_trans[of _ n A B])
   then show ?thesis using dB zero_lowner_le_positiveD by auto
 qed
 
 lemma lowner_le_keep_under_measurement:
   fixes M A B :: "complex mat"
   assumes dM: "M \<in> carrier_mat n n" and dA: "A \<in> carrier_mat n n" and dB: "B \<in> carrier_mat n n"
     and le: "A \<le>\<^sub>L B"
   shows "adjoint M * A * M \<le>\<^sub>L adjoint M * B * M"
   unfolding lowner_le_def
 proof (rule conjI, fastforce)+
   have daM: "adjoint M \<in> carrier_mat n n" using dM by auto
   have dBmA: "B - A \<in> carrier_mat n n" using dB dA by fastforce
   have "positive (B - A)" using le lowner_le_def by auto
   then have p: "positive (adjoint M * (B - A) * M)" 
     using positive_close_under_left_right_mult_adjoint[OF daM dBmA] adjoint_adjoint[of M] by auto
   moreover have e: "adjoint M * (B - A) * M = adjoint M * B * M - adjoint M * A * M" using dM dB dA by (mat_assoc n)
   ultimately show "positive (adjoint M * B * M - adjoint M * A * M)" by auto
 qed
 
 lemma smult_distrib_left_minus_mat:
   fixes A B :: "'a::comm_ring_1 mat"
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n"
   shows "c \<cdot>\<^sub>m (B - A) = c \<cdot>\<^sub>m B - c \<cdot>\<^sub>m A"
   using assms by (auto simp add: minus_add_uminus_mat add_smult_distrib_left_mat)
 
 lemma lowner_le_smultc:
   fixes c :: complex
   assumes "c \<ge> 0" "A \<le>\<^sub>L B" "A \<in> carrier_mat n n" "B \<in> carrier_mat n n"
   shows "c \<cdot>\<^sub>m A \<le>\<^sub>L c \<cdot>\<^sub>m B"
 proof -
   have eqBA: "c \<cdot>\<^sub>m (B - A) = c \<cdot>\<^sub>m B - c \<cdot>\<^sub>m A"
     using assms by (auto simp add: smult_distrib_left_minus_mat)
 
   have "positive (B - A)" using assms(2) unfolding lowner_le_def by auto
   then have "positive (c \<cdot>\<^sub>m (B - A))" using positive_smult[of "B-A" n c] assms by fastforce
   moreover have "c \<cdot>\<^sub>m A \<in> carrier_mat n n" using index_smult_mat(2,3) assms(3) by auto
   moreover have "c \<cdot>\<^sub>m B \<in> carrier_mat n n" using index_smult_mat(2,3) assms(4) by auto 
   ultimately show ?thesis unfolding lowner_le_def using eqBA by fastforce
 qed
 
 lemma lowner_le_smult:
   fixes c :: real
   assumes "c \<ge> 0" "A \<le>\<^sub>L B" "A \<in> carrier_mat n n" "B \<in> carrier_mat n n"
   shows "c \<cdot>\<^sub>m A \<le>\<^sub>L c \<cdot>\<^sub>m B"
   apply (rule lowner_le_smultc) using assms by (auto simp: less_eq_complex_def)
 
 lemma minus_smult_vec_distrib:
   fixes w :: "'a::comm_ring_1 vec"
   shows "(a - b) \<cdot>\<^sub>v w = a \<cdot>\<^sub>v w - b \<cdot>\<^sub>v w"
   apply (rule eq_vecI)
   by (auto simp add: scalar_prod_def algebra_simps)
 
 lemma smult_mat_mult_mat_vec_assoc:
   fixes A :: "'a::comm_ring_1 mat"
   assumes A: "A \<in> carrier_mat n m" and w: "w \<in> carrier_vec m"
   shows "a \<cdot>\<^sub>m A *\<^sub>v w = a \<cdot>\<^sub>v (A *\<^sub>v w)"
   apply (rule eq_vecI)
    apply (simp add: scalar_prod_def carrier_matD[OF A] carrier_vecD[OF w])
    apply (subst sum_distrib_left) apply (rule sum.cong, simp)
   by auto
 
 lemma mult_mat_vec_smult_vec_assoc:
   fixes A :: "'a::comm_ring_1 mat"
   assumes A: "A \<in> carrier_mat n m" and w: "w \<in> carrier_vec m"
   shows "A *\<^sub>v (a \<cdot>\<^sub>v w) = a \<cdot>\<^sub>v (A *\<^sub>v w)"
   apply (rule eq_vecI)
    apply (simp add: scalar_prod_def carrier_matD[OF A] carrier_vecD[OF w])
    apply (subst sum_distrib_left) apply (rule sum.cong, simp)
   by auto 
 
 lemma outer_prod_left_right_mat:
   fixes A B :: "complex mat"
   assumes du: "u \<in> carrier_vec d2" and dv: "v \<in> carrier_vec d3"
     and dA: "A \<in> carrier_mat d1 d2" and dB: "B \<in> carrier_mat d3 d4"
   shows "A * (outer_prod u v) * B = (outer_prod (A *\<^sub>v u) (adjoint B *\<^sub>v v))"
   unfolding outer_prod_def
 proof -
   have eq1: "A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i)) = mat (dim_vec (A *\<^sub>v u)) 1 (\<lambda>(i, j). (A *\<^sub>v u) $ i)"
     apply (rule eq_matI)
     by (auto simp add: dA du scalar_prod_def)
   have conj: "conjugate a * b = conjugate ((a::complex) * conjugate b) " for a b by auto
   have eq2: "mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y) * B = mat 1 (dim_vec (adjoint B *\<^sub>v v)) (\<lambda>(i, y). conjugate (adjoint B *\<^sub>v v) $ y)"
     apply (rule eq_matI)
       apply (auto simp add: carrier_matD[OF dB] carrier_vecD[OF dv] scalar_prod_def adjoint_def conjugate_vec_def sum_conjugate )
     apply (rule sum.cong)
     by (auto simp add: conj)
   have "A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i) * mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)) * B =
        (A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i))) *(mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)) * B"
     using dA du dv dB assoc_mult_mat[OF dA, of "mat (dim_vec u) 1 (\<lambda>(i, j). u $ i)" 1 "mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)"] by fastforce
   also have "\<dots> = (A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i))) *((mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)) * B)"
     using dA du dv dB assoc_mult_mat[OF _ _ dB, of "(A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i)))" d1 1] by fastforce
   finally show "A * (mat (dim_vec u) 1 (\<lambda>(i, j). u $ i) * mat 1 (dim_vec v) (\<lambda>(i, y). conjugate v $ y)) * B =
     mat (dim_vec (A *\<^sub>v u)) 1 (\<lambda>(i, j). (A *\<^sub>v u) $ i) * mat 1 (dim_vec (adjoint B *\<^sub>v v)) (\<lambda>(i, y). conjugate (adjoint B *\<^sub>v v) $ y)" 
     using eq1 eq2 by auto
 qed
 
 subsection \<open>Density operators\<close>
 
 definition density_operator :: "complex mat \<Rightarrow> bool" where
   "density_operator A \<longleftrightarrow> positive A \<and> trace A = 1"
 
 definition partial_density_operator :: "complex mat \<Rightarrow> bool" where
   "partial_density_operator A \<longleftrightarrow> positive A \<and> trace A \<le> 1"
 
 lemma pure_state_self_outer_prod_is_partial_density_operator:
   fixes v :: "complex vec"
   assumes dimv: "v \<in> carrier_vec n" and nv: "vec_norm v = 1"
   shows "partial_density_operator (outer_prod v v)"
   unfolding partial_density_operator_def
 proof
   have dimov: "outer_prod v v \<in> carrier_mat n n" using dimv by auto
   show "positive (outer_prod v v)" unfolding positive_def
   proof (rule, simp add: carrier_matD(2)[OF dimov] dimov, rule allI, rule impI)
     fix w assume "dim_vec (w::complex vec) = dim_col (outer_prod v v)"
     then have dimw: "w \<in> carrier_vec n"  using dimov carrier_vecI by auto
     then have "inner_prod w ((outer_prod v v) *\<^sub>v w) = inner_prod w v * inner_prod v w" 
       using inner_prod_outer_prod dimw dimv by auto
     also have "\<dots> = inner_prod w v * conjugate (inner_prod w v)" using dimw dimv
       apply (subst conjugate_scalar_prod[of v "conjugate w"], simp)
       apply (subst conjugate_vec_sprod_comm[of "conjugate v" _ "conjugate w"], auto)
        apply (rule carrier_vec_conjugate[OF dimv])
       apply (rule carrier_vec_conjugate[OF dimw])
       done
     also have "\<dots> \<ge> 0" by (auto simp: less_eq_complex_def)
     finally show "inner_prod w ((outer_prod v v) *\<^sub>v w) \<ge> 0".
   qed
   have eq: "trace (outer_prod v v) = (\<Sum>i=0..<n. v$i * conjugate(v$i))" unfolding trace_def 
     apply (subst carrier_matD(1)[OF dimov])
     apply (simp add: index_outer_prod[OF dimv dimv])
     done
   have "vec_norm v = csqrt (\<Sum>i=0..<n. v$i * conjugate(v$i))" unfolding vec_norm_def using dimv
     by (simp add: scalar_prod_def)
   then have "(\<Sum>i=0..<n. v$i * conjugate(v$i)) = 1" using nv by auto
   with eq show "trace (outer_prod v v) \<le> 1" by auto
 qed
 
 (* Lemma 2.1 *)
 lemma lowner_le_trace:
   assumes A: "A \<in> carrier_mat n n"
     and B: "B \<in> carrier_mat n n"
   shows "A \<le>\<^sub>L B \<longleftrightarrow> (\<forall>\<rho>\<in>carrier_mat n n. partial_density_operator \<rho> \<longrightarrow> trace (A * \<rho>) \<le> trace (B * \<rho>))"
 proof (rule iffI)
   have dimBmA: "B - A \<in> carrier_mat n n" using A B by auto
   {
     assume "A \<le>\<^sub>L B"
     then have pBmA: "positive (B - A)" using lowner_le_def by auto
     moreover have "B - A \<in> carrier_mat n n" using assms by auto
     ultimately have "\<exists>M\<in>carrier_mat n n. M * adjoint M = B - A" using positive_iff_decomp[of "B - A"] by auto
     then obtain M where dimM: "M \<in> carrier_mat n n" and M: "M * adjoint M = B - A" by auto
     {
       fix \<rho> assume dimr: "\<rho> \<in> carrier_mat n n" and pdr: "partial_density_operator \<rho>"
       have eq: "trace(B * \<rho>) - trace(A * \<rho>) = trace((B - A) * \<rho>)" using A B dimr
         apply (subst minus_mult_distrib_mat, auto)
         apply (subst trace_minus_linear, auto)
         done
       have pr: "positive \<rho>" using pdr partial_density_operator_def by auto
       then have "\<exists>P\<in>carrier_mat n n. \<rho> = P * adjoint P" using positive_iff_decomp dimr by auto
       then obtain P where dimP: "P \<in> carrier_mat n n" and P: "\<rho> = P * adjoint P" by auto
       have "trace((B - A) * \<rho>) = trace(M * adjoint M * (P * adjoint P))" using P M by auto
       also have "\<dots> = trace((adjoint P * M) * adjoint (adjoint P * M))" using dimM dimP by (mat_assoc n)
       also have "\<dots> \<ge> 0" using trace_adjoint_positive by auto
       finally have "trace((B - A) * \<rho>) \<ge> 0".
       with eq have " trace (B * \<rho>) - trace (A * \<rho>) \<ge> 0" by auto
     }
     then show "\<forall>\<rho>\<in>carrier_mat n n. partial_density_operator \<rho> \<longrightarrow> trace (A * \<rho>) \<le> trace (B * \<rho>)" by auto
   }
 
   {
     assume asm: "\<forall>\<rho>\<in>carrier_mat n n. partial_density_operator \<rho> \<longrightarrow> trace (A * \<rho>) \<le> trace (B * \<rho>)"
     have "positive (B - A)" 
     proof -
       {
         fix v assume "dim_vec (v::complex vec) = dim_col (B - A) \<and> vec_norm v = 1"
         then have dimv: "v \<in> carrier_vec n" and nv: "vec_norm v = 1"
           using carrier_matD[OF dimBmA] by (auto intro: carrier_vecI)
         have dimov: "outer_prod v v \<in> carrier_mat n n" using dimv by auto
         then have "partial_density_operator (outer_prod v v)" 
           using dimv nv pure_state_self_outer_prod_is_partial_density_operator by auto
         then have leq: "trace(A * (outer_prod v v)) \<le> trace(B * (outer_prod v v))" using asm dimov by auto
         have "trace((B - A) * (outer_prod v v)) = trace(B * (outer_prod v v)) - trace(A * (outer_prod v v))" using A B dimov
           apply (subst minus_mult_distrib_mat, auto)
           apply (subst trace_minus_linear, auto)
           done
         then have "trace((B - A) * (outer_prod v v)) \<ge> 0" using leq by auto
         then have "inner_prod v ((B - A) *\<^sub>v v) \<ge> 0" using trace_outer_prod_right[OF dimBmA dimv dimv] by auto
       }
       then show "positive (B - A)" using positive_iff_normalized_vec[of "B - A"] dimBmA A by simp
     qed
     then show "A \<le>\<^sub>L B" using lowner_le_def A B by auto
   }
 qed
 
 lemma lowner_le_traceI:
   assumes "A \<in> carrier_mat n n"
     and "B \<in> carrier_mat n n"
     and "\<And>\<rho>. \<rho> \<in> carrier_mat n n \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> trace (A * \<rho>) \<le> trace (B * \<rho>)"
   shows "A \<le>\<^sub>L B"
   using lowner_le_trace assms by auto
 
 lemma trace_pdo_eq_imp_eq:
   assumes A: "A \<in> carrier_mat n n"
     and B: "B \<in> carrier_mat n n"
     and teq: "\<And>\<rho>. \<rho> \<in> carrier_mat n n \<Longrightarrow> partial_density_operator \<rho> \<Longrightarrow> trace (A * \<rho>) = trace (B * \<rho>)"
   shows "A = B"
 proof -
   from teq have "A \<le>\<^sub>L B" using lowner_le_trace[OF A B] teq by auto
   moreover from teq have "B \<le>\<^sub>L A" using lowner_le_trace[OF B A] teq by auto
   ultimately show "A = B" using lowner_le_antisym A B by auto
 qed
 
 lemma lowner_le_traceD:
   assumes "A \<in> carrier_mat n n" "B \<in> carrier_mat n n" "\<rho> \<in> carrier_mat n n"
     and "A \<le>\<^sub>L B"
     and "partial_density_operator \<rho>"
   shows "trace (A * \<rho>) \<le> trace (B * \<rho>)"
   using lowner_le_trace assms by blast
 
 lemma sum_only_one_neq_0:
   assumes "finite A" and "j \<in> A" and "\<And>i. i \<in> A \<Longrightarrow> i \<noteq> j \<Longrightarrow> g i = 0"
   shows "sum g A = g j" 
 proof -
   have "{j} \<subseteq> A" using assms by auto
   moreover have "\<forall>i\<in>A - {j}. g i = 0" using assms by simp
   ultimately have "sum g A = sum g {j}" using assms 
     by (auto simp add: comm_monoid_add_class.sum.mono_neutral_right[of A "{j}" g])
   moreover have "sum g {j} = g j" by simp
   ultimately show ?thesis by auto
 qed
 
 end
diff --git a/thys/Saturation_Framework/Given_Clause_Architectures.thy b/thys/Saturation_Framework/Given_Clause_Architectures.thy
--- a/thys/Saturation_Framework/Given_Clause_Architectures.thy
+++ b/thys/Saturation_Framework/Given_Clause_Architectures.thy
@@ -1,1174 +1,1174 @@
 (*  Title:       Given Clause Prover Architectures
  *  Author:      Sophie Tourret <stourret at mpi-inf.mpg.de>, 2019-2020 *)
 
 section \<open>Given Clause Prover Architectures\<close>
 
 text \<open>This section covers all the results presented in the section 4 of the report.
   This is where abstract architectures of provers are defined and proven
   dynamically refutationally complete.\<close>
 
 theory Given_Clause_Architectures
   imports
     Lambda_Free_RPOs.Lambda_Free_Util
     Labeled_Lifting_to_Non_Ground_Calculi
 begin
 
 
 subsection \<open>Basis of the Given Clause Prover Architectures\<close>
 
 locale given_clause_basis = std?: labeled_lifting_intersection Bot_F Inf_F Bot_G Q
   entails_q Inf_G_q Red_I_q Red_F_q \<G>_F_q \<G>_I_q Inf_FL
   for
     Bot_F :: "'f set"
     and Inf_F :: "'f inference set"
     and Bot_G :: "'g set"
     and Q :: "'q set"
     and entails_q :: "'q \<Rightarrow> 'g set \<Rightarrow> 'g set \<Rightarrow> bool"
     and Inf_G_q :: \<open>'q \<Rightarrow> 'g inference set\<close>
     and Red_I_q :: "'q \<Rightarrow> 'g set \<Rightarrow> 'g inference set"
     and Red_F_q :: "'q \<Rightarrow> 'g set \<Rightarrow> 'g set"
     and \<G>_F_q :: "'q \<Rightarrow> 'f \<Rightarrow> 'g set"
     and \<G>_I_q :: "'q \<Rightarrow> 'f inference \<Rightarrow> 'g inference set option"
     and Inf_FL :: \<open>('f \<times> 'l) inference set\<close>
   + fixes
     Equiv_F :: "'f \<Rightarrow> 'f \<Rightarrow> bool" (infix "\<doteq>" 50) and
     Prec_F :: "'f \<Rightarrow> 'f \<Rightarrow> bool" (infix "\<prec>\<cdot>" 50) and
     Prec_L :: "'l \<Rightarrow> 'l \<Rightarrow> bool" (infix "\<sqsubset>L" 50) and
     active :: "'l"
   assumes
     equiv_equiv_F: "equivp (\<doteq>)" and
     wf_prec_F: "minimal_element (\<prec>\<cdot>) UNIV" and
     wf_prec_L: "minimal_element (\<sqsubset>L) UNIV" and
     compat_equiv_prec: "C1 \<doteq> D1 \<Longrightarrow> C2 \<doteq> D2 \<Longrightarrow> C1 \<prec>\<cdot> C2 \<Longrightarrow> D1 \<prec>\<cdot> D2" and
     equiv_F_grounding: "q \<in> Q \<Longrightarrow> C1 \<doteq> C2 \<Longrightarrow> \<G>_F_q q C1 \<subseteq> \<G>_F_q q C2" and
     prec_F_grounding: "q \<in> Q \<Longrightarrow> C2 \<prec>\<cdot> C1 \<Longrightarrow> \<G>_F_q q C1 \<subseteq> \<G>_F_q q C2" and
     active_minimal: "l2 \<noteq> active \<Longrightarrow> active \<sqsubset>L l2" and
     at_least_two_labels: "\<exists>l2. active \<sqsubset>L l2" and
     inf_never_active: "\<iota> \<in> Inf_FL \<Longrightarrow> snd (concl_of \<iota>) \<noteq> active" and
     static_ref_comp: "statically_complete_calculus Bot_F Inf_F (\<Turnstile>\<inter>\<G>)
       no_labels.Red_I_\<G> no_labels.Red_F_\<G>_empty"
 begin
 
 abbreviation Prec_eq_F :: "'f \<Rightarrow> 'f \<Rightarrow> bool" (infix "\<preceq>\<cdot>" 50) where
   "C \<preceq>\<cdot> D \<equiv> C \<doteq> D \<or> C \<prec>\<cdot> D"
 
 definition Prec_FL :: "('f \<times> 'l) \<Rightarrow> ('f \<times> 'l) \<Rightarrow> bool" (infix "\<sqsubset>" 50) where
   "Cl1 \<sqsubset> Cl2 \<longleftrightarrow> fst Cl1 \<prec>\<cdot> fst Cl2 \<or> (fst Cl1 \<doteq> fst Cl2 \<and> snd Cl1 \<sqsubset>L snd Cl2)"
 
 lemma irrefl_prec_F: "\<not> C \<prec>\<cdot> C"
   by (simp add: minimal_element.po[OF wf_prec_F, unfolded po_on_def irreflp_on_def])
 
 lemma trans_prec_F: "C1 \<prec>\<cdot> C2 \<Longrightarrow> C2 \<prec>\<cdot> C3 \<Longrightarrow> C1 \<prec>\<cdot> C3"
   by (auto intro: minimal_element.po[OF wf_prec_F, unfolded po_on_def transp_on_def, THEN conjunct2,
         simplified, rule_format])
 
 lemma wf_prec_FL: "minimal_element (\<sqsubset>) UNIV"
 proof
   show "po_on (\<sqsubset>) UNIV" unfolding po_on_def
   proof
     show "irreflp_on (\<sqsubset>) UNIV" unfolding irreflp_on_def Prec_FL_def
     proof
       fix Cl
       assume a_in: "Cl \<in> (UNIV::('f \<times> 'l) set)"
       have "\<not> (fst Cl \<prec>\<cdot> fst Cl)" using wf_prec_F minimal_element.min_elt_ex by force
       moreover have "\<not> (snd Cl \<sqsubset>L snd Cl)" using wf_prec_L minimal_element.min_elt_ex by force
       ultimately show "\<not> (fst Cl \<prec>\<cdot> fst Cl \<or> fst Cl \<doteq> fst Cl \<and> snd Cl \<sqsubset>L snd Cl)" by blast
     qed
   next
     show "transp_on (\<sqsubset>) UNIV" unfolding transp_on_def Prec_FL_def
     proof (simp, intro allI impI)
       fix C1 l1 C2 l2 C3 l3
       assume trans_hyp: "(C1 \<prec>\<cdot> C2 \<or> C1 \<doteq> C2 \<and> l1 \<sqsubset>L l2) \<and> (C2 \<prec>\<cdot> C3 \<or> C2 \<doteq> C3 \<and> l2 \<sqsubset>L l3)"
       have "C1 \<prec>\<cdot> C2 \<Longrightarrow> C2 \<doteq> C3 \<Longrightarrow> C1 \<prec>\<cdot> C3"
         using compat_equiv_prec by (metis equiv_equiv_F equivp_def)
       moreover have "C1 \<doteq> C2 \<Longrightarrow> C2 \<prec>\<cdot> C3 \<Longrightarrow> C1 \<prec>\<cdot> C3"
         using compat_equiv_prec by (metis equiv_equiv_F equivp_def)
       moreover have "l1 \<sqsubset>L l2 \<Longrightarrow> l2 \<sqsubset>L l3 \<Longrightarrow> l1 \<sqsubset>L l3"
         using wf_prec_L unfolding minimal_element_def po_on_def transp_on_def by (meson UNIV_I)
       moreover have "C1 \<doteq> C2 \<Longrightarrow> C2 \<doteq> C3 \<Longrightarrow> C1 \<doteq> C3"
         using equiv_equiv_F by (meson equivp_transp)
       ultimately show "C1 \<prec>\<cdot> C3 \<or> C1 \<doteq> C3 \<and> l1 \<sqsubset>L l3" using trans_hyp
         using trans_prec_F by blast
     qed
   qed
 next
   show "wfp_on (\<sqsubset>) UNIV" unfolding wfp_on_def
   proof
     assume contra: "\<exists>f. \<forall>i. f i \<in> UNIV \<and> f (Suc i) \<sqsubset> f i"
     then obtain f where
       f_suc: "\<forall>i. f (Suc i) \<sqsubset> f i"
       by blast
 
     define R :: "(('f \<times> 'l) \<times> ('f \<times> 'l)) set" where
       "R = {(Cl1, Cl2). fst Cl1 \<prec>\<cdot> fst Cl2}"
     define S :: "(('f \<times> 'l) \<times> ('f \<times> 'l)) set" where
       "S = {(Cl1, Cl2). fst Cl1 \<doteq> fst Cl2 \<and> snd Cl1 \<sqsubset>L snd Cl2}"
 
     obtain k where
       f_chain: "\<forall>i. (f (Suc (i + k)), f (i + k)) \<in> S"
     proof (atomize_elim, rule wf_infinite_down_chain_compatible[of R f S])
       show "wf R"
         unfolding R_def using wf_app[OF wf_prec_F[unfolded minimal_element_def, THEN conjunct2,
               unfolded wfp_on_UNIV wfP_def]]
         by force
     next
       show "\<forall>i. (f (Suc i), f i) \<in> R \<union> S"
         using f_suc unfolding R_def S_def Prec_FL_def by blast
     next
       show "R O S \<subseteq> R"
         unfolding R_def S_def using compat_equiv_prec equiv_equiv_F equivp_reflp by fastforce
     qed
 
     define g where
       "\<And>i. g i = f (i + k)"
 
     have g_chain: "\<forall>i. (g (Suc i), g i) \<in> S"
       unfolding g_def using f_chain by simp
     have wf_s: "wf S"
       unfolding S_def
       by (rule wf_subset[OF wf_app[OF wf_prec_L[unfolded minimal_element_def, THEN conjunct2,
                 unfolded wfp_on_UNIV wfP_def], of snd]])
         fast
     show False
       using g_chain[unfolded S_def]
         wf_s[unfolded S_def, folded wfP_def wfp_on_UNIV, unfolded wfp_on_def]
       by auto
   qed
 qed
 
 definition active_subset :: "('f \<times> 'l) set \<Rightarrow> ('f \<times> 'l) set" where
   "active_subset M = {CL \<in> M. snd CL = active}"
 
 definition passive_subset :: "('f \<times> 'l) set \<Rightarrow> ('f \<times> 'l) set" where
   "passive_subset M = {CL \<in> M. snd CL \<noteq> active}"
 
 lemma active_subset_insert[simp]:
   "active_subset (insert Cl N) = (if snd Cl = active then {Cl} else {}) \<union> active_subset N"
   unfolding active_subset_def by auto
 
 lemma active_subset_union[simp]: "active_subset (M \<union> N) = active_subset M \<union> active_subset N"
   unfolding active_subset_def by auto
 
 lemma passive_subset_insert[simp]:
   "passive_subset (insert Cl N) = (if snd Cl \<noteq> active then {Cl} else {}) \<union> passive_subset N"
   unfolding passive_subset_def by auto
 
 lemma passive_subset_union[simp]: "passive_subset (M \<union> N) = passive_subset M \<union> passive_subset N"
   unfolding passive_subset_def by auto
 
 sublocale std?: statically_complete_calculus Bot_FL Inf_FL "(\<Turnstile>\<inter>\<G>L)" Red_I Red_F
   using labeled_static_ref[OF static_ref_comp] .
 
 lemma labeled_tiebreaker_lifting:
   assumes q_in: "q \<in> Q"
   shows "tiebreaker_lifting Bot_FL Inf_FL Bot_G (entails_q q) (Inf_G_q q)
     (Red_I_q q) (Red_F_q q) (\<G>_F_L_q q) (\<G>_I_L_q q) (\<lambda>g. Prec_FL)"
 proof -
   have "tiebreaker_lifting Bot_FL Inf_FL Bot_G (entails_q q) (Inf_G_q q)
     (Red_I_q q) (Red_F_q q) (\<G>_F_L_q q) (\<G>_I_L_q q) (\<lambda>g Cl Cl'. False)"
     using ord_fam_lifted_q[OF q_in] .
   then have "standard_lifting Inf_FL Bot_G (Inf_G_q q) (entails_q q) (Red_I_q q)
     (Red_F_q q) Bot_FL (\<G>_F_L_q q) (\<G>_I_L_q q)"
     using lifted_q[OF q_in] by blast
   then show "tiebreaker_lifting Bot_FL Inf_FL Bot_G (entails_q q) (Inf_G_q q)
     (Red_I_q q) (Red_F_q q) (\<G>_F_L_q q) (\<G>_I_L_q q) (\<lambda>g. Prec_FL)"
     using wf_prec_FL by (simp add: tiebreaker_lifting.intro tiebreaker_lifting_axioms.intro)
 qed
 
 sublocale lifting_intersection Inf_FL Bot_G Q Inf_G_q entails_q Red_I_q Red_F_q
   Bot_FL \<G>_F_L_q \<G>_I_L_q "\<lambda>g. Prec_FL"
   using labeled_tiebreaker_lifting unfolding lifting_intersection_def
   by (simp add: lifting_intersection_axioms.intro
       no_labels.ground.consequence_relation_family_axioms
       no_labels.ground.inference_system_family_axioms)
 
 notation derive (infix "\<rhd>L" 50)
 
 lemma std_Red_I_eq: "std.Red_I = Red_I_\<G>"
   unfolding Red_I_\<G>_q_def Red_I_\<G>_L_q_def by simp
 
 lemma std_Red_F_eq: "std.Red_F = Red_F_\<G>_empty"
   unfolding Red_F_\<G>_empty_q_def Red_F_\<G>_empty_L_q_def by simp
 
 sublocale statically_complete_calculus Bot_FL Inf_FL "(\<Turnstile>\<inter>\<G>L)" Red_I Red_F
   by unfold_locales (use statically_complete std_Red_I_eq in auto)
 
 (* lem:redundant-labeled-inferences *)
 lemma labeled_red_inf_eq_red_inf:
   assumes i_in: "\<iota> \<in> Inf_FL"
   shows "\<iota> \<in> Red_I N \<longleftrightarrow> to_F \<iota> \<in> no_labels.Red_I_\<G> (fst ` N)"
 proof
   assume i_in2: "\<iota> \<in> Red_I N"
   then have "X \<in> Red_I_\<G>_q ` Q \<Longrightarrow> \<iota> \<in> X N" for X
     unfolding Red_I_def by blast
   obtain X0 where "X0 \<in> Red_I_\<G>_q ` Q"
     using Q_nonempty by blast
   then obtain q0 where x0_is: "X0 N = Red_I_\<G>_q q0 N" by blast
   then obtain Y0 where y0_is: "Y0 (fst ` N) = to_F ` (X0 N)" by auto
   have "Y0 (fst ` N) = no_labels.Red_I_\<G>_q q0 (fst ` N)"
     unfolding  y0_is
   proof
     show "to_F ` X0 N \<subseteq> no_labels.Red_I_\<G>_q q0 (fst ` N)"
     proof
       fix \<iota>0
       assume i0_in: "\<iota>0 \<in> to_F ` X0 N"
       then have i0_in2: "\<iota>0 \<in> to_F ` Red_I_\<G>_q q0 N"
         using x0_is by argo
       then obtain \<iota>0_FL where i0_FL_in: "\<iota>0_FL \<in> Inf_FL" and i0_to_i0_FL: "\<iota>0 = to_F \<iota>0_FL" and
         subs1: "((\<G>_I_L_q q0 \<iota>0_FL) \<noteq> None \<and>
             the (\<G>_I_L_q q0 \<iota>0_FL) \<subseteq> Red_I_q q0 (\<G>_Fset_q q0 N))
             \<or> ((\<G>_I_L_q q0 \<iota>0_FL = None) \<and>
             \<G>_F_L_q q0 (concl_of \<iota>0_FL) \<subseteq> \<G>_Fset_q q0 N \<union> Red_F_q q0 (\<G>_Fset_q q0 N))"
         unfolding Red_I_\<G>_q_def by blast
       have concl_swap: "fst (concl_of \<iota>0_FL) = concl_of \<iota>0"
         unfolding concl_of_def i0_to_i0_FL to_F_def by simp
       have i0_in3: "\<iota>0 \<in> Inf_F"
         using i0_to_i0_FL Inf_FL_to_Inf_F[OF i0_FL_in] unfolding to_F_def by blast
       {
         assume
           not_none: "\<G>_I_q q0 \<iota>0 \<noteq> None" and
           "the (\<G>_I_q q0 \<iota>0) \<noteq> {}"
         then obtain \<iota>1 where i1_in: "\<iota>1 \<in> the (\<G>_I_q q0 \<iota>0)" by blast
         have "the (\<G>_I_q q0 \<iota>0) \<subseteq> Red_I_q q0 (no_labels.\<G>_Fset_q q0 (fst ` N))"
           using subs1 i0_to_i0_FL not_none by auto
       }
       moreover {
         assume
           is_none: "\<G>_I_q q0 \<iota>0 = None"
         then have "\<G>_F_q q0 (concl_of \<iota>0) \<subseteq> no_labels.\<G>_Fset_q q0 (fst ` N)
             \<union> Red_F_q q0 (no_labels.\<G>_Fset_q q0 (fst ` N))"
           using subs1 i0_to_i0_FL concl_swap by simp
       }
       ultimately show "\<iota>0 \<in> no_labels.Red_I_\<G>_q q0 (fst ` N)"
         unfolding no_labels.Red_I_\<G>_q_def using i0_in3 by auto
     qed
   next
     show "no_labels.Red_I_\<G>_q q0 (fst ` N) \<subseteq> to_F ` X0 N"
     proof
       fix \<iota>0
       assume i0_in: "\<iota>0 \<in> no_labels.Red_I_\<G>_q q0 (fst ` N)"
       then have i0_in2: "\<iota>0 \<in> Inf_F"
         unfolding no_labels.Red_I_\<G>_q_def by blast
       obtain \<iota>0_FL where i0_FL_in: "\<iota>0_FL \<in> Inf_FL" and i0_to_i0_FL: "\<iota>0 = to_F \<iota>0_FL"
         using Inf_F_to_Inf_FL[OF i0_in2] unfolding to_F_def
         by (metis Ex_list_of_length fst_conv inference.exhaust_sel inference.inject map_fst_zip)
       have concl_swap: "fst (concl_of \<iota>0_FL) = concl_of \<iota>0"
         unfolding concl_of_def i0_to_i0_FL to_F_def by simp
       have subs1: "((\<G>_I_L_q q0 \<iota>0_FL) \<noteq> None \<and>
            the (\<G>_I_L_q q0 \<iota>0_FL) \<subseteq> Red_I_q q0 (\<G>_Fset_q q0 N))
            \<or> ((\<G>_I_L_q q0 \<iota>0_FL = None) \<and>
            \<G>_F_L_q q0 (concl_of \<iota>0_FL) \<subseteq> (\<G>_Fset_q q0 N \<union> Red_F_q q0 (\<G>_Fset_q q0 N)))"
         using i0_in i0_to_i0_FL concl_swap unfolding no_labels.Red_I_\<G>_q_def by simp
       then have "\<iota>0_FL \<in> Red_I_\<G>_q q0 N"
         using i0_FL_in unfolding Red_I_\<G>_q_def by simp
       then show "\<iota>0 \<in> to_F ` X0 N"
         using x0_is i0_to_i0_FL i0_in2 by blast
     qed
   qed
   then have "Y \<in> no_labels.Red_I_\<G>_q ` Q \<Longrightarrow> to_F \<iota> \<in> Y (fst ` N)" for Y
     using i_in2 no_labels.Red_I_def std_Red_I_eq red_inf_impl by force
   then show "to_F \<iota> \<in> no_labels.Red_I_\<G> (fst ` N)"
     unfolding Red_I_def no_labels.Red_I_\<G>_def by blast
 next
   assume to_F_in: "to_F \<iota> \<in> no_labels.Red_I_\<G> (fst ` N)"
   have imp_to_F: "X \<in> no_labels.Red_I_\<G>_q ` Q \<Longrightarrow> to_F \<iota> \<in> X (fst ` N)" for X
     using to_F_in unfolding no_labels.Red_I_\<G>_def by blast
   then have to_F_in2: "to_F \<iota> \<in> no_labels.Red_I_\<G>_q q (fst ` N)" if "q \<in> Q" for q
     using that by auto
   have "Red_I_\<G>_q q N = {\<iota>0_FL \<in> Inf_FL. to_F \<iota>0_FL \<in> no_labels.Red_I_\<G>_q q (fst ` N)}" for q
   proof
     show "Red_I_\<G>_q q N \<subseteq> {\<iota>0_FL \<in> Inf_FL. to_F \<iota>0_FL \<in> no_labels.Red_I_\<G>_q q (fst ` N)}"
     proof
       fix q0 \<iota>1
       assume
         i1_in: "\<iota>1 \<in> Red_I_\<G>_q q0 N"
       have i1_in2: "\<iota>1 \<in> Inf_FL"
         using i1_in unfolding Red_I_\<G>_q_def by blast
       then have to_F_i1_in: "to_F \<iota>1 \<in> Inf_F"
         using Inf_FL_to_Inf_F unfolding to_F_def by simp
       have concl_swap: "fst (concl_of \<iota>1) = concl_of (to_F \<iota>1)"
         unfolding concl_of_def to_F_def by simp
       then have i1_to_F_in: "to_F \<iota>1 \<in> no_labels.Red_I_\<G>_q q0 (fst ` N)"
         using i1_in to_F_i1_in unfolding Red_I_\<G>_q_def no_labels.Red_I_\<G>_q_def by force
       show "\<iota>1 \<in> {\<iota>0_FL \<in> Inf_FL. to_F \<iota>0_FL \<in> no_labels.Red_I_\<G>_q q0 (fst ` N)}"
         using i1_in2 i1_to_F_in by blast
     qed
   next
     show "{\<iota>0_FL \<in> Inf_FL. to_F \<iota>0_FL \<in> no_labels.Red_I_\<G>_q q (fst ` N)} \<subseteq> Red_I_\<G>_q q N"
     proof
       fix q0 \<iota>1
       assume
         i1_in: "\<iota>1 \<in> {\<iota>0_FL \<in> Inf_FL. to_F \<iota>0_FL \<in> no_labels.Red_I_\<G>_q q0 (fst ` N)}"
       then have i1_in2: "\<iota>1 \<in> Inf_FL" by blast
       then have to_F_i1_in: "to_F \<iota>1 \<in> Inf_F"
         using Inf_FL_to_Inf_F unfolding to_F_def by simp
       have concl_swap: "fst (concl_of \<iota>1) = concl_of (to_F \<iota>1)"
         unfolding concl_of_def to_F_def by simp
       then have "((\<G>_I_L_q q0 \<iota>1) \<noteq> None \<and> the (\<G>_I_L_q q0 \<iota>1) \<subseteq> Red_I_q q0 (\<G>_Fset_q q0 N))
         \<or> (\<G>_I_L_q q0 \<iota>1 = None \<and>
           \<G>_F_L_q q0 (concl_of \<iota>1) \<subseteq> \<G>_Fset_q q0 N \<union> Red_F_q q0 (\<G>_Fset_q q0 N))"
         using i1_in unfolding no_labels.Red_I_\<G>_q_def by auto
       then show "\<iota>1 \<in> Red_I_\<G>_q q0 N"
         using i1_in2 unfolding Red_I_\<G>_q_def by blast
     qed
   qed
   then have "\<iota> \<in> Red_I_\<G>_q q N" if "q \<in> Q" for q
     using that to_F_in2 i_in unfolding Red_I_\<G>_q_def no_labels.Red_I_\<G>_q_def by auto
   then show "\<iota> \<in> Red_I_\<G> N"
     unfolding Red_I_\<G>_def by blast
 qed
 
 (* lem:redundant-labeled-formulas *)
 lemma red_labeled_clauses:
   assumes \<open>C \<in> no_labels.Red_F_\<G>_empty (fst ` N) \<or>
     (\<exists>C' \<in> fst ` N. C' \<prec>\<cdot> C) \<or> (\<exists>(C', L') \<in> N. L' \<sqsubset>L L \<and> C' \<preceq>\<cdot> C)\<close>
   shows \<open>(C, L) \<in> Red_F N\<close>
 proof -
   note assms
   moreover have i: \<open>C \<in> no_labels.Red_F_\<G>_empty (fst ` N) \<Longrightarrow> (C, L) \<in> Red_F N\<close>
   proof -
     assume "C \<in> no_labels.Red_F_\<G>_empty (fst ` N)"
     then have "C \<in> no_labels.Red_F_\<G>_empty_q q (fst ` N)" if "q \<in> Q" for q
       unfolding no_labels.Red_F_\<G>_empty_def using that by fast
     then have g_in_red: "\<G>_F_q q C \<subseteq> Red_F_q q (no_labels.\<G>_Fset_q q (fst ` N))" if "q \<in> Q" for q
       unfolding no_labels.Red_F_\<G>_empty_q_def using that by blast
     have "\<G>_F_L_q q (C, L) \<subseteq> Red_F_q q (\<G>_Fset_q q N)" if "q \<in> Q" for q
       using that g_in_red by simp
     then show ?thesis
       unfolding Red_F_def Red_F_\<G>_q_def by blast
   qed
   moreover have ii: \<open>\<exists>C' \<in> fst ` N. C' \<prec>\<cdot> C \<Longrightarrow> (C, L) \<in> Red_F N\<close>
   proof -
     assume "\<exists>C' \<in> fst ` N. C' \<prec>\<cdot> C"
     then obtain C' where c'_in: "C' \<in> fst ` N" and c_prec_c': "C' \<prec>\<cdot> C" by blast
     obtain L' where c'_l'_in: "(C', L') \<in> N" using c'_in by auto
     have c'_l'_prec: "(C', L') \<sqsubset> (C, L)"
       using c_prec_c' unfolding Prec_FL_def by simp
     have c_in_c'_g: "\<G>_F_q q C \<subseteq> \<G>_F_q q C'" if "q \<in> Q" for q
       using prec_F_grounding[OF that c_prec_c'] by presburger
     then have "\<G>_F_L_q q (C, L) \<subseteq> \<G>_F_L_q q (C', L')" if "q \<in> Q" for q
       using that by auto
     then have "(C, L) \<in> Red_F_\<G>_q q N" if "q \<in> Q" for q
       unfolding Red_F_\<G>_q_def using that c'_l'_in c'_l'_prec by blast
     then show ?thesis
       unfolding Red_F_def by blast
   qed
   moreover have iii: \<open>\<exists>(C', L') \<in> N. L' \<sqsubset>L L \<and> C' \<preceq>\<cdot> C \<Longrightarrow> (C, L) \<in> Red_F N\<close>
   proof -
     assume "\<exists>(C', L') \<in> N. L' \<sqsubset>L L \<and> C' \<preceq>\<cdot> C"
     then obtain C' L' where c'_l'_in: "(C', L') \<in> N" and l'_sub_l: "L' \<sqsubset>L L" and c'_sub_c: "C' \<preceq>\<cdot> C"
       by fast
     have "(C, L) \<in> Red_F N" if "C' \<prec>\<cdot> C"
       using that c'_l'_in ii by fastforce
     moreover {
       assume equiv_c_c': "C \<doteq> C'"
       then have equiv_c'_c: "C' \<doteq> C"
         using equiv_equiv_F by (simp add: equivp_symp)
       then have c'_l'_prec: "(C', L') \<sqsubset> (C, L)"
         using l'_sub_l unfolding Prec_FL_def by simp
       have "\<G>_F_q q C = \<G>_F_q q C'" if "q \<in> Q" for q
         using that equiv_F_grounding equiv_c_c' equiv_c'_c by (simp add: set_eq_subset)
       then have "\<G>_F_L_q q (C, L) = \<G>_F_L_q q (C', L')" if "q \<in> Q" for q
         using that by auto
       then have "(C, L) \<in> Red_F_\<G>_q q N" if "q \<in> Q" for q
         unfolding Red_F_\<G>_q_def using that c'_l'_in c'_l'_prec by blast
       then have ?thesis
         unfolding Red_F_def by blast
     }
     ultimately show ?thesis
       using c'_sub_c equiv_equiv_F equivp_symp by fastforce
   qed
   ultimately show ?thesis
     by blast
 qed
 
 end
   
   
 subsection \<open>Given Clause Procedure\<close>
 
 locale given_clause = given_clause_basis Bot_F Inf_F Bot_G Q entails_q Inf_G_q Red_I_q
   Red_F_q \<G>_F_q \<G>_I_q Inf_FL Equiv_F Prec_F Prec_L active
   for
     Bot_F :: "'f set" and
     Inf_F :: "'f inference set" and
     Bot_G :: "'g set" and
     Q :: "'q set" and
     entails_q :: "'q \<Rightarrow> 'g set \<Rightarrow> 'g set \<Rightarrow> bool" and
     Inf_G_q :: \<open>'q \<Rightarrow> 'g inference set\<close> and
     Red_I_q :: "'q \<Rightarrow> 'g set \<Rightarrow> 'g inference set" and
     Red_F_q :: "'q \<Rightarrow> 'g set \<Rightarrow> 'g set" and
     \<G>_F_q :: "'q \<Rightarrow> 'f \<Rightarrow> 'g set"  and
     \<G>_I_q :: "'q \<Rightarrow> 'f inference \<Rightarrow> 'g inference set option" and
     Inf_FL :: \<open>('f \<times> 'l) inference set\<close> and
     Equiv_F :: "'f \<Rightarrow> 'f \<Rightarrow> bool" (infix "\<doteq>" 50) and
     Prec_F :: "'f \<Rightarrow> 'f \<Rightarrow> bool" (infix "\<prec>\<cdot>" 50) and
     Prec_L :: "'l \<Rightarrow> 'l \<Rightarrow> bool" (infix "\<sqsubset>L" 50) and
     active :: 'l +
   assumes
     inf_have_prems: "\<iota>F \<in> Inf_F \<Longrightarrow> prems_of \<iota>F \<noteq> []"
 begin
   
 lemma labeled_inf_have_prems: "\<iota> \<in> Inf_FL \<Longrightarrow> prems_of \<iota> \<noteq> []"
   using inf_have_prems Inf_FL_to_Inf_F by fastforce
 
 inductive step :: "('f \<times> 'l) set \<Rightarrow> ('f \<times> 'l) set \<Rightarrow> bool" (infix "\<leadsto>GC" 50) where
   process: "N1 = N \<union> M \<Longrightarrow> N2 = N \<union> M' \<Longrightarrow> M \<subseteq> Red_F (N \<union> M') \<Longrightarrow>
     active_subset M' = {} \<Longrightarrow> N1 \<leadsto>GC N2"
 | infer: "N1 = N \<union> {(C, L)} \<Longrightarrow> N2 = N \<union> {(C, active)} \<union> M \<Longrightarrow> L \<noteq> active \<Longrightarrow>
     active_subset M = {} \<Longrightarrow>
     no_labels.Inf_between (fst ` (active_subset N)) {C}
     \<subseteq> no_labels.Red_I (fst ` (N \<union> {(C, active)} \<union> M)) \<Longrightarrow>
     N1 \<leadsto>GC N2"
   
 lemma one_step_equiv: "N1 \<leadsto>GC N2 \<Longrightarrow> N1 \<rhd>L N2"
 proof (cases N1 N2 rule: step.cases)
   show "N1 \<leadsto>GC N2 \<Longrightarrow> N1 \<leadsto>GC N2" by blast
 next
   fix N M M'
   assume
     gc_step: "N1 \<leadsto>GC N2" and
     n1_is: "N1 = N \<union> M" and
     n2_is: "N2 = N \<union> M'" and
     m_red: "M \<subseteq> Red_F (N \<union> M')" and
     active_empty: "active_subset M' = {}"
   have "N1 - N2 \<subseteq> Red_F N2"
     using n1_is n2_is m_red by auto
   then show "N1 \<rhd>L N2"
     unfolding derive.simps by blast
 next
   fix N C L M
   assume
     gc_step: "N1 \<leadsto>GC N2" and
     n1_is: "N1 = N \<union> {(C, L)}" and
     not_active: "L \<noteq> active" and
     n2_is: "N2 = N \<union> {(C, active)} \<union> M" and
     active_empty: "active_subset M = {}"
   have "(C, active) \<in> N2" using n2_is by auto
   moreover have "C \<preceq>\<cdot> C" using equiv_equiv_F by (metis equivp_def)
   moreover have "active \<sqsubset>L L" using active_minimal[OF not_active] .
   ultimately have "{(C, L)} \<subseteq> Red_F N2"
     using red_labeled_clauses by blast
   moreover have "N1 - N2 = {} \<or> N1 - N2 = {(C, L)}" using n1_is n2_is by blast
   ultimately have "N1 - N2 \<subseteq> Red_F N2"
     using std_Red_F_eq by blast
   then show "N1 \<rhd>L N2"
     unfolding derive.simps by blast
 qed
 
 (* lem:gc-derivations-are-red-derivations *)
 lemma gc_to_red: "chain (\<leadsto>GC) Ns \<Longrightarrow> chain (\<rhd>L) Ns"
   using one_step_equiv Lazy_List_Chain.chain_mono by blast
 
 lemma (in-) all_ex_finite_set: "(\<forall>(j::nat)\<in>{0..<m}. \<exists>(n::nat). P j n) \<Longrightarrow>
   (\<forall>n1 n2. \<forall>j\<in>{0..<m}. P j n1 \<longrightarrow> P j n2 \<longrightarrow> n1 = n2) \<Longrightarrow> finite {n. \<exists>j \<in> {0..<m}. P j n}" for m P
 proof -
   fix m::nat and P:: "nat \<Rightarrow> nat \<Rightarrow> bool"
   assume
     allj_exn: "\<forall>j\<in>{0..<m}. \<exists>n. P j n" and
     uniq_n: "\<forall>n1 n2. \<forall>j\<in>{0..<m}. P j n1 \<longrightarrow> P j n2 \<longrightarrow> n1 = n2"
   have "{n. \<exists>j \<in> {0..<m}. P j n} = (\<Union>((\<lambda>j. {n. P j n}) ` {0..<m}))" by blast
   then have imp_finite: "(\<forall>j\<in>{0..<m}. finite {n. P j n}) \<Longrightarrow> finite {n. \<exists>j \<in> {0..<m}. P j n}"
     using finite_UN[of "{0..<m}" "\<lambda>j. {n. P j n}"] by simp
   have "\<forall>j\<in>{0..<m}. \<exists>!n. P j n" using allj_exn uniq_n by blast
   then have "\<forall>j\<in>{0..<m}. finite {n. P j n}" by (metis bounded_nat_set_is_finite lessI mem_Collect_eq)
   then show "finite {n. \<exists>j \<in> {0..<m}. P j n}" using imp_finite by simp
 qed
 
 (* lem:fair-gc-derivations *)
 lemma gc_fair:
   assumes
     deriv: "chain (\<leadsto>GC) Ns" and
     init_state: "active_subset (lhd Ns) = {}" and
     final_state: "passive_subset (Liminf_llist Ns) = {}"
   shows "fair Ns"
   unfolding fair_def
 proof
   fix \<iota>
   assume i_in: "\<iota> \<in> Inf_from (Liminf_llist Ns)"
   note lhd_is = lhd_conv_lnth[OF chain_not_lnull[OF deriv]]
   have i_in_inf_fl: "\<iota> \<in> Inf_FL" using i_in unfolding Inf_from_def by blast
   have "Liminf_llist Ns = active_subset (Liminf_llist Ns)"
     using final_state unfolding passive_subset_def active_subset_def by blast
   then have i_in2: "\<iota> \<in> Inf_from (active_subset (Liminf_llist Ns))" using i_in by simp
   define m where "m = length (prems_of \<iota>)"
   then have m_def_F: "m = length (prems_of (to_F \<iota>))" unfolding to_F_def by simp
   have i_in_F: "to_F \<iota> \<in> Inf_F"
     using i_in Inf_FL_to_Inf_F unfolding Inf_from_def to_F_def by blast
   then have m_pos: "m > 0" using m_def_F using inf_have_prems by blast
   have exist_nj: "\<forall>j \<in> {0..<m}. (\<exists>nj. enat (Suc nj) < llength Ns \<and>
       prems_of \<iota> ! j \<notin> active_subset (lnth Ns nj) \<and>
       (\<forall>k. k > nj \<longrightarrow> enat k < llength Ns \<longrightarrow> prems_of \<iota> ! j \<in> active_subset (lnth Ns k)))"
   proof clarify
     fix j
     assume j_in: "j \<in> {0..<m}"
     then obtain C where c_is: "(C, active) = prems_of \<iota> ! j"
       using i_in2 unfolding m_def Inf_from_def active_subset_def
       by (smt Collect_mem_eq Collect_mono_iff atLeastLessThan_iff nth_mem old.prod.exhaust snd_conv)
     then have "(C, active) \<in> Liminf_llist Ns"
       using j_in i_in unfolding m_def Inf_from_def by force
     then obtain nj where nj_is: "enat nj < llength Ns" and
       c_in2: "(C, active) \<in> \<Inter> (lnth Ns ` {k. nj \<le> k \<and> enat k < llength Ns})"
       unfolding Liminf_llist_def using init_state by blast
     then have c_in3: "\<forall>k. k \<ge> nj \<longrightarrow> enat k < llength Ns \<longrightarrow> (C, active) \<in> lnth Ns k" by blast
     have nj_pos: "nj > 0" using init_state c_in2 nj_is
       unfolding active_subset_def lhd_is by force
     obtain nj_min where nj_min_is: "nj_min = (LEAST nj. enat nj < llength Ns \<and>
         (C, active) \<in> \<Inter> (lnth Ns ` {k. nj \<le> k \<and> enat k < llength Ns}))" by blast
     then have in_allk: "\<forall>k. k \<ge> nj_min \<longrightarrow> enat k < llength Ns \<longrightarrow> (C, active) \<in> (lnth Ns k)"
       using c_in3 nj_is c_in2
       by (metis (mono_tags, lifting) INT_E LeastI_ex mem_Collect_eq)
     have njm_smaller_D: "enat nj_min < llength Ns"
       using nj_min_is
       by (smt LeastI_ex \<open>\<And>thesis. (\<And>nj. \<lbrakk>enat nj < llength Ns;
           (C, active) \<in> \<Inter> (lnth Ns ` {k. nj \<le> k \<and> enat k < llength Ns})\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>)
     have "nj_min > 0"
       using nj_is c_in2 nj_pos nj_min_is lhd_is
       by (metis (mono_tags, lifting) Collect_empty_eq \<open>(C, active) \<in> Liminf_llist Ns\<close>
           \<open>Liminf_llist Ns = active_subset (Liminf_llist Ns)\<close>
           \<open>\<forall>k\<ge>nj_min. enat k < llength Ns \<longrightarrow> (C, active) \<in> lnth Ns k\<close> active_subset_def init_state
           linorder_not_less mem_Collect_eq zero_enat_def chain_length_pos[OF deriv])
     then obtain njm_prec where nj_prec_is: "Suc njm_prec = nj_min" using gr0_conv_Suc by auto
     then have njm_prec_njm: "njm_prec < nj_min" by blast
     then have njm_prec_njm_enat: "enat njm_prec < enat nj_min" by simp
     have njm_prec_smaller_d: "njm_prec < llength Ns"
-      using HOL.no_atp(15)[OF njm_smaller_D njm_prec_njm_enat] .
+      by (rule less_trans[OF njm_prec_njm_enat njm_smaller_D])
     have njm_prec_all_suc: "\<forall>k>njm_prec. enat k < llength Ns \<longrightarrow> (C, active) \<in> lnth Ns k"
       using nj_prec_is in_allk by simp
     have notin_njm_prec: "(C, active) \<notin> lnth Ns njm_prec"
     proof (rule ccontr)
       assume "\<not> (C, active) \<notin> lnth Ns njm_prec"
       then have absurd_hyp: "(C, active) \<in> lnth Ns njm_prec" by simp
       have prec_smaller: "enat njm_prec < llength Ns" using nj_min_is nj_prec_is
         by (smt LeastI_ex Suc_leD \<open>\<And>thesis. (\<And>nj. \<lbrakk>enat nj < llength Ns;
             (C, active) \<in> \<Inter> (lnth Ns ` {k. nj \<le> k \<and> enat k < llength Ns})\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
             enat_ord_simps(1) le_eq_less_or_eq le_less_trans)
       have "(C, active) \<in> \<Inter> (lnth Ns ` {k. njm_prec \<le> k \<and> enat k < llength Ns})"
       proof -
         {
           fix k
           assume k_in: "njm_prec \<le> k \<and> enat k < llength Ns"
           have "k = njm_prec \<Longrightarrow> (C, active) \<in> lnth Ns k" using absurd_hyp by simp
           moreover have "njm_prec < k \<Longrightarrow> (C, active) \<in> lnth Ns k"
             using nj_prec_is in_allk k_in by simp
           ultimately have "(C, active) \<in> lnth Ns k" using k_in by fastforce
         }
         then show "(C, active) \<in> \<Inter> (lnth Ns ` {k. njm_prec \<le> k \<and> enat k < llength Ns})" by blast
       qed
       then have "enat njm_prec < llength Ns \<and>
           (C, active) \<in> \<Inter> (lnth Ns ` {k. njm_prec \<le> k \<and> enat k < llength Ns})"
         using prec_smaller by blast
       then show False
         using nj_min_is nj_prec_is Orderings.wellorder_class.not_less_Least njm_prec_njm by blast
     qed
     then have notin_active_subs_njm_prec: "(C, active) \<notin> active_subset (lnth Ns njm_prec)"
       unfolding active_subset_def by blast
     then show "\<exists>nj. enat (Suc nj) < llength Ns \<and> prems_of \<iota> ! j \<notin> active_subset (lnth Ns nj) \<and>
         (\<forall>k. k > nj \<longrightarrow> enat k < llength Ns \<longrightarrow> prems_of \<iota> ! j \<in> active_subset (lnth Ns k))"
       using c_is njm_prec_all_suc njm_prec_smaller_d by (metis (mono_tags, lifting)
           active_subset_def mem_Collect_eq nj_prec_is njm_smaller_D snd_conv)
   qed
   define nj_set where "nj_set = {nj. (\<exists>j\<in>{0..<m}. enat (Suc nj) < llength Ns \<and>
       prems_of \<iota> ! j \<notin> active_subset (lnth Ns nj) \<and>
       (\<forall>k. k > nj \<longrightarrow> enat k < llength Ns \<longrightarrow> prems_of \<iota> ! j \<in> active_subset (lnth Ns k)))}"
   then have nj_not_empty: "nj_set \<noteq> {}"
   proof -
     have zero_in: "0 \<in> {0..<m}" using m_pos by simp
     then obtain n0 where "enat (Suc n0) < llength Ns" and
       "prems_of \<iota> ! 0 \<notin> active_subset (lnth Ns n0)" and
       "\<forall>k>n0. enat k < llength Ns \<longrightarrow> prems_of \<iota> ! 0 \<in> active_subset (lnth Ns k)"
       using exist_nj by fast
     then have "n0 \<in> nj_set" unfolding nj_set_def using zero_in by blast
     then show "nj_set \<noteq> {}" by auto
   qed
   have nj_finite: "finite nj_set"
     using all_ex_finite_set[OF exist_nj]
     by (metis (no_types, lifting) Suc_ile_eq dual_order.strict_implies_order
         linorder_neqE_nat nj_set_def)
       (* the n below in the n-1 from the pen-and-paper proof *)
   have "\<exists>n \<in> nj_set. \<forall>nj \<in> nj_set. nj \<le> n"
     using nj_not_empty nj_finite using Max_ge Max_in by blast
   then obtain n where n_in: "n \<in> nj_set" and n_bigger: "\<forall>nj \<in> nj_set. nj \<le> n" by blast
   then obtain j0 where j0_in: "j0 \<in> {0..<m}" and suc_n_length: "enat (Suc n) < llength Ns" and
     j0_notin: "prems_of \<iota> ! j0 \<notin> active_subset (lnth Ns n)" and
     j0_allin: "(\<forall>k. k > n \<longrightarrow> enat k < llength Ns \<longrightarrow> prems_of \<iota> ! j0 \<in> active_subset (lnth Ns k))"
     unfolding nj_set_def by blast
   obtain C0 where C0_is: "prems_of \<iota> ! j0 = (C0, active)" using j0_in
     using i_in2 unfolding m_def Inf_from_def active_subset_def
     by (smt Collect_mem_eq Collect_mono_iff atLeastLessThan_iff nth_mem old.prod.exhaust snd_conv)
   then have C0_prems_i: "(C0, active) \<in> set (prems_of \<iota>)" using in_set_conv_nth j0_in m_def by force
   have C0_in: "(C0, active) \<in> (lnth Ns (Suc n))"
     using C0_is j0_allin suc_n_length by (simp add: active_subset_def)
   have C0_notin: "(C0, active) \<notin> (lnth Ns n)" using C0_is j0_notin unfolding active_subset_def by simp
   have step_n: "lnth Ns n \<leadsto>GC lnth Ns (Suc n)"
     using deriv chain_lnth_rel n_in unfolding nj_set_def by blast
   have "\<exists>N C L M. (lnth Ns n = N \<union> {(C, L)} \<and>
       lnth Ns (Suc n) = N \<union> {(C, active)} \<union> M \<and> L \<noteq> active \<and> active_subset M = {} \<and>
       no_labels.Inf_between (fst ` (active_subset N)) {C}
       \<subseteq> no_labels.Red_I (fst ` (N \<union> {(C, active)} \<union> M)))"
   proof -
     have proc_or_infer: "(\<exists>N1 N M N2 M'. lnth Ns n = N1 \<and> lnth Ns (Suc n) = N2 \<and> N1 = N \<union> M \<and>
          N2 = N \<union> M' \<and> M \<subseteq> Red_F (N \<union> M') \<and> active_subset M' = {}) \<or>
        (\<exists>N1 N C L N2 M. lnth Ns n = N1 \<and> lnth Ns (Suc n) = N2 \<and> N1 = N \<union> {(C, L)} \<and>
          N2 = N \<union> {(C, active)} \<union> M \<and> L \<noteq> active \<and> active_subset M = {} \<and>
          no_labels.Inf_between (fst ` (active_subset N)) {C} \<subseteq>
            no_labels.Red_I (fst ` (N \<union> {(C, active)} \<union> M)))"
       using step.simps[of "lnth Ns n" "lnth Ns (Suc n)"] step_n by blast
     show ?thesis
       using C0_in C0_notin proc_or_infer j0_in C0_is
       by (smt Un_iff active_subset_def mem_Collect_eq snd_conv sup_bot.right_neutral)
   qed
   then obtain N M L where inf_from_subs:
     "no_labels.Inf_between (fst ` (active_subset N)) {C0}
      \<subseteq> no_labels.Red_I (fst ` (N \<union> {(C0, active)} \<union> M))" and
     nth_d_is: "lnth Ns n = N \<union> {(C0, L)}" and
     suc_nth_d_is: "lnth Ns (Suc n) = N \<union> {(C0, active)} \<union> M" and
     l_not_active: "L \<noteq> active"
     using C0_in C0_notin j0_in C0_is using active_subset_def by fastforce
   have "j \<in> {0..<m} \<Longrightarrow> prems_of \<iota> ! j \<noteq> prems_of \<iota> ! j0 \<Longrightarrow> prems_of \<iota> ! j \<in> (active_subset N)" for j
   proof -
     fix j
     assume j_in: "j \<in> {0..<m}" and
       j_not_j0: "prems_of \<iota> ! j \<noteq> prems_of \<iota> ! j0"
     obtain nj where nj_len: "enat (Suc nj) < llength Ns" and
       nj_prems: "prems_of \<iota> ! j \<notin> active_subset (lnth Ns nj)" and
       nj_greater: "(\<forall>k. k > nj \<longrightarrow> enat k < llength Ns \<longrightarrow> prems_of \<iota> ! j \<in> active_subset (lnth Ns k))"
       using exist_nj j_in by blast
     then have "nj \<in> nj_set" unfolding nj_set_def using j_in by blast
     moreover have "nj \<noteq> n"
     proof (rule ccontr)
       assume "\<not> nj \<noteq> n"
       then have "prems_of \<iota> ! j = (C0, active)"
         using C0_in C0_notin step.simps[of "lnth Ns n" "lnth Ns (Suc n)"] step_n
         by (smt Un_iff nth_d_is suc_nth_d_is l_not_active active_subset_def insertCI insertE lessI
             mem_Collect_eq nj_greater nj_prems snd_conv suc_n_length)
       then show False using j_not_j0 C0_is by simp
     qed
     ultimately have "nj < n" using n_bigger by force
     then have "prems_of \<iota> ! j \<in> (active_subset (lnth Ns n))"
       using nj_greater n_in Suc_ile_eq dual_order.strict_implies_order unfolding nj_set_def by blast
     then show "prems_of \<iota> ! j \<in> (active_subset N)"
       using nth_d_is l_not_active unfolding active_subset_def by force
   qed
   then have "set (prems_of \<iota>) \<subseteq> active_subset N \<union> {(C0, active)}"
     using C0_prems_i C0_is m_def
     by (metis Un_iff atLeast0LessThan in_set_conv_nth insertCI lessThan_iff subrelI)
   moreover have "\<not> (set (prems_of \<iota>) \<subseteq> active_subset N - {(C0, active)})" using C0_prems_i by blast
   ultimately have "\<iota> \<in> Inf_between (active_subset N) {(C0, active)}"
     using i_in_inf_fl unfolding Inf_between_def Inf_from_def by blast
   then have "to_F \<iota> \<in> no_labels.Inf_between (fst ` (active_subset N)) {C0}"
     unfolding to_F_def Inf_between_def Inf_from_def
       no_labels.Inf_between_def no_labels.Inf_from_def using Inf_FL_to_Inf_F
     by force
   then have "to_F \<iota> \<in> no_labels.Red_I (fst ` (lnth Ns (Suc n)))"
     using suc_nth_d_is inf_from_subs by fastforce
   then have "\<forall>q \<in> Q. (\<G>_I_q q (to_F \<iota>) \<noteq> None \<and>
       the (\<G>_I_q q (to_F \<iota>)) \<subseteq> Red_I_q q (\<Union> (\<G>_F_q q ` fst ` lnth Ns (Suc n))))
       \<or> (\<G>_I_q q (to_F \<iota>) = None \<and>
       \<G>_F_q q (concl_of (to_F \<iota>)) \<subseteq> \<Union> (\<G>_F_q q ` fst ` lnth Ns (Suc n)) \<union>
         Red_F_q q (\<Union> (\<G>_F_q q ` fst ` lnth Ns (Suc n))))"
     unfolding to_F_def no_labels.Red_I_def no_labels.Red_I_\<G>_q_def by blast
   then have "\<iota> \<in> Red_I_\<G> (lnth Ns (Suc n))"
     using i_in_inf_fl unfolding Red_I_\<G>_def Red_I_\<G>_q_def by (simp add: to_F_def)
   then show "\<iota> \<in> Sup_llist (lmap Red_I_\<G> Ns)"
     unfolding Sup_llist_def using suc_n_length by auto
 qed
 
 theorem gc_complete_Liminf:
   assumes
     deriv: "chain (\<leadsto>GC) Ns" and
     init_state: "active_subset (lhd Ns) = {}" and
     final_state: "passive_subset (Liminf_llist Ns) = {}" and
     b_in: "B \<in> Bot_F" and
     bot_entailed: "no_labels.entails_\<G> (fst ` lhd Ns) {B}"
   shows "\<exists>BL \<in> Bot_FL. BL \<in> Liminf_llist Ns"
 proof -
   note lhd_is = lhd_conv_lnth[OF chain_not_lnull[OF deriv]]
   have labeled_b_in: "(B, active) \<in> Bot_FL" using b_in by simp
   have labeled_bot_entailed: "entails_\<G>_L (lhd Ns) {(B, active)}"
     using labeled_entailment_lifting bot_entailed lhd_is by fastforce
   have fair: "fair Ns" using gc_fair[OF deriv init_state final_state] .
   then show ?thesis
     using dynamically_complete_Liminf[OF labeled_b_in gc_to_red[OF deriv] fair
         labeled_bot_entailed]
     by blast
 qed
 
 (* thm:gc-completeness *)
 theorem gc_complete:
   assumes
     deriv: "chain (\<leadsto>GC) Ns" and
     init_state: "active_subset (lhd Ns) = {}" and
     final_state: "passive_subset (Liminf_llist Ns) = {}" and
     b_in: "B \<in> Bot_F" and
     bot_entailed: "no_labels.entails_\<G> (fst ` lhd Ns) {B}"
   shows "\<exists>i. enat i < llength Ns \<and> (\<exists>BL \<in> Bot_FL. BL \<in> lnth Ns i)"
 proof -
   note lhd_is = lhd_conv_lnth[OF chain_not_lnull[OF deriv]]
   have "\<exists>BL\<in>Bot_FL. BL \<in> Liminf_llist Ns"
     using assms by (rule gc_complete_Liminf)
   then show ?thesis
     unfolding Liminf_llist_def by auto
 qed
 
 end
 
 
 subsection \<open>Lazy Given Clause Procedure\<close>
 
 locale lazy_given_clause = given_clause_basis Bot_F Inf_F Bot_G Q entails_q Inf_G_q Red_I_q
   Red_F_q \<G>_F_q \<G>_I_q Inf_FL Equiv_F Prec_F Prec_L active
   for
     Bot_F :: "'f set" and
     Inf_F :: "'f inference set" and
     Bot_G :: "'g set" and
     Q :: "'q set" and
     entails_q :: "'q \<Rightarrow> 'g set \<Rightarrow> 'g set \<Rightarrow> bool" and
     Inf_G_q :: \<open>'q \<Rightarrow> 'g inference set\<close> and
     Red_I_q :: "'q \<Rightarrow> 'g set \<Rightarrow> 'g inference set" and
     Red_F_q :: "'q \<Rightarrow> 'g set \<Rightarrow> 'g set" and
     \<G>_F_q :: "'q \<Rightarrow> 'f \<Rightarrow> 'g set"  and
     \<G>_I_q :: "'q \<Rightarrow> 'f inference \<Rightarrow> 'g inference set option" and
     Inf_FL :: \<open>('f \<times> 'l) inference set\<close> and
     Equiv_F :: "'f \<Rightarrow> 'f \<Rightarrow> bool" (infix "\<doteq>" 50) and
     Prec_F :: "'f \<Rightarrow> 'f \<Rightarrow> bool" (infix "\<prec>\<cdot>" 50) and
     Prec_L :: "'l \<Rightarrow> 'l \<Rightarrow> bool" (infix "\<sqsubset>L" 50) and
     active :: 'l
 begin
 
 inductive step :: "'f inference set \<times> ('f \<times> 'l) set \<Rightarrow>
   'f inference set \<times> ('f \<times> 'l) set \<Rightarrow> bool" (infix "\<leadsto>LGC" 50) where
   process: "N1 = N \<union> M \<Longrightarrow> N2 = N \<union> M' \<Longrightarrow> M \<subseteq> Red_F (N \<union> M') \<Longrightarrow>
     active_subset M' = {} \<Longrightarrow> (T, N1) \<leadsto>LGC (T, N2)" |
   schedule_infer: "T2 = T1 \<union> T' \<Longrightarrow> N1 = N \<union> {(C, L)} \<Longrightarrow> N2 = N \<union> {(C, active)} \<Longrightarrow>
     L \<noteq> active \<Longrightarrow> T' = no_labels.Inf_between (fst ` (active_subset N)) {C} \<Longrightarrow>
     (T1, N1) \<leadsto>LGC (T2, N2)" |
   compute_infer: "T1 = T2 \<union> {\<iota>} \<Longrightarrow> N2 = N1 \<union> M \<Longrightarrow> active_subset M = {} \<Longrightarrow>
     \<iota> \<in> no_labels.Red_I (fst ` (N1 \<union> M)) \<Longrightarrow> (T1, N1) \<leadsto>LGC (T2, N2)" |
   delete_orphans: "T1 = T2 \<union> T' \<Longrightarrow>
     T' \<inter> no_labels.Inf_from (fst ` (active_subset N)) = {} \<Longrightarrow> (T1, N) \<leadsto>LGC (T2, N)"
 
 lemma premise_free_inf_always_from: "\<iota> \<in> Inf_F \<Longrightarrow> prems_of \<iota> = [] \<Longrightarrow> \<iota> \<in> no_labels.Inf_from N"
   unfolding no_labels.Inf_from_def by simp
 
 lemma one_step_equiv: "(T1, N1) \<leadsto>LGC (T2, N2) \<Longrightarrow> N1 \<rhd>L N2"
 proof (cases "(T1, N1)" "(T2, N2)" rule: step.cases)
   show "(T1, N1) \<leadsto>LGC (T2, N2) \<Longrightarrow> (T1, N1) \<leadsto>LGC (T2, N2)" by blast
 next
   fix N M M'
   assume
     n1_is: "N1 = N \<union> M" and
     n2_is: "N2 = N \<union> M'" and
     m_red: "M \<subseteq> Red_F (N \<union> M')"
   have "N1 - N2 \<subseteq> Red_F N2"
     using n1_is n2_is m_red by auto
   then show "N1 \<rhd>L N2"
     unfolding derive.simps by blast
 next
   fix N C L M
   assume
     n1_is: "N1 = N \<union> {(C, L)}" and
     not_active: "L \<noteq> active" and
     n2_is: "N2 = N \<union> {(C, active)}"
   have "(C, active) \<in> N2" using n2_is by auto
   moreover have "C \<preceq>\<cdot> C" by (metis equivp_def equiv_equiv_F)
   moreover have "active \<sqsubset>L L" using active_minimal[OF not_active] .
   ultimately have "{(C, L)} \<subseteq> Red_F N2"
     using red_labeled_clauses by blast
   then have "N1 - N2 \<subseteq> Red_F N2"
     using std_Red_F_eq using n1_is n2_is by blast
   then show "N1 \<rhd>L N2"
     unfolding derive.simps by blast
 next
   fix M
   assume
     n2_is: "N2 = N1 \<union> M"
   have "N1 - N2 \<subseteq> Red_F N2"
     using n2_is by blast
   then show "N1 \<rhd>L N2"
     unfolding derive.simps by blast
 next
   assume n2_is: "N2 = N1"
   have "N1 - N2 \<subseteq> Red_F N2"
     using n2_is by blast
   then show "N1 \<rhd>L N2"
     unfolding derive.simps by blast
 qed
 
 (* lem:lgc-derivations-are-red-derivations *)
 lemma lgc_to_red: "chain (\<leadsto>LGC) Ns \<Longrightarrow> chain (\<rhd>L) (lmap snd Ns)"
   using one_step_equiv Lazy_List_Chain.chain_mono by (smt chain_lmap prod.collapse)
 
 (* lem:fair-lgc-derivations *)
 lemma lgc_fair:
   assumes
     deriv: "chain (\<leadsto>LGC) Ns" and
     init_state: "active_subset (snd (lhd Ns)) = {}" and
     final_state: "passive_subset (Liminf_llist (lmap snd Ns)) = {}" and
     no_prems_init_active: "\<forall>\<iota> \<in> Inf_F. prems_of \<iota> = [] \<longrightarrow> \<iota> \<in> fst (lhd Ns)" and
     final_schedule: "Liminf_llist (lmap fst Ns) = {}"
   shows "fair (lmap snd Ns)"
   unfolding fair_def
 proof
   fix \<iota>
   assume i_in: "\<iota> \<in> Inf_from (Liminf_llist (lmap snd Ns))"
   note lhd_is = lhd_conv_lnth[OF chain_not_lnull[OF deriv]]
   have i_in_inf_fl: "\<iota> \<in> Inf_FL" using i_in unfolding Inf_from_def by blast
   have "Liminf_llist (lmap snd Ns) = active_subset (Liminf_llist (lmap snd Ns))"
     using final_state unfolding passive_subset_def active_subset_def by blast
   then have i_in2: "\<iota> \<in> Inf_from (active_subset (Liminf_llist (lmap snd Ns)))"
     using i_in by simp
   define m where "m = length (prems_of \<iota>)"
   then have m_def_F: "m = length (prems_of (to_F \<iota>))" unfolding to_F_def by simp
   have i_in_F: "to_F \<iota> \<in> Inf_F"
     using i_in Inf_FL_to_Inf_F unfolding Inf_from_def to_F_def by blast
   have exist_nj: "\<forall>j \<in> {0..<m}. (\<exists>nj. enat (Suc nj) < llength Ns \<and>
       prems_of \<iota> ! j \<notin> active_subset (snd (lnth Ns nj)) \<and>
       (\<forall>k. k > nj \<longrightarrow> enat k < llength Ns \<longrightarrow> prems_of \<iota> ! j \<in> active_subset (snd (lnth Ns k))))"
   proof clarify
     fix j
     assume j_in: "j \<in> {0..<m}"
     then obtain C where c_is: "(C, active) = prems_of \<iota> ! j"
       using i_in2 unfolding m_def Inf_from_def active_subset_def
       by (smt Collect_mem_eq Collect_mono_iff atLeastLessThan_iff nth_mem old.prod.exhaust snd_conv)
     then have "(C, active) \<in> Liminf_llist (lmap snd Ns)"
       using j_in i_in unfolding m_def Inf_from_def by force
     then obtain nj where nj_is: "enat nj < llength Ns" and
       c_in2: "(C, active) \<in> \<Inter> (snd ` (lnth Ns ` {k. nj \<le> k \<and> enat k < llength Ns}))"
       unfolding Liminf_llist_def using init_state by fastforce
     then have c_in3: "\<forall>k. k \<ge> nj \<longrightarrow> enat k < llength Ns \<longrightarrow> (C, active) \<in> snd (lnth Ns k)" by blast
     have nj_pos: "nj > 0" using init_state c_in2 nj_is unfolding active_subset_def lhd_is by fastforce
     obtain nj_min where nj_min_is: "nj_min = (LEAST nj. enat nj < llength Ns \<and>
         (C, active) \<in> \<Inter> (snd ` (lnth Ns ` {k. nj \<le> k \<and> enat k < llength Ns})))" by blast
     then have in_allk: "\<forall>k. k \<ge> nj_min \<longrightarrow> enat k < llength Ns \<longrightarrow> (C, active) \<in> snd (lnth Ns k)"
       using c_in3 nj_is c_in2 INT_E LeastI_ex
       by (smt INT_iff INT_simps(10) c_is image_eqI mem_Collect_eq)
     have njm_smaller_D: "enat nj_min < llength Ns"
       using nj_min_is
       by (smt LeastI_ex \<open>\<And>thesis. (\<And>nj. \<lbrakk>enat nj < llength Ns;
           (C, active) \<in> \<Inter> (snd ` (lnth Ns ` {k. nj \<le> k \<and> enat k < llength Ns}))\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>)
     have "nj_min > 0"
       using nj_is c_in2 nj_pos nj_min_is lhd_is
       by (metis (mono_tags, lifting) active_subset_def emptyE in_allk init_state mem_Collect_eq
           not_less snd_conv zero_enat_def chain_length_pos[OF deriv])
     then obtain njm_prec where nj_prec_is: "Suc njm_prec = nj_min" using gr0_conv_Suc by auto
     then have njm_prec_njm: "njm_prec < nj_min" by blast
     then have njm_prec_njm_enat: "enat njm_prec < enat nj_min" by simp
     have njm_prec_smaller_d: "njm_prec < llength Ns"
-      using HOL.no_atp(15)[OF njm_smaller_D njm_prec_njm_enat] .
+      by (rule less_trans[OF njm_prec_njm_enat njm_smaller_D])
     have njm_prec_all_suc: "\<forall>k>njm_prec. enat k < llength Ns \<longrightarrow> (C, active) \<in> snd (lnth Ns k)"
       using nj_prec_is in_allk by simp
     have notin_njm_prec: "(C, active) \<notin> snd (lnth Ns njm_prec)"
     proof (rule ccontr)
       assume "\<not> (C, active) \<notin> snd (lnth Ns njm_prec)"
       then have absurd_hyp: "(C, active) \<in> snd (lnth Ns njm_prec)" by simp
       have prec_smaller: "enat njm_prec < llength Ns" using nj_min_is nj_prec_is
         by (smt LeastI_ex Suc_leD \<open>\<And>thesis. (\<And>nj. \<lbrakk>enat nj < llength Ns;
             (C, active) \<in> \<Inter> (snd ` (lnth Ns ` {k. nj \<le> k \<and> enat k < llength Ns}))\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
             enat_ord_simps(1) le_eq_less_or_eq le_less_trans)
       have "(C, active) \<in> \<Inter> (snd ` (lnth Ns ` {k. njm_prec \<le> k \<and> enat k < llength Ns}))"
       proof -
         {
           fix k
           assume k_in: "njm_prec \<le> k \<and> enat k < llength Ns"
           have "k = njm_prec \<Longrightarrow> (C, active) \<in> snd (lnth Ns k)" using absurd_hyp by simp
           moreover have "njm_prec < k \<Longrightarrow> (C, active) \<in> snd (lnth Ns k)"
             using nj_prec_is in_allk k_in by simp
           ultimately have "(C, active) \<in> snd (lnth Ns k)" using k_in by fastforce
         }
         then show "(C, active) \<in> \<Inter> (snd ` (lnth Ns ` {k. njm_prec \<le> k \<and> enat k < llength Ns}))"
           by blast
       qed
       then have "enat njm_prec < llength Ns \<and>
           (C, active) \<in> \<Inter> (snd ` (lnth Ns ` {k. njm_prec \<le> k \<and> enat k < llength Ns}))"
         using prec_smaller by blast
       then show False
         using nj_min_is nj_prec_is Orderings.wellorder_class.not_less_Least njm_prec_njm by blast
     qed
     then have notin_active_subs_njm_prec: "(C, active) \<notin> active_subset (snd (lnth Ns njm_prec))"
       unfolding active_subset_def by blast
     then show "\<exists>nj. enat (Suc nj) < llength Ns \<and> prems_of \<iota> ! j \<notin> active_subset (snd (lnth Ns nj)) \<and>
         (\<forall>k. k > nj \<longrightarrow> enat k < llength Ns \<longrightarrow> prems_of \<iota> ! j \<in> active_subset (snd (lnth Ns k)))"
       using c_is njm_prec_all_suc njm_prec_smaller_d by (metis (mono_tags, lifting)
           active_subset_def mem_Collect_eq nj_prec_is njm_smaller_D snd_conv)
   qed
   define nj_set where "nj_set = {nj. (\<exists>j\<in>{0..<m}. enat (Suc nj) < llength Ns \<and>
       prems_of \<iota> ! j \<notin> active_subset (snd (lnth Ns nj)) \<and>
       (\<forall>k. k > nj \<longrightarrow> enat k < llength Ns \<longrightarrow> prems_of \<iota> ! j \<in> active_subset (snd (lnth Ns k))))}"
   {
     assume m_null: "m = 0"
     then have "enat 0 < llength Ns \<and> to_F \<iota> \<in> fst (lhd Ns)"
       using no_prems_init_active i_in_F m_def_F zero_enat_def chain_length_pos[OF deriv] by auto
     then have "\<exists>n. enat n < llength Ns \<and> to_F \<iota> \<in> fst (lnth Ns n)"
       unfolding lhd_is by blast
   }
   moreover {
     assume m_pos: "m > 0"
     have nj_not_empty: "nj_set \<noteq> {}"
     proof -
       have zero_in: "0 \<in> {0..<m}" using m_pos by simp
       then obtain n0 where "enat (Suc n0) < llength Ns" and
         "prems_of \<iota> ! 0 \<notin> active_subset (snd (lnth Ns n0))" and
         "\<forall>k>n0. enat k < llength Ns \<longrightarrow> prems_of \<iota> ! 0 \<in> active_subset (snd (lnth Ns k))"
         using exist_nj by fast
       then have "n0 \<in> nj_set" unfolding nj_set_def using zero_in by blast
       then show "nj_set \<noteq> {}" by auto
     qed
     have nj_finite: "finite nj_set"
       using all_ex_finite_set[OF exist_nj] by (metis (no_types, lifting) Suc_ile_eq
           dual_order.strict_implies_order linorder_neqE_nat nj_set_def)
     have "\<exists>n \<in> nj_set. \<forall>nj \<in> nj_set. nj \<le> n"
       using nj_not_empty nj_finite using Max_ge Max_in by blast
     then obtain n where n_in: "n \<in> nj_set" and n_bigger: "\<forall>nj \<in> nj_set. nj \<le> n" by blast
     then obtain j0 where j0_in: "j0 \<in> {0..<m}" and suc_n_length: "enat (Suc n) < llength Ns" and
       j0_notin: "prems_of \<iota> ! j0 \<notin> active_subset (snd (lnth Ns n))" and
       j0_allin: "(\<forall>k. k > n \<longrightarrow> enat k < llength Ns \<longrightarrow>
           prems_of \<iota> ! j0 \<in> active_subset (snd (lnth Ns k)))"
       unfolding nj_set_def by blast
     obtain C0 where C0_is: "prems_of \<iota> ! j0 = (C0, active)"
       using j0_in i_in2 unfolding m_def Inf_from_def active_subset_def
       by (smt Collect_mem_eq Collect_mono_iff atLeastLessThan_iff nth_mem old.prod.exhaust snd_conv)
     then have C0_prems_i: "(C0, active) \<in> set (prems_of \<iota>)" using in_set_conv_nth j0_in m_def by force
     have C0_in: "(C0, active) \<in> (snd (lnth Ns (Suc n)))"
       using C0_is j0_allin suc_n_length by (simp add: active_subset_def)
     have C0_notin: "(C0, active) \<notin> (snd (lnth Ns n))"
       using C0_is j0_notin unfolding active_subset_def by simp
     have step_n: "lnth Ns n \<leadsto>LGC lnth Ns (Suc n)"
       using deriv chain_lnth_rel n_in unfolding nj_set_def by blast
     have is_scheduled: "\<exists>T2 T1 T' N1 N C L N2. lnth Ns n = (T1, N1) \<and> lnth Ns (Suc n) = (T2, N2) \<and>
         T2 = T1 \<union> T' \<and> N1 = N \<union> {(C, L)} \<and> N2 = N \<union> {(C, active)} \<and> L \<noteq> active \<and>
         T' = no_labels.Inf_between (fst ` active_subset N) {C}"
       using step.simps[of "lnth Ns n" "lnth Ns (Suc n)"] step_n C0_in C0_notin
       unfolding active_subset_def by fastforce
     then obtain T2 T1 T' N1 N L N2 where nth_d_is: "lnth Ns n = (T1, N1)" and
       suc_nth_d_is: "lnth Ns (Suc n) = (T2, N2)" and t2_is: "T2 = T1 \<union> T'" and
       n1_is: "N1 = N \<union> {(C0, L)}" "N2 = N \<union> {(C0, active)}" and
       l_not_active: "L \<noteq> active" and
       tp_is: "T' = no_labels.Inf_between (fst ` active_subset N) {C0}"
       using C0_in C0_notin j0_in C0_is using active_subset_def by fastforce
     have "j \<in> {0..<m} \<Longrightarrow> prems_of \<iota> ! j \<noteq> prems_of \<iota> ! j0 \<Longrightarrow> prems_of \<iota> ! j \<in> (active_subset N)"
       for j
     proof -
       fix j
       assume j_in: "j \<in> {0..<m}" and
         j_not_j0: "prems_of \<iota> ! j \<noteq> prems_of \<iota> ! j0"
       obtain nj where nj_len: "enat (Suc nj) < llength Ns" and
         nj_prems: "prems_of \<iota> ! j \<notin> active_subset (snd (lnth Ns nj))" and
         nj_greater: "(\<forall>k. k > nj \<longrightarrow> enat k < llength Ns \<longrightarrow>
             prems_of \<iota> ! j \<in> active_subset (snd (lnth Ns k)))"
         using exist_nj j_in by blast
       then have "nj \<in> nj_set" unfolding nj_set_def using j_in by blast
       moreover have "nj \<noteq> n"
       proof (rule ccontr)
         assume "\<not> nj \<noteq> n"
         then have "prems_of \<iota> ! j = (C0, active)"
           using C0_in C0_notin step.simps[of "lnth Ns n" "lnth Ns (Suc n)"] step_n
             active_subset_def is_scheduled nj_greater nj_prems suc_n_length by auto
         then show False using j_not_j0 C0_is by simp
       qed
       ultimately have "nj < n" using n_bigger by force
       then have "prems_of \<iota> ! j \<in> (active_subset (snd (lnth Ns n)))"
         using nj_greater n_in Suc_ile_eq dual_order.strict_implies_order
         unfolding nj_set_def by blast
       then show "prems_of \<iota> ! j \<in> (active_subset N)"
         using nth_d_is l_not_active n1_is unfolding active_subset_def by force
     qed
     then have prems_i_active: "set (prems_of \<iota>) \<subseteq> active_subset N \<union> {(C0, active)}"
       using C0_prems_i C0_is m_def
       by (metis Un_iff atLeast0LessThan in_set_conv_nth insertCI lessThan_iff subrelI)
     moreover have "\<not> (set (prems_of \<iota>) \<subseteq> active_subset N - {(C0, active)})" using C0_prems_i by blast
     ultimately have "\<iota> \<in> Inf_between (active_subset N) {(C0, active)}"
       using i_in_inf_fl prems_i_active unfolding Inf_between_def Inf_from_def by blast
     then have "to_F \<iota> \<in> no_labels.Inf_between (fst ` (active_subset N)) {C0}"
       unfolding to_F_def Inf_between_def Inf_from_def
         no_labels.Inf_between_def no_labels.Inf_from_def
       using Inf_FL_to_Inf_F by force
     then have i_in_t2: "to_F \<iota> \<in> T2" using tp_is t2_is by simp
     have "j \<in> {0..<m} \<Longrightarrow> (\<forall>k. k > n \<longrightarrow> enat k < llength Ns \<longrightarrow>
         prems_of \<iota> ! j \<in> active_subset (snd (lnth Ns k)))" for j
     proof (cases "j = j0")
       case True
       assume "j = j0"
       then show "(\<forall>k. k > n \<longrightarrow> enat k < llength Ns \<longrightarrow>
           prems_of \<iota> ! j \<in> active_subset (snd (lnth Ns k)))" using j0_allin by simp
     next
       case False
       assume j_in: "j \<in> {0..<m}" and
         "j \<noteq> j0"
       obtain nj where nj_len: "enat (Suc nj) < llength Ns" and
         nj_prems: "prems_of \<iota> ! j \<notin> active_subset (snd (lnth Ns nj))" and
         nj_greater: "(\<forall>k. k > nj \<longrightarrow> enat k < llength Ns \<longrightarrow>
             prems_of \<iota> ! j \<in> active_subset (snd (lnth Ns k)))"
         using exist_nj j_in by blast
       then have "nj \<in> nj_set" unfolding nj_set_def using j_in by blast
       then show "(\<forall>k. k > n \<longrightarrow> enat k < llength Ns \<longrightarrow>
           prems_of \<iota> ! j \<in> active_subset (snd (lnth Ns k)))"
         using nj_greater n_bigger by auto
     qed
     then have allj_allk: "(\<forall>c\<in> set (prems_of \<iota>). (\<forall>k. k > n \<longrightarrow> enat k < llength Ns \<longrightarrow>
         c \<in> active_subset (snd (lnth Ns k))))"
       using m_def by (metis atLeast0LessThan in_set_conv_nth lessThan_iff)
     have "\<forall>c\<in> set (prems_of \<iota>). snd c = active"
       using prems_i_active unfolding active_subset_def by auto
     then have ex_n_i_in: "\<exists>n. enat (Suc n) < llength Ns \<and> to_F \<iota> \<in> fst (lnth Ns (Suc n)) \<and>
         (\<forall>c\<in> set (prems_of \<iota>). snd c = active) \<and>
         (\<forall>c\<in> set (prems_of \<iota>). (\<forall>k. k > n \<longrightarrow> enat k < llength Ns \<longrightarrow>
           c \<in> active_subset (snd (lnth Ns k))))"
       using allj_allk i_in_t2 suc_nth_d_is fstI n_in nj_set_def
       by auto
     then have "\<exists>n. enat n < llength Ns \<and> to_F \<iota> \<in> fst (lnth Ns n) \<and>
         (\<forall>c\<in> set (prems_of \<iota>). snd c = active) \<and> (\<forall>c\<in> set (prems_of \<iota>). (\<forall>k. k \<ge> n \<longrightarrow>
           enat k < llength Ns \<longrightarrow> c \<in> active_subset (snd (lnth Ns k))))"
       by auto
   }
   ultimately obtain n T2 N2 where i_in_suc_n: "to_F \<iota> \<in> fst (lnth Ns n)" and
     all_prems_active_after: "m > 0 \<Longrightarrow> (\<forall>c\<in> set (prems_of \<iota>). (\<forall>k. k \<ge> n \<longrightarrow> enat k < llength Ns \<longrightarrow>
                   c \<in> active_subset (snd (lnth Ns k))))" and
     suc_n_length: "enat n < llength Ns" and suc_nth_d_is: "lnth Ns n = (T2, N2)"
     by (metis less_antisym old.prod.exhaust zero_less_Suc)
   then have i_in_t2: "to_F \<iota> \<in> T2" by simp
   have "\<exists>p\<ge>n. enat (Suc p) < llength Ns \<and> to_F \<iota> \<in> (fst (lnth Ns p)) \<and> to_F \<iota> \<notin> (fst (lnth Ns (Suc p)))"
   proof (rule ccontr)
     assume
       contra: "\<not> (\<exists>p\<ge>n. enat (Suc p) < llength Ns \<and> to_F \<iota> \<in> (fst (lnth Ns p)) \<and>
                      to_F \<iota> \<notin> (fst (lnth Ns (Suc p))))"
     then have i_in_suc: "p0 \<ge> n \<Longrightarrow> enat (Suc p0) < llength Ns \<Longrightarrow> to_F \<iota> \<in> (fst (lnth Ns p0)) \<Longrightarrow>
         to_F \<iota> \<in> (fst (lnth Ns (Suc p0)))" for p0
       by blast
     have "p0 \<ge> n \<Longrightarrow> enat p0 < llength Ns \<Longrightarrow> to_F \<iota> \<in> (fst (lnth Ns p0))" for p0
     proof (induction rule: nat_induct_at_least)
       case base
       then show ?case using i_in_t2 suc_nth_d_is
         by simp
     next
       case (Suc p0)
       assume p_bigger_n: "n \<le> p0" and
         induct_hyp: "enat p0 < llength Ns \<Longrightarrow> to_F \<iota> \<in> fst (lnth Ns p0)" and
         sucsuc_smaller_d: "enat (Suc p0) < llength Ns"
       have suc_p_bigger_n: "n \<le> p0" using p_bigger_n by simp
       have suc_smaller_d: "enat p0 < llength Ns"
         using sucsuc_smaller_d Suc_ile_eq dual_order.strict_implies_order by blast
       then have "to_F \<iota> \<in> fst (lnth Ns p0)" using induct_hyp by blast
       then show ?case using i_in_suc[OF suc_p_bigger_n sucsuc_smaller_d] by blast
     qed
     then have i_in_all_bigger_n: "\<forall>j. j \<ge> n \<and> enat j < llength Ns \<longrightarrow> to_F \<iota> \<in> (fst (lnth Ns j))"
       by presburger
     have "llength (lmap fst Ns) = llength Ns" by force
     then have "to_F \<iota> \<in> \<Inter> (lnth (lmap fst Ns) ` {j. n \<le> j \<and> enat j < llength (lmap fst Ns)})"
       using i_in_all_bigger_n using Suc_le_D by auto
     then have "to_F \<iota> \<in> Liminf_llist (lmap fst Ns)"
       unfolding Liminf_llist_def using suc_n_length by auto
     then show False using final_schedule by fast
   qed
   then obtain p where p_greater_n: "p \<ge> n" and p_smaller_d: "enat (Suc p) < llength Ns" and
     i_in_p: "to_F \<iota> \<in> (fst (lnth Ns p))" and i_notin_suc_p: "to_F \<iota> \<notin> (fst (lnth Ns (Suc p)))"
     by blast
   have p_neq_n: "Suc p \<noteq> n" using i_notin_suc_p i_in_suc_n by blast
   have step_p: "lnth Ns p \<leadsto>LGC lnth Ns (Suc p)" using deriv p_smaller_d chain_lnth_rel by blast
   then have "\<exists>T1 T2 \<iota> N2 N1 M. lnth Ns p = (T1, N1) \<and> lnth Ns (Suc p) = (T2, N2) \<and>
       T1 = T2 \<union> {\<iota>} \<and> N2 = N1 \<union> M \<and> active_subset M = {} \<and>
       \<iota> \<in> no_labels.Red_I_\<G> (fst ` (N1 \<union> M))"
   proof -
     have ci_or_do: "(\<exists>T1 T2 \<iota> N2 N1 M. lnth Ns p = (T1, N1) \<and> lnth Ns (Suc p) = (T2, N2) \<and>
         T1 = T2 \<union> {\<iota>} \<and> N2 = N1 \<union> M \<and> active_subset M = {} \<and>
         \<iota> \<in> no_labels.Red_I_\<G> (fst ` (N1 \<union> M))) \<or>
         (\<exists>T1 T2 T' N. lnth Ns p = (T1, N) \<and> lnth Ns (Suc p) = (T2, N) \<and>
         T1 = T2 \<union> T' \<and> T' \<inter> no_labels.Inf_from (fst ` active_subset N) = {})"
       using step.simps[of "lnth Ns p" "lnth Ns (Suc p)"] step_p i_in_p i_notin_suc_p by fastforce
     then have p_greater_n_strict: "n < Suc p"
       using suc_nth_d_is p_greater_n i_in_t2 i_notin_suc_p le_eq_less_or_eq by force
     have "m > 0 \<Longrightarrow> j \<in> {0..<m} \<Longrightarrow> prems_of (to_F \<iota>) ! j \<in> fst ` active_subset (snd (lnth Ns p))"
       for j
     proof -
       fix j
       assume
         m_pos: "m > 0" and
         j_in: "j \<in> {0..<m}"
       then have "prems_of \<iota> ! j \<in> (active_subset (snd (lnth Ns p)))"
         using all_prems_active_after[OF m_pos] p_smaller_d m_def p_greater_n p_neq_n
         by (meson Suc_ile_eq atLeastLessThan_iff dual_order.strict_implies_order nth_mem
             p_greater_n_strict)
       then have "fst (prems_of \<iota> ! j) \<in> fst ` active_subset (snd (lnth Ns p))"
         by blast
       then show "prems_of (to_F \<iota>) ! j \<in> fst ` active_subset (snd (lnth Ns p))"
         unfolding to_F_def using j_in m_def by simp
     qed
     then have prems_i_active_p: "m > 0 \<Longrightarrow>
         to_F \<iota> \<in> no_labels.Inf_from (fst ` active_subset (snd (lnth Ns p)))"
       using i_in_F unfolding no_labels.Inf_from_def
       by (smt atLeast0LessThan in_set_conv_nth lessThan_iff m_def_F mem_Collect_eq subsetI)
     have "m = 0 \<Longrightarrow> (\<exists>T1 T2 \<iota> N2 N1 M. lnth Ns p = (T1, N1) \<and> lnth Ns (Suc p) = (T2, N2) \<and>
         T1 = T2 \<union> {\<iota>} \<and> N2 = N1 \<union> M \<and> active_subset M = {} \<and>
         \<iota> \<in> no_labels.Red_I_\<G> (fst ` (N1 \<union> M)))"
       using ci_or_do premise_free_inf_always_from[of "to_F \<iota>" "fst ` active_subset _", OF i_in_F]
         m_def i_in_p i_notin_suc_p m_def_F by auto
     then show "(\<exists>T1 T2 \<iota> N2 N1 M. lnth Ns p = (T1, N1) \<and> lnth Ns (Suc p) = (T2, N2) \<and>
         T1 = T2 \<union> {\<iota>} \<and> N2 = N1 \<union> M \<and> active_subset M = {} \<and>
         \<iota> \<in> no_labels.Red_I_\<G> (fst ` (N1 \<union> M)))"
       using ci_or_do i_in_p i_notin_suc_p prems_i_active_p unfolding active_subset_def by force
   qed
   then obtain T1p T2p N1p N2p Mp where  "lnth Ns p = (T1p, N1p)" and
     suc_p_is: "lnth Ns (Suc p) = (T2p, N2p)" and "T1p = T2p \<union> {to_F \<iota>}" and "T2p \<inter> {to_F \<iota>} = {}" and
     n2p_is: "N2p = N1p \<union> Mp"and "active_subset Mp = {}" and
     i_in_red_inf: "to_F \<iota> \<in> no_labels.Red_I_\<G>
         (fst ` (N1p \<union> Mp))"
     using i_in_p i_notin_suc_p by fastforce
   have "to_F \<iota> \<in> no_labels.Red_I (fst ` (snd (lnth Ns (Suc p))))"
     using i_in_red_inf suc_p_is n2p_is by fastforce
   then have "\<forall>q \<in> Q. (\<G>_I_q q (to_F \<iota>) \<noteq> None \<and>
       the (\<G>_I_q q (to_F \<iota>)) \<subseteq> Red_I_q q (\<Union> (\<G>_F_q q ` fst ` snd (lnth Ns (Suc p)))))
       \<or> (\<G>_I_q q (to_F \<iota>) = None \<and>
       \<G>_F_q q (concl_of (to_F \<iota>)) \<subseteq> \<Union> (\<G>_F_q q ` fst ` snd (lnth Ns (Suc p))) \<union>
         Red_F_q q (\<Union> (\<G>_F_q q ` fst ` snd (lnth Ns (Suc p)))))"
     unfolding to_F_def no_labels.Red_I_def no_labels.Red_I_\<G>_q_def by blast
   then have "\<iota> \<in> Red_I_\<G> (snd (lnth Ns (Suc p)))"
     using i_in_inf_fl unfolding Red_I_\<G>_def Red_I_\<G>_q_def by (simp add: to_F_def)
   then show "\<iota> \<in> Sup_llist (lmap Red_I_\<G> (lmap snd Ns))"
     unfolding Sup_llist_def using suc_n_length p_smaller_d by auto
 qed
 
 theorem lgc_complete_Liminf:
   assumes
     deriv: "chain (\<leadsto>LGC) Ns" and
     init_state: "active_subset (snd (lhd Ns)) = {}" and
     final_state: "passive_subset (Liminf_llist (lmap snd Ns)) = {}" and
     no_prems_init_active: "\<forall>\<iota> \<in> Inf_F. prems_of \<iota> = [] \<longrightarrow> \<iota> \<in> fst (lhd Ns)" and
     final_schedule: "Liminf_llist (lmap fst Ns) = {}" and
     b_in: "B \<in> Bot_F" and
     bot_entailed: "no_labels.entails_\<G> (fst ` snd (lhd Ns)) {B}"
   shows "\<exists>BL \<in> Bot_FL. BL \<in> Liminf_llist (lmap snd Ns)"
 proof -
   have labeled_b_in: "(B, active) \<in> Bot_FL" using b_in by simp
   have simp_snd_lmap: "lhd (lmap snd Ns) = snd (lhd Ns)"
     by (rule llist.map_sel(1)[OF chain_not_lnull[OF deriv]])
   have labeled_bot_entailed: "entails_\<G>_L (snd (lhd Ns)) {(B, active)}"
     using labeled_entailment_lifting bot_entailed by fastforce
   have "fair (lmap snd Ns)"
     using lgc_fair[OF deriv init_state final_state no_prems_init_active final_schedule] .
   then show ?thesis
     using dynamically_complete_Liminf labeled_b_in lgc_to_red[OF deriv]
       labeled_bot_entailed simp_snd_lmap std_Red_I_eq
     by presburger
 qed
 
 (* thm:lgc-completeness *)
 theorem lgc_complete:
   assumes
     deriv: "chain (\<leadsto>LGC) Ns" and
     init_state: "active_subset (snd (lhd Ns)) = {}" and
     final_state: "passive_subset (Liminf_llist (lmap snd Ns)) = {}" and
     no_prems_init_active: "\<forall>\<iota> \<in> Inf_F. prems_of \<iota> = [] \<longrightarrow> \<iota> \<in> fst (lhd Ns)" and
     final_schedule: "Liminf_llist (lmap fst Ns) = {}" and
     b_in: "B \<in> Bot_F" and
     bot_entailed: "no_labels.entails_\<G> (fst ` snd (lhd Ns)) {B}"
   shows "\<exists>i. enat i < llength Ns \<and> (\<exists>BL \<in> Bot_FL. BL \<in> snd (lnth Ns i))"
 proof -
   have "\<exists>BL\<in>Bot_FL. BL \<in> Liminf_llist (lmap snd Ns)"
     using assms by (rule lgc_complete_Liminf)
   then show ?thesis
     unfolding Liminf_llist_def by auto
 qed
 
 end
 
 end
diff --git a/thys/Virtual_Substitution/OptimizationProofs.thy b/thys/Virtual_Substitution/OptimizationProofs.thy
--- a/thys/Virtual_Substitution/OptimizationProofs.thy
+++ b/thys/Virtual_Substitution/OptimizationProofs.thy
@@ -1,702 +1,702 @@
 subsection "Optimization Proofs"
 theory OptimizationProofs
   imports Optimizations
 begin
 
 lemma neg_nnf : "\<forall>\<Gamma>. (\<not> eval (nnf (Neg \<phi>)) \<Gamma>) = eval (nnf \<phi>) \<Gamma>"
   apply(induction \<phi>)
            apply(simp_all)
   using aNeg_aEval apply blast
   using aNeg_aEval by blast
 
 theorem eval_nnf : "\<forall>\<Gamma>. eval \<phi> \<Gamma> = eval (nnf \<phi>) \<Gamma>"
   apply(induction \<phi>)apply(simp_all) using neg_nnf by blast
 
 
 theorem negation_free_nnf : "negation_free (nnf \<phi>)"
 proof(induction "depth \<phi>" arbitrary : \<phi> rule: nat_less_induct )
   case 1
   then show ?case
   proof(induction \<phi>)
     case (And \<phi>1 \<phi>2)
     then show ?case apply simp
       by (metis less_Suc_eq_le max.cobounded1 max.cobounded2)
   next
     case (Or \<phi>1 \<phi>2)
     then show ?case apply simp
       by (metis less_Suc_eq_le max.cobounded1 max.cobounded2)
   next
     case (Neg \<phi>)
     then show ?case proof (induction \<phi>)
       case (And \<phi>1 \<phi>2)
       then show ?case apply simp
         by (metis less_Suc_eq max_less_iff_conj not_less_eq)
     next
       case (Or \<phi>1 \<phi>2)
       then show ?case apply simp
         by (metis less_Suc_eq max_less_iff_conj not_less_eq)
     next
       case (Neg \<phi>)
       then show ?case
         by (metis Suc_eq_plus1 add_lessD1 depth.simps(6) lessI nnf.simps(12))
     qed auto
   qed auto
 qed
 
 
 lemma groupQuantifiers_eval : "eval F L = eval (groupQuantifiers F) L"
   apply(induction F arbitrary: L  rule:groupQuantifiers.induct) 
   unfolding doubleExist unwrapExist unwrapExist' unwrapExist'' doubleForall unwrapForall unwrapForall' unwrapForall''
   apply (auto)
   using doubleExist doubleExist unwrapExist unwrapExist' unwrapExist'' doubleForall unwrapForall unwrapForall' unwrapForall''  apply auto
   by metis+
 
 
 theorem simp_atom_eval : "aEval a xs = eval (simp_atom a) xs"
 proof(cases a)
   case (Less p)
   then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion)
 next
   case (Eq p)
   then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion)
 next
   case (Leq p)
   then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion)
 next
   case (Neq p)
   then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion)
 qed
 
 lemma simpfm_eval : "\<forall>L. eval \<phi> L = eval (simpfm \<phi>) L"
   apply(induction \<phi>)
   apply(simp_all add: simp_atom_eval eval_and eval_or)
   using eval_neg by blast
 
 lemma exQ_clearQuantifiers:
   assumes ExQ : "\<And>xs. eval (clearQuantifiers \<phi>) xs = eval \<phi> xs"
   shows "eval (clearQuantifiers (ExQ \<phi>)) xs = eval (ExQ \<phi>) xs"
 proof-
   define \<phi>' where "\<phi>' = clearQuantifiers \<phi>"
   have h : "freeIn 0 \<phi>' \<Longrightarrow> (eval (lowerFm 0 1 \<phi>') xs = eval (ExQ \<phi>') xs)"
     using eval_lowerFm by simp
   have "eval (clearQuantifiers (ExQ \<phi>)) xs = 
       eval (if freeIn 0 \<phi>' then lowerFm 0 1 \<phi>' else ExQ \<phi>') xs"
     using \<phi>'_def by simp
   also have "... = eval (ExQ \<phi>) xs"
     apply(cases "freeIn 0 \<phi>'")
     using h ExQ \<phi>'_def by(simp_all)
   finally show ?thesis
     by simp
 qed
 
 lemma allQ_clearQuantifiers :
   assumes AllQ : "\<And>xs. eval (clearQuantifiers \<phi>) xs = eval \<phi> xs"
   shows "eval (clearQuantifiers (AllQ \<phi>)) xs = eval (AllQ \<phi>) xs"
 proof-
   define \<phi>' where "\<phi>' = clearQuantifiers \<phi>"
   have "freeIn 0 \<phi>' \<Longrightarrow> (eval (ExQ \<phi>') xs) = eval (AllQ \<phi>') xs"
     by (simp add: var_not_in_eval2)
   then have h : "freeIn 0 \<phi>' \<Longrightarrow> (eval (lowerFm 0 1 \<phi>') xs = eval (AllQ \<phi>') xs)"
     using eval_lowerFm by simp
   have "eval (clearQuantifiers (AllQ \<phi>)) xs = 
       eval (if freeIn 0 \<phi>' then lowerFm 0 1 \<phi>' else AllQ \<phi>') xs"
     using \<phi>'_def by simp
   also have "... = eval (AllQ \<phi>) xs"
     apply(cases "freeIn 0 \<phi>'")
     using h AllQ \<phi>'_def by(simp_all)
   finally show ?thesis 
     by simp
 qed
 
 lemma clearQuantifiers_eval : "eval (clearQuantifiers \<phi>) xs = eval \<phi> xs"
 proof(induction \<phi> arbitrary : xs)
   case (Atom x)
   then show ?case using simp_atom_eval by simp
 next
   case (And \<phi>1 \<phi>2)
   then show ?case using eval_and by simp
 next
   case (Or \<phi>1 \<phi>2)
   then show ?case using eval_or by simp
 next
   case (Neg \<phi>)
   then show ?case using eval_neg by auto
 next
   case (ExQ \<phi>)
   then show ?case using exQ_clearQuantifiers by simp
 next
   case (AllQ \<phi>)
   then show ?case using allQ_clearQuantifiers by simp
 next
   case (ExN x1 \<phi>)
   then show ?case proof(induction x1 arbitrary:\<phi>)
     case 0
     then show ?case by auto
   next
     case (Suc x1)
     show ?case
       using Suc(1)[of "ExQ \<phi>", OF exQ_clearQuantifiers[OF Suc(2)]]
       apply simp
       using Suc_eq_plus1 \<open>eval (clearQuantifiers (ExN x1 (ExQ \<phi>))) xs = eval (ExN x1 (ExQ \<phi>)) xs\<close> eval.simps(10) unwrapExist' by presburger
   qed
 next
   case (AllN x1 \<phi>)
   then show ?case proof(induction x1 arbitrary:\<phi>)
     case 0
     then show ?case by auto
   next
     case (Suc x1)
     show ?case
       using Suc(1)[of "AllQ \<phi>", OF allQ_clearQuantifiers[OF Suc(2)]]
       apply simp
       using unwrapForall' by force
   qed
 qed auto
 
 lemma  push_forall_eval_AllQ : "\<forall>xs. eval (AllQ \<phi>) xs = eval (push_forall (AllQ \<phi>)) xs"
 proof(induction \<phi>)
   case TrueF
   then show ?case by simp
 next
   case FalseF
   then show ?case by simp
 next
   case (Atom x)
   then show ?case
     using aEval_lowerAtom eval.simps(1) eval.simps(8) push_forall.simps(11) by presburger
 next
   case (And \<phi>1 \<phi>2)
   {fix xs
     have "eval (AllQ (And \<phi>1 \<phi>2)) xs = (\<forall>x. eval \<phi>1 (x#xs) \<and> eval \<phi>2 (x#xs))"
       by simp
     also have "... = ((\<forall>x. eval \<phi>1 (x#xs)) \<and> (\<forall>x. eval \<phi>2 (x#xs)))"
       by blast
     also have "... = eval (push_forall (AllQ (And \<phi>1 \<phi>2))) xs"
       using And eval_and by(simp)
     finally have "eval (AllQ (And \<phi>1 \<phi>2)) xs = eval (push_forall (AllQ (And \<phi>1 \<phi>2))) xs"
       by simp
   }
   then show ?case by simp 
 next
   case (Or \<phi>1 \<phi>2)
   then show ?case proof(cases "freeIn 0 \<phi>1")
     case True
     then have h : "freeIn 0 \<phi>1"
       by simp
     then show ?thesis proof(cases "freeIn 0 \<phi>2")
       case True
       {fix xs
         have "\<exists>x. eval \<phi>1 (x # xs) = eval (lowerFm 0 1 \<phi>1) xs"
           using eval_lowerFm h eval.simps(7) by blast 
         then have h1 : "\<forall>x. eval \<phi>1 (x # xs) = eval (lowerFm 0 1 \<phi>1) xs"
           using h var_not_in_eval2 by blast
         have "\<exists>x. eval \<phi>2 (x # xs) = eval (lowerFm 0 1 \<phi>2) xs"
           using eval_lowerFm True eval.simps(7) by blast 
         then have h2 : "\<forall>x. eval \<phi>2 (x # xs) = eval (lowerFm 0 1 \<phi>2) xs"
           using True var_not_in_eval2 by blast
         have "eval (AllQ (Or \<phi>1 \<phi>2)) xs = eval (push_forall (AllQ (Or \<phi>1 \<phi>2))) xs"
           by(simp add:h h1 h2 True eval_or)
       }
       then show ?thesis by simp
     next
       case False
       {fix xs
         have "\<exists>x. eval \<phi>1 (x # xs) = eval (lowerFm 0 1 \<phi>1) xs"
           using eval_lowerFm h eval.simps(7) by blast 
         then have "\<forall>x. eval \<phi>1 (x # xs) = eval (lowerFm 0 1 \<phi>1) xs"
           using True var_not_in_eval2 by blast
         then have "eval (AllQ (Or \<phi>1 \<phi>2)) xs = eval (push_forall (AllQ (Or \<phi>1 \<phi>2))) xs"
           by(simp add:h False eval_or)
       }
       then show ?thesis by simp
     qed
   next
     case False
     then have h : "\<not>freeIn 0 \<phi>1"
       by simp
     then show ?thesis proof(cases "freeIn 0 \<phi>2")
       case True
       {fix xs
         have "\<exists>x. eval \<phi>2 (x # xs) = eval (lowerFm 0 1 \<phi>2) xs"
           using eval_lowerFm True eval.simps(7) by blast 
         then have "\<forall>x. eval \<phi>2 (x # xs) = eval (lowerFm 0 1 \<phi>2) xs"
           using True var_not_in_eval2 by blast
         then have "eval (AllQ (Or \<phi>1 \<phi>2)) xs = eval (push_forall (AllQ (Or \<phi>1 \<phi>2))) xs"
           by(simp add:h True eval_or)
       }
       then show ?thesis by simp
     next
       case False
       then show ?thesis by(simp add:h False eval_or)
     qed
   qed
 next
   case (Neg \<phi>)
   {fix xs
     have "freeIn 0 (Neg \<phi>) \<Longrightarrow> (eval (ExQ (Neg \<phi>)) xs) = eval (AllQ (Neg \<phi>)) xs"
       using var_not_in_eval2 eval.simps(7) eval.simps(8) by blast
     then have h : "freeIn 0 (Neg \<phi>) \<Longrightarrow> (eval (lowerFm 0 1 (Neg \<phi>)) xs = eval (AllQ (Neg \<phi>)) xs)"
       using eval_lowerFm by blast
     have "eval (push_forall (AllQ (Neg \<phi>))) xs = 
       eval (if freeIn 0 (Neg \<phi>) then lowerFm 0 1 (Neg \<phi>) else AllQ (Neg \<phi>)) xs"
       by simp
     also have "... = eval (AllQ (Neg \<phi>)) xs"
       apply(cases "freeIn 0 (Neg \<phi>)")
       using h  by(simp_all)
     finally have "eval (push_forall (AllQ (Neg \<phi>))) xs = eval (AllQ (Neg \<phi>)) xs"
       by simp
   }
   then show ?case by simp
 next
   case (ExQ \<phi>)
   {fix xs
     have "freeIn 0 (ExQ \<phi>) \<Longrightarrow> (eval (ExQ (ExQ \<phi>)) xs) = eval (AllQ (ExQ \<phi>)) xs"
       using var_not_in_eval2 eval.simps(7) eval.simps(8) by blast
     then have h : "freeIn 0 (ExQ \<phi>) \<Longrightarrow> (eval (lowerFm 0 1 (ExQ \<phi>)) xs = eval (AllQ (ExQ \<phi>)) xs)"
       using eval_lowerFm by blast
     have "eval (push_forall (AllQ (ExQ \<phi>))) xs = 
       eval (if freeIn 0 (ExQ \<phi>) then lowerFm 0 1 (ExQ \<phi>) else AllQ (ExQ \<phi>)) xs"
       by simp
     also have "... = eval (AllQ (ExQ \<phi>)) xs"
       apply(cases "freeIn 0 (ExQ \<phi>)")
       using h  by(simp_all)
     finally have "eval (push_forall (AllQ (ExQ \<phi>))) xs = eval (AllQ (ExQ \<phi>)) xs"
       by simp
   }
   then show ?case by simp
 next
   case (AllQ \<phi>)
   {fix xs
     have "freeIn 0 (AllQ \<phi>) \<Longrightarrow> (eval (ExQ (AllQ \<phi>)) xs) = eval (AllQ (AllQ \<phi>)) xs"
       using var_not_in_eval2 eval.simps(7) eval.simps(8) by blast
     then have h : "freeIn 0 (AllQ \<phi>) \<Longrightarrow> (eval (lowerFm 0 1 (AllQ \<phi>)) xs = eval (AllQ (AllQ \<phi>)) xs)"
       using eval_lowerFm by blast
     have "eval (push_forall (AllQ (AllQ \<phi>))) xs = 
       eval (if freeIn 0 (AllQ \<phi>) then lowerFm 0 1 (AllQ \<phi>) else AllQ (AllQ \<phi>)) xs"
       by simp
     also have "... = eval (AllQ (AllQ \<phi>)) xs"
       apply(cases "freeIn 0 (AllQ \<phi>)")
       using h AllQ  by(simp_all)
     finally have "eval (push_forall (AllQ (AllQ \<phi>))) xs = eval (AllQ (AllQ \<phi>)) xs"
       by simp
   }
   then show ?case by simp
 next
   case (ExN x1 \<phi>)
   then show ?case
     using eval.simps(7) eval.simps(8) eval_lowerFm push_forall.simps(17) var_not_in_eval2 by presburger
 next
   case (AllN x1 \<phi>)
   then show ?case
     using eval.simps(7) eval.simps(8) eval_lowerFm push_forall.simps(18) var_not_in_eval2 by presburger
 qed
 
 lemma push_forall_eval : "\<forall>xs. eval \<phi> xs = eval (push_forall \<phi>) xs"
 proof(induction \<phi>)
   case (Atom x)
   then show ?case using simp_atom_eval by simp
 next
   case (And \<phi>1 \<phi>2)
   then show ?case using eval_and by auto
 next
   case (Or \<phi>1 \<phi>2)
   then show ?case using eval_or by auto
 next
   case (Neg \<phi>)
   then show ?case using eval_neg by auto
 next
   case (AllQ \<phi>)
   then show ?case using push_forall_eval_AllQ by blast 
 next
   case (ExN x1 \<phi>)
   then show ?case
     using eval.simps(10) push_forall.simps(7) by presburger
 qed auto
 
 lemma map_fm_binders_negation_free : 
   assumes "negation_free \<phi>"
   shows "negation_free (map_fm_binders f \<phi> n)"
   using assms apply(induction \<phi> arbitrary : n) by auto
 
 lemma negation_free_and : 
   assumes "negation_free \<phi>"
   assumes "negation_free \<psi>"
   shows "negation_free (and \<phi> \<psi>)"
   using assms unfolding and_def by simp 
 
 lemma negation_free_or : 
   assumes "negation_free \<phi>"
   assumes "negation_free \<psi>"
   shows "negation_free (or \<phi> \<psi>)"
   using assms unfolding or_def by simp 
 
 lemma push_forall_negation_free_all :
   assumes "negation_free \<phi>"
   shows "negation_free (push_forall (AllQ \<phi>))"
   using assms proof(induction \<phi>)
   case (And \<phi>1 \<phi>2)
   show ?case apply auto
     apply(rule negation_free_and)
     using And by auto
 next
   case (Or \<phi>1 \<phi>2)
   show ?case
     apply auto
     apply(rule negation_free_or)   
     using Or map_fm_binders_negation_free negation_free_or by auto
 next
   case (ExQ \<phi>)
   then show ?case using map_fm_binders_negation_free by auto
 next
   case (AllQ \<phi>)
   then show ?case using map_fm_binders_negation_free by auto
 next
   case (ExN x1 \<phi>)
   then show ?case using map_fm_binders_negation_free by auto
 next
   case (AllN x1 \<phi>)
   then show ?case using map_fm_binders_negation_free by auto
 qed auto
 
 lemma push_forall_negation_free : 
   assumes "negation_free \<phi>"  
   shows "negation_free(push_forall \<phi>)"
   using assms proof(induction \<phi>)
   case (Atom A)
   then show ?case apply(cases A) by auto
 next
   case (And \<phi>1 \<phi>2)
   then show ?case by (auto simp add: and_def)
 next
   case (Or \<phi>1 \<phi>2)
   then show ?case by (auto simp add: or_def)
 next
   case (AllQ \<phi>)
   then show ?case using push_forall_negation_free_all by auto
 qed auto
 
 
 lemma to_list_insertion: "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)\<leftarrow>(to_list v p)]"
 proof-
   have h1 :  "insertion f p = insertion f (\<Sum>i\<le>MPoly_Type.degree p v. isolate_variable_sparse p v i * Var v ^ i)"
     using sum_over_zero by auto
   have h2 : "insertion f (Var v) = f v" by (auto simp: monomials_Var coeff_Var insertion_code)
   define d where "d = MPoly_Type.degree p v"
   define g where "g = (\<lambda>x. insertion f (isolate_variable_sparse p v x) * f v ^ x)"
   have h3 : "insertion f (isolate_variable_sparse p v d) * f v ^ d = g d" using g_def by auto
   show ?thesis unfolding h1
       insertion_sum' insertion_mult insertion_pow h2 apply auto unfolding d_def[symmetric] g_def[symmetric]
       h3  proof(induction d)
     case 0
     then show ?case by auto
   next
     case (Suc d)
     show ?case
       apply (auto simp add: Suc ) unfolding g_def by auto
   qed
 qed
 
 lemma to_list_p: "p = sum_list [term * (Var v) ^ i. (term,i)\<leftarrow>(to_list v p)]"
 proof-
   define d where "d = MPoly_Type.degree p v"
   have "(\<Sum>i\<le>MPoly_Type.degree p v. isolate_variable_sparse p v i * Var v ^ i) = (\<Sum>(term, i)\<leftarrow>to_list v p. term * Var v ^ i)"
     unfolding to_list.simps d_def[symmetric] apply(induction d) by auto
   then show ?thesis 
     using sum_over_zero[of p v]
     by auto
 qed
 
 
 fun chophelper :: "(real mpoly * nat) list \<Rightarrow> (real mpoly * nat) list \<Rightarrow> (real mpoly * nat) list * (real mpoly * nat) list" where
   "chophelper [] L = (L,[])"|
   "chophelper ((p,i)#L) R = (if p=0 then chophelper L (R @ [(p,i)]) else (R,(p,i)#L))"
 
 lemma preserve :
   assumes "(a,b)=chophelper L L'"
   shows "a@b=L'@L"
   using assms
 proof(induction L arbitrary : a b L')
   case Nil
   then show ?case using assms by auto
 next
   case (Cons A L)
   then show ?case proof(cases A)
     case (Pair p i)
     show ?thesis using Cons unfolding Pair apply(cases "p=0") by auto
   qed
 qed
 lemma compare : 
   assumes "(a,b)=chophelper L L'"
   shows "chop L = b"
   using assms
 proof(induction L arbitrary : a b L')
   case Nil
   then show ?case by auto
 next
   case (Cons A L)
   then show ?case proof(cases A)
     case (Pair p i)
     show ?thesis using Cons unfolding Pair apply(cases "p=0") by auto
   qed
 qed
 lemma allzero:
   assumes "\<forall>(p,i)\<in>set(L'). p=0"
   assumes "(a,b)=chophelper L L'"
   shows "\<forall>(p,i)\<in>set(a). p=0"
   using assms proof(induction L arbitrary : a b L')
   case Nil
   then show ?case by auto
 next
   case (Cons t L)
   then show ?case
   proof(cases t)
     case (Pair p i)
     show ?thesis proof(cases "p=0")
       case True
       have h1: "\<forall>x\<in>set (L' @ [(0, i)]). case x of (p, i) \<Rightarrow> p = 0"
         using Cons(2) by auto
       show ?thesis using Cons(1)[OF h1] Cons(3) True unfolding Pair by auto
     next
       case False
       then show ?thesis using Cons unfolding Pair by auto
     qed
   qed
 qed 
 
 lemma separate:
   assumes "(a,b)=chophelper (to_list v p) []"
   shows "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)\<leftarrow>a] + sum_list [insertion f term * (f v) ^ i. (term,i)\<leftarrow>b]"
   using to_list_insertion[of f p v]  preserve[OF assms, symmetric] unfolding List.append.left_neutral
   by (simp del: to_list.simps)
 
 lemma chopped : 
   assumes "(a,b)=chophelper (to_list v p) []"
   shows "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)\<leftarrow>b]"
 proof-
   have h1 : "\<forall>(p, i)\<in>set []. p = 0" by auto
   have "(\<Sum>(term, i)\<leftarrow>a. insertion f term * f v ^ i) = 0"
     using allzero[OF h1 assms] proof(induction a)
     case Nil
     then show ?case by auto
   next
     case (Cons a1 a2)
     then show ?case
       apply(cases a1) by simp
   qed 
   then show ?thesis using separate[OF assms, of f] by auto
 qed
 
 lemma insertion_chop : 
   shows "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)\<leftarrow>(chop (to_list v p))]" 
 proof(cases "chophelper (to_list v p) []")
   case (Pair a b)
   show ?thesis using chopped[OF Pair[symmetric], of f] unfolding compare[OF Pair[symmetric], symmetric] .
 qed
 
 lemma sorted : "sorted_wrt (\<lambda>(_,i).\<lambda>(_,i'). i<i') (to_list v p)"
 proof -
   define d  where "d = MPoly_Type.degree p v"
   show ?thesis unfolding to_list.simps d_def[symmetric] 
   proof(induction d)
     case 0
     then show ?case by auto
   next
     case (Suc d)
     have h : "(map (\<lambda>x. (isolate_variable_sparse p v x, x)) [0..<Suc d + 1]) = 
         (map (\<lambda>x. (isolate_variable_sparse p v x, x)) [0..<Suc d]) @ [(isolate_variable_sparse p v (Suc d), (Suc d))]"
       by auto
     show ?case
       unfolding sorted_wrt_append h
       using Suc
       by auto
   qed
 qed
 
 lemma sublist : "sublist (chop L) L"
 proof(induction L)
   case Nil
   then show ?case by auto
 next
   case (Cons a L)
   then show ?case proof(cases a)
     case (Pair a b)
     show ?thesis using Cons unfolding Pair apply auto
       by (simp add: sublist_Cons_right)
   qed
 qed
 
 
 
 lemma move_exp :
   assumes "(p',i)#L = (chop (to_list v p))"
   shows "insertion f p = sum_list [insertion f term * (f v) ^ (d-i). (term,d)\<leftarrow>(chop (to_list v p))] * (f v)^i" 
 proof-
   have h : "sorted_wrt (\<lambda>(_, i) (_, y). i < y) (chop (to_list v p))"
   proof-
     define L where "L = to_list v p"
     show ?thesis using sublist[of "to_list v p"] sorted[of v p] unfolding L_def[symmetric]
       by (metis sorted_wrt_append sublist_def)
   qed
   then have "\<forall>(term,d)\<in>set(chop (to_list v p)). d\<ge>i"
     unfolding assms[symmetric]  by fastforce
   then have simp : "\<forall>(term,d)\<in>set(chop(to_list v p)). f v ^ (d - i) * f v ^ i = f v ^ d"
-    unfolding HOL.no_atp(118) by(auto simp del: to_list.simps)
+    unfolding semiring_normalization_rules(26) by(auto simp del: to_list.simps)
   have "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)\<leftarrow>(chop (to_list v p))]" using insertion_chop[of f p v] .
   also have "...= (\<Sum>(term, d)\<leftarrow>chop (to_list v p). insertion f term * f v ^ (d-i) * f v ^ i)" 
     using simp
     by (smt Pair_inject case_prodE map_eq_conv mult.assoc split_cong) 
   also have "... =  (\<Sum>(term, d)\<leftarrow>chop (to_list v p). insertion f term * f v ^ (d - i)) * f v ^ i"
   proof-
     define d where "d = chop(to_list v p)"
     define a where "a = f v ^ i"
     define b where "b = (\<lambda>(term, d). insertion f term * f v ^ (d - i))"
     have h : "(\<Sum>(term, d)\<leftarrow>d. insertion f term * f v ^ (d - i) * a) = (\<Sum>(term, d)\<leftarrow>d. b (term,d) * a)"
       using b_def by auto
     show ?thesis unfolding d_def[symmetric] a_def[symmetric]  b_def[symmetric] h  apply(induction d) apply simp apply auto
       by (simp add: ring_class.ring_distribs(2))
   qed
   finally show ?thesis by auto
 qed
 
 lemma insert_Var_Zero : "insertion f (Var v) = f v"
   unfolding insertion_code monomials_Var apply auto
   unfolding coeff_Var by simp
 
 
 lemma decreasePower_insertion :
   assumes "decreasePower v p = (p',i)"
   shows "insertion f p = insertion f p'* (f v)^i"
 proof(cases "chop (to_list v p)")
   case Nil
   then show ?thesis
     using assms by auto
 next
   case (Cons a list)
   then show ?thesis
   proof(cases a)
     case (Pair coef i')
     have i'_def : "i'=i" using Cons assms Pair by auto
     have chop: "chop (to_list v p) = (coef, i) # list" using Cons assms unfolding i'_def Pair by auto
     have p'_def :  "p' = (\<Sum>(term, x)\<leftarrow>chop (to_list v p). term * Var v ^ (x - i))"
       using assms Cons Pair by auto 
     have p'_insertion : "insertion f p' = (\<Sum>(term, x)\<leftarrow>chop (to_list v p). insertion f term * f v ^ (x - i))"
     proof-
       define d where "d = chop (to_list v p)"
       have "insertion f p' = insertion f (\<Sum>(term, x)\<leftarrow>chop (to_list v p). term * Var v ^ (x - i))" using p'_def by auto
       also have "... = (\<Sum>(term, x)\<leftarrow>chop (to_list v p).  insertion f (term * Var v ^ (x - i)))" 
         unfolding d_def[symmetric] apply(induction d) apply simp apply(simp add:insertion_add) by auto
       also have "... = (\<Sum>(term, x)\<leftarrow>chop (to_list v p). insertion f term * f v ^ (x - i))" unfolding insertion_mult insertion_pow insert_Var_Zero by auto
       finally show ?thesis by auto
     qed
     have h : "(coef, i') # list = chop (to_list v p)"  using Cons unfolding Pair by auto
     show ?thesis unfolding p'_insertion
       using move_exp[OF h, of f] unfolding i'_def .
   qed
 qed 
 
 
 lemma unpower_eval: "eval (unpower v \<phi>) L = eval \<phi> L"
 proof(induction \<phi> arbitrary: v L)
   case TrueF
   then show ?case by auto
 next
   case FalseF
   then show ?case by auto
 next
   case (Atom At)
   then show ?case proof(cases At)
     case (Less p)
     obtain q i where h: "decreasePower v p = (q, i)"
       using prod.exhaust_sel by blast
     have p : "\<And>f. insertion f p = insertion f q* (f v)^i"
       using decreasePower_insertion[OF h] by auto
     show ?thesis
     proof(cases "i=0")
       case True
       then show ?thesis unfolding Less unpower.simps h  by auto
     next
       case False
       obtain x where x_def : "Suc x = i" using False
         using not0_implies_Suc by auto 
       have h1 : "i mod 2 = 0 \<Longrightarrow>
     (insertion (nth_default 0 L) q < 0 \<and>
      insertion (nth_default 0 L) (Var v) \<noteq> 0) =
     (insertion (nth_default 0 L) q * nth_default 0 L v ^ i < 0)"
       proof -
         assume "i mod 2 = 0"
         then have "\<forall>r. \<not> (r::real) ^ i < 0"
           by presburger
         then show ?thesis
           by (metis \<open>\<And>thesis. (\<And>x. Suc x = i \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> insert_Var_Zero linorder_neqE_linordered_idom mult_less_0_iff power_0_Suc power_eq_0_iff)
       qed
       show ?thesis unfolding Less unpower.simps h x_def[symmetric] apply simp
         unfolding x_def p apply(cases "i mod 2 = 0") using h1 apply simp_all
         by (smt insert_Var_Zero insertion_neg mod_Suc mod_eq_0D mult_less_0_iff nat.inject odd_power_less_zero power_0 power_Suc0_right power_eq_0_iff x_def zero_less_Suc zero_less_power)
     qed 
   next
     case (Eq p)
     obtain q i where h: "decreasePower v p = (q, i)"
       using prod.exhaust_sel by blast
     have p : "\<And>f. insertion f p = insertion f q* (f v)^i"
       using decreasePower_insertion[OF h] by auto
     show ?thesis unfolding Eq unpower.simps h apply simp apply(cases i) apply simp
       apply simp unfolding p apply simp
       by (metis insert_Var_Zero)
   next
     case (Leq p)
     obtain q i where h: "decreasePower v p = (q, i)"
       using prod.exhaust_sel by blast
     have p : "\<And>f. insertion f p = insertion f q* (f v)^i"
       using decreasePower_insertion[OF h] by auto
     show ?thesis
     proof(cases "i=0")
       case True
       then show ?thesis unfolding Leq unpower.simps h  by auto
     next
       case False
       obtain x where x_def : "Suc x = i" using False
         using not0_implies_Suc by auto 
       define a where "a = insertion (nth_default 0 L) q"
       define x' where "x' = nth_default 0 L v"
       show ?thesis unfolding Leq unpower.simps h x_def[symmetric] apply simp
         unfolding x_def p apply(cases "i mod 2 = 0") unfolding insert_Var_Zero insertion_mult insertion_pow insertion_neg apply simp_all
         unfolding a_def[symmetric] x'_def[symmetric]
       proof-
         assume "i mod 2 = 0"
         then have "x' ^ i \<ge>0"
           by (simp add: \<open>i mod 2 = 0\<close> even_iff_mod_2_eq_zero zero_le_even_power) 
         then show "(a \<le> 0 \<or> x' = 0) = (a * x' ^ i \<le> 0)"
           using Rings.ordered_semiring_0_class.mult_nonpos_nonneg[of a "x'^i"]
           apply auto
           unfolding Rings.linordered_ring_strict_class.mult_le_0_iff
           apply auto
           by (simp add: False power_0_left)
       next
         assume h:  "i mod 2 = Suc 0"
         show "(a = 0 \<or> a < 0 \<and> 0 \<le> x' \<or> 0 < a \<and> x' \<le> 0) = (a * x' ^ i \<le> 0)"
           using h
           by (smt even_iff_mod_2_eq_zero mult_less_cancel_right mult_neg_neg mult_nonneg_nonpos mult_pos_pos not_mod2_eq_Suc_0_eq_0 power_0_Suc x_def zero_le_power_eq zero_less_mult_pos2 zero_less_power)
       qed
     qed 
   next
     case (Neq p)
     obtain q i where h: "decreasePower v p = (q, i)"
       using prod.exhaust_sel by blast
     have p : "\<And>f. insertion f p = insertion f q* (f v)^i"
       using decreasePower_insertion[OF h] by auto
     show ?thesis unfolding Neq unpower.simps h apply simp apply(cases i) apply simp
       apply simp unfolding p apply simp
       by (metis insert_Var_Zero)
   qed
 qed auto
 
 lemma to_list_filter: "p = sum_list [term * (Var v) ^ i. (term,i)\<leftarrow>((filter (\<lambda>(x,_). x\<noteq>0) (to_list v p)))]"
 proof-
   define L where "L = to_list v p"
   have "(\<Sum>(term, i)\<leftarrow>to_list v p. term * Var v ^ i) = (\<Sum>(term, i)\<leftarrow>filter (\<lambda>(x, _). x \<noteq> 0) (to_list v p). term * Var v ^ i)"
     unfolding L_def[symmetric] apply(induction L) by auto
   then show ?thesis
     using to_list_p[of p v] by auto
 qed
 
 end
\ No newline at end of file