(* TODO: Port to new Collection Framework *)
section "Interface for NFAs and DFAs"
theory NFASpec
imports Main "../../Collections/ICF/Collections"
  "../../Collections/Iterator/SetAbstractionIterator"
  "../NFA" "../DFA"

begin
  type_synonym ('q,'a,'nfa) nfa_\<alpha> = "'nfa \<Rightarrow> ('q, 'a) NFA_rec"
  locale nfa =
    fixes \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes invar :: "'nfa \<Rightarrow> bool"
    assumes nfa_is_wellformed: "invar n \<Longrightarrow> NFA (\<alpha> n)"

  locale dfa =
    fixes \<alpha> :: "('q,'a,'dfa) nfa_\<alpha>"
    fixes invar :: "'dfa \<Rightarrow> bool"
    assumes dfa_is_wellformed: "invar n \<Longrightarrow> DFA (\<alpha> n)"

  type_synonym ('q,'a,'nfa) nfa_from_list =
    "('q list \<times> 'a list \<times> ('q \<times> 'a list \<times> 'q) list \<times> 'q list \<times> 'q list) \<Rightarrow> 'nfa"
  locale nfa_from_list = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes from_list :: "('q,'a,'nfa) nfa_from_list"
    assumes nfa_from_list_correct:
      "invar (from_list l)"
      "\<alpha> (from_list l) = NFA_construct l"
  begin
    lemma nfa_from_list_correct___isomorphic :
      "invar (from_list l)"
      "NFA_isomorphic_wf (\<alpha> (from_list l)) (NFA_construct l)"
    by (simp_all add: nfa_from_list_correct NFA_isomorphic_wf_def NFA_isomorphic_refl
                      NFA_construct___is_well_formed)
  end

  locale dfa_from_list = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes from_list :: "('q,'a,'nfa) nfa_from_list"
    assumes dfa_from_list_correct:
      "DFA (NFA_construct l) \<Longrightarrow> invar (from_list l)"
      "DFA (NFA_construct l) \<Longrightarrow> \<alpha> (from_list l) = NFA_construct l"
  begin
    lemma dfa_from_list_correct___isomorphic :
      "DFA (NFA_construct l) \<Longrightarrow> invar (from_list l)"
      "DFA (NFA_construct l) \<Longrightarrow> NFA_isomorphic_wf (\<alpha> (from_list l)) (NFA_construct l)"
    by (simp_all add: dfa_from_list_correct NFA_isomorphic_wf_def NFA_isomorphic_refl
                      NFA_construct___is_well_formed)
  end

  type_synonym ('q,'a,'nfa) nfa_to_list =
    "'nfa \<Rightarrow> ('q list \<times> 'a list \<times> ('q \<times> 'a list \<times> 'q) list \<times> 'q list \<times> 'q list)"
  locale nfa_to_list = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes to_list :: "('q,'a,'nfa) nfa_to_list"
    assumes to_list_correct:
      "invar n \<Longrightarrow> NFA_construct (to_list n) = \<alpha> n"
  begin
    lemma to_list_correct___isomorphic :
      "invar n \<Longrightarrow>  NFA_isomorphic_wf (\<alpha> n) (NFA_construct (to_list n))"
    using to_list_correct[of n]
      apply (simp add: NFA_isomorphic_wf_def NFA_isomorphic_refl)
      apply (metis NFA_construct___is_well_formed)
    done
  end

  type_synonym ('q,'a,'nfa) nfa_to_list_simple =
    "'nfa \<Rightarrow> ('q list \<times> 'a list \<times> ('q \<times> 'a \<times> 'q) list \<times> 'q list \<times> 'q list)"
  locale nfa_to_list_simple = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes to_list_simple :: "('q,'a,'nfa) nfa_to_list_simple"
    assumes to_list_simple_correct:
      "invar n \<Longrightarrow> NFA_construct_simple (to_list_simple n) = \<alpha> n"
  begin
    lemma to_list_simple_correct___isomorphic :
      "invar n \<Longrightarrow>  NFA_isomorphic_wf (\<alpha> n) (NFA_construct_simple (to_list_simple n))"
    using to_list_simple_correct[of n]
      apply (cases "to_list_simple n")
      apply (simp add: NFA_isomorphic_wf_def NFA_isomorphic_refl)
      apply (metis NFA_construct___is_well_formed)
    done
  end

  locale nfa_stats = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes states_no :: "'nfa \<Rightarrow> nat"
    fixes labels_no :: "'nfa \<Rightarrow> nat"
    fixes trans_no :: "'nfa \<Rightarrow> nat"
    fixes initial_no :: "'nfa \<Rightarrow> nat"
    fixes final_no :: "'nfa \<Rightarrow> nat"
    assumes stats_correct:
      "invar n \<Longrightarrow> states_no n = card (\<Q> (\<alpha> n))"
      "invar n \<Longrightarrow> labels_no n = card (\<Sigma> (\<alpha> n))"
      "invar n \<Longrightarrow> trans_no n = card (\<Delta> (\<alpha> n))"
      "invar n \<Longrightarrow> initial_no n = card (\<I> (\<alpha> n))"
      "invar n \<Longrightarrow> final_no n = card (\<F> (\<alpha> n))"
  begin
    lemma stats_correct___isomorphic :
    fixes \<A> :: "('q2, 'a, _) NFA_rec_scheme"
    shows
      "invar n \<Longrightarrow> NFA_isomorphic_wf (\<alpha> n) \<A> \<Longrightarrow> states_no n = card (\<Q> \<A>)"
      "invar n \<Longrightarrow> NFA_isomorphic_wf (\<alpha> n) \<A> \<Longrightarrow> labels_no n = card (\<Sigma> \<A>)"
      "invar n \<Longrightarrow> NFA_isomorphic_wf (\<alpha> n) \<A> \<Longrightarrow> trans_no n = card (\<Delta> \<A>)"
      "invar n \<Longrightarrow> NFA_isomorphic_wf (\<alpha> n) \<A> \<Longrightarrow> initial_no n = card (\<I> \<A>)"
      "invar n \<Longrightarrow> NFA_isomorphic_wf (\<alpha> n) \<A> \<Longrightarrow> final_no n = card (\<F> \<A>)"
    proof -
      fix n and \<A>:: "('q2, 'a, _) NFA_rec_scheme"
      assume invar_n: "invar n" and iso_\<A>: "NFA_isomorphic_wf (\<alpha> n) \<A>"

      note [simp] = stats_correct [OF invar_n]
      from iso_\<A> obtain f where inj_f: "inj_on f (\<Q> (\<alpha> n))"
                            and \<A>_eq[simp]: "\<A> = NFA_rename_states (\<alpha> n) f"
                            and wf: "NFA (\<alpha> n)"
        unfolding NFA_isomorphic_wf_def NFA_isomorphic_def by blast

      from wf have wf': "SemiAutomaton (\<alpha> n)" unfolding NFA_alt_def FinSemiAutomaton_def by simp

      show "states_no n = card (\<Q> \<A>)" by (simp add: card_image inj_f)
      show "labels_no n = card (\<Sigma> \<A>)" by simp

      from wf' [THEN SemiAutomaton.\<I>_consistent, THEN subset_inj_on[OF inj_f]]
      show "initial_no n = card (\<I> \<A>)" by (simp add: card_image inj_f)

      from wf [THEN NFA.\<F>_consistent, THEN subset_inj_on[OF inj_f]]
      show "final_no n = card (\<F> \<A>)" by (simp add: card_image inj_f)

      show "trans_no n = card (\<Delta> \<A>)"
      proof -
        have "{(f s1, a, f s2) |s1 a s2. (s1, a, s2) \<in> \<Delta> (\<alpha> n)} =
              (\<lambda>(s1, a, s2). (f s1, a, f s2)) ` (\<Delta> (\<alpha> n))"
          by (auto simp add: image_iff Bex_def, metis)
        moreover
          have "inj_on (\<lambda>(s1, a, s2). (f s1, a, f s2)) (\<Delta> (\<alpha> n))"
            using inj_f wf'[THEN SemiAutomaton.\<Delta>_consistent]
            by (simp add: inj_on_def Ball_def)
        ultimately show ?thesis
          by (simp add: NFA_rename_states_full_def card_image)
      qed
    qed
  end

  lemma (in nfa_from_list) \<alpha>_exists :
    "NFA \<A> \<Longrightarrow> \<exists>AA. invar AA \<and> \<A> = \<alpha> AA"
  by (metis NFA_construct_exists nfa_from_list_correct)

  type_synonym ('q,'a,'nfa) nfa_accept =
    "'nfa \<Rightarrow> 'a list \<Rightarrow> bool"
  locale nfa_accept = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes accept :: "'nfa \<Rightarrow> 'a list \<Rightarrow> bool"
    assumes accept_correct:
      "invar n \<Longrightarrow> (accept n w = NFA_accept (\<alpha> n) w)"
  begin
    lemma accept_correct___isomorphic :
      assumes invar: "invar n"
          and iso: "NFA_isomorphic_wf (\<alpha> n) (\<A> :: ('q2, 'a) NFA_rec)"
      shows "accept n w = NFA_accept \<A> w"
    using assms
    by (metis NFA_isomorphic_wf_accept accept_correct)
  end

  locale dfa_accept = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes accept :: "'nfa \<Rightarrow> 'a list \<Rightarrow> bool"
    assumes accept_correct:
      "invar n \<Longrightarrow> DFA (\<alpha> n) \<Longrightarrow> (accept n w = NFA_accept (\<alpha> n) w)"

  locale nfa_remove_states = nfa \<alpha> invar + set \<alpha>_s invar_s
    for \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>" and invar
    and \<alpha>_s :: "'q_set \<Rightarrow> 'q set" and invar_s +
    fixes remove_states :: "'nfa \<Rightarrow> 'q_set \<Rightarrow> 'nfa"
    assumes remove_states_correct:
      "invar n \<Longrightarrow> invar_s S \<Longrightarrow> (invar (remove_states n S))"
      "invar n \<Longrightarrow> invar_s S \<Longrightarrow>
       (\<alpha> (remove_states n S) = NFA_remove_states (\<alpha> n) (\<alpha>_s S))"

  locale nfa_rename_states = nfa \<alpha>1 invar1 + nfa \<alpha>2 invar2
    for \<alpha>1 :: "('q1,'a,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q2,'a,'nfa2) nfa_\<alpha>" and invar2 +
    fixes rename_states :: "'nfa1 \<Rightarrow> ('q1 \<Rightarrow> 'q2) \<Rightarrow> 'nfa2"
    assumes nfa_rename_states_correct:
      "invar1 n \<Longrightarrow> (invar2 (rename_states n f))"
      "invar1 n \<Longrightarrow> (\<alpha>2 (rename_states n f) = NFA_rename_states (\<alpha>1 n) f)"

  locale dfa_rename_states = nfa \<alpha>1 invar1 + nfa \<alpha>2 invar2
    for \<alpha>1 :: "('q1,'a,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q2,'a,'nfa2) nfa_\<alpha>" and invar2 +
    fixes rename_states :: "'nfa1 \<Rightarrow> ('q1 \<Rightarrow> 'q2) \<Rightarrow> 'nfa2"
    assumes dfa_rename_states_correct:
      "invar1 n \<Longrightarrow> DFA (NFA_rename_states (\<alpha>1 n) f) \<Longrightarrow> (invar2 (rename_states n f))"
      "invar1 n \<Longrightarrow> DFA (NFA_rename_states (\<alpha>1 n) f) \<Longrightarrow> (\<alpha>2 (rename_states n f) = NFA_rename_states (\<alpha>1 n) f)"

  type_synonym ('a1,'a2,'nfa1,'nfa2) nfa_rename_labels = "'nfa1 \<Rightarrow> ('a1 \<Rightarrow> 'a2) \<Rightarrow> 'nfa2"
  locale nfa_rename_labels = n1:nfa \<alpha>1 invar1 + n2:nfa \<alpha>2 invar2
    for \<alpha>1 :: "('q,'a1,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q,'a2,'nfa2) nfa_\<alpha>" and invar2 +
    fixes rename_labels :: "('a1,'a2,'nfa1,'nfa2) nfa_rename_labels"
    assumes rename_labels_correct:
      "invar1 n \<Longrightarrow> (invar2 (rename_labels n f))"
      "invar1 n \<Longrightarrow> (\<alpha>2 (rename_labels n f) = SemiAutomaton_rename_labels (\<alpha>1 n) f)"
  begin
    lemma rename_labels_correct___isomorphic :
      "invar1 n \<Longrightarrow> (invar2 (rename_labels n f))"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>1 n) \<A> \<Longrightarrow>
                    NFA_isomorphic_wf (\<alpha>2 (rename_labels n f)) (SemiAutomaton_rename_labels \<A> f)"
    using rename_labels_correct[of n f] n2.nfa_is_wellformed
          NFA_isomorphic_wf___NFA_rename_labels_cong [of "\<alpha>1 n" \<A> f]
      by simp_all
  end

  type_synonym ('a1,'a2,'a_set,'nfa1,'nfa2) nfa_rename_labels_gen = "'nfa1 \<Rightarrow> 'a_set \<Rightarrow> ('a1 \<Rightarrow> 'a2) \<Rightarrow> 'nfa2"
  locale nfa_rename_labels_gen = n1: nfa \<alpha>1 invar1 + n2: nfa \<alpha>2 invar2 + set \<alpha>3 invar3
    for \<alpha>1 :: "('q,'a1,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q,'a2,'nfa2) nfa_\<alpha>" and invar2 and
        \<alpha>3 :: "'a_set \<Rightarrow> 'a2 set" and invar3 +
    fixes rename_labels_gen :: "('a1,'a2,'a_set,'nfa1,'nfa2) nfa_rename_labels_gen"
    assumes rename_labels_gen_correct:
      "invar1 n \<Longrightarrow> invar3 A \<Longrightarrow> \<alpha>3 A = f ` (\<Sigma> (\<alpha>1 n)) \<Longrightarrow> (invar2 (rename_labels_gen n A f))"
      "invar1 n \<Longrightarrow> invar3 A \<Longrightarrow> \<alpha>3 A = f ` (\<Sigma> (\<alpha>1 n)) \<Longrightarrow> (\<alpha>2 (rename_labels_gen n A f) = SemiAutomaton_rename_labels (\<alpha>1 n) f)"
  begin
    lemma rename_labels_gen_correct___isomorphic :
      "invar1 n \<Longrightarrow> invar3 A \<Longrightarrow> \<alpha>3 A = f ` (\<Sigma> (\<alpha>1 n)) \<Longrightarrow> (invar2 (rename_labels_gen n A f))"
      "invar1 n \<Longrightarrow> invar3 A \<Longrightarrow> \<alpha>3 A = f ` (\<Sigma> (\<alpha>1 n)) \<Longrightarrow>
         NFA_isomorphic_wf (\<alpha>1 n) \<A> \<Longrightarrow>
         NFA_isomorphic_wf (\<alpha>2 (rename_labels_gen n A f)) (SemiAutomaton_rename_labels \<A> f)"
    using rename_labels_gen_correct[of n A f] n2.nfa_is_wellformed
          NFA_isomorphic_wf___NFA_rename_labels_cong [of "\<alpha>1 n" \<A> f]
    by simp_all
  end

  lemma nfa_rename_labels_gen_impl :
    assumes "nfa_rename_labels_gen \<alpha>1 invar1 \<alpha>2 invar2 \<alpha>3 invar3 rl"
        and "\<And>n f. invar1 n \<Longrightarrow> invar3 (im n f) \<and> \<alpha>3 (im n f) = f ` (\<Sigma> (\<alpha>1 n))"
    shows "nfa_rename_labels \<alpha>1 invar1 \<alpha>2 invar2 (\<lambda>AA f. rl AA (im AA f) f)"
    using assms
    unfolding nfa_rename_labels_def nfa_rename_labels_gen_def nfa_rename_labels_axioms_def
              nfa_rename_labels_gen_axioms_def
    by simp

  locale nfa_reverse = nfa \<alpha>1 invar1 + nfa \<alpha>2 invar2
    for \<alpha>1 :: "('q,'a,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q,'a,'nfa2) nfa_\<alpha>" and invar2 +
    fixes reverse :: "'nfa1 \<Rightarrow> 'nfa2"
    assumes reverse_correct:
      "invar1 n \<Longrightarrow> invar2 (reverse n)"
      "invar1 n \<Longrightarrow> (\<alpha>2 (reverse n) = NFA_reverse (\<alpha>1 n))"
  begin
    lemma reverse_correct___isomorphic :
      "invar1 n \<Longrightarrow> invar2 (reverse n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>1 n) (\<A> :: ('q2, 'a) NFA_rec) \<Longrightarrow>
                    NFA_isomorphic_wf (\<alpha>2 (reverse n)) (NFA_reverse \<A>)"
      apply (simp add: reverse_correct)
      apply (insert reverse_correct(2)[of n]
                  NFA_isomorphic_wf___NFA_reverse_cong [of "\<alpha>1 n" \<A>])
      apply (simp)
    done
  end

  locale nfa_complement = nfa \<alpha> invar
    for \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>" and invar +
    fixes complement :: "'nfa \<Rightarrow> 'nfa"
    assumes complement_correct:
      "invar n \<Longrightarrow> invar (complement n)"
      "invar n \<Longrightarrow> (\<alpha> (complement n) = DFA_complement (\<alpha> n))"
  begin
    lemma complement_correct___isomorphic :
      "invar n \<Longrightarrow> invar (complement n)"
      "invar n \<Longrightarrow> NFA_isomorphic_wf (\<alpha> n) (\<A> :: ('q2, 'a) NFA_rec) \<Longrightarrow>
                    NFA_isomorphic_wf (\<alpha> (complement n)) (DFA_complement \<A>)"
      apply (simp add: complement_correct)
      apply (insert complement_correct(2)[of n]
                  NFA_isomorphic_wf___DFA_complement_cong [of "\<alpha> n" \<A>])
      apply (simp)
    done
  end

  type_synonym ('q2,'i,'a,'a_set,'\<sigma>,'nfa) nfa_construct =
    "('q2 \<Rightarrow> 'i) \<Rightarrow> 'q2 list \<Rightarrow> 'a_set \<Rightarrow> ('q2 \<Rightarrow> bool) \<Rightarrow>
     ('q2 \<Rightarrow> ('a\<times>'q2,'\<sigma>) set_iterator) \<Rightarrow> 'nfa"

  locale nfa_dfa_construct_no_enc = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes construct :: "bool \<Rightarrow> ('q2,'i,'a,'a_set,'\<sigma>,'nfa) nfa_construct"
    assumes nfa_dfa_construct_no_enc_correct:
       "\<lbrakk>NFA (\<A>::('q2, 'a) NFA_rec); det \<Longrightarrow> DFA \<A>; inj_on f (\<Q> \<A>); distinct I; set I = \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. q \<in> \<Q> \<A> \<Longrightarrow> FP q \<longleftrightarrow> q \<in> \<F> \<A>;
         \<And>q. q \<in> \<Q> \<A> \<Longrightarrow> set_iterator (D_it q) {(a, q'). (q, a, q') \<in> \<Delta> \<A>}\<rbrakk> \<Longrightarrow>
         (invar (construct det f I A FP D_it) \<and>
          NFA_isomorphic_wf (\<alpha> (construct det f I A FP D_it)) (NFA_remove_unreachable_states \<A>))"

  locale nfa_construct_no_enc = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes construct :: "('q2,'i,'a,'a_set,'\<sigma>,'nfa) nfa_construct"
    assumes nfa_construct_no_enc_correct:
       "\<lbrakk>NFA (\<A>::('q2, 'a) NFA_rec); inj_on f (\<Q> \<A>); distinct I; set I = \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. q \<in> \<Q> \<A> \<Longrightarrow> FP q \<longleftrightarrow> q \<in> \<F> \<A>;
         \<And>q. q \<in> \<Q> \<A> \<Longrightarrow> set_iterator (D_it q) {(a, q'). (q, a, q') \<in> \<Delta> \<A>}\<rbrakk> \<Longrightarrow>
         (invar (construct f I A FP D_it) \<and>
          NFA_isomorphic_wf (\<alpha> (construct f I A FP D_it)) (NFA_remove_unreachable_states \<A>))"

  locale dfa_construct_no_enc = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes construct :: "('q2,'i,'a,'a_set,'\<sigma>,'nfa) nfa_construct"
    assumes dfa_construct_no_enc_correct:
       "\<lbrakk>DFA (\<A>::('q2, 'a) NFA_rec); inj_on f (\<Q> \<A>); distinct I; set I = \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. q \<in> \<Q> \<A> \<Longrightarrow> FP q \<longleftrightarrow> q \<in> \<F> \<A>;
         \<And>q. q \<in> \<Q> \<A> \<Longrightarrow> set_iterator (D_it q) {(a, q'). (q, a, q') \<in> \<Delta> \<A>}\<rbrakk> \<Longrightarrow>
         (invar (construct f I A FP D_it) \<and>
          NFA_isomorphic_wf (\<alpha> (construct f I A FP D_it)) (NFA_remove_unreachable_states \<A>))"

  type_synonym ('q2,'i,'a,'a_set,'nfa) nfa_construct_fun =
    "('q2 \<Rightarrow> 'i) \<Rightarrow> 'q2 \<Rightarrow> 'a_set \<Rightarrow> ('q2 \<Rightarrow> bool) \<Rightarrow>
     ('q2 \<Rightarrow> 'a \<Rightarrow> 'q2) \<Rightarrow> 'nfa"
  locale dfa_construct_no_enc_fun = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes construct :: "('q2,'i,'a,'a_set,'nfa) nfa_construct_fun"
    assumes dfa_construct_no_enc_fun_correct:
       "\<lbrakk>DFA (\<A>::('q2, 'a) NFA_rec); inj_on f (\<Q> \<A>); I \<in> \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. q \<in> \<Q> \<A> \<Longrightarrow> FP q \<longleftrightarrow> q \<in> \<F> \<A>;
         \<And>q a. q \<in> \<Q> \<A> \<Longrightarrow> a \<in> \<Sigma> \<A> \<Longrightarrow> (q, a, D_fun q a) \<in> \<Delta> \<A>\<rbrakk> \<Longrightarrow>
         (invar (construct f I A FP D_fun) \<and>
          NFA_isomorphic_wf (\<alpha> (construct f I A FP D_fun)) (NFA_remove_unreachable_states \<A>))"

  lemma nfa_construct_no_enc_sublocale :
  assumes pre: "nfa_construct_no_enc \<alpha> invar \<alpha>_s invar_s construct"
  shows "dfa_construct_no_enc \<alpha> invar \<alpha>_s invar_s construct"
    apply (intro dfa_construct_no_enc.intro dfa_construct_no_enc_axioms.intro)
      apply (insert pre) []
      apply (simp add: nfa_construct_no_enc_def)

      apply (rule_tac nfa_construct_no_enc.nfa_construct_no_enc_correct [OF pre])
      apply (simp_all add: DFA_alt_def)
  done

  lemma nfa_dfa_construct_no_enc_sublocale_nfa :
  assumes pre: "nfa_dfa_construct_no_enc \<alpha> invar \<alpha>_s invar_s construct"
  shows "nfa_construct_no_enc \<alpha> invar \<alpha>_s invar_s (construct False)"
    apply (intro nfa_construct_no_enc.intro nfa_construct_no_enc_axioms.intro)
      apply (insert pre) []
      apply (simp add: nfa_dfa_construct_no_enc_def)

      apply (rule_tac nfa_dfa_construct_no_enc.nfa_dfa_construct_no_enc_correct [OF pre])
      apply (simp_all)
  done

  lemma nfa_dfa_construct_no_enc_sublocale_dfa :
  assumes pre: "nfa_dfa_construct_no_enc \<alpha> invar \<alpha>_s invar_s construct"
  shows "dfa_construct_no_enc \<alpha> invar \<alpha>_s invar_s (construct det)"
    apply (intro dfa_construct_no_enc.intro dfa_construct_no_enc_axioms.intro)
      apply (insert pre) []
      apply (simp add: nfa_dfa_construct_no_enc_def)

      apply (rule_tac nfa_dfa_construct_no_enc.nfa_dfa_construct_no_enc_correct [OF pre])
      apply (simp_all)
  done

  text \<open> Sometimes, one cannot work on abstract states directly, but needs an encoding of
          states. An example is the powerset construction for determinising automata. In this
          example states are sets, which one probably wants to encode using the Collection
          framework. \<close>
  locale nfa_dfa_construct = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes q2_\<alpha> :: "'q2_rep \<Rightarrow> 'q2"
      and q2_invar :: "'q2_rep \<Rightarrow> bool"
      and construct :: "bool \<Rightarrow> ('q2_rep,'i,'a,'a_set,'\<sigma>,'nfa) nfa_construct"
    assumes nfa_dfa_construct_correct:
       "\<lbrakk>NFA (\<A>::('q2, 'a) NFA_rec); det \<Longrightarrow> DFA \<A>; inj_on f (\<Q> \<A>);
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> ff q = (f (q2_\<alpha> q));
         distinct (map q2_\<alpha> I); \<And>q. q \<in> set I \<Longrightarrow> q2_invar q; q2_\<alpha> ` (set I) = \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q \<longleftrightarrow> q2_\<alpha> q \<in> \<F> \<A>;
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> set_iterator_abs
               (\<lambda>(a, q'). (a, q2_\<alpha> q')) (\<lambda>(a, q'). q2_invar q') (D_it q)
               {(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}\<rbrakk> \<Longrightarrow>
         (invar (construct det ff I A FP D_it) \<and>
          NFA_isomorphic_wf (\<alpha> (construct det ff I A FP D_it)) (NFA_remove_unreachable_states \<A>))"

  locale nfa_construct = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes q2_\<alpha> :: "'q2_rep \<Rightarrow> 'q2"
      and q2_invar :: "'q2_rep \<Rightarrow> bool"
      and construct :: "('q2_rep,'i,'a,'a_set,'\<sigma>,'nfa) nfa_construct"
    assumes nfa_construct_correct:
       "\<lbrakk>NFA (\<A>::('q2, 'a) NFA_rec); inj_on f (\<Q> \<A>);
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> ff q = (f (q2_\<alpha> q));
         distinct (map q2_\<alpha> I); \<And>q. q \<in> set I \<Longrightarrow> q2_invar q; q2_\<alpha> ` (set I) = \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q \<longleftrightarrow> q2_\<alpha> q \<in> \<F> \<A>;
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> set_iterator_abs
               (\<lambda>(a, q'). (a, q2_\<alpha> q')) (\<lambda>(a, q'). q2_invar q') (D_it q)
               {(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}\<rbrakk> \<Longrightarrow>
         (invar (construct ff I A FP D_it) \<and>
          NFA_isomorphic_wf (\<alpha> (construct ff I A FP D_it)) (NFA_remove_unreachable_states \<A>))"

  locale dfa_construct = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes q2_\<alpha> :: "'q2_rep \<Rightarrow> 'q2"
      and q2_invar :: "'q2_rep \<Rightarrow> bool"
      and construct :: "('q2_rep,'i,'a,'a_set,'\<sigma>,'nfa) nfa_construct"
    assumes dfa_construct_correct:
       "\<lbrakk>DFA (\<A>::('q2, 'a) NFA_rec); inj_on f (\<Q> \<A>);
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> ff q = (f (q2_\<alpha> q));
         distinct (map q2_\<alpha> I); \<And>q. q \<in> set I \<Longrightarrow> q2_invar q; q2_\<alpha> ` (set I) = \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q \<longleftrightarrow> q2_\<alpha> q \<in> \<F> \<A>;
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> set_iterator_abs
               (\<lambda>(a, q'). (a, q2_\<alpha> q')) (\<lambda>(a, q'). q2_invar q') (D_it q)
               {(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}
            \<rbrakk> \<Longrightarrow>
         (invar (construct ff I A FP D_it) \<and>
          NFA_isomorphic_wf (\<alpha> (construct ff I A FP D_it)) (NFA_remove_unreachable_states \<A>))"

  lemma nfa_construct_sublocale :
  assumes pre: "nfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar construct"
  shows "dfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar construct"
    apply (intro dfa_construct.intro dfa_construct_axioms.intro)
    apply (insert pre) []
    apply (simp add: nfa_construct_def)

    apply (rule_tac nfa_construct.nfa_construct_correct [OF pre])
    apply (simp_all add: DFA_alt_def)
  done

  lemma nfa_dfa_construct_sublocale_dfa :
  assumes pre: "nfa_dfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar construct"
  shows "dfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar (construct det)"
    apply (intro dfa_construct.intro dfa_construct_axioms.intro)
    apply (insert pre) []
    apply (simp add: nfa_dfa_construct_def)

    apply (rule_tac nfa_dfa_construct.nfa_dfa_construct_correct [OF pre])
    apply (simp_all)
  done

  lemma nfa_dfa_construct_sublocale_nfa :
  assumes pre: "nfa_dfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar construct"
  shows "nfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar (construct False)"
    apply (intro nfa_construct.intro nfa_construct_axioms.intro)
    apply (insert pre) []
    apply (simp add: nfa_dfa_construct_def)

    apply (rule_tac nfa_dfa_construct.nfa_dfa_construct_correct [OF pre])
    apply (simp_all)
  done

  locale dfa_construct_fun = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes q2_\<alpha> :: "'q2_rep \<Rightarrow> 'q2"
      and q2_invar :: "'q2_rep \<Rightarrow> bool"
      and construct :: "('q2_rep,'i,'a,'a_set,'nfa) nfa_construct_fun"
    assumes dfa_construct_fun_correct:
       "\<lbrakk>DFA (\<A>::('q2, 'a) NFA_rec); inj_on f (\<Q> \<A>);
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> ff q = (f (q2_\<alpha> q));
         q2_invar I; q2_\<alpha> I \<in> \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>;
         \<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q \<longleftrightarrow> q2_\<alpha> q \<in> \<F> \<A>;
         \<And>q a. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> a \<in> \<Sigma> \<A> \<Longrightarrow>
              (q2_\<alpha> q, a, q2_\<alpha> (D_fun q a)) \<in> \<Delta> \<A> \<and> q2_invar (D_fun q a)
            \<rbrakk> \<Longrightarrow>
         (invar (construct ff I A FP D_fun) \<and>
          NFA_isomorphic_wf (\<alpha> (construct ff I A FP D_fun)) (NFA_remove_unreachable_states \<A>))"

  locale nfa_dfa_construct_label_sets = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes q2_\<alpha> :: "'q2_rep \<Rightarrow> 'q2"
      and q2_invar :: "'q2_rep \<Rightarrow> bool"
      and a_\<alpha> :: "'as \<Rightarrow> 'a set"
      and a_invar :: "'as \<Rightarrow> bool"
      and construct
    assumes nfa_dfa_construct_label_sets_correct:
       "\<lbrakk>NFA (\<A>::('q2, 'a) NFA_rec); det \<Longrightarrow> DFA \<A>; inj_on f (\<Q> \<A>);
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> ff q = (f (q2_\<alpha> q));
         distinct (map q2_\<alpha> I); \<And>q. q \<in> set I \<Longrightarrow> q2_invar q; q2_\<alpha> ` (set I) = \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q \<longleftrightarrow> q2_\<alpha> q \<in> \<F> \<A>;
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> set_iterator_abs
             (\<lambda>(as, q). (a_\<alpha> as, q2_\<alpha> q)) (\<lambda>(as, q). a_invar as \<and> q2_invar q) (D_it q)
             (DS_q (q2_\<alpha> q));
         \<And>q a q'. q \<in> \<Q> \<A> \<Longrightarrow> ((q, a, q') \<in> \<Delta> \<A>) = (\<exists>as. a \<in> as \<and> (as, q') \<in> DS_q q);
         \<And>q as q'. q \<in> \<Q> \<A> \<Longrightarrow> (as, q') \<in> DS_q q \<Longrightarrow> as \<noteq> {}
            \<rbrakk> \<Longrightarrow>
         (invar (construct det ff I A FP D_it) \<and>
          NFA_isomorphic_wf (\<alpha> (construct det ff I A FP D_it)) (NFA_remove_unreachable_states \<A>))"

  locale nfa_construct_label_sets = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes q2_\<alpha> :: "'q2_rep \<Rightarrow> 'q2"
      and q2_invar :: "'q2_rep \<Rightarrow> bool"
      and a_\<alpha> :: "'as \<Rightarrow> 'a set"
      and a_invar :: "'as \<Rightarrow> bool"
      and construct
    assumes nfa_construct_label_sets_correct:
       "\<lbrakk>NFA (\<A>::('q2, 'a) NFA_rec); inj_on f (\<Q> \<A>);
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> ff q = (f (q2_\<alpha> q));
         distinct (map q2_\<alpha> I); \<And>q. q \<in> set I \<Longrightarrow> q2_invar q; q2_\<alpha> ` (set I) = \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q \<longleftrightarrow> q2_\<alpha> q \<in> \<F> \<A>;
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> set_iterator_abs
             (\<lambda>(as, q). (a_\<alpha> as, q2_\<alpha> q)) (\<lambda>(as, q). a_invar as \<and> q2_invar q) (D_it q)
             (DS_q (q2_\<alpha> q));
         \<And>q a q'. q \<in> \<Q> \<A> \<Longrightarrow> ((q, a, q') \<in> \<Delta> \<A>) = (\<exists>as. a \<in> as \<and> (as, q') \<in> DS_q q);
         \<And>q as q'. q \<in> \<Q> \<A> \<Longrightarrow> (as, q') \<in> DS_q q \<Longrightarrow> as \<noteq> {}
            \<rbrakk> \<Longrightarrow>
         (invar (construct ff I A FP D_it) \<and>
          NFA_isomorphic_wf (\<alpha> (construct ff I A FP D_it)) (NFA_remove_unreachable_states \<A>))"

  locale dfa_construct_label_sets = nfa \<alpha> invar + set "s_\<alpha>::('a, 'a_set) set_\<alpha>" "s_invar::('a, 'a_set) set_invar"
    for \<alpha> invar s_\<alpha> s_invar +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes q2_\<alpha> :: "'q2_rep \<Rightarrow> 'q2"
      and q2_invar :: "'q2_rep \<Rightarrow> bool"
      and a_\<alpha> :: "'as \<Rightarrow> 'a set"
      and a_invar :: "'as \<Rightarrow> bool"
      and construct
    assumes dfa_construct_label_sets_correct:
       "\<lbrakk>DFA (\<A>::('q2, 'a) NFA_rec); inj_on f (\<Q> \<A>);
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> ff q = (f (q2_\<alpha> q));
         distinct (map q2_\<alpha> I); \<And>q. q \<in> set I \<Longrightarrow> q2_invar q; q2_\<alpha> ` (set I) = \<I> \<A>;
         s_invar A; s_\<alpha> A = \<Sigma> \<A>; \<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q \<longleftrightarrow> q2_\<alpha> q \<in> \<F> \<A>;
         \<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> set_iterator_abs
             (\<lambda>(as, q). (a_\<alpha> as, q2_\<alpha> q)) (\<lambda>(as, q). a_invar as \<and> q2_invar q) (D_it q)
             (DS_q (q2_\<alpha> q));
         \<And>q a q'. q \<in> \<Q> \<A> \<Longrightarrow> ((q, a, q') \<in> \<Delta> \<A>) = (\<exists>as. a \<in> as \<and> (as, q') \<in> DS_q q);
         \<And>q as q'. q \<in> \<Q> \<A> \<Longrightarrow> (as, q') \<in> DS_q q \<Longrightarrow> as \<noteq> {}
            \<rbrakk> \<Longrightarrow>
         (invar (construct ff I A FP D_it) \<and>
          NFA_isomorphic_wf (\<alpha> (construct ff I A FP D_it)) (NFA_remove_unreachable_states \<A>))"

  lemma nfa_construct_label_sets_sublocale :
  assumes pre: "nfa_construct_label_sets \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar a_\<alpha> a_invar construct"
  shows "dfa_construct_label_sets \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar a_\<alpha> a_invar construct"
    apply (intro dfa_construct_label_sets.intro dfa_construct_label_sets_axioms.intro)
    apply (insert pre) []
    apply (simp add: nfa_construct_label_sets_def)

    apply (rule_tac nfa_construct_label_sets.nfa_construct_label_sets_correct [OF pre])
    apply (simp_all add: DFA_alt_def)
    apply metis
  done

  lemma nfa_dfa_construct_label_sets_sublocale_dfa :
  assumes pre: "nfa_dfa_construct_label_sets \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar a_\<alpha> a_invar construct"
  shows "dfa_construct_label_sets \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar a_\<alpha> a_invar (construct det)"
    apply (intro dfa_construct_label_sets.intro dfa_construct_label_sets_axioms.intro)
    apply (insert pre) []
    apply (simp add: nfa_dfa_construct_label_sets_def)

    apply (rule_tac nfa_dfa_construct_label_sets.nfa_dfa_construct_label_sets_correct [OF pre])
    apply (simp_all)
    apply metis
  done

  lemma nfa_dfa_construct_label_sets_sublocale_nfa :
  assumes pre: "nfa_dfa_construct_label_sets \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar a_\<alpha> a_invar construct"
  shows "nfa_construct_label_sets \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar a_\<alpha> a_invar (construct False)"
    apply (intro nfa_construct_label_sets.intro nfa_construct_label_sets_axioms.intro)
    apply (insert pre) []
    apply (simp add: nfa_dfa_construct_label_sets_def)

    apply (rule_tac nfa_dfa_construct_label_sets.nfa_dfa_construct_label_sets_correct [OF pre])
    apply (simp_all)
    apply metis
  done

  locale nfa_normalise = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes normalise :: "'nfa \<Rightarrow> 'nfa"
    assumes normalise_correct:
       "invar n \<Longrightarrow> invar (normalise n)"
       "invar n \<Longrightarrow> NFA_isomorphic_wf (\<alpha> (normalise n)) (NFA_remove_unreachable_states (\<alpha> n))"
  begin
    lemma normalise_correct___isomorphic:
       "invar n \<Longrightarrow> invar (normalise n)"
       "\<lbrakk>invar n; NFA_isomorphic_wf (\<alpha> n) (\<A> :: ('q2, 'a) NFA_rec)\<rbrakk> \<Longrightarrow>
         NFA_isomorphic_wf (\<alpha> (normalise n)) (NFA_remove_unreachable_states \<A>)"
    proof -
      fix n
      assume invar_n: "invar n"
      with normalise_correct show invar_norm: "invar (normalise n)" by simp

      from normalise_correct[OF invar_n]
      have iso_wf: "NFA_isomorphic_wf (\<alpha> (normalise n)) (NFA_remove_unreachable_states (\<alpha> n))"
        by simp

      assume "NFA_isomorphic_wf (\<alpha> n) (\<A> :: ('q2, 'a) NFA_rec)"
      note NFA_isomorphic_wf___NFA_remove_unreachable_states[OF this]
      from NFA_isomorphic_wf_trans[OF iso_wf this]
      show "NFA_isomorphic_wf (\<alpha> (normalise n)) (NFA_remove_unreachable_states \<A>)" .
    qed
  end

  locale nfa_bool_comb_gen = nfa \<alpha>1 invar1 + nfa \<alpha>2 invar2 + nfa \<alpha>3 invar3 + set \<alpha>4 invar4
    for \<alpha>1 :: "('q1,'a,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q2,'a,'nfa2) nfa_\<alpha>" and invar2 and
        \<alpha>3 :: "('q3,'a,'nfa3) nfa_\<alpha>" and invar3 and
        \<alpha>4 :: "'a_set \<Rightarrow> 'a set" and invar4 +
    fixes bool_comb :: "'a_set \<Rightarrow> (bool \<Rightarrow> bool \<Rightarrow> bool) \<Rightarrow> 'nfa1 \<Rightarrow> 'nfa2 \<Rightarrow> 'nfa3"
    assumes bool_comb_correct_aux:
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow> invar4 as \<Longrightarrow>
         \<alpha>4 as = \<Sigma> (\<alpha>1 n1) \<inter> \<Sigma> (\<alpha>2 n2) \<Longrightarrow>
       invar3 (bool_comb as bc n1 n2) \<and>
       NFA_isomorphic_wf (\<alpha>3 (bool_comb as bc n1 n2)) (NFA.efficient_bool_comb_NFA bc (\<alpha>1 n1) (\<alpha>2 n2))"
  begin
    lemma bool_comb_correct:
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow> invar4 as \<Longrightarrow>
         \<alpha>4 as = \<Sigma> (\<alpha>1 n1) \<inter> \<Sigma> (\<alpha>2 n2) \<Longrightarrow> invar3 (bool_comb as bc n1 n2)"
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow> invar4 as \<Longrightarrow>
         \<alpha>4 as = \<Sigma> (\<alpha>1 n1) \<inter> \<Sigma> (\<alpha>2 n2) \<Longrightarrow>
         NFA_isomorphic_wf (\<alpha>3 (bool_comb as bc n1 n2)) (NFA.efficient_bool_comb_NFA bc (\<alpha>1 n1) (\<alpha>2 n2))"
      using bool_comb_correct_aux by simp_all

    lemma bool_comb_correct___isomorphic:
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow> invar4 as \<Longrightarrow>
         \<alpha>4 as = \<Sigma> (\<alpha>1 n1) \<inter> \<Sigma> (\<alpha>2 n2) \<Longrightarrow> invar3 (bool_comb as bc n1 n2)"
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow> invar4 as \<Longrightarrow>
         \<alpha>4 as = \<Sigma> (\<alpha>1 n1) \<inter> \<Sigma> (\<alpha>2 n2) \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>1 n1) \<A>1 \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>2 n2) \<A>2 \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>3 (bool_comb as bc n1 n2)) (NFA.efficient_bool_comb_NFA bc \<A>1 \<A>2)"
      apply (simp add: bool_comb_correct)
      apply (insert bool_comb_correct(2)[of n1 n2 as bc]
                    NFA_isomorphic_efficient_bool_comb_NFA [of "\<alpha>1 n1" \<A>1 "\<alpha>2 n2" \<A>2 bc])
      apply (metis NFA_isomorphic_wf_trans)
    done
  end

  locale nfa_bool_comb = nfa \<alpha>1 invar1 + nfa \<alpha>2 invar2 + nfa \<alpha>3 invar3
    for \<alpha>1 :: "('q1,'a,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q2,'a,'nfa2) nfa_\<alpha>" and invar2 and
        \<alpha>3 :: "('q3,'a,'nfa3) nfa_\<alpha>" and invar3 +
    fixes bool_comb :: "(bool \<Rightarrow> bool \<Rightarrow> bool) \<Rightarrow> 'nfa1 \<Rightarrow> 'nfa2 \<Rightarrow> 'nfa3"
    assumes bool_comb_correct_aux:
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow> \<Sigma> (\<alpha>1 n1) = \<Sigma> (\<alpha>2 n2) \<Longrightarrow>
       invar3 (bool_comb bc n1 n2) \<and>
       NFA_isomorphic_wf (\<alpha>3 (bool_comb bc n1 n2))
         (NFA.efficient_bool_comb_NFA bc (\<alpha>1 n1) (\<alpha>2 n2))"
  begin
    lemma bool_comb_correct:
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow> \<Sigma> (\<alpha>1 n1) = \<Sigma> (\<alpha>2 n2) \<Longrightarrow> invar3 (bool_comb bc n1 n2)"
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow> \<Sigma> (\<alpha>1 n1) = \<Sigma> (\<alpha>2 n2) \<Longrightarrow> NFA_isomorphic_wf (\<alpha>3 (bool_comb bc n1 n2))
                                     (NFA.efficient_bool_comb_NFA bc (\<alpha>1 n1) (\<alpha>2 n2))"
      using bool_comb_correct_aux by (simp_all)

    lemma bool_comb_correct___isomorphic:
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow> \<Sigma> (\<alpha>1 n1) = \<Sigma> (\<alpha>2 n2) \<Longrightarrow> invar3 (bool_comb bc n1 n2)"
      "invar1 n1 \<Longrightarrow> invar2 n2 \<Longrightarrow>
       \<Sigma> (\<alpha>1 n1) = \<Sigma> (\<alpha>2 n2) \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>1 n1) \<A>1 \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>2 n2) \<A>2 \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>3 (bool_comb bc n1 n2)) (NFA.efficient_bool_comb_NFA bc \<A>1 \<A>2)"
      apply (simp add: bool_comb_correct)
      apply (insert bool_comb_correct(2)[of n1 n2 bc]
                    NFA_isomorphic_efficient_bool_comb_NFA [of "\<alpha>1 n1" \<A>1 "\<alpha>2 n2" \<A>2 bc])
      apply (metis NFA_isomorphic_wf_trans)
    done
  end

  locale nfa_bool_comb_gen_same = nfa_bool_comb_gen \<alpha> invar \<alpha> invar \<alpha> invar \<alpha>_s invar_s bool_comb
    for \<alpha> :: "('q::{automaton_states},'a,'nfa1) nfa_\<alpha>" and invar and
        \<alpha>_s :: "'a_set \<Rightarrow> 'a set" and invar_s bool_comb
  begin
    lemma bool_comb_correct___same:
      "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow> invar_s as \<Longrightarrow>
         \<alpha>_s as = \<Sigma> (\<alpha> n1) \<inter> \<Sigma> (\<alpha> n2) \<Longrightarrow> invar (bool_comb as bc n1 n2)"
      "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow> invar_s as \<Longrightarrow>
         \<alpha>_s as = \<Sigma> (\<alpha> n1) \<inter> \<Sigma> (\<alpha> n2) \<Longrightarrow>
         NFA_isomorphic_wf (\<alpha> (bool_comb as bc n1 n2))
              (NFA_bool_comb bc (\<alpha> n1) (\<alpha> n2))"
       using bool_comb_correct [of n1 n2 as bc] nfa_axioms[unfolded nfa_def]
             NFA_bool_comb___isomorphic_wf [of "\<alpha> n1" "\<alpha> n2" bc]
       by (simp_all, metis NFA_isomorphic_wf_trans)

    lemma bool_comb_correct___same_isomorphic:
      "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow> invar_s as \<Longrightarrow>
         \<alpha>_s as = \<Sigma> (\<alpha> n1) \<inter> \<Sigma> (\<alpha> n2) \<Longrightarrow> invar (bool_comb as bc n1 n2)"
      "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow> invar_s as \<Longrightarrow>
         \<alpha>_s as = \<Sigma> (\<alpha> n1) \<inter> \<Sigma> (\<alpha> n2) \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha> n1) \<A>1 \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha> n2) \<A>2 \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha> (bool_comb as bc n1 n2)) (NFA_bool_comb bc \<A>1 \<A>2)"
      apply (simp add: bool_comb_correct)
      apply (insert bool_comb_correct___isomorphic(2)[of n1 n2 as \<A>1 \<A>2 bc]
             nfa_axioms[unfolded nfa_def]
             NFA_bool_comb___isomorphic_wf [of \<A>1 \<A>2 bc])
      apply (simp add: NFA_isomorphic_wf_refl)
      apply (metis NFA_isomorphic_wf_trans NFA_isomorphic_wf_alt_def)
    done
  end

  locale nfa_bool_comb_same = nfa_bool_comb \<alpha> invar \<alpha> invar \<alpha> invar bool_comb
    for \<alpha> :: "('q::{automaton_states},'a,'nfa1) nfa_\<alpha>" and invar bool_comb
  begin
    lemma bool_comb_correct___same:
      "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow>
         \<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> n2) \<Longrightarrow> invar (bool_comb bc n1 n2)"
      "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow>
         \<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> n2) \<Longrightarrow>
         NFA_isomorphic_wf (\<alpha> (bool_comb bc n1 n2))
              (NFA_bool_comb bc (\<alpha> n1) (\<alpha> n2))"
       using bool_comb_correct [of n1 n2 bc] nfa_axioms[unfolded nfa_def]
             NFA_bool_comb___isomorphic_wf [of "\<alpha> n1" "\<alpha> n2" bc]
       by (simp_all, metis NFA_isomorphic_wf_trans)

    lemma bool_comb_correct___same_isomorphic:
      "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow>
         \<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> n2) \<Longrightarrow> invar (bool_comb bc n1 n2)"
      "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow> \<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> n2) \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha> n1) \<A>1 \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha> n2) \<A>2 \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha> (bool_comb bc n1 n2)) (NFA_bool_comb bc \<A>1 \<A>2)"
      apply (simp add: bool_comb_correct)
      apply (insert bool_comb_correct___isomorphic(2)[of n1 n2 \<A>1 \<A>2 bc]
             nfa_axioms[unfolded nfa_def]
             NFA_bool_comb___isomorphic_wf [of \<A>1 \<A>2 bc])
      apply (simp add: NFA_isomorphic_wf_refl)
      apply (metis NFA_isomorphic_wf_trans NFA_isomorphic_wf_alt_def)
    done
  end

  locale nfa_determinise = n1: nfa \<alpha>1 invar1 + n2: nfa \<alpha>2 invar2
    for \<alpha>1 :: "('q1::{automaton_states},'a,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q2,'a,'nfa2) nfa_\<alpha>" and invar2 +
    fixes determinise :: "'nfa1 \<Rightarrow> 'nfa2"
    assumes determinise_correct_aux:
      "invar1 n \<Longrightarrow> invar2 (determinise n) \<and>
       NFA_isomorphic_wf (\<alpha>2 (determinise n)) (efficient_determinise_NFA (\<alpha>1 n))"
  begin
    lemma determinise_correct:
      "invar1 n \<Longrightarrow> invar2 (determinise n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>2 (determinise n)) (efficient_determinise_NFA (\<alpha>1 n))"
      using determinise_correct_aux by (simp_all)

    lemma determinise_correct___isomorphic:
      "invar1 n \<Longrightarrow> invar2 (determinise n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>1 n) \<A> \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>2 (determinise n)) (efficient_determinise_NFA \<A>)"
      apply (simp add: determinise_correct)
      apply (insert determinise_correct(2)[of n]
                    NFA_isomorphic_efficient_determinise [of "\<alpha>1 n" \<A>])
      apply (metis NFA_isomorphic_wf_trans)
    done

    lemma determinise_correct___same:
      "invar1 n \<Longrightarrow> invar2 (determinise n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>2 (determinise n)) (NFA_determinise (\<alpha>1 n))"
       using determinise_correct [of n] n1.nfa_axioms[unfolded nfa_def]
             NFA_determinise_isomorphic_wf [of "\<alpha>1 n"]
       by (simp_all, metis NFA_isomorphic_wf_trans)

    lemma determinise_correct___same_isomorphic:
      "invar1 n \<Longrightarrow> invar2 (determinise n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>1 n) \<A> \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>2 (determinise n)) (NFA_determinise \<A>)"
      apply (simp add: determinise_correct)
      apply (insert determinise_correct___isomorphic(2)[of n \<A>]
                    NFA_determinise_isomorphic_wf [of \<A>])
      apply (simp)
      apply (metis NFA_isomorphic_wf_trans NFA_isomorphic_wf_alt_def)
    done
  end

  locale nfa_minimise = n1: nfa \<alpha>1 invar1 + n2: nfa \<alpha>2 invar2
    for \<alpha>1 :: "('q1::{automaton_states},'a,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q2,'a,'nfa2) nfa_\<alpha>" and invar2 +
    fixes minimise :: "'nfa1 \<Rightarrow> 'nfa2"
    assumes nfa_minimise_correct_aux:
      "invar1 n \<Longrightarrow> invar2 (minimise n) \<and>
       NFA_isomorphic_wf (\<alpha>2 (minimise n)) (NFA_minimise (\<alpha>1 n))"
  begin
    lemma nfa_minimise_correct:
      "invar1 n \<Longrightarrow> invar2 (minimise n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>2 (minimise n)) (NFA_minimise (\<alpha>1 n))"
      using nfa_minimise_correct_aux by (simp_all)

    lemma nfa_minimise_correct___isomorphic:
      "invar1 n \<Longrightarrow> invar2 (minimise n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>1 n) \<A> \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>2 (minimise n)) (NFA_minimise \<A>)"
      apply (simp add: nfa_minimise_correct)
      apply (insert nfa_minimise_correct(2)[of n]
                    NFA_isomorphic_wf___minimise_cong [of "\<alpha>1 n" \<A>])
      apply (metis NFA_isomorphic_wf_trans)
    done

   lemma nfa_minimise_correct___isomorphic_Brzozowski :
      "invar1 n \<Longrightarrow> invar2 (minimise n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>1 n) (\<A>::('q3::{automaton_states}, 'a) NFA_rec) \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>2 (minimise n)) (Brzozowski \<A>)"
      apply (simp add: nfa_minimise_correct)
      apply (insert nfa_minimise_correct___isomorphic(2)[of n \<A>]
                    Brzozowski___minimise [of \<A>])
      apply (metis NFA_isomorphic_wf_alt_def NFA_isomorphic_wf_sym NFA_isomorphic_wf_trans)
    done
  end

  locale dfa_minimise = n1: nfa \<alpha>1 invar1 + n2: nfa \<alpha>2 invar2
    for \<alpha>1 :: "('q1::{automaton_states},'a,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q2,'a,'nfa2) nfa_\<alpha>" and invar2 +
    fixes minimise :: "'nfa1 \<Rightarrow> 'nfa2"
    assumes dfa_minimise_correct_aux:
      "invar1 n \<Longrightarrow> DFA (\<alpha>1 n) \<Longrightarrow> SemiAutomaton_is_initially_connected (\<alpha>1 n) \<Longrightarrow> invar2 (minimise n) \<and>
       NFA_isomorphic_wf (\<alpha>2 (minimise n)) (NFA_minimise (\<alpha>1 n))"
  begin
    lemma dfa_minimise_correct:
      "invar1 n \<Longrightarrow> DFA (\<alpha>1 n) \<Longrightarrow> SemiAutomaton_is_initially_connected (\<alpha>1 n) \<Longrightarrow> invar2 (minimise n)"
      "invar1 n \<Longrightarrow> DFA (\<alpha>1 n) \<Longrightarrow> SemiAutomaton_is_initially_connected (\<alpha>1 n) \<Longrightarrow>
           NFA_isomorphic_wf (\<alpha>2 (minimise n)) (NFA_minimise (\<alpha>1 n))"
      using dfa_minimise_correct_aux by (simp_all)

    lemma dfa_minimise_correct___isomorphic:
      "invar1 n \<Longrightarrow> DFA \<A> \<Longrightarrow> SemiAutomaton_is_initially_connected \<A> \<Longrightarrow> NFA_isomorphic_wf (\<alpha>1 n) \<A> \<Longrightarrow> invar2 (minimise n)"
      "invar1 n \<Longrightarrow> DFA \<A> \<Longrightarrow> SemiAutomaton_is_initially_connected \<A> \<Longrightarrow> NFA_isomorphic_wf (\<alpha>1 n) \<A> \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>2 (minimise n)) (NFA_minimise \<A>)"
      apply (insert dfa_minimise_correct[of n]
                    NFA_isomorphic_wf___minimise_cong [of "\<alpha>1 n" \<A>]
                    NFA_isomorphic_wf___DFA [of "\<alpha>1 n" \<A>]
                    SemiAutomaton_is_initially_connected___NFA_isomorphic_wf [of "\<alpha>1 n" \<A>])
      apply simp_all
      apply (metis NFA_isomorphic_wf_trans)
    done
  end

  lemma nfa_minimise_sublocale :
  assumes pre: "nfa_minimise \<alpha>1 invar1 \<alpha>2 invar2 minimise"
  shows "dfa_minimise \<alpha>1 invar1 \<alpha>2 invar2 minimise"
  using assms
  unfolding dfa_minimise_def dfa_minimise_axioms_def nfa_minimise_def nfa_minimise_axioms_def
  by simp

  locale nfa_right_quotient_lists = n1: nfa \<alpha>1 invar1 + n2: nfa \<alpha>2 invar2
    for \<alpha>1 :: "('q1,'a,'nfa1) nfa_\<alpha>" and invar1 and
        \<alpha>2 :: "('q2,'a,'nfa2) nfa_\<alpha>" and invar2 +
    fixes right_quotient_lists :: "('a \<Rightarrow> bool) \<Rightarrow> 'nfa1 \<Rightarrow> 'nfa2"
    assumes right_quotient_lists_correct_aux:
      "invar1 n \<Longrightarrow> invar2 (right_quotient_lists AP n) \<and>
       NFA_isomorphic_wf (\<alpha>2 (right_quotient_lists AP n)) (NFA_right_quotient_lists (\<alpha>1 n) {a. AP a})"
  begin
    lemma right_quotient_lists_correct:
      "invar1 n \<Longrightarrow> invar2 (right_quotient_lists AP n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>2 (right_quotient_lists AP n)) (NFA_right_quotient_lists (\<alpha>1 n) {a. AP a})"
      using right_quotient_lists_correct_aux by (simp_all)

    lemma right_quotient_lists_correct___isomorphic:
      "invar1 n \<Longrightarrow> invar2 (right_quotient_lists AP n)"
      "invar1 n \<Longrightarrow> NFA_isomorphic_wf (\<alpha>1 n) \<A> \<Longrightarrow> (AS \<inter> \<Sigma> \<A> = {a. AP a} \<inter>  \<Sigma> \<A>) \<Longrightarrow>
       NFA_isomorphic_wf (\<alpha>2 (right_quotient_lists AP n)) (NFA_right_quotient_lists \<A> AS)"
    proof -
      assume invar: "invar1 n"
      from right_quotient_lists_correct(1)[OF invar]
      show "invar2 (right_quotient_lists AP n)" by simp

      assume iso: "NFA_isomorphic_wf (\<alpha>1 n) \<A>"
      assume AS_eq: "(AS \<inter> \<Sigma> \<A> = {a. AP a} \<inter>  \<Sigma> \<A>)"

      from iso have wf_A: "NFA \<A>" unfolding NFA_isomorphic_wf_alt_def by simp

      from right_quotient_lists_correct(2)[OF invar, of AP]
           NFA_isomorphic_right_quotient [OF iso, of "lists {a. AP a}"]
      have "NFA_isomorphic_wf (\<alpha>2 (right_quotient_lists AP n))
                              (NFA_right_quotient_lists \<A> {a. AP a})"
        by (rule NFA_isomorphic_wf_trans)

      with NFA.NFA_right_quotient_lists_inter [of \<A> "{a. AP a}"]
           NFA.NFA_right_quotient_lists_inter [of \<A> AS] AS_eq wf_A
      show "NFA_isomorphic_wf (\<alpha>2 (right_quotient_lists AP n)) (NFA_right_quotient_lists \<A> AS)"
        by simp
    qed
  end

  locale nfa_language_is_empty = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes is_empty :: "'nfa \<Rightarrow> bool"
    assumes language_is_empty_correct:
       "invar n \<Longrightarrow> is_empty n \<longleftrightarrow> \<L> (\<alpha> n) = {}"
  begin
    lemma language_is_empty_correct___isomorphic:
       "\<lbrakk>invar n; NFA_isomorphic_wf (\<alpha> n) (\<A> :: ('q2, 'a) NFA_rec)\<rbrakk> \<Longrightarrow>
         is_empty n \<longleftrightarrow> \<L> \<A> = {}"
      using language_is_empty_correct[of n]
    by (metis NFA_isomorphic_wf_\<L>)
  end

  locale nfa_language_is_univ = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes is_univ :: "'nfa \<Rightarrow> bool"
    assumes language_is_univ_correct:
       "invar n \<Longrightarrow> is_univ n \<longleftrightarrow> \<L> (\<alpha> n) = lists (\<Sigma> (\<alpha> n))"
  begin
    lemma language_is_univ_correct___isomorphic:
       "\<lbrakk>invar n; NFA_isomorphic_wf (\<alpha> n) (\<A> :: ('q2, 'a) NFA_rec)\<rbrakk> \<Longrightarrow>
         is_univ n \<longleftrightarrow> \<L> \<A> = lists (\<Sigma> \<A>)"
      using language_is_univ_correct[of n]
    by (metis NFA_isomorphic_wf_\<L> NFA_isomorphic_wf_\<Sigma>)
  end

  locale nfa_language_is_subset = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes is_subset :: "'nfa \<Rightarrow> 'nfa \<Rightarrow> bool"
    assumes language_is_subset_correct:
       "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow> \<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> n2) \<Longrightarrow> is_subset n1 n2 \<longleftrightarrow> \<L> (\<alpha> n1) \<subseteq> \<L> (\<alpha> n2)"
  begin
    lemma language_is_subset_correct___isomorphic:
       "\<lbrakk>invar n1; invar n2; \<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> n2);
         NFA_isomorphic_wf (\<alpha> n1) (\<A>1 :: ('q2, 'a) NFA_rec);
         NFA_isomorphic_wf (\<alpha> n2) (\<A>2 :: ('q3, 'a) NFA_rec)\<rbrakk> \<Longrightarrow>
         is_subset n1 n2 \<longleftrightarrow> \<L> \<A>1 \<subseteq> \<L> \<A>2"
      using language_is_subset_correct[of n1 n2]
    by (metis NFA_isomorphic_wf_\<L>)
  end

  locale nfa_language_is_eq = nfa +
    constrains \<alpha> :: "('q,'a,'nfa) nfa_\<alpha>"
    fixes is_eq :: "'nfa \<Rightarrow> 'nfa \<Rightarrow> bool"
    assumes language_is_eq_correct:
       "invar n1 \<Longrightarrow> invar n2 \<Longrightarrow> \<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> n2) \<Longrightarrow> is_eq n1 n2 \<longleftrightarrow> \<L> (\<alpha> n1) = \<L> (\<alpha> n2)"
  begin
    lemma language_is_eq_correct___isomorphic:
       "\<lbrakk>invar n1; invar n2; \<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> n2); NFA_isomorphic_wf (\<alpha> n1) (\<A>1 :: ('q2, 'a) NFA_rec);
         NFA_isomorphic_wf (\<alpha> n2) (\<A>2 :: ('q3, 'a) NFA_rec)\<rbrakk> \<Longrightarrow>
         is_eq n1 n2 \<longleftrightarrow> \<L> \<A>1 = \<L> \<A>2"
      using language_is_eq_correct[of n1 n2]
    by (metis NFA_isomorphic_wf_\<L>)
  end

  subsection \<open> Record Based Interface \<close>

  record ('q,'a,'nfa) nfa_ops =
    nfa_op_\<alpha> :: "('q::{automaton_states},'a,'nfa) nfa_\<alpha>"
    nfa_op_invar :: "'nfa \<Rightarrow> bool"
    nfa_op_nfa_from_list :: "('q,'a,'nfa) nfa_from_list"
    nfa_op_dfa_from_list :: "('q,'a,'nfa) nfa_from_list"
    nfa_op_to_list :: "('q,'a,'nfa) nfa_to_list"
    nfa_op_to_list_simple :: "('q,'a,'nfa) nfa_to_list_simple"
    nfa_op_states_no :: "'nfa \<Rightarrow> nat"
    nfa_op_labels_no :: "'nfa \<Rightarrow> nat"
    nfa_op_trans_no :: "'nfa \<Rightarrow> nat"
    nfa_op_initial_no :: "'nfa \<Rightarrow> nat"
    nfa_op_final_no :: "'nfa \<Rightarrow> nat"
    nfa_op_accept :: "('q,'a,'nfa) nfa_accept"
    nfa_op_rename_labels :: "('a,'a,'nfa,'nfa) nfa_rename_labels"
    nfa_op_normalise :: "'nfa \<Rightarrow> 'nfa"
    nfa_op_reverse :: "'nfa \<Rightarrow> 'nfa"
    nfa_op_complement :: "'nfa \<Rightarrow> 'nfa"
    nfa_op_bool_comb :: "(bool \<Rightarrow> bool \<Rightarrow> bool) \<Rightarrow> 'nfa \<Rightarrow> 'nfa \<Rightarrow> 'nfa"
    nfa_op_determinise :: "'nfa \<Rightarrow> 'nfa"
    nfa_op_minimise_Brzozowski :: "'nfa \<Rightarrow> 'nfa"
    nfa_op_minimise_Hopcroft :: "'nfa \<Rightarrow> 'nfa"
    nfa_op_minimise_Hopcroft_NFA :: "'nfa \<Rightarrow> 'nfa"
    nfa_op_right_quotient_lists :: "('a \<Rightarrow> bool) \<Rightarrow> 'nfa \<Rightarrow> 'nfa"
    nfa_op_language_is_empty :: "'nfa \<Rightarrow> bool"
    nfa_op_language_is_univ :: "'nfa \<Rightarrow> bool"
    nfa_op_language_is_subset :: "'nfa \<Rightarrow> 'nfa \<Rightarrow> bool"
    nfa_op_language_is_eq :: "'nfa \<Rightarrow> 'nfa \<Rightarrow> bool"

  locale StdNFADefs =
    fixes ops :: "('q::{automaton_states},'a,'nfa) nfa_ops"
  begin
    abbreviation \<alpha> where "\<alpha> \<equiv> nfa_op_\<alpha> ops"
    abbreviation invar where "invar \<equiv> nfa_op_invar ops"
    abbreviation nfa_from_list where "nfa_from_list \<equiv> nfa_op_nfa_from_list ops"
    abbreviation dfa_from_list where "dfa_from_list \<equiv> nfa_op_dfa_from_list ops"
    abbreviation to_list where "to_list \<equiv> nfa_op_to_list ops"
    abbreviation accept where "accept \<equiv> nfa_op_accept ops"
    abbreviation rename_labels where "rename_labels \<equiv> nfa_op_rename_labels ops"
    abbreviation normalise where "normalise \<equiv> nfa_op_normalise ops"
    abbreviation reverse where "reverse \<equiv> nfa_op_reverse ops"
    abbreviation complement where "complement \<equiv> nfa_op_complement ops"
    abbreviation bool_comb where "bool_comb \<equiv> nfa_op_bool_comb ops"
    abbreviation product where "product \<equiv> bool_comb (\<and>)"
    abbreviation determinise where "determinise \<equiv> nfa_op_determinise ops"
    abbreviation minimise_Brzozowski where "minimise_Brzozowski \<equiv> nfa_op_minimise_Brzozowski ops"
    abbreviation minimise_Hopcroft where "minimise_Hopcroft \<equiv> nfa_op_minimise_Hopcroft ops"
    abbreviation minimise_Hopcroft_NFA where "minimise_Hopcroft_NFA \<equiv> nfa_op_minimise_Hopcroft_NFA ops"
    abbreviation right_quotient_lists where "right_quotient_lists \<equiv> nfa_op_right_quotient_lists ops"
    abbreviation to_list_simple where "to_list_simple \<equiv> nfa_op_to_list_simple ops"
    abbreviation states_no where "states_no \<equiv> nfa_op_states_no ops"
    abbreviation labels_no where "labels_no \<equiv> nfa_op_labels_no ops"
    abbreviation trans_no where "trans_no \<equiv> nfa_op_trans_no ops"
    abbreviation initial_no where "initial_no \<equiv> nfa_op_initial_no ops"
    abbreviation final_no where "final_no \<equiv> nfa_op_final_no ops"
    abbreviation language_is_empty where "language_is_empty \<equiv> nfa_op_language_is_empty ops"
    abbreviation language_is_univ where "language_is_univ \<equiv> nfa_op_language_is_univ ops"
    abbreviation language_is_subset where "language_is_subset \<equiv> nfa_op_language_is_subset ops"
    abbreviation language_is_eq where "language_is_eq \<equiv> nfa_op_language_is_eq ops"
  end

  locale StdNFA = StdNFADefs +
    nfa \<alpha> invar +
    nfa_from_list \<alpha> invar nfa_from_list +
    dfa_from_list \<alpha> invar dfa_from_list +
    nfa_to_list \<alpha> invar to_list +
    nfa_to_list_simple \<alpha> invar to_list_simple +
    nfa_stats \<alpha> invar states_no labels_no trans_no initial_no final_no +
    nfa_accept \<alpha> invar accept +
    nfa_rename_labels \<alpha> invar \<alpha> invar rename_labels +
    nfa_normalise \<alpha> invar normalise +
    nfa_reverse \<alpha> invar \<alpha> invar reverse +
    nfa_complement \<alpha> invar complement +
    nfa_bool_comb_same \<alpha> invar bool_comb +
    nfa_determinise \<alpha> invar \<alpha> invar determinise +
    min_brz: nfa_minimise \<alpha> invar \<alpha> invar minimise_Brzozowski +
    min_Hop: nfa_minimise \<alpha> invar \<alpha> invar minimise_Hopcroft_NFA +
    min_Hop_dfa: dfa_minimise \<alpha> invar \<alpha> invar minimise_Hopcroft +
    nfa_right_quotient_lists \<alpha> invar \<alpha> invar right_quotient_lists +
    nfa_language_is_empty \<alpha> invar language_is_empty +
    nfa_language_is_univ \<alpha> invar language_is_univ +
    nfa_language_is_subset \<alpha> invar language_is_subset +
    nfa_language_is_eq \<alpha> invar language_is_eq
  begin
    lemmas nfa_minimise_Brzozowski_correct = min_brz.nfa_minimise_correct
    lemmas nfa_minimise_Hopcroft_correct = min_Hop.nfa_minimise_correct
    lemmas dfa_minimise_Hopcroft_correct = min_Hop_dfa.dfa_minimise_correct
    lemmas nfa_minimise_Brzozowski_correct___isomorphic = min_brz.nfa_minimise_correct___isomorphic
    lemmas nfa_minimise_Brzozowski_correct___isomorphic_Brzozowski= min_brz.nfa_minimise_correct___isomorphic_Brzozowski
    lemmas nfa_minimise_Hopcroft_correct___isomorphic = min_Hop.nfa_minimise_correct___isomorphic
    lemmas dfa_minimise_Hopcroft_correct___isomorphic = min_Hop_dfa.dfa_minimise_correct___isomorphic

    lemmas correct = nfa_from_list_correct dfa_from_list_correct to_list_correct
                     to_list_simple_correct stats_correct
                     accept_correct rename_labels_correct
                     normalise_correct reverse_correct complement_correct
                     bool_comb_correct
                     determinise_correct
                     nfa_minimise_Brzozowski_correct
                     nfa_minimise_Hopcroft_correct
                     dfa_minimise_Hopcroft_correct
                     right_quotient_lists_correct
                     bool_comb_correct bool_comb_correct___same(2)
                     determinise_correct determinise_correct___same(2)
                     language_is_empty_correct
                     language_is_univ_correct
                     language_is_subset_correct
                     language_is_eq_correct

    lemmas correct_isomorphic =
       nfa_from_list_correct___isomorphic
       dfa_from_list_correct___isomorphic
       to_list_correct___isomorphic
       to_list_simple_correct___isomorphic
       stats_correct___isomorphic
       accept_correct___isomorphic
       rename_labels_correct___isomorphic
       normalise_correct___isomorphic
       reverse_correct___isomorphic
       complement_correct___isomorphic
       bool_comb_correct___isomorphic
       bool_comb_correct___same_isomorphic(2)
       determinise_correct___isomorphic
       determinise_correct___same_isomorphic(2)
       language_is_empty_correct___isomorphic
       language_is_univ_correct___isomorphic
       language_is_subset_correct___isomorphic
       language_is_eq_correct___isomorphic
       nfa_minimise_Brzozowski_correct___isomorphic
       nfa_minimise_Brzozowski_correct___isomorphic_Brzozowski(2)
       nfa_minimise_Hopcroft_correct___isomorphic
       dfa_minimise_Hopcroft_correct___isomorphic
       right_quotient_lists_correct___isomorphic
       nfa_is_wellformed NFA_isomorphic_wf_refl
       NFA_isomorphic_wf___NFA_normalise_states_cong
  end
end


(* Author: Johannes Hölzl <hoelzl@in.tum.de> *)

header {* Markov Decision Processes *}

theory Markov_Decision_Process
  imports Discrete_Time_Markov_Chain
begin

lemma funpow_increasing:
  fixes f :: "'a \<Rightarrow> ('a::complete_lattice)"
  assumes "m \<le> n" "mono f"
  shows "(f ^^ n) \<top> \<le> (f ^^ m) \<top>"
proof -
  have "(f ^^ n) \<top> = (f ^^ m) ((f ^^ (n - m)) \<top>)"
    using funpow_add[of m "n - m" f] `m \<le> n` by (simp add: comp_def)
  also have "\<dots> \<le> (f ^^ m) \<top>"
    using `mono f` by (rule funpow_mono) simp
  finally show ?thesis .
qed

lemma (in prob_space) nn_integral_le_const:
  "(AE x in M. f x \<le> c) \<Longrightarrow> 0 \<le> c \<Longrightarrow> (\<integral>\<^sup>+x. f x \<partial>M) \<le> c"
  using nn_integral_mono_AE[of f "\<lambda>x. c" M] emeasure_space_1 by simp

lemma nn_integral_less:
  assumes [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
  assumes f: "AE x in M. 0 \<le> f x" "(\<integral>\<^sup>+x. f x \<partial>M) \<noteq> \<infinity>"
  assumes ord: "AE x in M. f x \<le> g x" "\<not> (AE x in M. g x \<le> f x)"
  shows "(\<integral>\<^sup>+x. f x \<partial>M) < (\<integral>\<^sup>+x. g x \<partial>M)"
proof -
  have "0 < (\<integral>\<^sup>+x. g x - f x \<partial>M)"
  proof (intro order_le_neq_trans nn_integral_nonneg notI)
    assume "0 = (\<integral>\<^sup>+x. g x - f x \<partial>M)"
    then have "AE x in M. g x - f x \<le> 0"
      using nn_integral_0_iff_AE[of "\<lambda>x. g x - f x" M] by simp
    with f(1) ord(1) have "AE x in M. g x \<le> f x"
      by eventually_elim (auto simp: ereal_minus_le_iff)
    with ord show False
      by simp
  qed
  also have "\<dots> = (\<integral>\<^sup>+x. g x \<partial>M) - (\<integral>\<^sup>+x. f x \<partial>M)"
    by (subst nn_integral_diff) (auto simp: f ord)
  finally show ?thesis
    by (simp add: ereal_less_minus_iff f nn_integral_nonneg)
qed

context order
begin

definition
  "maximal f S = {x\<in>S. \<forall>y\<in>S. f y \<le> f x}"

lemma maximalI: "x \<in> S \<Longrightarrow> (\<And>y. y \<in> S \<Longrightarrow> f y \<le> f x) \<Longrightarrow> x \<in> maximal f S"
  by (simp add: maximal_def)

lemma maximalI_trans: "x \<in> maximal f S \<Longrightarrow> f x \<le> f y \<Longrightarrow> y \<in> S \<Longrightarrow> y \<in> maximal f S"
  unfolding maximal_def by (blast intro: antisym order_trans)

lemma maximalD1: "x \<in> maximal f S \<Longrightarrow> x \<in> S"
  by (simp add: maximal_def)

lemma maximalD2: "x \<in> maximal f S \<Longrightarrow> y \<in> S \<Longrightarrow> f y \<le> f x"
  by (simp add: maximal_def)

lemma maximal_inject: "x \<in> maximal f S \<Longrightarrow> y \<in> maximal f S \<Longrightarrow> f x = f y"
  unfolding maximal_def by (blast intro: antisym)

lemma maximal_empty[simp]: "maximal f {} = {}"
  by (simp add: maximal_def)

lemma maximal_singleton[simp]: "maximal f {x} = {x}"
  by (auto simp add: maximal_def)

lemma maximal_in_S: "maximal f S \<subseteq> S"
  using assms by (auto simp: maximal_def)

end

context linorder
begin

lemma maximal_ne:
  assumes "finite S" "S \<noteq> {}"
  shows "maximal f S \<noteq> {}"
  using assms
proof (induct rule: finite_ne_induct)
  case (insert s S)
  show ?case
  proof cases
    assume "\<forall>x\<in>S. f x \<le> f s"
    with insert have "s \<in> maximal f (insert s S)"
      by (auto intro!: maximalI)
    then show ?thesis
      by auto
  next
    assume "\<not> (\<forall>x\<in>S. f x \<le> f s)"
    then have "maximal f (insert s S) = maximal f S"
      by (auto simp: maximal_def)
    with insert show ?thesis
      by auto
  qed
qed simp

end

lemma hld_smap': "HLD x (smap f s) = HLD (f -` x) s"
  by (simp add: HLD_def)

lemma set_pmf_map: "set_pmf (map_pmf f M) = f ` set_pmf M"
  using pmf_set_map[of f] by (metis comp_def)

subsection {* Schedulers *}

text {*

We want to construct a \emph{non-free} codatatype
  @{text "'s cfg = Cfg (state: 's) (action: 's pmf) (cont: 's \<Rightarrow> 's cfg)"}.
with the restriction
  @{term "state (cont cfg s) = s"}

*}

codatatype 's scheduler = Scheduler (action_sch: "'s pmf") (cont_sch: "'s \<Rightarrow> 's scheduler")
datatype 's cfg = Cfg' (state: 's) (scheduler: "'s scheduler")

definition "action cfg = action_sch (scheduler cfg)"
definition "cont cfg s = Cfg' s (cont_sch (scheduler cfg) s)"

definition Cfg :: "'s \<Rightarrow> 's pmf \<Rightarrow> ('s \<Rightarrow> 's cfg) \<Rightarrow> 's cfg" where
  "Cfg s D c = Cfg' s (Scheduler D (\<lambda>t. scheduler (c t)))"

definition cfg_corec :: "'s \<Rightarrow> ('a \<Rightarrow> 's pmf) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> 'a)  \<Rightarrow> 'a \<Rightarrow> 's cfg" where
  "cfg_corec s d c x = Cfg' s (corec_scheduler d (\<lambda>x s. Inr (c x s)) x)"

lemma
  shows state_cont[simp]: "state (cont cfg s) = s"
    and state_Cfg[simp]: "state (Cfg s d' c') = s"
    and action_Cfg[simp]: "action (Cfg s d' c') = d'"
    and cont_Cfg[simp]: "state (c' t) = t \<Longrightarrow> cont (Cfg s d' c') t = c' t"
    and state_cfg_corec[simp]: "state (cfg_corec s d c x) = s"
    and action_cfg_corec[simp]: "action (cfg_corec s d c x) = d x"
    and cont_cfg_corec[simp]: "cont (cfg_corec s d c x) t = cfg_corec t d c (c x t)"
  by (simp_all add: cfg_corec_def Cfg_def action_def cont_def cfg.expand)

lemma cfg_coinduct[consumes 1, case_names state action cont]:
  assumes "X c d"
  assumes state: "\<And>c d. X c d \<Longrightarrow> state c = state d"
  assumes action:  "\<And>c d. X c d \<Longrightarrow> action c = action d"
  assumes cont: "\<And>c d t. X c d \<Longrightarrow> X (cont c t) (cont d t)"
  shows "c = d"
proof (intro cfg.expand conjI assms)
  from `X c d` show "scheduler c = scheduler d"
    by (coinduction arbitrary: c d)
       (auto intro!: exI[of _ "cont c y" for c y] dest: cont action simp: cont_def action_def)
qed

subsubsection {* Memoryless scheduler *}

definition "memoryless_on f s = cfg_corec s f (\<lambda>_ t. t) s"

lemma
  shows state_memoryless_on[simp]: "state (memoryless_on f s) = s"
    and action_memoryless_on[simp]: "action (memoryless_on f s) = f s"
    and cont_memoryless_on[simp]: "cont (memoryless_on f s) t = memoryless_on f t"
  by (simp_all add: memoryless_on_def)

definition K_cfg :: "'s cfg \<Rightarrow> 's cfg pmf" where
  "K_cfg cfg = map_pmf (cont cfg) (action cfg)"

lemma set_K_cfg: "set_pmf (K_cfg cfg) = cont cfg ` set_pmf (action cfg)"
  by (simp add: K_cfg_def set_pmf_map)

lemma nn_integral_K_cfg: "(\<integral>\<^sup>+cfg. f cfg \<partial>K_cfg cfg) = (\<integral>\<^sup>+s. f (cont cfg s) \<partial>action cfg)"
  by (simp add: K_cfg_def map_pmf.rep_eq nn_integral_distr)

subsection {* Markov Decision Process *}

locale Markov_Decision_Process =
  fixes K :: "'s \<Rightarrow> 's pmf set"
  assumes K_wf: "\<And>s. K s \<noteq> {}"
begin

definition "E = (SIGMA s:UNIV. \<Union>D\<in>K s. set_pmf D)"

coinductive cfg_onp :: "'s \<Rightarrow> 's cfg \<Rightarrow> bool" where
  "\<And>s. state cfg = s \<Longrightarrow> action cfg \<in> K s \<Longrightarrow> (\<And>t. t \<in> action cfg \<Longrightarrow> cfg_onp t (cont cfg t)) \<Longrightarrow>
    cfg_onp s cfg"

definition "cfg_on s = {cfg. cfg_onp s cfg}"

lemma
  shows cfg_onD_action[intro, simp]: "cfg \<in> cfg_on s \<Longrightarrow> action cfg \<in> K s"
    and cfg_onD_cont[intro, simp]: "cfg \<in> cfg_on s \<Longrightarrow> t \<in> action cfg \<Longrightarrow> cont cfg t \<in> cfg_on t"
    and cfg_onD_state[simp]: "cfg \<in> cfg_on s \<Longrightarrow> state cfg = s"
    and cfg_onI: "state cfg = s \<Longrightarrow> action cfg \<in> K s \<Longrightarrow> (\<And>t. t \<in> action cfg \<Longrightarrow> cont cfg t \<in> cfg_on t) \<Longrightarrow> cfg \<in> cfg_on s"
  by (auto simp: cfg_on_def intro: cfg_onp.intros elim: cfg_onp.cases)

lemma cfg_on_coinduct[coinduct set: cfg_on]:
  assumes "P s cfg"
  assumes "\<And>cfg s. P s cfg \<Longrightarrow> state cfg = s"
  assumes "\<And>cfg s. P s cfg \<Longrightarrow> action cfg \<in> K s"
  assumes "\<And>cfg s t. P s cfg \<Longrightarrow> t \<in> action cfg \<Longrightarrow> P t (cont cfg t)"
  shows "cfg \<in> cfg_on s"
  using assms cfg_onp.coinduct[of P s cfg] by (simp add: cfg_on_def)

lemma memoryless_on_cfg_onI:
  assumes "\<And>s. f s \<in> K s"
  shows "memoryless_on f s \<in> cfg_on s"
  by (coinduction arbitrary: s) (auto intro: assms)

lemma cfg_of_cfg_onI:
  "D \<in> K s \<Longrightarrow> (\<And>t. t \<in> D \<Longrightarrow> c t \<in> cfg_on t) \<Longrightarrow> Cfg s D c \<in> cfg_on s"
  by (rule cfg_onI) auto

definition "arb_act s = (SOME D. D \<in> K s)"

lemma cfg_on_not_empty[intro, simp]: "cfg_on s \<noteq> {}"
  by (auto intro: memoryless_on_cfg_onI arb_actI)

sublocale MC!: MC_syntax K_cfg .

abbreviation St :: "'s stream measure" where
  "St \<equiv> stream_space (count_space UNIV)"

definition "T cfg = distr (MC.T cfg) St (smap state)"

sublocale T!: prob_space "T cfg" for cfg
  by (simp add: T_def MC.T.prob_space_distr)

lemma space_T[simp]: "space (T cfg) = space St"
  by (simp add: T_def)

lemma sets_T[simp]: "sets (T cfg) = sets St"
  by (simp add: T_def)

lemma measurable_T1[simp]: "measurable (T cfg) N = measurable St N"
  by (simp add: T_def)

lemma measurable_T2[simp]: "measurable N (T cfg) = measurable N St"
  by (simp add: T_def)

lemma nn_integral_T:
  assumes [measurable]: "f \<in> borel_measurable St"
  shows "(\<integral>\<^sup>+X. f X \<partial>T cfg) = (\<integral>\<^sup>+cfg'. (\<integral>\<^sup>+x. f (state cfg' ## x) \<partial>T cfg') \<partial>K_cfg cfg)"
  by (simp add: T_def MC.nn_integral_T[of _ cfg] nn_integral_distr)

lemma emeasure_Collect_T:
  assumes [measurable]: "Measurable.pred St P"
  shows "emeasure (T cfg) {x\<in>space St. P x} =
    (\<integral>\<^sup>+cfg'. emeasure (T cfg') {x\<in>space St. P (state cfg' ## x)} \<partial>K_cfg cfg)"
  using MC.emeasure_Collect_T[of "\<lambda>x. P (smap state x)" cfg]
  by (simp add: nn_integral_distr emeasure_Collect_distr T_def)

definition "E_sup s f = (\<Squnion>cfg\<in>cfg_on s. \<integral>\<^sup>+x. f x \<partial>T cfg)"

lemma E_sup_nonneg: "0 \<le> E_sup s f"
  by (auto intro!: SUP_upper2 nn_integral_nonneg memoryless_on_cfg_onI arb_actI simp: E_sup_def)

lemma E_sup_const: "0 \<le> c \<Longrightarrow> E_sup s (\<lambda>_. c) = c"
  using T.emeasure_space_1 by (simp add: E_sup_def)

lemma E_sup_mult_right:
  assumes [measurable]: "f \<in> borel_measurable St" and [simp]: "0 \<le> c"
  shows "E_sup s (\<lambda>x. c * f x) = c * E_sup s f"
  by (simp add: nn_integral_cmult E_sup_def SUP_ereal_mult_right nn_integral_nonneg)

lemma E_sup_mono:
  "(\<And>\<omega>. f \<omega> \<le> g \<omega>) \<Longrightarrow> E_sup s f \<le> E_sup s g"
  unfolding E_sup_def by (intro SUP_subset_mono order_refl nn_integral_mono)

lemma E_sup_add:
  assumes [measurable]: "f \<in> borel_measurable St" "g \<in> borel_measurable St"
  shows "E_sup s (\<lambda>x. f x + g x) \<le> E_sup s f + E_sup s g"
proof -
  { fix \<omega> have "f \<omega> + g \<omega> \<le> max 0 (f \<omega>) + max 0 (g \<omega>)"
      by (cases "f \<omega>" "g \<omega>" rule: ereal2_cases) (auto split: split_max) }
  then have "E_sup s (\<lambda>x. f x + g x) \<le> E_sup s (\<lambda>x. max 0 (f x) + max 0 (g x))"
    by (rule E_sup_mono)
  also have "\<dots> = (\<Squnion>cfg\<in>cfg_on s. (\<integral>\<^sup>+x. max 0 (f x) \<partial>T cfg) + (\<integral>\<^sup>+x. max 0 (g x) \<partial>T cfg))"
    by (simp add: E_sup_def nn_integral_add)
  also have "\<dots> \<le> (\<Squnion>cfg\<in>cfg_on s. \<integral>\<^sup>+x. max 0 (f x) \<partial>T cfg) + (\<Squnion>cfg\<in>cfg_on s. (\<integral>\<^sup>+x. max 0 (g x) \<partial>T cfg))"
    by (auto simp: SUP_le_iff intro!: ereal_add_mono SUP_upper)
  finally show ?thesis
    by (simp add: nn_integral_max_0 E_sup_def)
qed

lemma E_sup_add_left:
  assumes [measurable]: "f \<in> borel_measurable St" and nn: "0 \<le> c" "\<And>x. 0 \<le> f x"
  shows "E_sup s (\<lambda>x. f x + c) = E_sup s f + c"
  by (simp add: nn nn_integral_add E_sup_def T.emeasure_space_1[simplified] nn_integral_nonneg SUP_ereal_add_left)

lemma E_sup_SUP:
  assumes [measurable]: "\<And>i. f i \<in> borel_measurable St" and [simp]: "incseq f"
  shows "E_sup s (\<lambda>x. \<Squnion>i. f i x) = (\<Squnion>i. E_sup s (f i))"
  by (auto simp add: E_sup_def nn_integral_monotone_convergence_SUP intro: SUP_commute)

lemma E_sup_iterate:
  assumes [measurable]: "f \<in> borel_measurable St"
  shows "E_sup s f = (\<Squnion>D\<in>K s. \<integral>\<^sup>+ t. E_sup t (\<lambda>\<omega>. f (t ## \<omega>)) \<partial>D)"
proof -
  let ?v = "\<lambda>t. \<integral>\<^sup>+x. f (state t ## x) \<partial>T t"
  let ?p = "\<lambda>t. E_sup t (\<lambda>\<omega>. f (t ## \<omega>))"
  have "E_sup s f = (\<Squnion>cfg\<in>cfg_on s. \<integral>\<^sup>+t. ?v t \<partial>K_cfg cfg)"
    unfolding E_sup_def by (intro SUP_cong refl) (subst nn_integral_T, simp_all add: cfg_on_def)
  also have "\<dots> = (\<Squnion>D\<in>K s. \<integral>\<^sup>+t. ?p t \<partial>D)"
  proof (intro antisym SUP_least)
    fix cfg :: "'s cfg" assume cfg: "cfg \<in> cfg_on s"
    then show "(\<integral>\<^sup>+ t. ?v t \<partial>K_cfg cfg) \<le> (SUP D:K s. \<integral>\<^sup>+t. ?p t \<partial>D)"
      by (auto simp: E_sup_def nn_integral_K_cfg AE_measure_pmf_iff
               intro!: nn_integral_mono_AE SUP_upper2)
  next
    fix D assume D: "D \<in> K s" show "(\<integral>\<^sup>+t. ?p t \<partial>D) \<le> (SUP cfg : cfg_on s. \<integral>\<^sup>+ t. ?v t \<partial>K_cfg cfg)"
    proof cases
      assume p_finite: "\<forall>t\<in>D. ?p t < \<infinity>"
      show ?thesis
      proof (rule ereal_le_epsilon2, intro allI impI)
        fix e :: real assume "0 < e"
        have "\<forall>t\<in>D. \<exists>cfg\<in>cfg_on t. ?p t \<le> ?v cfg + e"
        proof
          fix t assume "t \<in> D"
          moreover have "(SUP cfg : cfg_on t. ?v cfg) = ?p t"
            unfolding E_sup_def by (simp add: cfg_on_def)
          moreover have "0 \<le> ?p t"
            by (rule E_sup_nonneg)
          ultimately have "\<bar>SUP cfg : cfg_on t. ?v cfg\<bar> \<noteq> \<infinity>"
            using p_finite by (intro ereal_infinity_cases) auto
          from SUP_approx_ereal[OF `0 < e` refl this]
          show "\<exists>cfg\<in>cfg_on t. ?p t \<le> ?v cfg + e"
            by (simp add: E_sup_def)
        qed
        then obtain cfg' where v_cfg': "\<And>t. t \<in> D \<Longrightarrow> ?p t \<le> ?v (cfg' t) + e" and
          cfg_on_cfg': "\<And>t. t \<in> D \<Longrightarrow> cfg' t \<in> cfg_on t"
          unfolding Bex_def bchoice_iff by blast

        let ?cfg = "Cfg s D cfg'"
        have cfg: "K_cfg ?cfg = map_pmf cfg' D"
          by (auto simp add: K_cfg_def fun_eq_iff intro!: map_pmf_cong dest: cfg_on_cfg')

        have "(\<integral>\<^sup>+ t. ?p t \<partial>D) \<le> (\<integral>\<^sup>+t. ?v (cfg' t) + e \<partial>D)"
          by (intro nn_integral_mono_AE) (simp add: v_cfg' AE_measure_pmf_iff)
        also have "\<dots> = (\<integral>\<^sup>+t. ?v (cfg' t) \<partial>D) + e"
          using `0 < e` measure_pmf.emeasure_space_1[of D]
          by (subst nn_integral_add) (auto intro: cfg_on_cfg' nn_integral_nonneg)
        also have "(\<integral>\<^sup>+t. ?v (cfg' t) \<partial>D) = (\<integral>\<^sup>+t. ?v t \<partial>K_cfg ?cfg)"
          by (simp add: cfg map_pmf.rep_eq nn_integral_distr)
        also have "\<dots> \<le> (SUP cfg:cfg_on s. (\<integral>\<^sup>+t. ?v t \<partial>K_cfg cfg))"
          by (auto intro!: SUP_upper intro!: cfg_of_cfg_onI D cfg_on_cfg')
        finally show "(\<integral>\<^sup>+ t. ?p t \<partial>D) \<le> (SUP cfg : cfg_on s. \<integral>\<^sup>+ t. ?v t \<partial>K_cfg cfg) + e"
          by (blast intro: ereal_add_mono)
      qed
    next
      assume "\<not> (\<forall>t\<in>D. ?p t < \<infinity>)"
      then obtain t where "t \<in> D" "?p t = \<infinity>"
        by auto
      then have "\<infinity> = pmf (D) t * ?p t"
        by (auto intro!: pmf_positive)
      also have "\<dots> = (SUP cfg : cfg_on t. pmf (D) t * ?v cfg)"
        unfolding E_sup_def
        by (auto simp add: pmf_nonneg nn_integral_nonneg intro!: SUP_ereal_mult_right[symmetric])
      also have "\<dots> \<le> (SUP cfg : cfg_on s. \<integral>\<^sup>+ t. ?v t \<partial>K_cfg cfg)"
        unfolding E_sup_def
      proof (intro SUP_least SUP_upper2)
        fix cfg :: "'s cfg" assume cfg: "cfg \<in> cfg_on t"

        let ?cfg = "Cfg s D ((memoryless_on arb_act) (t := cfg))"
        have C: "K_cfg ?cfg = map_pmf ((memoryless_on arb_act) (t := cfg)) D"
          by (auto simp add: K_cfg_def fun_eq_iff intro!: map_pmf_cong simp: cfg)

        show "?cfg \<in> cfg_on s"
          by (auto intro!: cfg_of_cfg_onI D cfg memoryless_on_cfg_onI)
        have "ereal (pmf (D) t) * (\<integral>\<^sup>+ x. f (state cfg ## x) \<partial>T cfg) =
          (\<integral>\<^sup>+t'. (\<integral>\<^sup>+ x. f (state cfg ## x) \<partial>T cfg) * indicator {t} t' \<partial>D)"
          by (subst mult_ac)
             (simp add: nn_integral_nonneg nn_integral_cmult_indicator emeasure_pmf_single)
        also have "\<dots> = (\<integral>\<^sup>+cfg. ?v cfg * indicator {t} (state cfg) \<partial>K_cfg ?cfg)"
          unfolding C using cfg
          by (auto simp add: nn_integral_distr map_pmf.rep_eq split: split_indicator
                   intro!: nn_integral_cong)
        also have "\<dots> \<le> (\<integral>\<^sup>+cfg. ?v cfg \<partial>K_cfg ?cfg)"
          by (auto intro!: nn_integral_mono nn_integral_nonneg split: split_indicator)
        finally show "ereal (pmf (D) t) * (\<integral>\<^sup>+ x. f (state cfg ## x) \<partial>T cfg)
           \<le> (\<integral>\<^sup>+ t. \<integral>\<^sup>+ x. f (state t ## x) \<partial>T t \<partial>K_cfg ?cfg)" .
      qed
      finally show ?thesis
        by simp
    qed
  qed
  finally show ?thesis .
qed

definition "P_sup s P = (\<Squnion>cfg\<in>cfg_on s. emeasure (T cfg) {x\<in>space St. P x})"

lemma P_sup_eq_E_sup:
  assumes [measurable]: "Measurable.pred St P"
  shows "P_sup s P = E_sup s (indicator {x\<in>space St. P x})"
  by (auto simp add: P_sup_def E_sup_def intro!: SUP_cong nn_integral_cong)

lemma P_sup_True[simp]: "P_sup t (\<lambda>\<omega>. True) = 1"
  using T.emeasure_space_1
  by (auto simp add: P_sup_def SUP_constant)

lemma P_sup_False[simp]: "P_sup t (\<lambda>\<omega>. False) = 0"
  by (auto simp add: P_sup_def SUP_constant)

lemma P_sup_SUP:
  fixes P :: "nat \<Rightarrow> 's stream \<Rightarrow> bool"
  assumes "mono P" and P[measurable]: "\<And>i. Measurable.pred St (P i)"
  shows "P_sup s (\<lambda>x. \<exists>i. P i x) = (\<Squnion>i. P_sup s (P i))"
proof -
  have "P_sup s (\<lambda>x. \<Squnion>i. P i x) = (\<Squnion>cfg\<in>cfg_on s. emeasure (T cfg) (\<Union>i. {x\<in>space St. P i x}))"
    by (auto simp: P_sup_def intro!: SUP_cong arg_cong2[where f=emeasure])
  also have "\<dots> = (\<Squnion>cfg\<in>cfg_on s. \<Squnion>i. emeasure (T cfg) {x\<in>space St. P i x})"
    using `mono P` by (auto intro!: SUP_cong SUP_emeasure_incseq[symmetric] simp: mono_def le_fun_def)
  also have "\<dots> = (\<Squnion>i. P_sup s (P i))"
    by (subst SUP_commute) (simp add: P_sup_def)
  finally show ?thesis
    by simp
qed

lemma P_sup_lfp:
  assumes Q: "Order_Continuity.continuous Q"
  assumes f: "f \<in> measurable St M"
  assumes Q_m: "\<And>P. Measurable.pred M P \<Longrightarrow> Measurable.pred M (Q P)"
  shows "P_sup s (\<lambda>x. lfp Q (f x)) = (\<Squnion>i. P_sup s (\<lambda>x. (Q ^^ i) \<bottom> (f x)))"
  unfolding Order_Continuity.continuous_lfp[OF Q]
  apply simp
proof (rule P_sup_SUP)
  fix i show "Measurable.pred St (\<lambda>x. (Q ^^ i) \<bottom> (f x))"
    apply (intro measurable_compose[OF f])
    by (induct i) (auto intro!: Q_m)
qed (intro mono_funpow continuous_mono[OF Q] mono_compose[where f=f])

lemma P_sup_iterate:
  assumes [measurable]: "Measurable.pred St P"
  shows "P_sup s P = (\<Squnion>D\<in>K s. \<integral>\<^sup>+ t. P_sup t (\<lambda>\<omega>. P (t ## \<omega>)) \<partial>D)"
proof -
  have [simp]: "\<And>x s. indicator {x \<in> space St. P x} (x ## s) = indicator {s \<in> space St. P (x ## s)} s"
    by (auto simp: space_stream_space split: split_indicator)
  show ?thesis
    using E_sup_iterate[of "indicator {x\<in>space St. P x}" s] by (auto simp: P_sup_eq_E_sup)
qed

definition "E_inf s f = (\<Sqinter>cfg\<in>cfg_on s. \<integral>\<^sup>+x. f x \<partial>T cfg)"

lemma E_inf_nonneg: "0 \<le> E_inf s f"
  by (simp add: E_inf_def le_INF_iff nn_integral_nonneg)

lemma E_inf_const: "0 \<le> c \<Longrightarrow> E_inf s (\<lambda>_. c) = c"
  using T.emeasure_space_1 by (simp add: E_inf_def)

lemma E_inf_mono:
  "(\<And>\<omega>. f \<omega> \<le> g \<omega>) \<Longrightarrow> E_inf s f \<le> E_inf s g"
  unfolding E_inf_def by (intro INF_superset_mono order_refl nn_integral_mono)

lemma E_inf_iterate:
  assumes [measurable]: "f \<in> borel_measurable St"
  shows "E_inf s f = (\<Sqinter>D\<in>K s. \<integral>\<^sup>+ t. E_inf t (\<lambda>\<omega>. f (t ## \<omega>)) \<partial>D)"
proof -
  let ?v = "\<lambda>t. \<integral>\<^sup>+x. f (state t ## x) \<partial>T t"
  let ?p = "\<lambda>t. E_inf t (\<lambda>\<omega>. f (t ## \<omega>))"
  have "E_inf s f = (\<Sqinter>cfg\<in>cfg_on s. \<integral>\<^sup>+t. ?v t \<partial>K_cfg cfg)"
    unfolding E_inf_def by (intro INF_cong refl) (subst nn_integral_T, simp_all add: cfg_on_def)
  also have "\<dots> = (\<Sqinter>D\<in>K s. \<integral>\<^sup>+t. ?p t \<partial>D)"
  proof (intro antisym INF_greatest)
    fix cfg :: "'s cfg" assume cfg: "cfg \<in> cfg_on s"
    then show "(INF D:K s. \<integral>\<^sup>+t. ?p t \<partial>D) \<le> (\<integral>\<^sup>+ t. ?v t \<partial>K_cfg cfg)"
      by (auto simp add: E_inf_def nn_integral_K_cfg AE_measure_pmf_iff intro!: nn_integral_mono_AE INF_lower2)
  next
    fix D assume D: "D \<in> K s" show "(INF cfg : cfg_on s. \<integral>\<^sup>+ t. ?v t \<partial>K_cfg cfg) \<le> (\<integral>\<^sup>+t. ?p t \<partial>D)"
    proof (rule ereal_le_epsilon2, intro allI impI)
      fix e :: real assume "0 < e"
      have "\<forall>t\<in>D. \<exists>cfg\<in>cfg_on t. ?v cfg \<le> ?p t + e"
      proof
        fix t assume "t \<in> D"
        show "\<exists>cfg\<in>cfg_on t. ?v cfg \<le> ?p t + e"
        proof cases
          assume "?p t = \<infinity>" with cfg_on_not_empty[of t] show ?thesis
            by (auto simp del: cfg_on_not_empty)
        next
          assume p_finite: "?p t \<noteq> \<infinity>"
          note `t \<in> D`
          moreover have "(INF cfg : cfg_on t. ?v cfg) = ?p t"
            unfolding E_inf_def by (simp add: cfg_on_def)
          moreover have "0 \<le> ?p t"
            by (rule E_inf_nonneg)
          ultimately have "\<bar>INF cfg : cfg_on t. ?v cfg\<bar> \<noteq> \<infinity>"
            using p_finite by (intro ereal_infinity_cases) auto
          from INF_approx_ereal[OF `0 < e` refl this]
          show "\<exists>cfg\<in>cfg_on t. ?v cfg \<le> ?p t + e"
            by (auto simp: E_inf_def intro: less_imp_le)
        qed
      qed
      then obtain cfg' where v_cfg': "\<And>t. t \<in> D \<Longrightarrow> ?v (cfg' t) \<le> ?p t + e" and
        cfg_on_cfg': "\<And>t. t \<in> D \<Longrightarrow> cfg' t \<in> cfg_on t"
        unfolding Bex_def bchoice_iff by blast

      let ?cfg = "Cfg s D cfg'"

      have cfg: "K_cfg ?cfg = map_pmf cfg' D"
        by (auto simp add: K_cfg_def cfg_on_cfg' intro!: map_pmf_cong)

      have "?cfg \<in> cfg_on s"
        by (auto intro: D cfg_on_cfg' cfg_of_cfg_onI)
      then have "(INF cfg : cfg_on s. \<integral>\<^sup>+ t. ?v t \<partial>K_cfg cfg) \<le> (\<integral>\<^sup>+ t. ?p t + e \<partial>D)"
        by (rule INF_lower2) (auto simp: cfg map_pmf.rep_eq nn_integral_distr v_cfg' AE_measure_pmf_iff intro!: nn_integral_mono_AE)
      also have "\<dots> = (\<integral>\<^sup>+ t. ?p t \<partial>D) + e"
        using `0 < e` by (simp add: nn_integral_add E_inf_nonneg measure_pmf.emeasure_space_1[simplified])
      finally show "(INF cfg : cfg_on s. \<integral>\<^sup>+ t. ?v t \<partial>K_cfg cfg) \<le> (\<integral>\<^sup>+ t. ?p t \<partial>D) + e" .
    qed
  qed
  finally show ?thesis .
qed

definition "P_inf s P = (\<Sqinter>cfg\<in>cfg_on s. emeasure (T cfg) {x\<in>space St. P x})"

lemma P_inf_eq_E_inf:
  assumes [measurable]: "Measurable.pred St P"
  shows "P_inf s P = E_inf s (indicator {x\<in>space St. P x})"
  by (auto simp add: P_inf_def E_inf_def intro!: SUP_cong nn_integral_cong)

lemma P_inf_True[simp]: "P_inf t (\<lambda>\<omega>. True) = 1"
  using T.emeasure_space_1
  by (auto simp add: P_inf_def SUP_constant)

lemma P_inf_False[simp]: "P_inf t (\<lambda>\<omega>. False) = 0"
  by (auto simp add: P_inf_def SUP_constant)

lemma P_inf_lfp:
  assumes Q: "Order_Continuity.down_continuous Q"
  assumes f: "f \<in> measurable St M"
  assumes Q_m: "\<And>P. Measurable.pred M P \<Longrightarrow> Measurable.pred M (Q P)"
  shows "P_inf s (\<lambda>x. gfp Q (f x)) = (\<Sqinter>i. P_inf s (\<lambda>x. (Q ^^ i) \<top> (f x)))"
  unfolding Order_Continuity.down_continuous_gfp[OF Q]
  apply simp
proof (rule P_inf_INF)
  fix i show "Measurable.pred St (\<lambda>x. (Q ^^ i) \<top> (f x))"
    apply (intro measurable_compose[OF f])
    by (induct i) (auto intro!: Q_m)
next
  show "decseq (\<lambda>i x. (Q ^^ i) \<top> (f x))"
    using down_continuous_mono[OF Q, THEN funpow_increasing[rotated]]
    unfolding decseq_def le_fun_def by auto
qed

lemma P_inf_iterate:
  assumes [measurable]: "Measurable.pred St P"
  shows "P_inf s P = (\<Sqinter>D\<in>K s. \<integral>\<^sup>+ t. P_inf t (\<lambda>\<omega>. P (t ## \<omega>)) \<partial>D)"
proof -
  have [simp]: "\<And>x s. indicator {x \<in> space St. P x} (x ## s) = indicator {s \<in> space St. P (x ## s)} s"
    by (auto simp: space_stream_space split: split_indicator)
  show ?thesis
    using E_inf_iterate[of "indicator {x\<in>space St. P x}" s] by (auto simp: P_inf_eq_E_inf)
qed

end

locale Finite_Markov_Decision_Process = Markov_Decision_Process K for K :: "'s \<Rightarrow> 's pmf set" +
  fixes S :: "'s set"
  assumes S_not_empty: "S \<noteq> {}"
  assumes S_finite: "finite S"
  assumes K_closed: "\<And>s. s \<in> S \<Longrightarrow> (\<Union>D\<in>K s. set_pmf D) \<subseteq> S"
  assumes K_finite: "\<And>s. s \<in> S \<Longrightarrow> finite (K s)"
begin

lemma action_closed: "s \<in> S \<Longrightarrow> cfg \<in> cfg_on s \<Longrightarrow> t \<in> action cfg \<Longrightarrow> t \<in> S"
  using cfg_onD_action[of cfg s] K_closed[of s] by auto

lemma set_pmf_closed: "s \<in> S \<Longrightarrow> D \<in> K s \<Longrightarrow> t \<in> D \<Longrightarrow> t \<in> S"
  using K_closed by auto

lemma Pi_closed: "ct \<in> Pi S K \<Longrightarrow> s \<in> S \<Longrightarrow> t \<in> ct s \<Longrightarrow> t \<in> S"
  using set_pmf_closed by auto

lemma set_pmf_finite: "s \<in> S \<Longrightarrow> D \<in> K s \<Longrightarrow> finite D"
  using K_closed by (intro finite_subset[OF _ S_finite]) auto

definition "valid_cfg = (\<Union>s\<in>S. cfg_on s)"

lemma valid_cfgI: "s \<in> S \<Longrightarrow> cfg \<in> cfg_on s \<Longrightarrow> cfg \<in> valid_cfg"
  by (auto simp: valid_cfg_def)

lemma valid_cfgD: "cfg \<in> valid_cfg \<Longrightarrow> cfg \<in> cfg_on (state cfg)"
  by (auto simp: valid_cfg_def)

lemma
  shows valid_cfg_state_in_S: "cfg \<in> valid_cfg \<Longrightarrow> state cfg \<in> S"
    and valid_cfg_action: "cfg \<in> valid_cfg \<Longrightarrow> s \<in> action cfg \<Longrightarrow> s \<in> S"
    and valid_cfg_cont: "cfg \<in> valid_cfg \<Longrightarrow> s \<in> action cfg \<Longrightarrow> cont cfg s \<in> valid_cfg"
  by (auto simp: valid_cfg_def intro!: bexI[of _ s] intro: action_closed)

lemma valid_K_cfg[intro]: "cfg \<in> valid_cfg \<Longrightarrow> cfg' \<in> K_cfg cfg \<Longrightarrow> cfg' \<in> valid_cfg"
  by (auto simp add: K_cfg_def set_pmf_map valid_cfg_cont)

definition "simple ct = memoryless_on (\<lambda>s. if s \<in> S then ct s else arb_act s)"

lemma simple_cfg_on[simp]: "ct \<in> Pi S K \<Longrightarrow> simple ct s \<in> cfg_on s"
  by (auto simp: simple_def intro!: memoryless_on_cfg_onI)

lemma simple_valid_cfg[simp]: "ct \<in> Pi S K \<Longrightarrow> s \<in> S \<Longrightarrow> simple ct s \<in> valid_cfg"
  by (auto intro: valid_cfgI)

lemma cont_simple[simp]: "s \<in> S \<Longrightarrow> cont (simple ct s) t = simple ct t"
  by (simp add: simple_def)

lemma state_simple[simp]: "state (simple ct s) = s"
  by (simp add: simple_def)

lemma action_simple[simp]: "s \<in> S \<Longrightarrow> action (simple ct s) = ct s"
  by (simp add: simple_def)

lemma simple_valid_cfg_iff: "ct \<in> Pi S K \<Longrightarrow> simple ct s \<in> valid_cfg \<longleftrightarrow> s \<in> S"
  using cfg_onD_state[of "simple ct s"] by (auto simp add: valid_cfg_def intro!: bexI[of _ s])

end

end


theory ND_FiniteAssms
imports ND
begin

lemma ND_finite_assms: "\<Gamma> \<turnstile> F \<Longrightarrow> \<exists>\<Gamma>'. \<Gamma>' \<subseteq> \<Gamma> \<and> finite \<Gamma>' \<and> (\<Gamma>' \<turnstile> F)"
proof(induction rule: ND.induct)
  case (Ax F \<Gamma>) thus ?case by(intro exI[of _ "{F}"]) (simp add: ND.Ax)
next
  case (AndI \<Gamma> F G)
  from AndI.IH obtain \<Gamma>1 \<Gamma>2
    where "\<Gamma>1 \<subseteq> \<Gamma> \<and> finite \<Gamma>1 \<and> (\<Gamma>1 \<turnstile> F)"
      and "\<Gamma>2 \<subseteq> \<Gamma> \<and> finite \<Gamma>2 \<and> (\<Gamma>2 \<turnstile> G)"
    by blast
  then show ?case by(intro exI[where x="\<Gamma>1\<union>\<Gamma>2"]) (force elim: Weaken intro!: ND.AndI)
next
  case (CC F \<Gamma>)
  from CC.IH obtain \<Gamma>' where \<Gamma>': "\<Gamma>' \<subseteq> \<^bold>\<not> F \<triangleright> \<Gamma> \<and> finite \<Gamma>' \<and> (\<Gamma>' \<turnstile> \<bottom>)" ..
  thus ?case proof(cases "Not F \<in> \<Gamma>'") text\<open>case distinction: Did we actually use @{term "\<^bold>\<not>F"}?\<close>
    case False hence "\<Gamma>' \<subseteq> \<Gamma>" using \<Gamma>' by blast
    with \<Gamma>' show ?thesis using BotE by(intro exI[where x="\<Gamma>'"]) fast
  next
    case True
    then obtain \<Gamma>'' where "\<Gamma>' = \<^bold>\<not> F\<triangleright>\<Gamma>''" "\<^bold>\<not> F \<notin> \<Gamma>''" by (meson Set.set_insert)
    hence "\<Gamma>'' \<subseteq> \<Gamma>" "finite \<Gamma>''" "\<^bold>\<not> F\<triangleright>\<Gamma>'' \<turnstile> \<bottom>" using \<Gamma>' by auto
    thus ?thesis using ND.CC by auto
  qed
next
  case AndE1 thus ?case by(blast dest: ND.AndE1) next
  case AndE2 thus ?case by(blast dest: ND.AndE2)
next
  case OrI1 thus ?case by(blast dest: ND.OrI1) next
  case OrI2 thus ?case by(blast dest: ND.OrI2)
next
  case (OrE \<Gamma> F G H)
  from OrE.IH obtain \<Gamma>1 \<Gamma>2 \<Gamma>3
    where IH:
      "\<Gamma>1 \<subseteq> \<Gamma> \<and> finite \<Gamma>1 \<and> (\<Gamma>1 \<turnstile> F \<^bold>\<or> G)"
      "\<Gamma>2 \<subseteq> F \<triangleright> \<Gamma> \<and> finite \<Gamma>2 \<and> (\<Gamma>2 \<turnstile> H)"
      "\<Gamma>3 \<subseteq> G \<triangleright> \<Gamma> \<and> finite \<Gamma>3 \<and> (\<Gamma>3 \<turnstile> H)"
    by blast
  let ?w = "\<Gamma>1 \<union> (\<Gamma>2 - {F}) \<union> (\<Gamma>3 - {G})"
  from IH have "?w \<turnstile> F \<^bold>\<or> G" using Weaken[OF _ sup_ge1] by metis moreover
  from IH have "F\<triangleright>?w \<turnstile> H" "G\<triangleright>?w \<turnstile> H" using Weaken by (metis Un_commute Un_insert_right Un_upper1 Weaken insert_Diff_single)+ ultimately
  have "?w \<turnstile> H" using ND.OrE by blast
  thus ?case using IH by(intro exI[where x="?w"]) auto
  text\<open>Clever evasion of the case distinction made for CC.\<close>
next
  case (ImpI F \<Gamma> G)
  from ImpI.IH obtain \<Gamma>' where "\<Gamma>' \<subseteq> F \<triangleright> \<Gamma> \<and> finite \<Gamma>' \<and> (\<Gamma>' \<turnstile> G)" ..
  thus ?case by (intro exI[where x="\<Gamma>' - {F}"]) (force elim: Weaken intro!: ND.ImpI)
next
  case (ImpE \<Gamma> F G)
  from ImpE.IH obtain \<Gamma>1 \<Gamma>2 where
      "\<Gamma>1 \<subseteq> \<Gamma> \<and> finite \<Gamma>1 \<and> (\<Gamma>1 \<turnstile> F \<^bold>\<rightarrow> G)"
      "\<Gamma>2 \<subseteq> \<Gamma> \<and> finite \<Gamma>2 \<and> (\<Gamma>2 \<turnstile> F)"
    by blast
  then show ?case by(intro exI[where x="\<Gamma>1 \<union> \<Gamma>2"]) (force elim: Weaken intro: ND.ImpE[where F=F])
next
  case (NotE \<Gamma> F)
  from NotE.IH obtain \<Gamma>1 \<Gamma>2 where
      "\<Gamma>1 \<subseteq> \<Gamma> \<and> finite \<Gamma>1 \<and> (\<Gamma>1 \<turnstile> \<^bold>\<not> F)"
      "\<Gamma>2 \<subseteq> \<Gamma> \<and> finite \<Gamma>2 \<and> (\<Gamma>2 \<turnstile> F)"
    by blast
  then show ?case by(intro exI[where x="\<Gamma>1 \<union> \<Gamma>2"]) (force elim: Weaken intro: ND.NotE[where F=F])
next
  case (NotI F \<Gamma>)
  from NotI.IH obtain \<Gamma>' where "\<Gamma>' \<subseteq> F \<triangleright> \<Gamma> \<and> finite \<Gamma>' \<and> (\<Gamma>' \<turnstile> \<bottom>)" ..
  thus ?case by(intro exI[where x="\<Gamma>' - {F}"]) (force elim: Weaken intro: ND.NotI[where F=F])
qed

text\<open>We thought that a lemma like this would be necessary for the ND completeness by SC completeness proof
  (this lemma shows that if we made an ND proof, we can always limit ourselves to a finite set of assumptions --
   and thus put all the assumptions into one formula).
That is not the case, since in the completeness proof,
we assume a valid entailment and have to show (the existence of) a derivation.
The author hopes that his misunderstanding can help the reader's understanding.\<close>
corollary ND_no_assms:
  assumes "\<Gamma> \<turnstile> F"
  obtains \<Gamma>' where "set \<Gamma>' \<subseteq> \<Gamma> \<and> ({} \<turnstile> \<^bold>\<And>\<Gamma>' \<^bold>\<rightarrow> F)"
proof(goal_cases)
  case 1
  from ND_finite_assms[OF assms] obtain \<Gamma>' where "\<Gamma>'\<subseteq>\<Gamma>" "finite \<Gamma>'" "\<Gamma>' \<turnstile> F" by blast
  from \<open>finite \<Gamma>'\<close> obtain G where \<Gamma>'[simp]: "\<Gamma>' = set G"  using finite_list by blast
  with \<open>\<Gamma>'\<subseteq>\<Gamma>\<close> have "set G \<subseteq> \<Gamma>" by clarify
  moreover from \<open>\<Gamma>' \<turnstile> F\<close> have "{} \<turnstile> \<^bold>\<And> G \<^bold>\<rightarrow> F" unfolding \<Gamma>' AssmBigAnd .
  ultimately show ?case by(intro 1[where \<Gamma>'=G] conjI)
qed

end