\<^marker>\<open>creator "Kevin Kappelmann"\<close>
paragraph \<open>Galois Equivalence\<close>
theory Transport_Compositions_Agree_Galois_Equivalence
  imports
    HOL_Basics.Galois_Equivalences
    Transport_Compositions_Agree_Galois_Connection
begin

context transport_comp_agree
begin

interpretation flip : transport_comp_agree R2 L2 r2 l2 R1 L1 r1 l1 .

lemma galois_equivalenceI:
  assumes galois: "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R1\<^esub>)) l1 r1" "((\<le>\<^bsub>L2\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  and mono_L1_L2_l1: "\<And>x y. x \<le>\<^bsub>L1\<^esub> y \<Longrightarrow> l1 x \<le>\<^bsub>R1\<^esub> l1 y \<Longrightarrow> l1 x \<le>\<^bsub>L2\<^esub> l1 y"
  and mono_R2_R1_r2: "\<And>x y. x \<le>\<^bsub>R2\<^esub> y \<Longrightarrow> r2 x \<le>\<^bsub>L2\<^esub> r2 y \<Longrightarrow> r2 x \<le>\<^bsub>R1\<^esub> r2 y"
  and "([in_dom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow> [in_codom (\<le>\<^bsub>R2\<^esub>)] \<Rrightarrow> (\<longleftrightarrow>))
    (rel_bimap l1 r2 (\<le>\<^bsub>R1\<^esub>)) (rel_bimap l1 r2 (\<le>\<^bsub>L2\<^esub>))"
  and mono_iff2: "([in_dom (\<le>\<^bsub>R2\<^esub>)] \<Rrightarrow> [in_codom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow> (\<longleftrightarrow>))
    (rel_bimap r2 l1 (\<le>\<^bsub>R1\<^esub>)) (rel_bimap r2 l1 (\<le>\<^bsub>L2\<^esub>))"
  shows "((\<le>\<^bsub>L\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R\<^esub>)) l r"
proof -
  from galois mono_L1_L2_l1 have "([in_codom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m in_codom (\<le>\<^bsub>L2\<^esub>)) l1"
    by (intro dep_mono_wrt_predI) blast
  moreover from galois mono_R2_R1_r2 have "([in_dom (\<le>\<^bsub>R2\<^esub>)] \<Rrightarrow>\<^sub>m in_dom (\<le>\<^bsub>R1\<^esub>)) r2"
    by (intro dep_mono_wrt_predI) blast
  moreover from mono_iff2 have "([in_dom (\<le>\<^bsub>R2\<^esub>)] \<Rrightarrow> [in_codom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow> (\<longleftrightarrow>))
    (rel_bimap r2 l1 (\<le>\<^bsub>L2\<^esub>)) (rel_bimap r2 l1 (\<le>\<^bsub>R1\<^esub>))" by blast
  ultimately show ?thesis using assms
    by (intro galois_equivalenceI galois_connectionI flip.galois_propI) auto
qed

lemma galois_equivalenceI':
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R1\<^esub>)) l1 r1" "((\<le>\<^bsub>L2\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  and "((\<le>\<^bsub>L1\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>L2\<^esub>)) l1" "((\<le>\<^bsub>R2\<^esub>) \<Rrightarrow>\<^sub>m (\<le>\<^bsub>R1\<^esub>)) r2"
  and "([in_dom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow> [in_codom (\<le>\<^bsub>R2\<^esub>)] \<Rrightarrow> (\<longleftrightarrow>))
    (rel_bimap l1 r2 (\<le>\<^bsub>R1\<^esub>)) (rel_bimap l1 r2 (\<le>\<^bsub>L2\<^esub>))"
  and "([in_dom (\<le>\<^bsub>R2\<^esub>)] \<Rrightarrow> [in_codom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow> (\<longleftrightarrow>))
    (rel_bimap r2 l1 (\<le>\<^bsub>R1\<^esub>)) (rel_bimap r2 l1 (\<le>\<^bsub>L2\<^esub>))"
  shows "((\<le>\<^bsub>L\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R\<^esub>)) l r"
  using assms by (intro galois_equivalenceI) auto

end

context transport_comp_same
begin

lemma galois_equivalenceI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R1\<^esub>)) l1 r1" "((\<le>\<^bsub>R1\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  shows "((\<le>\<^bsub>L\<^esub>) \<equiv>\<^sub>G (\<le>\<^bsub>R\<^esub>)) l r"
  using assms by (rule galois_equivalenceI) auto

end

end


theory Stream_of_llist_of_stream
  imports Main "$HIPSTER_HOME/IsaHipster"
    "types/Llist"
    "types/Stream"
begin
setup Tactic_Data.set_coinduct_sledgehammer
setup Misc_Data.set_noisy
primcorec llist_of_stream :: "'a Stream \<Rightarrow> 'a Llist"
  where "llist_of_stream s = LCons (shd s) (llist_of_stream (stl s))"

primcorec stream_of_llist :: "'a Llist \<Rightarrow> 'a Stream"
where "stream_of_llist l = SCons (lhd l) (stream_of_llist (ltl l))"

(* cohipster stream_of_llist llist_of_stream *)
(* Discovered in about 20 seconds *)

lemma lemma_a [thy_expl]: "llist_of_stream (SCons y z) = LCons y (llist_of_stream z)"
  by (coinduction arbitrary: y z rule: Llist.Llist.coinduct_strong)
    simp

lemma lemma_aa [thy_expl]: "stream_of_llist (llist_of_stream y) = y"
 by (coinduction arbitrary: y rule: Stream.Stream.coinduct_strong)
    simp

lemma lemma_ab [thy_expl]: "stream_of_llist (LCons y (llist_of_stream z)) = SCons y z"
 by (coinduction arbitrary: y z rule: Stream.Stream.coinduct_strong)
    (simp add: lemma_aa)

end


(* Author: Hauke Brinkop and Tobias Nipkow *)

section \<open>Pairing Heaps\<close>

subsection \<open>Binary Tree Representation\<close>

theory Pairing_Heap_Tree_Analysis2
imports
  Pairing_Heap.Pairing_Heap_Tree
  Amortized_Framework
  Priority_Queue_ops_merge
  Lemmas_log
begin

text
\<open>Verification of logarithmic bounds on the amortized complexity of pairing heaps.
As in \<^cite>\<open>"FredmanSST86" and "Brinkop"\<close>, except that the treatment of @{const pass\<^sub>1} is simplified.
TODO: convert the other Pairing Heap analyses to this one.\<close>

fun len :: "'a tree \<Rightarrow> nat" where
  "len Leaf = 0"
| "len (Node _ _ r) = 1 + len r"

fun \<Phi> :: "'a tree \<Rightarrow> real" where
  "\<Phi> Leaf = 0"
| "\<Phi> (Node l x r) = log 2 (size (Node l x r)) + \<Phi> l + \<Phi> r"

lemma link_size[simp]: "size (link hp) = size hp"
  by (cases hp rule: link.cases) simp_all

lemma size_pass\<^sub>1: "size (pass\<^sub>1 hp) = size hp"
  by (induct hp rule: pass\<^sub>1.induct) simp_all

lemma size_merge:
  "is_root h1 \<Longrightarrow> is_root h2 \<Longrightarrow> size (merge h1 h2) = size h1 + size h2"
  by (simp split: tree.splits)

lemma \<Delta>\<Phi>_insert: "is_root hp \<Longrightarrow> \<Phi> (insert x hp) - \<Phi> hp \<le> log 2  (size hp + 1)"
  by (simp split: tree.splits)

lemma \<Delta>\<Phi>_merge:
  assumes "h1 = Node hs1 x1 Leaf" "h2 = Node hs2 x2 Leaf"
  shows "\<Phi> (merge h1 h2) - \<Phi> h1 - \<Phi> h2 \<le> log 2 (size h1 + size h2) + 1"
proof -
  let ?hs = "Node hs1 x1 (Node hs2 x2 Leaf)"
  have "\<Phi> (merge h1 h2) = \<Phi> (link ?hs)" using assms by simp
  also have "\<dots> = \<Phi> hs1 + \<Phi> hs2 + log 2 (size hs1 + size hs2 + 1) + log 2 (size hs1 + size hs2 + 2)"
    by (simp add: algebra_simps)
  also have "\<dots> = \<Phi> hs1 + \<Phi> hs2 + log 2 (size hs1 + size hs2 + 1) + log 2 (size h1 + size h2)"
     using assms by simp
  finally have "\<Phi> (merge h1 h2) = \<dots>" .
  have "\<Phi> (merge h1 h2) - \<Phi> h1 - \<Phi> h2 =
   log 2 (size hs1 + size hs2 + 1) + log 2 (size h1 + size h2)
   - log 2 (size hs1 + 1) - log 2 (size hs2 + 1)"
     using assms by (simp add: algebra_simps)
  also have "\<dots> \<le> log 2 (size h1 + size h2) + 1"
    using ld_le_2ld[of "size hs1" "size hs2"] assms by (simp add: algebra_simps)
  finally show ?thesis .
qed

lemma \<Delta>\<Phi>_pass1: "\<Phi> (pass\<^sub>1 hs) - \<Phi> hs  \<le> 2 * log 2 (size hs + 1) - len hs + 2"
proof (induction hs rule: pass\<^sub>1.induct)
  case (1 hs1 x hs2 y hs)
  let ?h = "Node hs1 x (Node hs2 y hs)"
  let ?n1 = "size hs1"
  let ?n2 = "size hs2" let ?m = "size hs"
  have "\<Phi> (pass\<^sub>1 ?h) - \<Phi> ?h = \<Phi> (pass\<^sub>1 hs) + log 2 (?n1+?n2+1) - \<Phi> hs - log 2 (?n2+?m+1)"
    by (simp add: size_pass\<^sub>1 algebra_simps)
  also have "\<dots> \<le> log 2 (?n1+?n2+1) - log 2 (?n2+?m+1) + 2 * log 2 (?m + 1) - len hs + 2"
    using "1.IH" by (simp)
  also have "\<dots> \<le> 2 * log 2 (?n1+?n2+?m+2) - log 2 (?n2+?m+1) + log 2 (?m + 1) - len hs"
        using ld_sum_inequality [of "?n1+?n2+1" "?m + 1"] by(simp)
  also have "\<dots> \<le> 2 * log 2 (?n1+?n2+?m+2) - len hs" by simp
  also have "\<dots> = 2 * log 2 (size ?h) - len ?h + 2" by simp
  also have "\<dots> \<le> 2 * log 2 (size ?h + 1) - len ?h + 2" by simp
  finally show ?case .
qed simp_all

lemma \<Delta>\<Phi>_pass2: "hs \<noteq> Leaf \<Longrightarrow> \<Phi> (pass\<^sub>2 hs) - \<Phi> hs \<le> log 2 (size hs)"
proof (induction hs)
  case (Node hs1 x hs)
  thus ?case
  proof (cases hs)
    case 1: (Node hs2 y r)
    let ?h = "Node hs1 x hs"
    obtain hs3 a where 2: "pass\<^sub>2 hs = Node hs3 a Leaf"
      using pass\<^sub>2_struct 1 by force
    hence 3: "size hs = size \<dots>" using size_pass\<^sub>2 by metis
    have link: "\<Phi>(link(Node hs1 x (pass\<^sub>2 hs))) - \<Phi> hs1 - \<Phi> (pass\<^sub>2 hs) =
          log 2 (size hs1 + size hs + 1) + log 2 (size hs1 + size hs) - log 2 (size hs)"
      using 2 3 by (simp add: algebra_simps)
    have "\<Phi> (pass\<^sub>2 ?h) - \<Phi> ?h =
        \<Phi> (link (Node hs1 x (pass\<^sub>2 hs))) - \<Phi> hs1 - \<Phi> hs - log 2 (size hs1 + size hs + 1)"
      by (simp)
    also have "\<dots> = \<Phi> (pass\<^sub>2 hs) - \<Phi> hs + log 2 (size hs1 + size hs) - log 2 (size hs)"
      using link by linarith
    also have "\<dots> \<le> log 2 (size hs1 + size hs)"
      using Node.IH(2) 1 by simp
    also have "\<dots> \<le> log 2 (size ?h)" using 1 by simp
    finally show ?thesis .
  qed simp
qed simp

corollary \<Delta>\<Phi>_pass2': "\<Phi> (pass\<^sub>2 hs) - \<Phi> hs \<le> log 2 (size hs + 1)"
proof cases
  assume "hs = Leaf" thus ?thesis by simp
next
  assume "hs \<noteq> Leaf"
  hence "log 2 (size hs) \<le> log 2 (size hs + 1)" using eq_size_0 by fastforce
  then show ?thesis using \<Delta>\<Phi>_pass2[OF \<open>hs \<noteq> Leaf\<close>] by linarith
qed

lemma \<Delta>\<Phi>_del_min:
  "\<Phi> (del_min (Node hs x Leaf)) - \<Phi> (Node hs x Leaf)
  \<le> 2 * log 2 (size hs + 1) - len hs + 2"
proof -
  have "\<Phi> (del_min (Node hs x Leaf)) - \<Phi> (Node hs x Leaf) =
        \<Phi> (pass\<^sub>2 (pass\<^sub>1 hs)) - (log 2 (1 + real (size hs)) + \<Phi> hs)" by simp
  also have "\<dots> \<le> \<Phi> (pass\<^sub>1 hs) - \<Phi> hs"
    using \<Delta>\<Phi>_pass2' [of "pass\<^sub>1 hs"] by(simp add: size_pass\<^sub>1)
  also have "\<dots> \<le> 2 * log 2 (size hs + 1) - len hs + 2" by(rule \<Delta>\<Phi>_pass1)
  finally show ?thesis .
qed

lemma is_root_merge:
  "is_root h1 \<Longrightarrow> is_root h2 \<Longrightarrow> is_root (merge h1 h2)"
by (simp split: tree.splits)

lemma is_root_insert: "is_root h \<Longrightarrow> is_root (insert x h)"
by (simp split: tree.splits)

lemma is_root_del_min:
  assumes "is_root h" shows "is_root (del_min h)"
proof (cases h)
  case [simp]: (Node hs1 x hs)
  have "hs = Leaf" using assms by simp
  thus ?thesis
  proof (cases hs1)
    case (Node hs2 y hs')
    then obtain la a ra where "pass\<^sub>1 hs1 = Node a la ra"
      using pass\<^sub>1_struct by blast
    moreover obtain lb b where "pass\<^sub>2 \<dots> = Node b lb Leaf"
      using pass\<^sub>2_struct by blast
    ultimately show ?thesis using assms by simp
  qed simp
qed simp

lemma pass\<^sub>1_len: "len (pass\<^sub>1 h) \<le> len h"
by (induct h rule: pass\<^sub>1.induct) simp_all

fun exec :: "'a :: linorder op \<Rightarrow> 'a tree list \<Rightarrow> 'a tree" where
"exec Empty [] = Leaf" |
"exec Del_min [h] = del_min h" |
"exec (Insert x) [h] = insert x h" |
"exec Merge [h1,h2] = merge h1 h2"

fun T_pass\<^sub>1 :: "'a tree \<Rightarrow> nat" where
"T_pass\<^sub>1 (Node _ _ (Node _ _ hs')) = T_pass\<^sub>1 hs' + 1" |
"T_pass\<^sub>1 h = 1"

fun T_pass\<^sub>2 :: "'a tree \<Rightarrow> nat" where
  "T_pass\<^sub>2 Leaf = 1"
| "T_pass\<^sub>2 (Node _ _ hs) = T_pass\<^sub>2 hs + 1"

fun T_del_min :: "('a::linorder) tree \<Rightarrow> nat" where
"T_del_min Leaf = 1" |
"T_del_min (Node hs _ _) = T_pass\<^sub>2 (pass\<^sub>1 hs) + T_pass\<^sub>1 hs + 1"

fun T_insert :: "'a \<Rightarrow> 'a tree \<Rightarrow> nat" where
"T_insert a h = 1"

fun T_merge :: "'a tree \<Rightarrow> 'a tree \<Rightarrow> nat" where
"T_merge h1 h2 = 1"

lemma A_del_min: assumes "is_root h"
shows "T_del_min h + \<Phi>(del_min h) - \<Phi> h \<le> 2 * log 2 (size h + 1) + 5"
proof (cases h)
  case [simp]: (Node hs1 x hs)
  have "T_pass\<^sub>2 (pass\<^sub>1 hs1) + real(T_pass\<^sub>1 hs1) \<le> real(len hs1) + 2"
    by (induct hs1 rule: pass\<^sub>1.induct) simp_all
  moreover have "\<Phi> (del_min h) - \<Phi> h \<le> 2 * log 2 (size h + 1) - len hs1 + 2"
  proof -
    have "\<Phi> (del_min h) - \<Phi> h \<le> 2 * log 2 (size hs1 + 1) - len hs1 + 2"
      using  \<Delta>\<Phi>_del_min[of "hs1" "x"] assms by simp
    also have "\<dots> \<le> 2 * log 2 (size h + 1) - len hs1 + 2" by fastforce
    finally show ?thesis .
  qed
  ultimately show ?thesis by(simp)
qed simp

lemma A_insert: "is_root h \<Longrightarrow> T_insert a h + \<Phi>(insert a h) - \<Phi> h \<le> log 2 (size h + 1) + 1"
by(drule \<Delta>\<Phi>_insert) simp

lemma A_merge: assumes "is_root h1" "is_root h2"
shows "T_merge h1 h2 + \<Phi>(merge h1 h2) - \<Phi> h1 - \<Phi> h2 \<le> log 2 (size h1 + size h2 + 1) + 2"
proof (cases h1)
  case Leaf thus ?thesis by (cases h2) auto
next
  case h1: Node
  show ?thesis
  proof (cases h2)
    case Leaf thus ?thesis using h1 by simp
  next
    case h2: Node
    have "\<Phi> (merge h1 h2) - \<Phi> h1 - \<Phi> h2 \<le> log 2 (real (size h1 + size h2)) + 1"
      apply(rule \<Delta>\<Phi>_merge) using h1 h2 assms by auto
    also have "\<dots> \<le> log 2 (size h1 + size h2 + 1) + 1" by (simp add: h1)
    finally show ?thesis by(simp add: algebra_simps)
  qed
qed

fun cost :: "'a :: linorder op \<Rightarrow> 'a tree list \<Rightarrow> nat" where
  "cost Empty [] = 1"
| "cost Del_min [h] = T_del_min h"
| "cost (Insert a) [h] = T_insert a h"
| "cost Merge [h1,h2] = T_merge h1 h2"

fun U :: "'a :: linorder op \<Rightarrow> 'a tree list \<Rightarrow> real" where
  "U Empty [] = 1"
| "U (Insert a) [h] = log 2 (size h + 1) + 1"
| "U Del_min [h] = 2 * log 2 (size h + 1) + 5"
| "U Merge [h1,h2] = log 2 (size h1 + size h2 + 1) + 2"

interpretation Amortized
where arity = arity and exec = exec and cost = cost and inv = is_root
and \<Phi> = \<Phi> and U = U
proof (standard, goal_cases)
  case (1 _ f) thus ?case using is_root_insert is_root_del_min is_root_merge
    by (cases f) (auto simp: numeral_eq_Suc)
next
  case (2 s) show ?case by (induct s) simp_all
next
  case (3 ss f) show ?case
  proof (cases f)
    case Empty with 3 show ?thesis by(auto)
  next
    case Insert
    then obtain h where "ss = [h]" "is_root h" using 3 by auto
    thus ?thesis using Insert \<Delta>\<Phi>_insert 3 by auto
  next
    case Del_min
    then obtain h where [simp]: "ss = [h]" using 3 by auto
    show ?thesis using A_del_min[of h] 3 Del_min by simp
  next
    case Merge
    then obtain h1 h2 where "ss = [h1,h2]" "is_root h1" "is_root h2"
      using 3 by (auto simp: numeral_eq_Suc)
    with A_merge[of h1 h2] Merge show ?thesis by simp
  qed
qed

end


section \<open>Miscellanneous Lemmas and Tools\<close>
theory Refine_Misc
imports
  "../Automatic_Refinement/Automatic_Refinement"
  Refine_Mono_Prover
begin

text \<open>Basic configuration for monotonicity prover:\<close>
lemmas [refine_mono] = monoI monotoneI[of "(\<le>)" "(\<le>)"]
lemmas [refine_mono] = TrueI le_funI order_refl

lemma case_prod_mono[refine_mono]:
  "\<lbrakk>\<And>a b. p=(a,b) \<Longrightarrow> f a b \<le> f' a b\<rbrakk> \<Longrightarrow> case_prod f p \<le> case_prod f' p"
  by (auto split: prod.split)

lemma case_option_mono[refine_mono]:
  assumes "fn \<le> fn'"
  assumes "\<And>v. x=Some v \<Longrightarrow> fs v \<le> fs' v"
  shows "case_option fn fs x \<le> case_option fn' fs' x"
  using assms by (auto split: option.split)

lemma case_list_mono[refine_mono]:
  assumes "fn \<le> fn'"
  assumes "\<And>x xs. l=x#xs \<Longrightarrow> fc x xs \<le> fc' x xs"
  shows "case_list fn fc l \<le> case_list fn' fc' l"
  using assms by (auto split: list.split)

lemma if_mono[refine_mono]:
  assumes "b \<Longrightarrow> m1 \<le> m1'"
  assumes "\<not>b \<Longrightarrow> m2 \<le> m2'"
  shows "(if b then m1 else m2) \<le> (if b then m1' else m2')"
  using assms by auto

lemma let_mono[refine_mono]:
  "f x \<le> f' x' \<Longrightarrow> Let x f \<le> Let x' f'" by auto

subsection \<open>Uncategorized Lemmas\<close>
lemma all_nat_split_at: "\<forall>i::'a::linorder<k. P i \<Longrightarrow> P k \<Longrightarrow> \<forall>i>k. P i
  \<Longrightarrow> \<forall>i. P i"
  by (metis linorder_neq_iff)

subsection \<open>Well-Foundedness\<close>

lemma wf_no_infinite_down_chainI:
  assumes "\<And>f. \<lbrakk>\<And>i. (f (Suc i), f i)\<in>r\<rbrakk> \<Longrightarrow> False"
  shows "wf r"
  by (metis assms wf_iff_no_infinite_down_chain)

text \<open>This lemma transfers well-foundedness over a simulation relation.\<close>
lemma sim_wf:
  assumes WF: "wf (S'\<inverse>)"
  assumes STARTR: "(x0,x0')\<in>R"
  assumes SIM: "\<And>s s' t. \<lbrakk> (s,s')\<in>R; (s,t)\<in>S; (x0',s')\<in>S'\<^sup>* \<rbrakk>
    \<Longrightarrow> \<exists>t'. (s',t')\<in>S' \<and> (t,t')\<in>R"
  assumes CLOSED: "Domain S  \<subseteq> S\<^sup>*``{x0}"
  shows "wf (S\<inverse>)"
proof (rule wf_no_infinite_down_chainI, simp)
  txt \<open>
    Informal proof:
    Assume there is an infinite chain in \<open>S\<close>.
    Due to the closedness property of \<open>S\<close>, it can be extended to
    start at \<open>x0\<close>.
    Now, we inductively construct an infinite chain in \<open>S'\<close>, such that
    each element of the new chain is in relation with the corresponding
    element of the original chain:
      The first element is \<open>x0'\<close>.
      For any element \<open>i+1\<close>, the simulation property yields the next
      element.
    This chain contradicts well-foundedness of \<open>S'\<close>.
\<close>

  fix f
  assume CHAIN: "\<And>i. (f i, f (Suc i))\<in>S"
  txt \<open>Extend to start with \<open>x0\<close>\<close>
  obtain f' where CHAIN': "\<And>i. (f' i, f' (Suc i))\<in>S" and [simp]: "f' 0 = x0"
  proof -
    {
      fix x
      assume S: "x = f 0"
      from CHAIN have "f 0 \<in> Domain S" by auto
      with CLOSED have "(x0,x)\<in>S\<^sup>*" by (auto simp: S)
      then obtain g k where G0: "g 0 = x0" and X: "x = g k"
        and CH: "(\<forall>i<k. (g i, g (Suc i))\<in>S)"
      proof induct
        case base thus ?case by force
      next
        case (step y z) show ?case proof (rule step.hyps(3))
          fix g k
          assume "g 0 = x0" and "y = g k"
            and "\<forall>i<k. (g i, g (Suc i))\<in>S"
          thus ?case using \<open>(y,z)\<in>S\<close>
            by (rule_tac step.prems[where g="g(Suc k := z)" and k="Suc k"])
              auto
        qed
      qed
      define f' where "f' i = (if i<k then g i else f (i-k))" for i
      have "\<exists>f'. f' 0 = x0 \<and> (\<forall>i. (f' i, f' (Suc i))\<in>S)"
        apply (rule_tac x=f' in exI)
        apply (unfold f'_def)
        apply (rule conjI)
        using S X G0 apply (auto) []
        apply (rule_tac k=k in all_nat_split_at)
        apply (auto)
        apply (simp add: CH)
        apply (subgoal_tac "k = Suc i")
        apply (simp add: S[symmetric] CH X)
        apply simp
        apply (simp add: CHAIN)
        apply (subgoal_tac "Suc i - k = Suc (i-k)")
        using CHAIN apply simp
        apply simp
        done
    }
    then obtain f' where "\<forall>i. (f' i,f' (Suc i))\<in>S" and "f' 0 = x0" by blast
    thus ?thesis by (blast intro!: that)
  qed

  txt \<open>Construct chain in \<open>S'\<close>\<close>
  define g' where "g' = rec_nat x0' (\<lambda>i x. SOME x'.
          (x,x')\<in>S' \<and> (f' (Suc i),x')\<in>R \<and> (x0', x')\<in>S'\<^sup>* )"
  {
    fix i
    note [simp] = g'_def
    have "(g' i, g' (Suc i))\<in>S' \<and> (f' (Suc i),g' (Suc i))\<in>R
      \<and> (x0',g' (Suc i))\<in>S'\<^sup>*"
    proof (induct i)
      case 0
      from SIM[OF STARTR] CHAIN'[of 0] obtain t' where
        "(x0',t')\<in>S'" and "(f' (Suc 0),t')\<in>R" by auto
      moreover hence "(x0',t')\<in>S'\<^sup>*" by auto
      ultimately show ?case
        by (auto intro: someI2 simp: STARTR)
    next
      case (Suc i)
      with SIM[OF _ CHAIN'[of "Suc i"]]
      obtain t' where LS: "(g' (Suc i),t')\<in>S'" and "(f' (Suc (Suc i)),t')\<in>R"
        by auto
      moreover from LS Suc have "(x0', t')\<in>S'\<^sup>*" by auto
      ultimately show ?case
        apply simp
        apply (rule_tac a="t'" in someI2)
        apply auto
        done
    qed
  } hence S'CHAIN: "\<forall>i. (g' i, g'(Suc i))\<in>S'" by simp
  txt \<open>This contradicts well-foundedness\<close>
  with WF show False
    by (erule_tac wf_no_infinite_down_chainE[where f=g']) simp
qed

text \<open>Well-founded relation that approximates a finite set from below.\<close>
definition "finite_psupset S \<equiv> { (Q',Q). Q\<subset>Q' \<and> Q' \<subseteq> S }"
lemma finite_psupset_wf[simp, intro]: "finite S \<Longrightarrow> wf (finite_psupset S)"
  unfolding finite_psupset_def by (blast intro: wf_bounded_supset)

definition "less_than_bool \<equiv> {(a,b). a<(b::bool)}"
lemma wf_less_than_bool[simp, intro!]: "wf (less_than_bool)"
  unfolding less_than_bool_def
  by (auto simp: wf_def)
lemma less_than_bool_iff[simp]:
  "(x,y)\<in>less_than_bool \<longleftrightarrow> x=False \<and> y=True"
  by (auto simp: less_than_bool_def)

definition "greater_bounded N \<equiv> inv_image less_than (\<lambda>x. N-x)"
lemma wf_greater_bounded[simp, intro!]: "wf (greater_bounded N)" by (auto simp: greater_bounded_def)

lemma greater_bounded_Suc_iff[simp]: "(Suc x,x)\<in>greater_bounded N \<longleftrightarrow> Suc x \<le> N"
  by (auto simp: greater_bounded_def)

subsection \<open>Monotonicity and Orderings\<close>

lemma mono_const[simp, intro!]: "mono (\<lambda>_. c)" by (auto intro: monoI)
lemma mono_if: "\<lbrakk>mono S1; mono S2\<rbrakk> \<Longrightarrow>
  mono (\<lambda>F s. if b s then S1 F s else S2 F s)"
  apply rule
  apply (rule le_funI)
  apply (auto dest: monoD[THEN le_funD])
  done

lemma mono_infI: "mono f \<Longrightarrow> mono g \<Longrightarrow> mono (inf f g)"
  unfolding inf_fun_def
  apply (rule monoI)
  apply (metis inf_mono monoD)
  done

lemma mono_infI':
  "mono f \<Longrightarrow> mono g \<Longrightarrow> mono (\<lambda>x. inf (f x) (g x) :: 'b::lattice)"
  by (rule mono_infI[unfolded inf_fun_def])

lemma mono_infArg:
  fixes f :: "'a::lattice \<Rightarrow> 'b::order"
  shows "mono f \<Longrightarrow> mono (\<lambda>x. f (inf x X))"
  apply (rule monoI)
  apply (erule monoD)
  apply (metis inf_mono order_refl)
  done

lemma mono_Sup:
  fixes f :: "'a::complete_lattice \<Rightarrow> 'b::complete_lattice"
  shows "mono f \<Longrightarrow> Sup (f`S) \<le> f (Sup S)"
  apply (rule Sup_least)
  apply (erule imageE)
  apply simp
  apply (erule monoD)
  apply (erule Sup_upper)
  done

lemma mono_SupI:
  fixes f :: "'a::complete_lattice \<Rightarrow> 'b::complete_lattice"
  assumes "mono f"
  assumes "S'\<subseteq>f`S"
  shows "Sup S' \<le> f (Sup S)"
  by (metis Sup_subset_mono assms mono_Sup order_trans)

lemma mono_Inf:
  fixes f :: "'a::complete_lattice \<Rightarrow> 'b::complete_lattice"
  shows "mono f \<Longrightarrow> f (Inf S) \<le> Inf (f`S)"
  apply (rule Inf_greatest)
  apply (erule imageE)
  apply simp
  apply (erule monoD)
  apply (erule Inf_lower)
  done

lemma mono_funpow: "mono (f::'a::order \<Rightarrow> 'a) \<Longrightarrow> mono (f^^i)"
  apply (induct i)
  apply (auto intro!: monoI)
  apply (auto dest: monoD)
  done

lemma mono_id[simp, intro!]:
  "mono id"
  "mono (\<lambda>x. x)"
  by (auto intro: monoI)

declare SUP_insert[simp]

lemma (in semilattice_inf) le_infD1:
  "a \<le> inf b c \<Longrightarrow> a \<le> b" by (rule le_infE)
lemma (in semilattice_inf) le_infD2:
  "a \<le> inf b c \<Longrightarrow> a \<le> c" by (rule le_infE)
lemma (in semilattice_inf) inf_leI:
  "\<lbrakk> \<And>x. \<lbrakk> x\<le>a; x\<le>b \<rbrakk> \<Longrightarrow> x\<le>c \<rbrakk> \<Longrightarrow> inf a b \<le> c"
  by (metis inf_le1 inf_le2)

lemma top_Sup: "(top::'a::complete_lattice)\<in>A \<Longrightarrow> Sup A = top"
  by (metis Sup_upper top_le)
lemma bot_Inf: "(bot::'a::complete_lattice)\<in>A \<Longrightarrow> Inf A = bot"
  by (metis Inf_lower le_bot)

lemma mono_compD: "mono f \<Longrightarrow> x\<le>y \<Longrightarrow> f o x \<le> f o y"
  apply (rule le_funI)
  apply (auto dest: monoD le_funD)
  done

subsubsection \<open>Galois Connections\<close>
locale galois_connection =
  fixes \<alpha>::"'a::complete_lattice \<Rightarrow> 'b::complete_lattice" and \<gamma>
  assumes galois: "c \<le> \<gamma>(a) \<longleftrightarrow> \<alpha>(c) \<le> a"
begin
  lemma \<alpha>\<gamma>_defl: "\<alpha>(\<gamma>(x)) \<le> x"
  proof -
    have "\<gamma> x \<le> \<gamma> x" by simp
    with galois show "\<alpha>(\<gamma>(x)) \<le> x" by blast
  qed
  lemma \<gamma>\<alpha>_infl: "x \<le> \<gamma>(\<alpha>(x))"
  proof -
    have "\<alpha> x \<le> \<alpha> x" by simp
    with galois show "x \<le> \<gamma>(\<alpha>(x))" by blast
  qed

  lemma \<gamma>_mono: "mono \<gamma>"
    by rule (metis \<alpha>\<gamma>_defl galois inf_absorb1 le_infE)

  lemma dist_\<gamma>[simp]:
    "\<gamma> (inf a b) = inf (\<gamma> a) (\<gamma> b)"
    apply (rule order_antisym)
    apply (rule mono_inf[OF \<gamma>_mono])
    apply (simp add: galois)
    apply (simp add: galois[symmetric])
    done

  lemma dist_\<alpha>[simp]:
    "\<alpha> (sup a b) = sup (\<alpha> a) (\<alpha> b)"
    by (metis (no_types) \<alpha>_mono galois mono_sup order_antisym
      sup_ge1 sup_ge2 sup_least)

end

subsubsection \<open>Fixed Points\<close>
lemma mono_lfp_eqI:
  assumes MONO: "mono f"
  assumes FIXP: "f a \<le> a"
  assumes LEAST: "\<And>x. f x = x \<Longrightarrow> a\<le>x"
  shows "lfp f = a"
  apply (rule antisym)
  apply (rule lfp_lowerbound)
  apply (rule FIXP)
  by (metis LEAST MONO lfp_unfold)

lemma mono_gfp_eqI:
  assumes MONO: "mono f"
  assumes FIXP: "a \<le> f a"
  assumes GREATEST: "\<And>x. f x = x \<Longrightarrow> x\<le>a"
  shows "gfp f = a"
  apply (rule antisym)
  apply (metis GREATEST MONO gfp_unfold)
  apply (rule gfp_upperbound)
  apply (rule FIXP)
  done

lemma lfp_le_gfp': "mono f \<Longrightarrow> lfp f x \<le> gfp f x"
  by (rule le_funD[OF lfp_le_gfp])

(* Just a reformulation of lfp_induct *)
lemma lfp_induct':
  assumes M: "mono f"
  assumes IS: "\<And>m. \<lbrakk> m \<le> lfp f; m \<le> P \<rbrakk> \<Longrightarrow> f m \<le> P"
  shows "lfp f \<le> P"
  apply (rule lfp_induct[OF M])
  apply (rule IS)
  by simp_all

lemma lfp_gen_induct:
  \<comment> \<open>Induction lemma for generalized lfps\<close>
  assumes M: "mono f"
  notes MONO'[refine_mono] = monoD[OF M]
  assumes I0: "m0 \<le> P"
  assumes IS: "\<And>m. \<lbrakk>
      m \<le> lfp (\<lambda>s. sup m0 (f s));  \<comment> \<open>Assume already established invariants\<close>
      m \<le> P;                       \<comment> \<open>Assume invariant\<close>
      f m \<le> lfp (\<lambda>s. sup m0 (f s)) \<comment> \<open>Assume that step preserved est. invars\<close>
    \<rbrakk> \<Longrightarrow> f m \<le> P"                 \<comment> \<open>Show that step preserves invariant\<close>
  shows "lfp (\<lambda>s. sup m0 (f s)) \<le> P"
  apply (rule lfp_induct')
  apply (meson MONO' monoI order_mono_setup.refl sup_mono)
  apply (rule sup_least)
  apply (rule I0)
  apply (rule IS, assumption+)
  apply (subst lfp_unfold)
  apply (meson MONO' monoI order_mono_setup.refl sup_mono)
  apply (rule le_supI2)
  apply (rule monoD[OF M])
  .

subsubsection \<open>Connecting Complete Lattices and
  Chain-Complete Partial Orders\<close>
(* Note: Also connected by subclass now. However, we need both directions
  of embedding*)
lemma (in complete_lattice) is_ccpo: "class.ccpo Sup (\<le>) (<)"
  apply unfold_locales
  apply (erule Sup_upper)
  apply (erule Sup_least)
  done

lemma (in complete_lattice) is_dual_ccpo: "class.ccpo Inf (\<ge>) (>)"
  apply unfold_locales
  apply (rule less_le_not_le)
  apply (rule order_refl)
  apply (erule (1) order_trans)
  apply (erule (1) order.antisym)
  apply (erule Inf_lower)
  apply (erule Inf_greatest)
  done

lemma dual_ccpo_mono_simp: "monotone (\<ge>) (\<ge>) f \<longleftrightarrow> mono f"
  unfolding monotone_def mono_def by auto
lemma dual_ccpo_monoI: "mono f \<Longrightarrow> monotone (\<ge>) (\<ge>) f"
  by (simp add: dual_ccpo_mono_simp)
lemma dual_ccpo_monoD: "monotone (\<ge>) (\<ge>) f \<Longrightarrow> mono f"
  by (simp add: dual_ccpo_mono_simp)

lemma ccpo_lfp_simp: "\<And>f. mono f \<Longrightarrow> ccpo.fixp Sup (\<le>) f = lfp f"
  apply (rule antisym)
  defer
  apply (rule lfp_lowerbound)
  apply (drule ccpo.fixp_unfold[OF is_ccpo , symmetric])
  apply simp

  apply (rule ccpo.fixp_lowerbound[OF is_ccpo], assumption)
  apply (simp add: lfp_unfold[symmetric])
  done

lemma ccpo_gfp_simp: "\<And>f. mono f \<Longrightarrow> ccpo.fixp Inf (\<ge>) f = gfp f"
  apply (rule antisym)
  apply (rule gfp_upperbound)
  apply (drule ccpo.fixp_unfold[OF is_dual_ccpo dual_ccpo_monoI, symmetric])
  apply simp

  apply (rule ccpo.fixp_lowerbound[OF is_dual_ccpo dual_ccpo_monoI], assumption)
  apply (simp add: gfp_unfold[symmetric])
  done

abbreviation "chain_admissible P \<equiv> ccpo.admissible Sup (\<le>) P"
abbreviation "is_chain \<equiv> Complete_Partial_Order.chain (\<le>)"
lemmas chain_admissibleI[intro?] = ccpo.admissibleI[where lub=Sup and ord="(\<le>)"]

abbreviation "dual_chain_admissible P \<equiv> ccpo.admissible Inf (\<lambda>x y. y\<le>x) P"
abbreviation "is_dual_chain \<equiv> Complete_Partial_Order.chain (\<lambda>x y. y\<le>x)"
lemmas dual_chain_admissibleI[intro?] =
  ccpo.admissibleI[where lub=Inf and ord="(\<lambda>x y. y\<le>x)"]

lemma dual_chain_iff[simp]: "is_dual_chain C = is_chain C"
  unfolding chain_def
  apply auto
  done

lemmas chain_dualI = iffD1[OF dual_chain_iff]
lemmas dual_chainI = iffD2[OF dual_chain_iff]

lemma is_chain_empty[simp, intro!]: "is_chain {}"
  by (rule chainI) auto
lemma is_dual_chain_empty[simp, intro!]: "is_dual_chain {}"
  by (rule dual_chainI) auto

lemma point_chainI: "is_chain M \<Longrightarrow> is_chain ((\<lambda>f. f x)`M)"
  by (auto intro: chainI le_funI dest: chainD le_funD)

text \<open>We transfer the admissible induction lemmas to complete
  lattices.\<close>
lemma lfp_cadm_induct:
  "\<lbrakk>chain_admissible P; P (Sup {}); mono f; \<And>x. P x \<Longrightarrow> P (f x)\<rbrakk> \<Longrightarrow> P (lfp f)"
  by (simp only:  ccpo_lfp_simp[symmetric])
     (rule ccpo.fixp_induct[OF is_ccpo])

lemma gfp_cadm_induct:
  "\<lbrakk>dual_chain_admissible P; P (Inf {}); mono f; \<And>x. P x \<Longrightarrow> P (f x)\<rbrakk> \<Longrightarrow> P (gfp f)"
  by (simp only: dual_ccpo_mono_simp[symmetric] ccpo_gfp_simp[symmetric])
     (rule ccpo.fixp_induct[OF is_dual_ccpo])

subsubsection \<open>Continuity and Kleene Fixed Point Theorem\<close>
definition "cont f \<equiv> \<forall>C. C\<noteq>{} \<longrightarrow> f (Sup C) = Sup (f`C)"
definition "strict f \<equiv> f bot = bot"
definition "inf_distrib f \<equiv> strict f \<and> cont f"

lemma contI[intro?]: "\<lbrakk>\<And>C. C\<noteq>{} \<Longrightarrow> f (Sup C) = Sup (f`C)\<rbrakk> \<Longrightarrow> cont f"
  unfolding cont_def by auto
lemma contD: "cont f \<Longrightarrow> C\<noteq>{} \<Longrightarrow> f (Sup C) = Sup (f ` C)"
  unfolding cont_def by auto
lemma contD': "cont f \<Longrightarrow> C\<noteq>{} \<Longrightarrow> f (Sup C) = Sup (f ` C)"
  by (fact contD)

lemma strictD[dest]: "strict f \<Longrightarrow> f bot = bot"
  unfolding strict_def by auto
\<comment> \<open>We only add this lemma to the simpset for functions on the same type.
    Otherwise, the simplifier tries it much too often.\<close>
lemma strictD_simp[simp]: "strict f \<Longrightarrow> f (bot::'a::bot) = (bot::'a)"
  unfolding strict_def by auto

lemma strictI[intro?]: "f bot = bot \<Longrightarrow> strict f"
  unfolding strict_def by auto

lemma inf_distribD[simp]:
  "inf_distrib f \<Longrightarrow> strict f"
  "inf_distrib f \<Longrightarrow> cont f"
  unfolding inf_distrib_def by auto

lemma inf_distribI[intro?]: "\<lbrakk>strict f; cont f\<rbrakk> \<Longrightarrow> inf_distrib f"
  unfolding inf_distrib_def by auto

lemma inf_distribD'[simp]:
  fixes f :: "'a::complete_lattice \<Rightarrow> 'b::complete_lattice"
  shows "inf_distrib f \<Longrightarrow> f (Sup C) = Sup (f`C)"
  apply (cases "C={}")
  apply (auto dest: inf_distribD contD')
  done

lemma inf_distrib_is_mono[simp]:
  fixes f :: "'a::complete_lattice \<Rightarrow> 'b::complete_lattice"
  shows "inf_distrib f \<Longrightarrow> mono f"
  by simp

text \<open>Only proven for complete lattices here. Also holds for CCPOs.\<close>

theorem gen_kleene_lfp:
  fixes f:: "'a::complete_lattice \<Rightarrow> 'a"
  assumes CONT: "cont f"
  shows "lfp (\<lambda>x. sup m (f x)) = (SUP i. (f^^i) m)"
proof (rule antisym)
  let ?f = "(\<lambda>x. sup m (f x))"
  let ?K="{ (f^^i) m | i . True}"
  note MONO=cont_is_mono[OF CONT]
  note MONO'[refine_mono] = monoD[OF MONO]
  {
    fix i
    have "(f^^i) m \<le> lfp ?f"
      apply (induct i)
      apply simp
      apply (subst lfp_unfold)
      apply (meson MONO' monoI order_mono_setup.refl sup_mono)
      apply simp

      apply (subst lfp_unfold)
      apply (meson MONO' monoI order_mono_setup.refl sup_mono)
      apply simp
      by (metis MONO' le_supI2)
  } thus "(SUP i. (f^^i) m) \<le> lfp ?f" by (blast intro: SUP_least)
next
  let ?f = "(\<lambda>x. sup m (f x))"
  show "lfp ?f \<le> (SUP i. (f^^i) m)"
    apply (rule lfp_lowerbound)
    apply (rule sup_least)
    apply (rule order_trans[OF _ SUP_upper[where i=0]], simp_all) []
    apply (simp add: contD [OF CONT])
    apply (rule Sup_subset_mono)
    apply (auto)
    apply (rule_tac x="Suc i" in range_eqI)
    apply simp
    done
qed

theorem kleene_lfp:
  fixes f:: "'a::complete_lattice \<Rightarrow> 'a"
  assumes CONT: "cont f"
  shows "lfp f = (SUP i. (f^^i) bot)"
  using gen_kleene_lfp[OF CONT,where m=bot] by simp

theorem (* Detailed proof *)
  fixes f:: "'a::complete_lattice \<Rightarrow> 'a"
  assumes CONT: "cont f"
  shows "lfp f = (SUP i. (f^^i) bot)"
proof (rule antisym)
  let ?K="{ (f^^i) bot | i . True}"
  note MONO=cont_is_mono[OF CONT]
  {
    fix i
    have "(f^^i) bot \<le> lfp f"
      apply (induct i)
      apply simp
      apply simp
      by (metis MONO lfp_unfold monoD)
  } thus "(SUP i. (f^^i) bot) \<le> lfp f" by (blast intro: SUP_least)
next
  show "lfp f \<le> (SUP i. (f^^i) bot)"
    apply (rule lfp_lowerbound)
    apply (simp add: contD [OF CONT])
    apply (rule Sup_subset_mono)
    apply auto
    apply (rule_tac x="Suc i" in range_eqI)
    apply auto
    done
qed

(* Alternative proof of gen_kleene_lfp that re-uses standard Kleene, but is more tedious *)
lemma SUP_funpow_contracting:
  fixes f :: "'a \<Rightarrow> ('a::complete_lattice)"
  assumes C: "cont f"
  shows "f (SUP i. (f^^i) m) \<le> (SUP i. (f^^i) m)"
proof -
  have 1: "\<And>i x. f ((f^^i) x) = (f^^(Suc i)) x"
    by simp

  have "f (SUP i. (f^^i) m) = (SUP i. f ((f ^^ i) m))"
    by (subst contD[OF C]) (simp_all add: image_comp)
  also have "\<dots> \<le> (SUP i. (f^^i) m)"
    apply (rule SUP_least)
    apply (simp, subst 1)
    apply (rule SUP_upper)
    ..
  finally show ?thesis .
qed

lemma gen_kleene_chain_conv:
  fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
  assumes C: "cont f"
  shows "(SUP i. (f^^i) m) = (SUP i. ((\<lambda>x. sup m (f x))^^i) bot)"
proof -
  let ?f' = "\<lambda>x. sup m (f x)"
  show ?thesis
  proof (intro antisym SUP_least)
    from C have C': "cont ?f'"
      unfolding cont_def
      by (simp add: SUP_sup_distrib[symmetric])

    fix i
    show "(f ^^ i) m \<le> (SUP i. (?f' ^^ i) bot)"
    proof (induction i)
      case 0 show ?case
        by (rule order_trans[OF _ SUP_upper[where i=1]]) auto
    next
      case (Suc i)
      from cont_is_mono[OF C, THEN monoD, OF Suc]
      have "(f ^^ (Suc i)) m \<le> f (SUP i. ((\<lambda>x. sup m (f x)) ^^ i) bot)"
        by simp
      also have "\<dots> \<le> sup m \<dots>" by simp
      also note SUP_funpow_contracting[OF C']
      finally show ?case .
    qed
  next
    fix i
    show "(?f'^^i) bot \<le> (SUP i. (f^^i) m)"
    proof (induction i)
      case 0 thus ?case by simp
    next
      case (Suc i)
      from monoD[OF cont_is_mono[OF C] Suc]
      have "(?f'^^Suc i) bot \<le> sup m (f (SUP i. (f ^^ i) m))"
        by (simp add: le_supI2)
      also have "\<dots> \<le> (SUP i. (f ^^ i) m)"
        apply (rule sup_least)
        apply (rule order_trans[OF _ SUP_upper[where i=0]], simp_all) []
        apply (rule SUP_funpow_contracting[OF C])
        done
      finally show ?case .
    qed
  qed
qed

theorem
  assumes C: "cont f"
  shows "lfp (\<lambda>x. sup m (f x)) = (SUP i. (f^^i) m)"
  apply (subst gen_kleene_chain_conv[OF C])
  apply (rule kleene_lfp)
    using C
    unfolding cont_def
    apply (simp add: SUP_sup_distrib[symmetric])
  done

lemma (in galois_connection) dual_inf_dist_\<gamma>: "\<gamma> (Inf C) = Inf (\<gamma>`C)"
  apply (rule antisym)
  apply (rule Inf_greatest)
  apply clarify
  apply (rule monoD[OF \<gamma>_mono])
  apply (rule Inf_lower)
  apply simp

  apply (subst galois)
  apply (rule Inf_greatest)
  apply (subst galois[symmetric])
  apply (rule Inf_lower)
  apply simp
  done

lemma (in galois_connection) inf_dist_\<alpha>: "inf_distrib \<alpha>"
  apply (rule inf_distribI')
  apply (rule antisym)

  apply (subst galois[symmetric])
  apply (rule Sup_least)
  apply (subst galois)
  apply (rule Sup_upper)
  apply simp

  apply (rule Sup_least)
  apply clarify
  apply (rule monoD[OF \<alpha>_mono])
  apply (rule Sup_upper)
  apply simp
  done

subsection \<open>Maps\<close>
subsubsection \<open>Key-Value Set\<close>

  lemma map_to_set_simps[simp]:
    "map_to_set Map.empty = {}"
    "map_to_set [a\<mapsto>b] = {(a,b)}"
    "map_to_set (m|`K) = map_to_set m \<inter> K\<times>UNIV"
    "map_to_set (m(x:=None)) = map_to_set m - {x}\<times>UNIV"
    "map_to_set (m(x\<mapsto>v)) = map_to_set m - {x}\<times>UNIV \<union> {(x,v)}"
    "map_to_set m \<inter> dom m\<times>UNIV = map_to_set m"
    "m k = Some v \<Longrightarrow> (k,v)\<in>map_to_set m"
    "single_valued (map_to_set m)"
    apply (simp_all)
    by (auto simp: map_to_set_def restrict_map_def split: if_split_asm
      intro: single_valuedI)

  lemma map_to_set_inj:
    "(k,v)\<in>map_to_set m \<Longrightarrow> (k,v')\<in>map_to_set m \<Longrightarrow> v = v'"
    by (auto simp: map_to_set_def)

end


(*  Title:      Util_Set.thy
    Date:       Feb 2008
    Author:     David Trachtenherz
*)

header {* Convenience results for set quantifiers *}

theory Util_Set
imports Main
begin

subsection {* Some auxiliary results for HOL rules *}

lemma conj_disj_absorb: "(P \<and> Q \<or> Q) = Q" by blast
lemma disj_eq_distribL: "((a \<or> b) = (a \<or> c)) = (a \<or> (b = c))" by blast
lemma disj_eq_distribR: "((a \<or> c) = (b \<or> c)) = ((a = b) \<or> c)" by blast

subsubsection {* Some auxiliary results for  @{text Let} *}

lemma Let_swap: "f (let x=a in g x) = (let x=a in f (g x))" by simp

subsubsection {* Some auxiliary @{text "if"}-rules *}

thm if_P
lemma if_P': "\<lbrakk> P; x = z \<rbrakk> \<Longrightarrow> (if P then x else y) = z" by simp
thm if_not_P
lemma if_not_P': "\<lbrakk> \<not> P; y = z \<rbrakk> \<Longrightarrow> (if P then x else y) = z" by simp

lemma if_P_both: "\<lbrakk> Q x; Q y \<rbrakk> \<Longrightarrow> Q (if P then x else y)" by simp
lemma if_P_both_in_set: "\<lbrakk> x \<in> s; y \<in> s \<rbrakk> \<Longrightarrow> (if P then x else y) \<in> s" by simp

subsubsection {* Some auxiliary rules for function composition *}

lemma comp2_conv: "f1 \<circ> f2 = (\<lambda>x. f1 (f2 x))" by (simp add: comp_def)
lemma comp3_conv: "f1 \<circ> f2 \<circ> f3 = (\<lambda>x. f1 (f2 (f3 x)))" by (simp add: comp_def)

subsection {* Some auxiliary lemmata for quantifiers *}

subsubsection {* Auxiliary results for universal and existential quantifiers *}

lemma ball_cong2: "
  \<lbrakk> I \<subseteq> A; \<forall>x\<in>A. f x = g x \<rbrakk> \<Longrightarrow> (\<forall>x\<in>I. P (f x)) = (\<forall>x\<in>I. P (g x))" by fastforce
lemma bex_cong2: "
  \<lbrakk> I \<subseteq> A; \<forall>x\<in>I. f x = g x \<rbrakk> \<Longrightarrow> (\<exists>x\<in>I. P (f x)) = (\<exists>x\<in>I. P (g x))" by simp
lemma ball_all_cong: "
  \<forall>x. f x = g x \<Longrightarrow> (\<forall>x\<in>I. P (f x)) = (\<forall>x\<in>I. P (g x))" by simp
lemma bex_all_cong: "
  \<forall>x. f x = g x \<Longrightarrow> (\<exists>x\<in>I. P (f x)) = (\<exists>x\<in>I. P (g x))" by simp
lemma all_cong: "
  \<forall>x. f x = g x \<Longrightarrow> (\<forall>x. P (f x)) = (\<forall>x. P (g x))" by simp
lemma ex_cong: "
  \<forall>x. f x = g x \<Longrightarrow> (\<exists>x. P (f x)) = (\<exists>x. P (g x))" by simp

(*lemma all_eqI: "(\<And>x. P x = Q x) \<Longrightarrow> (\<forall>x. P x) = (\<forall>x. Q x)"*)
lemmas all_eqI = iff_allI
(*lemma ex_eqI: "(\<And>x. P x = Q x) \<Longrightarrow> (\<exists>x. P x) = (\<exists>x. Q x)"*)
lemmas ex_eqI = iff_exI

lemma all_imp_eqI: "
  \<lbrakk> P = P'; \<And>x. P x \<Longrightarrow> Q x = Q' x \<rbrakk> \<Longrightarrow>
  (\<forall>x. P x \<longrightarrow> Q x) = (\<forall>x. P' x \<longrightarrow> Q' x)"
by blast
lemma ex_imp_eqI: "
  \<lbrakk> P = P'; \<And>x. P x \<Longrightarrow> Q x = Q' x \<rbrakk> \<Longrightarrow>
  (\<exists>x. P x \<and> Q x) = (\<exists>x. P' x \<and> Q' x)"
by blast

subsubsection {* Auxiliary results for @{text empty} sets *}

lemma empty_imp_not_in: "x \<notin> {}" by blast
lemma ex_imp_not_empty: "\<exists>x. x \<in> A \<Longrightarrow> A \<noteq> {}" by blast
lemma in_imp_not_empty: "x \<in> A \<Longrightarrow> A \<noteq> {}" by blast
lemma not_empty_imp_ex: "A \<noteq> {} \<Longrightarrow> \<exists>x. x \<in> A" by blast
lemma not_ex_in_conv: "(\<not> (\<exists>x. x \<in> A)) = (A = {})" by blast

subsubsection {* Some auxiliary results for subset and membership relation *}

lemma bex_subset_imp_bex: "\<lbrakk> \<exists>x\<in>A. P x; A \<subseteq> B \<rbrakk> \<Longrightarrow> \<exists>x\<in>B. P x" by blast
lemma bex_imp_ex: "\<exists>x\<in>A. P x \<Longrightarrow> \<exists>x. P x" by blast
lemma ball_subset_imp_ball: "\<lbrakk> \<forall>x\<in>B. P x; A \<subseteq> B \<rbrakk> \<Longrightarrow> \<forall>x\<in>A. P x" by blast
thm
  ball_subset_imp_ball
  ball_subset_imp_ball[rule_format]
lemma all_imp_ball: "\<forall>x. P x \<Longrightarrow> \<forall>x\<in>A. P x" by blast

thm mem_Collect_eq
lemma mem_Collect_eq_not: "(a \<notin> {x. P x}) = (\<not> P a)" by blast
lemma Collect_not_in_imp_not: "a \<notin> {x. P x} \<Longrightarrow> \<not> P a" by blast
lemma Collect_not_imp_not_in: "\<not> P a \<Longrightarrow> a \<notin> {x. P x}" by blast
lemma Collect_is_subset: "{x \<in> A. P x} \<subseteq> A" by blast

end


(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory SAS_Plus_Semantics
  imports "SAS_Plus_Representation" "List_Supplement"
    "Map_Supplement"
begin
section "SAS+ Semantics"

subsection "Serial Execution Semantics"

text \<open> Serial plan execution is implemented recursively just like in the STRIPS case. By and large,
compared to definition \ref{isadef:plan-execution-strips}, we only substitute the operator
applicability function with its SAS+ counterpart. \<close>

primrec execute_serial_plan_sas_plus
  where "execute_serial_plan_sas_plus s [] = s"
  | "execute_serial_plan_sas_plus s (op # ops)
    = (if is_operator_applicable_in s op
    then execute_serial_plan_sas_plus (execute_operator_sas_plus s op) ops
    else s)"

text \<open> Similarly, serial SAS+ solutions are defined just like in STRIPS but based on the
corresponding SAS+ definitions. \<close>

definition is_serial_solution_for_problem
  :: "('variable, 'domain) sas_plus_problem \<Rightarrow> ('variable, 'domain) sas_plus_plan \<Rightarrow> bool"
  where "is_serial_solution_for_problem \<Psi> \<psi>
    \<equiv> let
        I = sas_plus_problem.initial_of \<Psi>
        ; G = sas_plus_problem.goal_of \<Psi>
        ; ops = sas_plus_problem.operators_of \<Psi>
      in G \<subseteq>\<^sub>m execute_serial_plan_sas_plus I \<psi>
        \<and> list_all (\<lambda>op. ListMem op ops) \<psi>"

context
begin

private lemma execute_operator_sas_plus_effect_i:
  assumes "is_operator_applicable_in s op"
    and "\<forall>(v, a) \<in> set (effect_of op). \<forall>(v', a') \<in> set (effect_of op).
      v \<noteq> v' \<or> a = a'"
    and"(v, a) \<in> set (effect_of op)"
  shows "(s \<then>\<^sub>+ op) v = Some a"
proof -
  let ?effect = "effect_of op"
  have "map_of ?effect v = Some a"
    using map_of_constant_assignments_defined_if[OF assms(2, 3)] try0
    by blast
  thus ?thesis
    unfolding execute_operator_sas_plus_def map_add_def
    by fastforce
qed

private lemma  execute_operator_sas_plus_effect_ii:
  assumes "is_operator_applicable_in s op"
    and "\<forall>(v', a') \<in> set (effect_of op). v' \<noteq> v"
  shows "(s \<then>\<^sub>+ op) v = s v"
proof -
  let ?effect = "effect_of op"
  {
    have "v \<notin> fst ` set ?effect"
      using assms(2)
      by fastforce
    then have "v \<notin> dom (map_of ?effect)"
      using dom_map_of_conv_image_fst[of ?effect]
      by argo
    hence "(s ++ map_of ?effect) v = s v"
      using map_add_dom_app_simps(3)[of v "map_of ?effect" s]
      by blast
  }
  thus ?thesis
    by fastforce
qed

text \<open> Given an operator \<^term>\<open>op\<close> that is applicable in a state \<^term>\<open>s\<close> and has a consistent set
of effects (second assumption) we can now show that the successor state \<^term>\<open>s' \<equiv> s \<then>\<^sub>+ op\<close>
has the following properties:
\begin{itemize}
  \item \<^term>\<open>s' v = Some a\<close> if \<^term>\<open>(v, a)\<close> exist in \<^term>\<open>set (effect_of op)\<close>; and,
  \item \<^term>\<open>s' v = s v\<close> if no \<^term>\<open>(v, a')\<close> exist in \<^term>\<open>set (effect_of op)\<close>.
\end{itemize}
The second property is the case if the operator doesn't have an effect for a variable \<^term>\<open>v\<close>. \<close>

theorem execute_operator_sas_plus_effect:
  assumes "is_operator_applicable_in s op"
    and "\<forall>(v, a) \<in> set (effect_of op).
      \<forall>(v', a') \<in> set (effect_of op). v \<noteq> v' \<or> a = a'"
  shows "(v, a) \<in> set (effect_of op)
      \<longrightarrow> (s \<then>\<^sub>+ op) v = Some a"
    and "(\<forall>a. (v, a) \<notin> set (effect_of op))
      \<longrightarrow> (s \<then>\<^sub>+ op) v = s v"
proof -
  show "(v, a) \<in> set (effect_of op)
    \<longrightarrow> (s \<then>\<^sub>+ op) v = Some a"
    using execute_operator_sas_plus_effect_i[OF assms(1, 2)]
    by blast
next
  show "(\<forall>a. (v, a) \<notin> set (effect_of op))
    \<longrightarrow> (s \<then>\<^sub>+ op) v = s v"
    using execute_operator_sas_plus_effect_ii[OF assms(1)]
    by blast
qed

end

subsection "Parallel Execution Semantics"

\<comment> \<open> Define a type synonym for \emph{SAS+ parallel plans} and add a definition lifting SAS+
operator applicability to parallel plans. \<close>

type_synonym ('variable, 'domain) sas_plus_parallel_plan
  = "('variable, 'domain) sas_plus_operator list list"

definition are_all_operators_applicable_in
  :: "('variable, 'domain) state
    \<Rightarrow> ('variable, 'domain) sas_plus_operator list
    \<Rightarrow> bool"
  where "are_all_operators_applicable_in s ops
    \<equiv> list_all (is_operator_applicable_in s) ops"

definition are_operator_effects_consistent
  :: "('variable, 'domain) sas_plus_operator
    \<Rightarrow> ('variable, 'domain) sas_plus_operator
    \<Rightarrow> bool"
  where "are_operator_effects_consistent op op'
    \<equiv> let
        effect = effect_of op
        ; effect' = effect_of op'
      in list_all (\<lambda>(v, a). list_all (\<lambda>(v', a'). v \<noteq> v' \<or> a = a') effect') effect"

definition are_all_operator_effects_consistent
  :: "('variable, 'domain) sas_plus_operator list
    \<Rightarrow> bool"
  where "are_all_operator_effects_consistent ops
    \<equiv> list_all (\<lambda>op. list_all (are_operator_effects_consistent op) ops) ops"

definition execute_parallel_operator_sas_plus
  :: "('variable, 'domain) state
    \<Rightarrow> ('variable, 'domain) sas_plus_operator list
    \<Rightarrow> ('variable, 'domain) state"
  where "execute_parallel_operator_sas_plus s ops
    \<equiv> foldl (++) s (map (map_of \<circ> effect_of) ops)"

text \<open> We now define parallel execution and parallel traces for SAS+ by lifting the tests for
applicability and effect consistency to parallel SAS+ operators. The definitions are again very
similar to their STRIPS analogs (definitions \ref{isadef:parallel-plan-execution-strips} and
\ref{isadef:parallel-plan-trace-strips}). \<close>

fun execute_parallel_plan_sas_plus
  :: "('variable, 'domain) state
    \<Rightarrow> ('variable, 'domain) sas_plus_parallel_plan
    \<Rightarrow> ('variable, 'domain) state"
  where "execute_parallel_plan_sas_plus s [] = s"
  | "execute_parallel_plan_sas_plus s (ops # opss) = (if
      are_all_operators_applicable_in s ops
      \<and> are_all_operator_effects_consistent ops
    then execute_parallel_plan_sas_plus
      (execute_parallel_operator_sas_plus s ops) opss
    else s)"

fun trace_parallel_plan_sas_plus
  :: "('variable, 'domain) state
    \<Rightarrow> ('variable, 'domain) sas_plus_parallel_plan
    \<Rightarrow> ('variable, 'domain) state list"
  where "trace_parallel_plan_sas_plus s [] = [s]"
  | "trace_parallel_plan_sas_plus s (ops # opss) = s # (if
      are_all_operators_applicable_in s ops
      \<and> are_all_operator_effects_consistent ops
    then trace_parallel_plan_sas_plus
      (execute_parallel_operator_sas_plus s ops) opss
    else [])"

text \<open> A plan \<^term>\<open>\<psi>\<close> is a solution for a SAS+ problem \<^term>\<open>\<Psi>\<close> if
\begin{enumerate}
  \item starting from the initial state \<^term>\<open>\<Psi>\<close>, SAS+ parallel plan execution
    reaches a state which satisfies the described goal state \<^term>\<open>sas_plus_problem.goal_of \<Psi>\<close>; and,
  \item all parallel operators \<^term>\<open>ops\<close> in the plan \<^term>\<open>\<psi>\<close> only consist of operators that
    are specified in the problem description.
\end{enumerate} \<close>
definition is_parallel_solution_for_problem
  :: "('variable, 'domain) sas_plus_problem
    \<Rightarrow> ('variable, 'domain) sas_plus_parallel_plan
    \<Rightarrow> bool"
  where "is_parallel_solution_for_problem \<Psi> \<psi>
    \<equiv> let
        G = sas_plus_problem.goal_of \<Psi>
        ; I = sas_plus_problem.initial_of \<Psi>
        ; Ops = sas_plus_problem.operators_of \<Psi>
      in G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I \<psi>
      \<and> list_all (\<lambda>ops. list_all (\<lambda>op. ListMem op Ops) ops) \<psi>"

context
begin

lemma execute_parallel_operator_sas_plus_cons[simp]:
  "execute_parallel_operator_sas_plus s (op # ops)
    = execute_parallel_operator_sas_plus (s ++  map_of (effect_of op)) ops"
  unfolding execute_parallel_operator_sas_plus_def
  by simp

text \<open>The following lemmas show the properties of SAS+ parallel plan execution traces.
The results are analogous to those for STRIPS. So, let \<^term>\<open>\<tau> \<equiv> trace_parallel_plan_sas_plus I \<psi>\<close>
be a trace of a parallel SAS+ plan \<^term>\<open>\<psi>\<close> with initial state \<^term>\<open>I\<close>, then
\begin{itemize}
  \item the head of the trace \<^term>\<open>\<tau> ! 0\<close> is the initial state of the
problem (lemma \ref{isathm:head-parallel-plan-trace-sas-plus}); moreover,
  \item for all but the last element of the trace---i.e. elements with index
\<^term>\<open>k < length \<tau> - 1\<close>---the parallel operator \<^term>\<open>\<pi> ! k\<close> is executable (lemma
\ref{isathm:parallel-plan-trace-operator-execution-conditions-sas-plus}); and
finally,
  \item for all \<^term>\<open>k < length \<tau>\<close>, the parallel execution of the plan prefix \<^term>\<open>take k \<psi>\<close> with
initial state \<^term>\<open>I\<close> equals the \<^term>\<open>k\<close>-th element of the trace \<^term>\<open>\<tau> ! k\<close> (lemma
\ref{isathm:parallel-trace-plan-prefixes-sas-plus}).
\end{itemize} \<close>

(* TODO? Make invisible? *)
lemma trace_parallel_plan_sas_plus_head_is_initial_state:
  "trace_parallel_plan_sas_plus I \<psi> ! 0 = I"
proof (cases \<psi>)
  case (Cons a list)
  then show ?thesis
    by (cases "are_all_operators_applicable_in I a \<and> are_all_operator_effects_consistent a";
        simp+)
qed simp

lemma trace_parallel_plan_sas_plus_length_gt_one_if:
  assumes "k < length (trace_parallel_plan_sas_plus I \<psi>) - 1"
  shows "1 < length (trace_parallel_plan_sas_plus I \<psi>)"
  using assms
  by linarith

lemma length_trace_parallel_plan_sas_plus_lte_length_plan_plus_one:
  shows "length (trace_parallel_plan_sas_plus I \<psi>) \<le> length \<psi> + 1"
proof (induction \<psi> arbitrary: I)
  case (Cons a \<psi>)
  then show ?case
    proof (cases "are_all_operators_applicable_in I a \<and> are_all_operator_effects_consistent a")
      case True
      let ?I' = "execute_parallel_operator_sas_plus I a"
      {
        have "trace_parallel_plan_sas_plus I (a # \<psi>) = I # trace_parallel_plan_sas_plus ?I' \<psi>"
          using True
          by auto
        then have "length (trace_parallel_plan_sas_plus I (a # \<psi>))
          = length (trace_parallel_plan_sas_plus ?I' \<psi>) + 1"
          by simp
        moreover have "length (trace_parallel_plan_sas_plus ?I' \<psi>) \<le> length \<psi> + 1"
          using Cons.IH[of ?I']
          by blast
        ultimately have "length (trace_parallel_plan_sas_plus I (a # \<psi>)) \<le> length (a # \<psi>) + 1"
          by simp
      }
      thus ?thesis
        by blast
    qed auto
qed simp

lemma plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements:
  assumes "k < length (trace_parallel_plan_sas_plus I \<psi>) - 1"
  obtains ops \<psi>' where "\<psi> = ops # \<psi>'"
proof -
  let ?\<tau> = "trace_parallel_plan_sas_plus I \<psi>"
  have "length ?\<tau> \<le> length \<psi> + 1"
    using length_trace_parallel_plan_sas_plus_lte_length_plan_plus_one
    by fast
  then have "0 < length \<psi>"
    using trace_parallel_plan_sas_plus_length_gt_one_if[OF assms]
    by fastforce
  then obtain k' where "length \<psi> = Suc k'"
    using gr0_implies_Suc
    by meson
  thus ?thesis using that
    using length_Suc_conv[of \<psi> k']
    by blast
qed

lemma trace_parallel_plan_sas_plus_step_implies_operator_execution_condition_holds:
  assumes "k < length (trace_parallel_plan_sas_plus I \<pi>) - 1"
  shows "are_all_operators_applicable_in (trace_parallel_plan_sas_plus I \<pi> ! k) (\<pi> ! k)
      \<and> are_all_operator_effects_consistent (\<pi> ! k)"
using assms
proof  (induction "\<pi>" arbitrary: I k)
  \<comment> \<open> NOTE Base case yields contradiction with assumption and can be left to automation. \<close>
  case (Cons a \<pi>)
  then show ?case
    proof (cases "are_all_operators_applicable_in I a \<and> are_all_operator_effects_consistent a")
      case True
      have trace_parallel_plan_sas_plus_cons: "trace_parallel_plan_sas_plus I (a # \<pi>)
        = I # trace_parallel_plan_sas_plus (execute_parallel_operator_sas_plus I a) \<pi>"
        using True
        by simp
      then show ?thesis
      proof (cases "k")
        case 0
        have "trace_parallel_plan_sas_plus I (a # \<pi>) ! 0 = I"
          using trace_parallel_plan_sas_plus_cons
          by simp
        moreover have "(a # \<pi>) ! 0 = a"
          by simp
        ultimately show ?thesis
          using True 0
          by presburger
      next
        case (Suc k')
        have "trace_parallel_plan_sas_plus I (a # \<pi>) ! Suc k'
          = trace_parallel_plan_sas_plus (execute_parallel_operator_sas_plus I a) \<pi> ! k'"
          using trace_parallel_plan_sas_plus_cons
          by simp
        moreover have "(a # \<pi>) ! Suc k' = \<pi> ! k'"
          by simp
        moreover {
          let ?I' = "execute_parallel_operator_sas_plus I a"
          have "length (trace_parallel_plan_sas_plus I (a # \<pi>))
            = 1 + length (trace_parallel_plan_sas_plus ?I' \<pi>)"
            using trace_parallel_plan_sas_plus_cons
            by auto
          then have "k' < length (trace_parallel_plan_sas_plus ?I' \<pi>) - 1"
            using Cons.prems Suc
            unfolding Suc_eq_plus1
            by fastforce
          hence "are_all_operators_applicable_in
            (trace_parallel_plan_sas_plus (execute_parallel_operator_sas_plus I a) \<pi> ! k')
            (\<pi> ! k')
          \<and> are_all_operator_effects_consistent (\<pi> ! k')"
            using Cons.IH[of k' "execute_parallel_operator_sas_plus I a"] Cons.prems Suc trace_parallel_plan_sas_plus_cons
            by simp
        }
        ultimately show ?thesis
          using Suc
          by argo
      qed
    next
      case False
      then have "trace_parallel_plan_sas_plus I (a # \<pi>) = [I]"
        by force
      then have "length (trace_parallel_plan_sas_plus I (a # \<pi>)) - 1 = 0"
        by simp
      \<comment> \<open> NOTE Thesis follows from contradiction with assumption. \<close>
      then show ?thesis
        using Cons.prems
        by force
    qed
qed auto

lemma trace_parallel_plan_sas_plus_prefix:
  assumes "k < length (trace_parallel_plan_sas_plus I \<psi>)"
  shows "trace_parallel_plan_sas_plus I \<psi> ! k = execute_parallel_plan_sas_plus I (take k \<psi>)"
  using assms
proof  (induction \<psi> arbitrary: I k)
  case (Cons a \<psi>)
  then show ?case
    proof (cases "are_all_operators_applicable_in I a \<and> are_all_operator_effects_consistent a")
      case True
      let ?\<sigma> = "trace_parallel_plan_sas_plus I (a # \<psi>)"
        and ?I' = "execute_parallel_operator_sas_plus I a"
      have \<sigma>_equals: "?\<sigma> = I # trace_parallel_plan_sas_plus ?I' \<psi>"
        using True
        by auto
      then show ?thesis
        proof (cases "k = 0")
          case False
          obtain k' where k_is_suc_of_k': "k = Suc k'"
            using not0_implies_Suc[OF False]
            by blast
          then have "execute_parallel_plan_sas_plus I (take k (a # \<psi>))
            = execute_parallel_plan_sas_plus ?I' (take k' \<psi>)"
            using True
            by simp
          moreover have "trace_parallel_plan_sas_plus I (a # \<psi>) ! k
            = trace_parallel_plan_sas_plus ?I' \<psi> ! k'"
            using \<sigma>_equals k_is_suc_of_k'
            by simp
          moreover {
            have "k' < length (trace_parallel_plan_sas_plus ?I' \<psi>)"
              using Cons.prems \<sigma>_equals k_is_suc_of_k'
              by force
            hence "trace_parallel_plan_sas_plus ?I' \<psi> ! k'
              = execute_parallel_plan_sas_plus ?I' (take k' \<psi>)"
              using Cons.IH[of k' ?I']
              by blast
          }
          ultimately show ?thesis
            by presburger
        qed simp
    next
      case operator_precondition_violated: False
      then show ?thesis
      proof (cases "k = 0")
        case False
        then have "trace_parallel_plan_sas_plus I (a # \<psi>) = [I]"
          using operator_precondition_violated
          by force
        moreover have "execute_parallel_plan_sas_plus I (take k (a # \<psi>)) = I"
          using Cons.prems operator_precondition_violated
          by force
        ultimately show ?thesis
          using Cons.prems nth_Cons_0
          by auto
      qed simp
    qed
qed simp

text \<open> Finally, we obtain the result corresponding to lemma
\ref{isathm:parallel-solution-trace-strips} in the SAS+ case: it is equivalent to say that parallel
SAS+ execution reaches the problem's goal state and that the last element of the corresponding
trace satisfies the goal state. \<close>
lemma  execute_parallel_plan_sas_plus_reaches_goal_iff_goal_is_last_element_of_trace:
  "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I \<psi>
    \<longleftrightarrow> G \<subseteq>\<^sub>m last (trace_parallel_plan_sas_plus I \<psi>)"
proof   -
  let ?\<tau> = "trace_parallel_plan_sas_plus I \<psi>"
  show ?thesis
  proof (rule iffI)
    assume "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I \<psi>"
    thus "G \<subseteq>\<^sub>m last ?\<tau>"
      proof (induction \<psi> arbitrary: I)
        \<comment> \<open> NOTE Base case follows from simplification. \<close>
        case (Cons ops \<psi>)
        show ?case
          proof (cases "are_all_operators_applicable_in I ops
            \<and> are_all_operator_effects_consistent ops")
            case True
            let ?s = "execute_parallel_operator_sas_plus I ops"
            {
              have "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus ?s \<psi>"
                using True Cons.prems
                by simp
              hence "G \<subseteq>\<^sub>m last (trace_parallel_plan_sas_plus ?s \<psi>)"
                using Cons.IH
                by auto
            }
            moreover {
              have "trace_parallel_plan_sas_plus I (ops # \<psi>)
                = I # trace_parallel_plan_sas_plus ?s \<psi>"
                using True
                by simp
              moreover have "trace_parallel_plan_sas_plus ?s \<psi> \<noteq> []"
                using trace_parallel_plan_sas_plus.elims
                by blast
              ultimately have "last (trace_parallel_plan_sas_plus I (ops # \<psi>))
                = last (trace_parallel_plan_sas_plus ?s \<psi>)"
                using last_ConsR
                  by simp
            }
            ultimately show ?thesis
              by argo
          next
            case False
            then have "G \<subseteq>\<^sub>m I"
              using Cons.prems
              by force
            thus ?thesis
              using False
              by force
          qed
      qed force
  next
    assume "G \<subseteq>\<^sub>m last ?\<tau>"
    thus "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I \<psi>"
      proof (induction \<psi> arbitrary: I)
        case (Cons ops \<psi>)
        thus ?case
          proof (cases "are_all_operators_applicable_in I ops
            \<and> are_all_operator_effects_consistent ops")
            case True
            let ?s = "execute_parallel_operator_sas_plus I ops"
            {
              have "trace_parallel_plan_sas_plus I (ops # \<psi>)
                = I # trace_parallel_plan_sas_plus ?s \<psi>"
                using True
                by simp
              moreover have "trace_parallel_plan_sas_plus ?s \<psi> \<noteq> []"
                using trace_parallel_plan_sas_plus.elims
                by blast
              ultimately have "last (trace_parallel_plan_sas_plus I (ops # \<psi>))
                = last (trace_parallel_plan_sas_plus ?s \<psi>)"
                using last_ConsR
                by simp
              hence "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus ?s \<psi>"
                using Cons.IH[of ?s] Cons.prems
                by argo
            }
            moreover have "execute_parallel_plan_sas_plus I (ops # \<psi>)
                = execute_parallel_plan_sas_plus ?s \<psi>"
              using True
              by force
            ultimately show ?thesis
              by argo
          next
            case False
            have "G \<subseteq>\<^sub>m I"
              using Cons.prems False
              by simp
            thus ?thesis
              using False
              by force
          qed
      qed simp
  qed
qed

lemma is_parallel_solution_for_problem_plan_operator_set:
  (* TODO refactor move + make visible? *)
  fixes \<Psi> :: "('v, 'd) sas_plus_problem"
  assumes "is_parallel_solution_for_problem \<Psi> \<psi>"
  shows "\<forall>ops \<in> set \<psi>. \<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
  using assms
  unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff operators_of_def
  by presburger

end

subsection "Serializable Parallel Plans"

text \<open> Again we want to establish conditions for the serializability of plans. Let
\<^term>\<open>\<Psi>\<close> be a SAS+ problem instance and let \<^term>\<open>\<psi>\<close> be a serial solution. We obtain the following
two important results, namely that
\begin{enumerate}
  \item the embedding \<^term>\<open>embed \<psi>\<close> of \<^term>\<open>\<psi>\<close> is a parallel solution for \<^term>\<open>\<Psi>\<close>
(lemma \ref{isathm:serial-sas-plus-embedding}); and conversely that,
  \item a parallel solution to \<^term>\<open>\<Psi>\<close> that has the form of an embedded serial plan can be
concatenated to obtain a serial solution (lemma
\ref{isathm:embedded-serial-solution-flattening-sas-plus}).
\end{enumerate} \<close>

context
begin

(* TODO refactor *)
lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_i:
  assumes "is_operator_applicable_in s op"
    "are_operator_effects_consistent op op"
  shows "s \<then>\<^sub>+ op = execute_parallel_operator_sas_plus s [op]"
proof -
  have "are_all_operators_applicable_in s [op]"
    unfolding are_all_operators_applicable_in_def
       SAS_Plus_Representation.execute_operator_sas_plus_def
      is_operator_applicable_in_def SAS_Plus_Representation.is_operator_applicable_in_def
      list_all_iff
    using assms(1)
    by fastforce
  moreover have "are_all_operator_effects_consistent [op]"
    unfolding are_all_operator_effects_consistent_def list_all_iff
    using assms(2)
    by fastforce
  ultimately show ?thesis
    unfolding execute_parallel_operator_sas_plus_def execute_operator_sas_plus_def
    by simp
qed

lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_ii:
  fixes I :: "('variable, 'domain) state"
  assumes "\<forall>op \<in> set \<psi>. are_operator_effects_consistent op op"
    and "G \<subseteq>\<^sub>m execute_serial_plan_sas_plus I \<psi>"
  shows "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I (embed \<psi>)"
  using assms
proof (induction \<psi> arbitrary: I)
  case (Cons op \<psi>)
  show ?case
    proof (cases "are_all_operators_applicable_in I [op]")
      case True
      let ?J = "execute_operator_sas_plus I op"
        let ?J' = "execute_parallel_operator_sas_plus I [op]"
      have "SAS_Plus_Representation.is_operator_applicable_in I op"
        using True
        unfolding are_all_operators_applicable_in_def list_all_iff
        by force
      moreover have "G \<subseteq>\<^sub>m execute_serial_plan_sas_plus ?J \<psi>"
        using Cons.prems(2) calculation(1)
        by simp
      moreover have "are_all_operator_effects_consistent [op]"
        unfolding are_all_operator_effects_consistent_def list_all_iff Let_def
        using Cons.prems(1)
        by simp
      moreover have "execute_parallel_plan_sas_plus I ([op] # embed \<psi>)
        = execute_parallel_plan_sas_plus ?J' (embed \<psi>)"
        using True calculation(3)
        by simp
      moreover {
        have "is_operator_applicable_in I op"
          "are_operator_effects_consistent op op"
          using True Cons.prems(1)
          unfolding are_all_operators_applicable_in_def
            SAS_Plus_Representation.is_operator_applicable_in_def list_all_iff
          by fastforce+
        hence "?J = ?J'"
          using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_i
            calculation(1)
          by blast
      }
      ultimately show ?thesis
        using Cons.IH[of ?J] Cons.prems(1)
        by simp
    next
      case False
      moreover have "\<not>is_operator_applicable_in I op"
        using calculation
        unfolding are_all_operators_applicable_in_def
          SAS_Plus_Representation.is_operator_applicable_in_def list_all_iff
        by fastforce
      moreover have "G \<subseteq>\<^sub>m I"
        using Cons.prems(2) calculation(2)
        unfolding is_operator_applicable_in_def
        by simp
      moreover have "execute_parallel_plan_sas_plus I ([op] # embed \<psi>) = I"
        using calculation(1)
        by fastforce
      ultimately show ?thesis
        by force
    qed
  qed simp

lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iii:
  assumes "is_valid_problem_sas_plus \<Psi>"
    and "is_serial_solution_for_problem \<Psi> \<psi>"
    and "op \<in> set \<psi>"
  shows "are_operator_effects_consistent op op"
proof -
  have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
    using assms(2) assms(3)
    unfolding is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
    by fastforce
  then have "is_valid_operator_sas_plus \<Psi> op"
    using is_valid_problem_sas_plus_then(2) assms(1, 3)
    by auto
  thus ?thesis
    unfolding are_operator_effects_consistent_def Let_def list_all_iff ListMem_iff
    using is_valid_operator_sas_plus_then(6)
    by fast
qed

lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iv:
  fixes \<Psi> :: "('v, 'd) sas_plus_problem"
  assumes "\<forall>op \<in> set \<psi>. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
  shows "\<forall>ops \<in> set (embed \<psi>). \<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
proof -
  let ?\<psi>' = "embed \<psi>"
  have nb: "set ?\<psi>' = { [op] | op. op \<in> set \<psi> }"
    by (induction \<psi>; force)
  {
    fix ops
    assume "ops \<in> set ?\<psi>'"
    moreover obtain op where "ops = [op]" and "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
      using assms(1) nb calculation
      by blast
    ultimately have "\<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
      by fastforce
  }
  thus ?thesis..
qed

theorem execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus:
  assumes "is_valid_problem_sas_plus \<Psi>"
    and "is_serial_solution_for_problem \<Psi> \<psi>"
  shows "is_parallel_solution_for_problem \<Psi> (embed \<psi>)"
proof  -
  let ?ops = "sas_plus_problem.operators_of \<Psi>"
    and ?\<psi>' = "embed \<psi>"
  {
    thm execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_ii[OF]
    have "(\<Psi>)\<^sub>G\<^sub>+ \<subseteq>\<^sub>m execute_serial_plan_sas_plus ((\<Psi>)\<^sub>I\<^sub>+) \<psi>"
      using assms(2)
      unfolding is_serial_solution_for_problem_def Let_def
      by simp
    moreover have "\<forall>op \<in> set \<psi>. are_operator_effects_consistent op op"
      using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iii[OF assms]..
    ultimately have "(\<Psi>)\<^sub>G\<^sub>+ \<subseteq>\<^sub>m execute_parallel_plan_sas_plus ((\<Psi>)\<^sub>I\<^sub>+) ?\<psi>'"
      using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_ii
      by blast
  }
  moreover {
    have "\<forall>op \<in> set \<psi>. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
      using assms(2)
      unfolding is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
      by fastforce
    hence "\<forall>ops \<in> set ?\<psi>'. \<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
      using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iv
      by blast
  }
  ultimately show ?thesis
    unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff Let_def goal_of_def
      initial_of_def
    by fastforce
qed

lemma flattening_lemma_i:
  fixes \<Psi> :: "('v, 'd) sas_plus_problem"
  assumes "\<forall>ops \<in> set \<pi>. \<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
  shows "\<forall>op \<in> set (concat \<pi>). op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
proof -
  {
    fix op
    assume "op \<in> set (concat \<pi>)"
    moreover have "op \<in> (\<Union>ops \<in> set \<pi>. set ops)"
      using calculation
      unfolding set_concat.
    then obtain ops where "ops \<in> set \<pi>" and "op \<in> set ops"
      using UN_iff
      by blast
    ultimately have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
      using assms
      by blast
  }
  thus ?thesis..
qed

lemma flattening_lemma_ii:
  fixes I :: "('variable, 'domain) state"
  assumes "\<forall>ops \<in> set \<psi>. \<exists>op. ops = [op] \<and> is_valid_operator_sas_plus \<Psi> op "
    and "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus I \<psi>"
  shows "G \<subseteq>\<^sub>m execute_serial_plan_sas_plus I (concat \<psi>)"
proof -
  show ?thesis
    using assms
    proof (induction \<psi> arbitrary: I)
      case (Cons ops \<psi>)
      obtain op where ops_is: "ops = [op]" and is_valid_op: "is_valid_operator_sas_plus \<Psi> op"
        using Cons.prems(1)
        by auto
      then show ?case
        proof (cases "are_all_operators_applicable_in I ops")
          case True
          let ?J = "execute_parallel_operator_sas_plus I [op]"
            and ?J' = "execute_operator_sas_plus I op"
          have nb\<^sub>1: "is_operator_applicable_in I op"
            using True ops_is
            unfolding are_all_operators_applicable_in_def is_operator_applicable_in_def
              list_all_iff
            by force
          have nb\<^sub>2: "are_operator_effects_consistent op op"
            unfolding are_operator_effects_consistent_def list_all_iff Let_def
            using is_valid_operator_sas_plus_then(6)[OF is_valid_op]
            by blast
          have "are_all_operator_effects_consistent ops"
            using ops_is
            unfolding are_all_operator_effects_consistent_def list_all_iff
            using nb\<^sub>2
            by force
          moreover have "G \<subseteq>\<^sub>m execute_parallel_plan_sas_plus ?J \<psi>"
            using Cons.prems(2) True calculation ops_is
            by fastforce
          moreover have "execute_serial_plan_sas_plus I (concat (ops # \<psi>))
              = execute_serial_plan_sas_plus ?J' (concat \<psi>)"
              using ops_is nb\<^sub>1 is_operator_applicable_in_def
              by simp
          moreover have "?J = ?J'"
            using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_i[OF nb\<^sub>1 nb\<^sub>2]
            by simp
          ultimately show ?thesis
            using Cons.IH[of ?J] Cons.prems(1)
            by force
        next
          case False
          moreover have "G \<subseteq>\<^sub>m I"
            using Cons.prems(2) calculation
            by fastforce
          moreover {
            have "\<not>is_operator_applicable_in I op"
              using False ops_is
              unfolding are_all_operators_applicable_in_def
                is_operator_applicable_in_def list_all_iff
              by force
            moreover have "execute_serial_plan_sas_plus I (concat (ops # \<psi>))
              = execute_serial_plan_sas_plus I (op # concat \<psi>)"
              using ops_is
              by force
            ultimately have "execute_serial_plan_sas_plus I (concat (ops # \<psi>)) = I"
              using False
              unfolding is_operator_applicable_in_def
              by fastforce
          }
          ultimately show ?thesis
            by argo
        qed
    qed force
qed

lemma flattening_lemma:
  assumes "is_valid_problem_sas_plus \<Psi>"
    and "\<forall>ops \<in> set \<psi>. \<exists>op. ops = [op]"
    and "is_parallel_solution_for_problem \<Psi> \<psi>"
  shows "is_serial_solution_for_problem \<Psi> (concat \<psi>)"
proof  -
  let ?\<psi>' = "concat \<psi>"
  {
    have "\<forall>ops \<in> set \<psi>. \<forall>op \<in> set ops. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
      using assms(3)
      unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff
      by force
    hence "\<forall>op \<in> set ?\<psi>'. op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
      using flattening_lemma_i
      by blast
  }
  moreover {
    {
      fix ops
      assume "ops \<in> set \<psi>"
      moreover obtain op where "ops = [op]"
        using assms(2) calculation
        by blast
      moreover have "op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+)"
        using assms(3) calculation
        unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff
        by force
      moreover have "is_valid_operator_sas_plus \<Psi> op"
        using assms(1) calculation(3)
        unfolding is_valid_problem_sas_plus_def Let_def list_all_iff
          ListMem_iff
        by simp
      ultimately have "\<exists>op. ops = [op] \<and> is_valid_operator_sas_plus \<Psi> op"
        by blast
    }
    moreover have "(\<Psi>)\<^sub>G\<^sub>+ \<subseteq>\<^sub>m execute_parallel_plan_sas_plus ((\<Psi>)\<^sub>I\<^sub>+) \<psi>"
      using assms(3)
      unfolding is_parallel_solution_for_problem_def
      by fastforce
    ultimately have "(\<Psi>)\<^sub>G\<^sub>+ \<subseteq>\<^sub>m execute_serial_plan_sas_plus ((\<Psi>)\<^sub>I\<^sub>+) ?\<psi>'"
      using flattening_lemma_ii
      by blast
  }
  ultimately show "is_serial_solution_for_problem \<Psi> ?\<psi>'"
    unfolding is_serial_solution_for_problem_def list_all_iff ListMem_iff
    by fastforce
qed
end

subsection "Auxiliary lemmata on SAS+"

context
begin

\<comment> \<open> Relate the locale definition \<open>range_of\<close> with its corresponding implementation for valid
operators and given an effect \<open>(v, a)\<close>. \<close>
lemma is_valid_operator_sas_plus_then_range_of_sas_plus_op_is_set_range_of_op:
  assumes "is_valid_operator_sas_plus \<Psi> op"
    and "(v, a) \<in> set (precondition_of op) \<or> (v, a) \<in> set (effect_of op)"
  shows "(\<R>\<^sub>+ \<Psi> v) = set (the (sas_plus_problem.range_of \<Psi> v))"
proof -
  consider (A) "(v, a) \<in> set (precondition_of op)"
    | (B)  "(v, a) \<in> set (effect_of op)"
    using assms(2)..
  thus ?thesis
    proof (cases)
      case A
      then have "(\<R>\<^sub>+ \<Psi> v) \<noteq> {}" and "a \<in> \<R>\<^sub>+ \<Psi> v"
        using assms
        unfolding range_of_def
        using is_valid_operator_sas_plus_then(2)
        by fast+
      thus ?thesis
        unfolding range_of'_def option.case_eq_if
        by auto
    next
      case B
      then have "(\<R>\<^sub>+ \<Psi> v) \<noteq> {}" and "a \<in> \<R>\<^sub>+ \<Psi> v"
        using assms
        unfolding range_of_def
        using is_valid_operator_sas_plus_then(4)
        by fast+
      thus ?thesis
        unfolding range_of'_def option.case_eq_if
        by auto
    qed
qed

lemma set_the_range_of_is_range_of_sas_plus_if:
  fixes \<Psi> :: "('v, 'd) sas_plus_problem"
  assumes "is_valid_problem_sas_plus \<Psi>"
    "v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
  shows "set (the (sas_plus_problem.range_of \<Psi> v)) = \<R>\<^sub>+ \<Psi> v"
proof-
  have "v \<in> set((\<Psi>)\<^sub>\<V>\<^sub>+)"
    using assms(2)
    unfolding variables_of_def.
  moreover have "(\<R>\<^sub>+ \<Psi> v) \<noteq> {}"
    using assms(1) calculation is_valid_problem_sas_plus_then(1)
    by blast
  moreover have "sas_plus_problem.range_of \<Psi> v \<noteq> None"
    and "sas_plus_problem.range_of \<Psi> v \<noteq> Some []"
    using calculation(2) range_of_not_empty
    unfolding range_of_def
    by fast+
  ultimately show ?thesis
    unfolding option.case_eq_if range_of'_def
    by force
qed

lemma sublocale_sas_plus_finite_domain_representation_ii:
  fixes \<Psi>::"('v,'d) sas_plus_problem"
  assumes "is_valid_problem_sas_plus \<Psi>"
  shows "\<forall>v \<in> set ((\<Psi>)\<^sub>\<V>\<^sub>+). (\<R>\<^sub>+ \<Psi> v) \<noteq> {}"
    and "\<forall>op \<in> set ((\<Psi>)\<^sub>\<O>\<^sub>+). is_valid_operator_sas_plus \<Psi> op"
    and "dom ((\<Psi>)\<^sub>I\<^sub>+) = set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
    and "\<forall>v \<in> dom ((\<Psi>)\<^sub>I\<^sub>+). the (((\<Psi>)\<^sub>I\<^sub>+) v) \<in> \<R>\<^sub>+ \<Psi> v"
    and "dom ((\<Psi>)\<^sub>G\<^sub>+) \<subseteq> set ((\<Psi>)\<^sub>\<V>\<^sub>+)"
    and "\<forall>v \<in> dom ((\<Psi>)\<^sub>G\<^sub>+). the (((\<Psi>)\<^sub>G\<^sub>+) v) \<in> \<R>\<^sub>+ \<Psi> v"
  using is_valid_problem_sas_plus_then[OF assms]
  by auto

end

end