\<^marker>\<open>creator "Kevin Kappelmann"\<close>
section \<open>Coproduct (\<Coprod>-types)\<close>
text \<open>Aka binary disjoint union.\<close>
theory Coproduct
  imports Pairs
begin

definition "inl a = \<langle>{}, a\<rangle>"
definition "inr b = \<langle>{{}}, b\<rangle>"
definition "coprod A B \<equiv> {inl a | a \<in> A} \<union> {inr b | b \<in> B}"

bundle hotg_coprod_syntax begin notation coprod (infixl "\<Coprod>" 70) end
bundle no_hotg_coprod_syntax begin no_notation coprod (infixl "\<Coprod>" 70) end

unbundle hotg_coprod_syntax

lemma mem_coprod_iff [iff]:
  "x \<in> A \<Coprod> B \<longleftrightarrow> (\<exists>a \<in> A. x = inl a) \<or> (\<exists>b \<in> B. x = inr b)"
  unfolding coprod_def inl_def inr_def by auto

lemma mem_coprodE:
  assumes "x \<in> A \<Coprod> B"
  obtains (inl) a where "a \<in> A" "x = inl a" | (inr) b where "b \<in> B" "x = inr b"
  using assms by blast

lemma
  inl_inj_iff [iff]: "inl x = inl y \<longleftrightarrow> x = y" and
  inr_inj_iff [iff]: "inr x = inr y \<longleftrightarrow> x = y" and
  inl_ne_inr [iff]: "inl x \<noteq> inr y" and
  inr_ne_inl [iff]: "inr x \<noteq> inl y"
  unfolding inl_def inr_def by auto

lemma inl_mem_coprod_iff [iff]: "inl a \<in> A \<Coprod> B \<longleftrightarrow> a \<in> A"
  unfolding coprod_def by auto

lemma inr_mem_coprod_iff [iff]: "inr b \<in> A \<Coprod> B \<longleftrightarrow> b \<in> B"
  unfolding coprod_def by auto

definition "coprod_rec l r x = (if fst x = {} then l (snd x) else r (snd x))"

lemma
  shows coprod_rec_inl_eq [simp]: "coprod_rec l r (inl a) = l a"
  and coprod_rec_inr_eq [simp]: "coprod_rec l r (inr b) = r b"
  unfolding coprod_rec_def inl_def inr_def by auto

lemma mono_coprod_left: "mono (\<lambda>A. A \<Coprod> B)"
  by (intro monoI) auto

lemma mono_coprod_right: "mono (\<lambda>B. A \<Coprod> B)"
  by (intro monoI) auto

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_list_elem_nub_l
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun filter :: "('a => bool) => 'a list => 'a list" where
"filter p (nil2) = nil2"
| "filter p (cons2 y xs) =
     (if p y then cons2 y (filter p xs) else filter p xs)"

(*fun did not finish the proof*)
function nubBy :: "('a => ('a => bool)) => 'a list => 'a list" where
"nubBy x (nil2) = nil2"
| "nubBy x (cons2 z xs) =
     cons2 z (nubBy x (filter (% (y2 :: 'a) => (~ ((x z) y2))) xs))"
by pat_completeness auto

fun elem :: "'a => 'a list => bool" where
"elem x (nil2) = False"
| "elem x (cons2 z xs) = ((z = x) | (elem x xs))"

theorem property0 :
  "((elem x xs) ==>
      (elem x (nubBy (% (y :: 'a) => % (z :: 'a) => (y = z)) xs)))"
  oops

end


theory book imports Main

begin

lemma conj_swap1: "P \<and> Q \<Longrightarrow> Q \<and> P"
  apply (rule conjI)
   apply (erule conjE)
   apply assumption
  apply (erule conjE)
  apply assumption
  done

lemma conj_swap2: "P \<and> Q \<Longrightarrow> Q \<and> P"
  apply (rule conjI)
   apply (drule conjunct2)
   apply assumption
  apply (drule conjunct1)
  apply assumption
  done

lemma imp_uncurry1: "P \<longrightarrow> (Q \<longrightarrow> R) \<Longrightarrow> P \<and> Q \<longrightarrow> R"
  apply (rule impI)
  apply (erule impE)
   apply (erule conjE)
   apply assumption
  apply (erule impE)
   apply (erule conjE)
   apply assumption+
  done

lemma imp_uncurry2: "P \<longrightarrow> (Q \<longrightarrow> R) \<Longrightarrow> P \<and> Q \<longrightarrow> R"
  apply (rule impI)
  apply (erule conjE)
  apply (drule mp)
   apply assumption
  apply (drule mp)
   apply assumption+
  done

lemma imp_uncurry3: "P \<longrightarrow> (Q \<longrightarrow> R) \<Longrightarrow> P \<and> Q \<longrightarrow> R"
  apply (rule impI)
  apply (erule conjE)
  apply (drule mp)
   apply assumption
  by (drule mp)

lemma "\<lbrakk> \<not>(P \<longrightarrow> Q); \<not>(R \<longrightarrow> Q) \<rbrakk> \<Longrightarrow> R"
  apply (erule_tac Q="R\<longrightarrow>Q" in contrapos_np)
  apply (intro impI) (* rule impI works too *)
  by (erule notE)

lemma "(P \<and> Q) \<and> R \<Longrightarrow> P \<or> (Q \<and> R)"
  apply (rule disjCI)
  apply (elim conjE disjE) (* rule conjE, rule disjE *)
  by (erule contrapos_np, rule conjI)
 (* apply assumption *)

end


section \<open> Unrestriction \<close>

theory Unrestriction
  imports Expressions
begin

text \<open> Unrestriction means that an expression does not depend on the value of the state space
  described by the given scene (i.e. set of variables) for its valuation. It is a semantic
  characterisation of fresh variables. \<close>

consts unrest :: "'s scene \<Rightarrow> 'p \<Rightarrow> bool"

definition unrest_expr :: "'s scene \<Rightarrow> ('b, 's) expr \<Rightarrow> bool" where
[expr_defs]: "unrest_expr a e = (\<forall> s s'. e (s \<oplus>\<^sub>S s' on a) = e s)"

adhoc_overloading unrest unrest_expr

syntax
  "_unrest" :: "salpha \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic" (infix "\<sharp>" 20)

translations
  "_unrest x p" == "CONST unrest x p"

named_theorems unrest

lemma unrest_empty [unrest]: "\<emptyset> \<sharp> P"
  by (simp add: expr_defs lens_defs)

lemma unrest_var_union [unrest]:
  "\<lbrakk> A \<sharp> P; B \<sharp> P \<rbrakk> \<Longrightarrow> A \<union> B \<sharp> P"
  by (simp add: expr_defs lens_defs)
     (metis scene_override_union scene_override_unit scene_union_incompat)

lemma unrest_neg_union:
  assumes "A ##\<^sub>S B" "- A \<sharp> P" "- B \<sharp> P"
  shows "(- (A \<union> B)) \<sharp> P"
  using assms by (simp add: unrest_expr_def scene_override_commute scene_override_union)

text \<open> The following two laws greatly simplify proof when reasoning about unrestricted lens,
  and so we add them to the expression simplification set. \<close>

lemma unrest_lens [expr_simps]:
  "mwb_lens x \<Longrightarrow> ($x \<sharp> e) = (\<forall> s v. e (put\<^bsub>x\<^esub> s v) = e s)"
  by (simp add: unrest_expr_def var_alpha_def comp_mwb_lens lens_override_def)
     (metis mwb_lens.put_put)

lemma unrest_compl_lens [expr_simps]:
  "mwb_lens x \<Longrightarrow> (- $x \<sharp> e) = (\<forall>s s'. e (put\<^bsub>x\<^esub> s' (get\<^bsub>x\<^esub> s)) = e s)"
  by (simp add: unrest_expr_def var_alpha_def comp_mwb_lens lens_override_def scene_override_commute)

lemma unrest_subscene: "\<lbrakk> idem_scene a; a \<sharp> e; b \<subseteq>\<^sub>S a \<rbrakk> \<Longrightarrow> b \<sharp> e"
  by (metis subscene_eliminate unrest_expr_def)

lemma unrest_lens_comp [unrest]: "\<lbrakk> mwb_lens x; mwb_lens y; $x \<sharp> e \<rbrakk> \<Longrightarrow> $x:y \<sharp> e"
  by (simp add: unrest_lens, simp add: lens_comp_def ns_alpha_def)

lemma unrest_expr [unrest]: "x \<sharp> e \<Longrightarrow> x \<sharp> (e)\<^sub>e"
  by (simp add: expr_defs)

lemma unrest_lit [unrest]: "x \<sharp> (\<guillemotleft>v\<guillemotright>)\<^sub>e"
  by (simp add: expr_defs)

lemma unrest_var [unrest]:
  "\<lbrakk> vwb_lens x; idem_scene a; var_alpha x \<bowtie>\<^sub>S a \<rbrakk> \<Longrightarrow> a \<sharp> ($x)\<^sub>e"
  by (auto simp add: unrest_expr_def scene_indep_override var_alpha_def)
     (metis lens_override_def lens_override_idem mwb_lens_weak vwb_lens_mwb weak_lens_def)

lemma unrest_var_single [unrest]:
  "\<lbrakk> mwb_lens x; x \<bowtie> y \<rbrakk> \<Longrightarrow> $x \<sharp> ($y)\<^sub>e"
  by (simp add: expr_defs lens_indep.lens_put_irr2 lens_indep_sym lens_override_def var_alpha_def)

lemma unrest_conj [unrest]:
  "\<lbrakk> x \<sharp> P; x \<sharp> Q \<rbrakk> \<Longrightarrow> x \<sharp> (P \<and> Q)\<^sub>e"
  by (auto simp add: expr_defs)

lemma unrest_not [unrest]:
  "\<lbrakk> x \<sharp> P \<rbrakk> \<Longrightarrow> x \<sharp> (\<not> P)\<^sub>e"
  by (auto simp add: expr_defs)

lemma unrest_disj [unrest]:
  "\<lbrakk> x \<sharp> P; x \<sharp> Q \<rbrakk> \<Longrightarrow> x \<sharp> (P \<or> Q)\<^sub>e"
  by (auto simp add: expr_defs)

lemma unrest_implies [unrest]:
  "\<lbrakk> x \<sharp> P; x \<sharp> Q \<rbrakk> \<Longrightarrow> x \<sharp> (P \<longrightarrow> Q)\<^sub>e"
  by (auto simp add: expr_defs)

lemma unrest_uop:
  "\<lbrakk> x \<sharp> e \<rbrakk> \<Longrightarrow> x \<sharp> (\<guillemotleft>f\<guillemotright> e)\<^sub>e"
  by (auto simp add: expr_defs)

lemma unrest_bop:
  "\<lbrakk> x \<sharp> e\<^sub>1; x \<sharp> e\<^sub>2 \<rbrakk> \<Longrightarrow> x \<sharp> (\<guillemotleft>f\<guillemotright> e\<^sub>1 e\<^sub>2)\<^sub>e"
  by (auto simp add: expr_defs)

lemma unrest_trop:
  "\<lbrakk> x \<sharp> e\<^sub>1; x \<sharp> e\<^sub>2; x \<sharp> e\<^sub>3 \<rbrakk> \<Longrightarrow> x \<sharp> (\<guillemotleft>f\<guillemotright> e\<^sub>1 e\<^sub>2 e\<^sub>3)\<^sub>e"
  by (auto simp add: expr_defs)

end


theory Path_Tbd
  imports
    Graph
    "../../Misc_Ext_Ext"
begin

lemma path_split_edge:
  assumes "{u, v} \<in> set (edges_of_path p)"
  obtains p1 p2 where
    "p1 @ u # v # p2 = p \<or> p1 @ u # v # p2 = rev p"
proof -
  obtain i where i:
    "i < length (edges_of_path p)"
    "edges_of_path p ! i = {u, v}"
    using assms
    by (auto simp add: in_set_conv_nth)
  hence Suc_i: "Suc i < length p"
    by (simp add: edges_of_path_length)
  hence "{u, v} = {p ! i, p ! Suc i}"
    unfolding i(2)[symmetric]
    by (intro edges_of_path_index)
  hence "take i p @ u # v # drop (Suc (Suc i)) p = p \<or> take i p @ v # u # drop (Suc (Suc i)) p = p"
    using i(1) Suc_i
    by (auto simp add: Cons_nth_drop_Suc doubleton_eq_iff)
  moreover have
    "rev (take i p @ v # u # drop (Suc (Suc i)) p) =
     take (length p - Suc (Suc i)) (rev p) @ u # v # drop (length p - i) (rev p)"
    by (auto simp add: rev_drop rev_take)
  ultimately have
    "take i p @ u # v # drop (Suc (Suc i)) p = p \<or>
     take (length p - Suc (Suc i)) (rev p) @ u # v # drop (length p - i) (rev p) = rev p"
    by presburger
  thus ?thesis
    by (auto intro: that)
qed

definition sublist :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" where
  "sublist l' l \<equiv> \<exists>l1 l2. l1 @ l' @ l2 = l"

lemma sublistE:
  assumes "sublist l' l"
  obtains l1 l2 where
    "l1 @ l' @ l2 = l"
  using assms
  by (auto simp add: sublist_def)

lemma sublistI:
  assumes "l1 @ l' @ l2 = l"
  shows "sublist l' l"
  using assms
  by (auto simp add: sublist_def)

lemma sublist_singletonI:
  assumes "x \<in> set l"
  shows "sublist [x] l"
  using assms
  by (fastforce simp add: sublist_def dest: split_list)

lemma
  assumes "sublist l' l"
  shows "length l' \<le> length l"
  using assms
  by (auto simp add: sublist_def)

lemma set_sublist_subset:
  assumes "sublist l' l"
  shows "set l' \<subseteq> set l"
  using assms
  by (auto simp add: sublist_def)

lemma set_tl_butlast_sublist_subset:
  assumes "sublist l' l"
  shows "set (tl (butlast l')) \<subseteq> set (tl (butlast l))"
proof
  fix x
  assume "x \<in> set (tl (butlast l'))"
  then obtain i' where
    "i' < length (tl (butlast l'))"
    "tl (butlast l') ! i' = x"
    by (auto simp add: in_set_conv_nth)
  hence Suc_i':
    "Suc i' < length l' - 1"
    "l' ! Suc i' = x"
    by (simp_all add: nth_tl nth_butlast)
  obtain l1 l2 where
    l: "l1 @ l' @ l2 = l"
    using assms
    by (auto simp add: sublist_def)
  let ?i = "length l1 + Suc i'"
  have
    "?i < length l - 1"
    "l ! ?i = x"
    using Suc_i'
    by (auto simp add: l[symmetric] nth_append)
  hence
    "?i - 1 < length (tl (butlast l))"
    "tl (butlast l) ! (?i - 1) = x"
    by (simp_all add: nth_tl nth_butlast)
  thus "x \<in> set (tl (butlast l))"
    by (auto simp add: in_set_conv_nth)
qed

lemma set_edges_of_path_sublist_subset:
  assumes "sublist p' p"
  shows "set (edges_of_path p') \<subseteq> set (edges_of_path p)"
  using assms edges_of_path_append_subset set_edges_of_path_subset_append
  by (fastforce simp add: sublist_def)

lemma set_sublist_subset_2:
  assumes "sublist p' p \<or> sublist p' (rev p)"
  shows "set p' \<subseteq> set p"
  using assms
  by (fastforce dest: set_sublist_subset)

lemma set_edges_of_path_sublist_subset_2:
  assumes "sublist p' p \<or> sublist p' (rev p)"
  shows "set (edges_of_path p') \<subseteq> set (edges_of_path p)"
  using assms
  by (fastforce simp add: edges_of_path_rev[symmetric] dest: set_edges_of_path_sublist_subset)

lemma set_tl_butlast_sublist_subset_2:
  assumes "sublist p' p \<or> sublist p' (rev p)"
  shows "set (tl (butlast p')) \<subseteq> set (tl (butlast p))"
proof -
  consider
    (p) "sublist p' p" |
    (rev_p) "sublist p' (rev p)"
    using assms
    by blast
  thus ?thesis
  proof (cases)
    case p
    thus ?thesis
      by (intro set_tl_butlast_sublist_subset)
  next
    case rev_p
    hence "set (tl (butlast p')) \<subseteq> set (tl (butlast (rev p)))"
      by (intro set_tl_butlast_sublist_subset)
    thus ?thesis
      unfolding tl_butlast_rev set_rev
      .
  qed
qed

(* TODO Rename. *)
lemma tbdE:
  assumes "path G p"
  assumes "{u, v} \<in> set (edges_of_path p)"
  assumes "{x, y} \<in> set (edges_of_path p)"
  obtains p' where
    "walk_betw G u p' x"
    "sublist p' p \<or> sublist p' (rev p)"
proof (cases "u = x")
  case True
  hence "u \<in> Vs G"
    using assms(1, 2)
    by (auto intro: path_ball_edges edges_are_Vs)
  hence "walk_betw G u [u] x"
    by (auto simp add: True intro: walk_reflexive)
  moreover have "sublist [u] p"
    using assms(2)
    by (intro sublist_singletonI) (rule v_in_edge_in_path)
  ultimately show ?thesis
    by (intro that) simp+
next
  case False
  have
    "u \<in> set p"
    "x \<in> set p"
    using assms(2, 3)
    by (auto intro: v_in_edge_in_path)
  then obtain p1 p2 p3 where
    "p1 @ u # p2 @ x # p3 = p \<or> p1 @ u # p2 @ x # p3 = rev p"
    using False
    by (auto intro: split_list_2)
  then consider
    (p) "p1 @ u # p2 @ x # p3 = p" |
    (rev_p) "p1 @ u # p2 @ x # p3 = rev p"
    by fastforce
  thus ?thesis
  proof (cases)
    case p
    hence "walk_betw G u (u # p2 @ [x]) x"
      using assms(1)
      by (force intro: path_suff path_pref nonempty_path_walk_between)
    moreover have "sublist (u # p2 @ [x]) p"
      using p
      by (intro sublistI) simp
    ultimately show ?thesis
      by (intro that) simp+
  next
    case rev_p
    have "walk_betw G u (u # p2 @ [x]) x"
    proof -
      have "path G (rev p)"
        using assms(1)
        by (intro rev_path_is_path)
      thus ?thesis
        by (force simp add: rev_p[symmetric] intro: path_suff path_pref nonempty_path_walk_between)
    qed
    moreover have "sublist (u # p2 @ [x]) (rev p)"
      using rev_p
      by (intro sublistI) simp
    ultimately show ?thesis
      by (intro that) simp+
  qed
qed

end


(*  Title:      ZF/Induct/Brouwer.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1994  University of Cambridge
*)

section {* Infinite branching datatype definitions *}

theory Brouwer imports Main_ZFC begin

subsection {* The Brouwer ordinals *}

consts
  brouwer :: i

datatype \<subseteq> "Vfrom(0, csucc(nat))"
    "brouwer" = Zero | Suc ("b \<in> brouwer") | Lim ("h \<in> nat -> brouwer")
  monos Pi_mono
  type_intros inf_datatype_intros

lemma brouwer_unfold: "brouwer = {0} + brouwer + (nat -> brouwer)"
  by (fast intro!: brouwer.intros [unfolded brouwer.con_defs]
    elim: brouwer.cases [unfolded brouwer.con_defs])

lemma brouwer_induct2 [consumes 1, case_names Zero Suc Lim]:
  assumes b: "b \<in> brouwer"
    and cases:
      "P(Zero)"
      "!!b. [| b \<in> brouwer;  P(b) |] ==> P(Suc(b))"
      "!!h. [| h \<in> nat -> brouwer;  \<forall>i \<in> nat. P(h`i) |] ==> P(Lim(h))"
  shows "P(b)"
  -- {* A nicer induction rule than the standard one. *}
  using b
  apply induct
    apply (rule cases(1))
   apply (erule (1) cases(2))
  apply (rule cases(3))
   apply (fast elim: fun_weaken_type)
  apply (fast dest: apply_type)
  done

subsection {* The Martin-Löf wellordering type *}

consts
  Well :: "[i, i => i] => i"

datatype \<subseteq> "Vfrom(A \<union> (\<Union>x \<in> A. B(x)), csucc(nat \<union> |\<Union>x \<in> A. B(x)|))"
    -- {* The union with @{text nat} ensures that the cardinal is infinite. *}
  "Well(A, B)" = Sup ("a \<in> A", "f \<in> B(a) -> Well(A, B)")
  monos Pi_mono
  type_intros le_trans [OF UN_upper_cardinal le_nat_Un_cardinal] inf_datatype_intros

lemma Well_unfold: "Well(A, B) = (\<Sigma> x \<in> A. B(x) -> Well(A, B))"
  by (fast intro!: Well.intros [unfolded Well.con_defs]
    elim: Well.cases [unfolded Well.con_defs])

lemma Well_induct2 [consumes 1, case_names step]:
  assumes w: "w \<in> Well(A, B)"
    and step: "!!a f. [| a \<in> A;  f \<in> B(a) -> Well(A,B);  \<forall>y \<in> B(a). P(f`y) |] ==> P(Sup(a,f))"
  shows "P(w)"
  -- {* A nicer induction rule than the standard one. *}
  using w
  apply induct
  apply (assumption | rule step)+
   apply (fast elim: fun_weaken_type)
  apply (fast dest: apply_type)
  done

lemma Well_bool_unfold: "Well(bool, \<lambda>x. x) = 1 + (1 -> Well(bool, \<lambda>x. x))"
  -- {* In fact it's isomorphic to @{text nat}, but we need a recursion operator *}
  -- {* for @{text Well} to prove this. *}
  apply (rule Well_unfold [THEN trans])
  apply (simp add: Sigma_bool succ_def)
  done

end


theory Chapter11_1_Language
imports DeBruijnEnvironment
begin

datatype type =
  Nat
| Arrow type type
| Unit
| Prod type type
| Void
| Sum type type

datatype expr =
  Var var
| Zero
| Suc expr
| Rec expr expr expr
| Lam type expr
| Appl expr expr
| Triv
| Pair expr expr
| ProjL expr
| ProjR expr
| Abort type expr
| Case expr expr expr
| InL type type expr
| InR type type expr

primrec insert :: "var => expr => expr"
where "insert n (Var v) = Var (incr n v)"
    | "insert n Zero = Zero"
    | "insert n (Suc e) = Suc (insert n e)"
    | "insert n (Rec et e0 es) = Rec (insert n et) (insert n e0) (insert (next (next n)) es)"
    | "insert n (Lam t e) = Lam t (insert (next n) e)"
    | "insert n (Appl e1 e2) = Appl (insert n e1) (insert n e2)"
    | "insert n Triv = Triv"
    | "insert n (Pair e1 e2) = Pair (insert n e1) (insert n e2)"
    | "insert n (ProjL e) = ProjL (insert n e)"
    | "insert n (ProjR e) = ProjR (insert n e)"
    | "insert n (Abort t e) = Abort t (insert n e)"
    | "insert n (Case et el er) = Case (insert n et) (insert (next n) el) (insert (next n) er)"
    | "insert n (InL t1 t2 e) = InL t1 t2 (insert n e)"
    | "insert n (InR t1 t2 e) = InR t1 t2 (insert n e)"

primrec subst :: "expr => var => expr => expr"
where "subst e' n (Var v) = (if v = n then e' else Var (subr n v))"
    | "subst e' n Zero = Zero"
    | "subst e' n (Suc e) = Suc (subst e' n e)"
    | "subst e' n (Rec et e0 es) =
                      Rec (subst e' n et)
                          (subst e' n e0)
                          (subst (insert first (insert first e')) (next (next n)) es)"
    | "subst e' n (Lam t e) = Lam t (subst (insert first e') (next n) e)"
    | "subst e' n (Appl e1 e2) = Appl (subst e' n e1) (subst e' n e2)"
    | "subst e' n Triv = Triv"
    | "subst e' n (Pair e1 e2) = Pair (subst e' n e1) (subst e' n e2)"
    | "subst e' n (ProjL e) = ProjL (subst e' n e)"
    | "subst e' n (ProjR e) = ProjR (subst e' n e)"
    | "subst e' n (Abort t e) = Abort t (subst e' n e)"
    | "subst e' n (Case et el er) =
                      Case (subst e' n et)
                           (subst (insert first e') (next n) el)
                           (subst (insert first e') (next n) er)"
    | "subst e' n (InL t1 t2 e) = InL t1 t2 (subst e' n e)"
    | "subst e' n (InR t1 t2 e) = InR t1 t2 (subst e' n e)"

end


(*  Title:      HOL/Analysis/Jordan_Curve.thy
    Authors:    LC Paulson, based on material from HOL Light
*)

section \<open>The Jordan Curve Theorem and Applications\<close>

theory Jordan_Curve
  imports Arcwise_Connected Further_Topology
begin

subsection\<open>Janiszewski's theorem\<close>

lemma Janiszewski_weak:
  fixes a b::complex
  assumes "compact S" "compact T" and conST: "connected(S \<inter> T)"
      and ccS: "connected_component (- S) a b" and ccT: "connected_component (- T) a b"
    shows "connected_component (- (S \<union> T)) a b"
proof -
  have [simp]: "a \<notin> S" "a \<notin> T" "b \<notin> S" "b \<notin> T"
    by (meson ComplD ccS ccT connected_component_in)+
  have clo: "closedin (top_of_set (S \<union> T)) S" "closedin (top_of_set (S \<union> T)) T"
    by (simp_all add: assms closed_subset compact_imp_closed)
  obtain g where contg: "continuous_on S g"
             and g: "\<And>x. x \<in> S \<Longrightarrow> exp (\<i>* of_real (g x)) = (x - a) /\<^sub>R cmod (x - a) / ((x - b) /\<^sub>R cmod (x - b))"
    using ccS \<open>compact S\<close>
    apply (simp add: Borsuk_maps_homotopic_in_connected_component_eq [symmetric])
    apply (subst (asm) homotopic_circlemaps_divide)
    apply (auto simp: inessential_eq_continuous_logarithm_circle)
    done
  obtain h where conth: "continuous_on T h"
             and h: "\<And>x. x \<in> T \<Longrightarrow> exp (\<i>* of_real (h x)) = (x - a) /\<^sub>R cmod (x - a) / ((x - b) /\<^sub>R cmod (x - b))"
    using ccT \<open>compact T\<close>
    apply (simp add: Borsuk_maps_homotopic_in_connected_component_eq [symmetric])
    apply (subst (asm) homotopic_circlemaps_divide)
    apply (auto simp: inessential_eq_continuous_logarithm_circle)
    done
  have "continuous_on (S \<union> T) (\<lambda>x. (x - a) /\<^sub>R cmod (x - a))" "continuous_on (S \<union> T) (\<lambda>x. (x - b) /\<^sub>R cmod (x - b))"
    by (intro continuous_intros; force)+
  moreover have "(\<lambda>x. (x - a) /\<^sub>R cmod (x - a)) ` (S \<union> T) \<subseteq> sphere 0 1" "(\<lambda>x. (x - b) /\<^sub>R cmod (x - b)) ` (S \<union> T) \<subseteq> sphere 0 1"
    by (auto simp: divide_simps)
  moreover have "\<exists>g. continuous_on (S \<union> T) g \<and>
                     (\<forall>x\<in>S \<union> T. (x - a) /\<^sub>R cmod (x - a) / ((x - b) /\<^sub>R cmod (x - b)) = exp (\<i>*complex_of_real (g x)))"
  proof (cases "S \<inter> T = {}")
    case True
    have "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else h x)"
      apply (rule continuous_on_cases_local [OF clo contg conth])
      using True by auto
    then show ?thesis
      by (rule_tac x="(\<lambda>x. if x \<in> S then g x else h x)" in exI) (auto simp: g h)
  next
    case False
    have diffpi: "\<exists>n. g x = h x + 2* of_int n*pi" if "x \<in> S \<inter> T" for x
    proof -
      have "exp (\<i>* of_real (g x)) = exp (\<i>* of_real (h x))"
        using that by (simp add: g h)
      then obtain n where "complex_of_real (g x) = complex_of_real (h x) + 2* of_int n*complex_of_real pi"
        apply (auto simp: exp_eq)
        by (metis complex_i_not_zero distrib_left mult.commute mult_cancel_left)
      then show ?thesis
        apply (rule_tac x=n in exI)
        using of_real_eq_iff by fastforce
    qed
    have contgh: "continuous_on (S \<inter> T) (\<lambda>x. g x - h x)"
      by (intro continuous_intros continuous_on_subset [OF contg] continuous_on_subset [OF conth]) auto
    moreover have disc:
          "\<exists>e>0. \<forall>y. y \<in> S \<inter> T \<and> g y - h y \<noteq> g x - h x \<longrightarrow> e \<le> norm ((g y - h y) - (g x - h x))"
          if "x \<in> S \<inter> T" for x
    proof -
      obtain nx where nx: "g x = h x + 2* of_int nx*pi"
        using \<open>x \<in> S \<inter> T\<close> diffpi by blast
      have "2*pi \<le> norm (g y - h y - (g x - h x))" if y: "y \<in> S \<inter> T" and neq: "g y - h y \<noteq> g x - h x" for y
      proof -
        obtain ny where ny: "g y = h y + 2* of_int ny*pi"
          using \<open>y \<in> S \<inter> T\<close> diffpi by blast
        { assume "nx \<noteq> ny"
          then have "1 \<le> \<bar>real_of_int ny - real_of_int nx\<bar>"
            by linarith
          then have "(2*pi)*1 \<le> (2*pi)*\<bar>real_of_int ny - real_of_int nx\<bar>"
            by simp
          also have "... = \<bar>2*real_of_int ny*pi - 2*real_of_int nx*pi\<bar>"
            by (simp add: algebra_simps abs_if)
          finally have "2*pi \<le> \<bar>2*real_of_int ny*pi - 2*real_of_int nx*pi\<bar>" by simp
        }
        with neq show ?thesis
          by (simp add: nx ny)
      qed
      then show ?thesis
        by (rule_tac x="2*pi" in exI) auto
    qed
    ultimately have "(\<lambda>x. g x - h x) constant_on S \<inter> T"
      using continuous_discrete_range_constant [OF conST contgh] by blast
    then obtain z where z: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> g x - h x = z"
      by (auto simp: constant_on_def)
    obtain w where "exp(\<i> * of_real(h w)) = exp (\<i> * of_real(z + h w))"
      using disc z False
      by auto (metis diff_add_cancel g h of_real_add)
    then have [simp]: "exp (\<i>* of_real z) = 1"
      by (metis cis_conv_exp cis_mult exp_not_eq_zero mult_cancel_right1)
    show ?thesis
    proof (intro exI conjI)
      show "continuous_on (S \<union> T) (\<lambda>x. if x \<in> S then g x else z + h x)"
        apply (intro continuous_intros continuous_on_cases_local [OF clo contg] conth)
        using z by fastforce
    qed (auto simp: g h algebra_simps exp_add)
  qed
  ultimately have *: "homotopic_with_canon (\<lambda>x. True) (S \<union> T) (sphere 0 1)
                          (\<lambda>x. (x - a) /\<^sub>R cmod (x - a))  (\<lambda>x. (x - b) /\<^sub>R cmod (x - b))"
    by (subst homotopic_circlemaps_divide) (auto simp: inessential_eq_continuous_logarithm_circle)
  show ?thesis
    apply (rule Borsuk_maps_homotopic_in_connected_component_eq [THEN iffD1])
    using assms by (auto simp: *)
qed

theorem Janiszewski:
  fixes a b :: complex
  assumes "compact S" "closed T" and conST: "connected (S \<inter> T)"
      and ccS: "connected_component (- S) a b" and ccT: "connected_component (- T) a b"
    shows "connected_component (- (S \<union> T)) a b"
proof -
  have "path_component(- T) a b"
    by (simp add: \<open>closed T\<close> ccT open_Compl open_path_connected_component)
  then obtain g where g: "path g" "path_image g \<subseteq> - T" "pathstart g = a" "pathfinish g = b"
    by (auto simp: path_component_def)
  obtain C where C: "compact C" "connected C" "a \<in> C" "b \<in> C" "C \<inter> T = {}"
  proof
    show "compact (path_image g)"
      by (simp add: \<open>path g\<close> compact_path_image)
    show "connected (path_image g)"
      by (simp add: \<open>path g\<close> connected_path_image)
  qed (use g in auto)
  obtain r where "0 < r" and r: "C \<union> S \<subseteq> ball 0 r"
    by (metis \<open>compact C\<close> \<open>compact S\<close> bounded_Un compact_imp_bounded bounded_subset_ballD)
  have "connected_component (- (S \<union> (T \<inter> cball 0 r \<union> sphere 0 r))) a b"
  proof (rule Janiszewski_weak [OF \<open>compact S\<close>])
    show comT': "compact ((T \<inter> cball 0 r) \<union> sphere 0 r)"
      by (simp add: \<open>closed T\<close> closed_Int_compact compact_Un)
    have "S \<inter> (T \<inter> cball 0 r \<union> sphere 0 r) = S \<inter> T"
      using r by auto
    with conST show "connected (S \<inter> (T \<inter> cball 0 r \<union> sphere 0 r))"
      by simp
    show "connected_component (- (T \<inter> cball 0 r \<union> sphere 0 r)) a b"
      using conST C r
      apply (simp add: connected_component_def)
      apply (rule_tac x=C in exI)
      by auto
  qed (simp add: ccS)
  then obtain U where U: "connected U" "U \<subseteq> - S" "U \<subseteq> - T \<union> - cball 0 r" "U \<subseteq> - sphere 0 r" "a \<in> U" "b \<in> U"
    by (auto simp: connected_component_def)
  show ?thesis
    unfolding connected_component_def
  proof (intro exI conjI)
    show "U \<subseteq> - (S \<union> T)"
      using U r \<open>0 < r\<close> \<open>a \<in> C\<close> connected_Int_frontier [of U "cball 0 r"]
      apply simp
      by (metis ball_subset_cball compl_inf disjoint_eq_subset_Compl disjoint_iff_not_equal inf.orderE inf_sup_aci(3) subsetCE)
  qed (auto simp: U)
qed

lemma Janiszewski_connected:
  fixes S :: "complex set"
  assumes ST: "compact S" "closed T" "connected(S \<inter> T)"
      and notST: "connected (- S)" "connected (- T)"
    shows "connected(- (S \<union> T))"
using Janiszewski [OF ST]
by (metis IntD1 IntD2 notST compl_sup connected_iff_connected_component)

subsection\<open>The Jordan Curve theorem\<close>

lemma exists_double_arc:
  fixes g :: "real \<Rightarrow> 'a::real_normed_vector"
  assumes "simple_path g" "pathfinish g = pathstart g" "a \<in> path_image g" "b \<in> path_image g" "a \<noteq> b"
  obtains u d where "arc u" "arc d" "pathstart u = a" "pathfinish u = b"
                    "pathstart d = b" "pathfinish d = a"
                    "(path_image u) \<inter> (path_image d) = {a,b}"
                    "(path_image u) \<union> (path_image d) = path_image g"
proof -
  obtain u where u: "0 \<le> u" "u \<le> 1" "g u = a"
    using assms by (auto simp: path_image_def)
  define h where "h \<equiv> shiftpath u g"
  have "simple_path h"
    using \<open>simple_path g\<close> simple_path_shiftpath \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> assms(2) h_def by blast
  have "pathstart h = g u"
    by (simp add: \<open>u \<le> 1\<close> h_def pathstart_shiftpath)
  have "pathfinish h = g u"
    by (simp add: \<open>0 \<le> u\<close> assms h_def pathfinish_shiftpath)
  have pihg: "path_image h = path_image g"
    by (simp add: \<open>0 \<le> u\<close> \<open>u \<le> 1\<close> assms h_def path_image_shiftpath)
  then obtain v where v: "0 \<le> v" "v \<le> 1" "h v = b"
    using assms by (metis (mono_tags, lifting) atLeastAtMost_iff imageE path_image_def)
  show ?thesis
  proof
    show "arc (subpath 0 v h)"
      by (metis (no_types) \<open>pathstart h = g u\<close> \<open>simple_path h\<close> arc_simple_path_subpath \<open>a \<noteq> b\<close> atLeastAtMost_iff zero_le_one order_refl pathstart_def u(3) v)
    show "arc (subpath v 1 h)"
      by (metis (no_types) \<open>pathfinish h = g u\<close> \<open>simple_path h\<close> arc_simple_path_subpath \<open>a \<noteq> b\<close> atLeastAtMost_iff zero_le_one order_refl pathfinish_def u(3) v)
    show "pathstart (subpath 0 v h) = a"
      by (metis \<open>pathstart h = g u\<close> pathstart_def pathstart_subpath u(3))
    show "pathfinish (subpath 0 v h) = b"  "pathstart (subpath v 1 h) = b"
      by (simp_all add: v(3))
    show "pathfinish (subpath v 1 h) = a"
      by (metis \<open>pathfinish h = g u\<close> pathfinish_def pathfinish_subpath u(3))
    show "path_image (subpath 0 v h) \<inter> path_image (subpath v 1 h) = {a, b}"
    proof
      have "loop_free h"
        using \<open>simple_path h\<close> simple_path_def by blast
      then show "path_image (subpath 0 v h) \<inter> path_image (subpath v 1 h) \<subseteq> {a, b}"
        using v \<open>pathfinish (subpath v 1 h) = a\<close>
        apply (clarsimp simp add: loop_free_def path_image_subpath Ball_def)
        by (smt (verit))
      show "{a, b} \<subseteq> path_image (subpath 0 v h) \<inter> path_image (subpath v 1 h)"
        using v \<open>pathstart (subpath 0 v h) = a\<close> \<open>pathfinish (subpath v 1 h) = a\<close>
        by (auto simp: path_image_subpath image_iff Bex_def)
    qed
    show "path_image (subpath 0 v h) \<union> path_image (subpath v 1 h) = path_image g"
      using v apply (simp add: path_image_subpath pihg [symmetric])
      using path_image_def by fastforce
  qed
qed

theorem\<^marker>\<open>tag unimportant\<close> Jordan_curve:
  fixes c :: "real \<Rightarrow> complex"
  assumes "simple_path c" and loop: "pathfinish c = pathstart c"
  obtains inner outer where
                "inner \<noteq> {}" "open inner" "connected inner"
                "outer \<noteq> {}" "open outer" "connected outer"
                "bounded inner" "\<not> bounded outer" "inner \<inter> outer = {}"
                "inner \<union> outer = - path_image c"
                "frontier inner = path_image c"
                "frontier outer = path_image c"
proof -
  have "path c"
    by (simp add: assms simple_path_imp_path)
  have hom: "(path_image c) homeomorphic (sphere(0::complex) 1)"
    by (simp add: assms homeomorphic_simple_path_image_circle)
  with Jordan_Brouwer_separation have "\<not> connected (- (path_image c))"
    by fastforce
  then obtain inner where inner: "inner \<in> components (- path_image c)" and "bounded inner"
    using cobounded_has_bounded_component [of "- (path_image c)"]
    using \<open>\<not> connected (- path_image c)\<close> \<open>simple_path c\<close> bounded_simple_path_image by force
  obtain outer where outer: "outer \<in> components (- path_image c)" and "\<not> bounded outer"
    using cobounded_unbounded_components [of "- (path_image c)"]
    using \<open>path c\<close> bounded_path_image by auto
  show ?thesis
  proof
    show "inner \<noteq> {}"
      using inner in_components_nonempty by auto
    show "open inner"
      by (meson \<open>simple_path c\<close> compact_imp_closed compact_simple_path_image inner open_Compl open_components)
    show "connected inner"
      using in_components_connected inner by blast
    show "outer \<noteq> {}"
      using outer in_components_nonempty by auto
    show "open outer"
      by (meson \<open>simple_path c\<close> compact_imp_closed compact_simple_path_image outer open_Compl open_components)
    show "connected outer"
      using in_components_connected outer by blast
    show "inner \<inter> outer = {}"
      by (meson \<open>\<not> bounded outer\<close> \<open>bounded inner\<close> \<open>connected outer\<close> bounded_subset components_maximal in_components_subset inner outer)
    show fro_inner: "frontier inner = path_image c"
      by (simp add: Jordan_Brouwer_frontier [OF hom inner])
    show fro_outer: "frontier outer = path_image c"
      by (simp add: Jordan_Brouwer_frontier [OF hom outer])
    have False if m: "middle \<in> components (- path_image c)" and "middle \<noteq> inner" "middle \<noteq> outer" for middle
    proof -
      have "frontier middle = path_image c"
        by (simp add: Jordan_Brouwer_frontier [OF hom] that)
      have middle: "open middle" "connected middle" "middle \<noteq> {}"
        apply (meson \<open>simple_path c\<close> compact_imp_closed compact_simple_path_image m open_Compl open_components)
        using in_components_connected in_components_nonempty m by blast+
      obtain a0 b0 where "a0 \<in> path_image c" "b0 \<in> path_image c" "a0 \<noteq> b0"
        using simple_path_image_uncountable [OF \<open>simple_path c\<close>]
        by (metis Diff_cancel countable_Diff_eq countable_empty insert_iff subsetI subset_singleton_iff)
      obtain a b g where ab: "a \<in> path_image c" "b \<in> path_image c" "a \<noteq> b"
                     and "arc g" "pathstart g = a" "pathfinish g = b"
                     and pag_sub: "path_image g - {a,b} \<subseteq> middle"
      proof (rule dense_accessible_frontier_point_pairs [OF \<open>open middle\<close> \<open>connected middle\<close>, of "path_image c \<inter> ball a0 (dist a0 b0)" "path_image c \<inter> ball b0 (dist a0 b0)"])
        show "openin (top_of_set (frontier middle)) (path_image c \<inter> ball a0 (dist a0 b0))"
             "openin (top_of_set (frontier middle)) (path_image c \<inter> ball b0 (dist a0 b0))"
          by (simp_all add: \<open>frontier middle = path_image c\<close> openin_open_Int)
        show "path_image c \<inter> ball a0 (dist a0 b0) \<noteq> path_image c \<inter> ball b0 (dist a0 b0)"
          using \<open>a0 \<noteq> b0\<close> \<open>b0 \<in> path_image c\<close> by auto
        show "path_image c \<inter> ball a0 (dist a0 b0) \<noteq> {}"
          using \<open>a0 \<in> path_image c\<close> \<open>a0 \<noteq> b0\<close> by auto
        show "path_image c \<inter> ball b0 (dist a0 b0) \<noteq> {}"
          using \<open>b0 \<in> path_image c\<close> \<open>a0 \<noteq> b0\<close> by auto
      qed (use arc_distinct_ends arc_imp_simple_path simple_path_endless that in fastforce)
      obtain u d where "arc u" "arc d"
                   and "pathstart u = a" "pathfinish u = b" "pathstart d = b" "pathfinish d = a"
                   and ud_ab: "(path_image u) \<inter> (path_image d) = {a,b}"
                   and ud_Un: "(path_image u) \<union> (path_image d) = path_image c"
        using exists_double_arc [OF assms ab] by blast
      obtain x y where "x \<in> inner" "y \<in> outer"
        using \<open>inner \<noteq> {}\<close> \<open>outer \<noteq> {}\<close> by auto
      have "inner \<inter> middle = {}" "middle \<inter> outer = {}"
        using components_nonoverlap inner outer m that by blast+
      have "connected_component (- (path_image u \<union> path_image g \<union> (path_image d \<union> path_image g))) x y"
      proof (rule Janiszewski)
        show "compact (path_image u \<union> path_image g)"
          by (simp add: \<open>arc g\<close> \<open>arc u\<close> compact_Un compact_arc_image)
        show "closed (path_image d \<union> path_image g)"
          by (simp add: \<open>arc d\<close> \<open>arc g\<close> closed_Un closed_arc_image)
        show "connected ((path_image u \<union> path_image g) \<inter> (path_image d \<union> path_image g))"
          by (metis Un_Diff_cancel \<open>arc g\<close> \<open>path_image u \<inter> path_image d = {a, b}\<close> \<open>pathfinish g = b\<close> \<open>pathstart g = a\<close> connected_arc_image insert_Diff1 pathfinish_in_path_image pathstart_in_path_image sup_bot.right_neutral sup_commute sup_inf_distrib1)
        show "connected_component (- (path_image u \<union> path_image g)) x y"
          unfolding connected_component_def
        proof (intro exI conjI)
          have "connected ((inner \<union> (path_image c - path_image u)) \<union> (outer \<union> (path_image c - path_image u)))"
          proof (rule connected_Un)
            show "connected (inner \<union> (path_image c - path_image u))"
              apply (rule connected_intermediate_closure [OF \<open>connected inner\<close>])
              using fro_inner [symmetric]  apply (auto simp: closure_subset frontier_def)
              done
            show "connected (outer \<union> (path_image c - path_image u))"
              apply (rule connected_intermediate_closure [OF \<open>connected outer\<close>])
              using fro_outer [symmetric]  apply (auto simp: closure_subset frontier_def)
              done
            have "(inner \<inter> outer) \<union> (path_image c - path_image u) \<noteq> {}"
              by (metis \<open>arc d\<close>  ud_ab Diff_Int Diff_cancel Un_Diff \<open>inner \<inter> outer = {}\<close> \<open>pathfinish d = a\<close> \<open>pathstart d = b\<close> arc_simple_path insert_commute nonempty_simple_path_endless sup_bot_left ud_Un)
            then show "(inner \<union> (path_image c - path_image u)) \<inter> (outer \<union> (path_image c - path_image u)) \<noteq> {}"
              by auto
          qed
          then show "connected (inner \<union> outer \<union> (path_image c - path_image u))"
            by (metis sup.right_idem sup_assoc sup_commute)
          have "inner \<subseteq> - path_image u" "outer \<subseteq> - path_image u"
            using in_components_subset inner outer ud_Un by auto
          moreover have "inner \<subseteq> - path_image g" "outer \<subseteq> - path_image g"
            using \<open>inner \<inter> middle = {}\<close> \<open>inner \<subseteq> - path_image u\<close>
            using \<open>middle \<inter> outer = {}\<close> \<open>outer \<subseteq> - path_image u\<close> pag_sub ud_ab by fastforce+
          moreover have "path_image c - path_image u \<subseteq> - path_image g"
            using in_components_subset m pag_sub ud_ab by fastforce
          ultimately show "inner \<union> outer \<union> (path_image c - path_image u) \<subseteq> - (path_image u \<union> path_image g)"
            by force
          show "x \<in> inner \<union> outer \<union> (path_image c - path_image u)"
            by (auto simp: \<open>x \<in> inner\<close>)
          show "y \<in> inner \<union> outer \<union> (path_image c - path_image u)"
            by (auto simp: \<open>y \<in> outer\<close>)
        qed
        show "connected_component (- (path_image d \<union> path_image g)) x y"
          unfolding connected_component_def
        proof (intro exI conjI)
          have "connected ((inner \<union> (path_image c - path_image d)) \<union> (outer \<union> (path_image c - path_image d)))"
          proof (rule connected_Un)
            show "connected (inner \<union> (path_image c - path_image d))"
              apply (rule connected_intermediate_closure [OF \<open>connected inner\<close>])
              using fro_inner [symmetric]  apply (auto simp: closure_subset frontier_def)
              done
            show "connected (outer \<union> (path_image c - path_image d))"
              apply (rule connected_intermediate_closure [OF \<open>connected outer\<close>])
              using fro_outer [symmetric]  apply (auto simp: closure_subset frontier_def)
              done
            have "(inner \<inter> outer) \<union> (path_image c - path_image d) \<noteq> {}"
              using \<open>arc u\<close> \<open>pathfinish u = b\<close> \<open>pathstart u = a\<close> arc_imp_simple_path nonempty_simple_path_endless ud_Un ud_ab by fastforce
            then show "(inner \<union> (path_image c - path_image d)) \<inter> (outer \<union> (path_image c - path_image d)) \<noteq> {}"
              by auto
          qed
          then show "connected (inner \<union> outer \<union> (path_image c - path_image d))"
            by (metis sup.right_idem sup_assoc sup_commute)
          have "inner \<subseteq> - path_image d" "outer \<subseteq> - path_image d"
            using in_components_subset inner outer ud_Un by auto
          moreover have "inner \<subseteq> - path_image g" "outer \<subseteq> - path_image g"
            using \<open>inner \<inter> middle = {}\<close> \<open>inner \<subseteq> - path_image d\<close>
            using \<open>middle \<inter> outer = {}\<close> \<open>outer \<subseteq> - path_image d\<close> pag_sub ud_ab by fastforce+
          moreover have "path_image c - path_image d \<subseteq> - path_image g"
            using in_components_subset m pag_sub ud_ab by fastforce
          ultimately show "inner \<union> outer \<union> (path_image c - path_image d) \<subseteq> - (path_image d \<union> path_image g)"
            by force
          show "x \<in> inner \<union> outer \<union> (path_image c - path_image d)"
            by (auto simp: \<open>x \<in> inner\<close>)
          show "y \<in> inner \<union> outer \<union> (path_image c - path_image d)"
            by (auto simp: \<open>y \<in> outer\<close>)
        qed
      qed
      then have "connected_component (- (path_image u \<union> path_image d \<union> path_image g)) x y"
        by (simp add: Un_ac)
      moreover have "\<not>(connected_component (- (path_image c)) x y)"
        by (metis (no_types, lifting) \<open>\<not> bounded outer\<close> \<open>bounded inner\<close> \<open>x \<in> inner\<close> \<open>y \<in> outer\<close> componentsE connected_component_eq inner mem_Collect_eq outer)
      ultimately show False
        by (auto simp: ud_Un [symmetric] connected_component_def)
    qed
    then have "components (- path_image c) = {inner,outer}"
      using inner outer by blast
    then have "Union (components (- path_image c)) = inner \<union> outer"
      by simp
    then show "inner \<union> outer = - path_image c"
      by auto
  qed (auto simp: \<open>bounded inner\<close> \<open>\<not> bounded outer\<close>)
qed

corollary\<^marker>\<open>tag unimportant\<close> Jordan_disconnected:
  fixes c :: "real \<Rightarrow> complex"
  assumes "simple_path c" "pathfinish c = pathstart c"
    shows "\<not> connected(- path_image c)"
using Jordan_curve [OF assms]
  by (metis Jordan_Brouwer_separation assms homeomorphic_simple_path_image_circle zero_less_one)

corollary Jordan_inside_outside:
  fixes c :: "real \<Rightarrow> complex"
  assumes "simple_path c" "pathfinish c = pathstart c"
    shows "inside(path_image c) \<noteq> {} \<and>
          open(inside(path_image c)) \<and>
          connected(inside(path_image c)) \<and>
          outside(path_image c) \<noteq> {} \<and>
          open(outside(path_image c)) \<and>
          connected(outside(path_image c)) \<and>
          bounded(inside(path_image c)) \<and>
          \<not> bounded(outside(path_image c)) \<and>
          inside(path_image c) \<inter> outside(path_image c) = {} \<and>
          inside(path_image c) \<union> outside(path_image c) =
          - path_image c \<and>
          frontier(inside(path_image c)) = path_image c \<and>
          frontier(outside(path_image c)) = path_image c"
proof -
  obtain inner outer
    where *: "inner \<noteq> {}" "open inner" "connected inner"
             "outer \<noteq> {}" "open outer" "connected outer"
             "bounded inner" "\<not> bounded outer" "inner \<inter> outer = {}"
             "inner \<union> outer = - path_image c"
             "frontier inner = path_image c"
             "frontier outer = path_image c"
    using Jordan_curve [OF assms] by blast
  then have inner: "inside(path_image c) = inner"
    by (metis dual_order.antisym inside_subset interior_eq interior_inside_frontier)
  have outer: "outside(path_image c) = outer"
    using \<open>inner \<union> outer = - path_image c\<close> \<open>inside (path_image c) = inner\<close>
          outside_inside \<open>inner \<inter> outer = {}\<close> by auto
  show ?thesis
    using * by (auto simp: inner outer)
qed

subsubsection\<open>Triple-curve or "theta-curve" theorem\<close>

text\<open>Proof that there is no fourth component taken from
     Kuratowski's Topology vol 2, para 61, II.\<close>

theorem split_inside_simple_closed_curve:
  fixes c :: "real \<Rightarrow> complex"
  assumes "simple_path c1" and c1: "pathstart c1 = a" "pathfinish c1 = b"
      and "simple_path c2" and c2: "pathstart c2 = a" "pathfinish c2 = b"
      and "simple_path c"  and c: "pathstart c = a" "pathfinish c = b"
      and "a \<noteq> b"
      and c1c2: "path_image c1 \<inter> path_image c2 = {a,b}"
      and c1c: "path_image c1 \<inter> path_image c = {a,b}"
      and c2c: "path_image c2 \<inter> path_image c = {a,b}"
      and ne_12: "path_image c \<inter> inside(path_image c1 \<union> path_image c2) \<noteq> {}"
  obtains "inside(path_image c1 \<union> path_image c) \<inter> inside(path_image c2 \<union> path_image c) = {}"
          "inside(path_image c1 \<union> path_image c) \<union> inside(path_image c2 \<union> path_image c) \<union>
           (path_image c - {a,b}) = inside(path_image c1 \<union> path_image c2)"
proof -
  let ?\<Theta> = "path_image c"  let ?\<Theta>1 = "path_image c1"  let ?\<Theta>2 = "path_image c2"
  have sp: "simple_path (c1 +++ reversepath c2)" "simple_path (c1 +++ reversepath c)" "simple_path (c2 +++ reversepath c)"
    using assms by (auto simp: simple_path_join_loop_eq arc_simple_path simple_path_reversepath)
  then have op_in12: "open (inside (?\<Theta>1 \<union> ?\<Theta>2))"
     and op_out12: "open (outside (?\<Theta>1 \<union> ?\<Theta>2))"
     and op_in1c: "open (inside (?\<Theta>1 \<union> ?\<Theta>))"
     and op_in2c: "open (inside (?\<Theta>2 \<union> ?\<Theta>))"
     and op_out1c: "open (outside (?\<Theta>1 \<union> ?\<Theta>))"
     and op_out2c: "open (outside (?\<Theta>2 \<union> ?\<Theta>))"
     and co_in1c: "connected (inside (?\<Theta>1 \<union> ?\<Theta>))"
     and co_in2c: "connected (inside (?\<Theta>2 \<union> ?\<Theta>))"
     and co_out12c: "connected (outside (?\<Theta>1 \<union> ?\<Theta>2))"
     and co_out1c: "connected (outside (?\<Theta>1 \<union> ?\<Theta>))"
     and co_out2c: "connected (outside (?\<Theta>2 \<union> ?\<Theta>))"
     and pa_c: "?\<Theta> - {pathstart c, pathfinish c} \<subseteq> - ?\<Theta>1"
               "?\<Theta> - {pathstart c, pathfinish c} \<subseteq> - ?\<Theta>2"
     and pa_c1: "?\<Theta>1 - {pathstart c1, pathfinish c1} \<subseteq> - ?\<Theta>2"
                "?\<Theta>1 - {pathstart c1, pathfinish c1} \<subseteq> - ?\<Theta>"
     and pa_c2: "?\<Theta>2 - {pathstart c2, pathfinish c2} \<subseteq> - ?\<Theta>1"
                "?\<Theta>2 - {pathstart c2, pathfinish c2} \<subseteq> - ?\<Theta>"
     and co_c: "connected(?\<Theta> - {pathstart c,pathfinish c})"
     and co_c1: "connected(?\<Theta>1 - {pathstart c1,pathfinish c1})"
     and co_c2: "connected(?\<Theta>2 - {pathstart c2,pathfinish c2})"
     and fr_in: "frontier(inside(?\<Theta>1 \<union> ?\<Theta>2)) = ?\<Theta>1 \<union> ?\<Theta>2"
              "frontier(inside(?\<Theta>2 \<union> ?\<Theta>)) = ?\<Theta>2 \<union> ?\<Theta>"
              "frontier(inside(?\<Theta>1 \<union> ?\<Theta>)) = ?\<Theta>1 \<union> ?\<Theta>"
     and fr_out: "frontier(outside(?\<Theta>1 \<union> ?\<Theta>2)) = ?\<Theta>1 \<union> ?\<Theta>2"
              "frontier(outside(?\<Theta>2 \<union> ?\<Theta>)) = ?\<Theta>2 \<union> ?\<Theta>"
              "frontier(outside(?\<Theta>1 \<union> ?\<Theta>)) = ?\<Theta>1 \<union> ?\<Theta>"
    using Jordan_inside_outside [of "c1 +++ reversepath c2"]
    using Jordan_inside_outside [of "c1 +++ reversepath c"]
    using Jordan_inside_outside [of "c2 +++ reversepath c"] assms
              apply (simp_all add: path_image_join closed_Un closed_simple_path_image open_inside open_outside)
      apply (blast elim: | metis connected_simple_path_endless)+
    done
  have inout_12: "inside (?\<Theta>1 \<union> ?\<Theta>2) \<inter> (?\<Theta> - {pathstart c, pathfinish c}) \<noteq> {}"
    by (metis (no_types, lifting) c c1c ne_12 Diff_Int_distrib Diff_empty Int_empty_right Int_left_commute inf_sup_absorb inf_sup_aci(1) inside_no_overlap)
  have pi_disjoint:  "?\<Theta> \<inter> outside(?\<Theta>1 \<union> ?\<Theta>2) = {}"
  proof (rule ccontr)
    assume "?\<Theta> \<inter> outside (?\<Theta>1 \<union> ?\<Theta>2) \<noteq> {}"
    then show False
      using connectedD [OF co_c, of "inside(?\<Theta>1 \<union> ?\<Theta>2)" "outside(?\<Theta>1 \<union> ?\<Theta>2)"]
      using c c1c2 pa_c op_in12 op_out12 inout_12
      apply auto
      apply (metis Un_Diff_cancel2 Un_iff compl_sup disjoint_insert(1) inf_commute inf_compl_bot_left2 inside_Un_outside mk_disjoint_insert sup_inf_absorb)
      done
  qed
  have out_sub12: "outside(?\<Theta>1 \<union> ?\<Theta>2) \<subseteq> outside(?\<Theta>1 \<union> ?\<Theta>)" "outside(?\<Theta>1 \<union> ?\<Theta>2) \<subseteq> outside(?\<Theta>2 \<union> ?\<Theta>)"
    by (metis Un_commute pi_disjoint outside_Un_outside_Un)+
  have pa1_disj_in2: "?\<Theta>1 \<inter> inside (?\<Theta>2 \<union> ?\<Theta>) = {}"
  proof (rule ccontr)
    assume ne: "?\<Theta>1 \<inter> inside (?\<Theta>2 \<union> ?\<Theta>) \<noteq> {}"
    have 1: "inside (?\<Theta> \<union> ?\<Theta>2) \<inter> ?\<Theta> = {}"
      by (metis (no_types) Diff_Int_distrib Diff_cancel inf_sup_absorb inf_sup_aci(3) inside_no_overlap)
    have 2: "outside (?\<Theta> \<union> ?\<Theta>2) \<inter> ?\<Theta> = {}"
      by (metis (no_types) Int_empty_right Int_left_commute inf_sup_absorb outside_no_overlap)
    have "outside (?\<Theta>2 \<union> ?\<Theta>) \<subseteq> outside (?\<Theta>1 \<union> ?\<Theta>2)"
      apply (subst Un_commute, rule outside_Un_outside_Un)
      using connectedD [OF co_c1, of "inside(?\<Theta>2 \<union> ?\<Theta>)" "outside(?\<Theta>2 \<union> ?\<Theta>)"]
        pa_c1 op_in2c op_out2c ne c1 c2c 1 2 by (auto simp: inf_sup_aci)
    with out_sub12
    have "outside(?\<Theta>1 \<union> ?\<Theta>2) = outside(?\<Theta>2 \<union> ?\<Theta>)" by blast
    then have "frontier(outside(?\<Theta>1 \<union> ?\<Theta>2)) = frontier(outside(?\<Theta>2 \<union> ?\<Theta>))"
      by simp
    then show False
      using inout_12 pi_disjoint c c1c c2c fr_out by auto
  qed
  have pa2_disj_in1: "?\<Theta>2 \<inter> inside(?\<Theta>1 \<union> ?\<Theta>) = {}"
  proof (rule ccontr)
    assume ne: "?\<Theta>2 \<inter> inside (?\<Theta>1 \<union> ?\<Theta>) \<noteq> {}"
    have 1: "inside (?\<Theta> \<union> ?\<Theta>1) \<inter> ?\<Theta> = {}"
      by (metis (no_types) Diff_Int_distrib Diff_cancel inf_sup_absorb inf_sup_aci(3) inside_no_overlap)
    have 2: "outside (?\<Theta> \<union> ?\<Theta>1) \<inter> ?\<Theta> = {}"
      by (metis (no_types) Int_empty_right Int_left_commute inf_sup_absorb outside_no_overlap)
    have "outside (?\<Theta>1 \<union> ?\<Theta>) \<subseteq> outside (?\<Theta>1 \<union> ?\<Theta>2)"
      apply (rule outside_Un_outside_Un)
      using connectedD [OF co_c2, of "inside(?\<Theta>1 \<union> ?\<Theta>)" "outside(?\<Theta>1 \<union> ?\<Theta>)"]
        pa_c2 op_in1c op_out1c ne c2 c1c 1 2 by (auto simp: inf_sup_aci)
    with out_sub12
    have "outside(?\<Theta>1 \<union> ?\<Theta>2) = outside(?\<Theta>1 \<union> ?\<Theta>)"
      by blast
    then have "frontier(outside(?\<Theta>1 \<union> ?\<Theta>2)) = frontier(outside(?\<Theta>1 \<union> ?\<Theta>))"
      by simp
    then show False
      using inout_12 pi_disjoint c c1c c2c fr_out by auto
  qed
  have in_sub_in1: "inside(?\<Theta>1 \<union> ?\<Theta>) \<subseteq> inside(?\<Theta>1 \<union> ?\<Theta>2)"
    using pa2_disj_in1 out_sub12 by (auto simp: inside_outside)
  have in_sub_in2: "inside(?\<Theta>2 \<union> ?\<Theta>) \<subseteq> inside(?\<Theta>1 \<union> ?\<Theta>2)"
    using pa1_disj_in2 out_sub12 by (auto simp: inside_outside)
  have in_sub_out12: "inside(?\<Theta>1 \<union> ?\<Theta>) \<subseteq> outside(?\<Theta>2 \<union> ?\<Theta>)"
  proof
    fix x
    assume x: "x \<in> inside (?\<Theta>1 \<union> ?\<Theta>)"
    then have xnot: "x \<notin> ?\<Theta>"
      by (simp add: inside_def)
    obtain z where zim: "z \<in> ?\<Theta>1" and zout: "z \<in> outside(?\<Theta>2 \<union> ?\<Theta>)"
      apply (auto simp: outside_inside)
      using nonempty_simple_path_endless [OF \<open>simple_path c1\<close>]
      by (metis Diff_Diff_Int Diff_iff ex_in_conv c1 c1c c1c2 pa1_disj_in2)
    obtain e where "e > 0" and e: "ball z e \<subseteq> outside(?\<Theta>2 \<union> ?\<Theta>)"
      using zout op_out2c open_contains_ball_eq by blast
    have "z \<in> frontier (inside (?\<Theta>1 \<union> ?\<Theta>))"
      using zim by (auto simp: fr_in)
    then obtain w where w1: "w \<in> inside (?\<Theta>1 \<union> ?\<Theta>)" and dwz: "dist w z < e"
      using zim \<open>e > 0\<close> by (auto simp: frontier_def closure_approachable)
    then have w2: "w \<in> outside (?\<Theta>2 \<union> ?\<Theta>)"
      by (metis e dist_commute mem_ball subsetCE)
    then have "connected_component (- ?\<Theta>2 \<inter> - ?\<Theta>) z w"
      apply (simp add: connected_component_def)
      apply (rule_tac x = "outside(?\<Theta>2 \<union> ?\<Theta>)" in exI)
      using zout apply (auto simp: co_out2c)
       apply (simp_all add: outside_inside)
      done
    moreover have "connected_component (- ?\<Theta>2 \<inter> - ?\<Theta>) w x"
      unfolding connected_component_def
      using pa2_disj_in1 co_in1c x w1 union_with_outside by fastforce
    ultimately have eq: "connected_component_set (- ?\<Theta>2 \<inter> - ?\<Theta>) x =
                         connected_component_set (- ?\<Theta>2 \<inter> - ?\<Theta>) z"
      by (metis (mono_tags, lifting) connected_component_eq mem_Collect_eq)
    show "x \<in> outside (?\<Theta>2 \<union> ?\<Theta>)"
      using zout x pa2_disj_in1 by (auto simp: outside_def eq xnot)
  qed
  have in_sub_out21: "inside(?\<Theta>2 \<union> ?\<Theta>) \<subseteq> outside(?\<Theta>1 \<union> ?\<Theta>)"
  proof
    fix x
    assume x: "x \<in> inside (?\<Theta>2 \<union> ?\<Theta>)"
    then have xnot: "x \<notin> ?\<Theta>"
      by (simp add: inside_def)
    obtain z where zim: "z \<in> ?\<Theta>2" and zout: "z \<in> outside(?\<Theta>1 \<union> ?\<Theta>)"
      apply (auto simp: outside_inside)
      using nonempty_simple_path_endless [OF \<open>simple_path c2\<close>]
      by (metis (no_types, opaque_lifting) Diff_Diff_Int Diff_iff c1c2 c2 c2c ex_in_conv pa2_disj_in1)
    obtain e where "e > 0" and e: "ball z e \<subseteq> outside(?\<Theta>1 \<union> ?\<Theta>)"
      using zout op_out1c open_contains_ball_eq by blast
    have "z \<in> frontier (inside (?\<Theta>2 \<union> ?\<Theta>))"
      using zim by (auto simp: fr_in)
    then obtain w where w2: "w \<in> inside (?\<Theta>2 \<union> ?\<Theta>)" and dwz: "dist w z < e"
      using zim \<open>e > 0\<close> by (auto simp: frontier_def closure_approachable)
    then have w1: "w \<in> outside (?\<Theta>1 \<union> ?\<Theta>)"
      by (metis e dist_commute mem_ball subsetCE)
    then have "connected_component (- ?\<Theta>1 \<inter> - ?\<Theta>) z w"
      apply (simp add: connected_component_def)
      apply (rule_tac x = "outside(?\<Theta>1 \<union> ?\<Theta>)" in exI)
      using zout apply (auto simp: co_out1c)
       apply (simp_all add: outside_inside)
      done
    moreover have "connected_component (- ?\<Theta>1 \<inter> - ?\<Theta>) w x"
      unfolding connected_component_def
      using pa1_disj_in2 co_in2c x w2 union_with_outside by fastforce
    ultimately have eq: "connected_component_set (- ?\<Theta>1 \<inter> - ?\<Theta>) x =
                           connected_component_set (- ?\<Theta>1 \<inter> - ?\<Theta>) z"
      by (metis (no_types, lifting) connected_component_eq mem_Collect_eq)
    show "x \<in> outside (?\<Theta>1 \<union> ?\<Theta>)"
      using zout x pa1_disj_in2 by (auto simp: outside_def eq xnot)
  qed
  show ?thesis
  proof
    show "inside (?\<Theta>1 \<union> ?\<Theta>) \<inter> inside (?\<Theta>2 \<union> ?\<Theta>) = {}"
      by (metis Int_Un_distrib in_sub_out12 bot_eq_sup_iff disjoint_eq_subset_Compl outside_inside)
    have *: "outside (?\<Theta>1 \<union> ?\<Theta>) \<inter> outside (?\<Theta>2 \<union> ?\<Theta>) \<subseteq> outside (?\<Theta>1 \<union> ?\<Theta>2)"
    proof (rule components_maximal)
      show out_in: "outside (?\<Theta>1 \<union> ?\<Theta>2) \<in> components (- (?\<Theta>1 \<union> ?\<Theta>2))"
        apply (simp only: outside_in_components co_out12c)
        by (metis bounded_empty fr_out(1) frontier_empty unbounded_outside)
      have conn_U: "connected (- (closure (inside (?\<Theta>1 \<union> ?\<Theta>)) \<union> closure (inside (?\<Theta>2 \<union> ?\<Theta>))))"
      proof (rule Janiszewski_connected, simp_all)
        show "bounded (inside (?\<Theta>1 \<union> ?\<Theta>))"
          by (simp add: \<open>simple_path c1\<close> \<open>simple_path c\<close> bounded_inside bounded_simple_path_image)
        have if1: "- (inside (?\<Theta>1 \<union> ?\<Theta>) \<union> frontier (inside (?\<Theta>1 \<union> ?\<Theta>))) = - ?\<Theta>1 \<inter> - ?\<Theta> \<inter> - inside (?\<Theta>1 \<union> ?\<Theta>)"
          by (metis (no_types, lifting) Int_commute Jordan_inside_outside c c1 compl_sup path_image_join path_image_reversepath pathfinish_join pathfinish_reversepath pathstart_join pathstart_reversepath sp(2) closure_Un_frontier fr_out(3))
        then show "connected (- closure (inside (?\<Theta>1 \<union> ?\<Theta>)))"
          by (metis Compl_Un outside_inside co_out1c closure_Un_frontier)
        have if2: "- (inside (?\<Theta>2 \<union> ?\<Theta>) \<union> frontier (inside (?\<Theta>2 \<union> ?\<Theta>))) = - ?\<Theta>2 \<inter> - ?\<Theta> \<inter> - inside (?\<Theta>2 \<union> ?\<Theta>)"
          by (metis (no_types, lifting) Int_commute Jordan_inside_outside c c2 compl_sup path_image_join path_image_reversepath pathfinish_join pathfinish_reversepath pathstart_join pathstart_reversepath sp(3) closure_Un_frontier fr_out(2))
        then show "connected (- closure (inside (?\<Theta>2 \<union> ?\<Theta>)))"
          by (metis Compl_Un outside_inside co_out2c closure_Un_frontier)
        have "connected(?\<Theta>)"
          by (metis \<open>simple_path c\<close> connected_simple_path_image)
        moreover
        have "closure (inside (?\<Theta>1 \<union> ?\<Theta>)) \<inter> closure (inside (?\<Theta>2 \<union> ?\<Theta>)) = ?\<Theta>"
          (is "?lhs = ?rhs")
        proof
          show "?lhs \<subseteq> ?rhs"
          proof clarify
            fix x
            assume x: "x \<in> closure (inside (?\<Theta>1 \<union> ?\<Theta>))" "x \<in> closure (inside (?\<Theta>2 \<union> ?\<Theta>))"
            then have "x \<notin> inside (?\<Theta>1 \<union> ?\<Theta>)"
              by (meson closure_iff_nhds_not_empty in_sub_out12 inside_Int_outside op_in1c)
            with fr_in x show "x \<in> ?\<Theta>"
              by (metis c1c c1c2 closure_Un_frontier pa1_disj_in2 Int_iff Un_iff insert_disjoint(2) insert_subset subsetI subset_antisym)
          qed
          show "?rhs \<subseteq> ?lhs"
            using if1 if2 closure_Un_frontier by fastforce
        qed
        ultimately
        show "connected (closure (inside (?\<Theta>1 \<union> ?\<Theta>)) \<inter> closure (inside (?\<Theta>2 \<union> ?\<Theta>)))"
          by auto
      qed
      show "connected (outside (?\<Theta>1 \<union> ?\<Theta>) \<inter> outside (?\<Theta>2 \<union> ?\<Theta>))"
        using fr_in conn_U  by (simp add: closure_Un_frontier outside_inside Un_commute)
      show "outside (?\<Theta>1 \<union> ?\<Theta>) \<inter> outside (?\<Theta>2 \<union> ?\<Theta>) \<subseteq> - (?\<Theta>1 \<union> ?\<Theta>2)"
        by clarify (metis Diff_Compl Diff_iff Un_iff inf_sup_absorb outside_inside)
      show "outside (?\<Theta>1 \<union> ?\<Theta>2) \<inter>
            (outside (?\<Theta>1 \<union> ?\<Theta>) \<inter> outside (?\<Theta>2 \<union> ?\<Theta>)) \<noteq> {}"
        by (metis Int_assoc out_in inf.orderE out_sub12(1) out_sub12(2) outside_in_components)
    qed
    show "inside (?\<Theta>1 \<union> ?\<Theta>) \<union> inside (?\<Theta>2 \<union> ?\<Theta>) \<union> (?\<Theta> - {a, b}) = inside (?\<Theta>1 \<union> ?\<Theta>2)"
      (is "?lhs = ?rhs")
    proof
      show "?lhs \<subseteq> ?rhs"
        apply (simp add: in_sub_in1 in_sub_in2)
        using c1c c2c inside_outside pi_disjoint by fastforce
      have "inside (?\<Theta>1 \<union> ?\<Theta>2) \<subseteq> inside (?\<Theta>1 \<union> ?\<Theta>) \<union> inside (?\<Theta>2 \<union> ?\<Theta>) \<union> (?\<Theta>)"
        using Compl_anti_mono [OF *] by (force simp: inside_outside)
      moreover have "inside (?\<Theta>1 \<union> ?\<Theta>2) \<subseteq> -{a,b}"
        using c1 union_with_outside by fastforce
      ultimately show "?rhs \<subseteq> ?lhs" by auto
    qed
  qed
qed

end