(* D. Fuenmayor and A. Steen, August 2021 *)
(* This file contains domain-specific basic definitions on arguments, extensions, labellings, etc. *)
(* Auxiliary references:
 [BCG 2011] Baroni, P., M. Caminada and M. Giacomin, An introduction to argumentation semantics,
            Knowledge Engineering Review (2011)
 [Dung 1995] Dung, P.M., On the acceptability of arguments and its fundamental role in nonmonotonic reasoning,
             logic programming and n-person games, Artificial Intelligence. (1995)
*)
theory base
  imports Main misc
begin

(* A named collection of definitions related to AFs; it can later be referred to by its name 'Defs'. *)
named_theorems Defs

(* An abstract argumentation framework AF is characterized by its
   set of arguments \<A> of type 'a Set (the arguments being of arbitrary type 'a)
   and the attack relation (usually referred to as 'att' or ... ) of type 'a Rel.
   The is usually bundled within a pair (\<A>, att) in literature. For simplicity
   (and technical reasons) we pass to each concept \<A> and att individually,
   instead of the pair AF = (\<A>, att). Any 2-ary function can be regarded
   a nested unary function in terms of Currying. *)

(***********************************************************)
(***********************************************************)
(* Notions primarily related to extension based semantics. *)
(***********************************************************)
(***********************************************************)

(* Given a set of arguments S, we define its set of attacked (+) and attacking (-) arguments ([BCG 2011] p. 3). *)
definition plusset :: \<open>'a Rel \<Rightarrow> 'a Set \<Rightarrow> 'a Set\<close> ("[_|_]\<^sup>+")
  where \<open>[att|S]\<^sup>+ \<equiv> \<lambda>b. \<exists>a. S a \<and> att a b\<close>
definition minusset:: \<open>'a Rel \<Rightarrow> 'a Set \<Rightarrow> 'a Set\<close> ("[_|_]\<^sup>-")
  where \<open>[att|S]\<^sup>- \<equiv> \<lambda>b. \<exists>a. S a \<and> att b a\<close>

(* Below we define relativized variants, which require an universe set of arguments \<A> as additional parameter: *)
definition plusset_rel :: \<open>'a Set \<Rightarrow> 'a Rel \<Rightarrow> 'a Set \<Rightarrow> 'a Set\<close> ("[_|_|_]\<^sup>+")
  where \<open>[\<A>|att|S]\<^sup>+ \<equiv> \<lambda>b. (\<exists>a. \<A> a \<and> S a \<and> att a b)\<close>
definition minusset_rel:: \<open>'a Set \<Rightarrow> 'a Rel \<Rightarrow> 'a Set \<Rightarrow> 'a Set\<close> ("[_|_|_]\<^sup>-")
  where \<open>[\<A>|att|S]\<^sup>- \<equiv> \<lambda>b. (\<exists>a. \<A> a \<and> S a \<and> att b a)\<close>

(* A set S of arguments defends an argument 'a' iff each argument 'b' attacking 'a' is itself attacked by
   at least one argument in S ([Dung 1995] Def. 6(1) and  [BCG 2011] Def. 11). *)
definition defends :: \<open>'a Rel \<Rightarrow> 'a Set \<Rightarrow> 'a \<Rightarrow> bool\<close>
  where \<open>defends \<equiv> \<lambda>att S a. \<forall>b. att b a \<longrightarrow> (\<exists>z. S z \<and> att z b)\<close>

definition defends_rel :: \<open>'a Set \<Rightarrow> 'a Rel \<Rightarrow> 'a Set \<Rightarrow> 'a \<Rightarrow> bool\<close> ("defends\<^sup>_")
  where \<open>defends\<^sup>\<A> \<equiv> \<lambda>att S a. \<forall>b. \<A> b \<longrightarrow> att b a \<longrightarrow> (\<exists>z. \<A> z \<and> S z \<and> att z b)\<close>

lemma defends_defEq: \<open>defends att S a = [att|\<lbrace>a\<rbrace>]\<^sup>- \<subseteq> [att|S]\<^sup>+\<close>
  by (simp add: defends_def minusset_def plusset_def)

lemma defends_rel_defEq: \<open>\<A> a \<Longrightarrow> (defends\<^sup>\<A> att S a) = [\<A>|att|\<lbrace>a\<rbrace>]\<^sup>- \<subseteq>\<^sup>\<A> [\<A>|att|S]\<^sup>+\<close>
  by (simp add: defends_rel_def minusset_rel_def plusset_rel_def)

(* The characteristic function, denoted by \<F>, of an argumentation framework AF = (\<A>, att) is
   defined as \<F>(S) = {A | A is defended by S} ([BCG 2011] Def. 11). In fact, this corresponds to 'defends'.*)
abbreviation charFun  :: \<open>'a Rel \<Rightarrow> 'a Set \<Rightarrow> 'a Set\<close> ("\<F>")
  where \<open>\<F> \<equiv> defends\<close>
abbreviation charFun_rel :: \<open>'a Set \<Rightarrow> 'a Rel \<Rightarrow> 'a Set \<Rightarrow> 'a Set\<close> ("\<F>\<^sup>_")
  where \<open>\<F>\<^sup>\<A> \<equiv> defends\<^sup>\<A>\<close>

(* \<F> is monotone (i.e. order preserving wrt. set inclusion). *)
lemma \<F>_mono': "MONO (\<F>\<^sup>\<A> att)" unfolding MONO_def by (smt (verit, ccfv_SIG) defends_rel_def)
lemma \<F>_mono: "MONO\<^sup>\<A> (\<F>\<^sup>\<A> att)" unfolding MONO_rel_def defends_rel_def by blast

(* We can in fact verify that \<F> has both a least and a greatest fixed point. *)
lemma \<F>_leastFP_ex': \<open>\<exists>S. least (fixpoint (\<F>\<^sup>\<A> att)) S id\<close> using \<F>_mono' wKTl' by auto
lemma \<F>_leastFP_ex:  \<open>\<exists>S. least\<^sup>\<A> (fixpoint\<^sup>\<A> (\<F>\<^sup>\<A> att)) S id\<close> by (simp add: \<F>_mono wKTl_relw)
lemma \<F>_greatestFP_ex': \<open>\<exists>S. greatest (fixpoint (\<F>\<^sup>\<A> att)) S id\<close> using \<F>_mono' wKTg' by auto
lemma \<F>_greatestFP_ex:  \<open>\<exists>S. greatest\<^sup>\<A> (fixpoint\<^sup>\<A> (\<F>\<^sup>\<A> att)) S id\<close> by (simp add: \<F>_mono wKTg_relw)

(* Recalling that least/greatest elements are unique we can indeed define:
   "the least/greatest fixed point of \<F>".*)
definition \<open>tlfp att \<equiv> THE S. least (fixpoint (\<F> att)) S id\<close>
definition \<open>tgfp att \<equiv> THE S. greatest (fixpoint (\<F> att)) S id\<close>

(* least/greatest fixed point of \<F> wrt. universe \<A>*)
definition lfpR ("lfp\<^sup>_") where \<open>lfp\<^sup>\<A> \<equiv> \<lambda>att S. least\<^sup>\<A> (fixpoint\<^sup>\<A> (\<F>\<^sup>\<A> att)) S id\<close>
definition gfpR ("gfp\<^sup>_") where \<open>gfp\<^sup>\<A> \<equiv> \<lambda>att S. greatest\<^sup>\<A> (fixpoint\<^sup>\<A> (\<F>\<^sup>\<A> att)) S id\<close>

(***********************************************************)
(***********************************************************)
(* Notions primarily related to Labelling based semantics. *)
(***********************************************************)
(***********************************************************)

(* Generalising sets as "labellings", i.e. functions into some finite codomain (of "labels") *)
datatype Label = In | Out | Undec (*introduces a 3-element set of labels*)
type_synonym 'a Labelling = \<open>'a \<Rightarrow> Label\<close> (*labellings as functions into "labels" *)

(* (cf. [BCG 2011] p. 4) *)
definition inset :: \<open>'a Labelling \<Rightarrow> 'a Set\<close> ("in") where \<open>in(Lab) \<equiv> \<lambda>x. Lab(x) = In\<close>
definition outset :: \<open>'a Labelling \<Rightarrow> 'a Set\<close> ("out") where \<open>out(Lab) \<equiv> \<lambda>x. Lab(x) = Out\<close>
definition undecset :: \<open>'a Labelling \<Rightarrow> 'a Set\<close> ("undec") where \<open>undec(Lab) \<equiv> \<lambda>x. Lab(x) = Undec\<close>

definition equivalentLab :: \<open>'a Labelling \<Rightarrow> 'a Labelling \<Rightarrow> bool\<close> (infix "\<cong>" 52)
  where "L1 \<cong> L2 \<equiv> (in(L1) \<approx> in(L2)) \<and> (out(L1) \<approx> out(L2))"

lemma InUndecEquivLab: "(in(L1) \<approx> in(L2)) \<and> (undec(L1) \<approx> undec(L2)) \<longrightarrow> L1 \<cong> L2"
  by (smt (verit, ccfv_SIG) Label.exhaust equivalentLab_def inset_def outset_def undecset_def)
lemma OutUndecEquivLab: "(out(L1) \<approx> out(L2)) \<and> (undec(L1) \<approx> undec(L2)) \<longrightarrow> L1 \<cong> L2"
  by (smt (verit, ccfv_SIG) Label.exhaust equivalentLab_def inset_def outset_def undecset_def)

lemma equivLabId: "L1 \<cong> L2 \<longleftrightarrow> L1 = L2" using Label.exhaust ext by (metis (full_types) equivalentLab_def inset_def outset_def)

(* Analogously we provide a relativized definition too (wrt. an universe set of arguments \<A>)*)
definition equivalentLab_rel :: \<open>'a Labelling \<Rightarrow> 'a Set \<Rightarrow> 'a Labelling \<Rightarrow> bool\<close> ("_\<cong>\<^sup>__")
  where "L1 \<cong>\<^sup>\<A> L2 \<equiv> (in(L1) \<approx>\<^sup>\<A> in(L2)) \<and> (out(L1) \<approx>\<^sup>\<A> out(L2))"

lemma InUndecEquivLab_rel: "(in(L1) \<approx>\<^sup>\<A> in(L2)) \<and> (undec(L1) \<approx>\<^sup>\<A> undec(L2)) \<longrightarrow> L1 \<cong>\<^sup>\<A> L2"
  by (smt (verit, ccfv_SIG) Label.exhaust equivalentLab_rel_def inset_def outset_def undecset_def)
lemma OutUndecEquivLab_rel: "(out(L1) \<approx>\<^sup>\<A> out(L2)) \<and> (undec(L1) \<approx>\<^sup>\<A> undec(L2)) \<longrightarrow> L1 \<cong>\<^sup>\<A> L2"
  by (smt (verit, ccfv_SIG) Label.exhaust equivalentLab_rel_def inset_def outset_def undecset_def)

lemma equivLabId_rel: "L1 \<cong>\<^sup>\<A> L2 \<longleftrightarrow> L1 = L2" oops (* does not hold as expected *)
lemma IdLabImplEquiv_rel: "L1 = L2 \<Longrightarrow> L1 \<cong>\<^sup>\<A> L2" (* of course this one-sided direction holds *)
  by (simp add: equivalentLab_rel_def)

(***********************************************************)
(***********************************************************)
(*        Argument justification (cf. [BCG 2011] \<section>4).      *)
(***********************************************************)
(***********************************************************)

type_synonym 'a LabSemantics = \<open>'a Rel \<Rightarrow> 'a Labelling \<Rightarrow> bool\<close>

(* semantics has to be non-empty *)
definition skepticallyJustified :: \<open>'a LabSemantics \<Rightarrow> 'a Rel \<Rightarrow> 'a \<Rightarrow> bool\<close> ("sJ")
  where \<open>sJ S att \<equiv> \<lambda>arg. \<forall>Lab. ((\<exists>x. (Lab x) = In) \<and> (S att Lab)) \<longrightarrow> Lab(arg) = In\<close>
(* non-emptiness implicit *)
definition credulouslyJustified :: \<open>'a LabSemantics \<Rightarrow> 'a Rel \<Rightarrow> 'a \<Rightarrow> bool\<close> ("cJ")
  where \<open>cJ S att \<equiv> \<lambda>arg. \<exists>Lab. (S att Lab) \<and> Lab(arg) = In\<close>

lemma \<open>\<exists> S att a. \<not>(sJ S att a \<longrightarrow> cJ S att a)\<close>
  unfolding skepticallyJustified_def credulouslyJustified_def
  by auto
lemma \<open>cJ S att a \<Longrightarrow> sJ S att a\<close> nitpick oops (* expected *)

(***********************************************************)
(***********************************************************)
(*     Technical auxiliary definitions for experiments     *)
(***********************************************************)
(***********************************************************)

(* The predicate below is actually equivalent to: S = (Prop att).
This is useful for obtaining at once *all* sets of extensions/labellings by using Nitpick *)
abbreviation \<open>findFor  att Prop S \<equiv> \<forall>x.  S x  \<longleftrightarrow> Prop att x\<close>
(* For technical reasons, we will often employ the equivalent formulation below.
(when using sets instead of predicates, we get nitpick to output only the contained elements) *)
abbreviation \<open>findFor' att Prop S \<equiv> \<forall>x. x \<in> S \<longleftrightarrow> Prop att x\<close>

(* Technical: Include into Defs collection *)
declare plusset_def[Defs] minusset_def[Defs]
        plusset_rel_def[Defs] minusset_rel_def[Defs]
        defends_def[Defs] defends_rel_def[Defs]
        inset_def[Defs] outset_def[Defs] undecset_def[Defs]

end


(* Author: Tobias Nipkow *)

theory Abs_Int3_ITP
imports Abs_Int2_ivl_ITP
begin

subsection "Widening and Narrowing"

class WN = SL_top +
fixes widen :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infix "\<nabla>" 65)
assumes widen1: "x \<sqsubseteq> x \<nabla> y"
assumes widen2: "y \<sqsubseteq> x \<nabla> y"
fixes narrow :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infix "\<triangle>" 65)
assumes narrow1: "y \<sqsubseteq> x \<Longrightarrow> y \<sqsubseteq> x \<triangle> y"
assumes narrow2: "y \<sqsubseteq> x \<Longrightarrow> x \<triangle> y \<sqsubseteq> x"

subsubsection "Intervals"

instantiation ivl :: WN
begin

definition "widen_ivl ivl1 ivl2 =
  ((*if is_empty ivl1 then ivl2 else
   if is_empty ivl2 then ivl1 else*)
     case (ivl1,ivl2) of (I l1 h1, I l2 h2) \<Rightarrow>
       I (if le_option False l2 l1 \<and> l2 \<noteq> l1 then None else l1)
         (if le_option True h1 h2 \<and> h1 \<noteq> h2 then None else h1))"

definition "narrow_ivl ivl1 ivl2 =
  ((*if is_empty ivl1 \<or> is_empty ivl2 then empty else*)
     case (ivl1,ivl2) of (I l1 h1, I l2 h2) \<Rightarrow>
       I (if l1 = None then l2 else l1)
         (if h1 = None then h2 else h1))"

instance
proof qed
  (auto simp add: widen_ivl_def narrow_ivl_def le_option_def le_ivl_def empty_def split: ivl.split option.split if_splits)

end

subsubsection "Abstract State"

instantiation st :: (WN)WN
begin

definition "widen_st F1 F2 =
  FunDom (\<lambda>x. fun F1 x \<nabla> fun F2 x) (inter_list (dom F1) (dom F2))"

definition "narrow_st F1 F2 =
  FunDom (\<lambda>x. fun F1 x \<triangle> fun F2 x) (inter_list (dom F1) (dom F2))"

instance
proof
  case goal1 thus ?case
    by(simp add: widen_st_def le_st_def lookup_def widen1)
next
  case goal2 thus ?case
    by(simp add: widen_st_def le_st_def lookup_def widen2)
next
  case goal3 thus ?case
    by(auto simp: narrow_st_def le_st_def lookup_def narrow1)
next
  case goal4 thus ?case
    by(auto simp: narrow_st_def le_st_def lookup_def narrow2)
qed

end

subsubsection "Option"

instantiation option :: (WN)WN
begin

fun widen_option where
"None \<nabla> x = x" |
"x \<nabla> None = x" |
"(Some x) \<nabla> (Some y) = Some(x \<nabla> y)"

fun narrow_option where
"None \<triangle> x = None" |
"x \<triangle> None = None" |
"(Some x) \<triangle> (Some y) = Some(x \<triangle> y)"

instance
proof
  case goal1 show ?case
    by(induct x y rule: widen_option.induct) (simp_all add: widen1)
next
  case goal2 show ?case
    by(induct x y rule: widen_option.induct) (simp_all add: widen2)
next
  case goal3 thus ?case
    by(induct x y rule: narrow_option.induct) (simp_all add: narrow1)
next
  case goal4 thus ?case
    by(induct x y rule: narrow_option.induct) (simp_all add: narrow2)
qed

end

subsubsection "Annotated commands"

fun map2_acom :: "('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a acom \<Rightarrow> 'a acom \<Rightarrow> 'a acom" where
"map2_acom f (SKIP {a1}) (SKIP {a2}) = (SKIP {f a1 a2})" |
"map2_acom f (x ::= e {a1}) (x' ::= e' {a2}) = (x ::= e {f a1 a2})" |
"map2_acom f (c1;;c2) (c1';;c2') = (map2_acom f c1 c1';; map2_acom f c2 c2')" |
"map2_acom f (IF b THEN c1 ELSE c2 {a1}) (IF b' THEN c1' ELSE c2' {a2}) =
  (IF b THEN map2_acom f c1 c1' ELSE map2_acom f c2 c2' {f a1 a2})" |
"map2_acom f ({a1} WHILE b DO c {a2}) ({a3} WHILE b' DO c' {a4}) =
  ({f a1 a3} WHILE b DO map2_acom f c c' {f a2 a4})"

abbreviation widen_acom :: "('a::WN)acom \<Rightarrow> 'a acom \<Rightarrow> 'a acom" (infix "\<nabla>\<^sub>c" 65)
where "widen_acom == map2_acom (op \<nabla>)"

abbreviation narrow_acom :: "('a::WN)acom \<Rightarrow> 'a acom \<Rightarrow> 'a acom" (infix "\<triangle>\<^sub>c" 65)
where "narrow_acom == map2_acom (op \<triangle>)"

lemma widen1_acom: "strip c = strip c' \<Longrightarrow> c \<sqsubseteq> c \<nabla>\<^sub>c c'"
by(induct c c' rule: le_acom.induct)(simp_all add: widen1)

lemma widen2_acom: "strip c = strip c' \<Longrightarrow> c' \<sqsubseteq> c \<nabla>\<^sub>c c'"
by(induct c c' rule: le_acom.induct)(simp_all add: widen2)

lemma narrow1_acom: "y \<sqsubseteq> x \<Longrightarrow> y \<sqsubseteq> x \<triangle>\<^sub>c y"
by(induct y x rule: le_acom.induct) (simp_all add: narrow1)

lemma narrow2_acom: "y \<sqsubseteq> x \<Longrightarrow> x \<triangle>\<^sub>c y \<sqsubseteq> x"
by(induct y x rule: le_acom.induct) (simp_all add: narrow2)

subsubsection "Post-fixed point computation"

definition iter_widen :: "('a acom \<Rightarrow> 'a acom) \<Rightarrow> 'a acom \<Rightarrow> ('a::WN)acom option"
where "iter_widen f = while_option (\<lambda>c. \<not> f c \<sqsubseteq> c) (\<lambda>c. c \<nabla>\<^sub>c f c)"

definition iter_narrow :: "('a acom \<Rightarrow> 'a acom) \<Rightarrow> 'a acom \<Rightarrow> 'a::WN acom option"
where "iter_narrow f = while_option (\<lambda>c. \<not> c \<sqsubseteq> c \<triangle>\<^sub>c f c) (\<lambda>c. c \<triangle>\<^sub>c f c)"

definition pfp_wn ::
  "(('a::WN)option acom \<Rightarrow> 'a option acom) \<Rightarrow> com \<Rightarrow> 'a option acom option"
where "pfp_wn f c = (case iter_widen f (\<bottom>\<^sub>c c) of None \<Rightarrow> None
                     | Some c' \<Rightarrow> iter_narrow f c')"

lemma strip_map2_acom:
 "strip c1 = strip c2 \<Longrightarrow> strip(map2_acom f c1 c2) = strip c1"
by(induct f c1 c2 rule: map2_acom.induct) simp_all

lemma iter_widen_pfp: "iter_widen f c = Some c' \<Longrightarrow> f c' \<sqsubseteq> c'"
by(auto simp add: iter_widen_def dest: while_option_stop)

lemma strip_while: fixes f :: "'a acom \<Rightarrow> 'a acom"
assumes "\<forall>c. strip (f c) = strip c" and "while_option P f c = Some c'"
shows "strip c' = strip c"
using while_option_rule[where P = "\<lambda>c'. strip c' = strip c", OF _ assms(2)]
by (metis assms(1))

lemma strip_iter_widen: fixes f :: "'a::WN acom \<Rightarrow> 'a acom"
assumes "\<forall>c. strip (f c) = strip c" and "iter_widen f c = Some c'"
shows "strip c' = strip c"
proof-
  have "\<forall>c. strip(c \<nabla>\<^sub>c f c) = strip c" by (metis assms(1) strip_map2_acom)
  from strip_while[OF this] assms(2) show ?thesis by(simp add: iter_widen_def)
qed

lemma iter_narrow_pfp: assumes "mono f" and "f c0 \<sqsubseteq> c0"
and "iter_narrow f c0 = Some c"
shows "f c \<sqsubseteq> c \<and> c \<sqsubseteq> c0" (is "?P c")
proof-
  { fix c assume "?P c"
    note 1 = conjunct1[OF this] and 2 = conjunct2[OF this]
    let ?c' = "c \<triangle>\<^sub>c f c"
    have "?P ?c'"
    proof
      have "f ?c' \<sqsubseteq> f c"  by(rule monoD[OF `mono f` narrow2_acom[OF 1]])
      also have "\<dots> \<sqsubseteq> ?c'" by(rule narrow1_acom[OF 1])
      finally show "f ?c' \<sqsubseteq> ?c'" .
      have "?c' \<sqsubseteq> c" by (rule narrow2_acom[OF 1])
      also have "c \<sqsubseteq> c0" by(rule 2)
      finally show "?c' \<sqsubseteq> c0" .
    qed
  }
  with while_option_rule[where P = ?P, OF _ assms(3)[simplified iter_narrow_def]]
    assms(2) le_refl
  show ?thesis by blast
qed

lemma pfp_wn_pfp:
  "\<lbrakk> mono f;  pfp_wn f c = Some c' \<rbrakk> \<Longrightarrow> f c' \<sqsubseteq> c'"
unfolding pfp_wn_def
by (auto dest: iter_widen_pfp iter_narrow_pfp split: option.splits)

lemma strip_pfp_wn:
  "\<lbrakk> \<forall>c. strip(f c) = strip c; pfp_wn f c = Some c' \<rbrakk> \<Longrightarrow> strip c' = c"
apply(auto simp add: pfp_wn_def iter_narrow_def split: option.splits)
by (metis (mono_tags) strip_map2_acom strip_while strip_bot_acom strip_iter_widen)

locale Abs_Int2 = Abs_Int1_mono
where \<gamma>=\<gamma> for \<gamma> :: "'av::{WN,L_top_bot} \<Rightarrow> val set"
begin

definition AI_wn :: "com \<Rightarrow> 'av st option acom option" where
"AI_wn = pfp_wn (step' \<top>)"

lemma AI_wn_sound: "AI_wn c = Some c' \<Longrightarrow> CS c \<le> \<gamma>\<^sub>c c'"
proof(simp add: CS_def AI_wn_def)
  assume 1: "pfp_wn (step' \<top>) c = Some c'"
  from pfp_wn_pfp[OF mono_step'2 1]
  have 2: "step' \<top> c' \<sqsubseteq> c'" .
  have 3: "strip (\<gamma>\<^sub>c (step' \<top> c')) = c" by(simp add: strip_pfp_wn[OF _ 1])
  have "lfp (step UNIV) c \<le> \<gamma>\<^sub>c (step' \<top> c')"
  proof(rule lfp_lowerbound[simplified,OF 3])
    show "step UNIV (\<gamma>\<^sub>c (step' \<top> c')) \<le> \<gamma>\<^sub>c (step' \<top> c')"
    proof(rule step_preserves_le[OF _ _])
      show "UNIV \<subseteq> \<gamma>\<^sub>o \<top>" by simp
      show "\<gamma>\<^sub>c (step' \<top> c') \<le> \<gamma>\<^sub>c c'" by(rule mono_gamma_c[OF 2])
    qed
  qed
  from this 2 show "lfp (step UNIV) c \<le> \<gamma>\<^sub>c c'"
    by (blast intro: mono_gamma_c order_trans)
qed

end

global_interpretation Abs_Int2
where \<gamma> = \<gamma>_ivl and num' = num_ivl and plus' = plus_ivl
and test_num' = in_ivl
and filter_plus' = filter_plus_ivl and filter_less' = filter_less_ivl
defines AI_ivl' = AI_wn
..

subsubsection "Tests"

definition "step_up_ivl n = ((\<lambda>c. c \<nabla>\<^sub>c step_ivl \<top> c)^^n)"
definition "step_down_ivl n = ((\<lambda>c. c \<triangle>\<^sub>c step_ivl \<top> c)^^n)"

text{* For @{const test3_ivl}, @{const AI_ivl} needed as many iterations as
the loop took to execute. In contrast, @{const AI_ivl'} converges in a
constant number of steps: *}

value "show_acom (step_up_ivl 1 (\<bottom>\<^sub>c test3_ivl))"
value "show_acom (step_up_ivl 2 (\<bottom>\<^sub>c test3_ivl))"
value "show_acom (step_up_ivl 3 (\<bottom>\<^sub>c test3_ivl))"
value "show_acom (step_up_ivl 4 (\<bottom>\<^sub>c test3_ivl))"
value "show_acom (step_up_ivl 5 (\<bottom>\<^sub>c test3_ivl))"
value "show_acom (step_down_ivl 1 (step_up_ivl 5 (\<bottom>\<^sub>c test3_ivl)))"
value "show_acom (step_down_ivl 2 (step_up_ivl 5 (\<bottom>\<^sub>c test3_ivl)))"
value "show_acom (step_down_ivl 3 (step_up_ivl 5 (\<bottom>\<^sub>c test3_ivl)))"

text{* Now all the analyses terminate: *}

value "show_acom_opt (AI_ivl' test4_ivl)"
value "show_acom_opt (AI_ivl' test5_ivl)"
value "show_acom_opt (AI_ivl' test6_ivl)"

subsubsection "Termination: Intervals"

definition m_ivl :: "ivl \<Rightarrow> nat" where
"m_ivl ivl = (case ivl of I l h \<Rightarrow>
     (case l of None \<Rightarrow> 0 | Some _ \<Rightarrow> 1) + (case h of None \<Rightarrow> 0 | Some _ \<Rightarrow> 1))"

lemma m_ivl_height: "m_ivl ivl \<le> 2"
by(simp add: m_ivl_def split: ivl.split option.split)

lemma m_ivl_anti_mono: "(y::ivl) \<sqsubseteq> x \<Longrightarrow> m_ivl x \<le> m_ivl y"
by(auto simp: m_ivl_def le_option_def le_ivl_def
        split: ivl.split option.split if_splits)

lemma m_ivl_widen:
  "~ y \<sqsubseteq> x \<Longrightarrow> m_ivl(x \<nabla> y) < m_ivl x"
by(auto simp: m_ivl_def widen_ivl_def le_option_def le_ivl_def
        split: ivl.splits option.splits if_splits)

lemma Top_less_ivl: "\<top> \<sqsubseteq> x \<Longrightarrow> m_ivl x = 0"
by(auto simp: m_ivl_def le_option_def le_ivl_def empty_def Top_ivl_def
        split: ivl.split option.split if_splits)

definition n_ivl :: "ivl \<Rightarrow> nat" where
"n_ivl ivl = 2 - m_ivl ivl"

lemma n_ivl_mono: "(x::ivl) \<sqsubseteq> y \<Longrightarrow> n_ivl x \<le> n_ivl y"
unfolding n_ivl_def by (metis diff_le_mono2 m_ivl_anti_mono)

lemma n_ivl_narrow:
  "~ x \<sqsubseteq> x \<triangle> y \<Longrightarrow> n_ivl(x \<triangle> y) < n_ivl x"
by(auto simp: n_ivl_def m_ivl_def narrow_ivl_def le_option_def le_ivl_def
        split: ivl.splits option.splits if_splits)

subsubsection "Termination: Abstract State"

definition "m_st m st = (\<Sum>x\<in>set(dom st). m(fun st x))"

lemma m_st_height: assumes "finite X" and "set (dom S) \<subseteq> X"
shows "m_st m_ivl S \<le> 2 * card X"
proof(auto simp: m_st_def)
  have "(\<Sum>x\<in>set(dom S). m_ivl (fun S x)) \<le> (\<Sum>x\<in>set(dom S). 2)" (is "?L \<le> _")
    by(rule sum_mono)(simp add:m_ivl_height)
  also have "\<dots> \<le> (\<Sum>x\<in>X. 2)"
    by(rule sum_mono3[OF assms]) simp
  also have "\<dots> = 2 * card X" by(simp add: sum_constant)
  finally show "?L \<le> \<dots>" .
qed

lemma m_st_anti_mono:
  "S1 \<sqsubseteq> S2 \<Longrightarrow> m_st m_ivl S2 \<le> m_st m_ivl S1"
proof(auto simp: m_st_def le_st_def lookup_def split: if_splits)
  let ?X = "set(dom S1)" let ?Y = "set(dom S2)"
  let ?f = "fun S1" let ?g = "fun S2"
  assume asm: "\<forall>x\<in>?Y. (x \<in> ?X \<longrightarrow> ?f x \<sqsubseteq> ?g x) \<and> (x \<in> ?X \<or> \<top> \<sqsubseteq> ?g x)"
  hence 1: "\<forall>y\<in>?Y\<inter>?X. m_ivl(?g y) \<le> m_ivl(?f y)" by(simp add: m_ivl_anti_mono)
  have 0: "\<forall>x\<in>?Y-?X. m_ivl(?g x) = 0" using asm by (auto simp: Top_less_ivl)
  have "(\<Sum>y\<in>?Y. m_ivl(?g y)) = (\<Sum>y\<in>(?Y-?X) \<union> (?Y\<inter>?X). m_ivl(?g y))"
    by (metis Un_Diff_Int)
  also have "\<dots> = (\<Sum>y\<in>?Y-?X. m_ivl(?g y)) + (\<Sum>y\<in>?Y\<inter>?X. m_ivl(?g y))"
    by(subst sum.union_disjoint) auto
  also have "(\<Sum>y\<in>?Y-?X. m_ivl(?g y)) = 0" using 0 by simp
  also have "0 + (\<Sum>y\<in>?Y\<inter>?X. m_ivl(?g y)) = (\<Sum>y\<in>?Y\<inter>?X. m_ivl(?g y))" by simp
  also have "\<dots> \<le> (\<Sum>y\<in>?Y\<inter>?X. m_ivl(?f y))"
    by(rule sum_mono)(simp add: 1)
  also have "\<dots> \<le> (\<Sum>y\<in>?X. m_ivl(?f y))"
    by(simp add: sum_mono3[of "?X" "?Y Int ?X", OF _ Int_lower2])
  finally show "(\<Sum>y\<in>?Y. m_ivl(?g y)) \<le> (\<Sum>x\<in>?X. m_ivl(?f x))"
    by (metis add_less_cancel_left)
qed

lemma m_st_widen:
assumes "\<not> S2 \<sqsubseteq> S1" shows "m_st m_ivl (S1 \<nabla> S2) < m_st m_ivl S1"
proof-
  { let ?X = "set(dom S1)" let ?Y = "set(dom S2)"
    let ?f = "fun S1" let ?g = "fun S2"
    fix x assume "x \<in> ?X" "\<not> lookup S2 x \<sqsubseteq> ?f x"
    have "(\<Sum>x\<in>?X\<inter>?Y. m_ivl(?f x \<nabla> ?g x)) < (\<Sum>x\<in>?X. m_ivl(?f x))" (is "?L < ?R")
    proof cases
      assume "x : ?Y"
      have "?L < (\<Sum>x\<in>?X\<inter>?Y. m_ivl(?f x))"
      proof(rule sum_strict_mono_ex1, simp)
        show "\<forall>x\<in>?X\<inter>?Y. m_ivl(?f x \<nabla> ?g x) \<le> m_ivl (?f x)"
          by (metis m_ivl_anti_mono widen1)
      next
        show "\<exists>x\<in>?X\<inter>?Y. m_ivl(?f x \<nabla> ?g x) < m_ivl(?f x)"
          using `x:?X` `x:?Y` `\<not> lookup S2 x \<sqsubseteq> ?f x`
          by (metis IntI m_ivl_widen lookup_def)
      qed
      also have "\<dots> \<le> ?R" by(simp add: sum_mono3[OF _ Int_lower1])
      finally show ?thesis .
    next
      assume "x ~: ?Y"
      have "?L \<le> (\<Sum>x\<in>?X\<inter>?Y. m_ivl(?f x))"
      proof(rule sum_mono, simp)
        fix x assume "x:?X \<and> x:?Y" show "m_ivl(?f x \<nabla> ?g x) \<le> m_ivl (?f x)"
          by (metis m_ivl_anti_mono widen1)
      qed
      also have "\<dots> < m_ivl(?f x) + \<dots>"
        using m_ivl_widen[OF `\<not> lookup S2 x \<sqsubseteq> ?f x`]
        by (metis Nat.le_refl add_strict_increasing gr0I not_less0)
      also have "\<dots> = (\<Sum>y\<in>insert x (?X\<inter>?Y). m_ivl(?f y))"
        using `x ~: ?Y` by simp
      also have "\<dots> \<le> (\<Sum>x\<in>?X. m_ivl(?f x))"
        by(rule sum_mono3)(insert `x:?X`, auto)
      finally show ?thesis .
    qed
  } with assms show ?thesis
    by(auto simp: le_st_def widen_st_def m_st_def Int_def)
qed

definition "n_st m X st = (\<Sum>x\<in>X. m(lookup st x))"

lemma n_st_mono: assumes "set(dom S1) \<subseteq> X" "set(dom S2) \<subseteq> X" "S1 \<sqsubseteq> S2"
shows "n_st n_ivl X S1 \<le> n_st n_ivl X S2"
proof-
  have "(\<Sum>x\<in>X. n_ivl(lookup S1 x)) \<le> (\<Sum>x\<in>X. n_ivl(lookup S2 x))"
    apply(rule sum_mono) using assms
    by(auto simp: le_st_def lookup_def n_ivl_mono split: if_splits)
  thus ?thesis by(simp add: n_st_def)
qed

lemma n_st_narrow:
assumes "finite X" and "set(dom S1) \<subseteq> X" "set(dom S2) \<subseteq> X"
and "S2 \<sqsubseteq> S1" "\<not> S1 \<sqsubseteq> S1 \<triangle> S2"
shows "n_st n_ivl X (S1 \<triangle> S2) < n_st n_ivl X S1"
proof-
  have 1: "\<forall>x\<in>X. n_ivl (lookup (S1 \<triangle> S2) x) \<le> n_ivl (lookup S1 x)"
    using assms(2-4)
    by(auto simp: le_st_def narrow_st_def lookup_def n_ivl_mono narrow2
            split: if_splits)
  have 2: "\<exists>x\<in>X. n_ivl (lookup (S1 \<triangle> S2) x) < n_ivl (lookup S1 x)"
    using assms(2-5)
    by(auto simp: le_st_def narrow_st_def lookup_def intro: n_ivl_narrow
            split: if_splits)
  have "(\<Sum>x\<in>X. n_ivl(lookup (S1 \<triangle> S2) x)) < (\<Sum>x\<in>X. n_ivl(lookup S1 x))"
    apply(rule sum_strict_mono_ex1[OF `finite X`]) using 1 2 by blast+
  thus ?thesis by(simp add: n_st_def)
qed

subsubsection "Termination: Option"

definition "m_o m n opt = (case opt of None \<Rightarrow> n+1 | Some x \<Rightarrow> m x)"

lemma m_o_anti_mono: "finite X \<Longrightarrow> domo S2 \<subseteq> X \<Longrightarrow> S1 \<sqsubseteq> S2 \<Longrightarrow>
  m_o (m_st m_ivl) (2 * card X) S2 \<le> m_o (m_st m_ivl) (2 * card X) S1"
apply(induction S1 S2 rule: le_option.induct)
apply(auto simp: domo_def m_o_def m_st_anti_mono le_SucI m_st_height
           split: option.splits)
done

lemma m_o_widen: "\<lbrakk> finite X; domo S2 \<subseteq> X; \<not> S2 \<sqsubseteq> S1 \<rbrakk> \<Longrightarrow>
  m_o (m_st m_ivl) (2 * card X) (S1 \<nabla> S2) < m_o (m_st m_ivl) (2 * card X) S1"
by(auto simp: m_o_def domo_def m_st_height less_Suc_eq_le m_st_widen
        split: option.split)

definition "n_o n opt = (case opt of None \<Rightarrow> 0 | Some x \<Rightarrow> n x + 1)"

lemma n_o_mono: "domo S1 \<subseteq> X \<Longrightarrow> domo S2 \<subseteq> X \<Longrightarrow> S1 \<sqsubseteq> S2 \<Longrightarrow>
  n_o (n_st n_ivl X) S1 \<le> n_o (n_st n_ivl X) S2"
apply(induction S1 S2 rule: le_option.induct)
apply(auto simp: domo_def n_o_def n_st_mono
           split: option.splits)
done

lemma n_o_narrow:
  "\<lbrakk> finite X; domo S1 \<subseteq> X; domo S2 \<subseteq> X; S2 \<sqsubseteq> S1; \<not> S1 \<sqsubseteq> S1 \<triangle> S2 \<rbrakk>
  \<Longrightarrow> n_o (n_st n_ivl X) (S1 \<triangle> S2) < n_o (n_st n_ivl X) S1"
apply(induction S1 S2 rule: narrow_option.induct)
apply(auto simp: n_o_def domo_def n_st_narrow)
done

lemma domo_widen_subset: "domo (S1 \<nabla> S2) \<subseteq> domo S1 \<union> domo S2"
apply(induction S1 S2 rule: widen_option.induct)
apply (auto simp: domo_def widen_st_def)
done

lemma domo_narrow_subset: "domo (S1 \<triangle> S2) \<subseteq> domo S1 \<union> domo S2"
apply(induction S1 S2 rule: narrow_option.induct)
apply (auto simp: domo_def narrow_st_def)
done

subsubsection "Termination: Commands"

lemma strip_widen_acom[simp]:
  "strip c' = strip (c::'a::WN acom) \<Longrightarrow>  strip (c \<nabla>\<^sub>c c') = strip c"
by(induction "widen::'a\<Rightarrow>'a\<Rightarrow>'a" c c' rule: map2_acom.induct) simp_all

lemma strip_narrow_acom[simp]:
  "strip c' = strip (c::'a::WN acom) \<Longrightarrow>  strip (c \<triangle>\<^sub>c c') = strip c"
by(induction "narrow::'a\<Rightarrow>'a\<Rightarrow>'a" c c' rule: map2_acom.induct) simp_all

lemma annos_widen_acom[simp]: "strip c1 = strip (c2::'a::WN acom) \<Longrightarrow>
  annos(c1 \<nabla>\<^sub>c c2) = map (%(x,y).x\<nabla>y) (zip (annos c1) (annos(c2::'a::WN acom)))"
by(induction "widen::'a\<Rightarrow>'a\<Rightarrow>'a" c1 c2 rule: map2_acom.induct)
  (simp_all add: size_annos_same2)

lemma annos_narrow_acom[simp]: "strip c1 = strip (c2::'a::WN acom) \<Longrightarrow>
  annos(c1 \<triangle>\<^sub>c c2) = map (%(x,y).x\<triangle>y) (zip (annos c1) (annos(c2::'a::WN acom)))"
by(induction "narrow::'a\<Rightarrow>'a\<Rightarrow>'a" c1 c2 rule: map2_acom.induct)
  (simp_all add: size_annos_same2)

lemma widen_acom_Com[simp]: "strip c2 = strip c1 \<Longrightarrow>
  c1 : Com X \<Longrightarrow> c2 : Com X \<Longrightarrow> (c1 \<nabla>\<^sub>c c2) : Com X"
apply(auto simp add: Com_def)
apply(rename_tac S S' x)
apply(erule in_set_zipE)
apply(auto simp: domo_def split: option.splits)
apply(case_tac S)
apply(case_tac S')
apply simp
apply fastforce
apply(case_tac S')
apply fastforce
apply (fastforce simp: widen_st_def)
done

lemma narrow_acom_Com[simp]: "strip c2 = strip c1 \<Longrightarrow>
  c1 : Com X \<Longrightarrow> c2 : Com X \<Longrightarrow> (c1 \<triangle>\<^sub>c c2) : Com X"
apply(auto simp add: Com_def)
apply(rename_tac S S' x)
apply(erule in_set_zipE)
apply(auto simp: domo_def split: option.splits)
apply(case_tac S)
apply(case_tac S')
apply simp
apply fastforce
apply(case_tac S')
apply fastforce
apply (fastforce simp: narrow_st_def)
done

definition "m_c m c = (let as = annos c in \<Sum>i=0..<size as. m(as!i))"

lemma measure_m_c: "finite X \<Longrightarrow> {(c, c \<nabla>\<^sub>c c') |c c'::ivl st option acom.
     strip c' = strip c \<and> c : Com X \<and> c' : Com X \<and> \<not> c' \<sqsubseteq> c}\<inverse>
    \<subseteq> measure(m_c(m_o (m_st m_ivl) (2*card(X))))"
apply(auto simp: m_c_def Let_def Com_def)
apply(subgoal_tac "length(annos c') = length(annos c)")
prefer 2 apply (simp add: size_annos_same2)
apply (auto)
apply(rule sum_strict_mono_ex1)
apply simp
apply (clarsimp)
apply(erule m_o_anti_mono)
apply(rule subset_trans[OF domo_widen_subset])
apply fastforce
apply(rule widen1)
apply(auto simp: le_iff_le_annos listrel_iff_nth)
apply(rule_tac x=n in bexI)
prefer 2 apply simp
apply(erule m_o_widen)
apply (simp)+
done

lemma measure_n_c: "finite X \<Longrightarrow> {(c, c \<triangle>\<^sub>c c') |c c'.
  strip c = strip c' \<and> c \<in> Com X \<and> c' \<in> Com X \<and> c' \<sqsubseteq> c \<and> \<not> c \<sqsubseteq> c \<triangle>\<^sub>c c'}\<inverse>
  \<subseteq> measure(m_c(n_o (n_st n_ivl X)))"
apply(auto simp: m_c_def Let_def Com_def)
apply(subgoal_tac "length(annos c') = length(annos c)")
prefer 2 apply (simp add: size_annos_same2)
apply (auto)
apply(rule sum_strict_mono_ex1)
apply simp
apply (clarsimp)
apply(rule n_o_mono)
using domo_narrow_subset apply fastforce
apply fastforce
apply(rule narrow2)
apply(fastforce simp: le_iff_le_annos listrel_iff_nth)
apply(auto simp: le_iff_le_annos listrel_iff_nth strip_narrow_acom)
apply(rule_tac x=n in bexI)
prefer 2 apply simp
apply(erule n_o_narrow)
apply (simp)+
done

subsubsection "Termination: Post-Fixed Point Iterations"

lemma iter_widen_termination:
fixes c0 :: "'a::WN acom"
assumes P_f: "\<And>c. P c \<Longrightarrow> P(f c)"
assumes P_widen: "\<And>c c'. P c \<Longrightarrow> P c' \<Longrightarrow> P(c \<nabla>\<^sub>c c')"
and "wf({(c::'a acom,c \<nabla>\<^sub>c c')|c c'. P c \<and> P c' \<and> ~ c' \<sqsubseteq> c}^-1)"
and "P c0" and "c0 \<sqsubseteq> f c0" shows "EX c. iter_widen f c0 = Some c"
proof(simp add: iter_widen_def, rule wf_while_option_Some[where P = "P"])
  show "wf {(cc', c). (P c \<and> \<not> f c \<sqsubseteq> c) \<and> cc' = c \<nabla>\<^sub>c f c}"
    apply(rule wf_subset[OF assms(3)]) by(blast intro: P_f)
next
  show "P c0" by(rule `P c0`)
next
  fix c assume "P c" thus "P (c \<nabla>\<^sub>c f c)" by(simp add: P_f P_widen)
qed

lemma iter_narrow_termination:
assumes P_f: "\<And>c. P c \<Longrightarrow> P(c \<triangle>\<^sub>c f c)"
and wf: "wf({(c, c \<triangle>\<^sub>c f c)|c c'. P c \<and> ~ c \<sqsubseteq> c \<triangle>\<^sub>c f c}^-1)"
and "P c0" shows "EX c. iter_narrow f c0 = Some c"
proof(simp add: iter_narrow_def, rule wf_while_option_Some[where P = "P"])
  show "wf {(c', c). (P c \<and> \<not> c \<sqsubseteq> c \<triangle>\<^sub>c f c) \<and> c' = c \<triangle>\<^sub>c f c}"
    apply(rule wf_subset[OF wf]) by(blast intro: P_f)
next
  show "P c0" by(rule `P c0`)
next
  fix c assume "P c" thus "P (c \<triangle>\<^sub>c f c)" by(simp add: P_f)
qed

lemma iter_winden_step_ivl_termination:
  "EX c. iter_widen (step_ivl \<top>) (\<bottom>\<^sub>c c0) = Some c"
apply(rule iter_widen_termination[where
  P = "%c. strip c = c0 \<and> c : Com(vars c0)"])
apply (simp_all add: step'_Com bot_acom)
apply(rule wf_subset)
apply(rule wf_measure)
apply(rule subset_trans)
prefer 2
apply(rule measure_m_c[where X = "vars c0", OF finite_cvars])
apply blast
done

lemma iter_narrow_step_ivl_termination:
  "c0 \<in> Com (vars(strip c0)) \<Longrightarrow> step_ivl \<top> c0 \<sqsubseteq> c0 \<Longrightarrow>
  EX c. iter_narrow (step_ivl \<top>) c0 = Some c"
apply(rule iter_narrow_termination[where
  P = "%c. strip c = strip c0 \<and> c : Com(vars(strip c0)) \<and> step_ivl \<top> c \<sqsubseteq> c"])
apply (simp_all add: step'_Com)
apply(clarify)
apply(frule narrow2_acom, drule mono_step'[OF le_refl], erule le_trans[OF _ narrow1_acom])
apply assumption
apply(rule wf_subset)
apply(rule wf_measure)
apply(rule subset_trans)
prefer 2
apply(rule measure_n_c[where X = "vars(strip c0)", OF finite_cvars])
apply auto
by (metis bot_least domo_Top order_refl step'_Com strip_step')

(* FIXME: simplify type system: Combine Com(X) and vars <= X?? *)
lemma while_Com:
fixes c :: "'a st option acom"
assumes "while_option P f c = Some c'"
and "!!c. strip(f c) = strip c"
and "\<forall>c::'a st option acom. c : Com(X) \<longrightarrow> vars(strip c) \<subseteq> X \<longrightarrow> f c : Com(X)"
and "c : Com(X)" and "vars(strip c) \<subseteq> X" shows "c' : Com(X)"
using while_option_rule[where P = "\<lambda>c'. c' : Com(X) \<and> vars(strip c') \<subseteq> X", OF _ assms(1)]
by(simp add: assms(2-))

lemma iter_widen_Com: fixes f :: "'a::WN st option acom \<Rightarrow> 'a st option acom"
assumes "iter_widen f c = Some c'"
and "\<forall>c. c : Com(X) \<longrightarrow> vars(strip c) \<subseteq> X \<longrightarrow> f c : Com(X)"
and "!!c. strip(f c) = strip c"
and "c : Com(X)" and "vars (strip c) \<subseteq> X" shows "c' : Com(X)"
proof-
  have "\<forall>c. c : Com(X) \<longrightarrow> vars(strip c) \<subseteq> X \<longrightarrow> c \<nabla>\<^sub>c f c : Com(X)"
    by (metis (full_types) widen_acom_Com assms(2,3))
  from while_Com[OF assms(1)[simplified iter_widen_def] _ this assms(4,5)]
  show ?thesis using assms(3) by(simp)
qed

context Abs_Int2
begin

lemma iter_widen_step'_Com:
  "iter_widen (step' \<top>) c = Some c' \<Longrightarrow> vars(strip c) \<subseteq> X \<Longrightarrow> c : Com(X)
   \<Longrightarrow> c' : Com(X)"
apply(subgoal_tac "strip c'= strip c")
prefer 2 apply (metis strip_iter_widen strip_step')
apply(drule iter_widen_Com)
prefer 3 apply assumption
prefer 3 apply assumption
apply (auto simp: step'_Com)
done

end

theorem AI_ivl'_termination:
  "EX c'. AI_ivl' c = Some c'"
apply(auto simp: AI_wn_def pfp_wn_def iter_winden_step_ivl_termination split: option.split)
apply(rule iter_narrow_step_ivl_termination)
apply (metis bot_acom_Com iter_widen_step'_Com[OF _ subset_refl] strip_iter_widen strip_step')
apply(erule iter_widen_pfp)
done

end

(* interesting(?) relic
lemma widen_assoc:
  "~ (y::ivl) \<sqsubseteq> x \<Longrightarrow> ~ z \<sqsubseteq> x \<nabla> y \<Longrightarrow> ((x::ivl) \<nabla> y) \<nabla> z = x \<nabla> (y \<nabla> z)"
apply(cases x)
apply(cases y)
apply(cases z)
apply(rename_tac x1 x2 y1 y2 z1 z2)
apply(simp add: le_ivl_def)
apply(case_tac x1)
apply(case_tac x2)
apply(simp add:le_option_def widen_ivl_def split: if_splits option.splits)
apply(simp add:le_option_def widen_ivl_def split: if_splits option.splits)
apply(case_tac x2)
apply(simp add:le_option_def widen_ivl_def split: if_splits option.splits)
apply(case_tac y1)
apply(case_tac y2)
apply(simp add:le_option_def widen_ivl_def split: if_splits option.splits)
apply(case_tac z1)
apply(auto simp add:le_option_def widen_ivl_def split: if_splits option.splits ivl.splits)[1]
apply(auto simp add:le_option_def widen_ivl_def split: if_splits option.splits ivl.splits)[1]
apply(case_tac y2)
apply(auto simp add:le_option_def widen_ivl_def split: if_splits option.splits ivl.splits)[1]
apply(case_tac z1)
apply(auto simp add:le_option_def widen_ivl_def split: if_splits ivl.splits option.splits)[1]
apply(case_tac z2)
apply(auto simp add:le_option_def widen_ivl_def split: if_splits option.splits)[1]
apply(auto simp add:le_option_def widen_ivl_def split: if_splits option.splits)[1]
done

lemma widen_step_trans:
  "~ (y::ivl) \<sqsubseteq> x \<Longrightarrow> ~ z \<sqsubseteq> x \<nabla> y \<Longrightarrow> EX u. (x \<nabla> y) \<nabla> z = x \<nabla> u \<and> ~ u \<sqsubseteq> x"
by (metis widen_assoc preord_class.le_trans widen1)
*)


(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

header "Further Plane Graph Properties"

theory PlaneProps
imports Invariants
begin

subsection {* @{const final} *}

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 {* @{const degree} *}

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 {* Misc *}

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 -
  have "\<not> final g" using assms(2)
    by(auto simp: nonFinals_def finalGraph_def filter_empty_conv)
  thus ?thesis using assms by(auto simp:next_plane0_def Bex_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{* Increasing final faces *}

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:split_if_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{* Increasing vertices *}

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{* Increasing vertex degrees *}

lemma next_plane0_incr_faceListAt:
 "\<lbrakk> g' \<in> set (next_plane0\<^bsub>p\<^esub> g); minGraphProps g \<rbrakk>
  \<Longrightarrow> |faceListAt g| \<le> |faceListAt g'| &
      (\<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{* Increasing @{const except} *}

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 `v : \<V> g`]]
  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' `v : \<V> g'`]]
  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' `v \<in> \<V> g'`])
  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{* Increasing edges *}

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{* Increasing final vertices *}

(*
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{* Preservation of @{const facesAt} at final vertices *}

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 `v : \<V> g`]]
  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' `v : \<V> g'`]]
  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{* Properties of @{const subdivFace'} *}

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] `r \<noteq> v`
        by(auto simp: between_next_empty[OF distf]
          unroll_between_next2[OF distf `r \<in> \<V> f` `u \<in> \<V> f`])
    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 `r\<noteq>u` `r\<noteq>v` `u\<noteq>v` `v \<in> \<V> f` `r \<in> \<V> f` 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 `v \<in> \<V> f` `u \<in> \<V> f` r] `r\<noteq>v`
          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 `r\<noteq>v` `u\<noteq>v` 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 `v : \<V> f` `r\<noteq>v` `r : \<V> f` 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 `r : \<V> f` disj by blast
          thus ?thesis using `r \<noteq> v`
            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] `r \<noteq> v` 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