theory ex_2_4
  imports Main
begin
fun snoc::"'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
"snoc [] x = [x]" |
"snoc (y#ys) x = y # (snoc ys x)"

fun reverse::"'a list \<Rightarrow> 'a list" where
"reverse [] = []" |
"reverse (x # xs) = snoc (reverse xs) x"

lemma rev_snoc[simp]: "reverse (snoc xs x) = x # reverse xs"
  apply (induction xs)
  by (auto)

theorem rev_rev[simp]:"reverse (reverse xs) = xs"
  apply (induction xs)
  by (auto)
end


(* Title: ETTS/ETTS_Auxiliary.thy
   Author: Mihails Milehins
   Copyright 2021 (C) Mihails Milehins

Auxiliary functionality for the ETTS.
*)

section\<open>Auxiliary functionality and helpful lemmas for Types-To-Sets\<close>
theory ETTS_Auxiliary
  imports ETTS
begin

subsection\<open>Further transfer rules\<close>

lemma Domainp_eq[transfer_domain_rule, transfer_rule]:
  "Domainp (=) = (\<lambda>x. x \<in> UNIV)"
  by auto

lemma Domainp_rel_prod[transfer_domain_rule, transfer_rule]:
  assumes "Domainp cr\<^sub>1 = (\<lambda>x. x \<in> \<UU>\<^sub>1)" and "Domainp cr\<^sub>2 = (\<lambda>x. x \<in> \<UU>\<^sub>2)"
  shows "Domainp (rel_prod cr\<^sub>1 cr\<^sub>2) = (\<lambda>x. x \<in> \<UU>\<^sub>1 \<times> \<UU>\<^sub>2)"
  using assms by (simp add: ctr_simps_pred_prod_eq_cart prod.Domainp_rel)

subsection\<open>Constant function\<close>

definition const_fun :: "['b, 'a] \<Rightarrow> 'b" where "const_fun c = (\<lambda>x. c)"

lemma const_fun_transfer[transfer_rule]:
  includes lifting_syntax
  assumes "Domainp A = (\<lambda>x. x \<in> \<UU>A)" and "\<forall>x \<in> \<UU>A. f x = c" and "B c c'"
  shows "(A ===> B) f (const_fun c')"
proof(intro rel_funI)
  fix x y assume "A x y"
  then have "x \<in> \<UU>A" by (meson Domainp.DomainI assms(1))
  then have "f x = c" by (rule assms(2)[rule_format])
  show "B (f x) (const_fun c' y)"
    unfolding \<open>f x = c\<close> const_fun_def by (rule assms(3))
qed

subsection\<open>Transfer rules suitable for instantiation\<close>

lemma Domainp_eq_Collect: "Domainp A = (\<lambda>x. x \<in> \<UU>) = (\<UU> = Collect (Domainp A))"
  by (metis mem_Collect_eq pred_equals_eq)

context
  includes lifting_syntax
begin

lemma tts_rel_set_transfer:
  fixes A :: "'al \<Rightarrow> 'ar \<Rightarrow> bool"
    and B :: "'bl \<Rightarrow> 'br \<Rightarrow> bool"
  assumes "S \<subseteq> Collect (Domainp A)"
  shows "\<exists>S'. rel_set A S S'"
  by (metis assms(1)[folded Ball_Collect] DomainpE Domainp_set)

lemma tts_AB_transfer:
  fixes f :: "'al \<Rightarrow> 'bl"
    and A :: "'al \<Rightarrow> 'ar \<Rightarrow> bool"
    and B :: "'bl \<Rightarrow> 'br \<Rightarrow> bool"
  assumes closed: "f ` \<UU>A \<subseteq> \<UU>B"
  assumes
    "Domainp A = (\<lambda>x. x \<in> \<UU>A)" "bi_unique A" "right_total A"
    "Domainp B = (\<lambda>x. x \<in> \<UU>B)" "bi_unique B" "right_total B"
  shows "\<exists>rcdt. (A ===> B) f rcdt"
proof-
  from closed have closed': "x \<in> \<UU>A \<Longrightarrow> f x \<in> \<UU>B" for x by auto
  from assms(3,4) obtain Rep_a :: "'ar \<Rightarrow> 'al" and Abs_a :: "'al \<Rightarrow> 'ar"
    where td_a: "type_definition Rep_a Abs_a (Collect (Domainp A))"
      and A_Rep: "A b b' = (b = Rep_a b')" for b b'
    by (blast dest: ex_type_definition)
  from assms(6,7) obtain Rep_b :: "'br \<Rightarrow> 'bl" and Abs_b :: "'bl \<Rightarrow> 'br"
    where td_b: "type_definition Rep_b Abs_b (Collect (Domainp B))"
      and B_Rep: "B b b' = (b = Rep_b b')" for b b'
    by (blast dest: ex_type_definition)
  define f' where f': "f' = (Rep_a ---> Abs_b) f"
  have f_closed: "f (Rep_a a) \<in> \<UU>B" for a
    using td_a td_b by (intro closed') (simp add: assms(2,5))+
  have rep_abs_b: "y \<in> \<UU>B \<Longrightarrow> y = Rep_b (Abs_b y)" for y
    using td_b unfolding type_definition_def by (simp add: assms(5))
  have "(A ===> B) f f'"
    unfolding f' map_fun_apply
    by
      (
        intro rel_funI,
        unfold A_Rep B_Rep,
        elim ssubst,
        intro rep_abs_b f_closed
      )
  then show ?thesis by auto
qed

lemma tts_AB_transfer':
  fixes f' :: "'ar \<Rightarrow> 'br"
    and A :: "'al \<Rightarrow> 'ar \<Rightarrow> bool"
    and B :: "'bl \<Rightarrow> 'br \<Rightarrow> bool"
  assumes
    "Domainp A = (\<lambda>x. x \<in> \<UU>A)" "bi_unique A" "right_total A"
    "Domainp B = (\<lambda>x. x \<in> \<UU>B)" "bi_unique B" "right_total B"
  shows "\<exists>f. (A ===> B) f f'"
proof-
  from assms(2,3) obtain Rep_a :: "'ar \<Rightarrow> 'al" and Abs_a :: "'al \<Rightarrow> 'ar"
    where td_a: "type_definition Rep_a Abs_a (Collect (Domainp A))"
      and A_Rep: "A b b' = (b = Rep_a b')" for b b'
    by (blast dest: ex_type_definition)
  from assms(5,6) obtain Rep_b :: "'br \<Rightarrow> 'bl" and Abs_b :: "'bl \<Rightarrow> 'br"
    where td_b: "type_definition Rep_b Abs_b (Collect (Domainp B))"
      and B_Rep: "B b b' = (b = Rep_b b')" for b b'
    by (blast dest: ex_type_definition)
  define f where f: "f = (Abs_a ---> Rep_b) f'"
  have abs_rep_a: "y = Abs_a (Rep_a y)" for y
    using td_a unfolding type_definition_def by simp
  have "(A ===> B) f f'"
    unfolding f map_fun_apply
    by
      (
        intro rel_funI,
        unfold A_Rep B_Rep,
        elim ssubst,
        fold abs_rep_a,
        intro refl
      )
  then show ?thesis by auto
qed

lemma tts_AB_C_transfer:
  fixes f :: "'al \<Rightarrow> 'bl \<Rightarrow> 'cl"
    and A :: "'al \<Rightarrow> 'ar \<Rightarrow> bool"
    and B :: "'bl \<Rightarrow> 'br \<Rightarrow> bool"
    and C :: "'cl \<Rightarrow> 'cr \<Rightarrow> bool"
  assumes closed: "\<And>a b. \<lbrakk> a \<in> \<UU>A; b \<in> \<UU>B \<rbrakk> \<Longrightarrow> f a b \<in> \<UU>C"
  assumes
    "Domainp A = (\<lambda>x. x \<in> \<UU>A)" "bi_unique A" "right_total A"
    "Domainp B = (\<lambda>x. x \<in> \<UU>B)" "bi_unique B" "right_total B"
    "Domainp C = (\<lambda>x. x \<in> \<UU>C)" "bi_unique C" "right_total C"
  shows "\<exists>rcdt. (A ===> B ===> C) f rcdt"
proof-
  from assms(3,4) obtain Rep_a :: "'ar \<Rightarrow> 'al" and Abs_a :: "'al \<Rightarrow> 'ar"
    where td_a: "type_definition Rep_a Abs_a (Collect (Domainp A))"
      and A_Rep: "A b b' = (b = Rep_a b')" for b b'
    by (blast dest: ex_type_definition)
  from assms(6,7) obtain Rep_b :: "'br \<Rightarrow> 'bl" and Abs_b :: "'bl \<Rightarrow> 'br"
    where td_b: "type_definition Rep_b Abs_b (Collect (Domainp B))"
      and B_Rep: "B b b' = (b = Rep_b b')" for b b'
    by (blast dest: ex_type_definition)
  from assms(9,10) obtain Rep_c :: "'cr \<Rightarrow> 'cl" and Abs_c :: "'cl \<Rightarrow> 'cr"
    where td_c: "type_definition Rep_c Abs_c (Collect (Domainp C))"
      and C_Rep: "C b b' = (b = Rep_c b')" for b b'
    by (blast dest: ex_type_definition)
  define f' where f': "f' = (Rep_a ---> Rep_b ---> Abs_c) f"
  from td_a td_b td_c have f_closed: "f (Rep_a a) (Rep_b b) \<in> \<UU>C" for a b
    by (intro closed; simp_all add: assms(2,5,8))+
  have rep_abs_c: "y \<in> \<UU>C \<Longrightarrow> y = Rep_c (Abs_c y)" for y
    using td_c unfolding type_definition_def by (simp add: assms(8))
  have "(A ===> B ===> C) f f'"
    unfolding f' map_fun_apply
    by
      (
        intro rel_funI,
        unfold A_Rep B_Rep C_Rep,
        elim ssubst,
        intro rep_abs_c f_closed
      )
  then show ?thesis by auto
qed

lemma tts_AA_A_transfer:
  fixes A :: "'a \<Rightarrow> 'b \<Rightarrow> bool" and f :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
  assumes closed: "\<And>a b. \<lbrakk> a \<in> \<UU>; b \<in> \<UU> \<rbrakk> \<Longrightarrow> f a b \<in> \<UU>"
  assumes "Domainp A = (\<lambda>x. x \<in> \<UU>)" "bi_unique A" "right_total A"
  shows "\<exists>rcdt. (A ===> A ===> A) f rcdt"
  using closed
  by (rule tts_AB_C_transfer[OF _ assms(2-4) assms(2-4) assms(2-4)])

lemma tts_AA_eq_transfer:
  fixes A :: "'a \<Rightarrow> 'b \<Rightarrow> bool" and f :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
  assumes "Domainp A = (\<lambda>x. x \<in> \<UU>)" "bi_unique A" "right_total A"
  shows "\<exists>rcdt. (A ===> A ===> (=)) f rcdt"
proof-
  have closed: "f x y \<in> UNIV" for x y by auto
  have dom_eq: "Domainp (=) = (\<lambda>x. x \<in> UNIV)" by auto
  from tts_AB_C_transfer[
      OF _ assms(1-3) assms(1-3) dom_eq bi_unique_eq right_total_eq
      ]
  show ?thesis by auto
qed

lemma Dom_fun_eq_set:
  assumes
    "Domainp A = (\<lambda>x. x \<in> \<UU>A)" "bi_unique A" "right_total A"
    "Domainp B = (\<lambda>x. x \<in> \<UU>B)" "bi_unique B" "right_total B"
  shows "{f. f ` \<UU>A \<subseteq> \<UU>B} = Collect (Domainp (A ===> B))"
proof(standard; (standard, intro CollectI, elim CollectE DomainpE))
  fix x assume "x ` \<UU>A \<subseteq> \<UU>B"
  from tts_AB_transfer[OF this assms] obtain x' where xx':
    "(A ===> B) x x'" by clarsimp
  show "Domainp (A ===> B) x" by standard (rule xx')
next
  fix x b assume "(A ===> B) x b"
  then show "x ` \<UU>A \<subseteq> \<UU>B"
    unfolding
      rel_fun_def
      Domainp_eq_Collect[THEN iffD1, OF assms(1)]
      Domainp_eq_Collect[THEN iffD1, OF assms(4)]
    by auto
qed

lemma Dom_AB_eq_pred:
  assumes
    "Domainp A = (\<lambda>x. x \<in> \<UU>A)" "bi_unique A" "right_total A"
    "Domainp B = (\<lambda>x. x \<in> \<UU>B)" "bi_unique B" "right_total B"
  shows "(Domainp (A ===> B) f) = (f ` \<UU>A \<subseteq> \<UU>B)"
  using Dom_fun_eq_set[OF assms] by blast

end

end


(* Title: Implementation of a trie
   Author: Andreas Lochbihler < andreas dot lochbihler at kit dot edu >
   Author: Peter Gammie < peteg42 at gmail dot com >

A gross simplification of Andreas Lochbihler's code from the Isabelle
Collections Framework: here there is no need for data refinement.

*)

(*<*)
theory Trie imports
  MapOps
  ODList
begin
(*>*)

(* From AssocList2 *)

text {* a more general update for assoc lists that uses the former value to compute the updated value *}

fun
  update_with :: "'val \<Rightarrow> 'key \<Rightarrow> ('val \<Rightarrow> 'val) \<Rightarrow> ('key \<times> 'val) list \<Rightarrow> ('key \<times> 'val) list"
where
  "update_with v k f [] = [(k, f v)]"
| "update_with v k f (p # ps) = (if (fst p = k) then (k, f (snd p)) # ps else p # update_with v k f ps)"

lemma map_of_update_with':
  "map_of (update_with v k f ps) k' = ((map_of ps)(k \<mapsto> (case map_of ps k of None \<Rightarrow> f v | Some v \<Rightarrow> f v))) k'"
  by (induct ps) auto

lemma map_of_update_with:
  "map_of (update_with v k f ps) = (map_of ps)(k \<mapsto> (case map_of ps k of None \<Rightarrow> f v | Some v \<Rightarrow> f v))"
  by (simp add: fun_eq_iff map_of_update_with')

text {* definitions for tries *}

datatype ('key, 'val) trie = Trie "'val option" "('key \<times> ('key, 'val) trie) list"

abbreviation
  trie_empty :: "('key, 'val) trie"
where
  "trie_empty \<equiv> Trie None []"

fun
  is_empty_trie :: "('key, 'val) trie \<Rightarrow> bool"
where
  "is_empty_trie (Trie vo ts) \<longleftrightarrow> vo = None \<and> ts = []"

lemma is_empty_trie_conv:
  "is_empty_trie ts \<longleftrightarrow> ts = trie_empty"
  by (cases ts) (simp)

fun trie_lookup :: "('key, 'val) trie \<Rightarrow> 'key list \<rightharpoonup> 'val"
where
  "trie_lookup (Trie vo _) [] = vo"
| "trie_lookup (Trie _ ts) (k#ks) = (case map_of ts k of None \<Rightarrow> None | Some t \<Rightarrow> trie_lookup t ks)"

fun
  trie_update_with :: "'key list \<Rightarrow> 'val \<Rightarrow> ('val \<Rightarrow> 'val) \<Rightarrow> ('key, 'val) trie \<Rightarrow> ('key, 'val) trie"
where
  "trie_update_with []     v f (Trie vo ts) = Trie (Some (f (case vo of None \<Rightarrow> v | Some v' \<Rightarrow> v'))) ts"
| "trie_update_with (k#ks) v f (Trie vo ts) = Trie vo (update_with trie_empty k (trie_update_with ks v f) ts)"

abbreviation
  trie_update_with' :: "'k list \<Rightarrow> ('k, 'v) trie \<Rightarrow> 'v \<Rightarrow> ('v \<Rightarrow> 'v) \<Rightarrow> ('k, 'v) trie"
where
  "trie_update_with' \<equiv> (\<lambda>k m v f. trie_update_with k v f m)"

definition
  trie_update :: "'key list \<Rightarrow> 'val \<Rightarrow> ('key, 'val) trie \<Rightarrow> ('key, 'val) trie"
where
  "trie_update k v t = trie_update_with k v (\<lambda>v'. v) t"

text {* @{term "trie_lookup"} *}

lemma trie_lookup_empty [simp]:
  "trie_lookup trie_empty ks = None"
  by (cases ks) (simp_all)

lemma trie_lookup_trie_update_with:
  "trie_lookup (trie_update_with ks v f t) ks'
 = (if ks = ks' then Some (f (case trie_lookup t ks of None \<Rightarrow> v | Some v' \<Rightarrow> v')) else trie_lookup t ks')"
proof(induct ks v f t arbitrary: ks' rule: trie_update_with.induct)
  case (1 v f vo ts ks')
  show ?case by (fastforce simp add: neq_Nil_conv dest: not_sym)
next
  case (2 k ks v f vo ts ks')
  note IH = `\<And>t ks'. trie_lookup (trie_update_with ks v f t) ks' = (if ks = ks' then Some (f (case trie_lookup t ks of None \<Rightarrow> v | Some v' \<Rightarrow> v')) else trie_lookup t ks')`
  show ?case by(cases ks')(auto simp add: map_of_update_with IH split: option.split)
qed

lemma trie_lookup_trie_update:
  "trie_lookup (trie_update ks v t) ks' = (if ks = ks' then Some v else trie_lookup t ks')"
  unfolding trie_update_def by (simp add: trie_lookup_trie_update_with)

text{* @{term "MapOps"} *}

definition
  trie_MapOps :: "(('k, 'e) trie, 'k list, 'e) MapOps"
where
  "trie_MapOps \<equiv>
     \<lparr> MapOps.empty = trie_empty,
       lookup = trie_lookup,
       update = trie_update \<rparr>"

lemma trie_MapOps[intro, simp]:
  "inj_on \<alpha> { x . \<alpha> x \<in> d } \<Longrightarrow> MapOps \<alpha> d trie_MapOps"
  apply rule
  unfolding trie_MapOps_def
  apply (auto dest: inj_onD simp add: trie_lookup_trie_update)
  done

definition
  "trie_odlist_lookup = (\<lambda>M. trie_lookup M \<circ> toList)"

definition
  "trie_odlist_update = (\<lambda>k v. trie_update (toList k) v)"

definition
  trie_odlist_update_with :: "('k :: linorder) odlist \<Rightarrow> ('k, 'v) trie \<Rightarrow> 'v \<Rightarrow> ('v \<Rightarrow> 'v) \<Rightarrow> ('k, 'v) trie"
where
  "trie_odlist_update_with = (\<lambda>k m v f. trie_update_with (toList k) v f m)"

definition
  trie_odlist_MapOps :: "(('k, 'e) trie, ('k ::linorder) odlist, 'e) MapOps"
where
  "trie_odlist_MapOps \<equiv>
     \<lparr> MapOps.empty = trie_empty,
       lookup = trie_odlist_lookup,
       update = trie_odlist_update \<rparr>"

lemma trie_odlist_MapOps[intro, simp]:
  "inj_on \<alpha> { x . \<alpha> x \<in> d } \<Longrightarrow> MapOps \<alpha> d trie_odlist_MapOps"
  apply rule
  unfolding trie_odlist_MapOps_def trie_odlist_lookup_def trie_odlist_update_def
  apply (auto dest: inj_onD simp add: trie_lookup_trie_update)
  done

(*<*)
end
(*>*)


(*  Title:       Deterministic Finite Automata
    Authors:     Thomas Tuerk <tuerk@in.tum.de>
                 Petra Dietrich <petra@ecs.vuw.ac.nz>

    using Peter Lammich <peter.lammich@uni-muenster.de> work on
    Finite state machines
*)

section \<open> Deterministic Finite Automata \<close>

theory DFA
imports Main LTS NFA
begin

subsection \<open> Basic Definitions \<close>

lemma dummy_NFA___SemiAutomaton_is_complete_deterministic :
  "SemiAutomaton_is_complete_deterministic (dummy_NFA q a)"
by (simp add: SemiAutomaton_is_complete_deterministic_def LTS_is_complete_deterministic_def
              LTS_is_deterministic_def LTS_is_complete_def dummy_NFA_def)

locale DFA = NFA \ +
             DetFinSemiAutomaton \
  for \::"('q,'a, 'DFA_more) NFA_rec_scheme"

lemma DFA_alt_def : "DFA \ \<longleftrightarrow> NFA \ \<and> SemiAutomaton_is_complete_deterministic \"
  unfolding DFA_def DetFinSemiAutomaton_def DetSemiAutomaton_alt_def FinSemiAutomaton_alt_def NFA_alt_def by metis

lemma DFA_alt_def2 : "DFA \ \<longleftrightarrow> NFA \ \<and> DetFinSemiAutomaton \"
  unfolding DFA_def DetFinSemiAutomaton_alt_def NFA_alt_def by auto

lemma DFA_alt_def3 : "DFA \ \<longleftrightarrow> NFA \ \<and> DetSemiAutomaton \"
  unfolding DFA_def DetFinSemiAutomaton_alt_def NFA_alt_def
            DetSemiAutomaton_alt_def FinSemiAutomaton_def by auto

lemma DFA_implies_NFA[simp] :
  "DFA \ \<Longrightarrow> NFA \" unfolding DFA_alt_def by simp

lemma dummy_NFA___is_DFA :
  "DFA (dummy_NFA q a)"
by (simp add: DFA_alt_def dummy_NFA___is_NFA dummy_NFA___SemiAutomaton_is_complete_deterministic)

lemma (in DFA) \<L>_in_state_\ : "\<L>_in_state \ (\ \) = \<L> \" using \<L>_alt_def by force

subsection \<open> Lemmas about deterministic automata \<close>

lemma (in DFA) DFA_left_languages___pairwise_disjoint :
assumes p_in_Q : "p \<in> \<Q> \"
    and q_in_Q : "q \<in> \<Q> \"
    and p_neq_Q: "p \<noteq> q"
shows "\<L>_left \ p \<inter> \<L>_left \ q = {}"
proof (rule ccontr)
  assume "\<L>_left \ p \<inter> \<L>_left \ q \<noteq> {}"
  then obtain w where "w \<in> \<L>_left \ p" and "w \<in> \<L>_left \ q" by auto
  then have "LTS_is_reachable (\<Delta> \) (\ \) w p" and "LTS_is_reachable (\<Delta> \) (\ \) w q"
    unfolding \<L>_left_def by auto
  with `p \<noteq> q` show "False" by (simp add: DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp)
qed

lemma (in DFA) DFA_accept_alt_def :
  "NFA_accept \ w =
   (case (DLTS_reach (\<delta> \) (\ \) w) of None \<Rightarrow> False | Some q' \<Rightarrow> q' \<in> \<F> \)"
by (simp add: NFA_accept_def Bex_def DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp
         split: option.split)

lemma \<L>_in_state___DFA___eq_reachable_step :
assumes DFA_\: "DFA \"
    and DFA_\': "DFA \'"
    and in_D1: "(q1, \<sigma>, q1') \<in> \<Delta> \"
    and in_D2: "(q2, \<sigma>, q2') \<in> \<Delta> \'"
    and lang_eq : "\<L>_in_state \ q1 = \<L>_in_state \' q2"
shows "\<L>_in_state \ q1' = \<L>_in_state \' q2'"
proof -
  interpret DFA1 : DFA \ by (fact DFA_\)
  interpret DFA2 : DFA \' by (fact DFA_\')

  from DFA1.deterministic_LTS in_D1 have q1'_unique:
     "\<And>q1''. (q1, \<sigma>, q1'') \<in> \<Delta> \ = (q1'' = q1')"
     by (auto simp add: LTS_is_deterministic_def)

  from DFA2.deterministic_LTS in_D2 have q2'_unique:
     "\<And>q2''. (q2, \<sigma>, q2'') \<in> \<Delta> \' = (q2'' = q2')"
     by (auto simp add: LTS_is_deterministic_def)

  from DFA1.\<Delta>_consistent DFA2.\<Delta>_consistent in_D1 in_D2 have
    \<sigma>_in_\<Sigma>: "\<sigma> \<in> (\<Sigma> \ \<inter> \<Sigma> \')" by simp

  from lang_eq
    have "remove_prefix [\<sigma>] (\<L>_in_state \ q1) = remove_prefix [\<sigma>] (\<L>_in_state \' q2)" by simp
  with \<sigma>_in_\<Sigma>
  have "\<Union>{\<L>_in_state \ q' |q'. (q1, \<sigma>, q') \<in> \<Delta> \} =
        \<Union>{\<L>_in_state \' q' |q'. (q2, \<sigma>, q') \<in> \<Delta> \'}"
    by (simp add: \<L>_in_state_remove_prefix)
  with q1'_unique q2'_unique show "\<L>_in_state \ q1' = \<L>_in_state \' q2'" by simp
qed

lemma \<L>_in_state___DFA___eq_DLTS_reachable :
assumes DFA_\: "DFA \"
    and DFA_\': "DFA \'"
    and DLTS_reach_1: "LTS_is_reachable (\<Delta> \) q1 w q1'"
    and DLTS_reach_2: "LTS_is_reachable (\<Delta> \') q2 w q2'"
    and lang_eq : "\<L>_in_state \ q1 = \<L>_in_state \' q2"
shows "\<L>_in_state \ q1' = \<L>_in_state \' q2'"
using DLTS_reach_1 DLTS_reach_2 lang_eq
proof (induct w arbitrary: q1 q2)
  case Nil thus ?thesis by simp
next
  case (Cons \<sigma> w)
  note ind_hyp = Cons (1)
  note DLTS_reach_1 = Cons (2)
  note DLTS_reach_2 = Cons (3)
  note lang_eq = Cons (4)

  from DLTS_reach_1 obtain q1'' where in_D1 : "(q1, \<sigma>, q1'') \<in> (\<Delta> \)" and
                                 DLTS_reach_1' : "LTS_is_reachable (\<Delta> \) q1'' w q1'"
    by auto
  from DLTS_reach_2 obtain q2'' where in_D2 : "(q2, \<sigma>, q2'') \<in> (\<Delta> \')" and
                                 DLTS_reach_2' : "LTS_is_reachable (\<Delta> \') q2'' w q2'"
    by auto

  have lang_eq' : "\<L>_in_state \ q1'' = \<L>_in_state \' q2''"
    by (fact \<L>_in_state___DFA___eq_reachable_step
              [OF DFA_\ DFA_\' in_D1 in_D2 lang_eq])

  note ind_hyp [OF DLTS_reach_1' DLTS_reach_2' lang_eq']
  thus ?thesis by assumption
qed

lemma DFA___inj_rename :
assumes DFA_\: "DFA \"
    and inj_f: "inj_on f (\<Q> \)"
shows "DFA (NFA_rename_states \ f)"
proof -
  interpret det_A: DFA \ by fact

  from NFA_rename_states___is_well_formed[OF det_A.NFA_axioms, of f]
  have nfa: "NFA (NFA_rename_states \ f)" .

  have det: "SemiAutomaton_is_complete_deterministic (NFA_rename_states \ f)"
    unfolding NFA_rename_states_def
    by (simp add: det_A.SemiAutomaton_is_complete_deterministic___inj_rename [OF inj_f])

  from nfa det show ?thesis
    unfolding DFA_alt_def by simp
qed

lemma NFA_isomorphic___is_well_formed_DFA :
assumes wf_A1: "DFA \1"
    and eq_A12: "NFA_isomorphic \1 \2"
shows "DFA \2"
proof -
  from eq_A12 obtain f where
    inj_f: "inj_on f (\<Q> \1)" and
    A2_eq: "\2 = NFA_rename_states \1 f"
    unfolding NFA_isomorphic_def by blast

  from A2_eq DFA___inj_rename [OF wf_A1 inj_f]
  show "DFA \2" by simp
qed

lemma NFA_isomorphic_wf___DFA :
fixes \1 :: "('q1, 'a) NFA_rec" and \2 :: "('q2, 'a) NFA_rec"
assumes iso: "NFA_isomorphic_wf \1 \2"
shows "DFA \1 \<longleftrightarrow> DFA \2"
using assms
by (metis NFA_isomorphic_wf_sym NFA_isomorphic_wf_def NFA_isomorphic___is_well_formed_DFA)

lemma NFA_normalise_states_DFA [simp] :
assumes wf_A: "DFA \"
shows "DFA (NFA_normalise_states \)"
by (metis NFA_isomorphic_wf_normalise_states[unfolded NFA_isomorphic_wf_def]
    NFA_isomorphic___is_well_formed_DFA DFA_alt_def assms)

subsection \<open> Determinisation \<close>

definition determinise_NFA where
  "determinise_NFA \ = SemiAutomaton_to_NFA (powerset_SemiAutomaton \)
     {fs. (fs \<subseteq> (\<Q> \)) \<and> (fs \<inter> \<F> \) \<noteq> {}}"

lemma determinise_NFA_full_def :
  "determinise_NFA \ = \<lparr>\<Q> = {q. q \<subseteq> \<Q> \}, \<Sigma> = \<Sigma> \,
       \<Delta> = {(Q, \<sigma>, {q'. \<exists>q\<in>Q. (q, \<sigma>, q') \<in> \<Delta> \}) |Q \<sigma>.
            Q \<subseteq> \<Q> \ \<and> \<sigma> \<in> \<Sigma> \},
       \ = {\ \}, \<F> = {fs. fs \<subseteq> \<Q> \ \<and> fs \<inter> \<F> \ \<noteq> {}}\<rparr>"
unfolding determinise_NFA_def SemiAutomaton_to_NFA_def powerset_SemiAutomaton_def
by simp

lemma determinise_NFA_\ [simp] : "\ (determinise_NFA \) = {\ \}" by (simp add: determinise_NFA_def)
lemma determinise_NFA_\<Q> [simp] : "(q \<in> \<Q> (determinise_NFA \)) \<longleftrightarrow> q \<subseteq> \<Q> \" by (simp add: determinise_NFA_def)
lemma determinise_NFA_\<Sigma> [simp] : "\<Sigma> (determinise_NFA \) = \<Sigma> \" by (simp add: determinise_NFA_def)
lemma determinise_NFA_\<F> [simp] : "q \<in> \<F> (determinise_NFA \) \<longleftrightarrow> (q \<subseteq> (\<Q> \)) \<and> q \<inter> \<F> \ \<noteq> {}" by (simp add: determinise_NFA_def)

lemma determinise_NFA_\<Delta> [simp] : "Q\<sigma>Q' \<in> \<Delta> (determinise_NFA \) \<longleftrightarrow>
  ((snd (snd Q\<sigma>Q') = {q'. \<exists>q\<in>(fst Q\<sigma>Q'). (q, fst (snd Q\<sigma>Q'), q') \<in> \<Delta> \}) \<and>
   (fst Q\<sigma>Q' \<subseteq> \<Q> \) \<and> ((fst (snd Q\<sigma>Q')) \<in> \<Sigma> \))"
by (cases Q\<sigma>Q', simp add: determinise_NFA_def)

lemma determinise_NFA_is_det :
  "SemiAutomaton_is_deterministic (determinise_NFA \)"
unfolding determinise_NFA_def
by (simp) (rule powerset_SemiAutomaton_is_deterministic)

lemma (in NFA) determinise_NFA_is_complete_determistic :
  "SemiAutomaton_is_complete_deterministic (determinise_NFA \)"
unfolding determinise_NFA_def
by (simp add: powerset_SemiAutomaton_is_complete_determistic)

lemma determinise_NFA___is_well_formed :
  assumes "NFA \"
  shows "NFA (determinise_NFA \)"
proof -
  from assms interpret NFA \ .
  from finite_\<Sigma> have "finite (\<Delta> (powerset_SemiAutomaton \))"
    using powerset_SemiAutomaton__finite_\<Delta>
    by simp
  with assms show ?thesis
    by (auto simp add: NFA_full_def determinise_NFA_def powerset_SemiAutomaton_def)
qed

lemma determinise_NFA___DFA :
  "NFA \ \<Longrightarrow> DFA (determinise_NFA \)"
by (simp add: determinise_NFA___is_well_formed DFA_alt_def
              NFA.determinise_NFA_is_complete_determistic)

lemma (in NFA) determinise_NFA___DLTS_reach :
shows "Q \<subseteq> \<Q> \ \<Longrightarrow>
  DLTS_reach (\<delta> (determinise_NFA \)) Q w =
  (if (w \<in> lists (\<Sigma> \)) then Some {q'. \<exists>q\<in>Q. LTS_is_reachable (\<Delta> \) q w q'} else None)"
unfolding determinise_NFA_def
using powerset_SemiAutomaton___DLTS_reach[of Q w]
by simp

lemma (in NFA) determinise_NFA___LTS_is_reachable :
shows "Q \<subseteq> \<Q> \ \<Longrightarrow>
  LTS_is_reachable (\<Delta> (determinise_NFA \)) Q w Q' \<longleftrightarrow>
  (w \<in> lists (\<Sigma> \)) \<and> Q' = {q'. \<exists>q\<in>Q. LTS_is_reachable (\<Delta> \) q w q'}"
unfolding determinise_NFA_def
using powerset_SemiAutomaton___LTS_is_reachable[of Q w Q']
by simp

lemma (in NFA) determinise_NFA___\<L>_in_state :
  assumes Q_subset: "Q \<subseteq> \<Q> \"
  shows "\<L>_in_state (determinise_NFA \) Q = \<Union> {\<L>_in_state \ q | q. q \<in> Q}"
        (is "?s1 = ?s2")
proof (intro set_eqI)
  fix w
  show "w \<in> ?s1 \<longleftrightarrow> w \<in> ?s2"
  proof -
    interpret DFA_detA: DFA "(determinise_NFA \)" using determinise_NFA___DFA [OF NFA_axioms]
      by assumption

    from LTS_is_reachable___labels[of _ w]
    have in_s1_eq: "w \<in> ?s1 =
      ({q'. \<exists>q\<in>Q. LTS_is_reachable (\<Delta> \) q w q'} \<subseteq> \<Q> \ \<and>
       {q'. \<exists>q\<in>Q. LTS_is_reachable (\<Delta> \) q w q'} \<inter> \<F> \ \<noteq> {})"
      apply (simp add: \<L>_in_state_def DFA_detA.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp)
      apply (auto simp add: determinise_NFA___DLTS_reach Q_subset)
    done

    have in_s1_eq2: "({q'. \<exists>q\<in>Q. LTS_is_reachable (\<Delta> \) q w q'} \<inter> \<F> \ \<noteq> {}) =
                     (\<exists>q q'. q \<in> Q \<and> q' \<in> (\<F> \) \<and> LTS_is_reachable (\<Delta> \) q w q')"
      by auto

    from Q_subset SemiAutomaton_\<Delta>_cons___LTS_is_reachable [where w = w]
    have in_s1_eq1: "{q'. \<exists>q\<in>Q. LTS_is_reachable (\<Delta> \) q w q'} \<subseteq> \<Q> \" by auto

    have in_s2_eq:
    "w \<in> ?s2 = (\<exists>q q'. q \<in> Q \<and> q' \<in> (\<F> \) \<and> LTS_is_reachable (\<Delta> \) q w q')"
      by (auto simp add: \<L>_in_state_def)

    show ?thesis unfolding in_s2_eq in_s1_eq in_s1_eq2
      by (simp add: in_s1_eq1)
  qed
qed

lemma (in NFA) determinise_NFA_\<L> [simp] :
"\<L> (determinise_NFA \) = \<L> \"
proof -
  from \_consistent have "\ \ \<in> \<Q> (determinise_NFA \)" by (simp add: NFA_def)

  thus ?thesis
    by (auto simp add: \<L>_alt_def determinise_NFA___\<L>_in_state)
qed

lemma (in NFA) determinise_NFA_accept [simp] :
  "NFA_accept (determinise_NFA \) w = NFA_accept \ w"
by (simp add: NFA_accept_alt_def)

definition efficient_determinise_NFA where
  "efficient_determinise_NFA \ = NFA_remove_unreachable_states (determinise_NFA \)"

lemma SemiAutomaton_is_complete_deterministic___NFA_remove_unreachable_states :
  "SemiAutomaton_is_complete_deterministic \ \<Longrightarrow>
   SemiAutomaton_is_complete_deterministic (NFA_remove_unreachable_states \)"
using SemiAutomaton_is_complete_deterministic___SemiAutomaton_remove_unreachable_states[of \]
unfolding NFA_remove_unreachable_states_def NFA_remove_states_def
          SemiAutomaton_remove_unreachable_states_def
by simp

lemma DFA___NFA_remove_unreachable_states :
  "DFA \ \<Longrightarrow> DFA (NFA_remove_unreachable_states \)"
unfolding DFA_alt_def
by (metis SemiAutomaton_is_complete_deterministic___NFA_remove_unreachable_states
          NFA_remove_unreachable_states___is_well_formed)

lemma (in NFA) efficient_determinise_SemiAutomaton_is_complete_deterministic :
  "SemiAutomaton_is_complete_deterministic (efficient_determinise_NFA \)"
unfolding efficient_determinise_NFA_def
apply (rule SemiAutomaton_is_complete_deterministic___NFA_remove_unreachable_states)
apply (rule determinise_NFA_is_complete_determistic)
done

lemma efficient_determinise_NFA_is_DFA :
assumes wf_A: "NFA \"
shows "DFA (efficient_determinise_NFA \)"
unfolding DFA_alt_def
proof
  show "SemiAutomaton_is_complete_deterministic (efficient_determinise_NFA \)"
    by (rule NFA.efficient_determinise_SemiAutomaton_is_complete_deterministic[OF wf_A])
next
  show "NFA (efficient_determinise_NFA \)"
    unfolding efficient_determinise_NFA_def
    apply (rule NFA_remove_unreachable_states___is_well_formed)
    apply (rule determinise_NFA___is_well_formed)
    apply (fact wf_A)
  done
qed

lemma efficient_determinise_NFA_\<Sigma> [simp] :
  "\<Sigma> (efficient_determinise_NFA \) = \<Sigma> \"
unfolding efficient_determinise_NFA_def by simp

lemma (in NFA) efficient_determinise_NFA_accept [simp] :
  "NFA_accept (efficient_determinise_NFA \) w = NFA_accept \ w"
unfolding efficient_determinise_NFA_def
by simp

lemma (in NFA) efficient_determinise_NFA_\<L> [simp] :
"\<L> (efficient_determinise_NFA \) = \<L> \"
unfolding efficient_determinise_NFA_def
by simp

lemma efficient_determinise_NFA___is_initially_connected :
  "SemiAutomaton_is_initially_connected (efficient_determinise_NFA \)"
unfolding efficient_determinise_NFA_def
by (simp add: SemiAutomaton_is_initially_connected___NFA_remove_unreachable_states)

lemma efficient_determinise_NFA_already_det :
assumes dfa_A : "DFA \"
    and conn: "SemiAutomaton_is_initially_connected \"
shows "NFA_isomorphic_wf \ (efficient_determinise_NFA \)"
proof -
  from dfa_A have nfa_A: "NFA \"
              and det_A: "SemiAutomaton_is_complete_deterministic \"
              and sa_A: "SemiAutomaton \"
              and dsa_A: "DetSemiAutomaton \"
    unfolding DFA_alt_def NFA_alt_def FinSemiAutomaton_def DetSemiAutomaton_alt_def by simp_all

  interpret det_A': DFA "determinise_NFA \" by (rule determinise_NFA___DFA[OF nfa_A])
  interpret det_A: DFA \ by fact

  have det_trans: "LTS_is_deterministic (\<Delta> (determinise_NFA \))"
    by (metis SemiAutomaton_is_deterministic_def determinise_NFA_is_det)

  let ?f = "\<lambda>q. {q}"
  have inj_f: "\<And>Q. inj_on ?f Q"
    unfolding inj_on_def by simp

  have reachable_states_eq: "SemiAutomaton_reachable_states (determinise_NFA \) = (\<lambda>q. {q}) ` \<Q> \"
    using det_A.determinise_NFA___LTS_is_reachable[of "{\ \}"] det_A.\_is_state
    unfolding det_A'.SemiAutomaton_reachable_states_reachable
              det_A.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp
    apply (simp)
    apply (rule set_eqI)
    apply (simp add: image_iff Bex_def)
    apply (intro iffI)
  proof -
    fix Q'
    assume "\<exists>w. w \<in> lists (\<Sigma> \) \<and>
                Q' = {q'. DLTS_reach (\<delta> \) (\ \) w = Some q'}"
    then obtain w where
      w_in: "w \<in> lists (\<Sigma> \)" and Q'_eq: "Q' = {q'. DLTS_reach (\<delta> \) (\ \) w = Some q'}" by blast

    from det_A CLTS_is_reachable_exists[of "\<Q> \" "\<Sigma> \" "\<Delta> \" w "\ \"] det_A.\_is_state w_in
    obtain q' where reach_w_simp: "DLTS_reach (\<delta> \) (\ \) w = Some q'"
      unfolding SemiAutomaton_is_complete_deterministic_def LTS_is_complete_deterministic_def
                det_A.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp
      by simp blast

    from reach_w_simp have q'_in: "q' \<in> \<Q> \"
      using det_A.DetSemiAutomaton_DLTS_reach_wf[OF det_A.\_is_state, of w q'] by simp

    show "\<exists>q'. q' \<in> \<Q> \ \<and> Q' = {q'}"
      apply (rule exI[where x = q'])
      apply (simp add: Q'_eq reach_w_simp q'_in)
    done
  next
    fix Q'
    assume "\<exists>q'. q' \<in> \<Q> \ \<and> Q' = {q'}"
    then obtain q' where q'_in: "q' \<in> \<Q> \" and Q'_eq: "Q' = {q'}" by blast

    from q'_in conn obtain w where
      reach_w_simp: "DLTS_reach (\<delta> \) (\ \) w = Some q'"
      unfolding SemiAutomaton_is_initially_connected_def SemiAutomaton_unreachable_states_def
              LTS_is_unreachable_def
              det_A.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp
      by auto

    from reach_w_simp have w_in: "w \<in> lists (\<Sigma> \)"
      using det_A.DetSemiAutomaton_DLTS_reach_wf[OF det_A.\_is_state, of w q'] by simp

    show "\<exists>w. w \<in> lists (\<Sigma> \) \<and>
                Q' = {q'. DLTS_reach (\<delta> \) (\ \) w = Some q'}"
      apply (rule exI[where x=w])
      apply (simp add: Q'_eq w_in reach_w_simp)
    done
  qed

  show ?thesis
    unfolding NFA_isomorphic_wf_def  NFA_isomorphic_def
    apply (simp add: nfa_A)
    apply (rule exI[where x = ?f])
    apply (simp add: inj_f efficient_determinise_NFA_def SemiAutomaton_to_NFA_def
      det_A'.NFA_remove_unreachable_states_alt_def2
      det_A'.SemiAutomaton_remove_unreachable_states_alt_def
      NFA_rename_states_full_def reachable_states_eq)
    apply (insert det_A.\<Delta>_consistent det_A.\<F>_consistent)
    apply (intro conjI set_eqI)
    apply (auto simp add: image_iff det_A.\_is_state)
    apply (metis LTS_is_deterministic_def det_A.deterministic_LTS)
  done
qed

lemma NFA_isomorphic_wf___NFA_determinise_cong :
assumes equiv: "NFA_isomorphic_wf \1 \2"
shows "NFA_isomorphic_wf (determinise_NFA \1) (determinise_NFA \2)"
proof -
  from equiv obtain f where inj_f : "inj_on f (\<Q> \1)" and
                            \2_eq: "\2 = NFA_rename_states \1 f" and
                            wf_\1: "NFA \1"
    unfolding NFA_isomorphic_wf_def NFA_isomorphic_def by auto

  obtain F where F_def : "F = (\<lambda>S. f ` S)" by blast

  have F_elim: "\<And>Q1 Q2. \<lbrakk>Q1 \<subseteq> \<Q> \1; Q2 \<subseteq> \<Q> \1\<rbrakk> \<Longrightarrow> (F Q1 = F Q2) \<longleftrightarrow> Q1 = Q2"
  proof -
    fix Q1 Q2
    assume "Q1 \<subseteq> \<Q> \1" "Q2 \<subseteq> \<Q> \1"
    hence "Q1 \<union> Q2 \<subseteq> \<Q> \1" by simp
    with inj_f have "inj_on f (Q1 \<union> Q2)" by (rule subset_inj_on)

    thus "(F Q1 = F Q2) \<longleftrightarrow> Q1 = Q2"
      using inj_on_Un_image_eq_iff [of f Q1 Q2] F_def
      by simp
  qed

  from F_elim have inj_F : "inj_on F (\<Q> (determinise_NFA \1))"
    unfolding determinise_NFA_def inj_on_def
    by simp

  have \2_eq' : "determinise_NFA \2 = NFA_rename_states (determinise_NFA \1) F"
    unfolding determinise_NFA_def \2_eq NFA_rename_states_def SemiAutomaton_rename_states_ext_def
              powerset_SemiAutomaton_def SemiAutomaton_to_NFA_def
    apply simp
  proof (intro conjI)
    show "f ` \ \1 = F (\ \1)" unfolding F_def by simp
  next
    show "{q. q \<subseteq> f ` \<Q> \<A>1} = F ` {q. q \<subseteq> \<Q> \1}"
      apply (rule set_eqI)
      apply (simp add: subset_image_iff F_def image_iff)
    done
  next
    have "\<And>Q. Q \<subseteq> (\<Q> \1) \<Longrightarrow> (f ` Q \<inter> (f ` (\<F> \1)) \<noteq> {}) = (Q \<inter> \<F> \1 \<noteq> {})"
    proof -
      fix Q
      assume Q_sub: "Q \<subseteq> (\<Q> \1)"

      from NFA.\<F>_consistent [OF wf_\1]
      have F_sub: "\<F> \1 \<subseteq> \<Q> \1" .

      from inj_on_image_Int [OF inj_f Q_sub F_sub, symmetric]
      show "(f ` Q \<inter> (f ` (\<F> \1)) \<noteq> {}) = (Q \<inter> \<F> \1 \<noteq> {})"
        by simp
    qed
    thus "{fs. fs \<subseteq> f ` \<Q> \<A>1 \<and> fs \<inter> f ` \<F> \1 \<noteq> {}} = F ` {fs. fs \<subseteq> \<Q> \1 \<and> fs \<inter> \<F> \1 \<noteq> {}}"
      apply (rule_tac set_eqI)
      apply (simp add: subset_image_iff F_def image_iff)
      apply metis
    done
  next
    from inj_f SemiAutomaton.\<Delta>_consistent[of \1] wf_\1
    have lem: "\<And>\<sigma> Q. \<lbrakk>Q \<subseteq> \<Q> \1; \<sigma> \<in> \<Sigma> \1\<rbrakk> \<Longrightarrow>
        {q'. \<exists>q\<in>Q. \<exists>s1 s2. f q = f s1 \<and> q' = f s2 \<and> (s1, \<sigma>, s2) \<in> \<Delta> \1} =
        f ` {q'. \<exists>q\<in>Q. (q, \<sigma>, q') \<in> \<Delta> \1}"
      apply (rule_tac set_eqI)
      apply (simp add: image_iff inj_on_def subset_iff Bex_def NFA_alt_def FinSemiAutomaton_def)
      apply auto
      apply metis
    done

    show "{(Q, \<sigma>, {q'. \<exists>q\<in>Q. \<exists>s1. q = f s1 \<and> (\<exists>s2. q' = f s2 \<and> (s1, \<sigma>, s2) \<in> \<Delta> \1)}) |Q \<sigma>.
     Q \<subseteq> f ` \<Q> \1 \<and> \<sigma> \<in> \<Sigma> \1} =
    {(F s1, a, F {q'. \<exists>q\<in>s1. (q, a, q') \<in> \<Delta> \1}) |s1 a. s1 \<subseteq> \<Q> \1 \<and> a \<in> \<Sigma> \1}"

      apply (rule_tac set_eqI)
      apply (simp add: subset_image_iff F_def image_iff)
      apply (simp del: ex_simps add: ex_simps[symmetric])
      apply auto
        apply (insert lem, auto)
        apply (insert lem[symmetric], auto)
    done
  qed

  from inj_F \2_eq' determinise_NFA___is_well_formed [OF wf_\1]
  show ?thesis
    unfolding NFA_isomorphic_wf_def NFA_isomorphic_def by blast
qed

lemma NFA_isomorphic_efficient_determinise :
assumes equiv: "NFA_isomorphic_wf \1 \2"
shows "NFA_isomorphic_wf (efficient_determinise_NFA \1) (efficient_determinise_NFA \2)"
unfolding efficient_determinise_NFA_def
by (intro NFA_isomorphic_wf___NFA_remove_unreachable_states
          NFA_isomorphic_wf___NFA_determinise_cong equiv)

definition NFA_determinise :: "('q::{automaton_states}, 'a, _) NFA_rec_scheme \<Rightarrow> ('q, 'a) NFA_rec" where
  "NFA_determinise \ = NFA_normalise_states (efficient_determinise_NFA \)"

lemma NFA_determinise_isomorphic_wf :
assumes wf_A: "NFA \"
shows  "NFA_isomorphic_wf (efficient_determinise_NFA \)
                          (NFA_determinise \)"
unfolding NFA_determinise_def
apply (rule NFA_isomorphic_wf_normalise_states)
apply (rule efficient_determinise_NFA_is_DFA [OF wf_A, THEN DFA_implies_NFA])
done

lemma NFA_determinise_already_det :
assumes dfa_A : "DFA \"
    and conn: "SemiAutomaton_is_initially_connected \"
shows "NFA_isomorphic_wf \ (NFA_determinise \)"
using NFA_isomorphic_wf_trans[OF
   efficient_determinise_NFA_already_det[OF dfa_A conn]
   NFA_determinise_isomorphic_wf[of \]] dfa_A
by (simp add: DFA_alt_def)

lemma NFA_determinise_\<Sigma> [simp] :
  "\<Sigma> (NFA_determinise \) = \<Sigma> \"
unfolding NFA_determinise_def by simp

lemma NFA_determinise_is_DFA :
assumes wf_A : "NFA \"
shows "DFA (NFA_determinise \)"
proof -
  note step1 = efficient_determinise_NFA_is_DFA [OF wf_A]
  note step2 = NFA_determinise_isomorphic_wf [OF wf_A]
  note step3 = NFA_isomorphic___is_well_formed_DFA [OF step1 NFA_isomorphic_wf_D(3)[OF step2]]
  thus ?thesis .
qed

lemma NFA_determinise_NFA_accept :
assumes wf_A : "NFA \"
shows  "NFA_accept (NFA_determinise \) w = NFA_accept \ w"
proof -
  note iso = NFA_determinise_isomorphic_wf [OF wf_A]
  from NFA_isomorphic_wf_accept [OF iso] NFA.efficient_determinise_NFA_accept [OF wf_A]
  show ?thesis by auto
qed

lemma NFA_determinise_\<L> :
"NFA \ \<Longrightarrow> \<L> (NFA_determinise \) = \<L> \"
by (simp add: \<L>_def NFA_determinise_NFA_accept)

subsection \<open> Right quotient \<close>

lemma NFA_right_quotient___is_well_formed_DFA :
  "DFA \ \<Longrightarrow> DFA (NFA_right_quotient \ L)"
unfolding DFA_alt_def SemiAutomaton_is_complete_deterministic_def
by (simp add: NFA_right_quotient___is_well_formed)

subsection \<open> Complement \<close>
definition DFA_complement :: "('q, 'a, 'x) NFA_rec_scheme \<Rightarrow> ('q, 'a) NFA_rec" where
  "DFA_complement \ = \<lparr> \<Q> = \<Q> \, \<Sigma> = \<Sigma> \, \<Delta> = \<Delta> \, \ = \ \, \<F> = \<Q> \ - \<F> \ \<rparr>"

lemma [simp] : "\<Q> (DFA_complement \) = \<Q> \" by (simp add: DFA_complement_def)
lemma [simp] : "\<Sigma> (DFA_complement \) = \<Sigma> \" by (simp add: DFA_complement_def)
lemma [simp] : "\<Delta> (DFA_complement \) = \<Delta> \" by (simp add: DFA_complement_def)
lemma [simp] : "\ (DFA_complement \) = \ \" by (simp add: DFA_complement_def)
lemma [simp] : "\<F> (DFA_complement \) = \<Q> \ - \<F> \" by (simp add: DFA_complement_def)

lemma [simp] : "\<delta> (DFA_complement \) = \<delta> \" by (simp add: DFA_complement_def \<delta>_def)
lemma [simp] : "\ (DFA_complement \) = \ \" by (simp add: DFA_complement_def \_def)

lemma DFA_complement_alt_def :
  "DFA_complement \ = SemiAutomaton_to_NFA \ (\<Q> \ - \<F> \)"
unfolding DFA_complement_def SemiAutomaton_to_NFA_def by simp

lemma DFA_complement___is_well_formed : "NFA \ \<Longrightarrow> NFA (DFA_complement \)"
unfolding NFA_full_def by auto

lemma DFA_complement_of_DFA_is_DFA :
  "DFA \ \<Longrightarrow> DFA (DFA_complement \)"
unfolding DFA_alt_def NFA_full_def SemiAutomaton_is_complete_deterministic_def by auto

lemma DFA_complement___DLTS_reach :
  "DLTS_reach (\<delta> (DFA_complement \)) q w = DLTS_reach (\<delta> \) q w" by simp

lemma DFA_complement_DFA_complement [simp] :
  "NFA \ \<Longrightarrow> DFA_complement (DFA_complement \) = \"
proof -
  assume a: "NFA \"
  then have "\<Q> \ - (\<Q> \ - \<F> \) = \<F> \" using NFA.\<F>_consistent by auto
  thus ?thesis unfolding DFA_complement_def by simp
qed

lemma DFA_complement_word :
  assumes wf_A: "DFA \" and w_in_\<Sigma>: "w \<in> lists (\<Sigma> \)"
  shows "NFA_accept (DFA_complement \) w \<longleftrightarrow> \<not> NFA_accept \ w"
proof -
  let ?c\ = "DFA_complement \"

  interpret DFA_A: DFA \ by (fact wf_A)
  interpret DFA_cA: DFA ?c\ by (simp add: DFA_complement_of_DFA_is_DFA wf_A)

  from w_in_\<Sigma> DFA_A.\_is_state
  have "~(DLTS_reach (\<delta> \) (\ \) w = None)"
    by (simp add: DFA_A.DetSemiAutomaton_DLTS_reach_is_some)
  then obtain q' where DLTS_reach_eq_q': "DLTS_reach (\<delta> \) (\ \) w = Some q'" by auto

  from DLTS_reach_eq_q' DFA_A.\_is_state have
   "q' \<in> \<Q> \" by (metis DFA_A.DetSemiAutomaton_DLTS_reach_wf)

  with DLTS_reach_eq_q' show ?thesis
    by (simp add: NFA_accept_def Bex_def w_in_\<Sigma>
           DFA_A.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp
           DFA_cA.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp)
qed

lemma (in DFA) DFA_complement_\<L>___lists_\<Sigma> :
  "\<L> (DFA_complement \) \<subseteq> lists (\<Sigma> \)"
by (simp add: DFA_complement_def \<L>_def NFA_accept_def subset_iff)
   (metis LTS_is_reachable___labels)

lemma (in DFA) DFA_complement_\<L> [simp] :
shows "\<L> (DFA_complement \) = lists (\<Sigma> \) - \<L> \"
proof (intro set_eqI)
  fix w
  show "(w \<in> \<L> (DFA_complement \)) \<longleftrightarrow> w \<in> (lists (\<Sigma> \) - \<L> \)"
  proof (cases "w \<in> lists (\<Sigma> \)")
    case False with DFA_complement_\<L>___lists_\<Sigma> show ?thesis
      by auto
  next
    case True
    note w_in_\<Sigma> = this
    note DFA_complement_w = DFA_complement_word [OF DFA_axioms w_in_\<Sigma>]

    from DFA_complement_w w_in_\<Sigma> show ?thesis by (simp add: \<L>_def)
  qed
qed

lemma NFA_isomorphic_wf___DFA_complement_cong :
assumes equiv: "NFA_isomorphic_wf \1 \2"
shows "NFA_isomorphic_wf (DFA_complement \1) (DFA_complement \2)"
proof -
  from equiv obtain f where inj_f : "inj_on f (\<Q> \1)" and
                 \2_eq: "\2 = NFA_rename_states \1 f" and
                 wf_\1: "NFA \1"
    unfolding NFA_isomorphic_wf_def NFA_isomorphic_def by auto

  with inj_f have inj_f' : "inj_on f (\<Q> (DFA_complement \1))"
    by simp

  have \2_eq': "DFA_complement \2 = NFA_rename_states (DFA_complement \1) f"
    unfolding DFA_complement_def \2_eq
    apply (rule NFA_rec.equality)
    apply (simp_all)
    apply (simp add: NFA_rename_states_def SemiAutomaton_rename_states_ext_def)
    apply (insert inj_on_image_set_diff [of f "\<Q> \1" "\<Q> \1" "\<F> \1"])
    apply (insert NFA.\<F>_consistent[OF wf_\1])
    apply (simp add: inj_f)
  done

  from inj_f' \2_eq' DFA_complement___is_well_formed [OF wf_\1]
  show ?thesis
    unfolding NFA_isomorphic_wf_def NFA_isomorphic_def by blast
qed

subsection \<open> Boolean Combinations of NFAs \<close>

lemma bool_comb_DFA___is_well_formed :
assumes DFA_\1 : "DFA \1"
    and DFA_\2 : "DFA \2"
shows "DFA (bool_comb_NFA f \1 \2)"
proof -
  from DFA_\1 DFA_\2 bool_comb_NFA___is_well_formed [of \1 \2]
  have NFA_ok: "NFA (bool_comb_NFA f \1 \2)"
    unfolding DFA_def by auto

  from DFA_\1 DFA_\2 product_SemiAutomaton___is_well_formed_det[of \1 \2]
  have det_ok: "SemiAutomaton_is_complete_deterministic (bool_comb_NFA f \1 \2)"
    unfolding DFA_alt_def3 by (simp add: bool_comb_NFA_def DetSemiAutomaton_alt_def)

  from NFA_ok det_ok show ?thesis
    unfolding DFA_alt_def by simp
qed

lemma efficient_bool_comb_DFA___is_well_formed :
assumes DFA_\1 : "DFA \1"
    and DFA_\2 : "DFA \2"
shows "DFA (efficient_bool_comb_NFA f \1 \2)"
using bool_comb_DFA___is_well_formed [OF DFA_\1 DFA_\2, of f]
unfolding efficient_bool_comb_NFA_def
by (rule DFA___NFA_remove_unreachable_states)

lemma bool_comb_DFA_NFA_accept :
assumes DFA_\1 : "DFA \1"
    and DFA_\2 : "DFA \2"
shows "NFA_accept (bool_comb_NFA f \1 \2) w =
       (w \<in> lists (\<Sigma> \1) \<inter> lists (\<Sigma> \2) \<and> f (NFA_accept \1 w) (NFA_accept \2 w))"
proof -
  interpret DFA1 : DFA \1 by (fact DFA_\1)
  interpret DFA2 : DFA \2 by (fact DFA_\2)
  interpret DFA12: DFA "(bool_comb_NFA f \1 \2)" by (rule bool_comb_DFA___is_well_formed, fact+)

  show ?thesis
  proof (cases "w \<in> lists (\<Sigma> \1) \<inter> lists (\<Sigma> \2)")
    case False thus ?thesis
      by (simp add: DFA12.NFA_accept_wf_def, auto)
  next
    case True note w_in_lists = this
    then obtain q1 q2 where DLTS_reach_is_some:
      "(DLTS_reach (\<delta> \1) (\ \1) w = Some q1) \<and>
       (DLTS_reach (\<delta> \2) (\ \2) w = Some q2)"
    using DFA1.DetSemiAutomaton_reach_is_none_iff [where w = w and q = "\ \1"]
          DFA2.DetSemiAutomaton_reach_is_none_iff [where w = w and q = "\ \2"]
    by (simp add: DFA1.\_is_state DFA2.\_is_state, auto)

    from DLTS_reach_is_some
      have q12_in_Q: "q1 \<in> \<Q> \1 \<and> q2 \<in> \<Q> \2"
    using DFA1.DetSemiAutomaton_DLTS_reach_wf [where w = w and q = "\ \1" and q' = q1]
          DFA2.DetSemiAutomaton_DLTS_reach_wf [where w = w and q = "\ \2" and q' = q2]
          DFA1.\_is_state DFA2.\_is_state
    by simp

    from q12_in_Q DLTS_reach_is_some w_in_lists show ?thesis
      by (simp add: bool_comb_NFA_def NFA_accept_def
                    LTS_is_reachable_product Bex_def lists_inter
                    DFA1.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp DFA1.\_is_state
                    DFA2.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp DFA2.\_is_state)
  qed
qed

lemma efficient_bool_comb_DFA_accept :
assumes DFA_\1 : "DFA \1"
    and DFA_\2 : "DFA \2"
shows "NFA_accept (efficient_bool_comb_NFA f \1 \2) w =
       (w \<in> lists (\<Sigma> \1) \<inter> lists (\<Sigma> \2) \<and> f (NFA_accept \1 w) (NFA_accept \2 w))"
using assms
unfolding efficient_bool_comb_NFA_def
by (simp add: bool_comb_DFA_NFA_accept)

lemma NFA_bool_comb_DFA___is_well_formed :
assumes DFA_\1 : "DFA \1"
    and DFA_\2 : "DFA \2"
shows "DFA (NFA_bool_comb f \1 \2)"
proof -
  from  DFA_\1 DFA_\2 have NFA_\12: "NFA \1" "NFA \2"
    unfolding DFA_alt_def by simp_all

  note step1 = efficient_bool_comb_DFA___is_well_formed [OF DFA_\1 DFA_\2, of f]
  note iso = NFA_isomorphic_wf_D(3) [OF NFA_bool_comb___isomorphic_wf [OF NFA_\12]]
  note step3 = NFA_isomorphic___is_well_formed_DFA [OF step1 iso]
  thus ?thesis .
qed

lemma NFA_bool_comb_DFA___NFA_accept :
assumes DFA_\1 : "DFA \1"
    and DFA_\2 : "DFA \2"
shows "NFA_accept (NFA_bool_comb f \1 \2) w =
       (w \<in> lists (\<Sigma> \1) \<inter> lists (\<Sigma> \2) \<and> f (NFA_accept \1 w) (NFA_accept \2 w))"
proof -
  from  DFA_\1 DFA_\2 have NFA_\12: "NFA \1" "NFA \2"
    unfolding DFA_alt_def by simp_all

  note step1 = efficient_bool_comb_DFA_accept [OF DFA_\1 DFA_\2, of f]
  note iso = NFA_bool_comb___isomorphic_wf [OF NFA_\12]
  note step2 = NFA_isomorphic_wf_\<L> [OF iso, of f]

  from step1 step2
  show ?thesis by (auto simp add: NFA_accept_alt_def)
qed

subsection \<open> Minimisation \<close>

definition DFA_is_smaller_equiv where
  "DFA_is_smaller_equiv \ \' \<equiv>
   DFA \' \<and> (\<Sigma> \ = \<Sigma> \') \<and> (\<L> \ = \<L> \') \<and> (card (\<Q> \') < card (\<Q> \))"

definition DFA_is_minimal where
  "DFA_is_minimal \ \<equiv> DFA (\::('q, 'a, 'X) NFA_rec_scheme) \<and>
     (\<forall>\'::('q, 'a) NFA_rec. \<not>(DFA_is_smaller_equiv \ \'))"

text \<open> The definition of minimal automata considers only automata that use the same type of states and no extra information.
  This is useful, because otherwise the right hand side would contain type variables that do not occur on the left side of the definition.
  However, the property holds in general. \<close>

lemma NFA_accept_truncate [simp] :
  "NFA_accept (NFA_rec.truncate \) = NFA_accept \"
by (simp add: fun_eq_iff NFA_accept_def NFA_rec.truncate_def)

lemma \<L>_truncate [simp] :
  "\<L> (NFA_rec.truncate \) = \<L> \"
by (simp add: \<L>_def)

lemma NFA_truncate [simp] :
  "NFA (NFA_rec.truncate \) = NFA \"
unfolding NFA_full_def
by (simp add: NFA_rec.truncate_def)

lemma SemiAutomaton_is_complete_deterministic_truncate [simp] :
  "SemiAutomaton_is_complete_deterministic (NFA_rec.truncate \) = SemiAutomaton_is_complete_deterministic \"
unfolding SemiAutomaton_is_complete_deterministic_def
by (simp add: NFA_rec.truncate_def)

lemma SemiAutomaton_is_deterministic_truncate [simp] :
  "SemiAutomaton_is_deterministic (NFA_rec.truncate \) = SemiAutomaton_is_deterministic \"
unfolding SemiAutomaton_is_deterministic_def
by (simp add: NFA_rec.truncate_def)

lemma DFA_truncate [simp] :
  "DFA (NFA_rec.truncate \) = DFA \"
unfolding DFA_alt_def
by simp

lemma DFA_is_smaller_equiv_truncate [simp] : "DFA_is_smaller_equiv \ (NFA_rec.truncate \') \<longleftrightarrow> DFA_is_smaller_equiv \ \'"
unfolding DFA_is_smaller_equiv_def
by (simp, simp add: NFA_rec.truncate_def)

lemma DFA_is_minimal_gen_def :
fixes \:: "('q, 'a, 'X) NFA_rec_scheme"
shows "DFA_is_minimal \ \<longleftrightarrow> DFA \ \<and> (\<forall>\'::('q, 'a, 'X2) NFA_rec_scheme. \<not>(DFA_is_smaller_equiv \ \'))"
unfolding DFA_is_minimal_def
proof (intro iffI allI conjI)
  fix \' :: "('q, 'a, 'X2) NFA_rec_scheme"
  assume "DFA \ \<and> (\<forall>\'::('q, 'a) NFA_rec. \<not>(DFA_is_smaller_equiv \ \'))"
  hence "\<not> DFA_is_smaller_equiv \ (NFA_rec.truncate \')"
    by blast
  thus "\<not> DFA_is_smaller_equiv \ \'" by simp
next
  fix \' :: "('q, 'a) NFA_rec"
  assume "DFA \ \<and>
          (\<forall>\'::('q, 'a, 'X2) NFA_rec_scheme. \<not> DFA_is_smaller_equiv \ \')"
  hence "\<not> DFA_is_smaller_equiv \ (NFA_rec.extend \' (ARB::'X2))"
    by blast
  hence "\<not> DFA_is_smaller_equiv \ (NFA_rec.truncate (NFA_rec.extend \' (ARB::'X2)))" by simp
  hence "\<not> DFA_is_smaller_equiv \ (NFA_rec.truncate \')"
    by (simp add: NFA_rec.defs)
  thus "\<not> DFA_is_smaller_equiv \ \'" by simp
qed simp_all

locale minDFA = DFA \ for \ +
  assumes minimal_DFA: "DFA_is_minimal \"

lemma minDFA_alt_def :
  "minDFA \ = DFA_is_minimal \"
by (simp add: minDFA_def minDFA_axioms_def DFA_is_minimal_def)

lemma (in minDFA) wf_minDFA :
  "minDFA \" by (simp add: minDFA_alt_def minimal_DFA)

lemma (in minDFA) DFA_is_minimal___DLTS_reachable :
  "q \<in> \<Q> \ \<Longrightarrow> q \<notin> SemiAutomaton_unreachable_states \"
proof
  let ?\' = "NFA_remove_unreachable_states \"
  from complete_deterministic_SemiAutomaton have det_A': "SemiAutomaton_is_complete_deterministic ?\'"
    by (simp add: SemiAutomaton_is_complete_deterministic___NFA_remove_unreachable_states)

  have \<Sigma>_A': "\<Sigma> ?\' = \<Sigma> \" by (simp add: NFA_remove_unreachable_states_def)
  have L_A': "\<L> ?\' = \<L> \" by simp
  from NFA_axioms have wf_A': "NFA ?\'" using NFA_remove_states___is_well_formed
    unfolding NFA_remove_unreachable_states_def by metis
  with det_A' have "DFA ?\'" unfolding DFA_alt_def by fast

  assume "q \<in> \<Q> \" "q \<in> SemiAutomaton_unreachable_states \"
  hence "\<Q> ?\' \<subset> \<Q> \" by (auto simp add: NFA_remove_unreachable_states_def)
  hence card_A': "card (\<Q> ?\') < card (\<Q> \)"
    by (metis psubset_card_mono NFA_full_def NFA_axioms)

  from `DFA ?\<A>'` \<Sigma>_A' L_A' card_A'
  have "DFA_is_smaller_equiv \ ?\'"
    unfolding DFA_is_smaller_equiv_def
    by simp
  hence not_min_A: "\<not> DFA_is_minimal \"
    by (metis DFA_is_minimal_def)

  from not_min_A minimal_DFA show "False" by auto
qed

lemma (in minDFA) DFA_is_minimal___initially_connected :
  "SemiAutomaton_is_initially_connected \"
using DFA_is_minimal___DLTS_reachable
unfolding SemiAutomaton_is_initially_connected_def
by auto

lemma (in DFA) SemiAutomaton_is_complete_deterministic___combine_equiv_states :
assumes equiv_f: "NFA_is_strong_equivalence_rename_fun \ f"
shows "SemiAutomaton_is_complete_deterministic (NFA_rename_states \ f)"
proof -
  have comdet_\<Delta>: "LTS_is_complete_deterministic (\<Q> \) (\<Sigma> \) (\<Delta> \)"
    by (simp add: complete_deterministic_LTS)
  hence det_\<Delta>: "LTS_is_deterministic (\<Delta> \)"
    by (simp add: LTS_is_complete_deterministic_def)

  have part1:
   "\<And>q1 q2 q1' q2' \<sigma>.
      \<lbrakk>(q1, \<sigma>, q1') \<in> \<Delta> \; (q2, \<sigma>, q2') \<in> \<Delta> \; f q1 = f q2\<rbrakk> \<Longrightarrow> (f q1' = f q2')"
  proof -
    fix q1 q2 q1' q2' \<sigma>
    assume in_\<Delta>1 : "(q1, \<sigma>, q1') \<in> \<Delta> \"
    assume in_\<Delta>2 : "(q2, \<sigma>, q2') \<in> \<Delta> \"
    assume f_eq : "f q1 = f q2"

    from in_\<Delta>1 in_\<Delta>2 \<Delta>_consistent have "q1 \<in> \<Q> \ \<and> q2 \<in> \<Q> \" by simp
    with f_eq equiv_f have \<L>_eq: "\<L>_in_state \ q1 = \<L>_in_state \ q2"
      by (simp add: NFA_is_strong_equivalence_rename_fun_def)

    have \<L>'_eq: "\<L>_in_state \ q1' = \<L>_in_state \ q2'"
      by (fact \<L>_in_state___DFA___eq_reachable_step [OF DFA_axioms DFA_axioms in_\<Delta>1 in_\<Delta>2 \<L>_eq])

    from in_\<Delta>1 in_\<Delta>2 \<Delta>_consistent have "q1' \<in> \<Q> \ \<and> q2' \<in> \<Q> \" by simp
    with \<L>'_eq equiv_f show f'_eq: "f q1' = f q2'"
      by (simp add: NFA_is_strong_equivalence_rename_fun_def)
  qed

  have part2:
    "\<And>q \<sigma>. \<lbrakk>q \<in> \<Q> \; \<sigma> \<in> \<Sigma> \\<rbrakk> \<Longrightarrow> \<exists>q1 q1'. f q = f q1 \<and> (q1, \<sigma>, q1') \<in> \<Delta> \"
  proof -
    fix q \<sigma>
    assume "q \<in> \<Q> \" "\<sigma> \<in> \<Sigma> \"
    with comdet_\<Delta> obtain q' where q'_intro: "(q, \<sigma>, q') \<in> \<Delta> \"
      by (auto simp add: LTS_is_complete_deterministic_def LTS_is_complete_def)

    from q'_intro show "\<exists>q1 q1'. f q = f q1 \<and> (q1, \<sigma>, q1') \<in> \<Delta> \" by blast
  qed

  show ?thesis
    apply (simp add: SemiAutomaton_is_complete_deterministic_def LTS_is_complete_deterministic_def
                  LTS_is_deterministic_def LTS_is_complete_def Bex_def Ball_def image_iff)
    apply (simp del: all_simps ex_simps add: ex_simps[symmetric] all_simps[symmetric])
    apply (simp)
    apply (rule conjI)
    apply (metis part1)
    apply (metis part2 \<Delta>_consistent)
  done
qed

lemma DFA___combine_equiv_states :
assumes DFA_\: "DFA \"
    and equiv_f: "NFA_is_strong_equivalence_rename_fun \ f"
shows "DFA (NFA_rename_states \ f)"
using DFA_\ DFA.SemiAutomaton_is_complete_deterministic___combine_equiv_states [OF DFA_\ equiv_f]
unfolding DFA_alt_def
by (simp add: NFA_rename_states___is_well_formed)

lemma (in minDFA) \<L>_in_state_inj :
  assumes q: "q \<in> \<Q> \" and q': "q' \<in> \<Q> \" and q_not_q': "q \<noteq> q'"
  shows "\<L>_in_state \ q \<noteq> \<L>_in_state \ q'"
proof
  obtain f where f_is_serf: "NFA_is_strong_equivalence_rename_fun \ (f::'a \<Rightarrow> 'a)"
    using NFA_is_strong_equivalence_rename_fun_exists by metis
  let ?\' = "NFA_rename_states \ f"

  have "DFA ?\'" by
     (fact DFA___combine_equiv_states [OF DFA_axioms f_is_serf])
  moreover
  note \<L>_rename_iff [OF NFA_is_strong_equivalence_rename_fun___weaken [OF f_is_serf]]
  hence "\<L> \ = \<L> ?\'" by simp
  moreover
  assume "\<L>_in_state \ q = \<L>_in_state \ q'"
  with f_is_serf q q' q_not_q' have not_inj: "\<not> inj_on f (\<Q> \)"
    unfolding inj_on_def NFA_is_strong_equivalence_rename_fun_def by auto
  from finite_\<Q> not_inj have not_eq: "card (\<Q> ?\') \<noteq> card (\<Q> \)" using eq_card_imp_inj_on
    unfolding NFA_rename_states_def by auto
  from finite_\<Q> have "card (\<Q> ?\') \<le> card (\<Q> \)"
    using card_image_le unfolding NFA_rename_states_def by auto
  with not_eq have "card (\<Q> ?\') < card (\<Q> \)" by simp
  ultimately have "DFA_is_smaller_equiv \ (NFA_rename_states \ f)"
    unfolding DFA_is_smaller_equiv_def by simp
  hence "\<not> DFA_is_minimal \" by (metis DFA_is_minimal_def)
  with minimal_DFA show "False" by simp
qed

lemma (in DFA) DFA_is_minimal_intro :
  assumes
    connected: "SemiAutomaton_is_initially_connected \" and
    no_equivalant_states: "inj_on (\<L>_in_state \) (\<Q> \)"
  shows "DFA_is_minimal \"
proof (rule ccontr)
  assume "\<not> DFA_is_minimal \"
  then obtain \'::"('q, 'a) NFA_rec" where
    dfa_A': "DFA \'" and
    same_\<Sigma>: "\<Sigma> \ = \<Sigma> \'" and
    same_\<L>: "\<L> \ = \<L> \'" and
    smaller: "card (\<Q> \') < card (\<Q> \)"
    unfolding DFA_is_minimal_def DFA_is_smaller_equiv_def by (auto simp add: DFA_axioms)

  interpret DFA_A' : DFA \' by (fact dfa_A')

  have "\<not> (\<L>_in_state \) ` (\<Q> \<A>) \<subseteq> (\<L>_in_state \<A>') ` (\<Q> \')"
  proof -
    note DFA_A'.finite_\<Q>
    hence fin_L_A': "finite ((\<L>_in_state \') ` (\<Q> \'))" by (metis finite_imageI)
    from `finite (\<Q> \<A>')` have "card ((\<L>_in_state \') ` (\<Q> \')) \<le> card (\<Q> \')" by (metis card_image_le)
    moreover
    from no_equivalant_states have "card ((\<L>_in_state \) ` (\<Q> \)) = card (\<Q> \)" by (metis card_image)
    ultimately
    have "\<not> card ((\<L>_in_state \) ` (\<Q> \<A>)) \<le> card ((\<L>_in_state \<A>') ` (\<Q> \'))" using smaller by simp
    then show ?thesis by (metis card_mono fin_L_A')
  qed
  then obtain q where q_in_Q: "q \<in> \<Q> \ " and
    \<L>_q: "\<L>_in_state \ q \<notin> (\<L>_in_state \') ` (\<Q> \')" by auto
  from q_in_Q connected obtain w where DLTS_reach_\: "LTS_is_reachable (\<Delta> \) (\ \) w q"
    unfolding SemiAutomaton_is_initially_connected_alt_def
    by auto
  hence w_word: "w \<in> lists (\<Sigma> \)" using LTS_is_reachable___labels by fast
  with same_\<Sigma> have "w \<in> lists (\<Sigma> \')" by simp
  hence "\<not>(DLTS_reach (\<delta> \') (\ \') w = None)" unfolding DFA_A'.DetSemiAutomaton_reach_is_none_iff
    by (simp add: DFA_A'.\_is_state)
  then obtain q' where DLTS_reach_\': "LTS_is_reachable (\<Delta> \') (\ \') w q'"
    by (auto simp add: DFA_A'.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp)
  hence "q' \<in> \<Q> \'"
    using DFA_A'.SemiAutomaton_\<Delta>_cons___LTS_is_reachable DFA_A'.\_is_state
    by simp
  with \<L>_q have \<L>_q_q'_neq: "\<L>_in_state \' q' \<noteq> \<L>_in_state \ q" by blast
  show "False"
    using same_\<L> \<L>_q_q'_neq \<L>_in_state_\ DFA_A'.\<L>_in_state_\
         \<L>_in_state___DFA___eq_DLTS_reachable [OF DFA_axioms dfa_A'
            DLTS_reach_\ DLTS_reach_\']
    by simp
qed

theorem (in DFA) DFA_is_minimal_alt_def :
  "DFA_is_minimal \ \<longleftrightarrow>
    (SemiAutomaton_is_initially_connected \ \<and>
     inj_on (\<L>_in_state \) (\<Q> \))"
   (is "_ = (?P1 \<and> ?P2)")
proof
  assume "DFA_is_minimal \"
  then interpret minDFA_A: minDFA \ by (simp add: minDFA_alt_def)

  show "?P1 \<and> ?P2"
  proof
    show ?P1 by (auto simp add: minDFA_A.DFA_is_minimal___initially_connected)
  next
    show ?P2 by (auto simp add: inj_on_def, metis minDFA_A.\<L>_in_state_inj)
  qed
next
  assume "?P1 \<and> ?P2"
  with DFA_axioms show "DFA_is_minimal \"
    by (simp add: DFA_is_minimal_intro)
qed

lemma DFA_is_minimal_alt_DFA_def :
  "DFA_is_minimal \ \<longleftrightarrow>
    (DFA \ \<and> SemiAutomaton_is_initially_connected \ \<and>
     inj_on (\<L>_in_state \) (\<Q> \))"
   (is "_ = (?P1 \<and> ?P2)")
apply (cases "DFA \")
  apply (simp add: DFA.DFA_is_minimal_alt_def)
apply (simp add: DFA_is_minimal_def)
done

lemma NFA_isomorphic___DFA_is_minimal :
fixes \1 :: "('q1, 'a, 'X) NFA_rec_scheme"
fixes \2 :: "('q2, 'a) NFA_rec"
assumes eq_A12: "NFA_isomorphic \1 \2"
    and min_A1: "DFA_is_minimal \1"
shows "DFA_is_minimal \2"
proof (rule ccontr)
  assume not_min_A2: "\<not>(DFA_is_minimal \2)"

  from eq_A12 obtain f where
    inj_f: "inj_on f (\<Q> \1)" and
    A2_eq: "\2 = NFA_rename_states \1 f"
    unfolding NFA_isomorphic_def by blast

  from min_A1 have wf_A1: "DFA \1"
    unfolding DFA_is_minimal_def by fast

  from NFA_isomorphic___is_well_formed_DFA [OF wf_A1 eq_A12]
  have wf_A2: "DFA \2" .

  from not_min_A2 obtain \2' :: "('q2, 'a) NFA_rec"
    where A2'_smaller: "DFA_is_smaller_equiv \2 \2'"
    by (auto simp add: DFA_is_minimal_def wf_A2)

  have wf_A2': "DFA \2'"
    using A2'_smaller
    unfolding DFA_is_smaller_equiv_def by simp

  have fin_QA2' : "finite (\<Q> \2')"
    using wf_A2' [unfolded DFA_alt_def NFA_alt_def] FinSemiAutomaton.finite_\<Q>
    by blast
  have fin_QA1 : "finite (\<Q> \1)"
    using wf_A1 [unfolded DFA_alt_def NFA_alt_def] FinSemiAutomaton.finite_\<Q>
    by blast

  from A2'_smaller have "card (\<Q> \2') < card (\<Q> \2)"
    unfolding DFA_is_smaller_equiv_def by fast
  hence "card (\<Q> \2') < card (\<Q> \1)"
    unfolding A2_eq
    by (simp add: inj_f card_image)
  then obtain f' :: "'q2 \<Rightarrow> 'q1" where inj_f': "inj_on f' (\<Q> \2')"
    using inj_on_iff_card_le [OF fin_QA2' fin_QA1]
    by auto

  have equiv_f': "NFA_is_equivalence_rename_fun \2' f'"
    using inj_f'
    unfolding NFA_is_equivalence_rename_fun_def inj_on_def
    by auto

  have equiv_f: "NFA_is_equivalence_rename_fun \1 f"
    using inj_f
    unfolding NFA_is_equivalence_rename_fun_def inj_on_def
    by auto

  from A2'_smaller wf_A1 have
    A1_smaller: "DFA_is_smaller_equiv \1 (NFA_rename_states \2' f')"
    unfolding DFA_is_smaller_equiv_def A2_eq
    apply (simp add: inj_f inj_f' card_image DFA___inj_rename)
    apply (simp add: DFA_alt_def equiv_f' NFA.\<L>_rename_iff equiv_f)
  done

  from A1_smaller have "\<not>(DFA_is_minimal \1)"
    unfolding DFA_is_minimal_def by auto
  with min_A1 show "False" by fast
qed

lemma DFA_is_minimal___equiv_states_injection_exists :
fixes \1 :: "('q1, 'a, 'X1) NFA_rec_scheme"
fixes \2 :: "('q2, 'a, 'X2) NFA_rec_scheme"
assumes L_eq: "\<L> \1 = \<L> \2"
    and \<Sigma>_eq: "\<Sigma> \1 = \<Sigma> \2"
    and min_A1: "DFA_is_minimal \1"
    and min_A2: "DFA_is_minimal \2"
shows "\<exists>f. inj_on f (\<Q> \1) \<and>
           (\<forall>q\<in>\<Q> \1. (f q) \<in> \<Q> \2 \<and> \<L>_in_state \2 (f q) = \<L>_in_state \1 q)"
proof -
  from min_A1 have wf_A1: "DFA \1"
    by (simp add: DFA_is_minimal_alt_DFA_def)
  from min_A2 have wf_A2: "DFA \2"
    by (simp add: DFA_is_minimal_alt_DFA_def)

  interpret DFA1 : DFA \1 by (fact wf_A1)
  interpret DFA2 : DFA \2 by (fact wf_A2)

  let ?states_equiv = "\<lambda>q1 q2. q2 \<in> \<Q> \2 \<and> \<L>_in_state \2 q2 = \<L>_in_state \1 q1"
  have "\<forall>q1 \<in> \<Q> \1. \<exists>q2. ?states_equiv q1 q2"
  proof
    fix q1
    assume q1_in: "q1 \<in> \<Q> \1"

    from min_A1 have "SemiAutomaton_is_initially_connected \1" by (simp add: DFA_is_minimal_alt_DFA_def)
    then obtain w where DLTS_reach_q1: "LTS_is_reachable (\<Delta> \1) (\ \1) w q1"
      unfolding SemiAutomaton_is_initially_connected_alt_def
      using q1_in by auto

    from DFA1.LTS_is_reachable___labels[OF DLTS_reach_q1]
    have w_in_\<Sigma>1: "w \<in> lists (\<Sigma> \1)" by simp
    from  w_in_\<Sigma>1 \<Sigma>_eq have w_in_\<Sigma>2: "w \<in> lists (\<Sigma> \2)" by fast

    from DFA2.DetSemiAutomaton_DLTS_reach_is_some [OF DFA2.\_is_state w_in_\<Sigma>2]
    obtain q2 where "DLTS_reach (\<delta> \2) (\ \2) w = Some q2" by auto
    hence DLTS_reach_q2: "LTS_is_reachable (\<Delta> \2) (\ \2) w q2"
      by (simp add: DFA2.DetSemiAutomaton_LTS_is_reachable_DLTS_reach_simp)

    from DFA2.SemiAutomaton_\<Delta>_cons___LTS_is_reachable [OF DLTS_reach_q2]
    have q2_in: "q2 \<in> \<Q> \2" by (simp add: DFA2.\_is_state)

    from L_eq have initial_equiv: "\<L>_in_state \1 (\ \1) = \<L>_in_state \2 (\ \2)"
      unfolding \<L>_alt_def by simp

    from \<L>_in_state___DFA___eq_DLTS_reachable [OF wf_A1 wf_A2 DLTS_reach_q1 DLTS_reach_q2 initial_equiv]
    have q12_equiv: "\<L>_in_state \1 q1 = \<L>_in_state \2 q2" .

    from q12_equiv q2_in show "\<exists>q2. ?states_equiv q1 q2" by blast
  qed
  from bchoice[OF this] obtain f where "\<forall>x\<in>\<Q> \1. f x \<in> \<Q> \2 \<and> \<L>_right \2 (f x) = \<L>_right \1 x" .. note f_prop = this

  have inj_f : "inj_on f (\<Q> \1)"
  unfolding inj_on_def
  proof (intro ballI impI)
    fix q q'
    assume q1_in: "q \<in> \<Q> \1"
       and q2_in: "q' \<in> \<Q> \1"
       and f_qq'_eq: "f q = f q'"
    with f_prop have L_qq'_eq: "\<L>_in_state \1 q = \<L>_in_state \1 q'" by metis

    from q1_in q2_in L_qq'_eq min_A1
    show "q = q'"
      unfolding DFA_is_minimal_alt_DFA_def inj_on_def
      by simp
  qed

  from f_prop inj_f show ?thesis by blast
qed

lemma DFA_is_minimal___equiv_states_bijection_exists :
fixes \1 :: "('q1, 'a, 'X1) NFA_rec_scheme"
fixes \2 :: "('q2, 'a, 'X2) NFA_rec_scheme"
assumes L_eq: "\<L> \1 = \<L> \2"
    and \<Sigma>_eq: "\<Sigma> \1 = \<Sigma> \2"
    and min_A1: "DFA_is_minimal \1"
    and min_A2: "DFA_is_minimal \2"
shows "\<exists>f. bij_betw f (\<Q> \1) (\<Q> \2) \<and>
           (\<forall>q\<in>\<Q> \1. \<L>_in_state \2 (f q) = \<L>_in_state \1 q)"
proof -
  from DFA_is_minimal___equiv_states_injection_exists
    [OF L_eq \<Sigma>_eq min_A1 min_A2]
  obtain f1 where "inj_on f1 (\<Q> \1) \<and> (\<forall>q\<in>\<Q> \1. f1 q \<in> \<Q> \2 \<and> \<L>_right \2 (f1 q) = \<L>_right \1 q)" .. note f1_props = this

  from DFA_is_minimal___equiv_states_injection_exists
    [OF L_eq[symmetric] \<Sigma>_eq[symmetric] min_A2 min_A1]
  obtain f2 where "inj_on f2 (\<Q> \2) \<and> (\<forall>q\<in>\<Q> \2. f2 q \<in> \<Q> \1 \<and> \<L>_right \1 (f2 q) = \<L>_right \2 q)" .. note f2_props = this

  have A2_eq: "f1 ` \<Q> \1 = \<Q> \2"
  proof
    from f1_props show "f1 ` \<Q> \1 \<subseteq> \<Q> \2" by auto
  next
    show "\<Q> \2 \<subseteq> f1 ` \<Q> \1"
    proof
      fix q2
      assume q2_in: "q2 \<in> \<Q> \2"
      let ?q1 = "f2 q2"
      let ?q2' = "f1 ?q1"

      from q2_in f2_props
      have q1_in: "?q1 \<in> \<Q> \1" and
           q1_q2_equiv: "\<L>_in_state \1 ?q1 = \<L>_in_state \2 q2"
        by simp_all

      from f1_props q1_in
      have q2'_in: "?q2' \<in> \<Q> \2" and
           q2'_q1_equiv: "\<L>_in_state \2 ?q2' = \<L>_in_state \1 ?q1"
        by simp_all

      from q1_q2_equiv q2'_q1_equiv have
        q2_q2'_equiv: "\<L>_in_state \2 ?q2' = \<L>_in_state \2 q2"
        by simp

      from min_A2 q2_in q2'_in q2_q2'_equiv
      have q2'_eq: "?q2' = q2"
        unfolding DFA_is_minimal_alt_DFA_def inj_on_def by simp

      from q2'_eq q1_in show "q2 \<in> f1 ` \<Q> \1"
        by (simp add: image_iff) metis
    qed
  qed
  from f1_props A2_eq show ?thesis
    apply (rule_tac exI [where x = f1])
    apply (simp add: bij_betw_def)
  done
qed

lemma DFA_is_minimal___isomorph_wf :
fixes \1 :: "('q1, 'a, 'X) NFA_rec_scheme"
fixes \2 :: "('q2, 'a) NFA_rec"
assumes min_A1: "DFA_is_minimal \1"
    and min_A2: "DFA_is_minimal \2"
    and L_eq: "\<L> \1 = \<L> \2"
    and \<Sigma>_eq: "\<Sigma> \1 = \<Sigma> \2"
shows "NFA_isomorphic_wf \1 \2"
proof -
  from min_A1 have wf_A1: "DFA \1"
    by (simp add: DFA_is_minimal_alt_DFA_def)
  from min_A2 have wf_A2: "DFA \2"
    by (simp add: DFA_is_minimal_alt_DFA_def)

  interpret DFA1 : DFA \1 by (fact wf_A1)
  interpret DFA2 : DFA \2 by (fact wf_A2)

  from DFA_is_minimal___equiv_states_bijection_exists
    [OF L_eq \<Sigma>_eq min_A1 min_A2]
  obtain f where "bij_betw f (\<Q> \1) (\<Q> \2) \<and> (\<forall>q\<in>\<Q> \1. \<L>_right \2 (f q) = \<L>_right \1 q)" .. note f_props = this
  hence bij_f: "bij_betw f (\<Q> \1) (\<Q> \2)"
    and f_equiv: "\<And>q1. q1\<in>\<Q> \1 \<Longrightarrow> \<L>_in_state \2 (f q1) = \<L>_in_state \1 q1"
    by simp_all

  from bij_f have f_is_state: "\<And>q1. q1\<in>\<Q> \1 \<Longrightarrow> f q1 \<in> \<Q> \2"
     unfolding bij_betw_def by auto

  from bij_f have inj_f: "inj_on f (\<Q> \1)"
     unfolding bij_betw_def by fast

  have A2_eq: "\2 = NFA_rename_states \1 f"
  unfolding NFA_rename_states_def SemiAutomaton_rename_states_ext_def
  proof (intro NFA_rec.equality, simp_all)
    show "\<Sigma> \2 = \<Sigma> \1" by (simp add: \<Sigma>_eq)
  next
    show "\<Q> \2 = f ` \<Q> \1"
      using bij_f unfolding bij_betw_def
      by simp
  next
    from f_equiv [OF DFA1.\_is_state] L_eq
    have "\<L>_in_state \2 (f (\ \1)) = \<L>_in_state \2 (\ \2)"
      unfolding \<L>_alt_def by simp
    with min_A2 DFA2.\_is_state f_is_state [OF DFA1.\_is_state]
    show "\ \2 = f (\ \1)"
      unfolding DFA_is_minimal_alt_DFA_def inj_on_def
      by simp
  next
    show "\<F> \2 = f ` \<F> \1"
    proof (intro set_eqI iffI)
      fix q2
      assume "q2 \<in> f ` (\<F> \1)"
      then obtain q1 where q1_in_F: "q1 \<in> \<F> \1" and
                           q2_eq: "q2 = f q1" by auto

      from DFA1.\<F>_consistent q1_in_F
      have q1_in_Q: "q1 \<in> \<Q> \1" by blast

      from f_equiv[OF q1_in_Q] q2_eq q1_in_F
      show "q2 \<in> \<F> \2"
      by (simp add: in_\<L>_in_state_Nil [symmetric]
               del: in_\<L>_in_state_Nil)
    next
      fix q2
      assume q2_in_F: "q2 \<in> \<F> \2"

      from DFA2.\<F>_consistent q2_in_F
      have q2_in_Q: "q2 \<in> \<Q> \2" by blast

      with bij_f obtain q1 where q1_in_Q: "q1 \<in> \<Q> \1" and
                        q2_eq: "q2 = f q1"
        unfolding bij_betw_def
        by auto

      from f_equiv[OF q1_in_Q] q2_eq q2_in_F
      have q1_in_F: "q1 \<in> \<F> \1"
        by (simp add: in_\<L>_in_state_Nil [symmetric]
                 del: in_\<L>_in_state_Nil)

      show "q2 \<in> f ` (\<F> \1)"
        unfolding q2_eq
        using q1_in_F
        by auto
    qed
  next
    show "\<Delta> \2 = {(f s1, a, f s2) |s1 a s2. (s1, a, s2) \<in> \<Delta> \1}"
    proof (intro set_eqI)
      fix q2aq2' :: "'q2 \<times> 'a \<times> 'q2"
      obtain q2 a q2' where q2aq2'_eq [simp]: "q2aq2' = (q2, a, q2')"
        by (cases q2aq2', blast)

      show "q2aq2' \<in> \<Delta> \2 \<longleftrightarrow> q2aq2' \<in> {(f s1, a, f s2) |s1 a s2. (s1, a, s2) \<in> \<Delta> \1}"
      proof (cases "q2 \<in> \<Q> \2 \<and> a \<in> \<Sigma> \2 \<and> q2' \<in> \<Q> \2")
        case False note q2aq2'_not_wf = this

        from q2aq2'_not_wf have q2aq2'_nin_ls: "q2aq2' \<notin> \<Delta> \2"
          using DFA2.\<Delta>_consistent
          by auto

        have q2aq2'_nin_rs: "q2aq2' \<notin> {(f s1, a, f s2) |s1 a s2. (s1, a, s2) \<in> \<Delta> \1}"
        proof (rule notI)
           assume "q2aq2' \<in> {(f s1, a, f s2) |s1 a s2. (s1, a, s2) \<in> \<Delta> \1}"
           then obtain q1 q1' where
              q2_eq:  "q2 = f q1" and
              q2'_eq: "q2' = f q1'" and
              q1aq1'_in: "(q1, a, q1') \<in> \<Delta> \1"
              by auto
           with DFA1.\<Delta>_consistent f_is_state q2aq2'_not_wf \<Sigma>_eq
           show "False" by metis
        qed
        from q2aq2'_nin_rs q2aq2'_nin_ls show ?thesis by simp
      next
        case True
        hence q2_in: "q2 \<in> \<Q> \2"
          and a_in2: "a \<in> \<Sigma> \2"
          and q2'_in: "q2' \<in> \<Q> \2"
        by simp_all
        from a_in2 \<Sigma>_eq have a_in1: "a \<in> \<Sigma> \1" by fast

        from bij_f q2_in
          obtain q1 where q1_in: "q1 \<in> \<Q> \1"
                      and q2_eq: "q2 = f q1"
          unfolding bij_betw_def by auto

        from DFA1.DetSemiAutomaton_\<delta>_is_some [OF q1_in a_in1]
        obtain q1'' where \<delta>_q1a: "(\<delta> \1) (q1, a) = Some q1''" by auto
        from DFA1.\<delta>_wf[OF \<delta>_q1a] have q1''_in: "q1'' \<in> \<Q> \1" by fast

        from DFA2.DetSemiAutomaton_\<delta>_is_some [OF q2_in a_in2]
        obtain q2'' where \<delta>_q2a: "(\<delta> \2) (q2, a) = Some q2''" by auto
        from DFA2.\<delta>_wf[OF \<delta>_q2a] have q2''_in: "q2'' \<in> \<Q> \2" by fast

        from \<L>_in_state___DFA___eq_reachable_step [OF wf_A1 wf_A2,
           of q1 a q1'' q2 q2'']  \<delta>_q1a  \<delta>_q2a f_equiv[OF q1_in]
        have q1''_q2''_equiv: "\<L>_in_state \1 q1'' = \<L>_in_state \2 q2''"
          by (simp add: q2_eq DFA1.\<delta>_in_\<Delta>_iff [symmetric]
                        DFA2.\<delta>_in_\<Delta>_iff [symmetric])

        from q1''_q2''_equiv f_equiv[OF q1''_in]
        have "\<L>_in_state \2 q2'' = \<L>_in_state \2 (f q1'')" by simp
        hence q2''_eq: "q2'' = f q1''"
          using min_A2 q2''_in f_is_state[OF q1''_in]
          unfolding DFA_is_minimal_alt_DFA_def inj_on_def
          by simp

        from DFA1.\<delta>_wf inj_f \<delta>_q1a
        have q2aq2'_in_rs_eq: "q2aq2' \<in> {(f s1, a, f s2) |s1 a s2. (s1, a, s2) \<in> \<Delta> \1} \<longleftrightarrow> q2' = f q1''"
           unfolding inj_on_def
           by (simp add: q2_eq DFA1.\<delta>_in_\<Delta>_iff)
              (metis option.inject)
        show ?thesis
          unfolding q2aq2'_in_rs_eq
          by (simp add: q2''_eq DFA2.\<delta>_in_\<Delta>_iff \<delta>_q2a) blast
      qed
    qed
  qed

  from wf_A1 inj_f A2_eq
  show ?thesis
    unfolding NFA_isomorphic_wf_def NFA_isomorphic_def
    apply (simp add: DFA_alt_def)
    apply (rule exI [where x = f])
    apply simp
  done
qed

subsection\<open> Brzozowski's Algorithm \<close>

text \<open> Brzozowski's algorithm for minimisation applies powerset
  construction to the reverse and repeats this to obtain a minimal automaton. \<close>

definition Brzozowski_halfway
where "Brzozowski_halfway \ \<equiv> efficient_determinise_NFA (NFA_reverse \)"

definition Brzozowski
where "Brzozowski \ \<equiv> Brzozowski_halfway (Brzozowski_halfway \)"

lemma Brzozowski_halfway___well_formed :
  "NFA \ \<Longrightarrow> NFA (Brzozowski_halfway \)"
unfolding Brzozowski_halfway_def efficient_determinise_NFA_def
by (metis determinise_NFA___is_well_formed NFA_reverse___is_well_formed
          NFA_remove_unreachable_states___is_well_formed)

lemma Brzozowski___well_formed :
  "NFA \ \<Longrightarrow> NFA (Brzozowski \)"
unfolding Brzozowski_def
by (metis Brzozowski_halfway___well_formed)

lemma Brzozowski_\<Sigma> [simp] :
  "\<Sigma> (Brzozowski \) = \<Sigma> \"
unfolding Brzozowski_def Brzozowski_halfway_def efficient_determinise_NFA_def
by simp

lemma Brzozowski_halfway_yields_DFA :
  assumes "NFA \"
  shows "DFA (Brzozowski_halfway \)"
unfolding DFA_alt_def
using assms
by (simp add: Brzozowski_halfway___well_formed,
    simp add: SemiAutomaton_is_complete_deterministic___NFA_remove_unreachable_states
              efficient_determinise_NFA_def
              Brzozowski_halfway_def NFA_reverse___is_well_formed
              NFA.determinise_NFA_is_complete_determistic)

lemma Brzozowski_yields_DFA :
  assumes "NFA \"
  shows "DFA (Brzozowski \)"
unfolding Brzozowski_def
using assms
by (metis DFA_alt_def Brzozowski_halfway_yields_DFA)

lemma (in NFA) Brzozowski_halfway___\<L> :
  shows "\<L> (Brzozowski_halfway \) = {rev w |w. w \<in> \<L> \}"
using NFA_reverse___\<L> NFA.determinise_NFA_\<L> [OF NFA_reverse___is_well_formed [OF NFA_axioms]]
by (simp add: Brzozowski_halfway_def efficient_determinise_NFA_def)

text \<open> Finally we show that Brzozowski's algorithm preserves the language of the automaton. \<close>

theorem (in NFA) Brzozowski___\<L> :
  "\<L> (Brzozowski \) = \<L> \"
unfolding Brzozowski_def
using Brzozowski_halfway___\<L>
using NFA.Brzozowski_halfway___\<L> [OF Brzozowski_halfway___well_formed [OF NFA_axioms]]
by (simp add: set_eq_iff del: ex_simps add: ex_simps[symmetric])

theorem (in NFA) Brzozowski___NFA_accept :
  "NFA_accept (Brzozowski \) w = NFA_accept \ w"
using Brzozowski___\<L>
by (simp add: \<L>_def set_eq_iff)

lemma (in DFA) Brzozowski_halfway___minimal :
assumes connected: "SemiAutomaton_is_initially_connected \"
shows "DFA_is_minimal (Brzozowski_halfway \)"
proof -
  let ?BH = "Brzozowski_halfway \"
  interpret DFA_BH: DFA ?BH
    using Brzozowski_halfway_yields_DFA [OF NFA_axioms] .

  show "DFA_is_minimal ?BH"
  proof (rule DFA_BH.DFA_is_minimal_intro)
    show "SemiAutomaton_is_initially_connected ?BH"
      by (simp add: Brzozowski_halfway_def efficient_determinise_NFA_def
                    SemiAutomaton_is_initially_connected___NFA_remove_unreachable_states)
  next
    let ?DR = "determinise_NFA (NFA_reverse \)"

    have wf_reverse_A: "NFA (NFA_reverse \)"
      using NFA_reverse___is_well_formed [OF NFA_axioms] .

    have "\<And>Q1 Q2. \<lbrakk>Q1 \<in> \<Q> ?DR; Q2 \<in> \<Q> ?DR;
                   \<L>_in_state ?DR Q1 = \<L>_in_state ?DR Q2\<rbrakk> \<Longrightarrow> (Q1 = Q2)"
    proof -
      fix Q1 Q2
      assume "Q1 \<in> \<Q> ?DR" hence Q1_Q : "Q1 \<subseteq> \<Q> \" by simp
      assume "Q2 \<in> \<Q> ?DR" hence Q2_Q : "Q2 \<subseteq> \<Q> \" by simp
      assume \<L>_eq : "\<L>_in_state ?DR Q1 = \<L>_in_state ?DR Q2"

      have \<L>_left_not_empty :
        "\<And>q. q \<in> Q1 \<union> Q2 \<Longrightarrow> \<exists>w. w \<in> \<L>_left \ q"
      proof -
        fix q
        assume "q \<in> Q1 \<union> Q2"
        with Q1_Q Q2_Q have "q \<in> \<Q> \" by auto
        with connected have "q \<notin> SemiAutomaton_unreachable_states \" unfolding SemiAutomaton_is_initially_connected_def by auto
        hence "\<L>_left \ q \<noteq> {}" by (simp add: NFA_unreachable_states_alt_def)
        thus "\<exists>w. w \<in> \<L>_left \ q"
          by (metis ex_in_conv)
      qed

      note DFA_left_languages___pairwise_disjoint
      with Q1_Q Q2_Q have \<L>_left_unique: "\<And>q1 q2 w. \<lbrakk>q1 \<in> Q1; q2 \<in> Q2;
           w \<in> \<L>_left \ q1; w \<in> \<L>_left \ q2\<rbrakk> \<Longrightarrow> (q1 = q2)"
        by (simp add: set_eq_iff subset_iff, metis)

      obtain QQ where QQ_def: "QQ = (\<lambda>Q. \<Union>{{rev w |w. w \<in> \<L>_left \ q} |q. q \<in> Q})" by auto
      have QQ_in: "\<And>w Q. rev w \<in> QQ Q = (\<exists>q \<in> Q. w \<in> \<L>_left \ q)"
        by (auto simp add: QQ_def)

      note NFA.determinise_NFA___\<L>_in_state [OF wf_reverse_A]
      with Q1_Q Q2_Q \<L>_eq have "QQ Q1 = QQ Q2"
        by (simp add: NFA_reverse___\<L>_in_state QQ_def)
      hence "\<And>w. (rev w \<in> QQ Q1) = (rev w \<in> QQ Q2)" by simp
      hence "\<And>w. (\<exists>q \<in> Q1. w \<in> \<L>_left \ q) \<longleftrightarrow> (\<exists>q \<in> Q2. w \<in> \<L>_left \ q)"
        by (simp add: QQ_in)
      with \<L>_left_unique \<L>_left_not_empty have "\<And>q. q \<in> Q1 \<longleftrightarrow> q \<in> Q2"
        by (simp, metis)
      thus "Q1 = Q2" by auto
    qed
    hence "\<And>q1 q2. \<lbrakk>q1 \<in> \<Q> ?BH; q2 \<in> \<Q> ?BH;
                   \<L>_in_state ?BH q1 = \<L>_in_state ?BH q2\<rbrakk> \<Longrightarrow> (q1 = q2)"
      apply (simp add: Brzozowski_halfway_def efficient_determinise_NFA_def)
      apply (simp add: NFA_remove_unreachable_states_def)
    done

    thus "inj_on (\<L>_in_state ?BH) (\<Q> ?BH)"
      by (simp add: inj_on_def)
  qed
qed

theorem (in NFA) Brzozowski___minimal :
 "DFA_is_minimal (Brzozowski \)"
unfolding Brzozowski_def
proof (rule DFA.Brzozowski_halfway___minimal)
  let ?BH = "Brzozowski_halfway \"

  show "DFA ?BH"
    using Brzozowski_halfway_yields_DFA [OF NFA_axioms] .

  show "SemiAutomaton_is_initially_connected ?BH"
    by (simp add: Brzozowski_halfway_def efficient_determinise_NFA_def
                  SemiAutomaton_is_initially_connected___NFA_remove_unreachable_states)
qed

lemma NFA_isomorphic_Brzozowski_halfway :
assumes equiv: "NFA_isomorphic_wf \1 \2"
shows "NFA_isomorphic_wf (Brzozowski_halfway \1) (Brzozowski_halfway \2)"
proof -
  note equiv_1 = NFA_isomorphic_wf___NFA_reverse_cong [OF equiv]
  note equiv_2 = NFA_isomorphic_wf___NFA_determinise_cong [OF equiv_1]
  note equiv_3 = NFA_isomorphic_wf___NFA_remove_unreachable_states [OF equiv_2]
  thus ?thesis unfolding Brzozowski_halfway_def efficient_determinise_NFA_def .
qed

lemma NFA_isomorphic_Brzozowski :
assumes equiv: "NFA_isomorphic_wf \1 \2"
shows "NFA_isomorphic_wf (Brzozowski \1) (Brzozowski \2)"
proof -
  note equiv_1 = NFA_isomorphic_Brzozowski_halfway [OF equiv]
  note equiv_2 = NFA_isomorphic_Brzozowski_halfway [OF equiv_1]
  thus ?thesis unfolding Brzozowski_def .
qed

subsection \<open> Abstract Minimisation Function \<close>

text \<open> Above, it is shown that all minimal automata that accept the same language are
isomorphic. Let's use Brzozwski minisation and this property in order to define a
minisation function that is later used for specification. \<close>

consts NFA_minimise :: "('q::{automaton_states}, 'a, 'X) NFA_rec_scheme \<Rightarrow> ('q, 'a) NFA_rec"

specification (NFA_minimise) NFA_minimise_spec_aux:
"\<forall>\. NFA \ \<longrightarrow>
   \<L>(NFA_minimise \) = \<L> \ \<and>
   \<Sigma>(NFA_minimise \) = \<Sigma> \ \<and>
   DFA_is_minimal (NFA_minimise \)"
apply (rule exI [where x = "\<lambda>\. NFA_normalise_states (Brzozowski \)"])
apply (simp add: Brzozowski___well_formed NFA.Brzozowski___\<L>)
apply (metis Brzozowski___well_formed NFA.Brzozowski___minimal NFA_isomorphic_wf_D(3)
          NFA_isomorphic_wf_normalise_states NFA_isomorphic___DFA_is_minimal)
done

lemma NFA_minimise_spec:
  "NFA \ \<Longrightarrow> \<L>(NFA_minimise \) = \<L> \"
  "NFA \ \<Longrightarrow> \<Sigma>(NFA_minimise \) = \<Sigma> \"
  "NFA \ \<Longrightarrow> DFA_is_minimal (NFA_minimise \)"
by (simp_all add: NFA_minimise_spec_aux)

lemma NFA_isomorphic_wf___minimise :
fixes \1 :: "('q1::{automaton_states}, 'a, _) NFA_rec_scheme"
  and \2 :: "('q2, 'a) NFA_rec"
assumes wf_\1: "NFA \1"
shows "NFA_isomorphic_wf \2 (NFA_minimise \1) \<longleftrightarrow>
       \<L> \2 = \<L> \1 \<and> \<Sigma> \2 = \<Sigma> \1 \<and> DFA_is_minimal \2"
using NFA_minimise_spec[OF wf_\1]
      DFA_is_minimal___isomorph_wf [of \2 "NFA_minimise \1"]
      NFA_isomorphic___DFA_is_minimal [of "NFA_minimise \1" \2]
by (simp, metis NFA_isomorphic_wf_D(4) NFA_isomorphic_wf_\<L> NFA_isomorphic_wf_\<Sigma>)

lemma NFA_isomorphic_wf___minimise_cong :
assumes pre: "NFA_isomorphic_wf \1 \2"
shows "NFA_isomorphic_wf (NFA_minimise \1) (NFA_minimise \2)"
proof -
  from pre have "NFA \1" "NFA \2"
    by (simp_all add: NFA_isomorphic_wf_alt_def)

  from `NFA \<A>2` NFA_minimise_spec[OF `NFA \<A>1`] pre
  show ?thesis
    by (simp add: NFA_isomorphic_wf___minimise NFA_isomorphic_wf_\<L> NFA_isomorphic_wf_\<Sigma>)
qed

lemma Brzozowski___minimise :
  "NFA \ \<Longrightarrow> NFA_isomorphic_wf (Brzozowski \) (NFA_minimise \)"
by (simp add: NFA_isomorphic_wf___minimise NFA.Brzozowski___\<L> NFA.Brzozowski___minimal)

end


theory LundfallErfurtEx03
imports Main

begin

subsection \<open>Exercise 1\<close>

theorem "a)":
  assumes a: "(\<forall> x. P x) \<and> (\<forall> x. Q x)"
  shows "\<forall> x. P x \<and> Q x"
proof -
  {
    fix x
    from a have "\<forall> x. P x" by (rule conjunct1)
    then  have px: "P x" by (rule allE)
    from a have "\<forall> x. Q x" by (rule conjunct2)
    then have "Q x" by (rule allE)
    with px have "P x \<and> Q x" by (rule conjI)
  }
  thus ?thesis by (rule allI)
qed

lemma "b)":
  assumes "\<exists> x. P x \<and> Q x"
  shows "\<exists> x. P x"
proof -
  from assms obtain x where 1: "P x \<and> Q x" by (rule exE)
  then have xx: "P x" by (rule conjunct1)
  then show ?thesis by (rule exI)
qed

lemma "c)":
  assumes "\<forall> x. P x"
  shows "\<exists>x. P x"
proof -
  fix x
  from assms have "P x" by (rule allE)
  then have "\<exists> x. P x" by (rule exI)
  thus ?thesis .
qed

lemma "d)":
  shows "((\<forall> x. P x) \<and> (\<forall> x. Q x)) \<longleftrightarrow> (\<forall> x. P x \<and> Q x)"
proof -
  {
    assume a: "(\<forall> x. P x) \<and> (\<forall> x. Q x)"
    {
      fix x
      from a have "\<forall> x. P x" by (rule conjunct1)
      then have b: "P x" by (rule allE)
      from a have "\<forall> x. Q x" by (rule conjunct2)
      then have c: "Q x" by (rule allE)
      from b c have "P x \<and> Q x" by (rule conjI)
    }
    then have "(\<forall> x. P x \<and> Q x)" by (rule allI)
  } note lhs = this
  {
    assume a: "(\<forall> x. P x \<and> Q x)"
    {
      fix x
      from a have "P x \<and> Q x" by (rule allE)
      then have "P x" by (rule conjunct1)
    }
    then have b: "\<forall> x. P x" by (rule allI)
    {
      fix x
      from a have "P x \<and> Q x" by (rule allE)
      then have "Q x" by (rule conjunct2)
    }
    then have c: "\<forall> x. Q x" by (rule allI)
    from b c have "(\<forall> x. P x) \<and> (\<forall> x. Q x)" by (rule conjI)
  } note rhs = this
  from lhs rhs show ?thesis by (rule iffI)
qed

subsection \<open>Exercise 2\<close>

theorem "a":
  shows "(\<exists> x. \<forall> y. P x y) \<longrightarrow> (\<forall> y. \<exists> x. P x y)"
proof -
  {
    assume a: "\<exists> x. \<forall> y. P x y"
    {
      fix y
      from a obtain x where 1: "\<forall> y. P x y" by (rule exE)
      from this have "P x y" by (rule allE)
      from this have "\<exists> x. P x y" by (rule exI)
    }
    from this have "\<forall> y. \<exists> x. P x y" by (rule allI)
  }
  from this show ?thesis by (rule impI)
qed

theorem "b":
  shows "((\<forall> x. P x) \<longrightarrow> Q) \<longleftrightarrow> ((\<exists> x. P x) \<longrightarrow> Q)"
  proof
  (*
    'a = {a, b, c, d}
    Q = False
    P(a) = False
    P(b) = False
    P(c) = False
    P(d) = True
  *)
oops

lemma "c":
  shows "((\<forall> x. P x) \<or> (\<forall> x. Q x)) \<longleftrightarrow> (\<forall> x. (P x \<or> Q x))"
proof -
  (*
    'a = {a, b}
    P(a) = False
    P(b) = True
    Q(a) = True
    Q(b) = False
  *)
oops

lemma "d":
  shows "((\<exists> x. P x) \<or> (\<exists> x. Q x)) \<longleftrightarrow> (\<exists> x. (P x \<or> P x))"
  (*
    'a = {a,b,c}
    P(a) = False
    P(b) = False
    P(c) = False
    Q(a) = False
    Q(b) = False
    Q(c) = True
  *)
oops

lemma "e":
  shows "(\<forall> x. \<exists> y. P x y) \<longrightarrow> (\<exists> y. \<forall> x. P x y)"
  (*
    'a = {a,b}
    P(a,a) = False
    P(a,b) = True
    P(b,a) = True
    P(b,b) = False
  *)
oops

lemma "f":
  shows "(\<not>(\<forall> x. P x)) \<longleftrightarrow> (\<exists> x. \<not> P x)"
proof -
  {
    assume a: "\<not>(\<forall> x. P x)"
    {
      assume b: "\<not>(\<exists> x. \<not> P x)"
      {
        fix y
        {
          assume c: "\<not>P y"
          from c have d: "\<exists> x. \<not> P x" by (rule exI)
          from b d have "False" by (rule notE)
        }
        from this have e: "P y" by (rule ccontr)
      }
      from this have d: "\<forall> x. P x" by (rule allI)
      from a d have "False" by (rule notE)
    }
    from this have "\<exists> x. \<not> P x" by (rule ccontr)
  }
  note ltor = this
  {
    assume 1: "\<exists> x. \<not> P x"
    from 1 obtain a where 2: "\<not>P a" by (rule exE)
    {
      assume 3: "\<forall> x. P x"
      from 3 have 4: "P a" by (rule allE)
      from 2 4 have "False" by (rule notE)
    }
    from this have "\<not>(\<forall> x. P x)" by (rule notI)
  }
  note rtol = this
  from ltor rtol have "(\<not>(\<forall> x. P x)) \<longleftrightarrow> (\<exists> x. \<not> P x)" by (rule iffI)
  thus ?thesis .
qed

subsection \<open>Exercise 3\<close>

theorem "3a":
  shows "(\<exists> x. \<forall> y. P x y) \<longrightarrow> (\<forall> y. \<exists> x. P x y)"
proof -
  {
    assume a: "\<exists> x. \<forall> y. P x y"
    {
      fix y
      from a obtain x where 1: "\<forall> y. P x y" by (rule exE)
      hence "P x y" by (rule allE)
      hence "\<exists> x. P x y" by (rule exI)
    }
    hence "\<forall> y. \<exists> x. P x y" by (rule allI)
  }
  thus ?thesis by (rule impI)
qed

lemma "3f":
  shows "(\<not>(\<forall> x. P x)) \<longleftrightarrow> (\<exists> x. \<not> P x)"
proof
  assume a: "(\<not>(\<forall> x. P x))"
  show "\<exists> x. \<not> P x"
  proof (rule ccontr)
    assume b: "\<not>(\<exists> x. \<not> P x)"
    {
        fix y
        {
          assume "\<not>P y"
          hence "\<exists> x. \<not> P x" by (rule exI)
          with b have "False" by (rule notE)
        }
        hence "P y" by (rule ccontr)
      }
      hence "\<forall> x. P x" by (rule allI)
      with a show "False" by (rule notE)
  qed
next
  assume 1: "\<exists> x. \<not> P x"
  show "\<not>(\<forall> x. P x)"
  proof (rule notI)
    from 1 obtain a where 2: "\<not>P a" by (rule exE)
    assume "\<forall> x. P x"
    hence "P a" by (rule allE)
    with 2 show "False" by (rule notE)
  qed
qed

subsection \<open>Exercise 4\<close>

lemma allDeMorgan: "\<not> (\<forall> x. P(x)) \<Longrightarrow> (\<exists> x. \<not> (P(x)))" by simp

lemma disjToImp:
  assumes "\<not>A \<or> B"
  shows "A \<longrightarrow> B"
  proof -
  {
    assume 1: "A"
      {
        assume 3: "\<not>A"
        {
          assume 2: "\<not>B"
          from 3 1 have "False" by (rule notE)
        }
        from this have "B" by (rule ccontr)
      } note case1 = this
      {
        assume "B"
      } note case2 = this
      from assms case1 case2 have "B" by (rule disjE)
      }
  from this have "A \<longrightarrow> B" by (rule impI)
  thus ?thesis .
qed

lemma "ex4":
  shows "\<exists> x. (D(x) \<longrightarrow> (\<forall> y. D(y)))"
proof cases
    assume 1: "\<forall> y. D(y)"
    {
      assume "D(x)"
      from 1 have "(\<forall> y. D(y))" by -
    }
    from this have 2: "D(x) \<longrightarrow> (\<forall> y. D(y))" by (rule impI)
    from 2 show b: "\<exists> x. (D(x) \<longrightarrow> (\<forall> y. D(y)))" by (rule exI)
next
    assume 4: "\<not> (\<forall> y. D(y))"
    then have 5: "\<exists> z. \<not> (D(z))" by (rule allDeMorgan)
    from 5 obtain z where 5: "\<not>D(z)" by (rule exE)
    then have "\<not>D(z) \<or> (\<forall> y. D(y))" by (rule disjI1)
    then have 6: "D(z) \<longrightarrow> (\<forall> y. D(y))" by (rule disjToImp)
    then show c: "\<exists> x. (D(x) \<longrightarrow> (\<forall> y. D(y)))" by (rule exI)
qed

end