(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

section "Further Plane Graph Properties"

theory PlaneProps
imports Invariants
begin

subsection \<open>@{const final}\<close>

lemma plane_final_facesAt:
assumes "inv g" "final g" "v : \<V> g" "f \<in> set (facesAt g v)" shows "final f"
proof -
  from assms(1,3,4) have "f \<in> \<F> g" by(blast intro: minGraphProps inv_mgp)
  with assms(2) show ?thesis by (rule finalGraph_face)
qed

lemma setFinal_notin_finals:
 "\<lbrakk> f \<in> \<F> g; \<not> final f; minGraphProps g \<rbrakk> \<Longrightarrow> setFinal f \<notin> set (finals g)"
apply(drule minGraphProps11)
apply(cases f)
apply(fastforce simp:finals_def setFinal_def normFaces_def normFace_def
                    verticesFrom_def minVertex_def inj_on_def distinct_map
           split:facetype.splits)
done

subsection \<open>@{const degree}\<close>

lemma planeN4: "inv g \<Longrightarrow> f \<in> \<F> g \<Longrightarrow> 3 \<le> |vertices f|"
apply(subgoal_tac "2 < | vertices f |")
 apply arith
apply(drule inv_mgp)
apply (erule (1) minGraphProps2)
done

lemma degree_eq:
assumes pl: "inv g" and fin: "final g" and v: "v : \<V> g"
shows "degree g v = tri g v + quad g v + except g v"
proof -
  have dist: "distinct(facesAt g v)" using pl v by simp
  have 3: "\<forall>f \<in> set(facesAt g v). |vertices f| = 3 \<or> |vertices f| = 4 \<or>
                                  |vertices f| \<ge> 5"
  proof
    fix f assume f: "f \<in> set (facesAt g v)"
    hence "|vertices f| \<ge> 3"
      using minGraphProps5[OF inv_mgp[OF pl] v f] planeN4[OF pl] by blast
    thus "|vertices f| = 3 \<or> |vertices f| = 4 \<or> |vertices f| \<ge> 5" by arith
  qed
  have "degree g v = |facesAt g v|" by(simp add:degree_def)
  also have "\<dots> = card(set(facesAt g v))" by (simp add:distinct_card[OF dist])
  also have "set(facesAt g v) = {f \<in> set(facesAt g v). |vertices f| = 3} \<union>
                                {f \<in> set(facesAt g v). |vertices f| = 4} \<union>
                                {f \<in> set(facesAt g v). |vertices f| \<ge> 5}"
    (is "_ = ?T \<union> ?Q \<union> ?E")
    using 3 by blast
  also have "card(?T \<union> ?Q \<union> ?E) = card ?T + card ?Q + card ?E"
    apply (subst card_Un_disjoint)
    apply simp
    apply simp
    apply fastforce
    apply (subst card_Un_disjoint)
    apply simp
    apply simp
    apply fastforce
    apply simp
    done
  also have "\<dots> = tri g v + quad g v + except g v" using fin
    by(simp add:tri_def quad_def except_def
                distinct_card[symmetric] distinct_filter[OF dist]
                plane_final_facesAt[OF pl fin v] cong:conj_cong)
  finally show ?thesis .
qed

lemma plane_fin_exceptionalVertex_def:
assumes pl: "inv g" and fin: "final g" and v: "v : \<V> g"
shows "exceptionalVertex g v =
 ( | [f \<leftarrow> facesAt g v . 5 \<le> |vertices f| ] | \<noteq> 0)"
proof -
  have "\<And>f. f \<in> set (facesAt g v) \<Longrightarrow> final f"
    by(rule plane_final_facesAt[OF pl fin v])
  then show ?thesis by (simp add: filter_simp exceptionalVertex_def except_def)
qed

lemma not_exceptional:
  "inv g \<Longrightarrow> final g \<Longrightarrow> v : \<V> g \<Longrightarrow> f \<in> set (facesAt g v) \<Longrightarrow>
  \<not> exceptionalVertex g v \<Longrightarrow> |vertices f| \<le> 4"
by (auto simp add: plane_fin_exceptionalVertex_def except_def filter_empty_conv)

subsection \<open>Misc\<close>

lemma in_next_plane0I:
assumes "g' \<in> set (generatePolygon n v f g)" "f \<in> set (nonFinals g)"
        "v \<in> \<V> f" "3 \<le> n" "n < 4+p"
shows "g' \<in> set (next_plane0\<^bsub>p\<^esub> g)"
proof -
  from assms have
    "\<exists>n\<in>{3..<4 + p}. g' \<in> set (generatePolygon n v f g)"
    by auto
  with assms have
    "\<exists>v\<in>\<V> f. \<exists>n\<in>{3..<4 + p}. g' \<in> set (generatePolygon n v f g)"
    by auto
  with assms have
    "\<exists>f\<in>set (nonFinals g). \<exists>v\<in>\<V> f. \<exists>n\<in>{3..<4 + p}. g' \<in> set (generatePolygon n v f g)"
    by auto
  moreover have "\<not> final g" using assms(2)
    by (auto simp: nonFinals_def finalGraph_def filter_empty_conv)
  ultimately show ?thesis
    by (simp add: next_plane0_def)
qed

lemma next_plane0_nonfinals: "g [next_plane0\<^bsub>p\<^esub>]\<rightarrow> g' \<Longrightarrow> nonFinals g \<noteq> []"
by(auto simp:next_plane0_def finalGraph_def)

lemma next_plane0_ex:
assumes a: "g [next_plane0\<^bsub>p\<^esub>]\<rightarrow> g'"
shows "\<exists>f\<in> set(nonFinals g). \<exists>v \<in> \<V> f. \<exists>i \<in> set([3..<Suc(maxGon p)]).
       g' \<in> set (generatePolygon i v f g)"
proof -
  from a have "\<not> final g" by (auto simp add: next_plane0_def)
  with a show ?thesis
   by (auto simp add: next_plane0_def nonFinals_def)
qed

lemma step_outside2:
 "inv g \<Longrightarrow> g [next_plane0\<^bsub>p\<^esub>]\<rightarrow> g' \<Longrightarrow> \<not> final g' \<Longrightarrow> |faces g'| \<noteq> 2"
apply(frule inv_two_faces)
apply(frule inv_finals_nonempty)
apply(drule inv_mgp)
apply(insert len_faces_sum[of g] len_faces_sum[of g'])
apply(subgoal_tac "|nonFinals g| \<noteq> 0")
 prefer 2 apply(drule next_plane0_nonfinals) apply simp
apply(subgoal_tac "|nonFinals g'| \<noteq> 0")
 prefer 2 apply(simp add:finalGraph_def)
apply(drule (1) next_plane0_incr_faces)
apply(case_tac "|faces g| = 2")
 prefer 2 apply arith
apply(subgoal_tac "|finals g| \<noteq> 0")
 apply arith
apply simp
done

subsection\<open>Increasing final faces\<close>

lemma set_finals_splitFace[simp]:
 "\<lbrakk> f \<in> \<F> g; \<not> final f \<rbrakk> \<Longrightarrow>
  set(finals(snd(snd(splitFace g u v f vs)))) = set(finals g)"
apply(auto simp add:splitFace_def split_def finals_def
                split_face_def)
 apply(drule replace5)
 apply(clarsimp)
apply(erule replace4)
apply clarsimp
done

lemma next_plane0_finals_incr:
 "g [next_plane0\<^bsub>p\<^esub>]\<rightarrow> g' \<Longrightarrow> f \<in> set(finals g) \<Longrightarrow> f \<in> set(finals g')"
apply(auto simp:next_plane0_def generatePolygon_def split:if_split_asm)
apply(erule subdivFace_pres_finals)
apply (simp add:nonFinals_def)
done

lemma next_plane0_finals_subset:
  "g' \<in> set (next_plane0\<^bsub>p\<^esub> g) \<Longrightarrow>
  set (finals g) \<subseteq> set (finals g')"
  by (auto simp add: next_plane0_finals_incr)

lemma next_plane0_final_mono:
  "\<lbrakk> g' \<in> set (next_plane0\<^bsub>p\<^esub> g); f \<in> \<F> g; final f \<rbrakk> \<Longrightarrow> f \<in> \<F> g'"
apply(drule next_plane0_finals_subset)
apply(simp add:finals_def)
apply blast
done

subsection\<open>Increasing vertices\<close>

lemma next_plane0_vertices_subset:
 "\<lbrakk> g' \<in> set (next_plane0\<^bsub>p\<^esub> g); minGraphProps g \<rbrakk> \<Longrightarrow> \<V> g \<subseteq> \<V> g'"
apply(rule next_plane0_incr)
    apply(erule (1) subset_trans)
   apply(simp add: vertices_makeFaceFinal)
  defer apply assumption+
apply (auto simp: splitFace_def split_def vertices_graph)
done

subsection\<open>Increasing vertex degrees\<close>

lemma next_plane0_incr_faceListAt:
 "\<lbrakk> g' \<in> set (next_plane0\<^bsub>p\<^esub> g); minGraphProps g \<rbrakk>
  \<Longrightarrow> |faceListAt g| \<le> |faceListAt g'| \<and>
      (\<forall>v < |faceListAt g|. |faceListAt g ! v| \<le> |faceListAt g' ! v| )"
 (is "_ \<Longrightarrow> _ \<Longrightarrow> ?Q g g'")
apply(rule next_plane0_incr[where Q = ?Q])
prefer 4 apply assumption
prefer 4 apply assumption
  apply(rule conjI) apply fastforce
  apply(clarsimp)
  apply(erule allE, erule impE, assumption)
  apply(erule_tac x = v in allE, erule impE) apply force
  apply force
 apply(simp add: makeFaceFinal_def makeFaceFinalFaceList_def)
apply (simp add: splitFace_def split_def nth_append nth_list_update)
done

lemma next_plane0_incr_degree:
 "\<lbrakk> g' \<in> set (next_plane0\<^bsub>p\<^esub> g); minGraphProps g; v \<in> \<V> g \<rbrakk>
  \<Longrightarrow> degree g v \<le> degree g' v"
apply(frule (1) next_plane0_incr_faceListAt)
apply(frule (1) next_plane0_vertices_subset)
apply(simp add:degree_def facesAt_def)
apply(frule minGraphProps4)
apply(simp add:vertices_graph)
done

subsection\<open>Increasing @{const except}\<close>

lemma next_plane0_incr_except:
assumes "g' \<in> set (next_plane0\<^bsub>p\<^esub> g)" "inv g" "v \<in> \<V> g"
shows "except g v \<le> except g' v"
proof (unfold except_def)
  note inv' = invariantE[OF inv_inv_next_plane0, OF assms(1,2)]
  note mgp = inv_mgp[OF assms(2)] and mgp' = inv_mgp[OF inv']
  note dist = distinct_filter[OF mgp_dist_facesAt[OF mgp \<open>v : \<V> g\<close>]]
  have "v \<in> \<V> g'"
    using assms(3) next_plane0_vertices_subset[OF assms(1) mgp] by blast
  note dist' = distinct_filter[OF mgp_dist_facesAt[OF mgp' \<open>v : \<V> g'\<close>]]
  have "|[f\<leftarrow>facesAt g v . final f \<and> 5 \<le> |vertices f| ]| =
        card{f\<in> set(facesAt g v) . final f \<and> 5 \<le> |vertices f|}"
    (is "?L = card ?M") using distinct_card[OF dist] by simp
  also have "?M = {f\<in> \<F> g. v \<in> \<V> f \<and> final f \<and> 5 \<le> |vertices f|}"
    by(simp add: minGraphProps_facesAt_eq[OF mgp assms(3)])
  also have "\<dots> = {f \<in> set(finals g) . v \<in> \<V> f \<and> 5 \<le> |vertices f|}"
    by(auto simp:finals_def)
  also have "card \<dots> \<le> card{f \<in> set(finals g'). v \<in> \<V> f \<and> 5 \<le> |vertices f|}"
    (is "_ \<le> card ?M")
    apply(rule card_mono)
    apply simp
    using next_plane0_finals_subset[OF assms(1)] by blast
  also have "?M = {f\<in> \<F> g' . v \<in> \<V> f \<and> final f \<and> 5 \<le> |vertices f|}"
    by(auto simp:finals_def)
  also have "\<dots> = {f \<in> set(facesAt g' v) . final f \<and> 5 \<le> |vertices f|}"
    by(simp add: minGraphProps_facesAt_eq[OF mgp' \<open>v \<in> \<V> g'\<close>])
  also have "card \<dots> =
    |[f \<leftarrow> facesAt g' v . final f \<and> 5 \<le> |vertices f| ]|" (is "_ = ?R")
    using distinct_card[OF dist'] by simp
  finally show "?L \<le> ?R" .
qed

subsection\<open>Increasing edges\<close>

lemma next_plane0_set_edges_subset:
  "\<lbrakk> minGraphProps g;  g [next_plane0\<^bsub>p\<^esub>]\<rightarrow> g' \<rbrakk> \<Longrightarrow> edges g \<subseteq> edges g'"
apply(rule next_plane0_incr)
    apply(erule (1) subset_trans)
   apply(simp add: edges_makeFaceFinal)
  apply(erule snd_snd_splitFace_edges_incr)
 apply assumption+
done

subsection\<open>Increasing final vertices\<close>

(*
This should really be proved via the (unproven) invariant
v : f \<Longrightarrow> ((g,v).f).(f.v) = v
*)

declare  atLeastLessThan_iff[iff]

lemma next_plane0_incr_finV:
 "\<lbrakk>g' \<in> set (next_plane0\<^bsub>p\<^esub> g); minGraphProps g \<rbrakk>
  \<Longrightarrow> \<forall>v \<in> \<V> g. v \<in> \<V> g' \<and>
        ((\<forall>f\<in>\<F> g. v \<in> \<V> f \<longrightarrow> final f) \<longrightarrow>
         (\<forall>f\<in>\<F> g'. v \<in> \<V> f \<longrightarrow> f \<in> \<F> g))" (is "_ \<Longrightarrow> _ \<Longrightarrow> ?Q g g'")
apply(rule next_plane0_incr[where Q = ?Q and g=g and g'=g'])
prefer 4 apply assumption
prefer 4 apply assumption
  apply fast
 apply(clarsimp simp:makeFaceFinal_def vertices_graph makeFaceFinalFaceList_def)
 apply(drule replace5)
 apply(erule disjE)apply blast
 apply(simp add:setFinal_def)
apply(unfold pre_splitFace_def)
apply(clarsimp simp:splitFace_def split_def vertices_graph)
apply(rule conjI)
 apply(clarsimp simp:split_face_def vertices_graph atLeastLessThan_def)
 apply(blast dest:inbetween_inset)
apply(clarsimp)
apply(erule disjE[OF replace5]) apply blast
apply(clarsimp simp:split_face_def vertices_graph)
apply(blast dest:inbetween_inset)
done

lemma next_plane0_finalVertex_mono:
 "\<lbrakk>g' \<in> set (next_plane0\<^bsub>p\<^esub> g); inv g; u \<in> \<V> g; finalVertex g u \<rbrakk>
  \<Longrightarrow> finalVertex g' u"
apply(frule (1) invariantE[OF inv_inv_next_plane0])
apply(subgoal_tac "u \<in> \<V> g'")
 prefer 2 apply(blast dest:next_plane0_vertices_subset inv_mgp)
apply(clarsimp simp:finalVertex_def minGraphProps_facesAt_eq[OF inv_mgp])
apply(blast dest:next_plane0_incr_finV inv_mgp)
done

subsection\<open>Preservation of @{const facesAt} at final vertices\<close>

lemma next_plane0_finalVertex_facesAt_eq:
 "\<lbrakk>g' \<in> set (next_plane0\<^bsub>p\<^esub> g); inv g; v \<in> \<V> g; finalVertex g v \<rbrakk>
  \<Longrightarrow> set(facesAt g' v) = set(facesAt g v)"
apply(frule (1) invariantE[OF inv_inv_next_plane0])
apply(subgoal_tac "v \<in> \<V> g'")
 prefer 2 apply(blast dest:next_plane0_vertices_subset inv_mgp)
apply(clarsimp simp:finalVertex_def minGraphProps_facesAt_eq[OF inv_mgp])
by(blast dest:next_plane0_incr_finV next_plane0_final_mono inv_mgp)

lemma next_plane0_len_filter_eq:
assumes "g' \<in> set (next_plane0\<^bsub>p\<^esub> g)" "inv g" "v \<in> \<V> g" "finalVertex g v"
shows "|filter P (facesAt g' v)| = |filter P (facesAt g v)|"
proof -
  note inv' = invariantE[OF inv_inv_next_plane0, OF assms(1,2)]
  note mgp = inv_mgp[OF assms(2)] and mgp' = inv_mgp[OF inv']
  note dist = distinct_filter[OF mgp_dist_facesAt[OF mgp \<open>v : \<V> g\<close>]]
  have "v \<in> \<V> g'"
    using assms(3) next_plane0_vertices_subset[OF assms(1) mgp] by blast
  note dist' = distinct_filter[OF mgp_dist_facesAt[OF mgp' \<open>v : \<V> g'\<close>]]
  have "|filter P (facesAt g' v)| = card{f \<in> set(facesAt g' v) . P f}"
    using distinct_card[OF dist'] by simp
  also have "\<dots> = card{f \<in> set(facesAt g v) . P f}"
    by(simp add: next_plane0_finalVertex_facesAt_eq[OF assms])
  also have "\<dots> = |filter P (facesAt g v)|"
    using distinct_card[OF dist] by simp
  finally show ?thesis .
qed

subsection\<open>Properties of @{const subdivFace'}\<close>

lemma new_edge_subdivFace':
  "\<And>f v n g.
  pre_subdivFace' g f u v n ovs \<Longrightarrow> minGraphProps g \<Longrightarrow> f \<in> \<F> g \<Longrightarrow>
  subdivFace' g f v n ovs = makeFaceFinal f g \<or>
  (\<forall>f' \<in> \<F> (subdivFace' g f v n ovs) - (\<F> g - {f}).
   \<exists>e \<in> \<E> f'. e \<notin> \<E> g)"
proof (induct ovs)
  case Nil thus ?case by simp
next
  case (Cons ov ovs)
  note IH = Cons(1) and pre = Cons(2) and mgp = Cons(3) and fg = Cons(4)
  have uf: "u \<in> \<V> f" and vf: "v \<in> \<V> f" and distf: "distinct (vertices f)"
    using pre by(simp add:pre_subdivFace'_def)+
  note distFg = minGraphProps11'[OF mgp]
  show ?case
  proof (cases ov)
    case None
    have pre': "pre_subdivFace' g f u v (Suc n) ovs"
      using None pre by (simp add: pre_subdivFace'_None)
    show ?thesis using None
      by (simp add: IH[OF pre' mgp fg])
  next
    case (Some w)
    note pre = pre[simplified Some]
    have uvw: "before (verticesFrom f u) v w"
      using pre by(simp add:pre_subdivFace'_def)
    have uw: "u \<noteq> w" using pre by(clarsimp simp: pre_subdivFace'_def)
    { assume w: "f \<bullet> v = w" and n: "n = 0"
      have pre': "pre_subdivFace' g f u w 0 ovs"
        using pre Some n using [[simp_depth_limit = 5]] by (simp add: pre_subdivFace'_Some2)
      note IH[OF pre' mgp fg]
    } moreover
    { let ?vs = "[countVertices g..<countVertices g + n]"
      let ?fdg = "splitFace g v w f ?vs"
      let  ?f\<^sub>1 = "fst ?fdg" and ?f\<^sub>2 = "fst(snd ?fdg)" and ?g' = "snd(snd ?fdg)"
      let ?g'' = "subdivFace' ?g' ?f\<^sub>2 w 0 ovs"
      let ?fvw = "between(vertices f) v w" and ?fwv = "between(vertices f) w v"
      assume a: "f \<bullet> v = w \<longrightarrow> 0 < n"
      have fsubg: "\<V> f \<subseteq> \<V> g"
        using mgp fg by(simp add: minGraphProps_def faces_subset_def)
      have pre_fdg: "pre_splitFace g v w f ?vs"
           apply (rule pre_subdivFace'_preFaceDiv[OF pre fg _ fsubg])
           using a by (simp)
      hence "v \<noteq> w" and "w \<in> \<V> f" by(unfold pre_splitFace_def)simp+
      have f\<^sub>1: "?f\<^sub>1= fst(split_face f v w ?vs)"
        and f\<^sub>2: "?f\<^sub>2 = snd(split_face f v w ?vs)"
        by(auto simp add:splitFace_def split_def)
      note pre_split = pre_splitFace_pre_split_face[OF pre_fdg]
      have E\<^sub>1: "\<E> ?f\<^sub>1 = Edges (w # rev ?vs @ [v]) \<union> Edges (v # ?fvw @ [w])"
        using f\<^sub>1 by(simp add:edges_split_face1[OF pre_split])
      have E\<^sub>2: "\<E> ?f\<^sub>2 = Edges (v # ?vs @ [w]) \<union> Edges (w # ?fwv @ [v])"
        by(simp add:splitFace_def split_def
            edges_split_face2[OF pre_split])
      note mgp' = splitFace_holds_minGraphProps[OF pre_fdg mgp]
      note distFg' = minGraphProps11'[OF mgp']
      have pre': "pre_subdivFace' ?g' ?f\<^sub>2 u w 0 ovs"
        by (rule pre_subdivFace'_Some1[OF pre fg _ fsubg HOL.refl HOL.refl])
           (simp add:a)
      note f2inF = splitFace_add_f21'[OF fg]
      have 1: "\<exists>e \<in> \<E> ?f\<^sub>1. e \<notin> \<E> g"
      proof cases
        assume "rev ?vs = []"
        hence "(w,v) \<in> \<E> ?f\<^sub>1 \<and> (w,v) \<notin> \<E> g" using pre_fdg E\<^sub>1
          by(unfold pre_splitFace_def) (auto simp:Edges_Cons)
        thus ?thesis by blast
      next
        assume "rev ?vs \<noteq> []"
        then obtain x xs where rvs: "rev ?vs = x#xs"
          by(auto simp only:neq_Nil_conv)
        hence "(w,x) \<in> \<E> ?f\<^sub>1" using E\<^sub>1 by (auto simp:Edges_Cons)
        moreover have "(w,x) \<notin> \<E> g"
        proof -
          have "x \<in> set(rev ?vs)" using rvs by simp
          hence "x \<ge> countVertices g" by simp
          hence "x \<notin> \<V> g" by(induct g) (simp add:vertices_graph_def)
          thus ?thesis
            by (auto simp:edges_graph_def)
               (blast dest: in_edges_in_vertices minGraphProps9[OF mgp])
        qed
        ultimately show ?thesis by blast
      qed
      have 2: "\<exists>e \<in> \<E> ?f\<^sub>2. e \<notin> \<E> g"
      proof cases
        assume "?vs = []"
        hence "(v,w) \<in> \<E> ?f\<^sub>2 \<and> (v,w) \<notin> \<E> g" using pre_fdg E\<^sub>2
          by(unfold pre_splitFace_def) (auto simp:Edges_Cons)
        thus ?thesis by blast
      next
        assume "?vs \<noteq> []"
        then obtain x xs where vs: "?vs = x#xs"
          by(auto simp only:neq_Nil_conv)
        hence "(v,x) \<in> \<E> ?f\<^sub>2" using E\<^sub>2 by (auto simp:Edges_Cons)
        moreover have "(v,x) \<notin> \<E> g"
        proof -
          have "x \<in> set ?vs" using vs by simp
          hence "x \<ge> countVertices g" by simp
          hence "x \<notin> \<V> g" by(induct g) (simp add:vertices_graph_def)
          thus ?thesis
            by (auto simp:edges_graph_def)
               (blast dest: in_edges_in_vertices minGraphProps9[OF mgp])
        qed
        ultimately show ?thesis by blast
      qed
      have fdg: "(?f\<^sub>1,?f\<^sub>2,?g') = splitFace g v w f ?vs" by auto
      hence Fg': "\<F> ?g' = {?f\<^sub>1,?f\<^sub>2} \<union> (\<F> g - {f})"
        using set_faces_splitFace[OF mgp fg pre_fdg] by blast
      have "\<forall>f' \<in> \<F> ?g'' - (\<F> g - {f}). \<exists>e \<in> \<E> f'. e \<notin> \<E> g"
      proof (clarify)
        fix f' assume f'g'': "f' \<in> \<F> ?g''" and f'ng: "f' \<notin> \<F> g - {f}"
        from IH[OF pre' mgp' f2inF]
        show "\<exists>e \<in> \<E> f'. e \<notin> \<E> g"
        proof
          assume "?g'' = makeFaceFinal ?f\<^sub>2 ?g'"
          hence "f' = setFinal ?f\<^sub>2 \<or> f' = ?f\<^sub>1" (is "?A \<or> ?B")
            using f'g'' Fg' f'ng
            by(auto simp:makeFaceFinal_def makeFaceFinalFaceList_def
              distinct_set_replace[OF distFg'])
          thus ?thesis
          proof
            assume ?A thus ?thesis using 2 by(simp)
          next
            assume ?B thus ?thesis using 1 by blast
          qed
        next
          assume A: "\<forall>f' \<in> \<F> ?g'' - (\<F> ?g' - {?f\<^sub>2}).
                     \<exists>e \<in> \<E> f'. e \<notin> \<E> ?g'"
          show ?thesis
          proof cases
            assume "f' \<in> {?f\<^sub>1,?f\<^sub>2}"
            thus ?thesis using 1 2 by blast
          next
            assume "f' \<notin> {?f\<^sub>1,?f\<^sub>2}"
            hence "\<exists>e\<in>\<E> f'. e \<notin> \<E> ?g'"
              using A f'g'' f'ng Fg' by simp
            with splitFace_edges_incr[OF pre_fdg fdg]
            show ?thesis by blast
          qed
        qed
      qed
    }
    ultimately show ?thesis using Some by(auto simp: split_def)
  qed
qed

lemma dist_edges_subdivFace':
  "pre_subdivFace' g f u v n ovs \<Longrightarrow> minGraphProps g \<Longrightarrow> f \<in> \<F> g \<Longrightarrow>
  subdivFace' g f v n ovs = makeFaceFinal f g \<or>
  (\<forall>f' \<in> \<F> (subdivFace' g f v n ovs) - (\<F> g - {f}). \<E> f' \<noteq> \<E> f)"
apply(drule (2) new_edge_subdivFace')
apply(erule disjE)
 apply blast
apply(rule disjI2)
apply(clarify)
apply(drule bspec)
 apply fast
apply(simp add:edges_graph_def)
by(blast)

lemma between_last: "\<lbrakk> distinct(vertices f); u \<in> \<V> f \<rbrakk> \<Longrightarrow>
   between (vertices f) u (last (verticesFrom f u)) =
   butlast(tl(verticesFrom f u))"
apply(drule split_list)
apply (fastforce dest: last_in_set
  simp: between_def verticesFrom_Def split_def
       last_append butlast_append fst_splitAt_last)
done

(* FIXME move condition to pre_addfacesnd? *)
lemma final_subdivFace': "\<And>f u n g. minGraphProps g \<Longrightarrow>
  pre_subdivFace' g f r u n ovs \<Longrightarrow> f \<in> \<F> g \<Longrightarrow>
  (ovs = [] \<longrightarrow> n=0 \<and> u = last(verticesFrom f r)) \<Longrightarrow>
  \<exists>f' \<in> set(finals(subdivFace' g f u n ovs)) - set(finals g).
   (f\<^bsup>-1\<^esup> \<bullet> r,r) \<in> \<E> f' \<and>  |vertices f'| =
      n + |ovs| + (if r=u then 1 else |between (vertices f) r u| + 2)"
proof (induct ovs)
  case Nil show ?case (is "\<exists>f' \<in> ?F. ?P f'")
  proof
    show "?P (setFinal f)" (is "?A \<and> ?B")
    proof
      show "?A" using Nil
        by(simp add:pre_subdivFace'_def prevVertex_in_edges
          del:is_nextElem_edges_eq)
      show  "?B"
        using Nil mgp_vertices3[OF Nil(1,3)]
        by(simp add:  setFinal_def between_last pre_subdivFace'_def)
    qed
  next
    show "setFinal f \<in> ?F" using Nil
      by(simp add:pre_subdivFace'_def setFinal_notin_finals minGraphProps11')
  qed
next
  case (Cons ov ovs)
  note IH = Cons(1) and mgp = Cons(2) and pre = Cons(3) and fg = Cons(4)
    and mt = Cons(5)
  have "r \<in> \<V> f" and "u \<in> \<V> f" and distf: "distinct (vertices f)"
    using pre by(simp add:pre_subdivFace'_def)+
  show ?case
  proof (cases ov)
    case None
    have pre': "pre_subdivFace' g f r u (Suc n) ovs"
      using None pre by (simp add: pre_subdivFace'_None)
    have "ovs \<noteq> []" using pre None by (auto simp: pre_subdivFace'_def)
    thus ?thesis using None IH[OF mgp pre' fg] by simp
  next
    case (Some v)
    note pre = pre[simplified Some]
      have ruv: "before (verticesFrom f r) u v" and "r \<noteq> v"
        using pre by(simp add:pre_subdivFace'_def)+
    show ?thesis
    proof (cases "f \<bullet> u = v \<and> n = 0")
      case True
      have pre': "pre_subdivFace' g f r v 0 ovs"
        using pre True using [[simp_depth_limit = 5]] by (simp add: pre_subdivFace'_Some2)
      have mt: "ovs = [] \<longrightarrow> 0 = 0 \<and> v = last (verticesFrom f r)"
        using pre by(clarsimp simp:pre_subdivFace'_def)
      show ?thesis using Some True IH[OF mgp pre' fg mt] \<open>r \<noteq> v\<close>
        by(auto simp: between_next_empty[OF distf]
          unroll_between_next2[OF distf \<open>r \<in> \<V> f\<close> \<open>u \<in> \<V> f\<close>])
    next
      case False
      let ?vs = "[countVertices g..<countVertices g + n]"
      let ?fdg = "splitFace g u v f ?vs"
      let ?g' = "snd(snd ?fdg)" and ?f\<^sub>2 = "fst(snd ?fdg)"
      let ?fvu = "between (vertices f) v u"
      have False': "f \<bullet> u = v \<longrightarrow> n \<noteq> 0" using False by auto
      have VfVg: "\<V> f \<subseteq> \<V> g" using mgp fg
          by (simp add: minGraphProps_def faces_subset_def)
      note pre_fdg = pre_subdivFace'_preFaceDiv[OF pre fg False' VfVg]
      hence "u \<noteq> v" and "v \<in> \<V> f" and disj: "\<V> f \<inter> set ?vs = {}"
        by(unfold pre_splitFace_def)simp+
      hence vvs: "v \<notin> set ?vs" by auto
      have vf\<^sub>2: "vertices ?f\<^sub>2 = [v] @ ?fvu @ u # ?vs"
        by(simp add:split_face_def splitFace_def split_def)
      hence betuvf\<^sub>2: "between (vertices ?f\<^sub>2) u v = ?vs"
        using splitFace_distinct1[OF pre_fdg]
        by(simp add: between_back)
      have betrvf\<^sub>2: "r \<noteq> u \<Longrightarrow> between (vertices ?f\<^sub>2) r v =
        between (vertices f) r u @ [u] @ ?vs"
      proof -
        assume "r\<noteq>u"
        have r: "r \<in> set (between (vertices f) v u)"
          using \<open>r\<noteq>u\<close> \<open>r\<noteq>v\<close> \<open>u\<noteq>v\<close> \<open>v \<in> \<V> f\<close> \<open>r \<in> \<V> f\<close> distf ruv
          by(blast intro:rotate_before_vFrom before_between)
        have "between (vertices f) v u =
          between (vertices f) v r @ [r] @ between (vertices f) r u"
          using split_between[OF distf \<open>v \<in> \<V> f\<close> \<open>u \<in> \<V> f\<close> r] \<open>r\<noteq>v\<close>
          by simp
        moreover hence "v \<notin> set (between (vertices f) r u)"
          using between_not_r1[OF distf, of v u] by simp
        ultimately show ?thesis using vf\<^sub>2 \<open>r\<noteq>v\<close> \<open>u\<noteq>v\<close> vvs
          by (simp add: between_back between_not_r2[OF distf])
      qed
      note mgp' = splitFace_holds_minGraphProps[OF pre_fdg mgp]
      note f2g = splitFace_add_f21'[OF fg]
      note pre' = pre_subdivFace'_Some1[OF pre fg False' VfVg HOL.refl HOL.refl]
      from pre_fdg have "v \<in> \<V> f" and disj: "\<V> f \<inter> set ?vs = {}"
        by(unfold pre_splitFace_def, simp)+
      have fr: "?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r = f\<^bsup>-1\<^esup> \<bullet> r"
      proof -
        note pre_split = pre_splitFace_pre_split_face[OF pre_fdg]
        have rinf\<^sub>2: "r \<in> \<V> ?f\<^sub>2"
        proof cases
          assume "r = u" thus ?thesis by(simp add:vf\<^sub>2)
        next
          assume "r \<noteq> u"
          hence "r \<in> set ?fvu" using distf \<open>v : \<V> f\<close> \<open>r\<noteq>v\<close> \<open>r : \<V> f\<close> ruv
            by(blast intro: before_between rotate_before_vFrom)
          thus ?thesis by(simp add:vf\<^sub>2)
        qed
        have E\<^sub>2: "\<E> ?f\<^sub>2 = Edges (u # ?vs @ [v]) \<union>
                             Edges (v # ?fvu @ [u])"
          by(simp add:splitFace_def split_def
            edges_split_face2[OF pre_split])
        moreover have "(?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r, r) \<in> \<E> ?f\<^sub>2"
          by(blast intro: prevVertex_in_edges rinf\<^sub>2
            splitFace_distinct1[OF pre_fdg])
        moreover have "(?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r, r) \<notin> Edges (u # ?vs @ [v])"
        proof -
          have "r \<notin> set ?vs" using \<open>r : \<V> f\<close> disj by blast
          thus ?thesis using \<open>r \<noteq> v\<close>
            by(simp add:Edges_Cons Edges_append notinset_notinEdge2) arith
        qed
        ultimately have "(?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r, r) \<in> Edges (v # ?fvu @ [u])" by blast
        hence "(?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r, r) \<in> \<E> f" using pre_split_face_symI[OF pre_split]
          by(blast intro: Edges_between_edges)
        hence eq: "f \<bullet> (?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r) = r" and inf: "?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r \<in> \<V> f"
          by(simp add:edges_face_eq)+
        have "?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r = f\<^bsup>-1\<^esup> \<bullet> (f \<bullet> (?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r))"
          using prevVertex_nextVertex[OF distf inf] by simp
        also have "\<dots> = f\<^bsup>-1\<^esup> \<bullet> r" using eq by simp
        finally show ?thesis .
      qed
      hence mt: "ovs = [] \<longrightarrow> 0 = 0 \<and> v = last (verticesFrom ?f\<^sub>2 r)"
        using pre' pre by(auto simp:pre_subdivFace'_def splitFace_def
          split_def last_vFrom)
      from IH[OF mgp' pre' f2g mt] \<open>r \<noteq> v\<close> obtain f' :: face where
        f: "f' \<in> set(finals(subdivFace' ?g' ?f\<^sub>2 v 0 ovs)) - set(finals ?g')"
        and ff: "(?f\<^sub>2\<^bsup>-1\<^esup> \<bullet> r, r) \<in> \<E> f'"
        "|vertices f'| = |ovs| + |between (vertices ?f\<^sub>2) r v| + 2"
        by simp blast
      show ?thesis (is "\<exists>f' \<in> ?F. ?P f'")
      proof
        show "f' \<in> ?F" using f pre Some fg
          by(simp add:False split_def pre_subdivFace'_def)
        show "?P f'" using ff fr by(clarsimp simp:betuvf\<^sub>2 betrvf\<^sub>2)
      qed
    qed
  qed
qed

lemma Seed_max_final_ex:
 "\<exists>f\<in>set (finals (Seed p)). |vertices f| = maxGon p"
  by (simp add: Seed_def graph_max_final_ex)

lemma max_face_ex: assumes a: "Seed\<^bsub>p\<^esub> [next_plane0\<^bsub>p\<^esub>]\<rightarrow>* g"
shows "\<exists>f \<in> set (finals g). |vertices f| = maxGon p"
using a
proof (induct rule: RTranCl_induct)
  case refl then show ?case using Seed_max_final_ex by simp
next
  case (succs g g')
  then obtain f where f: "f\<in>set (finals g)" and "|vertices f| = maxGon p"
    by auto
  moreover from succs(1) f have "f\<in>set (finals g')" by (rule next_plane0_finals_incr)
  ultimately show ?case by auto
qed

end


(*
  File: Logic_FOL.thy
  Author: Bohua Zhan

  Setup for proof steps related to logic.
*)

theory Logic_FOL
  imports Auto2_FOL
begin

section \<open>Trivial contradictions\<close>

setup {* add_resolve_prfstep @{thm refl} *}
setup {* add_forward_prfstep @{thm contra_triv} *}
setup {* add_resolve_prfstep @{thm TrueI} *}
theorem FalseD [resolve]: "\<not>False" by simp
lemma exists_triv_eq [resolve]: "\<exists>x. x = x" by auto

section \<open>If and only iff\<close>

setup {* add_gen_prfstep ("iff_intro1",
  [WithGoal @{term_pat "?A \<longleftrightarrow> ?B"}, CreateCase @{term_pat "?A::o"}, WithScore 25]) *}
theorem iff_goal:
  "\<not>(A \<longleftrightarrow> B) \<Longrightarrow> A \<Longrightarrow> \<not>B" "\<not>(A \<longleftrightarrow> B) \<Longrightarrow> B \<Longrightarrow> \<not>A"
  "\<not>(A \<longleftrightarrow> B) \<Longrightarrow> \<not>A \<Longrightarrow> B" "\<not>(A \<longleftrightarrow> B) \<Longrightarrow> \<not>B \<Longrightarrow> A"
  "\<not>(\<not>A \<longleftrightarrow> B) \<Longrightarrow> A \<Longrightarrow> B" "\<not>(A \<longleftrightarrow> \<not>B) \<Longrightarrow> B \<Longrightarrow> A" by auto
setup {* fold (fn th => add_forward_prfstep_cond th [with_score 1]) @{thms iff_goal} *}

section \<open>Unique existence\<close>

setup {* add_rewrite_rule @{thm ex1_def} *}

(* To show \<exists>!x. P(x), first show \<exists>x. P(x), then name a variable x satisfying P.
   Finally show \<forall>y. P(y) \<longrightarrow> x = y. *)
setup {* add_gen_prfstep ("ex1_case",
  [WithGoal @{term_pat "\<exists>!x. ?P(x)"}, CreateConcl @{term_pat "\<exists>x. ?P(x)"}]) *}
setup {* add_backward2_prfstep @{thm ex_ex1I} *}
theorem ex_ex1I' [backward1]:
  "(\<forall>y. P(y) \<longrightarrow> x = y) \<Longrightarrow> P(x) \<Longrightarrow> \<exists>!x. P(x)" by auto
theorem ex_ex1D [forward]:
  "\<exists>!x. P(x) \<Longrightarrow> \<exists>x. P(x)"
  "\<exists>!x. P(x) \<Longrightarrow> P(x) \<Longrightarrow> \<forall>y. P(y) \<longrightarrow> y = x" by auto
setup {* del_prfstep_thm @{thm ex1_def} *}

section \<open>Let\<close>

setup {* Normalizer.add_rewr_normalizer ("rewr_let", @{thm Let_def}) *}

end


(*  Title:      HOL/UNITY/Project.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1999  University of Cambridge

Projections of state sets (also of actions and programs).

Inheritance of GUARANTEES properties under extension.
*)

section{*Projections of State Sets*}

theory Project imports Extend begin

definition projecting :: "['c program => 'c set, 'a*'b => 'c,
                  'a program, 'c program set, 'a program set] => bool" where
    "projecting C h F X' X ==
       \<forall>G. extend h F\<squnion>G \<in> X' --> F\<squnion>project h (C G) G \<in> X"

definition extending :: "['c program => 'c set, 'a*'b => 'c, 'a program,
                 'c program set, 'a program set] => bool" where
    "extending C h F Y' Y ==
       \<forall>G. extend h F  ok G --> F\<squnion>project h (C G) G \<in> Y
              --> extend h F\<squnion>G \<in> Y'"

definition subset_closed :: "'a set set => bool" where
    "subset_closed U == \<forall>A \<in> U. Pow A \<subseteq> U"

context Extend
begin

lemma project_extend_constrains_I:
     "F \<in> A co B ==> project h C (extend h F) \<in> A co B"
apply (auto simp add: extend_act_def project_act_def constrains_def)
done

subsection{*Safety*}

(*used below to prove Join_project_ensures*)
lemma project_unless:
     "[| G \<in> stable C;  project h C G \<in> A unless B |]
      ==> G \<in> (C \<inter> extend_set h A) unless (extend_set h B)"
apply (simp add: unless_def project_constrains)
apply (blast dest: stable_constrains_Int intro: constrains_weaken)
done

(*Generalizes project_constrains to the program F\<squnion>project h C G
  useful with guarantees reasoning*)
lemma Join_project_constrains:
     "(F\<squnion>project h C G \<in> A co B)  =
        (extend h F\<squnion>G \<in> (C \<inter> extend_set h A) co (extend_set h B) &
         F \<in> A co B)"
apply (simp (no_asm) add: project_constrains)
apply (blast intro: extend_constrains [THEN iffD2, THEN constrains_weaken]
             dest: constrains_imp_subset)
done

(*The condition is required to prove the left-to-right direction
  could weaken it to G \<in> (C \<inter> extend_set h A) co C*)
lemma Join_project_stable:
     "extend h F\<squnion>G \<in> stable C
      ==> (F\<squnion>project h C G \<in> stable A)  =
          (extend h F\<squnion>G \<in> stable (C \<inter> extend_set h A) &
           F \<in> stable A)"
apply (unfold stable_def)
apply (simp only: Join_project_constrains)
apply (blast intro: constrains_weaken dest: constrains_Int)
done

(*For using project_guarantees in particular cases*)
lemma project_constrains_I:
     "extend h F\<squnion>G \<in> extend_set h A co extend_set h B
      ==> F\<squnion>project h C G \<in> A co B"
apply (simp add: project_constrains extend_constrains)
apply (blast intro: constrains_weaken dest: constrains_imp_subset)
done

lemma project_increasing_I:
     "extend h F\<squnion>G \<in> increasing (func o f)
      ==> F\<squnion>project h C G \<in> increasing func"
apply (unfold increasing_def stable_def)
apply (simp del: Join_constrains
            add: project_constrains_I extend_set_eq_Collect)
done

lemma Join_project_increasing:
     "(F\<squnion>project h UNIV G \<in> increasing func)  =
      (extend h F\<squnion>G \<in> increasing (func o f))"
apply (rule iffI)
apply (erule_tac [2] project_increasing_I)
apply (simp del: Join_stable
            add: increasing_def Join_project_stable)
apply (auto simp add: extend_set_eq_Collect extend_stable [THEN iffD1])
done

(*The UNIV argument is essential*)
lemma project_constrains_D:
     "F\<squnion>project h UNIV G \<in> A co B
      ==> extend h F\<squnion>G \<in> extend_set h A co extend_set h B"
by (simp add: project_constrains extend_constrains)

end

subsection{*"projecting" and union/intersection (no converses)*}

lemma projecting_Int:
     "[| projecting C h F XA' XA;  projecting C h F XB' XB |]
      ==> projecting C h F (XA' \<inter> XB') (XA \<inter> XB)"
by (unfold projecting_def, blast)

lemma projecting_Un:
     "[| projecting C h F XA' XA;  projecting C h F XB' XB |]
      ==> projecting C h F (XA' \<union> XB') (XA \<union> XB)"
by (unfold projecting_def, blast)

lemma projecting_INT:
     "[| !!i. i \<in> I ==> projecting C h F (X' i) (X i) |]
      ==> projecting C h F (\<Inter>i \<in> I. X' i) (\<Inter>i \<in> I. X i)"
by (unfold projecting_def, blast)

lemma projecting_UN:
     "[| !!i. i \<in> I ==> projecting C h F (X' i) (X i) |]
      ==> projecting C h F (\<Union>i \<in> I. X' i) (\<Union>i \<in> I. X i)"
by (unfold projecting_def, blast)

lemma projecting_weaken:
     "[| projecting C h F X' X;  U'<=X';  X \<subseteq> U |] ==> projecting C h F U' U"
by (unfold projecting_def, auto)

lemma projecting_weaken_L:
     "[| projecting C h F X' X;  U'<=X' |] ==> projecting C h F U' X"
by (unfold projecting_def, auto)

lemma extending_Int:
     "[| extending C h F YA' YA;  extending C h F YB' YB |]
      ==> extending C h F (YA' \<inter> YB') (YA \<inter> YB)"
by (unfold extending_def, blast)

lemma extending_Un:
     "[| extending C h F YA' YA;  extending C h F YB' YB |]
      ==> extending C h F (YA' \<union> YB') (YA \<union> YB)"
by (unfold extending_def, blast)

lemma extending_INT:
     "[| !!i. i \<in> I ==> extending C h F (Y' i) (Y i) |]
      ==> extending C h F (\<Inter>i \<in> I. Y' i) (\<Inter>i \<in> I. Y i)"
by (unfold extending_def, blast)

lemma extending_UN:
     "[| !!i. i \<in> I ==> extending C h F (Y' i) (Y i) |]
      ==> extending C h F (\<Union>i \<in> I. Y' i) (\<Union>i \<in> I. Y i)"
by (unfold extending_def, blast)

lemma extending_weaken:
     "[| extending C h F Y' Y;  Y'<=V';  V \<subseteq> Y |] ==> extending C h F V' V"
by (unfold extending_def, auto)

lemma extending_weaken_L:
     "[| extending C h F Y' Y;  Y'<=V' |] ==> extending C h F V' Y"
by (unfold extending_def, auto)

lemma projecting_UNIV: "projecting C h F X' UNIV"
by (simp add: projecting_def)

context Extend
begin

lemma projecting_constrains:
     "projecting C h F (extend_set h A co extend_set h B) (A co B)"
apply (unfold projecting_def)
apply (blast intro: project_constrains_I)
done

lemma projecting_stable:
     "projecting C h F (stable (extend_set h A)) (stable A)"
apply (unfold stable_def)
apply (rule projecting_constrains)
done

lemma projecting_increasing:
     "projecting C h F (increasing (func o f)) (increasing func)"
apply (unfold projecting_def)
apply (blast intro: project_increasing_I)
done

lemma extending_UNIV: "extending C h F UNIV Y"
apply (simp (no_asm) add: extending_def)
done

lemma extending_constrains:
     "extending (%G. UNIV) h F (extend_set h A co extend_set h B) (A co B)"
apply (unfold extending_def)
apply (blast intro: project_constrains_D)
done

lemma extending_stable:
     "extending (%G. UNIV) h F (stable (extend_set h A)) (stable A)"
apply (unfold stable_def)
apply (rule extending_constrains)
done

lemma extending_increasing:
     "extending (%G. UNIV) h F (increasing (func o f)) (increasing func)"
by (force simp only: extending_def Join_project_increasing)

subsection{*Reachability and project*}

(*In practice, C = reachable(...): the inclusion is equality*)
lemma reachable_imp_reachable_project:
     "[| reachable (extend h F\<squnion>G) \<subseteq> C;
         z \<in> reachable (extend h F\<squnion>G) |]
      ==> f z \<in> reachable (F\<squnion>project h C G)"
apply (erule reachable.induct)
apply (force intro!: reachable.Init simp add: split_extended_all, auto)
 apply (rule_tac act = x in reachable.Acts)
 apply auto
 apply (erule extend_act_D)
apply (rule_tac act1 = "Restrict C act"
       in project_act_I [THEN [3] reachable.Acts], auto)
done

lemma project_Constrains_D:
     "F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> A Co B
      ==> extend h F\<squnion>G \<in> (extend_set h A) Co (extend_set h B)"
apply (unfold Constrains_def)
apply (simp del: Join_constrains
            add: Join_project_constrains, clarify)
apply (erule constrains_weaken)
apply (auto intro: reachable_imp_reachable_project)
done

lemma project_Stable_D:
     "F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> Stable A
      ==> extend h F\<squnion>G \<in> Stable (extend_set h A)"
apply (unfold Stable_def)
apply (simp (no_asm_simp) add: project_Constrains_D)
done

lemma project_Always_D:
     "F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> Always A
      ==> extend h F\<squnion>G \<in> Always (extend_set h A)"
apply (unfold Always_def)
apply (force intro: reachable.Init simp add: project_Stable_D split_extended_all)
done

lemma project_Increasing_D:
     "F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> Increasing func
      ==> extend h F\<squnion>G \<in> Increasing (func o f)"
apply (unfold Increasing_def, auto)
apply (subst extend_set_eq_Collect [symmetric])
apply (simp (no_asm_simp) add: project_Stable_D)
done

subsection{*Converse results for weak safety: benefits of the argument C *}

(*In practice, C = reachable(...): the inclusion is equality*)
lemma reachable_project_imp_reachable:
     "[| C \<subseteq> reachable(extend h F\<squnion>G);
         x \<in> reachable (F\<squnion>project h C G) |]
      ==> \<exists>y. h(x,y) \<in> reachable (extend h F\<squnion>G)"
apply (erule reachable.induct)
apply  (force intro: reachable.Init)
apply (auto simp add: project_act_def)
apply (force del: Id_in_Acts intro: reachable.Acts extend_act_D)+
done

lemma project_set_reachable_extend_eq:
     "project_set h (reachable (extend h F\<squnion>G)) =
      reachable (F\<squnion>project h (reachable (extend h F\<squnion>G)) G)"
by (auto dest: subset_refl [THEN reachable_imp_reachable_project]
               subset_refl [THEN reachable_project_imp_reachable])

(*UNUSED*)
lemma reachable_extend_Join_subset:
     "reachable (extend h F\<squnion>G) \<subseteq> C
      ==> reachable (extend h F\<squnion>G) \<subseteq>
          extend_set h (reachable (F\<squnion>project h C G))"
apply (auto dest: reachable_imp_reachable_project)
done

lemma project_Constrains_I:
     "extend h F\<squnion>G \<in> (extend_set h A) Co (extend_set h B)
      ==> F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> A Co B"
apply (unfold Constrains_def)
apply (simp del: Join_constrains
            add: Join_project_constrains extend_set_Int_distrib)
apply (rule conjI)
 prefer 2
 apply (force elim: constrains_weaken_L
              dest!: extend_constrains_project_set
                     subset_refl [THEN reachable_project_imp_reachable])
apply (blast intro: constrains_weaken_L)
done

lemma project_Stable_I:
     "extend h F\<squnion>G \<in> Stable (extend_set h A)
      ==> F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> Stable A"
apply (unfold Stable_def)
apply (simp (no_asm_simp) add: project_Constrains_I)
done

lemma project_Always_I:
     "extend h F\<squnion>G \<in> Always (extend_set h A)
      ==> F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> Always A"
apply (unfold Always_def)
apply (auto simp add: project_Stable_I)
apply (unfold extend_set_def, blast)
done

lemma project_Increasing_I:
    "extend h F\<squnion>G \<in> Increasing (func o f)
     ==> F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> Increasing func"
apply (unfold Increasing_def, auto)
apply (simp (no_asm_simp) add: extend_set_eq_Collect project_Stable_I)
done

lemma project_Constrains:
     "(F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> A Co B)  =
      (extend h F\<squnion>G \<in> (extend_set h A) Co (extend_set h B))"
apply (blast intro: project_Constrains_I project_Constrains_D)
done

lemma project_Stable:
     "(F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> Stable A)  =
      (extend h F\<squnion>G \<in> Stable (extend_set h A))"
apply (unfold Stable_def)
apply (rule project_Constrains)
done

lemma project_Increasing:
   "(F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> Increasing func)  =
    (extend h F\<squnion>G \<in> Increasing (func o f))"
apply (simp (no_asm_simp) add: Increasing_def project_Stable extend_set_eq_Collect)
done

subsection{*A lot of redundant theorems: all are proved to facilitate reasoning
    about guarantees.*}

lemma projecting_Constrains:
     "projecting (%G. reachable (extend h F\<squnion>G)) h F
                 (extend_set h A Co extend_set h B) (A Co B)"

apply (unfold projecting_def)
apply (blast intro: project_Constrains_I)
done

lemma projecting_Stable:
     "projecting (%G. reachable (extend h F\<squnion>G)) h F
                 (Stable (extend_set h A)) (Stable A)"
apply (unfold Stable_def)
apply (rule projecting_Constrains)
done

lemma projecting_Always:
     "projecting (%G. reachable (extend h F\<squnion>G)) h F
                 (Always (extend_set h A)) (Always A)"
apply (unfold projecting_def)
apply (blast intro: project_Always_I)
done

lemma projecting_Increasing:
     "projecting (%G. reachable (extend h F\<squnion>G)) h F
                 (Increasing (func o f)) (Increasing func)"
apply (unfold projecting_def)
apply (blast intro: project_Increasing_I)
done

lemma extending_Constrains:
     "extending (%G. reachable (extend h F\<squnion>G)) h F
                  (extend_set h A Co extend_set h B) (A Co B)"
apply (unfold extending_def)
apply (blast intro: project_Constrains_D)
done

lemma extending_Stable:
     "extending (%G. reachable (extend h F\<squnion>G)) h F
                  (Stable (extend_set h A)) (Stable A)"
apply (unfold extending_def)
apply (blast intro: project_Stable_D)
done

lemma extending_Always:
     "extending (%G. reachable (extend h F\<squnion>G)) h F
                  (Always (extend_set h A)) (Always A)"
apply (unfold extending_def)
apply (blast intro: project_Always_D)
done

lemma extending_Increasing:
     "extending (%G. reachable (extend h F\<squnion>G)) h F
                  (Increasing (func o f)) (Increasing func)"
apply (unfold extending_def)
apply (blast intro: project_Increasing_D)
done

subsection{*leadsETo in the precondition (??)*}

subsubsection{*transient*}

lemma transient_extend_set_imp_project_transient:
     "[| G \<in> transient (C \<inter> extend_set h A);  G \<in> stable C |]
      ==> project h C G \<in> transient (project_set h C \<inter> A)"
apply (auto simp add: transient_def Domain_project_act)
apply (subgoal_tac "act `` (C \<inter> extend_set h A) \<subseteq> - extend_set h A")
 prefer 2
 apply (simp add: stable_def constrains_def, blast)
(*back to main goal*)
apply (erule_tac V = "?AA \<subseteq> -C \<union> ?BB" in thin_rl)
apply (drule bspec, assumption)
apply (simp add: extend_set_def project_act_def, blast)
done

(*converse might hold too?*)
lemma project_extend_transient_D:
     "project h C (extend h F) \<in> transient (project_set h C \<inter> D)
      ==> F \<in> transient (project_set h C \<inter> D)"
apply (simp add: transient_def Domain_project_act, safe)
apply blast+
done

subsubsection{*ensures -- a primitive combining progress with safety*}

(*Used to prove project_leadsETo_I*)
lemma ensures_extend_set_imp_project_ensures:
     "[| extend h F \<in> stable C;  G \<in> stable C;
         extend h F\<squnion>G \<in> A ensures B;  A-B = C \<inter> extend_set h D |]
      ==> F\<squnion>project h C G
            \<in> (project_set h C \<inter> project_set h A) ensures (project_set h B)"
apply (simp add: ensures_def project_constrains extend_transient,
       clarify)
apply (intro conjI)
(*first subgoal*)
apply (blast intro: extend_stable_project_set
                  [THEN stableD, THEN constrains_Int, THEN constrains_weaken]
             dest!: extend_constrains_project_set equalityD1)
(*2nd subgoal*)
apply (erule stableD [THEN constrains_Int, THEN constrains_weaken])
    apply assumption
   apply (simp (no_asm_use) add: extend_set_def)
   apply blast
 apply (simp add: extend_set_Int_distrib extend_set_Un_distrib)
 apply (blast intro!: extend_set_project_set [THEN subsetD], blast)
(*The transient part*)
apply auto
 prefer 2
 apply (force dest!: equalityD1
              intro: transient_extend_set_imp_project_transient
                         [THEN transient_strengthen])
apply (simp (no_asm_use) add: Int_Diff)
apply (force dest!: equalityD1
             intro: transient_extend_set_imp_project_transient
               [THEN project_extend_transient_D, THEN transient_strengthen])
done

text{*Transferring a transient property upwards*}
lemma project_transient_extend_set:
     "project h C G \<in> transient (project_set h C \<inter> A - B)
      ==> G \<in> transient (C \<inter> extend_set h A - extend_set h B)"
apply (simp add: transient_def project_set_def extend_set_def project_act_def)
apply (elim disjE bexE)
 apply (rule_tac x=Id in bexI)
  apply (blast intro!: rev_bexI )+
done

lemma project_unless2:
     "[| G \<in> stable C;  project h C G \<in> (project_set h C \<inter> A) unless B |]
      ==> G \<in> (C \<inter> extend_set h A) unless (extend_set h B)"
by (auto dest: stable_constrains_Int intro: constrains_weaken
         simp add: unless_def project_constrains Diff_eq Int_assoc
                   Int_extend_set_lemma)

lemma extend_unless:
   "[|extend h F \<in> stable C; F \<in> A unless B|]
    ==> extend h F \<in> C \<inter> extend_set h A unless extend_set h B"
apply (simp add: unless_def stable_def)
apply (drule constrains_Int)
apply (erule extend_constrains [THEN iffD2])
apply (erule constrains_weaken, blast)
apply blast
done

(*Used to prove project_leadsETo_D*)
lemma Join_project_ensures:
     "[| extend h F\<squnion>G \<in> stable C;
         F\<squnion>project h C G \<in> A ensures B |]
      ==> extend h F\<squnion>G \<in> (C \<inter> extend_set h A) ensures (extend_set h B)"
apply (auto simp add: ensures_eq extend_unless project_unless)
apply (blast intro:  extend_transient [THEN iffD2] transient_strengthen)
apply (blast intro: project_transient_extend_set transient_strengthen)
done

text{*Lemma useful for both STRONG and WEAK progress, but the transient
    condition's very strong*}

(*The strange induction formula allows induction over the leadsTo
  assumption's non-atomic precondition*)
lemma PLD_lemma:
     "[| extend h F\<squnion>G \<in> stable C;
         F\<squnion>project h C G \<in> (project_set h C \<inter> A) leadsTo B |]
      ==> extend h F\<squnion>G \<in>
          C \<inter> extend_set h (project_set h C \<inter> A) leadsTo (extend_set h B)"
apply (erule leadsTo_induct)
  apply (blast intro: Join_project_ensures)
 apply (blast intro: psp_stable2 [THEN leadsTo_weaken_L] leadsTo_Trans)
apply (simp del: UN_simps add: Int_UN_distrib leadsTo_UN extend_set_Union)
done

lemma project_leadsTo_D_lemma:
     "[| extend h F\<squnion>G \<in> stable C;
         F\<squnion>project h C G \<in> (project_set h C \<inter> A) leadsTo B |]
      ==> extend h F\<squnion>G \<in> (C \<inter> extend_set h A) leadsTo (extend_set h B)"
apply (rule PLD_lemma [THEN leadsTo_weaken])
apply (auto simp add: split_extended_all)
done

lemma Join_project_LeadsTo:
     "[| C = (reachable (extend h F\<squnion>G));
         F\<squnion>project h C G \<in> A LeadsTo B |]
      ==> extend h F\<squnion>G \<in> (extend_set h A) LeadsTo (extend_set h B)"
by (simp del: Join_stable    add: LeadsTo_def project_leadsTo_D_lemma
                                  project_set_reachable_extend_eq)

subsection{*Towards the theorem @{text project_Ensures_D}*}

lemma project_ensures_D_lemma:
     "[| G \<in> stable ((C \<inter> extend_set h A) - (extend_set h B));
         F\<squnion>project h C G \<in> (project_set h C \<inter> A) ensures B;
         extend h F\<squnion>G \<in> stable C |]
      ==> extend h F\<squnion>G \<in> (C \<inter> extend_set h A) ensures (extend_set h B)"
(*unless*)
apply (auto intro!: project_unless2 [unfolded unless_def]
            intro: project_extend_constrains_I
            simp add: ensures_def)
(*transient*)
(*A G-action cannot occur*)
 prefer 2
 apply (blast intro: project_transient_extend_set)
(*An F-action*)
apply (force elim!: extend_transient [THEN iffD2, THEN transient_strengthen]
             simp add: split_extended_all)
done

lemma project_ensures_D:
     "[| F\<squnion>project h UNIV G \<in> A ensures B;
         G \<in> stable (extend_set h A - extend_set h B) |]
      ==> extend h F\<squnion>G \<in> (extend_set h A) ensures (extend_set h B)"
apply (rule project_ensures_D_lemma [of _ UNIV, elim_format], auto)
done

lemma project_Ensures_D:
     "[| F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> A Ensures B;
         G \<in> stable (reachable (extend h F\<squnion>G) \<inter> extend_set h A -
                     extend_set h B) |]
      ==> extend h F\<squnion>G \<in> (extend_set h A) Ensures (extend_set h B)"
apply (unfold Ensures_def)
apply (rule project_ensures_D_lemma [elim_format])
apply (auto simp add: project_set_reachable_extend_eq [symmetric])
done

subsection{*Guarantees*}

lemma project_act_Restrict_subset_project_act:
     "project_act h (Restrict C act) \<subseteq> project_act h act"
apply (auto simp add: project_act_def)
done

lemma subset_closed_ok_extend_imp_ok_project:
     "[| extend h F ok G; subset_closed (AllowedActs F) |]
      ==> F ok project h C G"
apply (auto simp add: ok_def)
apply (rename_tac act)
apply (drule subsetD, blast)
apply (rule_tac x = "Restrict C  (extend_act h act)" in rev_image_eqI)
apply simp +
apply (cut_tac project_act_Restrict_subset_project_act)
apply (auto simp add: subset_closed_def)
done

(*Weak precondition and postcondition
  Not clear that it has a converse [or that we want one!]*)

(*The raw version; 3rd premise could be weakened by adding the
  precondition extend h F\<squnion>G \<in> X' *)
lemma project_guarantees_raw:
 assumes xguary:  "F \<in> X guarantees Y"
     and closed:  "subset_closed (AllowedActs F)"
     and project: "!!G. extend h F\<squnion>G \<in> X'
                        ==> F\<squnion>project h (C G) G \<in> X"
     and extend:  "!!G. [| F\<squnion>project h (C G) G \<in> Y |]
                        ==> extend h F\<squnion>G \<in> Y'"
 shows "extend h F \<in> X' guarantees Y'"
apply (rule xguary [THEN guaranteesD, THEN extend, THEN guaranteesI])
apply (blast intro: closed subset_closed_ok_extend_imp_ok_project)
apply (erule project)
done

lemma project_guarantees:
     "[| F \<in> X guarantees Y;  subset_closed (AllowedActs F);
         projecting C h F X' X;  extending C h F Y' Y |]
      ==> extend h F \<in> X' guarantees Y'"
apply (rule guaranteesI)
apply (auto simp add: guaranteesD projecting_def extending_def
                      subset_closed_ok_extend_imp_ok_project)
done

(*It seems that neither "guarantees" law can be proved from the other.*)

subsection{*guarantees corollaries*}

subsubsection{*Some could be deleted: the required versions are easy to prove*}

lemma extend_guar_increasing:
     "[| F \<in> UNIV guarantees increasing func;
         subset_closed (AllowedActs F) |]
      ==> extend h F \<in> X' guarantees increasing (func o f)"
apply (erule project_guarantees)
apply (rule_tac [3] extending_increasing)
apply (rule_tac [2] projecting_UNIV, auto)
done

lemma extend_guar_Increasing:
     "[| F \<in> UNIV guarantees Increasing func;
         subset_closed (AllowedActs F) |]
      ==> extend h F \<in> X' guarantees Increasing (func o f)"
apply (erule project_guarantees)
apply (rule_tac [3] extending_Increasing)
apply (rule_tac [2] projecting_UNIV, auto)
done

lemma extend_guar_Always:
     "[| F \<in> Always A guarantees Always B;
         subset_closed (AllowedActs F) |]
      ==> extend h F
            \<in> Always(extend_set h A) guarantees Always(extend_set h B)"
apply (erule project_guarantees)
apply (rule_tac [3] extending_Always)
apply (rule_tac [2] projecting_Always, auto)
done

subsubsection{*Guarantees with a leadsTo postcondition*}

lemma project_leadsTo_D:
     "F\<squnion>project h UNIV G \<in> A leadsTo B
      ==> extend h F\<squnion>G \<in> (extend_set h A) leadsTo (extend_set h B)"
apply (rule_tac C1 = UNIV in project_leadsTo_D_lemma [THEN leadsTo_weaken], auto)
done

lemma project_LeadsTo_D:
     "F\<squnion>project h (reachable (extend h F\<squnion>G)) G \<in> A LeadsTo B
       ==> extend h F\<squnion>G \<in> (extend_set h A) LeadsTo (extend_set h B)"
apply (rule refl [THEN Join_project_LeadsTo], auto)
done

lemma extending_leadsTo:
     "extending (%G. UNIV) h F
                (extend_set h A leadsTo extend_set h B) (A leadsTo B)"
apply (unfold extending_def)
apply (blast intro: project_leadsTo_D)
done

lemma extending_LeadsTo:
     "extending (%G. reachable (extend h F\<squnion>G)) h F
                (extend_set h A LeadsTo extend_set h B) (A LeadsTo B)"
apply (unfold extending_def)
apply (blast intro: project_LeadsTo_D)
done

end

end


theory bip
  imports Main "/Volumes/Setup/Isabelle/Isabelle-Code/Jan21-Isab/trinhlibs"
begin

(*---- BIP encoding - 1st trans----*)
(*2nd style:
(\<not>P(t,l) \<or> Q(el,el)) \<and> \<not>P(t,l1) \<and> \<not>Q(el1,h)
*)
value "\<exists>bet \<in> set t_betaSet_1. (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l \<or> (\<forall>export \<in> set bet.\<exists>elm \<in> set export. Q (fst elm) (snd elm)))
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)
)"

(*2nd style - 1trans*)
(*(\<not>P(t,l) \<or> Q(el,el)) \<and> \<not>P(t,l1) \<and> \<not>Q(el1,h)
\<equiv> (\<not>P(t,l) \<and> \<not>P(t,l1) \<and> \<not>Q(el1,h)) \<or> (Q(el,el) \<and> \<not>P(t,l1) \<and> \<not>Q(el1,h))
*)
value "\<exists>bet \<in> set t_betaSet_1. (
  \<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(
    (\<not>P (fst t) l
    \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
    \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1))
\<or>
  (\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))
)"

lemma fst_trans: "\<exists>bet \<in> set t_betaSet_1. (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l \<or> (\<forall>export \<in> set bet.\<exists>elm \<in> set export. Q (fst elm) (snd elm)))
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)
)
\<Longrightarrow> \<exists>bet \<in> set t_betaSet_1. (
  \<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(
    (\<not>P (fst t) l
    \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
    \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1))
\<or>
  (\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))
)"
  unfolding t_betaSet_1_def t_SyncInstance_1_def t_TrigInstance_1_def
  by metis

(*---- BIP encoding - 2nd trans----*)
(*(\<not>P(t,l) \<or> Q(el1,el1)) \<and> \<not>P(t,l1) \<and> \<not>Q(el1,h)
\<equiv> [\<not>P(t,l) \<and> \<not>P(t,l1) \<and> \<not>Q(el1,h)] \<or> [Q(el1,el1) \<and> \<not>P(t,l1) \<and> \<not>Q(el1,h)]*)
value "\<exists>bet \<in> set t_betaSet_1.
(
  \<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(
    (\<not>P (fst t) l
      \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
      \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)
    )
  \<or>
    (\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)
      \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
      \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)
    )
  )
)"

(*---- 2nd-trans - the 1st-sub ----*)
(*(\<not>Pi \<and> \<not>Pi' \<and> \<not>Qj')*)
value "\<exists>bet \<in> set t_betaSet_1.(\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l  \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h) \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))"

value "\<exists>bet \<in> set t_betaSet_1.((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<forall>l \<in> set (snd t).(\<not>P (fst t) l))  \<and> ((\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)))"

lemma test_1st_sub: "\<exists>bet \<in> set t_betaSet_1.(\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l  \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h) \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))
\<Longrightarrow> \<exists>bet \<in> set t_betaSet_1.((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<forall>l \<in> set (snd t).(\<not>P (fst t) l))  \<and> ((\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)))"
  unfolding t_betaSet_1_def t_SyncInstance_1_def t_TrigInstance_1_def
  by (metis Diff_iff list.set_intros(1) singletonD)

(*---- compare 1st part ----*)
(*BIP*)
value "\<exists>bet \<in> set t_betaSet_1.((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<forall>l \<in> set (snd t).(\<not>P (fst t) l))  \<and> ((\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)))"
(*JavaBIP*)
value "((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j.\<forall>t \<in> set u. \<forall>l \<in> set (snd t). \<not>P (fst t) l)
\<and> (\<forall>i \<in> set t_TrigInstance_1. \<forall>v \<in> set i. \<forall>k \<in> set v. \<exists>h \<in> set (snd k).\<forall>h1 \<in> set (snd k) - {h}. \<not> Q (fst k) h1))"

(*compare1 doesn't work*)
(*
lemma compare1: "\<exists>bet \<in> set t_betaSet_1.((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<forall>l \<in> set (snd t).(\<not>P (fst t) l))  \<and> ((\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)))
\<Longrightarrow> ((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j.\<forall>t \<in> set u. \<forall>l \<in> set (snd t). \<not>P (fst t) l)
\<and> (\<forall>i \<in> set t_TrigInstance_1. \<forall>v \<in> set i. \<forall>k \<in> set v. \<exists>h \<in> set (snd k).\<forall>h1 \<in> set (snd k) - {h}. \<not> Q (fst k) h1))"
  unfolding t_betaSet_1_def t_SyncInstance_1_def t_TrigInstance_1_def
  sledgehammer
*)

(*
lemma rev_compare1: "((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j.\<forall>t \<in> set u. \<forall>l \<in> set (snd t). \<not>P (fst t) l)
\<and> (\<forall>i \<in> set t_TrigInstance_1. \<forall>v \<in> set i. \<forall>k \<in> set v. \<exists>h \<in> set (snd k).\<forall>h1 \<in> set (snd k) - {h}. \<not> Q (fst k) h1))
\<Longrightarrow> \<exists>bet \<in> set t_betaSet_1.((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<forall>l \<in> set (snd t).(\<not>P (fst t) l))  \<and> ((\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)))"
  unfolding t_betaSet_1_def t_SyncInstance_1_def t_TrigInstance_1_def
  sledgehammer
*)
(*---- END the 1st-sub ----*)

(*-----------------------------------------------------------------------------------------------*)
(*---- 2nd-trans - the 2nd-sub ----*)
(*(Qj \<and> \<not>Pi' \<and> \<not>Qj')*)
value "
\<exists>bet \<in> set t_betaSet_1.(\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).
(\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h) \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1) ))"

value "
(\<exists>bet \<in> set t_betaSet_1.(
(\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1))
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<and> (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<forall>t \<in> set u. \<exists>l \<in> set (snd t).\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1))"

lemma test_2nd_sub: "
\<exists>bet \<in> set t_betaSet_1.(\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h) \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1) ))
\<Longrightarrow>
(\<exists>bet \<in> set t_betaSet_1.(
(\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1))
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<and> (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<forall>t \<in> set u. \<exists>l \<in> set (snd t).\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1))
"
  unfolding t_betaSet_1_def t_SyncInstance_1_def t_TrigInstance_1_def
  sledgehammer

(*---- END the 2nd-sub ----*)

(*---- split the 2nd-trans ----*)
lemma split_2ndtrans:"
\<exists>bet \<in> set t_betaSet_1.
(
  \<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(
    (\<not>P (fst t) l
      \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
      \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)
    )
  \<or>
    (\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)
      \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
      \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)
    )
  )
)
\<Longrightarrow> (\<exists>bet \<in> set t_betaSet_1.(\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l  \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h) \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1))))
\<or>
(\<exists>bet \<in> set t_betaSet_1.(\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1))))
"
  unfolding t_betaSet_1_def t_TrigInstance_1_def t_SyncInstance_1_def
  by smt

(*3rd trans --- split*)
lemma sample: "\<lbrakk>A \<Longrightarrow> C; B \<Longrightarrow> D\<rbrakk> \<Longrightarrow> A \<or> B \<Longrightarrow> C \<or> D"
  by blast
lemma third_trans:"
(\<exists>bet \<in> set t_betaSet_1.(\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l  \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h) \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1))))
\<or>
(\<exists>bet \<in> set t_betaSet_1.(\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1))))
\<Longrightarrow> (\<exists>bet \<in> set t_betaSet_1.((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<forall>l \<in> set (snd t).(\<not>P (fst t) l))  \<and> ((\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))))
\<or>
((\<exists>bet \<in> set t_betaSet_1. (\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1))
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<and> (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<forall>t \<in> set u. \<exists>l \<in> set (snd t).\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t)  l1))
"
  using test_1st_sub test_2nd_sub
  sledgehammer

lemma snd_trans: "\<exists>bet \<in> set t_betaSet_1. (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(
(\<not>P (fst t) l
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1))
\<or>
(\<forall>export \<in> set bet.\<exists>elm \<in> set export. Q (fst elm) (snd elm)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))
) \<Longrightarrow>
\<exists>bet \<in> set t_betaSet_1.
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))
\<or>
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>export \<in> set bet.\<exists>elm \<in> set export. Q (fst elm) (snd elm)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))"
  unfolding t_betaSet_1_def t_SyncInstance_1_def t_TrigInstance_1_def
  by smt

(*---- BIP encoding - 3rd trans----*)
value "\<exists>bet \<in> set t_betaSet_1.
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<forall>l \<in> set (snd t).(\<not>P (fst t) l))
\<and> (\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>bet \<in> set t_betaSet_1.\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<or>
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>export \<in> set bet.\<exists>elm \<in> set export. Q (fst elm) (snd elm)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))"

value "\<exists>bet \<in> set t_betaSet_1.
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l))
\<and> (\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<or>
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>export \<in> set bet.\<exists>elm \<in> set export. Q (fst elm) (snd elm)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))"

lemma third_trans: "\<exists>bet \<in> set t_betaSet_1.
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))
\<or>
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>export \<in> set bet.\<exists>elm \<in> set export. Q (fst elm) (snd elm)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))
\<Longrightarrow>
\<exists>bet \<in> set t_betaSet_1.
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l))
\<and> (\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<or>
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>export \<in> set bet.\<exists>elm \<in> set export. Q (fst elm) (snd elm)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))"
  unfolding t_betaSet_1_def t_SyncInstance_1_def t_TrigInstance_1_def
  by smt

value "\<exists>bet \<in> set t_betaSet_1.
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l))
\<and> (\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<or>
(\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1) \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h) \<and> (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<forall>t \<in> set u. \<exists>l \<in> set (snd t).\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t)  l1) )"

lemma third_trans_1: "\<exists>bet \<in> set t_betaSet_1.
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l))
\<and> (\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<or>
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>export \<in> set bet.\<exists>elm \<in> set export. Q (fst elm) (snd elm)
\<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)
\<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t) l1)))
\<Longrightarrow>
\<exists>bet \<in> set t_betaSet_1.
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l))
\<and> (\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<or>
(\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1) \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h) \<and> (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<forall>t \<in> set u. \<exists>l \<in> set (snd t).\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t)  l1) )"
  unfolding t_betaSet_1_def t_SyncInstance_1_def t_TrigInstance_1_def
  by (smt DiffI Diff_empty Diff_insert0 empty_Diff insertI1 insert_Diff1 insert_Diff_if insert_Diff_single insert_absorb insert_commute insert_iff insert_not_empty list.discI list.set_cases list.set_intros(1) list.set_intros(1) list.set_intros(1) list.set_intros(1) list.simps(15) list.simps(15) list.simps(15) mk_disjoint_insert numeral_eq_iff numeral_eq_one_iff semiring_norm(86) semiring_norm(88) set_ConsD set_empty set_empty set_empty singletonD singletonD singletonD singletonI snd_conv)

(*---- JavaBIP encoding ----*)
value "((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j.\<forall>t \<in> set u. \<forall>l \<in> set (snd t). \<not>P (fst t) l)
\<and> (\<forall>i \<in> set t_TrigInstance_1. \<forall>v \<in> set i. \<forall>k \<in> set v. \<exists>h \<in> set (snd k).\<forall>h1 \<in> set (snd k) - {h}. \<not> Q (fst k) h1))
\<or> ((\<exists>bet \<in> set t_betaSet_1. (\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)) \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)) \<and> (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<forall>t \<in> set u. \<exists>l \<in> set (snd t).\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t)  l1))"

lemma compare: "
((\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j.\<forall>t \<in> set u. \<forall>l \<in> set (snd t). \<not>P (fst t) l)
\<and> (\<forall>i \<in> set t_TrigInstance_1. \<forall>v \<in> set i. \<forall>k \<in> set v. \<exists>h \<in> set (snd k).\<forall>h1 \<in> set (snd k) - {h}. \<not> Q (fst k) h1))
\<or> ((\<exists>bet \<in> set t_betaSet_1. (\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1)) \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h)) \<and> (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<forall>t \<in> set u. \<exists>l \<in> set (snd t).\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t)  l1)) \<Longrightarrow>
\<exists>bet \<in> set t_betaSet_1.
(\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<not>P (fst t) l))
\<and> (\<forall>j \<in> set t_SyncInstance_1.\<forall>u \<in> set j. \<exists>t \<in> set u.\<exists>l \<in> set (snd t).(\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h))
\<or>
(\<forall>elm \<in> set bet.\<exists>el1 \<in> set elm. Q (fst el1) (snd el1) \<and> (\<forall>elm \<in> set bet.\<forall>el1 \<in> set elm.\<forall>h \<in> set (lookup_3 (fst el1) t_TrigInstance_1) - {snd el1}. \<not>Q (fst el1) h) \<and> (\<forall>j \<in> set t_SyncInstance_1. \<forall>u \<in> set j. \<forall>t \<in> set u. \<exists>l \<in> set (snd t).\<forall>l1 \<in> set (snd t) - {l}. \<not> P (fst t)  l1) )
"
  unfolding t_betaSet_1_def t_SyncInstance_1_def t_TrigInstance_1_def
  sledgehammer
end


theory Output_Interface_Replace
imports
  Ipassmt
  Routing_IpAssmt
  Common_Primitive_toString
begin

section\<open>Replacing output interfaces by their IP ranges according to Routing\<close>

text\<open>Copy of @{file \<open>Interface_Replace.thy\<close>}\<close>

definition ipassmt_iface_replace_dstip_mexpr
  :: "'i::len ipassignment \<Rightarrow> iface \<Rightarrow> 'i common_primitive match_expr" where
  "ipassmt_iface_replace_dstip_mexpr ipassmt ifce \<equiv> case ipassmt ifce of
          None \<Rightarrow> Match (OIface ifce)
        | Some ips \<Rightarrow> (match_list_to_match_expr (map (Match \<circ> Dst) (map (uncurry IpAddrNetmask) ips)))"

lemma matches_ipassmt_iface_replace_dstip_mexpr:
    "matches (common_matcher, \<alpha>) (ipassmt_iface_replace_dstip_mexpr ipassmt ifce) a p \<longleftrightarrow> (case ipassmt ifce of
            None \<Rightarrow> match_iface ifce (p_oiface p)
          | Some ips \<Rightarrow> p_dst p \<in> ipcidr_union_set (set ips)
          )"
proof(cases "ipassmt ifce")
case None thus ?thesis by(simp add: ipassmt_iface_replace_dstip_mexpr_def primitive_matcher_generic.Iface_single[OF primitive_matcher_generic_common_matcher])
next
case (Some ips)
  have "matches (common_matcher, \<alpha>) (match_list_to_match_expr (map (Match \<circ> Dst \<circ> (uncurry IpAddrNetmask)) ips)) a p \<longleftrightarrow>
       (\<exists>m\<in>set ips. p_dst p \<in> (uncurry ipset_from_cidr m))"
       by(simp add: match_list_to_match_expr_disjunction[symmetric]
                    match_list_matches match_simplematcher_SrcDst ipt_iprange_to_set_uncurry_IpAddrNetmask)
  with Some show ?thesis
    by(simp add: ipassmt_iface_replace_dstip_mexpr_def bunch_of_lemmata_about_matches ipcidr_union_set_uncurry)
qed

fun oiface_rewrite
  :: "'i::len ipassignment \<Rightarrow> 'i common_primitive match_expr \<Rightarrow> 'i common_primitive match_expr"
where
  "oiface_rewrite _       MatchAny = MatchAny" |
  "oiface_rewrite ipassmt (Match (OIface ifce)) = ipassmt_iface_replace_dstip_mexpr ipassmt ifce" |
  "oiface_rewrite _       (Match a) = Match a" |
  "oiface_rewrite ipassmt (MatchNot m) = MatchNot (oiface_rewrite ipassmt m)" |
  "oiface_rewrite ipassmt (MatchAnd m1 m2) = MatchAnd (oiface_rewrite ipassmt m1) (oiface_rewrite ipassmt m2)"

context
begin
  (*helper1: used in induction case MatchNot*)
  private lemma oiface_rewrite_matches_Primitive:
          "matches (common_matcher, \<alpha>) (MatchNot (oiface_rewrite ipassmt (Match x))) a p = matches (common_matcher, \<alpha>) (MatchNot (Match x)) a p \<longleftrightarrow>
           matches (common_matcher, \<alpha>) (oiface_rewrite ipassmt (Match x)) a p = matches (common_matcher, \<alpha>) (Match x) a p"
  proof(cases x)
  case (OIface ifce)
    have "(matches (common_matcher, \<alpha>) (MatchNot (ipassmt_iface_replace_dstip_mexpr ipassmt ifce)) a p = (\<not> match_iface ifce (p_oiface p))) \<longleftrightarrow>
      (matches (common_matcher, \<alpha>) (ipassmt_iface_replace_dstip_mexpr ipassmt ifce) a p = match_iface ifce (p_oiface p))"
    proof(cases "ipassmt ifce")
    case None thus ?thesis
       apply(simp add: matches_ipassmt_iface_replace_dstip_mexpr)
       apply(simp add: ipassmt_iface_replace_dstip_mexpr_def primitive_matcher_generic.Iface_single_not[OF primitive_matcher_generic_common_matcher])
       done
     next
     case (Some ips)
       {  fix ips
          have "matches (common_matcher, \<alpha>)
                 (MatchNot (match_list_to_match_expr (map (Match \<circ> Dst \<circ> (uncurry IpAddrNetmask)) ips))) a p \<longleftrightarrow>
                 (p_dst p \<notin> ipcidr_union_set (set ips))"
        apply(induction ips)
         apply(simp add: bunch_of_lemmata_about_matches ipcidr_union_set_uncurry)
        apply(simp add: MatchOr_MatchNot)
        apply(simp add: ipcidr_union_set_uncurry)
        apply(simp add: match_simplematcher_SrcDst_not)
        apply(thin_tac _)
        apply(simp add: ipt_iprange_to_set_uncurry_IpAddrNetmask)
        done
       } note helper=this
       from Some show ?thesis
         apply(simp add: matches_ipassmt_iface_replace_dstip_mexpr)
         apply(simp add: ipassmt_iface_replace_dstip_mexpr_def)
         apply(simp add: helper)
         done
     qed
     with OIface show ?thesis
      by(simp add: primitive_matcher_generic.Iface_single_not[OF primitive_matcher_generic_common_matcher]
            primitive_matcher_generic.Iface_single[OF primitive_matcher_generic_common_matcher])
  qed(simp_all)

  lemma ipassmt_disjoint_matcheq_iifce_dstip:
        assumes ipassmt_nowild: "ipassmt_sanity_nowildcards ipassmt"
            and ipassmt_disjoint: "ipassmt_sanity_disjoint ipassmt"
            and ifce: "ipassmt ifce = Some i_ips"
            and p_ifce: "ipassmt (Iface (p_oiface p)) = Some p_ips \<and> p_dst p \<in> ipcidr_union_set (set p_ips)"
        shows   "match_iface ifce (p_oiface p) \<longleftrightarrow> p_dst p \<in> ipcidr_union_set (set i_ips)"
    proof
     assume "match_iface ifce (p_oiface p)"
     thus "p_dst p \<in> ipcidr_union_set (set i_ips)"
       apply(cases "ifce = Iface (p_oiface p)")
        using ifce p_ifce apply force
       by (metis domI iface.sel iface_is_wildcard_def ifce ipassmt_nowild ipassmt_sanity_nowildcards_def match_iface.elims(2) match_iface_case_nowildcard)
   next
     assume a: "p_dst p \<in> ipcidr_union_set (set i_ips)"
     \<comment> \<open>basically, we need to reverse the map @{term ipassmt}\<close>

     from ipassmt_disjoint_nonempty_inj[OF ipassmt_disjoint ifce] a have ipassmt_inj: "\<forall>k. ipassmt k = Some i_ips \<longrightarrow> k = ifce" by blast

     from ipassmt_disjoint_inj_k[OF ipassmt_disjoint ifce _ a] have ipassmt_inj_k:
      "\<And>k ips'. ipassmt k = Some ips' \<Longrightarrow> p_dst p \<in> ipcidr_union_set (set ips') \<Longrightarrow> k = ifce" by simp

     have ipassmt_inj_p: "\<forall>ips'. p_dst p \<in> ipcidr_union_set (set ips') \<and> (\<exists>k. ipassmt k = Some ips') \<longrightarrow> ips' = i_ips"
     (*using ipassmt_inj_k ifce by force*)
     proof(intro allI impI; elim conjE exE)
       fix ips' k
       assume as: "p_dst p \<in> ipcidr_union_set (set ips')" "ipassmt k = Some ips'"
       hence "k = ifce" using ipassmt_inj_k by simp
       thus "ips' = i_ips" using ifce as by simp
     qed

     from p_ifce have "(Iface (p_oiface p)) = ifce" using ipassmt_inj_p ipassmt_inj by blast

     thus "match_iface ifce (p_oiface p)" using match_iface_refl by blast
   qed

  (*helper2: used in induction base case*)
  private lemma matches_ipassmt_iface_replace_dstip_mexpr_case_Iface:
        fixes ifce::iface
        assumes "ipassmt_sanity_nowildcards ipassmt"
            and "ipassmt_sanity_disjoint ipassmt"
            and "ipassmt (Iface (p_oiface p)) = Some p_ips \<and> p_dst p \<in> ipcidr_union_set (set p_ips)"
        shows   "matches (common_matcher, \<alpha>) (ipassmt_iface_replace_dstip_mexpr ipassmt ifce) a p \<longleftrightarrow>
                 matches (common_matcher, \<alpha>) (Match (OIface ifce)) a p"
  proof -
    have "matches (common_matcher, \<alpha>) (ipassmt_iface_replace_dstip_mexpr ipassmt ifce) a p = match_iface ifce (p_oiface p)"
      proof -
        show ?thesis
        proof(cases "ipassmt ifce")
          case None thus ?thesis by(simp add: matches_ipassmt_iface_replace_dstip_mexpr)
          next
          case (Some y) with assms(2) have "p_dst p \<in> ipcidr_union_set (set y) = match_iface ifce (p_oiface p)"
            using assms(1) assms(3) ipassmt_disjoint_matcheq_iifce_dstip by blast
            with Some show ?thesis by(simp add: matches_ipassmt_iface_replace_dstip_mexpr)
        qed
    qed
    thus ?thesis by(simp add: primitive_matcher_generic.Iface_single[OF primitive_matcher_generic_common_matcher])
  qed

  lemma matches_oiface_rewrite_ipassmt:
       "normalized_nnf_match m \<Longrightarrow> ipassmt_sanity_nowildcards ipassmt \<Longrightarrow> ipassmt_sanity_disjoint ipassmt \<Longrightarrow>
        (\<exists>p_ips. ipassmt (Iface (p_oiface p)) = Some p_ips \<and> p_dst p \<in> ipcidr_union_set (set p_ips)) \<Longrightarrow>
        matches (common_matcher, \<alpha>) (oiface_rewrite ipassmt m) a p \<longleftrightarrow> matches (common_matcher, \<alpha>) m a p"
    proof(induction m)
    case MatchAny thus ?case by simp
    next
    case (MatchNot m)
      hence IH: "normalized_nnf_match m \<Longrightarrow>
        matches (common_matcher, \<alpha>) (oiface_rewrite ipassmt m) a p =matches (common_matcher, \<alpha>) m a p" by blast
      with MatchNot.prems IH show ?case by(induction m) (simp_all add: oiface_rewrite_matches_Primitive)
    next
    case(Match x) thus ?case
      proof(cases x)
        case (OIface ifce) with Match show ?thesis
        apply(cases "ipassmt (Iface (p_oiface p))")
         prefer 2
          apply(simp add: matches_ipassmt_iface_replace_dstip_mexpr_case_Iface; fail)
        by auto
      qed(simp_all)
    next
    case (MatchAnd m1 m2) thus ?case by(simp add: bunch_of_lemmata_about_matches)
    qed

  lemma matches_oiface_rewrite:
       "normalized_nnf_match m \<Longrightarrow> ipassmt_sanity_nowildcards ipassmt \<comment> \<open>TODO: check?\<close> \<Longrightarrow>
        correct_routing rt \<Longrightarrow>
        ipassmt = map_of (routing_ipassmt rt) \<Longrightarrow>
        output_iface (routing_table_semantics rt (p_dst p)) = p_oiface p \<Longrightarrow>
        matches (common_matcher, \<alpha>) (oiface_rewrite ipassmt m) a p \<longleftrightarrow> matches (common_matcher, \<alpha>) m a p"
  apply(rule matches_oiface_rewrite_ipassmt; assumption?)
   apply(simp add: correct_routing_def routing_ipassmt_ipassmt_sanity_disjoint; fail)
  apply(simp)
  apply(rule routing_ipassmt; assumption?)
   apply(simp add: correct_routing_def; fail)
  done
end

lemma oiface_rewrite_preserves_nodisc:
  "\<forall>a. \<not> disc (Dst a) \<Longrightarrow> \<not> has_disc disc m \<Longrightarrow> \<not> has_disc disc (oiface_rewrite ipassmt m)"
  proof(induction ipassmt m rule: oiface_rewrite.induct)
  case 2
    have "\<forall>a. \<not> disc (Dst a) \<Longrightarrow> \<not> disc (OIface ifce) \<Longrightarrow> \<not> has_disc disc (ipassmt_iface_replace_dstip_mexpr ipassmt ifce)"
      for ifce ipassmt
      apply(simp add: ipassmt_iface_replace_dstip_mexpr_def split: option.split)
      apply(intro allI impI, rename_tac ips)
      apply(drule_tac X=Dst and ls="map (uncurry IpAddrNetmask) ips" in match_list_to_match_expr_not_has_disc)
      apply(simp)
      done
    with 2 show ?case by simp
  qed(simp_all)

end