Theory Intermediate_Implementations

section ‹Intermediate Implementations›

text ‹This theory implements various functions to be supplied to the H, SPY, and Pair-Frameworks.›


theory Intermediate_Implementations
  imports H_Framework SPY_Framework Pair_Framework "../Distinguishability"  Automatic_Refinement.Misc 
begin



subsection ‹Functions for the Pair Framework›

definition get_initial_test_suite_H :: "('a,'b,'c) state_cover_assignment  
                                    ('a::linorder,'b::linorder,'c::linorder) fsm                         
                                    nat 
                                    ('b×'c) prefix_tree" 
where
  "get_initial_test_suite_H V M m = 
    (let 
      rstates       = reachable_states_as_list M;
      n             = size_r M;
      iM            = inputs_as_list M; 
      T             = from_list (concat (map (λq . map (λτ. (V q)@τ) (h_extensions M q (m-n))) rstates))
    in T)"

lemma get_initial_test_suite_H_set_and_finite :
shows  "{(V q)@io@[(x,y)] | q io x y . q  reachable_states M  io  LS M q  length io  m - size_r M  x  inputs M  y  outputs M}  set (get_initial_test_suite_H V M m)"
and "finite_tree (get_initial_test_suite_H V M m)"
proof -

  define rstates where "rstates       = reachable_states_as_list M"
  moreover define n where "n             = size_r M"
  moreover define iM where "iM            = inputs_as_list M"
  moreover define T where "T             = from_list (concat (map (λq . map (λτ. (V q)@τ) (h_extensions M q (m-n))) rstates))"
  ultimately have res: "get_initial_test_suite_H V M m = T"
    unfolding get_initial_test_suite_H_def Let_def by auto

  define 𝒳 where 𝒳: "𝒳 = (λ q . {io@[(x,y)] | io x y . io  LS M q  length io  m-n  x  inputs M  y  outputs M})"

  have "list.set rstates = reachable_states M"
    unfolding rstates_def reachable_states_as_list_set by simp

  have "{ (V q) @ τ | q τ . q  reachable_states M  τ  𝒳 q}  set T"
  proof 
    fix io assume "io  { (V q) @ τ | q τ . q  reachable_states M  τ  𝒳 q}"
    then obtain q τ where "io = (V q) @ τ"
                      and "q  reachable_states M"
                      and "τ  𝒳 q"
      by blast
    
    have "τ  list.set (h_extensions M q (m - n))"
      using τ  𝒳 q unfolding 𝒳
      using h_extensions_set[OF reachable_state_is_state[OF q  reachable_states M]]
      by auto
    then have "io  list.set (map ((@) (V q)) (h_extensions M q (m - n)))"
      unfolding io = (V q) @ τ by auto
    moreover have "q  list.set rstates"
      using list.set rstates = reachable_states M q  reachable_states M by auto
    ultimately have "io  list.set (concat (map (λq. map ((@) (V q)) (h_extensions M q (m - n))) rstates))"
      by auto
    then show "io  set T"
      unfolding T_def from_list_set by blast
  qed
  moreover have "{ (V q) @ τ | q τ . q  reachable_states M  τ  𝒳 q} = {(V q)@io@[(x,y)] | q io x y . q  reachable_states M  io  LS M q  length io  m - size_r M  x  inputs M  y  outputs M}"
    unfolding 𝒳 n_def[symmetric] by force
  ultimately show "{(V q)@io@[(x,y)] | q io x y . q  reachable_states M  io  LS M q  length io  m - size_r M  x  inputs M  y  outputs M}  set (get_initial_test_suite_H V M m)"
    unfolding res by simp

  show "finite_tree (get_initial_test_suite_H V M m)"
    unfolding res T_def
    using from_list_finite_tree by auto 
qed



fun complete_inputs_to_tree :: "('a::linorder,'b::linorder,'c::linorder) fsm  'a  'c list  'b list  ('b × 'c) prefix_tree" where
  "complete_inputs_to_tree M q ys [] = Prefix_Tree.empty" |
  "complete_inputs_to_tree M q ys (x#xs) = foldl (λ t y . case h_obs M q x y of None  insert t [(x,y)] |
                                                                             Some q'  combine_after t [(x,y)] (complete_inputs_to_tree M q' ys xs)) Prefix_Tree.empty ys"

lemma complete_inputs_to_tree_finite_tree :
  "finite_tree (complete_inputs_to_tree M q ys xs)"
proof (induction xs arbitrary: q ys)
  case Nil
  then show ?case using empty_finite_tree by auto
next
  case (Cons x xs)
  
  define ys' where "ys' = ys"
  moreover define f where "f = (λ t y . case h_obs M q x y of None  insert t [(x,y)] | Some q'  combine_after t [(x,y)] (complete_inputs_to_tree M q' ys' xs))"
  ultimately have *:"complete_inputs_to_tree M q ys (x # xs) 
              = foldl f Prefix_Tree.empty ys"
    by auto
  moreover have "finite_tree (foldl f Prefix_Tree.empty ys)" 
  proof (induction ys rule: rev_induct)
    case Nil
    then show ?case using empty_finite_tree by auto
  next
    case (snoc y ys)

    define t where "t = foldl (λ t y . case h_obs M q x y of None  insert t [(x,y)] | Some q'  combine_after t [(x,y)] (complete_inputs_to_tree M q' ys' xs)) Prefix_Tree.empty ys"
    then have *:"foldl f Prefix_Tree.empty (ys@[y])
                = (case h_obs M q x y of None  insert t [(x,y)] | Some q'  combine_after t [(x,y)] (complete_inputs_to_tree M q' ys' xs))"
      unfolding f_def by auto

    have "finite_tree t" 
      using snoc unfolding t_def f_def by force

    have "finite_tree (insert t [(x,y)])"
      using finite_tree t insert_finite_tree by blast
    moreover have " q' . finite_tree (combine_after t [(x,y)] (complete_inputs_to_tree M q' ys' xs))"
      using finite_tree t  q ys . finite_tree (complete_inputs_to_tree M q ys xs) combine_after_finite_tree by blast
    ultimately show ?case 
      unfolding * by auto
  qed
  ultimately show ?case by auto
qed

fun complete_inputs_to_tree_initial :: "('a::linorder,'b::linorder,'c::linorder) fsm  'b list  ('b × 'c) prefix_tree" where
  "complete_inputs_to_tree_initial M xs = complete_inputs_to_tree M (initial M) (outputs_as_list M) xs"


definition get_initial_test_suite_H_2 :: "bool  ('a,'b,'c) state_cover_assignment  
                                    ('a::linorder,'b::linorder,'c::linorder) fsm                         
                                    nat 
                                    ('b×'c) prefix_tree" where
  "get_initial_test_suite_H_2 c V M m = 
    (if c then get_initial_test_suite_H V M m
       else let TS = get_initial_test_suite_H V M m;
                xss = map (map fst) (sorted_list_of_maximal_sequences_in_tree TS);
                ys  = outputs_as_list M
            in 
              foldl (λ t xs . combine t (complete_inputs_to_tree_initial M xs)) TS xss)" 


lemma get_initial_test_suite_H_2_set_and_finite :
shows  "{(V q)@io@[(x,y)] | q io x y . q  reachable_states M  io  LS M q  length io  m - size_r M  x  inputs M  y  outputs M}  set (get_initial_test_suite_H_2 c V M m)" (is ?P1)
and "finite_tree (get_initial_test_suite_H_2 c V M m)" (is ?P2)
proof -
  have "?P1  ?P2"
  proof (cases c)
    case True
    then have "get_initial_test_suite_H_2 c V M m = get_initial_test_suite_H V M m"
      unfolding get_initial_test_suite_H_2_def by auto
    then show ?thesis 
      using get_initial_test_suite_H_set_and_finite 
      by fastforce
  next
    case False

    define TS where "TS = get_initial_test_suite_H V M m"
    moreover define xss where "xss = map (map fst) (sorted_list_of_maximal_sequences_in_tree TS)"
    moreover define ys where "ys  = outputs_as_list M"
    ultimately have "get_initial_test_suite_H_2 c V M m = foldl (λ t xs . combine t (complete_inputs_to_tree M (initial M) ys xs)) TS xss"
      unfolding get_initial_test_suite_H_2_def Let_def using False by auto
    moreover have "set TS  set (foldl (λ t xs . combine t (complete_inputs_to_tree M (initial M) ys xs)) TS xss)"
      using combine_set by (induction xss rule: rev_induct; auto)
    moreover have "finite_tree (foldl (λ t xs . combine t (complete_inputs_to_tree M (initial M) ys xs)) TS xss)"
      using complete_inputs_to_tree_finite_tree get_initial_test_suite_H_set_and_finite(2)[of V M m] combine_finite_tree
      unfolding TS_def[symmetric] by (induction xss rule: rev_induct; auto; blast)   
    ultimately show ?thesis 
      using get_initial_test_suite_H_set_and_finite(1)[of V M m] unfolding TS_def[symmetric]
      by force
  qed
  then show ?P1 and ?P2
    by blast+
qed


definition get_pairs_H :: "('a,'b,'c) state_cover_assignment  
                       ('a::linorder,'b::linorder,'c::linorder) fsm  
                       nat 
                       ((('b × 'c) list × 'a) × (('b × 'c) list × 'a)) list" 
where
  "get_pairs_H V M m = 
    (let 
      rstates       = reachable_states_as_list M;
      n             = size_r M;
      iM            = inputs_as_list M;
      hMap          = mapping_of (map (λ(q,x) . ((q,x), map (λ(y,q') . (q,x,y,q')) (sorted_list_of_set (h M (q,x))))) (List.product (states_as_list M) iM));
      hM            = (λ q x . case Mapping.lookup hMap (q,x) of Some ts  ts | None  []);    
      pairs         = pairs_to_distinguish M V (λq . paths_up_to_length_with_targets q hM iM ((m-n)+1)) rstates
     in 
      pairs)"


lemma get_pairs_H_set :
  assumes "observable M"
  and     "is_state_cover_assignment M V"
shows
  " α β . (α,β)  (V ` reachable_states M) × (V ` reachable_states M)
                       (V ` reachable_states M) × { (V q) @ τ | q τ . q  reachable_states M  τ  {io@[(x,y)] | io x y . io  LS M q  length io  m-size_r M  x  inputs M  y  outputs M}}
                       ( q  reachable_states M .  τ  {io@[(x,y)] | io x y . io  LS M q  length io  m-size_r M  x  inputs M  y  outputs M} . { (V q) @ τ' | τ' . τ'  list.set (prefixes τ)} × {(V q)@τ}) 
                    α  L M  β  L M  after_initial M α  after_initial M β 
                    ((α,after_initial M α),(β,after_initial M β))  list.set (get_pairs_H V M m)"
and " α q' β q'' . ((α,q'),(β,q''))  list.set (get_pairs_H V M m)  α  L M  β  L M  after_initial M α  after_initial M β  q' = after_initial M α  q'' = after_initial M β"
proof -

  define rstates where "rstates       = reachable_states_as_list M"
  moreover define n where "n             = size_r M"
  moreover define iM where "iM            = inputs_as_list M"
  moreover define hMap' where "hMap'          = mapping_of (map (λ(q,x) . ((q,x), map (λ(y,q') . (q,x,y,q')) (sorted_list_of_set (h M (q,x))))) (List.product (states_as_list M) iM))"
  moreover define hM' where "hM'            = (λ q x . case Mapping.lookup hMap' (q,x) of Some ts  ts | None  [])"
  ultimately have "get_pairs_H V M m = pairs_to_distinguish M V (λq . paths_up_to_length_with_targets q hM' iM ((m-n)+1)) rstates"
    unfolding get_pairs_H_def Let_def by force

  
  define hMap where "hMap          = map_of (map (λ(q,x) . ((q,x), map (λ(y,q') . (q,x,y,q')) (sorted_list_of_set (h M (q,x))))) (List.product (states_as_list M) iM))"
  define hM where "hM            = (λ q x . case hMap (q,x) of Some ts  ts | None  [])"

  have "distinct (List.product (states_as_list M) iM)"
    using states_as_list_distinct inputs_as_list_distinct distinct_product
    unfolding iM_def 
    by blast
  
  then have "Mapping.lookup hMap' = hMap"
    using mapping_of_map_of
    unfolding hMap_def hMap'_def
    using map_pair_fst_helper[of "λ q x . map (λ(y,q') . (q,x,y,q')) (sorted_list_of_set (h M (q,x)))"]
    by (metis (no_types, lifting))
  then have "hM' = hM"
    unfolding hM'_def hM_def
    by meson
  moreover define pairs where "pairs         = pairs_to_distinguish M V (λq . paths_up_to_length_with_targets q hM iM ((m-n)+1)) rstates"
  ultimately have res: "get_pairs_H V M m = pairs"
    unfolding get_pairs_H V M m = pairs_to_distinguish M V (λq . paths_up_to_length_with_targets q hM' iM ((m-n)+1)) rstates
    by force

  
  have *:"list.set rstates = reachable_states M"
    unfolding rstates_def reachable_states_as_list_set by simp

  define 𝒳' where 𝒳': "𝒳' = (λq . paths_up_to_length_with_targets q hM iM ((m-n)+1))"


  have **: " q p q' . q  reachable_states M  (p,q')  list.set (𝒳' q)  path M q p  target q p = q'  length p  m-n+1"
  proof -
    fix q p q' assume "q  reachable_states M"

    define qxPairs where qxPairs: "qxPairs = (List.product (states_as_list M) iM)"
    moreover define mapList where mapList: "mapList = (map (λ(q,x) . ((q,x), map (λ(y,q') . (q,x,y,q')) (sorted_list_of_set (h M (q,x))))) qxPairs)"
    ultimately have hMap': "hMap = map_of mapList"
      unfolding hMap_def by simp

    have "distinct (states_as_list M)" and "distinct iM"
      unfolding iM_def
      by auto
    then have "distinct qxPairs"
      unfolding qxPairs by (simp add: distinct_product)
    moreover have "(map fst mapList) = qxPairs"
      unfolding mapList by (induction qxPairs; auto)
    ultimately have "distinct (map fst mapList)"
      by auto

    have " q x . hM q x = map (λ(y, q'). (q, x, y, q')) (sorted_list_of_set (h M (q, x)))"
    proof -
      fix q x
      show "hM q x = map (λ(y, q'). (q, x, y, q')) (sorted_list_of_set (h M (q, x)))"
      proof (cases "q  states M  x  inputs M")
        case False
        then have "(h M (q, x)) = {}"
          unfolding h_simps using fsm_transition_source fsm_transition_input by fastforce
        then have "map (λ(y, q'). (q, x, y, q')) (sorted_list_of_set (h M (q, x))) = []"
          by auto

        have "q  list.set (states_as_list M)  x  list.set iM"
          using False unfolding states_as_list_set iM_def inputs_as_list_set by simp
        then have "(q,x)  list.set qxPairs"
          unfolding qxPairs by auto
        then have " y . ((q,x),y)  list.set mapList"
          unfolding mapList by auto
        then have "hMap (q,x) = None"
          unfolding hMap' using map_of_eq_Some_iff[OF distinct (map fst mapList)]
          by (meson option.exhaust)
        then show ?thesis
          using map (λ(y, q'). (q, x, y, q')) (sorted_list_of_set (h M (q, x))) = [] 
          unfolding hM_def by auto 
      next
        case True
        then have "q  list.set (states_as_list M)  x  list.set iM"
          unfolding states_as_list_set iM_def inputs_as_list_set by simp
        then have "(q,x)  list.set qxPairs"
          unfolding qxPairs by auto
        then have "((q,x),map (λ(y, q'). (q, x, y, q')) (sorted_list_of_set (h M (q, x))))  list.set mapList"
          unfolding mapList by auto
        then have "hMap (q,x) = Some (map (λ(y, q'). (q, x, y, q')) (sorted_list_of_set (h M (q, x))))"
          unfolding hMap' using map_of_eq_Some_iff[OF distinct (map fst mapList)]
          by (meson option.exhaust)
        then show ?thesis 
          unfolding hM_def by auto 
      qed
    qed
    then have hM_alt_def: "hM = (λ q x . map (λ(y, q'). (q, x, y, q')) (sorted_list_of_set (h M (q, x))))"
      by auto

    show "(p,q')  list.set (𝒳' q)  path M q p  target q p = q'  length p  m-n+1"
      unfolding 𝒳' hM_alt_def iM_def
                  paths_up_to_length_with_targets_set[OF reachable_state_is_state[OF q  reachable_states M]]
      by blast
  qed

  show " α β . (α,β)  (V ` reachable_states M) × (V ` reachable_states M)
                       (V ` reachable_states M) × { (V q) @ τ | q τ . q  reachable_states M  τ  {io@[(x,y)] | io x y . io  LS M q  length io  m-size_r M  x  inputs M  y  outputs M}}
                       ( q  reachable_states M .  τ  {io@[(x,y)] | io x y . io  LS M q  length io  m-size_r M  x  inputs M  y  outputs M} . { (V q) @ τ' | τ' . τ'  list.set (prefixes τ)} × {(V q)@τ}) 
                    α  L M  β  L M  after_initial M α  after_initial M β 
                    ((α,after_initial M α),(β,after_initial M β))  list.set (get_pairs_H V M m)"
    using pairs_to_distinguish_containment[OF assms(1,2) * **]
    unfolding res pairs_def 𝒳'[symmetric] n_def[symmetric]
    by presburger 





  show " α q' β q'' . ((α,q'),(β,q''))  list.set (get_pairs_H V M m)  α  L M  β  L M  after_initial M α  after_initial M β  q' = after_initial M α  q'' = after_initial M β"
    using pairs_to_distinguish_elems(3,4,5,6,7)[OF assms(1,2) * **]
    unfolding res pairs_def 𝒳'[symmetric] n_def[symmetric]
    by blast
qed



subsection ‹Functions of the SPYH-Method›

subsubsection ‹Heuristic Functions for Selecting Traces to Extend›
 
(* results:
    errorValue - (x,y) need not be considered, as it is not in the language of either state
                 or (x,y) reaches the same states again or converges to a single state
    1    - (x,y) immediately distinguishes the states
    else - |(x,y)| + twice the length of the shortest distinguishing trace for the states
*)
fun estimate_growth :: "('a::linorder,'b::linorder,'c::linorder) fsm  ('a  'a  ('b × 'c) list)  'a  'a  'b  'c  nat  nat" where
  "estimate_growth M dist_fun q1 q2 x y errorValue= (case h_obs M q1 x y of 
    None  (case h_obs M q1 x y of 
      None  errorValue | 
      Some q2'  1) |
    Some q1'  (case h_obs M q2 x y of
      None  1 |
      Some q2'  if q1' = q2'  {q1',q2'} = {q1,q2}
        then errorValue
        else 1 + 2 * (length (dist_fun q1 q2))))"

 
lemma estimate_growth_result :
  assumes "observable M"
  and     "minimal M"
  and     "q1  states M"
  and     "q2  states M"
  and     "estimate_growth M dist_fun q1 q2 x y errorValue < errorValue"
shows " γ . distinguishes M q1 q2 ([(x,y)]@γ)"
proof (cases "h_obs M q1 x y")
  case None
  show ?thesis proof (cases "h_obs M q2 x y")
    case None
    then show ?thesis 
      using h_obs M q1 x y = None assms(5) 
      by auto
  next
    case (Some a)
    then have "distinguishes M q1 q2 [(x,y)]"
      using h_obs_distinguishes[OF assms(1) _ None] distinguishes_sym
      by metis
    then show ?thesis 
      by auto
  qed 
next
  case (Some q1')
  show ?thesis proof (cases "h_obs M q2 x y")
    case None
    then have "distinguishes M q1 q2 [(x,y)]"
      using h_obs_distinguishes[OF assms(1) Some]
      by metis
    then show ?thesis 
      by auto
  next
    case (Some q2')
    then have "q1'  q2'"
      using h_obs M q1 x y = Some q1' assms(5)
      by auto
    then obtain γ where "distinguishes M q1' q2' γ"
      using h_obs_state[OF h_obs M q1 x y = Some q1']
      using h_obs_state[OF Some]
      using minimal M unfolding minimal.simps distinguishes_def
      by blast
    then have "distinguishes M q1 q2 ([(x,y)]@γ)"
      using h_obs_language_iff[OF assms(1), of x y γ]
      using h_obs M q1 x y = Some q1' Some
      unfolding distinguishes_def
      by force
    then show ?thesis 
      by blast      
  qed
qed


fun shortest_list_or_default :: "'a list list  'a list  'a list" where
  "shortest_list_or_default xs x = foldl (λ a b . if length a < length b then a else b) x xs"

lemma shortest_list_or_default_elem :
  "shortest_list_or_default xs x  Set.insert x (list.set xs)"
  by (induction xs rule: rev_induct; auto)

fun shortest_list :: "'a list list  'a list" where
  "shortest_list [] = undefined" |
  "shortest_list (x#xs) = shortest_list_or_default xs x"

lemma shortest_list_elem :
  assumes "xs  []"
shows "shortest_list xs  list.set xs"
  using assms shortest_list_or_default_elem
  by (metis list.simps(15) shortest_list.elims) 

fun shortest_list_in_tree_or_default :: "'a list list  'a prefix_tree  'a list  'a list" where
  "shortest_list_in_tree_or_default xs T x = foldl (λ a b . if isin T a  length a < length b then a else b) x xs"

lemma shortest_list_in_tree_or_default_elem :
  "shortest_list_in_tree_or_default xs T x  Set.insert x (list.set xs)"
  by (induction xs rule: rev_induct; auto)


fun has_leaf :: "('b×'c) prefix_tree  'd  ('d  ('b×'c) list  ('b×'c) list list)  ('b×'c) list  bool" where
  "has_leaf T G cg_lookup α = 
    (find (λ β . is_maximal_in T β) (α # cg_lookup G α)  None)"

fun has_extension :: "('b×'c) prefix_tree  'd  ('d  ('b×'c) list  ('b×'c) list list)  ('b×'c) list  'b  'c  bool" where
  "has_extension T G cg_lookup α x y = 
    (find (λ β . isin T (β@[(x,y)])) (α # cg_lookup G α)  None)"

fun get_extension :: "('b×'c) prefix_tree  'd  ('d  ('b×'c) list  ('b×'c) list list)  ('b×'c) list  'b  'c  ('b×'c) list option" where
  "get_extension T G cg_lookup α x y = 
    (find (λ β . isin T (β@[(x,y)])) (α # cg_lookup G α))"





(* uses a fixed recursion depth to avoid partiality, as the lookup function of the convergence 
   graph is not constrained here in any way *)
fun get_prefix_of_separating_sequence :: "('a::linorder,'b::linorder,'c::linorder) fsm  ('b×'c) prefix_tree  'd  ('d  ('b×'c) list  ('b×'c) list list)  ('a  'a  ('b×'c) list)  ('b×'c) list  ('b×'c) list  nat  (nat × ('b×'c) list)" where
  "get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u v 0 = (1,[])" |
  "get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u v (Suc k)= (let
    u' = shortest_list_or_default (cg_lookup G u) u;
    v' = shortest_list_or_default (cg_lookup G v) v;
    su = after_initial M u;
    sv = after_initial M v;
    bestPrefix0 = get_distinguishing_trace su sv;
    minEst0 = length bestPrefix0 + (if (has_leaf T G cg_lookup u') then 0 else length u') + (if (has_leaf T G cg_lookup v') then 0 else length v');
    errorValue = Suc minEst0;
    XY = List.product (inputs_as_list M) (outputs_as_list M);
    tryIO = (λ (minEst,bestPrefix) (x,y) . 
              if minEst = 0 
                then (minEst,bestPrefix)
                else (case get_extension T G cg_lookup u' x y of
                      Some u''  (case get_extension T G cg_lookup v' x y of
                        Some v''  if (h_obs M su x y = None)  (h_obs M sv x y = None)
                          then (0,[])
                          else if h_obs M su x y = h_obs M sv x y
                            then (minEst,bestPrefix)
                            else (let (e,w) = get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace (u''@[(x,y)]) (v''@[(x,y)]) k
                                    in if e = 0
                                      then (0,[])
                                      else if e  minEst
                                        then (e,(x,y)#w)
                                        else (minEst,bestPrefix)) |
                        None  (let e = estimate_growth M get_distinguishing_trace su sv x y errorValue;
                                  e' = if e  1
                                        then if has_leaf T G cg_lookup u''
                                          then e + 1
                                          else if ¬(has_leaf T G cg_lookup (u''@[(x,y)])) 
                                            then e + length u' + 1
                                            else e
                                        else e;
                                  e'' = e' + (if ¬(has_leaf T G cg_lookup v') then length v' else 0)
                                in if e''  minEst
                                  then (e'',[(x,y)])
                                  else (minEst,bestPrefix))) |
                      None  (case get_extension T G cg_lookup v' x y of
                        Some v''  (let e = estimate_growth M get_distinguishing_trace su sv x y errorValue;
                                  e' = if e  1
                                        then if has_leaf T G cg_lookup v''
                                          then e + 1
                                          else if ¬(has_leaf T G cg_lookup (v''@[(x,y)]))
                                            then e + length v' + 1
                                            else e
                                        else e;
                                  e'' = e' + (if ¬(has_leaf T G cg_lookup u') then length u' else 0)
                                in if e''  minEst
                                  then (e'',[(x,y)])
                                  else (minEst,bestPrefix)) |
                        None  (minEst,bestPrefix))))
  in if ¬ isin T u'  ¬ isin T v'
      then (errorValue,[])
      else foldl tryIO (minEst0,[]) XY)"


lemma estimate_growth_Suc :
  assumes "errorValue > 0"
  shows "estimate_growth M get_distinguishing_trace q1 q2 x y errorValue > 0" 
  using assms unfolding estimate_growth.simps 
  by (cases "FSM.h_obs M q1 x y"; cases "FSM.h_obs M q2 x y"; fastforce)

lemma get_extension_result:
  assumes "u  L M1" and "u  L M2"
  and     "convergence_graph_lookup_invar M1 M2 cg_lookup G"
  and     "get_extension T G cg_lookup u x y = Some u'"
shows "converge M1 u u'" and "u'  L M2  converge M2 u u'" and "u'@[(x,y)]  set T"    
proof -

  have "find (λ β . isin T (β@[(x,y)])) (u # cg_lookup G u) = Some u'"
    using assms(4) 
    by auto
  then have "isin T (u'@[(x,y)])" 
    using find_condition by metis
  then show "u'@[(x,y)]  set T"
    by auto

  have "u'  Set.insert u (list.set (cg_lookup G u))"
    using find (λ β . isin T (β@[(x,y)])) (u # cg_lookup G u) = Some u'
    by (metis find_set list.simps(15)) 
  then show "converge M1 u u'" and "u'  L M2  converge M2 u u'"
    using assms(1,2,3)
    by (metis converge.elims(3) convergence_graph_lookup_invar_def insert_iff)+
qed


lemma get_prefix_of_separating_sequence_result :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "u  L M1" and "u  L M2"
  and     "v  L M1" and "v  L M2"
  and     "after_initial M1 u  after_initial M1 v"
  and     " α β q1 q2 . q1  states M1  q2  states M1  q1  q2  distinguishes M1 q1 q2 (get_distinguishing_trace q1 q2)"
  and     "convergence_graph_lookup_invar M1 M2 cg_lookup G"  
  and     "L M1  set T = L M2  set T"
shows "fst (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k) = 0  ¬ converge M2 u v"
and   "fst (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k)  0    γ . distinguishes M1 (after_initial M1 u) (after_initial M1 v) ((snd (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k))@γ)"
proof -
  have "(fst (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k) = 0  ¬ converge M2 u v)
         (fst (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k)  0   ( γ . distinguishes M1 (after_initial M1 u) (after_initial M1 v) ((snd (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k))@γ)))"
    using assms(4,5,6,7,8)
  proof (induction k arbitrary: u v)
    case 0

    then have " γ . distinguishes M1 (after_initial M1 u) (after_initial M1 v) γ"
      using minimal M1 unfolding minimal.simps
      by (meson after_is_state assms(1) assms(9)) 
   then show ?case 
     unfolding get_prefix_of_separating_sequence.simps fst_conv snd_conv
     by auto
  next
    case (Suc k)

    define u' where u': "u' = shortest_list_or_default (cg_lookup G u) u"
    define v' where v': "v' = shortest_list_or_default (cg_lookup G v) v"
    define su where su: "su = after_initial M1 u"
    define sv where sv: "sv = after_initial M1 v"
    define bestPrefix0 where bestPrefix0: "bestPrefix0 = get_distinguishing_trace su sv"
    define minEst0 where minEst0: "minEst0 = length bestPrefix0 + (if (has_leaf T G cg_lookup u') then 0 else length u') + (if (has_leaf T G cg_lookup v') then 0 else length v')"
    define errorValue where errorValue: "errorValue = Suc minEst0"
    define XY where XY: "XY = List.product (inputs_as_list M1) (outputs_as_list M1)"
    define tryIO where tryIO: "tryIO = (λ (minEst,bestPrefix) (x,y) . 
              if minEst = 0 
                then (minEst,bestPrefix)
                else (case get_extension T G cg_lookup u' x y of
                      Some u''  (case get_extension T G cg_lookup v' x y of
                        Some v''  if (h_obs M1 su x y = None)  (h_obs M1 sv x y = None)
                          then (0,[])
                          else if h_obs M1 su x y = h_obs M1 sv x y
                            then (minEst,bestPrefix)
                            else (let (e,w) = get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace (u''@[(x,y)]) (v''@[(x,y)]) k
                                    in if e = 0
                                      then (0,[])
                                      else if e  minEst
                                        then (e,(x,y)#w)
                                        else (minEst,bestPrefix)) |
                        None  (let e = estimate_growth M1 get_distinguishing_trace su sv x y errorValue;
                                  e' = if e  1
                                        then if has_leaf T G cg_lookup u''
                                          then e + 1
                                          else if ¬(has_leaf T G cg_lookup (u''@[(x,y)])) 
                                            then e + length u' + 1
                                            else e
                                        else e;
                                  e'' = e' + (if ¬(has_leaf T G cg_lookup v') then length v' else 0)
                                in if e''  minEst
                                  then (e'',[(x,y)])
                                  else (minEst,bestPrefix))) |
                      None  (case get_extension T G cg_lookup v' x y of
                        Some v''  (let e = estimate_growth M1 get_distinguishing_trace su sv x y errorValue;
                                  e' = if e  1
                                        then if has_leaf T G cg_lookup v''
                                          then e + 1
                                          else if ¬(has_leaf T G cg_lookup (v''@[(x,y)]))
                                            then e + length v' + 1
                                            else e
                                        else e;
                                  e'' = e' + (if ¬(has_leaf T G cg_lookup u') then length u' else 0)
                                in if e''  minEst
                                  then (e'',[(x,y)])
                                  else (minEst,bestPrefix)) |
                        None  (minEst,bestPrefix))))"


    have res': "(get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v (Suc k)) = 
                  (if ¬ isin T u'  ¬ isin T v' then (errorValue,[]) else foldl tryIO (minEst0,[]) XY)"
      unfolding tryIO XY errorValue minEst0 bestPrefix0 sv su v' u'
      unfolding get_prefix_of_separating_sequence.simps Let_def
      by force


    show ?case proof (cases "¬ isin T u'  ¬ isin T v'")
      case True
      then have *:"(get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v (Suc k)) = (errorValue,[])"
        using res' by auto
      
      show ?thesis
        unfolding * fst_conv snd_conv errorValue
        by (metis Suc.prems(1,3,5) Zero_not_Suc after_is_state append_Nil assms(1) assms(9))
    next
      case False

      then have res: "(get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v (Suc k)) = foldl tryIO (minEst0,[]) XY"
        using res' by auto

      
      have "converge M1 u u'" and "converge M2 u u'"
        unfolding u' 
        using shortest_list_or_default_elem[of "cg_lookup G u" u] assms(10) Suc.prems(1,2,3)
        by (metis converge.elims(3) convergence_graph_lookup_invar_def insertE)+

      have "converge M1 v v'" and "converge M2 v v'"
        unfolding v' 
        using shortest_list_or_default_elem[of "cg_lookup G v" v] assms(10) Suc.prems
        by (metis converge.elims(3) convergence_graph_lookup_invar_def insertE)+
  
      have "su  states M1"
        unfolding su
        using after_is_state[OF assms(1) Suc.prems(1)] .
  
      have "sv  states M1"
        unfolding sv
        using after_is_state[OF assms(1) Suc.prems(3)] .
  
      define P where P: "P = (λ (ew :: (nat × ('b × 'c) list)) . 
                                      (fst ew = 0  ¬ converge M2 u v)
                                       (fst ew  0   ( γ . distinguishes M1 (after_initial M1 u) (after_initial M1 v) ((snd ew)@γ))))"
  
      have "P (minEst0,[])"
      proof -
        have "distinguishes M1 (after_initial M1 u) (after_initial M1 v) bestPrefix0"
          using assms(9)[of su sv]
          using su  states M1 sv  states M1
          using Suc.prems(5) 
          unfolding bestPrefix0 su sv
          by blast
        
        moreover have "minEst0  0"
          unfolding minEst0
          using calculation distinguishes_not_Nil[OF _ after_is_state[OF assms(1) Suc.prems(1)] after_is_state[OF assms(1) Suc.prems(3)]]
          by auto
        ultimately show ?thesis
          unfolding P fst_conv snd_conv
          by (metis append.left_neutral) 
      qed
  
      have "errorValue > 0"
        unfolding errorValue by auto
  
      have " x y e w . e < errorValue  P (e,w)  P (tryIO (e,w) (x,y))  fst (tryIO (e,w) (x,y))  e" 
      proof -
        fix x y e w
        assume "e < errorValue" and "P (e,w)"
  
        have *:" x y a b f . (case (x, y) of (x, y)  (λ(a, b). f x y a b)) (a,b)  = f x y a b"
          by auto
  
        
        show "P (tryIO (e,w) (x,y))  fst (tryIO (e,w) (x,y))  e"
        proof (cases "e = 0")
          case True
          then have "tryIO (e,w) (x,y) = (e,w)"
            unfolding P tryIO fst_conv snd_conv case_prod_conv 
            by auto
          then show ?thesis 
            using P (e,w)
            by auto
        next
          case False
          show ?thesis 
          proof (cases "get_extension T G cg_lookup u' x y")
            case None
            
            show ?thesis 
            proof (cases "get_extension T G cg_lookup v' x y")
              case None
              then have "tryIO (e,w) (x,y) = (e,w)"
                using get_extension T G cg_lookup u' x y = None
                unfolding tryIO by auto
              then show ?thesis 
                using P (e,w)
                by auto
            next
              case (Some v'')
    
              define c where c: "c = estimate_growth M1 get_distinguishing_trace su sv x y errorValue"
              define c' where c': "c' = (if c  1 then if has_leaf T G cg_lookup v'' then c + 1 else if ¬(has_leaf T G cg_lookup (v''@[(x,y)])) then c + length v' + 1 else c else c)"
              define c'' where c'': "c'' = c' + (if ¬(has_leaf T G cg_lookup u') then length u' else 0)"
    
              have "tryIO (e,w) (x,y) = (if c''  e then (c'',[(x,y)]) else (e,w))"
                unfolding c c' c'' tryIO Let_def
                using None Some False
                by auto
    
              show ?thesis proof (cases "c''  e")
                case True
                then have "c'' < errorValue"
                  using e < errorValue by auto
                then have "c' < errorValue"
                  unfolding c'' by auto
                then have "estimate_growth M1 get_distinguishing_trace su sv x y errorValue < errorValue"
                  unfolding c' c
                  using add_lessD1 by presburger
    
                have "c > 0"
                  using estimate_growth_Suc[OF errorValue > 0] unfolding c
                  by blast 
                then have "c'' > 0"
                  unfolding c' c''
                  using add_gr_0 by presburger 
                then have "c''  0"
                  by auto
                then have "P (c'',[(x,y)])"
                  using True estimate_growth_result[OF assms(1,3) su  states M1 sv  states M1 estimate_growth M1 get_distinguishing_trace su sv x y errorValue < errorValue]
                  unfolding P fst_conv su sv snd_conv 
                  by blast
                then show ?thesis 
                  using tryIO (e,w) (x,y) = (if c''  e then (c'',[(x,y)]) else (e,w)) True
                  by auto
              next
                case False
                then show ?thesis 
                  using tryIO (e,w) (x,y) = (if c''  e then (c'',[(x,y)]) else (e,w)) P (e,w)
                  by auto
              qed
            qed
          next
            case (Some u'')
            
            show ?thesis proof (cases "get_extension T G cg_lookup v' x y")
              case None
    
              define c where c: "c = estimate_growth M1 get_distinguishing_trace su sv x y errorValue"
              define c' where c': "c' = (if c  1 then if has_leaf T G cg_lookup u'' then c + 1 else if ¬(has_leaf T G cg_lookup (u''@[(x,y)])) then c + length u' + 1 else c else c)"
              define c'' where c'': "c'' = c' + (if ¬(has_leaf T G cg_lookup v') then length v' else 0)"
    
              have "tryIO (e,w) (x,y) = (if c''  e then (c'',[(x,y)]) else (e,w))"
                unfolding c c' c'' tryIO Let_def
                using None Some False
                by auto
    
              show ?thesis proof (cases "c''  e")
                case True
                then have "c'' < errorValue"
                  using e < errorValue by auto
                then have "c' < errorValue"
                  unfolding c'' by auto
                then have "estimate_growth M1 get_distinguishing_trace su sv x y errorValue < errorValue"
                  unfolding c' c
                  using add_lessD1 by presburger
    
                have "c > 0"
                  using estimate_growth_Suc[OF errorValue > 0] unfolding c
                  by blast 
                then have "c'' > 0"
                  unfolding c' c''
                  using add_gr_0 by presburger 
                then have "c''  0"
                  by auto
                then have "P (c'',[(x,y)])"
                  using True estimate_growth_result[OF assms(1,3) su  states M1 sv  states M1 estimate_growth M1 get_distinguishing_trace su sv x y errorValue < errorValue]
                  unfolding P fst_conv su sv snd_conv 
                  by blast
                then show ?thesis 
                  using tryIO (e,w) (x,y) = (if c''  e then (c'',[(x,y)]) else (e,w)) True
                  by auto
              next
                case False
                then show ?thesis 
                  using tryIO (e,w) (x,y) = (if c''  e then (c'',[(x,y)]) else (e,w)) P (e,w)
                  by auto
              qed
    
    
            next
              case (Some v'')
  
              have "u'  L M1"
                using converge M1 u u' converge.simps by blast 
              have "v'  L M1"
                using converge M1 v v' converge.simps by blast 
              have "u'  L M2"
                using converge M2 u u' converge.simps by blast 
              have "v'  L M2"
                using converge M2 v v' converge.simps by blast 
                
  
              have "converge M1 u' u''" and "u'' @ [(x, y)]  set T"
                using get_extension_result(1,3)[OF u'  L M1 u'  L M2 assms(10) get_extension T G cg_lookup u' x y = Some u'']
                by blast+
              then have "converge M1 u u''"
                using converge M1 u u' by auto
              then have "u''  set T  L M1"
                using set_prefix[OF u'' @ [(x, y)]  set T] by auto
  
              have "converge M1 v' v''" and "v'' @ [(x, y)]  set T"
                using get_extension_result[OF v'  L M1 v'  L M2 assms(10) get_extension T G cg_lookup v' x y = Some v'']
                by blast+
              then have "converge M1 v v''"
                using converge M1 v v' by auto
              then have "v''  set T  L M1"
                using set_prefix[OF v'' @ [(x, y)]  set T] by auto
    
              show ?thesis proof (cases "(h_obs M1 su x y = None)  (h_obs M1 sv x y = None)")
                case True
    
                then have "tryIO (e,w) (x,y) = (0,[])"
                  using Some get_extension T G cg_lookup u' x y = Some u'' False
                  unfolding tryIO Let_def by auto
    
                have "¬ converge M2 u v"
                proof -
                  note L M1  set T = L M2  set T
  
                  then have "u'  L M2" and "v'  L M2"
                    using False u'  L M1 v'  L M1 ¬ (¬ isin T u'  ¬ isin T v')
                    by auto
  
                  have "u''  L M2"
                    using L M1  set T = L M2  set T u''  set T  L M1
                    by blast
                  then have "converge M2 u' u''"
                    using get_extension_result(2)[OF u'  L M1 u'  L M2 assms(10) get_extension T G cg_lookup u' x y = Some u''] 
                    by blast                
                  moreover note converge M2 u u'
                  ultimately have "converge M2 u u''"
                    by auto
                    
                  have "v''  L M2"
                    using L M1  set T = L M2  set T v''  set T  L M1
                    by blast
                  then have "converge M2 v' v''"
                    using get_extension_result(2)[OF v'  L M1 v'  L M2 assms(10) get_extension T G cg_lookup v' x y = Some v''] 
                    by blast
                  moreover note converge M2 v v'
                  ultimately have "converge M2 v v''"
                    by auto
  
                  have "distinguishes M1 su sv ([(x,y)])"
                    using h_obs_distinguishes[OF assms(1), of su x y _ sv] 
                    using distinguishes_sym[OF h_obs_distinguishes[OF assms(1), of sv x y _ su]]
                    using True 
                    by (cases "h_obs M1 su x y"; cases "h_obs M1 sv x y"; metis)
                  then have "distinguishes M1 (after_initial M1 u) (after_initial M1 v) ([(x,y)])"
                    unfolding su sv by auto
  
                  show "¬ converge M2 u v"
                    using distinguish_converge_diverge[OF assms(1-3) _ _ converge M1 u u'' converge M1 v v'' converge M2 u u'' converge M2 v v'' distinguishes M1 (after_initial M1 u) (after_initial M1 v) ([(x,y)]) u'' @ [(x, y)]  set T v'' @ [(x, y)]  set T L M1  set T = L M2  set T]
                          u''  set T  L M1 v''  set T  L M1
                    by blast
                qed
                then show ?thesis
                  unfolding P tryIO (e,w) (x,y) = (0,[]) fst_conv snd_conv su sv
                  by blast
  
              next
                case False
    
                show ?thesis proof (cases "h_obs M1 su x y = h_obs M1 sv x y")
                  case True
    
                  then have "tryIO (e,w) (x,y) = (e,w)"
                    using get_extension T G cg_lookup u' x y = Some u'' Some
                    unfolding tryIO by auto
                  then show ?thesis 
                    using P (e,w)
                    by auto
                next
                  case False 
    
                  then have "h_obs M1 su x y  None" and "h_obs M1 sv x y  None"
                    using ¬ (h_obs M1 su x y = None)  (h_obs M1 sv x y = None) 
                    by metis+
    
                  have "u''@[(x,y)]  L M1"
                    by (metis converge M1 u u'' h_obs M1 su x y  None after_language_iff assms(1) converge.elims(2) h_obs_language_single_transition_iff su) 
                  have "v''@[(x,y)]  L M1"
                    by (metis converge M1 v v'' h_obs M1 sv x y  None after_language_iff assms(1) converge.elims(2) h_obs_language_single_transition_iff sv) 

                  have "u''@[(x,y)]  L M2"
                    using u''@[(x,y)]  L M1 u''@[(x,y)]  set T L M1  set T = L M2  set T
                    by blast
                  have "v''@[(x,y)]  L M2"
                    using v''@[(x,y)]  L M1 v''@[(x,y)]  set T L M1  set T = L M2  set T
                    by blast

                  have "FSM.after M1 (FSM.initial M1) (u'' @ [(x, y)])  FSM.after M1 (FSM.initial M1) (v'' @ [(x, y)])"
                    using False converge M1 u u'' converge M1 v v'' unfolding su sv
                  proof - (* auto-generated proof *)
                    assume a1: "h_obs M1 (FSM.after M1 (FSM.initial M1) u) x y  h_obs M1 (FSM.after M1 (FSM.initial M1) v) x y"
                    have f2: "f ps psa. converge (f::('a, 'b, 'c) fsm) ps psa = (ps  L f  psa  L f  LS f (FSM.after f (FSM.initial f) ps) = LS f (FSM.after f (FSM.initial f) psa))"
                      by (meson converge.simps)
                    then have f3: "u  L M1  u''  L M1  LS M1 (FSM.after M1 (FSM.initial M1) u) = LS M1 (FSM.after M1 (FSM.initial M1) u'')"
                      using converge M1 u u'' by presburger
                    have f4: "f ps psa. ¬ minimal (f::('a, 'b, 'c) fsm)  ¬ observable f  ps  L f  psa  L f  converge f ps psa = (FSM.after f (FSM.initial f) ps = FSM.after f (FSM.initial f) psa)"
                      using convergence_minimal by blast
                    have f5: "v  L M1  v''  L M1  LS M1 (FSM.after M1 (FSM.initial M1) v) = LS M1 (FSM.after M1 (FSM.initial M1) v'')"
                      using f2 converge M1 v v'' by blast
                    then have f6: "FSM.after M1 (FSM.initial M1) v = FSM.after M1 (FSM.initial M1) v''"
                      using f4 converge M1 v v'' assms(1) assms(3) by blast
                    have "FSM.after M1 (FSM.initial M1) u = FSM.after M1 (FSM.initial M1) u''"
                      using f4 f3 converge M1 u u'' assms(1) assms(3) by blast
                    then show ?thesis
                      using f6 f5 f3 a1 by (metis (no_types) u'' @ [(x, y)]  L M1 v'' @ [(x, y)]  L M1 after_h_obs after_language_iff after_split assms(1) h_obs_from_LS)
                  qed
    
                  obtain e' w' where "get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace (u''@[(x,y)]) (v''@[(x,y)]) k = (e',w')"
                    using prod.exhaust by metis
    
                  then have "tryIO (e,w) (x,y) = (if e' = 0 then (0,[]) else if e'  e then (e',(x,y)#w') else (e,w))"
                    using get_extension T G cg_lookup u' x y = Some u'' Some False ¬ (h_obs M1 su x y = None)  (h_obs M1 sv x y = None) e  0
                    unfolding tryIO Let_def by auto
    
    
                  show ?thesis proof (cases "e' = 0")
                    case True
    
                    have "¬ converge M2 u v"
                    proof -
                      note L M1  set T = L M2  set T
                      then have "u'  L M2" and "v'  L M2"
                        using ¬ (¬ isin T u'  ¬ isin T v') u'  L M1 v'  L M1
                        by auto
      
                      have "u''  L M2"
                        using L M1  set T = L M2  set T u''  set T  L M1
                        by blast
                      then have "converge M2 u' u''"
                        using get_extension_result(2)[OF u'  L M1 u'  L M2 assms(10) get_extension T G cg_lookup u' x y = Some u''] 
                        by blast                
                      moreover note converge M2 u u'
                      ultimately have "converge M2 u u''"
                        by auto
                      
                      have "v''  L M2"
                        using L M1  set T = L M2  set T v''  set T  L M1
                        by blast
                      then have "converge M2 v' v''"
                        using get_extension_result(2)[OF v'  L M1 v'  L M2 assms(10) get_extension T G cg_lookup v' x y = Some v''] 
                        by blast
                      moreover note converge M2 v v'
                      ultimately have "converge M2 v v''"
                        by auto
    
                      have "fst (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace (u'' @ [(x, y)]) (v'' @ [(x, y)]) k) = 0"
                        using True get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace (u''@[(x,y)]) (v''@[(x,y)]) k = (e',w')
                        by auto
                      then have "¬ converge M2 (u'' @ [(x, y)]) (v'' @ [(x, y)])"
                        using Suc.IH[OF u''@[(x,y)]  L M1 u''@[(x,y)]  L M2 v''@[(x,y)]  L M1 v''@[(x,y)]  L M2 FSM.after M1 (FSM.initial M1) (u'' @ [(x, y)])  FSM.after M1 (FSM.initial M1) (v'' @ [(x, y)])]
                        using L M1  Prefix_Tree.set T = L M2  Prefix_Tree.set T
                        by blast
                      then have "¬ converge M2 u'' v''"
                        using diverge_prefix[OF assms(2) u''@[(x,y)]  L M2 v''@[(x,y)]  L M2]
                        by blast
                      then show "¬ converge M2 u v"
                        using converge M2 u u'' converge M2 v v''
                        by fastforce
                    qed
                    then show ?thesis
                      unfolding P tryIO (e,w) (x,y) = (if e' = 0 then (0,[]) else if e'  e then (e',(x,y)#w') else (e,w)) True fst_conv snd_conv su sv
                      by simp
                  next
                    case False

                    show ?thesis proof (cases "e'  e")
                      case True
                      then have "fst (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace (u'' @ [(x, y)]) (v'' @ [(x, y)]) k)  0"
                        using get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace (u''@[(x,y)]) (v''@[(x,y)]) k = (e',w') False
                        by auto
                      then have "(γ. distinguishes M1 (FSM.after M1 (FSM.initial M1) (u'' @ [(x, y)])) (FSM.after M1 (FSM.initial M1) (v'' @ [(x, y)]))
                                     (snd (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace (u'' @ [(x, y)]) (v'' @ [(x, y)]) k) @ γ))"
                        using Suc.IH[OF u''@[(x,y)]  L M1 u''@[(x,y)]  L M2 v''@[(x,y)]  L M1 v''@[(x,y)]  L M2 FSM.after M1 (FSM.initial M1) (u'' @ [(x, y)])  FSM.after M1 (FSM.initial M1) (v'' @ [(x, y)])]
                        by blast
                      then obtain γ where "distinguishes M1 (FSM.after M1 (FSM.initial M1) (u'' @ [(x, y)])) (FSM.after M1 (FSM.initial M1) (v'' @ [(x, y)])) (w'@γ)"
                        unfolding get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace (u''@[(x,y)]) (v''@[(x,y)]) k = (e',w')  snd_conv
                        by blast
                      have "distinguishes M1 (after_initial M1 u'') (after_initial M1 v'')  ((x,y)#(w'@γ))"
                        using distinguishes_after_initial_prepend[OF assms(1) language_prefix[OF u''@[(x,y)]  L M1] language_prefix[OF v''@[(x,y)]  L M1]]
                        by (metis Suc.prems(1) Suc.prems(3) converge M1 u u' converge M1 u' u'' converge M1 v v'' distinguishes M1 (after_initial M1 (u'' @ [(x, y)])) (after_initial M1 (v'' @ [(x, y)])) (w' @ γ) h_obs M1 su x y  None h_obs M1 sv x y  None u'  L M1 u'' @ [(x, y)]  L M1 v'' @ [(x, y)]  L M1 assms(1) assms(3) convergence_minimal language_prefix su sv)                    
                      then have "distinguishes M1 (after_initial M1 u) (after_initial M1 v)  (((x,y)#w')@γ)"
                        by (metis Cons_eq_appendI Suc.prems(1) Suc.prems(3) converge M1 u u'' converge M1 v v'' u'' @ [(x, y)]  L M1 v'' @ [(x, y)]  L M1 assms(1) assms(3) convergence_minimal language_prefix)
    
                      have "tryIO (e,w) (x,y) = (e',(x,y)#w')"
                        using tryIO (e,w) (x,y) = (if e' = 0 then (0,[]) else if e'  e then (e',(x,y)#w') else (e,w)) True False
                        by auto
                      
                      show ?thesis
                      unfolding P tryIO (e,w) (x,y) = (e',(x,y)#w') fst_conv snd_conv
                        using distinguishes M1 (after_initial M1 u) (after_initial M1 v) (((x,y)#w')@γ)
                              False True
                      by blast
                    next
                      case False
    
                      then have "tryIO (e,w) (x,y) = (e,w)"
                        using e'  0 tryIO (e,w) (x,y) = (if e' = 0 then (0,[]) else if e'  e then (e',(x,y)#w') else (e,w))
                        by auto
                      then show ?thesis 
                        using P (e,w)
                        by auto
                    qed
                  qed
                qed
              qed
            qed
          qed
        qed
      qed
  
      have "minEst0 < errorValue"
        unfolding errorValue by auto
  
      have "P (foldl tryIO (minEst0,[]) XY)  fst (foldl tryIO (minEst0,[]) XY)  minEst0"
      proof (induction XY rule: rev_induct)
        case Nil
        then show ?case 
          using P (minEst0,[])
          by auto
      next
        case (snoc a XY)
        
        obtain x y where "a = (x,y)"
          using prod.exhaust by metis
        moreover obtain e w where "(foldl tryIO (minEst0,[]) XY) = (e,w)"
          using prod.exhaust by metis
        ultimately have "(foldl tryIO (minEst0, []) (XY@[a])) = tryIO (e,w) (x,y)"
          by auto
  
        have "P (e,w)" and "e  minEst0" and "e < errorValue"
          using snoc.IH minEst0 < errorValue
          unfolding (foldl tryIO (minEst0,[]) XY) = (e,w) 
          by auto
        
        then show ?case
          unfolding (foldl tryIO (minEst0, []) (XY@[a])) = tryIO (e,w) (x,y)
          using  x y e w . e < errorValue  P (e,w)  P (tryIO (e,w) (x,y))  fst (tryIO (e,w) (x,y))  e
          using dual_order.trans by blast
      qed
  
      then have "P (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v (Suc k))"
        unfolding res by blast
      then show ?thesis
        unfolding P by blast
    qed
  qed

  then show "fst (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k) = 0  ¬ converge M2 u v"
       and  "fst (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k)  0    γ . distinguishes M1 (after_initial M1 u) (after_initial M1 v) ((snd (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k))@γ)"
    by blast+
qed



subsubsection ‹Distributing Convergent Traces›

fun append_heuristic_io :: "('b×'c) prefix_tree  ('b×'c) list  (('b×'c) list × int)  ('b×'c) list  (('b×'c) list × int)" where
  "append_heuristic_io T w (uBest,lBest) u' = (let t' = after T u';
                                        w' = maximum_prefix t' w
                                    in if w' = w
                                        then (u',0::int)
                                        else if (is_maximal_in t' w'  (int (length w') > lBest  (int (length w') = lBest  length u' < length uBest)))
                                          then (u', int (length w'))
                                          else (uBest,lBest))"
  

lemma append_heuristic_io_in :
  "fst (append_heuristic_io T w (uBest,lBest) u')  {u',uBest}"
  unfolding append_heuristic_io.simps Let_def by auto


fun append_heuristic_input :: "('a::linorder,'b::linorder,'c::linorder) fsm  ('b×'c) prefix_tree  ('b×'c) list  (('b×'c) list × int)  ('b×'c) list  (('b×'c) list × int)" where
"append_heuristic_input M T w (uBest,lBest) u' = (let t' = after T u';
                                       ws = maximum_fst_prefixes t' (map fst w) (outputs_as_list M)
                                    in
                                      foldr (λ w' (uBest',lBest'::int) .
                                                if w' = w
                                                  then (u',0::int)
                                                  else if (int (length w') > lBest'  (int (length w') = lBest'  length u' < length uBest'))
                                                    then (u',int (length w'))
                                                    else (uBest',lBest'))
                                            ws (uBest,lBest))"

lemma append_heuristic_input_in :
  "fst (append_heuristic_input M T w (uBest,lBest) u')  {u',uBest}"
proof -
  define ws where ws: "ws = maximum_fst_prefixes (after T u') (map fst w) (outputs_as_list M)"
  define f where f: "f = (λ w' (uBest',lBest'::int) .
                                                if w' = w
                                                  then (u',0::int)
                                                  else if (int (length w') > lBest'  (int (length w') = lBest'  length u' < length uBest'))
                                                    then (u',int (length w'))
                                                    else (uBest',lBest'))"

  have " w' b' . fst b'  {u',uBest}  fst (f w' b')  {u',uBest}"
    unfolding f by auto
  then have "fst (foldr f ws (uBest,lBest))  {u',uBest}"
    by (induction ws; auto)
  moreover have "append_heuristic_input M T w (uBest,lBest) u' = foldr f ws (uBest,lBest)"
    unfolding append_heuristic_input.simps Let_def ws f by force
  ultimately show ?thesis
    by simp
qed

fun distribute_extension :: "('a::linorder,'b::linorder,'c::linorder) fsm  ('b×'c) prefix_tree  'd  ('d  ('b×'c) list  ('b×'c) list list)  ('d  ('b×'c) list  'd) ('b×'c) list  ('b×'c) list  bool  (('b×'c) prefix_tree  ('b×'c) list  (('b×'c) list × int)  ('b×'c) list  (('b×'c) list × int))  (('b×'c) prefix_tree ×'d)" where
 "distribute_extension M T G cg_lookup cg_insert u w completeInputTraces append_heuristic = (let
      cu = cg_lookup G u;
      u0 = shortest_list_in_tree_or_default cu T u;
      l0 = -1::int;
      u' = fst ((foldl (append_heuristic T w) (u0,l0) (filter (isin T) cu)) :: (('b×'c) list × int));
      T' = insert T (u'@w);
      G' = cg_insert G (maximal_prefix_in_language M (initial M) (u'@w)) 
    in if completeInputTraces
      then let TC = complete_inputs_to_tree M (initial M) (outputs_as_list M) (map fst (u'@w));
               T'' = Prefix_Tree.combine T' TC
           in (T'',G')     
      else (T',G'))"

(* alternative implementation: consider inserting the intersection of L M and TC into G' *)
(*
fun distribute_extension :: "('a::linorder,'b::linorder,'c::linorder) fsm ⇒ ('b×'c) prefix_tree ⇒ 'd ⇒ ('d ⇒ ('b×'c) list ⇒ ('b×'c) list list) ⇒ ('d ⇒ ('b×'c) list ⇒ 'd) ⇒('b×'c) list ⇒ ('b×'c) list ⇒ bool ⇒ (('b×'c) prefix_tree ⇒ ('b×'c) list ⇒ ('b×'c) list ⇒ (('b×'c) list × int) ⇒ (('b×'c) list × int)) ⇒ (('b×'c) prefix_tree ×'d)" where
 "distribute_extension M T G cg_lookup cg_insert u w completeInputTraces append_heuristic = (let
      u0 = shortest_list_in_tree_or_default (cg_lookup G u) T u;
      l0 = -1::int;
      u' = fst ((foldr (append_heuristic T w) (filter (isin T) (cg_lookup G u)) (u0,l0)) :: (('b×'c) list × int));
      T' = insert T (u'@w);
      G' = cg_insert G (maximal_prefix_in_language M (initial M) (u'@w)) 
    in if completeInputTraces
      then let lang = language_for_input M (after_initial M u') (map fst w);
               T'' = combine_after T' u' (Prefix_Tree.from_list lang);
               G'' = foldr (λ io G . cg_insert G (u'@io)) lang G'
           in (T'',G'')
      else (T',G'))"
*)


lemma distribute_extension_subset :
  "set T  set (fst (distribute_extension M T G cg_lookup cg_insert u w b heuristic))"
proof -

  define u0 where u0: "u0 = shortest_list_in_tree_or_default (cg_lookup G u) T u"
  define l0 where l0: "l0 = (-1::int)"
  define u' where u': "u' = fst (foldl (heuristic T w) (u0,l0) (filter (isin T) (cg_lookup G u)))"
  define T' where T': "T' = insert T (u'@w)"
  define G' where G': "G' = cg_insert G (maximal_prefix_in_language M (initial M) (u'@w))"

  have "set T  set T'"
    unfolding T' insert_set
    by blast

  show ?thesis proof (cases b)
    case True
    then show ?thesis
      using set T  set T' 
      unfolding distribute_extension.simps u0 l0 u' T' G' Let_def
      using combine_set
      by force
  next
    case False
    then have "fst (distribute_extension M T G cg_lookup cg_insert u w b heuristic) = T'"
      unfolding distribute_extension.simps u0 l0 u' T' G' Let_def by force
    then show ?thesis 
      using set T  set T'
      by blast
  qed
qed


lemma distribute_extension_finite :
  assumes "finite_tree T"
  shows "finite_tree (fst (distribute_extension M T G cg_lookup cg_insert u w b heuristic))"
proof -

  define u0 where u0: "u0 = shortest_list_in_tree_or_default (cg_lookup G u) T u"
  define l0 where l0: "l0 = (-1::int)"
  define u' where u': "u' = fst (foldl (heuristic T w) (u0,l0) (filter (isin T) (cg_lookup G u)))"
  define T' where T': "T' = insert T (u'@w)"
  define G' where G': "G' = cg_insert G (maximal_prefix_in_language M (initial M) (u'@w))"

  have "finite_tree T'"
    unfolding T' 
    using insert_finite_tree[OF assms]
    by blast

  show ?thesis proof (cases b)
    case True
    then show ?thesis
      using finite_tree T' 
      unfolding distribute_extension.simps u0 l0 u' T' G' Let_def
      by (simp add: combine_finite_tree complete_inputs_to_tree_finite_tree)
  next
    case False
    then have "fst (distribute_extension M T G cg_lookup cg_insert u w b heuristic) = T'"
      unfolding distribute_extension.simps u0 l0 u' T' G' Let_def by force
    then show ?thesis 
      using finite_tree T'
      by blast
  qed
qed
  

lemma distribute_extension_adds_sequence :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  assumes "observable M1"
  and     "minimal M1"
  and     "u  L M1" and "u  L M2"
  and     "convergence_graph_lookup_invar M1 M2 cg_lookup G"
  and     "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
  and     "(L M1  set (fst (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic)) = L M2  set (fst (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic)))"
  and     " u' uBest lBest . fst (heuristic T w (uBest,lBest) u')  {u',uBest}"
shows " u' . converge M1 u u'  u'@w  set (fst (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic))  converge M2 u u'"
and   "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic))"
proof -

  define u0 where u0: "u0 = shortest_list_in_tree_or_default (cg_lookup G u) T u"
  define l0 where l0: "l0 = (-1::int)"
  define u' where u': "u' = fst (foldl (heuristic T w) (u0,l0) (filter (isin T) (cg_lookup G u)))"
  define T' where T': "T' = insert T (u'@w)"
  define G' where G': "G' = cg_insert G (maximal_prefix_in_language M1 (initial M1) (u'@w))"

  define TC where TC: "TC = complete_inputs_to_tree M1 (initial M1) (outputs_as_list M1) (map fst (u'@w))"
  define T'' where T'': "T'' = Prefix_Tree.combine T' TC"

  have "distribute_extension M1 T G cg_lookup cg_insert u w b heuristic = (T',G') 
        distribute_extension M1 T G cg_lookup cg_insert u w b heuristic = (T'',G')"
    unfolding distribute_extension.simps u0 l0 u' T' G' TC T'' Let_def by force
  moreover have "set T'  set T''"
    unfolding T'' combine_set by blast
  ultimately have "set T'  set (fst (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic))"
    by force

  have " xs . fst (foldl (heuristic T w) (u0,l0) xs)  Set.insert u0 (list.set xs)"
  proof -
    fix xs
    
    show "fst (foldl (heuristic T w) (u0,l0) xs)  Set.insert u0 (list.set xs)"
    proof (induction xs rule: rev_induct)
      case Nil
      then show ?case 
        by auto
    next
      case (snoc x xs)
      have " u' uBest lBest . (fst ((heuristic T w) (uBest,lBest) u')) = u'  (fst ((heuristic T w) (uBest,lBest) u')) = uBest"
        using assms(8) by blast
      then have "(fst ((heuristic T w) (foldl (heuristic T w) (u0, l0) xs) x)) = x  (fst ((heuristic T w) (foldl (heuristic T w) (u0, l0) xs) x)) = fst (foldl (heuristic T w) (u0, l0) xs)"
        by (metis prod.exhaust_sel)
      then show ?case 
        using snoc.IH by auto        
    qed
  qed
  then have "u'  Set.insert u0 (list.set (filter (isin T) (cg_lookup G u)))" 
    unfolding u'
    by blast
  then have "u'  Set.insert u0 (list.set (cg_lookup G u))" 
    by auto
  moreover have "converge M1 u u0"
    unfolding u' 
    using shortest_list_in_tree_or_default_elem[of "cg_lookup G u" T u] 
    by (metis assms(1-5) convergence_graph_lookup_invar_def convergence_minimal insert_iff u0)
  moreover have " u' . u'  list.set (cg_lookup G u)  converge M1 u u'"
    using assms(3,4,5)
    by (metis convergence_graph_lookup_invar_def) 
  ultimately have "converge M1 u u'"
    by blast
  moreover have "u'@w  set (fst (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic))"
    using set T'  set (fst (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic))
    unfolding T' insert_set fst_conv
    by blast
  moreover have "converge M2 u u'"
    by (metis u'  Set.insert u0 (list.set (cg_lookup G u)) assms(3) assms(4) assms(5) converge.elims(3) convergence_graph_lookup_invar_def insertE shortest_list_in_tree_or_default_elem u0)
  ultimately show " u' . converge M1 u u'  u'@w  set (fst (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic))  converge M2 u u'"
    by blast


  have "(maximal_prefix_in_language M1 (initial M1) (u'@w))  L M1"
  and  "(maximal_prefix_in_language M1 (initial M1) (u'@w))  list.set (prefixes (u'@w))"
    using maximal_prefix_in_language_properties[OF assms(1) fsm_initial]
    by auto
  
  moreover have "(maximal_prefix_in_language M1 (initial M1) (u'@w))  set (fst (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic))"
    using u'@w  set (fst (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic)) set_prefix
    by (metis (no_types, lifting) maximal_prefix_in_language M1 (FSM.initial M1) (u' @ w)  list.set (prefixes (u' @ w)) prefixes_set_ob) 
  ultimately have "(maximal_prefix_in_language M1 (initial M1) (u'@w))  L M2"
    using assms(7)
    by blast

  have "convergence_graph_lookup_invar M1 M2 cg_lookup G'"
    using assms(5,6) (maximal_prefix_in_language M1 (initial M1) (u'@w))  L M1 (maximal_prefix_in_language M1 (initial M1) (u'@w))  L M2
    unfolding G' convergence_graph_insert_invar_def 
    by blast
  
  
  show "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (distribute_extension M1 T G cg_lookup cg_insert u w b heuristic))"
    using convergence_graph_lookup_invar M1 M2 cg_lookup G' 
    unfolding distribute_extension.simps u0 l0 u' T' G' Let_def by force
qed


subsubsection ‹Distinguishing a Trace from Other Traces›

fun spyh_distinguish :: "('a::linorder,'b::linorder,'c::linorder) fsm  ('b×'c) prefix_tree  'd  ('d  ('b×'c) list  ('b×'c) list list)  ('d  ('b×'c) list  'd)  ('a  'a  ('b×'c) list)  ('b×'c) list  ('b×'c) list list  nat  bool  (('b×'c) prefix_tree  ('b×'c) list  (('b×'c) list × int)  ('b×'c) list  (('b×'c) list × int))  (('b×'c) prefix_tree × 'd)" where
  "spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic = (let 
      dist_helper = (λ (T,G) v . if after_initial M u = after_initial M v
                                  then (T,G)
                                  else (let ew = get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u v k
                                         in if fst ew = 0
                                              then (T,G)
                                              else (let u' = (u@(snd ew));
                                                        v' = (v@(snd ew));
                                                        w' = if does_distinguish M (after_initial M u) (after_initial M v) (snd ew) then (snd ew) else (snd ew)@(get_distinguishing_trace (after_initial M u') (after_initial M v'));
                                                        TG' = distribute_extension M T G cg_lookup cg_insert u w' completeInputTraces append_heuristic
                                                    in distribute_extension M (fst TG') (snd TG') cg_lookup cg_insert v w' completeInputTraces append_heuristic)))
    in foldl dist_helper (T,G) X)"



lemma spyh_distinguish_subset :
  "set T  set (fst (spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))"
proof (induction X rule: rev_induct)
  case Nil
  then show ?case by auto
next
  case (snoc a X)

  have "set (fst (spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))
          set (fst (spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic))"
  proof -
    define dh where dh: "dh = (λ (T,G) v . if after_initial M u = after_initial M v
                                  then (T,G)
                                  else (let ew = get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u v k
                                         in if fst ew = 0
                                              then (T,G)
                                              else (let u' = (u@(snd ew));
                                                        v' = (v@(snd ew));
                                                        w' = if does_distinguish M (after_initial M u) (after_initial M v) (snd ew) then (snd ew) else (snd ew)@(get_distinguishing_trace (after_initial M u') (after_initial M v'));
                                                        TG' = distribute_extension M T G cg_lookup cg_insert u w' completeInputTraces append_heuristic
                                                    in distribute_extension M (fst TG') (snd TG') cg_lookup cg_insert v w' completeInputTraces append_heuristic)))"

    have "spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic
                = dh (spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) a"
      unfolding dh spyh_distinguish.simps Let_def
      unfolding foldl_append
      by auto

    moreover have " T G . set T  set (fst (dh (T,G) a))"
    proof -
      fix T G 
      show "set T  set (fst (dh (T,G) a))"        
      proof (cases "after_initial M u = after_initial M a")
        case True
        then show ?thesis using dh by auto
      next
        case False
        then show ?thesis proof (cases "fst (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k) = 0")
          case True
          then show ?thesis using False dh by auto
        next
          case False

          define u' where u': "u' = (u@(snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k)))"
          define v' where v': "v' = (a@(snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k)))"
          define w where w: "w = get_distinguishing_trace (after_initial M u') (after_initial M v')"
          define w' where w': "w' = (if does_distinguish M (after_initial M u) (after_initial M a) (snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k)) then (snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k)) else (snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k))@w)"
          define TG' where TG': "TG' = distribute_extension M T G cg_lookup cg_insert u w' completeInputTraces append_heuristic"

          have "dh (T,G) a = distribute_extension M (fst (distribute_extension M T G cg_lookup cg_insert u w' completeInputTraces append_heuristic)) (snd (distribute_extension M T G cg_lookup cg_insert u w' completeInputTraces append_heuristic)) cg_lookup cg_insert a w' completeInputTraces append_heuristic"
            using False FSM.after M (FSM.initial M) u  FSM.after M (FSM.initial M) a
            unfolding dh u' v' w w' TG' Let_def case_prod_conv by metis

          then show ?thesis
            using distribute_extension_subset
            by (metis (no_types, lifting) subset_trans)
        qed
      qed
    qed

    ultimately show ?thesis 
      by (metis eq_fst_iff)
  qed

  then show ?case 
    using snoc.IH by blast
qed

lemma spyh_distinguish_finite :
  fixes T :: "('b::linorder×'c::linorder) prefix_tree"
  assumes "finite_tree T"
  shows "finite_tree (fst (spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))"
proof (induction X rule: rev_induct)
  case Nil
  then show ?case using assms by auto
next
  case (snoc a X)

  
  define dh where dh: "dh = (λ (T,G) v . if after_initial M u = after_initial M v
                                then (T,G)
                                else (let ew = get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u v k
                                       in if fst ew = 0
                                            then (T,G)
                                            else (let u' = (u@(snd ew));
                                                      v' = (v@(snd ew));
                                                      w' = if does_distinguish M (after_initial M u) (after_initial M v) (snd ew) then (snd ew) else (snd ew)@(get_distinguishing_trace (after_initial M u') (after_initial M v'));
                                                      TG' = distribute_extension M T G cg_lookup cg_insert u w' completeInputTraces append_heuristic
                                                  in distribute_extension M (fst TG') (snd TG') cg_lookup cg_insert v w' completeInputTraces append_heuristic)))"

  have *: "spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic
                = dh (spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) a"
      unfolding dh spyh_distinguish.simps Let_def
      unfolding foldl_append
      by auto

  have **:" T G . finite_tree T  finite_tree (fst (dh (T,G) a))"
  proof -
    fix T :: "('b×'c) prefix_tree"
    fix G 
    assume "finite_tree T"                      
    show "finite_tree (fst (dh (T,G) a))"        
    proof (cases "after_initial M u = after_initial M a")
      case True
      then show ?thesis using dh finite_tree T by auto
    next
      case False
      then show ?thesis proof (cases "fst (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k) = 0")
        case True
        then show ?thesis using False dh finite_tree T by auto
      next
        case False

        define u' where u': "u' = (u@(snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k)))"
        define v' where v': "v' = (a@(snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k)))"
        define w where w: "w = get_distinguishing_trace (after_initial M u') (after_initial M v')"
        define w' where w': "w' = (if does_distinguish M (after_initial M u) (after_initial M a) (snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k)) then (snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k)) else (snd (get_prefix_of_separating_sequence M T G cg_lookup get_distinguishing_trace u a k))@w)"
        define TG' where TG': "TG' = distribute_extension M T G cg_lookup cg_insert u w'"

        have *:"dh (T,G) a = distribute_extension M (fst (distribute_extension M T G cg_lookup cg_insert u w' completeInputTraces append_heuristic)) (snd (distribute_extension M T G cg_lookup cg_insert u w' completeInputTraces append_heuristic)) cg_lookup cg_insert a w' completeInputTraces append_heuristic"
          using False FSM.after M (FSM.initial M) u  FSM.after M (FSM.initial M) a
          unfolding dh u' v' w w' TG' Let_def case_prod_conv by metis

        show ?thesis
          unfolding *
          using distribute_extension_finite[OF distribute_extension_finite[OF finite_tree T]]
          by metis
      qed
    qed
  qed

  show ?case 
    unfolding *
    using **[OF snoc]
    by (metis eq_fst_iff)
qed


lemma spyh_distinguish_establishes_divergence :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "u  L M1" and "u  L M2"
  and     " α β q1 q2 . q1  states M1  q2  states M1  q1  q2  distinguishes M1 q1 q2 (get_distinguishing_trace q1 q2)"
  and     "convergence_graph_lookup_invar M1 M2 cg_lookup G"
  and     "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
  and     "list.set X  L M1"
  and     "list.set X  L M2"
  and     "L M1  set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic)) = L M2  set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))"
  and     " T w u' uBest lBest . fst (append_heuristic T w (uBest,lBest) u')  {u',uBest}"
shows " v . v  list.set X  ¬ converge M1 u v  ¬ converge M2 u v"
(is "?P1 X")
and   "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))"
(is "?P2 X")
proof -
  have "?P1 X  ?P2 X"
    using assms(10,11,12) 
  proof (induction X rule: rev_induct)
    case Nil

    have *: "spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u [] k completeInputTraces append_heuristic = (T,G)"
      by auto

    show ?case 
      using Nil assms(8)
      unfolding * fst_conv snd_conv by auto
  next
    case (snoc a X)

    define dh where dh: "dh = (λ (T,G) v . if after_initial M1 u = after_initial M1 v
                                  then (T,G)
                                  else (let ew = get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u v k
                                         in if fst ew = 0
                                              then (T,G)
                                              else (let u' = (u@(snd ew));
                                                        v' = (v@(snd ew));
                                                        w' = (if does_distinguish M1 (after_initial M1 u) (after_initial M1 v) (snd ew) then (snd ew) else (snd ew)@(get_distinguishing_trace (after_initial M1 u') (after_initial M1 v')));
                                                        TG' = distribute_extension M1 T G cg_lookup cg_insert u w' completeInputTraces append_heuristic
                                                    in distribute_extension M1 (fst TG') (snd TG') cg_lookup cg_insert v w' completeInputTraces append_heuristic)))"

    have "spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic
                = dh (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) a"
      unfolding dh spyh_distinguish.simps Let_def
      unfolding foldl_append
      by auto



    have " T G . set T  set (fst (dh (T,G) a))"
    proof -
      fix T G 
      show "set T  set (fst (dh (T,G) a))"        
      proof (cases "after_initial M1 u = after_initial M1 a")
        case True
        then show ?thesis using dh by auto
      next
        case False
        then show ?thesis proof (cases "fst (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u a k) = 0")
          case True
          then show ?thesis using False dh by auto
        next
          case False

          define u' where u': "u' = (u@(snd (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u a k)))"
          define v' where v': "v' = (a@(snd (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u a k)))"
          define w where w: "w = get_distinguishing_trace (after_initial M1 u') (after_initial M1 v')"
          define w' where w': "w' = (if does_distinguish M1 (after_initial M1 u) (after_initial M1 a) (snd (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u a k)) then (snd (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u a k)) else (snd (get_prefix_of_separating_sequence M1 T G cg_lookup get_distinguishing_trace u a k))@w)"
          define TG' where TG': "TG' = distribute_extension M1 T G cg_lookup cg_insert u w'"

          have "dh (T,G) a = distribute_extension M1 (fst (distribute_extension M1 T G cg_lookup cg_insert u w' completeInputTraces append_heuristic)) (snd (distribute_extension M1 T G cg_lookup cg_insert u w' completeInputTraces append_heuristic)) cg_lookup cg_insert a w' completeInputTraces append_heuristic"
            using False FSM.after M1 (FSM.initial M1) u  FSM.after M1 (FSM.initial M1) a
            unfolding dh u' v' w w' TG' Let_def case_prod_conv by metis

          then show ?thesis
            using distribute_extension_subset
            by (metis (no_types, lifting) subset_trans)
        qed
      qed
    qed
    then have "set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))  set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic))" 
      unfolding spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic = dh (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) a
      by (metis prod.exhaust_sel)
    then have "L M1  Prefix_Tree.set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic)) = L M2  Prefix_Tree.set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))"
      using snoc.prems(3) by blast
    moreover have "list.set X  L M1"
      using snoc.prems(1) by auto
    moreover have "list.set X  L M2"
      using snoc.prems(2) by auto
    ultimately have "?P1 X" and "?P2 X"
      using snoc.IH by blast+


    obtain T' G' where "(spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) = (T',G')"
      using prod.exhaust by metis

    then have "convergence_graph_lookup_invar M1 M2 cg_lookup G'"
      using ?P2 X by auto

    have "L M1  set T' = L M2  set T'"
      using L M1  Prefix_Tree.set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic)) = L M2  Prefix_Tree.set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))
            (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) = (T',G')
      by auto 
    

    have "¬converge M1 u a  ¬converge M2 u a" and "?P2 (X@[a])"
    proof -
      have "a  L M1"
        using snoc.prems(1) by auto
      then have "¬converge M1 u a  after_initial M1 u  after_initial M1 a"
        using u  L M1 
        using assms(1) assms(3) convergence_minimal by blast

      have "a  L M2"
        using snoc.prems(2) by auto

      define ew where ew: "ew = get_prefix_of_separating_sequence M1 T' G' cg_lookup get_distinguishing_trace u a k"

      have "(¬converge M1 u a  ¬converge M2 u a)  ?P2 (X@[a])"
      proof (cases "fst ew = 0")
        case True
        then have *: "fst (get_prefix_of_separating_sequence M1 T' G' cg_lookup get_distinguishing_trace u a k) = 0"
          unfolding ew by auto

        have "L M1  Prefix_Tree.set T' = L M2  Prefix_Tree.set T'  ¬ converge M1 u a  ¬ converge M2 u a" 
          using get_prefix_of_separating_sequence_result(1)[OF assms(1,2,3) u  L M1 u  L M2 a  L M1 a  L M2 ¬converge M1 u a  after_initial M1 u  after_initial M1 a assms(7) convergence_graph_lookup_invar M1 M2 cg_lookup G' _ *] 
          by fast
        then have "(¬converge M1 u a  ¬converge M2 u a)"
          using L M1  set T' = L M2  set T'
          by blast

        have "(snd (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic)) = (snd (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))"
          unfolding spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic = dh (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) a
          unfolding (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) = (T',G')
          unfolding dh case_prod_conv snd_conv
          using True ew
          by fastforce 
        then have "?P2 (X@[a])"
          using ?P2 X
          by auto
        then show ?thesis 
          using (¬converge M1 u a  ¬converge M2 u a)
          by auto          
      next
        case False
        then have *: "fst (get_prefix_of_separating_sequence M1 T' G' cg_lookup get_distinguishing_trace u a k)  0"
          unfolding ew by auto

        define w where w: "w = get_distinguishing_trace (after_initial M1 (u@(snd ew))) (after_initial M1 (a@(snd ew)))"
        define w' where w': "w' = (if does_distinguish M1 (after_initial M1 u) (after_initial M1 a) (snd ew) then (snd ew) else (snd ew)@w)"
        define TG' where TG': "TG' = distribute_extension M1 T' G' cg_lookup cg_insert u w' completeInputTraces append_heuristic"

        show ?thesis proof (cases "¬ converge M1 u a")
          case True
          then have "after_initial M1 u  after_initial M1 a"
            using u  L M1 a  L M1
            using assms(1) assms(3) convergence_minimal by blast

          obtain γ where "distinguishes M1 (after_initial M1 u) (after_initial M1 a) (snd ew @ γ)"
            unfolding ew = get_prefix_of_separating_sequence M1 T' G' cg_lookup get_distinguishing_trace u a k
            using get_prefix_of_separating_sequence_result(2)[OF assms(1,2,3) u  L M1 u  L M2 a  L M1 a  L M2 after_initial M1 u  after_initial M1 a assms(7) convergence_graph_lookup_invar M1 M2 cg_lookup G' _ *]
            using L M1  Prefix_Tree.set T' = L M2  Prefix_Tree.set T' by presburger

          have "dh (T',G') a = distribute_extension M1 (fst TG') (snd TG') cg_lookup cg_insert a w' completeInputTraces append_heuristic"
            unfolding dh w w' TG' case_prod_conv
            unfolding ew[symmetric] Let_def
            using ew False after_initial M1 u  after_initial M1 a
            by meson 
  
          have "L M1  set (fst (dh (T',G') a)) = L M2  set (fst (dh (T',G') a))"
            using snoc.prems(3)
            using spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic = dh (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) a spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic = (T', G') 
            by auto 
          moreover have "set (fst (distribute_extension M1 T' G' cg_lookup cg_insert u w' completeInputTraces append_heuristic))  set (fst (dh (T',G') a))"
            by (metis TG' dh (T', G') a = distribute_extension M1 (fst TG') (snd TG') cg_lookup cg_insert a w' completeInputTraces append_heuristic distribute_extension_subset)
          ultimately have "(L M1  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert u w' completeInputTraces append_heuristic)) = L M2  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert u w' completeInputTraces append_heuristic)))"
            by blast
  
          obtain u' where "converge M1 u u'" and "converge M2 u u'"
                      and "u' @ w'  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert u w' completeInputTraces append_heuristic))"
                      and "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG')"
            using distribute_extension_adds_sequence[OF assms(1,3) u  L M1 u  L M2 convergence_graph_lookup_invar M1 M2 cg_lookup G' convergence_graph_insert_invar M1 M2 cg_lookup cg_insert, of _ _ completeInputTraces append_heuristic, OF _ assms(13) ]  
                  (L M1  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert u w' completeInputTraces append_heuristic)) = L M2  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert u w' completeInputTraces append_heuristic)))
            unfolding TG'
            by blast
          then have "u' @ w'  set (fst (dh (T',G') a))"
            unfolding dh (T',G') a = distribute_extension M1 (fst TG') (snd TG') cg_lookup cg_insert a w' completeInputTraces append_heuristic 
            by (metis (no_types, opaque_lifting) TG' distribute_extension_subset in_mono)
  
  
          obtain a' where "converge M1 a a'" and "converge M2 a a'"
                      and "a' @ w'  set (fst (dh (T',G') a))"
                      and "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (dh (T',G') a))"
            using distribute_extension_adds_sequence[OF assms(1,3) a  L M1 a  L M2 convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') convergence_graph_insert_invar M1 M2 cg_lookup cg_insert, of "fst TG'" w' completeInputTraces append_heuristic, OF _ assms(13)]
                  L M1  set (fst (dh (T',G') a)) = L M2  set (fst (dh (T',G') a))
            unfolding dh (T',G') a = distribute_extension M1 (fst TG') (snd TG') cg_lookup cg_insert a w' completeInputTraces append_heuristic
            by blast
  
          have "u'  L M1" and "a'  L M1"
            using converge M1 u u' converge M1 a a' by auto
  
          have "?P2 (X@[a])"
            using convergence_graph_lookup_invar M1 M2 cg_lookup (snd (dh (T',G') a))
            using False after_initial M1 u  after_initial M1 a
            using spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic = dh (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) a spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic= (T', G') 
            by presburger
            
  
          show ?thesis proof (cases "does_distinguish M1 (after_initial M1 u) (after_initial M1 a) (snd ew)")
            case True
            then have "distinguishes M1 (after_initial M1 u) (after_initial M1 a) w'"
              using does_distinguish_correctness[OF assms(1) after_is_state[OF assms(1) u  L M1] after_is_state[OF assms(1) a  L M1]] w'
              by metis
  
            show ?thesis 
              using distinguish_converge_diverge[OF assms(1,2,3) u'  L M1 a'  L M1 converge M1 u u' converge M1 a a' converge M2 u u' converge M2 a a' distinguishes M1 (after_initial M1 u) (after_initial M1 a) w' u' @ w'  set (fst (dh (T',G') a)) a' @ w'  set (fst (dh (T',G') a)) L M1  set (fst (dh (T',G') a)) = L M2  set (fst (dh (T',G') a))] 
                    ?P2 (X@[a])  
              by blast
          next
            case False
            then have "¬ distinguishes M1 (after_initial M1 u) (after_initial M1 a) (snd ew)"
              using does_distinguish_correctness[OF assms(1) after_is_state[OF assms(1) u  L M1] after_is_state[OF assms(1) a  L M1]] 
              by blast
            then have "snd ew  LS M1 (after_initial M1 u) = (snd ew  LS M1 (after_initial M1 a))"
              unfolding distinguishes_def 
              by blast
            moreover have "snd ew  LS M1 (after_initial M1 u)  (snd ew  LS M1 (after_initial M1 a))"
              using distinguishes M1 (after_initial M1 u) (after_initial M1 a) (snd ew @ γ)
              using language_prefix[of "snd ew" γ]
              unfolding distinguishes_def 
              by fast
            ultimately have "snd ew  LS M1 (after_initial M1 u)" and "snd ew  LS M1 (after_initial M1 a)"
              by auto
  
            have "after_initial M1 (u @ snd ew)  states M1"
              using snd ew  LS M1 (after_initial M1 u) after_is_state[OF assms(1) u  L M1]
              by (meson after_is_state after_language_iff assms(1) assms(5))
            moreover have "after_initial M1 (a @ snd ew)  states M1"
              using snd ew  LS M1 (after_initial M1 a) after_is_state[OF assms(1) a  L M1]
              by (meson a  L M1 after_is_state after_language_iff assms(1))
            moreover have "after_initial M1 (u @ snd ew)  after_initial M1 (a @ snd ew)" 
              using distinguishes M1 (after_initial M1 u) (after_initial M1 a) (snd ew @ γ)
              by (metis a  L M1 snd ew  LS M1 (after_initial M1 a) snd ew  LS M1 (after_initial M1 u) after_distinguishes_language after_language_iff append.assoc assms(1) assms(5))
            ultimately have "distinguishes M1 (after_initial M1 (u @ snd ew)) (after_initial M1 (a @ snd ew)) w"
              unfolding w using assms(7)
              by blast 
            moreover have "w' = snd ew @ w"
              using False w' by auto
            ultimately have "distinguishes M1 (after_initial M1 u) (after_initial M1 a) w'"
              using distinguish_prepend_initial[OF assms(1)]
              by (meson a  L M1 snd ew  LS M1 (after_initial M1 a) snd ew  LS M1 (after_initial M1 u) after_language_iff assms(1) assms(5))
  
            show ?thesis 
              using distinguish_converge_diverge[OF assms(1,2,3) u'  L M1 a'  L M1 converge M1 u u' converge M1 a a' converge M2 u u' converge M2 a a' distinguishes M1 (after_initial M1 u) (after_initial M1 a) w' u' @ w'  set (fst (dh (T',G') a)) a' @ w'  set (fst (dh (T',G') a)) L M1  set (fst (dh (T',G') a)) = L M2  set (fst (dh (T',G') a))]
                    ?P2 (X@[a])  
              by blast
          qed
        next
          case False
          then have "after_initial M1 u = after_initial M1 a"
            by (meson a  L M1 assms(1) assms(3) assms(5) convergence_minimal)
          then have "dh (T',G') a = (T',G')"
            unfolding dh case_prod_conv 
            by auto
          then have "?P2 (X@[a])"
            using ?P2 X
            by (metis spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u (X@[a]) k completeInputTraces append_heuristic = dh (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic) a spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic = (T', G')) 
          then show ?thesis
            using False
            by blast
        qed
      qed
      then show "¬ converge M1 u a  ¬ converge M2 u a"
            and "?P2 (X@[a])"
        by blast+
    qed
    
    have "?P1 (X@[a])"
    proof -  
      have " v . v  list.set X  ¬converge M1 u v  ¬converge M2 u v"
        using ?P1 X 
        unfolding preserves_divergence.simps
        using Int_absorb2 list.set X  L M1 assms(5) by blast 
      then show ?thesis
        using ¬ converge M1 u a  ¬ converge M2 u a by auto
    qed
    then show ?case
      using ?P2 (X@[a]) by auto
  qed

  then show "?P1 X" and "?P2 X"
    by auto
qed


lemma spyh_distinguish_preserves_divergence :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "u  L M1" and "u  L M2"
  and     " α β q1 q2 . q1  states M1  q2  states M1  q1  q2  distinguishes M1 q1 q2 (get_distinguishing_trace q1 q2)"
  and     "convergence_graph_lookup_invar M1 M2 cg_lookup G"
  and     "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
  and     "list.set X  L M1"
  and     "list.set X  L M2"
  and     "L M1  set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic)) = L M2  set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))"
  and     " T w u' uBest lBest . fst (append_heuristic T w (uBest,lBest) u')  {u',uBest}"
  and     "preserves_divergence M1 M2 (list.set X)"
shows "preserves_divergence M1 M2 (Set.insert u (list.set X))"
(is "?P1 X")
  using spyh_distinguish_establishes_divergence(1)[OF assms(1-13)] 
  using assms(14) 
  unfolding preserves_divergence.simps
  by (metis IntD2 Int_iff assms(10) converge.elims(2) converge.elims(3) inf.absorb_iff2 insert_iff)
  

subsection ‹HandleIOPair›


definition handle_io_pair :: "bool  bool  (('a::linorder,'b::linorder,'c::linorder) fsm 
                                            ('a,'b,'c) state_cover_assignment 
                                            ('b×'c) prefix_tree  
                                            'd 
                                            ('d  ('b×'c) list  'd)  
                                            ('d  ('b×'c) list  ('b×'c) list list)  
                                            'a  'b  'c   
                                            (('b×'c) prefix_tree × 'd))" where
  "handle_io_pair completeInputTraces useInputHeuristic M V T G cg_insert cg_lookup q x y = 
      distribute_extension M T G cg_lookup cg_insert (V q) [(x,y)] completeInputTraces (if useInputHeuristic then append_heuristic_input M else append_heuristic_io)"
    
lemma handle_io_pair_verifies_io_pair : "verifies_io_pair (handle_io_pair b c) M1 M2 cg_lookup cg_insert"
proof -
  
  have *:" (M::('a::linorder,'b::linorder,'c::linorder) fsm) V T (G::'d) cg_insert cg_lookup q x y . set T  set (fst (handle_io_pair b c M V T G cg_insert cg_lookup q x y))"
    using distribute_extension_subset unfolding handle_io_pair_def
    by metis 

  have ***:" (M::('a::linorder,'b::linorder,'c::linorder) fsm) V T (G::'d) cg_insert cg_lookup q x y . finite_tree T  finite_tree (fst (handle_io_pair b c M V T G cg_insert cg_lookup q x y))"
    using distribute_extension_finite unfolding handle_io_pair_def
    by metis 

  have **:" (M1::('a::linorder,'b::linorder,'c::linorder) fsm) V T (G::'d) cg_insert cg_lookup q x y.
        observable M1 
        observable M2 
        minimal M1 
        minimal M2 
        FSM.inputs M2 = FSM.inputs M1 
        FSM.outputs M2 = FSM.outputs M1 
        is_state_cover_assignment M1 V 
        L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1 
        q  reachable_states M1 
        x  inputs M1 
        y  outputs M1  
        convergence_graph_lookup_invar M1 M2 cg_lookup G 
        convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
        L M1  set (fst (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y)) = L M2  set (fst (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y)) 
        ( α . 
             converge M1 α (V q)  
             converge M2 α (V q) 
             α  set (fst (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y)) 
             α@[(x,y)]  set (fst (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y)))
         convergence_graph_lookup_invar M1 M2 cg_lookup (snd (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y))"
  proof -
    fix M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
    fix G :: 'd
    fix V T cg_insert cg_lookup q x y
    assume a01: "observable M1"
    assume a02: "observable M2"
    assume a03: "minimal M1"
    assume a04: "minimal M2"
    assume a05: "FSM.inputs M2 = FSM.inputs M1"
    assume a06: "FSM.outputs M2 = FSM.outputs M1"
    assume a07: "is_state_cover_assignment M1 V"
    assume a09: "L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1"
    assume a10: "q  reachable_states M1"
    assume a11: "x  inputs M1"
    assume a12: "y  outputs M1"
    assume a13: "convergence_graph_lookup_invar M1 M2 cg_lookup G"
    assume a14: "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
    assume a15: "L M1  set (fst (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y)) = L M2  set (fst (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y))"

    let ?heuristic = "(if c then append_heuristic_input M1 else append_heuristic_io)"

    have d1: "V q  L M1"
      using is_state_cover_assignment_language[OF a07 a10] by auto
    have d2: "V q  L M2"
      using is_state_cover_assignment_language[OF a07 a10]
      using a09 a10 by auto 

    have d3: "L M1  Prefix_Tree.set (fst (distribute_extension M1 T G cg_lookup cg_insert (V q) [(x,y)] b ?heuristic)) = L M2  Prefix_Tree.set (fst (distribute_extension M1 T G cg_lookup cg_insert (V q) [(x,y)] b ?heuristic))"
      using a15 unfolding handle_io_pair_def .

    have d4: "(T w u' uBest lBest. fst (?heuristic T w (uBest, lBest) u')  {u', uBest})"
      using append_heuristic_input_in[of M1] append_heuristic_io_in
      by fastforce

    show "( α . 
             converge M1 α (V q)  
             converge M2 α (V q) 
             α  set (fst (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y)) 
             α@[(x,y)]  set (fst (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y)))
         convergence_graph_lookup_invar M1 M2 cg_lookup (snd (handle_io_pair b c M1 V T G cg_insert cg_lookup q x y))"
      using distribute_extension_adds_sequence[OF a01 a03 d1 d2 a13 a14 d3 d4]
      unfolding handle_io_pair_def
      by (metis converge_sym set_prefix) 
  qed

  show ?thesis
    unfolding verifies_io_pair_def
    using * *** ** by presburger
qed

lemma handle_io_pair_handles_io_pair : "handles_io_pair (handle_io_pair b c) M1 M2 cg_lookup cg_insert"
  using verifies_io_pair_handled[OF handle_io_pair_verifies_io_pair] .



subsection ‹HandleStateCover›

subsubsection ‹Dynamic›


fun handle_state_cover_dynamic :: "bool  
                                  bool 
                                  ('a  'a  ('b×'c) list) 
                                  ('a::linorder,'b::linorder,'c::linorder) fsm 
                                  ('a,'b,'c) state_cover_assignment 
                                  (('a,'b,'c) fsm  ('b×'c) prefix_tree  'd)  
                                  ('d  ('b×'c) list  'd)  
                                  ('d  ('b×'c) list  ('b×'c) list list)  
                                  (('b×'c) prefix_tree × 'd)" 
  where
  "handle_state_cover_dynamic completeInputTraces useInputHeuristic get_distinguishing_trace M V cg_initial cg_insert cg_lookup  = 
    (let
      k = (2 * size M);
      heuristic = (if useInputHeuristic then append_heuristic_input M else append_heuristic_io);
      rstates = reachable_states_as_list M;
      T0' = from_list (map V rstates);
      T0 = (if completeInputTraces 
                then Prefix_Tree.combine T0' (from_list (concat (map (λ q . language_for_input M (initial M) (map fst (V q))) rstates))) 
                else T0');
      G0 = cg_initial M T0;
      separate_state = (λ (X,T,G) q . let u = V q;
                                          TG' = spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces heuristic;
                                          X' = u#X
                                      in (X',TG'))
    in snd (foldl separate_state ([],T0,G0) rstates))"


lemma handle_state_cover_dynamic_separates_state_cover: 
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('e,'b,'c) fsm"
  fixes cg_insert :: "('d  ('b×'c) list  'd)"
  assumes " α β q1 q2 . q1  states M1  q2  states M1  q1  q2  distinguishes M1 q1 q2 (dist_fun q1 q2)"
  shows "separates_state_cover (handle_state_cover_dynamic b c dist_fun) M1 M2 cg_initial cg_insert cg_lookup"
proof -

  let ?f = "(handle_state_cover_dynamic b c dist_fun)"

  have " (V :: ('a,'b,'c) state_cover_assignment) .
          (V ` reachable_states M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup)))
             finite_tree (fst (?f M1 V cg_initial cg_insert cg_lookup))
             (observable M1 
                observable M2 
                minimal M1 
                minimal M2 
                inputs M2 = inputs M1 
                outputs M2 = outputs M1 
                is_state_cover_assignment M1 V 
                convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
                convergence_graph_initial_invar M1 M2 cg_lookup cg_initial 
                L M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) = L M2  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) 
                (preserves_divergence M1 M2 (V ` reachable_states M1)
                 convergence_graph_lookup_invar M1 M2 cg_lookup (snd (?f M1 V cg_initial cg_insert cg_lookup))))" (is " V . ?P V")
  proof -
    fix V :: "('a,'b,'c) state_cover_assignment"

    define k where "k = 2 * size M1"
    define heuristic where "heuristic = (if c then append_heuristic_input M1 else append_heuristic_io)"
    define separate_state where "separate_state = (λ (X,T,G::'d) q . let u = V q;
                                          TG' = spyh_distinguish M1 T G cg_lookup cg_insert dist_fun u X k b heuristic;
                                          X' = u#X
                                      in (X',TG'))"
    define rstates where "rstates = reachable_states_as_list M1"
    define T0' where "T0' = from_list (map V rstates)"
    define T0 where "T0 = (if b 
                then Prefix_Tree.combine T0' (from_list (concat (map (λ q . language_for_input M1 (initial M1) (map fst (V q))) rstates))) 
                else T0')"
    define G0 where "G0 = cg_initial M1 T0"
    
    have *:"(?f M1 V cg_initial cg_insert cg_lookup) = snd (foldl separate_state ([],T0,G0) rstates)"
      unfolding k_def separate_state_def rstates_def heuristic_def T0'_def T0_def G0_def handle_state_cover_dynamic.simps Let_def
      by simp

    have separate_state_subset : " q X T G . set T  set (fst (snd (separate_state (X,T,G) q)))"
      using spyh_distinguish_subset
      unfolding separate_state_def case_prod_conv Let_def snd_conv
      by metis
    then have "set T0  set (fst (?f M1 V cg_initial cg_insert cg_lookup))"
      unfolding *
      by (induction rstates rule: rev_induct; auto; metis (mono_tags, opaque_lifting) Collect_mono_iff prod.exhaust_sel)
    moreover have "set T0'  set T0"
      unfolding T0_def using combine_set by auto
    moreover have "V ` reachable_states M1  set T0'"
      unfolding T0'_def rstates_def using from_list_subset
      by (metis image_set reachable_states_as_list_set) 
    ultimately have p1: "V ` reachable_states M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup))"
      by blast

    have "finite_tree T0'"
      unfolding T0'_def using from_list_finite_tree by auto
    then have "finite_tree T0"
      unfolding T0_def using combine_finite_tree[OF _ from_list_finite_tree]
      by auto 

    have separate_state_finite : " q X T G . finite_tree T  finite_tree (fst (snd (separate_state (X,T,G) q)))"
      using spyh_distinguish_finite
      unfolding separate_state_def case_prod_conv Let_def snd_conv
      by metis
    have p2: "finite_tree (fst (?f M1 V cg_initial cg_insert cg_lookup))"
      unfolding *  
    proof (induction rstates rule: rev_induct)
      case Nil
      show ?case using finite_tree T0 by auto
    next
      case (snoc a rstates) 
      have *:"foldl separate_state ([], T0, G0) (rstates@[a]) = separate_state (foldl separate_state ([], T0, G0) rstates) a"
        by auto
      show ?case 
        using separate_state_finite[OF snoc.IH]
        unfolding *
        by (metis prod.collapse)  
    qed

    have " q X T G . fst (separate_state (X,T,G) q) = V q # X"
      unfolding separate_state_def case_prod_conv Let_def fst_conv by blast

    have heuristic_prop: "(T w u' uBest lBest. fst (heuristic T w (uBest, lBest) u')  {u', uBest})"
      unfolding heuristic_def
      using append_heuristic_input_in[of M1] append_heuristic_io_in
      by fastforce
      

    have p3: "observable M1 
                observable M2 
                minimal M1 
                minimal M2 
                inputs M2 = inputs M1 
                outputs M2 = outputs M1 
                is_state_cover_assignment M1 V 
                convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
                convergence_graph_initial_invar M1 M2 cg_lookup cg_initial 
                L M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) = L M2  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) 
                (preserves_divergence M1 M2 (V ` reachable_states M1)
                 convergence_graph_lookup_invar M1 M2 cg_lookup (snd (?f M1 V cg_initial cg_insert cg_lookup)))"
    proof -
      assume a0: "observable M1"
         and a1: "observable M2"
         and a2: "minimal M1"
         and a3: "minimal M2"
         and a4: "inputs M2 = inputs M1"
         and a5: "outputs M2 = outputs M1"
         and a6: "is_state_cover_assignment M1 V"
         and a7: "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
         and a8: "convergence_graph_initial_invar M1 M2 cg_lookup cg_initial"
         and a9: "L M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) = L M2  set (fst (?f M1 V cg_initial cg_insert cg_lookup))"

      have " rstates . (list.set (fst (foldl separate_state ([],T0,G0) rstates))) = V ` list.set rstates"
      proof -
        fix rstates show "(list.set (fst (foldl separate_state ([],T0,G0) rstates))) = V ` list.set rstates"
        proof (induction rstates rule: rev_induct)
          case Nil
          then show ?case by auto
        next
          case (snoc a rstates)
          have *:"(foldl separate_state ([], T0, G0) (rstates@[a])) = separate_state (foldl separate_state ([], T0, G0) rstates) a"
            by auto
          have **: " q XTG . fst (separate_state XTG q) = V q # fst XTG"
            using  q X T G . fst (separate_state (X,T,G) q) = V q # X by auto
  
          show ?case
            unfolding * **
            using snoc by auto
        qed
      qed
      then have "(list.set (fst (foldl separate_state ([],T0,G0) rstates))) = V ` reachable_states M1"
        by (metis reachable_states_as_list_set rstates_def)

      have " q . q  reachable_states M1  V q  set T0"
        using Prefix_Tree.set T0'  Prefix_Tree.set T0 V ` reachable_states M1  Prefix_Tree.set T0' by auto


      have "list.set rstates  reachable_states M1"
        unfolding rstates_def
        using reachable_states_as_list_set by auto 
      moreover have "L M1  set (fst (snd (foldl separate_state ([],T0,G0) rstates))) = L M2  set (fst (snd (foldl separate_state ([],T0,G0) rstates)))"
        using "*" a9 by presburger
      ultimately have "preserves_divergence M1 M2 (list.set (fst (foldl separate_state ([],T0,G0) rstates)))
                         convergence_graph_lookup_invar M1 M2 cg_lookup (snd (snd (foldl separate_state ([],T0,G0) rstates)))"
      proof (induction rstates rule: rev_induct)
        case Nil
        have "L M1  set T0 = L M2  set T0"
          using a9
          using set T0  set (fst (handle_state_cover_dynamic b c dist_fun M1 V cg_initial cg_insert cg_lookup)) by blast 
        then have "convergence_graph_lookup_invar M1 M2 cg_lookup G0"
          using a8 finite_tree T0
          unfolding G0_def convergence_graph_initial_invar_def
          by blast
        then show ?case by auto  
      next
        case (snoc q rstates)

        obtain X' T' G' where "foldl separate_state ([],T0,G0) rstates = (X',T',G')"
          using prod_cases3 by blast
        then have "T' = fst (snd (foldl separate_state ([],T0,G0) rstates))"  
             and  "X' = fst (foldl separate_state ([],T0,G0) rstates)"
          by auto

        define u where "u = V q"
        define TG'' where "TG'' = spyh_distinguish M1 T' G' cg_lookup cg_insert dist_fun u X' k b heuristic"
        define X'' where "X'' = u#X'"

        have "foldl separate_state ([], T0, G0) (rstates@[q]) = separate_state (X',T',G') q"
          using foldl separate_state ([],T0,G0) rstates = (X',T',G')  by auto
        also have "separate_state (X',T',G') q = (X'',TG'')"
          unfolding separate_state_def u_def TG''_def X''_def case_prod_conv Let_def
          by auto        
        finally have "foldl separate_state ([], T0, G0) (rstates@[q]) = (X'',TG'')" .


        have "set T'  set (fst (snd (foldl separate_state ([],T0,G0) (rstates@[q]))))"
          using separate_state_subset
          unfolding foldl separate_state ([], T0, G0) (rstates@[q]) = separate_state (X',T',G') q by simp
        then have "L M1  set T' = L M2  set T'"
          using snoc.prems(2) by blast

        then have "preserves_divergence M1 M2 (list.set X')"
        and       "convergence_graph_lookup_invar M1 M2 cg_lookup G'"
          using snoc unfolding foldl separate_state ([],T0,G0) rstates = (X',T',G') 
          by auto

        have "set T0  set T'"
          using separate_state_subset 
          unfolding T' = fst (snd (foldl separate_state ([],T0,G0) rstates))
          by (induction rstates rule: rev_induct; auto; metis (mono_tags, opaque_lifting) Collect_mono_iff prod.collapse) 

        have "V q  set T0"
          using snoc.prems
          using q. q  reachable_states M1  V q  Prefix_Tree.set T0 by auto 
        then have "V q  set T'" 
          using set T0  set T' by auto 
        moreover have "V q  L M1"
        proof -
          have "q  reachable_states M1"
            using snoc.prems(1) by auto
          then show ?thesis
            using is_state_cover_assignment_language[OF a6] by blast
        qed 
        ultimately have "V q  L M2"
          using L M1  set T' = L M2  set T' by blast

        
        have "list.set X' = V ` list.set rstates"
          unfolding X' = fst (foldl separate_state ([],T0,G0) rstates)
          using  rstates . (list.set (fst (foldl separate_state ([],T0,G0) rstates))) = V ` list.set rstates
          by blast
        moreover have "list.set rstates  reachable_states M1"
          using snoc.prems(1) by auto
        ultimately have "list.set X'  set T'"
          using set T0  set T'
          using q. q  reachable_states M1  V q  Prefix_Tree.set T0 by auto 
        moreover have "list.set X'  L M1"
          using list.set X' = V ` list.set rstates list.set rstates  reachable_states M1 a6
          by (metis dual_order.trans image_mono state_cover_assignment_language) 
        ultimately have "list.set X'  L M2"
          using L M1  set T' = L M2  set T' by blast

        have *: "L M1  set (fst (spyh_distinguish M1 T' G' cg_lookup cg_insert dist_fun (V q) X' k b heuristic)) =
                 L M2  set (fst (spyh_distinguish M1 T' G' cg_lookup cg_insert dist_fun (V q) X' k b heuristic))"
          using snoc.prems(2) TG''_def foldl separate_state ([], T0, G0) (rstates@[q]) = separate_state (X', T', G') q separate_state (X', T', G') q = (X'', TG'') u_def by auto
          

        have "preserves_divergence M1 M2 (Set.insert (V q) (list.set X'))"
          using spyh_distinguish_preserves_divergence[OF a0 a1 a2 a3 V q  L M1 V q  L M2 assms(1) convergence_graph_lookup_invar M1 M2 cg_lookup G' a7 list.set X'  L M1 list.set X'  L M2 * heuristic_prop preserves_divergence M1 M2 (list.set X')]
          by presburger
        then have "preserves_divergence M1 M2 (list.set X'')"
          by (metis X''_def list.simps(15) u_def)

        moreover have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG'')"
          using spyh_distinguish_establishes_divergence(2)[OF a0 a1 a2 a3 V q  L M1 V q  L M2 assms(1) convergence_graph_lookup_invar M1 M2 cg_lookup G' a7 list.set X'  L M1 list.set X'  L M2 * heuristic_prop ]
          unfolding u_def[symmetric] TG''_def[symmetric]
          by presburger
        ultimately show ?case 
          unfolding foldl separate_state ([], T0, G0) (rstates@[q]) = (X'',TG'') snd_conv fst_conv
          by blast
      qed
      then show ?thesis
        unfolding (list.set (fst (foldl separate_state ([],T0,G0) rstates))) = V ` reachable_states M1
        unfolding * .
    qed

    show "?P V"
      using p1 p2 p3 by blast
  qed

  then show ?thesis 
    unfolding separates_state_cover_def by blast
qed



subsubsection ‹Static›


fun handle_state_cover_static :: "(nat  'a  ('b×'c) prefix_tree) 
                                  ('a::linorder,'b::linorder,'c::linorder) fsm  
                                  ('a,'b,'c) state_cover_assignment  
                                  (('a,'b,'c) fsm  ('b×'c) prefix_tree  'd)  
                                  ('d  ('b×'c) list  'd)  
                                  ('d  ('b×'c) list  ('b×'c) list list)  
                                  (('b×'c) prefix_tree × 'd)" 
  where
  "handle_state_cover_static dist_set M V cg_initial cg_insert cg_lookup  = 
    (let
      separate_state = (λ T q . combine_after T (V q) (dist_set 0 q));
      T' = foldl separate_state empty (reachable_states_as_list M);
      G' = cg_initial M T'
    in (T',G'))"





lemma handle_state_cover_static_applies_dist_sets:
  assumes "q  reachable_states M1"
  shows "set (dist_fun 0 q)  set (after (fst (handle_state_cover_static dist_fun M1 V cg_initial cg_insert cg_lookup)) (V q))"
  (is "set (dist_fun 0 q)  set (after ?T (V q))")
proof -

  define k where "k = 2 * size M1"
  define separate_state where "separate_state = (λ T q . combine_after T (V q) (dist_fun 0 q))"
  define rstates where "rstates = reachable_states_as_list M1"
  define T where "T = foldl separate_state empty rstates"
  define G where "G = cg_initial M1 T"
  
  have *:"?T = T"
    unfolding k_def separate_state_def rstates_def T_def G_def handle_state_cover_static.simps Let_def
    by simp

  have separate_state_subset : " q T . set T  set (separate_state T q)"
    unfolding separate_state_def combine_after_set 
    by blast

  have " q . q  list.set rstates  set (dist_fun 0 q)  set (after T (V q))"
  proof -
    fix q assume "q  list.set rstates"
    then show "set (dist_fun 0 q)  set (after T (V q))"
      unfolding T_def proof (induction rstates arbitrary: q rule: rev_induct )
      case Nil
      then show ?case by auto
    next
      case (snoc a rstates)
      have *: "foldl separate_state empty (rstates@[a]) = separate_state (foldl separate_state empty rstates) a"
        by auto
      show ?case proof (cases "q = a")
        case True
        show ?thesis 
          unfolding True using separate_state_def combine_after_after_subset by force
      next
        case False
        then have q  list.set rstates using snoc.prems by auto
        then have "set (dist_fun 0 q)  set (after (foldl separate_state empty rstates) (V q))"
          using snoc.IH by auto
        moreover have "set (after (foldl separate_state empty rstates) (V q))  set (after (foldl separate_state empty (rstates@[a])) (V q))"
          unfolding *
          using subset_after_subset[OF separate_state_subset] by blast
        ultimately show ?thesis by blast
      qed
    qed
  qed

  then show ?thesis
    unfolding rstates_def ?T = T using assms
    using reachable_states_as_list_set by auto 
qed



lemma handle_state_cover_static_separates_state_cover: 
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('e,'b,'c) fsm"
  fixes cg_insert :: "('d  ('b×'c) list  'd)"
  assumes "observable M1  minimal M1  ( q1 q2 . q1  states M1  q2  states M1  q1  q2   io .  k1 k2 . io  set (dist_fun k1 q1)  set (dist_fun k2 q2)  distinguishes M1 q1 q2 io)"   
  and     " k q . q  states M1  finite_tree (dist_fun k q)"
shows "separates_state_cover (handle_state_cover_static dist_fun) M1 M2 cg_initial cg_insert cg_lookup"
proof -

  let ?f = "(handle_state_cover_static dist_fun)"

  have " (V :: ('a,'b,'c) state_cover_assignment) .
          (V ` reachable_states M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup)))
             finite_tree (fst (?f M1 V cg_initial cg_insert cg_lookup))
             (observable M1 
                observable M2 
                minimal M1 
                minimal M2 
                inputs M2 = inputs M1 
                outputs M2 = outputs M1 
                is_state_cover_assignment M1 V 
                convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
                convergence_graph_initial_invar M1 M2 cg_lookup cg_initial 
                L M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) = L M2  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) 
                (preserves_divergence M1 M2 (V ` reachable_states M1)
                 convergence_graph_lookup_invar M1 M2 cg_lookup (snd (?f M1 V cg_initial cg_insert cg_lookup))))" (is " V . ?P V")
  proof -
    fix V :: "('a,'b,'c) state_cover_assignment"

    define k where "k = 2 * size M1"
    define separate_state where "separate_state = (λ T q . combine_after T (V q) (dist_fun 0 q))"
    define rstates where "rstates = reachable_states_as_list M1"
    define T where "T = foldl separate_state empty rstates"
    define G where "G = cg_initial M1 T"
    
    have *:"(?f M1 V cg_initial cg_insert cg_lookup) = (T,G)"
      unfolding k_def separate_state_def rstates_def T_def G_def handle_state_cover_static.simps Let_def
      by simp

    have separate_state_subset : " q T . set T  set (separate_state T q)"
      unfolding separate_state_def combine_after_set 
      by blast

    have "V ` (list.set rstates)  set T"
      unfolding T_def proof (induction rstates rule: rev_induct)
      case Nil
      then show ?case by auto
    next
      case (snoc a rstates)
      have *: "foldl separate_state empty (rstates@[a]) = separate_state (foldl separate_state empty rstates) a"
        by auto

      have "V ` (list.set rstates)  set (foldl separate_state empty (rstates@[a]))"
        using snoc separate_state_subset by auto
      moreover have "V a  set (separate_state (foldl separate_state empty rstates) a)"
        unfolding separate_state_def combine_after_set
        by simp 
      ultimately show ?case 
        unfolding * by auto
    qed
    then have p1: "(V ` reachable_states M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup)))"
      unfolding rstates_def *
      using reachable_states_as_list_set by auto 

    have separate_state_finite : " q X T G . q  states M1  finite_tree T  finite_tree (separate_state T q)"
      unfolding separate_state_def using combine_after_finite_tree[OF _ assms(2)]
      by metis
    moreover have " q . q  list.set rstates  q  states M1"
      unfolding rstates_def
      by (metis reachable_state_is_state reachable_states_as_list_set) 
    ultimately have p2: "finite_tree (fst (?f M1 V cg_initial cg_insert cg_lookup))"
      unfolding *  fst_conv T_def using empty_finite_tree
      by (induction rstates rule: rev_induct; auto) 

    have p3: "observable M1 
                observable M2 
                minimal M1 
                minimal M2 
                inputs M2 = inputs M1 
                outputs M2 = outputs M1 
                is_state_cover_assignment M1 V 
                convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
                convergence_graph_initial_invar M1 M2 cg_lookup cg_initial 
                L M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) = L M2  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) 
                (preserves_divergence M1 M2 (V ` reachable_states M1)
                 convergence_graph_lookup_invar M1 M2 cg_lookup (snd (?f M1 V cg_initial cg_insert cg_lookup)))"
    proof -
      assume a0: "observable M1"
         and a1: "observable M2"
         and a2: "minimal M1"
         and a3: "minimal M2"
         and a4: "inputs M2 = inputs M1"
         and a5: "outputs M2 = outputs M1"
         and a6: "is_state_cover_assignment M1 V"
         and a7: "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
         and a8: "convergence_graph_initial_invar M1 M2 cg_lookup cg_initial"
         and a9: "L M1  set (fst (?f M1 V cg_initial cg_insert cg_lookup)) = L M2  set (fst (?f M1 V cg_initial cg_insert cg_lookup))"

      have "L M1  set T = L M2  set T"
        using a9 unfolding * by auto
      then have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (?f M1 V cg_initial cg_insert cg_lookup))"
        using a8 p2
        unfolding * fst_conv snd_conv G_def convergence_graph_initial_invar_def
        by blast 
      moreover have "preserves_divergence M1 M2 (V ` reachable_states M1)"
      proof -
        have " u v . uL M1  V ` reachable_states M1  vL M1  V ` reachable_states M1  ¬ converge M1 u v  ¬ converge M2 u v"
        proof -
          fix u v assume "uL M1  V ` reachable_states M1" and "vL M1  V ` reachable_states M1" and "¬ converge M1 u v"
          then obtain qv qu where "qu  reachable_states M1" and "u = V qu"
                                  "qv  reachable_states M1" and "v = V qv"
            by auto
          then have "u  L M1" and "v  L M1"
            using a6 by (meson is_state_cover_assignment_language)+ 
          then have "qu  qv" 
            using a6 ¬ converge M1 u v
            using u = V qu v = V qv a0 a2 convergence_minimal by blast 
          moreover have "qu  states M1" and "qv  states M1"
            using qu  reachable_states M1 qv  reachable_states M1
            by (simp add: reachable_state_is_state)+
          ultimately obtain w where "distinguishes M1 qu qv w" and "w  set (dist_fun 0 qu)" and "w  set (dist_fun 0 qv)"
            using assms(1)[OF a0 a2]
            by (metis Int_iff) 
          then have "w  []"
            by (meson qu  FSM.states M1 qv  FSM.states M1 distinguishes_not_Nil) 
          
          have "(u@w  L M1)  (v@w  L M1)"
            unfolding u = V qu v = V qv
            using state_cover_assignment_after[OF a0 a6 qu  reachable_states M1]
            using state_cover_assignment_after[OF a0 a6 qv  reachable_states M1]
            by (metis distinguishes M1 qu qv w a0 after_distinguishes_language)
          moreover have "u@w  set T" 
            using handle_state_cover_static_applies_dist_sets[OF qu  reachable_states M1, of dist_fun V cg_initial cg_insert cg_lookup] w  set (dist_fun 0 qu) w  []
            unfolding * fst_conv after_set u = V qu by auto
          moreover have "v@w  set T" 
            using handle_state_cover_static_applies_dist_sets[OF qv  reachable_states M1, of dist_fun V cg_initial cg_insert cg_lookup] w  set (dist_fun 0 qv) w  []
            unfolding * fst_conv after_set v = V qv by auto
          ultimately have "(u@w  L M2)  (v@w  L M2)"
            using L M1  set T = L M2  set T
            by blast 
          then show "¬ converge M2 u v"
            using a1 converge_append_language_iff by blast            
        qed
        then show ?thesis
          unfolding preserves_divergence.simps by blast
      qed
      ultimately show ?thesis
        by blast
    qed

    show "?P V"
      using p1 p2 p3 by blast
  qed

  then show ?thesis 
    unfolding separates_state_cover_def by blast
qed




subsection ‹Establishing Convergence of Traces›

subsubsection ‹Dynamic›

fun distinguish_from_set :: "('a::linorder,'b::linorder,'c::linorder) fsm  ('a,'b,'c) state_cover_assignment  ('b×'c) prefix_tree  'd  ('d  ('b×'c) list  ('b×'c) list list)  ('d  ('b×'c) list  'd)  ('a  'a  ('b×'c) list)  ('b×'c) list  ('b×'c) list  ('b×'c) list list  nat  nat  bool  (('b×'c) prefix_tree  ('b×'c) list  (('b×'c) list × int)  ('b×'c) list  (('b×'c) list × int))  bool  (('b×'c) prefix_tree × 'd)" where
  "distinguish_from_set M V T G cg_lookup cg_insert get_distinguishing_trace u v X k depth completeInputTraces append_heuristic u_is_v= 
    (let TG' = spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic;
         vClass = Set.insert v (list.set (cg_lookup (snd TG') v));
         notReferenced = (¬ u_is_v)  ( q  reachable_states M . V q  vClass);
         TG'' = (if notReferenced then spyh_distinguish M (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic
                                  else TG')
      in if depth > 0
        then let X' = if notReferenced then (v#u#X) else (u#X);
                 XY = List.product (inputs_as_list M) (outputs_as_list M);
                 handleIO = (λ (T,G) (x,y) . (let TGu = distribute_extension M T G cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic;
                                                 TGv = if u_is_v then TGu else distribute_extension M (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic
                                             in if is_in_language M (initial M) (u@[(x,y)])
                                                  then distinguish_from_set M V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u@[(x,y)]) (v@[(x,y)]) X' k (depth - 1) completeInputTraces append_heuristic u_is_v
                                                  else TGv))
            in foldl handleIO TG'' XY
        else TG'')"

lemma distinguish_from_set_subset :
  "set T  set (fst (distinguish_from_set M V T G cg_lookup cg_insert get_distinguishing_trace u v X k depth completeInputTraces append_heuristic u_is_v))"
proof (induction depth arbitrary: T G u v X)
  case 0

  define TG' where TG': "TG' = spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic "
  define vClass where vClass: "vClass = Set.insert v (list.set (cg_lookup (snd TG') v))"
  define notReferenced where notReferenced: "notReferenced = ((¬ u_is_v)  ( q  reachable_states M . V q  vClass))"
  define TG'' where TG'': "TG'' = (if notReferenced then spyh_distinguish M (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic else TG')"

  have "distinguish_from_set M V T G cg_lookup cg_insert get_distinguishing_trace u v X k 0 completeInputTraces append_heuristic u_is_v = TG''"
    apply (subst distinguish_from_set.simps)
    unfolding TG' vClass notReferenced TG'' Let_def 
    by force
  moreover have "set T  set (fst (TG'))"
    unfolding TG'
    using spyh_distinguish_subset
    by metis
  moreover have "set (fst (TG'))  set (fst (TG''))"
    unfolding TG'' 
    using spyh_distinguish_subset
    by (metis (mono_tags, lifting) equalityE)
  ultimately show ?case 
    by blast
next
  case (Suc depth)

  have "(Suc depth - 1) = depth"
    by auto

  define TG' where TG': "TG' = spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic"
  define vClass where vClass: "vClass = Set.insert v (list.set (cg_lookup (snd TG') v))"
  define notReferenced where notReferenced: "notReferenced = ((¬ u_is_v)  ( q  reachable_states M . V q  vClass))"
  define TG'' where TG'': "TG'' = (if notReferenced then spyh_distinguish M (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic else TG')"
  define X' where X': "X' = (if notReferenced then (v#u#X) else (u#X))"
  define XY where XY: "XY = List.product (inputs_as_list M) (outputs_as_list M)"
  define handleIO where handleIO: "handleIO = (λ (T,G) (x,y) . (let TGu = distribute_extension M T G cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic;
                                                 TGv = if u_is_v then TGu else distribute_extension M (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic
                                             in if is_in_language M (initial M) (u@[(x,y)])
                                                  then distinguish_from_set M V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u@[(x,y)]) (v@[(x,y)]) X' k (depth) completeInputTraces append_heuristic u_is_v
                                                  else TGv))"

  

  have " x y T G . set T  set (fst (handleIO (T,G) (x,y)))"
  proof -
    fix x y T G 

    define TGu where TGu: "TGu = distribute_extension M T G cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic"
    define TGv where TGv: "TGv = (if u_is_v then TGu else distribute_extension M (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic)"
    have *: "handleIO (T,G) (x,y) = (if is_in_language M (initial M) (u@[(x,y)])
                                                  then distinguish_from_set M V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u@[(x,y)]) (v@[(x,y)]) X' k (depth) completeInputTraces append_heuristic u_is_v
                                                  else TGv)"
      unfolding handleIO TGu TGv case_prod_conv Let_def 
      by auto
    
    have "set T  set (fst TGu)"
      unfolding TGu
      using distribute_extension_subset
      by metis
    moreover have "set (fst TGu)  set (fst TGv)"
      unfolding TGv 
      using distribute_extension_subset by force
    ultimately have "set T  set (fst TGv)"
      by blast
      
    show "set T  set (fst (handleIO (T,G) (x,y)))"
      unfolding *
      using set T  set (fst TGv)
      using Suc.IH[of "fst TGv" "snd TGv" "u@[(x,y)]" "v@[(x,y)]" X'] 
      by (cases "is_in_language M (initial M) (u@[(x,y)])"; auto)
  qed
  
  have "set (fst TG'')  set (fst (foldl handleIO TG'' XY))"
  proof (induction XY rule: rev_induct)
    case Nil
    then show ?case by auto
  next
    case (snoc a XY)
    obtain x y where "a = (x,y)"
      using prod.exhaust by metis
    then have *: "(foldl handleIO TG'' (XY@[a])) = handleIO (fst (foldl handleIO TG'' XY),snd (foldl handleIO TG'' XY)) (x,y) "
      by auto

    show ?case 
      using snoc unfolding * 
      using  x y T G . set T  set (fst (handleIO (T,G) (x,y)))
      by blast       
  qed
  moreover have "set T  set (fst TG'')"
  proof -
    have "set T  set (fst TG')"
      unfolding TG'
      using spyh_distinguish_subset
      by metis
    moreover have "set (fst TG')  set (fst TG'')"
      unfolding TG''
      using spyh_distinguish_subset
      by (metis (mono_tags, lifting) order_refl)
    ultimately show ?thesis
      by blast
  qed
  moreover have "distinguish_from_set M V T G cg_lookup cg_insert get_distinguishing_trace u v X k (Suc depth) completeInputTraces append_heuristic u_is_v = foldl handleIO TG'' XY"
    apply (subst distinguish_from_set.simps)
    unfolding TG' vClass notReferenced TG'' Let_def X' XY handleIO 
    unfolding (Suc depth - 1) = depth 
    by force

  ultimately show ?case
    by (metis (no_types, lifting) order_trans) 
qed


lemma distinguish_from_set_finite :
  fixes T :: "('b::linorder×'c::linorder) prefix_tree "
  assumes "finite_tree T"
  shows "finite_tree (fst (distinguish_from_set M V T G cg_lookup cg_insert get_distinguishing_trace u v X k depth completeInputTraces append_heuristic u_is_v))"
using assms proof (induction depth arbitrary: T G u v X)
  case 0

  define TG' where TG': "TG' = spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic"
  define vClass where vClass: "vClass = Set.insert v (list.set (cg_lookup (snd TG') v))"
  define notReferenced where notReferenced: "notReferenced = ((¬ u_is_v)  ( q  reachable_states M . V q  vClass))"
  define TG'' where TG'': "TG'' = (if notReferenced then spyh_distinguish M (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic else TG')"

  have "finite_tree (fst (TG'))"
    unfolding TG'
    using spyh_distinguish_finite 0
    by metis
  then have "finite_tree (fst (TG''))"
    unfolding TG'' 
    using spyh_distinguish_finite[OF finite_tree (fst (TG')), of M "snd TG'" ] 
    by auto
  moreover have "distinguish_from_set M V T G cg_lookup cg_insert get_distinguishing_trace u v X k 0 completeInputTraces append_heuristic u_is_v= TG''"
    apply (subst distinguish_from_set.simps)
    unfolding TG' vClass notReferenced TG'' Let_def 
    by force
  ultimately show ?case 
    by blast
next
  case (Suc depth)

  have "(Suc depth - 1) = depth"
    by auto

  define TG' where TG': "TG' = spyh_distinguish M T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic"
  define vClass where vClass: "vClass = Set.insert v (list.set (cg_lookup (snd TG') v))"
  define notReferenced where notReferenced: "notReferenced = ((¬ u_is_v)  ( q  reachable_states M . V q  vClass))"
  define TG'' where TG'': "TG'' = (if notReferenced then spyh_distinguish M (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic else TG')"
  define X' where X': "X' = (if notReferenced then (v#u#X) else (u#X))"
  define XY where XY: "XY = List.product (inputs_as_list M) (outputs_as_list M)"
  define handleIO where handleIO: "handleIO = (λ (T,G) (x,y) . (let TGu = distribute_extension M T G cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic;
                                                 TGv = if u_is_v then TGu else distribute_extension M (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic
                                             in if is_in_language M (initial M) (u@[(x,y)])
                                                  then distinguish_from_set M V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u@[(x,y)]) (v@[(x,y)]) X' k (depth) completeInputTraces append_heuristic u_is_v
                                                  else TGv))"

  

  have " x y T G . finite_tree T  finite_tree (fst (handleIO (T,G) (x,y)))"
  proof -
    fix T :: "('b::linorder×'c::linorder) prefix_tree "
    fix x y G assume "finite_tree T"

    define TGu where TGu: "TGu = distribute_extension M T G cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic"
    define TGv where TGv: "TGv = (if u_is_v then TGu else distribute_extension M (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic)"
    have *: "handleIO (T,G) (x,y) = (if is_in_language M (initial M) (u@[(x,y)])
                                                  then distinguish_from_set M V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u@[(x,y)]) (v@[(x,y)]) X' k (depth) completeInputTraces append_heuristic u_is_v
                                                  else TGv)"
      unfolding handleIO TGu TGv case_prod_conv Let_def 
      by auto
    
    have "finite_tree (fst TGu)"
      unfolding TGu
      using distribute_extension_finite finite_tree T
      by metis
    then have "finite_tree (fst TGv)"
      unfolding TGv 
      using distribute_extension_finite by force      
    then show "finite_tree (fst (handleIO (T,G) (x,y)))"
      unfolding *
      using Suc.IH[of "fst TGv" "snd TGv" "u@[(x,y)]" "v@[(x,y)]" X'] 
      by (cases "is_in_language M (initial M) (u@[(x,y)])"; auto)
  qed

  have "finite_tree (fst TG')"
    unfolding TG'
    using spyh_distinguish_finite finite_tree T
    by metis
  then have "finite_tree (fst TG'')"
    unfolding TG'' 
    using spyh_distinguish_finite[OF finite_tree (fst (TG')), of M "snd TG'" ] 
    by auto
    
  
  have "finite_tree (fst (foldl handleIO TG'' XY))"
  proof (induction XY rule: rev_induct)
    case Nil
    then show ?case using finite_tree (fst TG'') by auto
  next
    case (snoc a XY)
    obtain x y where "a = (x,y)"
      using prod.exhaust by metis
    then have *: "(foldl handleIO TG'' (XY@[a])) = handleIO (fst (foldl handleIO TG'' XY),snd (foldl handleIO TG'' XY)) (x,y)"
      by auto

    show ?case 
      using snoc unfolding * 
      using  x y T G . finite_tree T  finite_tree (fst (handleIO (T,G) (x,y)))
      by blast       
  qed
  moreover have "distinguish_from_set M V T G cg_lookup cg_insert get_distinguishing_trace u v X k (Suc depth) completeInputTraces append_heuristic u_is_v = foldl handleIO TG'' XY"
    apply (subst distinguish_from_set.simps)
    unfolding TG' vClass notReferenced TG'' Let_def X' XY handleIO 
    unfolding (Suc depth - 1) = depth 
    by force

  ultimately show ?case
    by (metis (no_types, lifting)) 
qed


lemma distinguish_from_set_properties :
  assumes "observable M1"
      and "observable M2"
      and "minimal M1"
      and "minimal M2"
      and "inputs M2 = inputs M1"
      and "outputs M2 = outputs M1"
      and "is_state_cover_assignment M1 V"
      and "V ` reachable_states M1  list.set X"
      and "preserves_divergence M1 M2 (list.set X)"
      and " w . w  list.set X   w' . converge M1 w w'  converge M2 w w'"
      and "converge M1 u v"
      and "u  L M2"
      and "v  L M2"
      and "convergence_graph_lookup_invar M1 M2 cg_lookup G"
      and "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
      and " α β q1 q2 . q1  states M1  q2  states M1  q1  q2  distinguishes M1 q1 q2 (get_distinguishing_trace q1 q2)"
      and "L M1  set (fst (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k depth completeInputTraces append_heuristic (u = v))) = L M2  set (fst (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k depth completeInputTraces append_heuristic (u = v)))"
      and " T w u' uBest lBest . fst (append_heuristic T w (uBest,lBest) u')  {u',uBest}"
shows " γ x y . length (γ@[(x,y)])  depth 
                  γ  LS M1 (after_initial M1 u) 
                  x  inputs M1  y  outputs M1 
                  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes (γ@[(x,y)]))}) = L M2   (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes (γ@[(x,y)]))})
                   preserves_divergence M1 M2 (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes (γ@[(x,y)]))})"
(is "?P1a X u v depth")
and     "preserves_divergence M1 M2 (list.set X  {u,v})"
(is "?P1b X u v")
and   "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k depth completeInputTraces append_heuristic (u = v)))"
(is "?P2 T G u v X depth")
proof -
  have "?P1a X u v depth  ?P1b X u v  ?P2 T G u v X depth"
    using assms(8-14) assms(17)
  proof (induction depth arbitrary: T G u v X)
    case 0

    define TG' where TG': "TG' = spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic"
    define vClass where vClass: "vClass = Set.insert v (list.set (cg_lookup (snd TG') v))"
    define notReferenced where notReferenced: "notReferenced = ((¬ (u = v))  ( q  reachable_states M1 . V q  vClass))"
    define TG'' where TG'': "TG'' = (if notReferenced then spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic else TG')"
  
    have "distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k 0 completeInputTraces append_heuristic (u = v) = TG''"
      apply (subst distinguish_from_set.simps)
      unfolding TG' vClass notReferenced TG'' Let_def 
      by force

    have "set T  set (fst (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k 0 completeInputTraces append_heuristic (u = v)))"
      using distinguish_from_set_subset by metis
    then have "L M1  set T = L M2  set T"
      using  "0.prems"(8) 
      by blast

    have "list.set X  L M1" and "list.set X  L M2"
      using "0.prems"(3)
      by (meson converge.elims(2) subsetI)+
    have "set (fst TG')  set (fst (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k 0 completeInputTraces append_heuristic (u = v)))"
      by (metis TG'' distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k 0 completeInputTraces append_heuristic (u = v) = TG'' order_refl spyh_distinguish_subset)      
    then have *: "L M1  Prefix_Tree.set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic)) =
                    L M2  Prefix_Tree.set (fst (spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic))"
      using "0.prems"(8) unfolding TG' 
      by blast
    have "u  L M1" and "v  L M1"
      using converge M1 u v by auto

    have "preserves_divergence M1 M2 (Set.insert u (list.set X))"
      using spyh_distinguish_preserves_divergence[OF assms(1-4) u  L M1 u  L M2 assms(16) "0.prems"(7) assms(15) list.set X  L M1 list.set X  L M2 * assms(18) "0.prems"(2)] 
      unfolding TG' by presburger

    have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG')"
      unfolding TG'
      using spyh_distinguish_establishes_divergence[OF assms(1-4) u  L M1 u  L M2 assms(16) "0.prems"(7) assms(15) list.set X  L M1 list.set X  L M2 * assms(18)] 
      by linarith

    have "L M1  set (fst TG'') = L M2  set (fst TG'')"
      using "0.prems"(8)
      unfolding distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k 0 completeInputTraces append_heuristic (u = v) = TG''
      by blast

    have "preserves_divergence M1 M2 (Set.insert v (list.set X))"
    and  "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG'')"
    proof -
      have "preserves_divergence M1 M2 (Set.insert v (list.set X))  convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG'')"
      proof (cases "notReferenced")
        case True

        then have "TG'' = spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic"
          unfolding TG'' by auto
        then have *: "L M1  Prefix_Tree.set (fst (spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic)) =
                    L M2  Prefix_Tree.set (fst (spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic))"
          using L M1  set (fst TG'') = L M2  set (fst TG'')
          by simp

        show ?thesis 
          using spyh_distinguish_preserves_divergence[OF assms(1-4) v  L M1 v  L M2 assms(16) convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') assms(15) list.set X  L M1 list.set X  L M2 * assms(18) "0.prems"(2)]
          using spyh_distinguish_establishes_divergence(2)[OF assms(1-4) v  L M1 v  L M2 assms(16) convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') assms(15) list.set X  L M1 list.set X  L M2 * assms(18)] 
          unfolding TG'' = spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic
          by presburger
      next
        case False
        then consider "u = v" | "(u  v)  ¬( q  reachable_states M1 . V q  vClass)"
          unfolding notReferenced by blast
        then show ?thesis proof cases
          case 1 
          then show ?thesis
            using False TG'' convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') preserves_divergence M1 M2 (Set.insert u (list.set X)) by presburger 
        next
          case 2          
          then have "TG'' = TG'"
            unfolding TG'' using False  by auto
  
          obtain q where "q  reachable_states M1"
                     and "V q  Set.insert v (list.set (cg_lookup (snd TG') v))"
            using 2 
            unfolding notReferenced vClass
            by blast
  
          have "converge M1 (V q) v" and "converge M2 (V q) v"
          proof -
            have "converge M1 v (V q)  converge M2 v (V q)"
            proof (cases "V q = v")
              case True
              then show ?thesis 
                using v  L M1 v  L M2 by auto
            next
              case False
              then have "V q  list.set (cg_lookup (snd TG') v)"
                using V q  Set.insert v (list.set (cg_lookup (snd TG') v)) 
                by blast
              then show ?thesis 
                using convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') 
                unfolding convergence_graph_lookup_invar_def
                using "0.prems"(6) v  L M1 by blast
            qed
            then show "converge M1 (V q) v" and "converge M2 (V q) v"
              by auto
          qed
  
          have "V q  Set.insert u (list.set X)"
            using q  reachable_states M1 "0.prems"(1) by blast 
            
          have "preserves_divergence M1 M2 (Set.insert v (list.set X))"
            using preserves_divergence_converge_insert[OF assms(1-4) converge M1 (V q) v converge M2 (V q) v preserves_divergence M1 M2 (Set.insert u (list.set X)) V q  Set.insert u (list.set X)]
            unfolding preserves_divergence.simps by blast
          then show ?thesis 
            unfolding TG'' = TG'
            using convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG')
            by auto
        qed
      qed
      then show "preserves_divergence M1 M2 (Set.insert v (list.set X))" and  "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG'')"
        by auto
    qed

    have "converge M1 u u" and "converge M1 v v" and "converge M1 v u" and "converge M1 u v"
      using u  L M1 v  L M1 converge M1 u v by auto
    then have "preserves_divergence M1 M2 (Set.insert u (Set.insert v (list.set X)))"
      using preserves_divergence M1 M2 (Set.insert v (list.set X))
            preserves_divergence M1 M2 (Set.insert u (list.set X))
      unfolding preserves_divergence.simps 
      by blast 
    then have "?P1b X u v"
      by (metis Un_insert_right sup_bot_right) 
    moreover have "?P2 T G u v X 0"  
      using convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG'')
      using distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k 0 completeInputTraces append_heuristic (u = v) = TG'' by blast
    moreover have P1: "?P1a X u v 0"
      by auto
    ultimately show ?case 
      by blast
  next
    case (Suc depth)
    have "0 < Suc depth = True"
      by auto
    have "Suc depth - 1 = depth"
      by auto

    have "u  L M1" and "v  L M1"
      using converge M1 u v by auto

    define TG' where TG': "TG' = spyh_distinguish M1 T G cg_lookup cg_insert get_distinguishing_trace u X k completeInputTraces append_heuristic"
    define vClass where vClass: "vClass = Set.insert v (list.set (cg_lookup (snd TG') v))"
    define notReferenced where notReferenced: "notReferenced = (¬(u = v)  ( q  reachable_states M1 . V q  vClass))"
    define TG'' where TG'': "TG'' = (if notReferenced then spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic else TG')"
    define X' where X': "X' = (if notReferenced then (v#u#X) else (u#X))"
    define XY where XY: "XY = List.product (inputs_as_list M1) (outputs_as_list M1)"
    define handleIO where handleIO: "handleIO = (λ (T,G) (x,y). (let TGu = distribute_extension M1 T G cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic;
                                                 TGv = if (u = v) then TGu else distribute_extension M1 (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic
                                             in if is_in_language M1 (initial M1) (u@[(x,y)])
                                                  then distinguish_from_set M1 V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u@[(x,y)]) (v@[(x,y)]) X' k depth completeInputTraces append_heuristic (u = v) 
                                                  else TGv))"
    
    have result: "distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v X k (Suc depth) completeInputTraces append_heuristic (u = v) = foldl handleIO TG'' XY"
      apply (subst distinguish_from_set.simps)
      unfolding TG' vClass notReferenced TG'' X' XY handleIO 0 < Suc depth = True case_prod_conv Suc depth - 1 = depth if_True Let_def 
      by force
    then have pass_result: "L M1  set (fst (foldl handleIO TG'' XY)) = L M2  set (fst (foldl handleIO TG'' XY))"
      using Suc.prems(8)
      by metis 

    have handleIO_subset : " x y T G . set T  set (fst (handleIO (T,G) (x,y)))"
    proof -
      fix x y T G 

      define TGu where TGu: "TGu = distribute_extension M1 T G cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic"
      define TGv where TGv: "TGv = (if (u = v) then TGu else distribute_extension M1 (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic)" 

      have handleIO: "handleIO (T,G) (x,y) = (if is_in_language M1 (initial M1) (u@[(x,y)])
                                                  then distinguish_from_set M1 V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u@[(x,y)]) (v@[(x,y)]) X' k depth completeInputTraces append_heuristic (u = v) 
                                                  else TGv)"
        unfolding handleIO TGu TGv case_prod_conv Let_def 
        by force

      have "set T  set (fst TGu)"
        using distribute_extension_subset[of T]
        unfolding TGu by metis
      moreover have "set (fst TGu)  set (fst TGv)"
        using distribute_extension_subset[of "fst TGu"]
        unfolding TGv by force
      moreover have "set (fst TGv)  set (fst (handleIO (T,G) (x,y)))"
        unfolding handleIO 
        using distinguish_from_set_subset[of "fst TGv" M1 V "snd TGv" cg_lookup cg_insert get_distinguishing_trace "u@[(x,y)]" "v@[(x,y)]" X' k depth] 
        by auto
      ultimately show "set T  set (fst (handleIO (T,G) (x,y)))"
        by blast
    qed
    
    have result_subset: "set (fst TG'')  set (fst (foldl handleIO TG'' XY))"
    proof (induction XY rule: rev_induct)
      case Nil
      then show ?case by auto
    next
      case (snoc x xs)
      then show ?case 
        using handleIO_subset[of "fst (foldl handleIO TG'' xs)" "snd (foldl handleIO TG'' xs)" "fst x" "snd x"]
        by force
    qed 
    then have pass_TG'' : "L M1  set (fst TG'') = L M2  set (fst TG'')"
      using pass_result by blast

    
    have "set (fst TG')  set (fst TG'')"
      unfolding TG'' using spyh_distinguish_subset
      by (metis (mono_tags, lifting) equalityE) 
    then have pass_TG': "L M1  set (fst TG') = L M2  set (fst TG')"
      using pass_TG'' by blast

    have "set T  set (fst TG')"
      unfolding TG' using spyh_distinguish_subset by metis
    then have pass_T: "L M1  set T = L M2  set T"
      using pass_TG' by blast

    have "list.set X  L M1" and "list.set X  L M2"
      using Suc.prems(3) by auto 
    

    have "preserves_divergence M1 M2 (Set.insert u (list.set X))"
    and  "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG')"
      using spyh_distinguish_preserves_divergence[OF assms(1-4) u  L M1 u  L M2 assms(16) Suc.prems(7) assms(15) list.set X  L M1 list.set X  L M2 _ _Suc.prems(2), of T k completeInputTraces append_heuristic, OF _ _ _ _ assms(18)] 
            spyh_distinguish_establishes_divergence(2)[OF assms(1-4) u  L M1 u  L M2 assms(16) Suc.prems(7) assms(15) list.set X  L M1 list.set X  L M2, of T k completeInputTraces append_heuristic, OF _ _ _ _ assms(18)]
            pass_TG'
      unfolding TG'[symmetric]
      by linarith+

    have "preserves_divergence M1 M2 (Set.insert v (list.set X))"
    and  "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG'')"
    proof -
      have "preserves_divergence M1 M2 (Set.insert v (list.set X))  convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG'')"
      proof (cases "notReferenced")
        case True

        then have "TG'' = spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic"
          unfolding TG'' by auto
        then have *: "L M1  Prefix_Tree.set (fst (spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic)) =
                    L M2  Prefix_Tree.set (fst (spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic))"
          using L M1  set (fst TG'') = L M2  set (fst TG'')
          by simp

        show ?thesis 
          using spyh_distinguish_preserves_divergence[OF assms(1-4) v  L M1 v  L M2 assms(16) convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') assms(15) list.set X  L M1 list.set X  L M2 * assms(18) Suc.prems(2)]
                spyh_distinguish_establishes_divergence(2)[OF assms(1-4) v  L M1 v  L M2 assms(16) convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') assms(15) list.set X  L M1 list.set X  L M2 * assms(18)]
          unfolding TG'' = spyh_distinguish M1 (fst TG') (snd TG') cg_lookup cg_insert get_distinguishing_trace v X k completeInputTraces append_heuristic
          by presburger
      next
        case False
        then consider "u = v" | "(u  v)  ¬( q  reachable_states M1 . V q  vClass)"
          unfolding notReferenced by blast
        then show ?thesis proof cases
          case 1 
          then show ?thesis
            using False TG'' convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') preserves_divergence M1 M2 (Set.insert u (list.set X)) by presburger 
        next
          case 2          
          then have "TG'' = TG'"
            unfolding TG'' using False  by auto
        
        

          obtain q where "q  reachable_states M1"
                     and "V q  Set.insert v (list.set (cg_lookup (snd TG') v))"
            using 2 
            unfolding notReferenced vClass
            by blast
  
          have "converge M1 (V q) v" and "converge M2 (V q) v"
          proof -
            have "converge M1 v (V q)  converge M2 v (V q)"
            proof (cases "V q = v")
              case True
              then show ?thesis 
                using v  L M1 v  L M2 by auto
            next
              case False
              then have "V q  list.set (cg_lookup (snd TG') v)"
                using V q  Set.insert v (list.set (cg_lookup (snd TG') v)) 
                by blast
              then show ?thesis 
                using convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') 
                unfolding convergence_graph_lookup_invar_def
                using Suc.prems(6) v  L M1 by blast
            qed
            then show "converge M1 (V q) v" and "converge M2 (V q) v"
              by auto
          qed
  
          have "V q  Set.insert u (list.set X)"
            using q  reachable_states M1 Suc.prems(1) by blast 
            
          have "preserves_divergence M1 M2 (Set.insert v (list.set X))"
            using preserves_divergence_converge_insert[OF assms(1-4) converge M1 (V q) v converge M2 (V q) v preserves_divergence M1 M2 (Set.insert u (list.set X)) V q  Set.insert u (list.set X)]
            unfolding preserves_divergence.simps by blast
          then show ?thesis 
            unfolding TG'' = TG'
            using convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG')
            by auto
        qed
      qed
      then show "preserves_divergence M1 M2 (Set.insert v (list.set X))" and  "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG'')"
        by auto
    qed

    have "converge M1 u u" and "converge M1 v v" and "converge M1 v u" and "converge M1 u v"
      using u  L M1 v  L M1 converge M1 u v by auto
    then have "preserves_divergence M1 M2 (Set.insert u (Set.insert v (list.set X)))"
      using preserves_divergence M1 M2 (Set.insert v (list.set X))
            preserves_divergence M1 M2 (Set.insert u (list.set X))
      unfolding preserves_divergence.simps 
      by blast 


    have IS1: "V ` reachable_states M1  list.set X'"
      using Suc.prems(1) unfolding X' by auto

    have IS2: "preserves_divergence M1 M2 (list.set X')"
      using preserves_divergence M1 M2 (Set.insert u (Set.insert v (list.set X)))
            preserves_divergence M1 M2 (Set.insert u (list.set X))
      unfolding X'
      by (simp add: insert_commute) 
    
    have handleIO_props : " x y T' G' . set T  set T'  convergence_graph_lookup_invar M1 M2 cg_lookup G'  L M1  set (fst (handleIO (T',G') (x,y))) = L M2  set (fst (handleIO (T',G') (x,y))) 
                                          x  inputs M1  y  outputs M1  
                                          convergence_graph_lookup_invar M1 M2 cg_lookup (snd (handleIO (T',G') (x,y)))
                                           L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])}) = L M2  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})
                                           preserves_divergence M1 M2 (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})
                                           ( γ x' y' . length ((x,y)#γ@[(x',y')])  Suc depth 
                                                      ((x,y)#γ)  LS M1 (after_initial M1 u) 
                                                      x'  inputs M1  y'  outputs M1 
                                                      L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes ((x,y)#γ@[(x',y')]))}) = L M2  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes ((x,y)#γ@[(x',y')]))})
                                                       preserves_divergence M1 M2 (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes ((x,y)#γ@[(x',y')]))}))"
    proof -
      fix x y T' G' 

      assume "convergence_graph_lookup_invar M1 M2 cg_lookup G'" 
         and "L M1  set (fst (handleIO (T',G') (x,y))) = L M2  set (fst (handleIO (T',G') (x,y)))"
         and "x  inputs M1"
         and "y  outputs M1"
         and "set T  set T'"

      define TGu where TGu: "TGu = distribute_extension M1 T' G' cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic"
      define TGv where TGv: "TGv = (if (u=v) then TGu else distribute_extension M1 (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic)"

      have handleIO: "handleIO (T',G') (x,y) = (if is_in_language M1 (initial M1) (u@[(x,y)])
                                                  then distinguish_from_set M1 V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u@[(x,y)]) (v@[(x,y)]) X' k depth completeInputTraces append_heuristic (u=v)
                                                  else TGv)"
        unfolding handleIO TGu TGv case_prod_conv Let_def 
        by force

      have "set T'  set (fst TGu)"
        using distribute_extension_subset[of T']
        unfolding TGu by metis
      have "set (fst TGu)  set (fst TGv)"
        using distribute_extension_subset[of "fst TGu"]
        unfolding TGv by force
      have "set (fst TGv)  set (fst (handleIO (T',G') (x,y)))"
        unfolding handleIO 
        using distinguish_from_set_subset[of "fst TGv" M1 V "snd TGv" cg_lookup cg_insert get_distinguishing_trace "u@[(x,y)]" "v@[(x,y)]" X' k depth] 
        by auto
      then have pass_TGv: "L M1  set (fst TGv) = L M2  set (fst TGv)"
        using L M1  set (fst (handleIO (T',G') (x,y))) = L M2  set (fst (handleIO (T',G') (x,y))) set (fst TGv)  set (fst (handleIO (T',G') (x,y)))
        by blast

      have *:"L M1  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic)) = L M2  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert u [(x,y)] completeInputTraces append_heuristic))"
        using L M1  set (fst (handleIO (T',G') (x,y))) = L M2  set (fst (handleIO (T',G') (x,y))) set (fst TGv)  set (fst (handleIO (T',G') (x,y))) set (fst TGu)  set (fst TGv)
        unfolding TGu
        by blast

      obtain u' where "converge M1 u u'"  
                      "u' @ [(x, y)]  set (fst TGv)"
                      "converge M2 u u'"
                      "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TGu)"
        using distribute_extension_adds_sequence[OF assms(1,3) u  L M1 u  L M2 convergence_graph_lookup_invar M1 M2 cg_lookup G' assms(15) * assms(18)]
        using set (fst TGu)  set (fst TGv)
        unfolding TGu by blast

      have "u'  set (fst TGv)"
        using u' @ [(x, y)]  set (fst TGv) set_prefix by metis
      have "u'  L M1"
        using converge M1 u u' by auto

      have *:"¬(u=v)  L M1  set (fst (distribute_extension M1 (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic)) = L M2  set (fst (distribute_extension M1 (fst TGu) (snd TGu) cg_lookup cg_insert v [(x,y)] completeInputTraces append_heuristic))"
        using L M1  set (fst (handleIO (T',G') (x,y))) = L M2  set (fst (handleIO (T',G') (x,y))) set (fst TGv)  set (fst (handleIO (T',G') (x,y)))
        using TGv pass_TGv by presburger 

      obtain v' where "converge M1 v v'"  
                      "v' @ [(x, y)]  set (fst TGv)"
                      "converge M2 v v'"
                      "convergence_graph_lookup_invar M1 M2 cg_lookup (snd TGv)"
                      "u=v  u' = v'"
      proof (cases "u=v")
        case True
        then have "TGv = TGu" unfolding TGv by auto
        show ?thesis 
          using that
          using converge M1 u u' u' @ [(x, y)]  set (fst TGv) converge M2 u u' convergence_graph_lookup_invar M1 M2 cg_lookup (snd TGu)
          unfolding True TGv = TGu by blast
      next
        case False
        then show ?thesis 
          using that
          using distribute_extension_adds_sequence[OF assms(1,3) v  L M1 v  L M2 convergence_graph_lookup_invar M1 M2 cg_lookup (snd TGu) assms(15) *[OF False] assms(18)]
          unfolding TGv by auto
      qed
        

      have "v'  set (fst TGv)"
        using v' @ [(x, y)]  set (fst TGv) set_prefix by metis
      have "v'  L M1"
        using converge M1 v v' by auto

      have *: "{ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])} = {u,v,u@[(x,y)],v@[(x,y)]}"
        by auto

      have "u  L M1 = (u  L M2)"
        using Suc.prems(5) u  L M1 by auto
      moreover have "v  L M1 = (v  L M2)"
        using Suc.prems(6) v  L M1 by auto
      moreover have "u @ [(x, y)]  L M1 = (u @ [(x, y)]  L M2)"
      proof -
        have "u @ [(x, y)]  L M1 = (u' @ [(x, y)]  L M1)"
          using converge M1 u u' assms(1) converge_append_language_iff by blast
        also have " = (u' @ [(x, y)]  L M2)"
          using pass_TGv u' @ [(x, y)]  set (fst TGv) by blast
        also have " = (u @ [(x, y)]  L M2)"
          using converge M2 u u' assms(2) converge_append_language_iff by blast 
        finally show ?thesis .
      qed
      moreover have "v @ [(x, y)]  L M1 = (v @ [(x, y)]  L M2)"
      proof -
        have "v @ [(x, y)]  L M1 = (v' @ [(x, y)]  L M1)"
          using converge M1 v v' assms(1) converge_append_language_iff by blast
        also have " = (v' @ [(x, y)]  L M2)"
          using pass_TGv v' @ [(x, y)]  set (fst TGv) by blast
        also have " = (v @ [(x, y)]  L M2)"
          using converge M2 v v' assms(2) converge_append_language_iff by blast 
        finally show ?thesis .
      qed
      moreover have "L M1  list.set X = (L M2  list.set X)"
        using Suc.prems(3)
        by fastforce
      ultimately have p2: "L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])}) = L M2  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})"
        unfolding * by blast


      show "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (handleIO (T',G') (x,y)))
                                           L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])}) = L M2  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})
                                           preserves_divergence M1 M2 (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})
                                           ( γ x' y' . length ((x,y)#γ@[(x',y')])  Suc depth 
                                                      ((x,y)#γ)  LS M1 (after_initial M1 u) 
                                                      x'  inputs M1  y'  outputs M1 
                                                      L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes ((x,y)#γ@[(x',y')]))}) = L M2  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes ((x,y)#γ@[(x',y')]))})
                                                       preserves_divergence M1 M2 (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes ((x,y)#γ@[(x',y')]))}))"
      proof (cases "is_in_language M1 (initial M1) (u@[(x,y)])")
        case False

        
        have "u@[(x,y)]  L M1"
          using False by (meson assms(1) fsm_initial is_in_language_iff)
        moreover have "v@[(x,y)]  L M1"
          using calculation Suc.prems(4) assms(1) converge_append_language_iff by blast
        moreover have "preserves_divergence M1 M2 (list.set X  {u,v})"
          by (metis (no_types) Un_insert_right preserves_divergence M1 M2 (Set.insert u (Set.insert v (list.set X))) sup_bot_right)
        ultimately have p3: "preserves_divergence M1 M2 (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})"
          unfolding * preserves_divergence.simps
          by blast 
          
        have handleIO: "(handleIO (T',G') (x,y)) = TGv"
          using handleIO False by auto

        have " x xs . x # xs = [x] @ xs" by auto
        then have " γ . (x, y) # γ  LS M1 (after_initial M1 u)"
          by (metis u @ [(x, y)]  L M1 u  L M1 after_language_iff assms(1) language_prefix)

        
        have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (handleIO (T',G') (x,y)))"
          unfolding handleIO
          by (simp add: convergence_graph_lookup_invar M1 M2 cg_lookup (snd TGv)) 
        moreover note p2 p3  γ . (x, y) # γ  LS M1 (after_initial M1 u)
        ultimately show ?thesis
          by presburger 
      next
        case True
        then have handleIO: "(handleIO (T',G') (x,y)) = distinguish_from_set M1 V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u @ [(x, y)]) (v @ [(x, y)]) X' k depth completeInputTraces append_heuristic (u@[(x,y)] = v@[(x,y)])"
          using handleIO by auto

        have "converge M1 (u@[(x,y)]) (v@[(x,y)])"
          by (meson Suc.prems(4) True v  L M1 assms(1) converge_append fsm_initial is_in_language_iff)
        then have "(u@[(x,y)])  L M1" and "(v@[(x,y)])  L M1"
          by auto
        have "(u@[(x,y)])  L M2"
          by (meson True (u @ [(x, y)]  L M1) = (u @ [(x, y)]  L M2) assms(1) fsm_initial is_in_language_iff) 
        have "(v@[(x,y)])  L M2"
          using Suc.prems(4) (u @ [(x, y)]  L M1) = (u @ [(x, y)]  L M2) (v @ [(x, y)]  L M1) = (v @ [(x, y)]  L M2) u @ [(x, y)]  L M2 assms(1) converge_append_language_iff by blast
        have "preserves_divergence M1 M2 (list.set X  {u,v})"
          by (metis (no_types) Un_insert_right preserves_divergence M1 M2 (Set.insert u (Set.insert v (list.set X))) sup_bot_right)


        have IS3: "w. w  list.set X'  w'. converge M1 w w'  converge M2 w w'"
          unfolding X'
          by (metis (full_types) Suc.prems(3) converge M1 u u' converge M1 v v' converge M2 u u' converge M2 v v' set_ConsD) 

        have "(u@[(x,y)] = v@[(x,y)]) = (u=v)"
          by auto
        have IS4: "L M1  Prefix_Tree.set (fst (distinguish_from_set M1 V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u @ [(x, y)]) (v @ [(x, y)]) X' k depth completeInputTraces append_heuristic (u@[(x,y)] = v@[(x,y)]))) = L M2  Prefix_Tree.set (fst (distinguish_from_set M1 V (fst TGv) (snd TGv) cg_lookup cg_insert get_distinguishing_trace (u @ [(x, y)]) (v @ [(x, y)]) X' k depth completeInputTraces append_heuristic (u@[(x,y)] = v@[(x,y)])))"
          using L M1  set (fst (handleIO (T',G') (x,y))) = L M2  set (fst (handleIO (T',G') (x,y)))
          unfolding handleIO (u@[(x,y)] = v@[(x,y)]) = (u=v)
          by blast

        have IH1: " γ xa ya. length (γ @ [(xa, ya)])  depth 
                     γ  LS M1 (after_initial M1 (u @ [(x, y)])) 
                     xa  FSM.inputs M1 
                     ya  FSM.outputs M1 
                     L M1  (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(xa, ya)]))}) = L M2  (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(xa, ya)]))})  
                     preserves_divergence M1 M2 (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(xa, ya)]))})"
        and  IH2: "preserves_divergence M1 M2 (list.set X'  {u @ [(x, y)], v @ [(x, y)]})"
        and  IH3: "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (handleIO (T', G') (x, y)))"          
          using Suc.IH[OF IS1 IS2 IS3 converge M1 (u@[(x,y)]) (v@[(x,y)]) u@[(x,y)]  L M2 v@[(x,y)]  L M2 convergence_graph_lookup_invar M1 M2 cg_lookup (snd TGv) IS4]
          unfolding handleIO[symmetric]
          by blast+
        

        have p3: "preserves_divergence M1 M2 (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})"
        proof (cases notReferenced)
          case True
          then have "list.set X' = list.set X  {u,v}"
            unfolding X' by auto
          show ?thesis 
            using IH2
            unfolding * preserves_divergence.simps list.set X' = list.set X  {u,v}
            by blast
        next
          case False
          then consider "u = v" | "(u  v)  ¬( q  reachable_states M1 . V q  vClass)"
            unfolding notReferenced by blast
          then show ?thesis proof cases
            case 1
            then show ?thesis
              by (metis (no_types, lifting) "*" False IH2 Un_insert_left Un_insert_right X' insertI1 insert_absorb list.simps(15)) 
          next
            case 2

            then have **:"(list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])}) = (list.set X'  {u @ [(x, y)], v @ [(x, y)]})  {v}"
              unfolding * X'
              by auto
  
            obtain q where "q  reachable_states M1" and "V q  vClass"
              using 2 notReferenced by blast
            then have "V q  list.set (cg_lookup (snd TG') v)"
              unfolding vClass
              using convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') v  L M1 v  L M2
              unfolding convergence_graph_lookup_invar_def by blast
            then have "converge M1 (V q) v" and "converge M2 (V q) v"
              using convergence_graph_lookup_invar_simp[OF convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') v  L M1 v  L M2, of "V q"]
              by auto
            
            have " β . β  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})  ¬converge M1 v β  ¬converge M2 v β"
            proof -
              fix β assume "β  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})" and "¬converge M1 v β"
              then consider "β = v" | "β  L M1  (list.set X'  {u @ [(x, y)], v @ [(x, y)]})"
                unfolding ** by blast
              then show "¬converge M2 v β"
              proof cases
                case 1
                then show ?thesis using ¬converge M1 v β v  L M1 by auto
              next
                case 2
                moreover have "¬converge M1 (V q) β"
                  using converge M1 (V q) v ¬converge M1 v β
                  by auto
                moreover have "V q  list.set X'"
                  using Suc.prems(1) q  reachable_states M1 
                  unfolding X' by auto
                moreover have "V q  L M1"
                  using converge M1 (V q) v converge.simps by blast 
                ultimately have "¬converge M2 (V q) β"
                  using IH2
                  unfolding preserves_divergence.simps
                  by blast
                then show ?thesis 
                  using converge M2 (V q) v unfolding converge.simps by force
              qed 
            qed
            
            have " α β . α  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})  β  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})  ¬converge M1 α β  ¬converge M2 α β"
            proof - 
              fix α β assume "α  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})"
                             "β  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})"
                             "¬converge M1 α β"
              then consider "α = v  β  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})" | 
                            "β = v  α  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})" |
                            "α  L M1  (list.set X'  {u @ [(x, y)], v @ [(x, y)]})  β  L M1  (list.set X'  {u @ [(x, y)], v @ [(x, y)]})"
                unfolding ** by auto
              then show "¬converge M2 α β" proof cases
                case 1
                then show ?thesis using  β . β  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})  ¬converge M1 v β  ¬converge M2 v β
                  using ¬ converge M1 α β by blast                
              next
                case 2
                then show ?thesis using  β . β  L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})  ¬converge M1 v β  ¬converge M2 v β[of α]
                  using ¬ converge M1 α β 
                  unfolding converge_sym[of _ α] by blast                
              next
                case 3
                then show ?thesis 
                  using IH2 ¬ converge M1 α β 
                  unfolding preserves_divergence.simps by blast
              qed
            qed
            then show ?thesis
              unfolding preserves_divergence.simps 
              by blast
          qed
        qed

        have p4: "( γ x' y'.
                      length ((x, y) # γ @ [(x', y')])  Suc depth 
                      (x, y) # γ  LS M1 (after_initial M1 u) 
                      x'  FSM.inputs M1 
                      y'  FSM.outputs M1 
                      L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) =
                      L M2  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) 
                      preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}))"
        proof -
          fix γ x' y'
          assume "length ((x, y) # γ @ [(x', y')])  Suc depth"
                 "(x, y) # γ  LS M1 (after_initial M1 u)"
                 "x'  FSM.inputs M1"
                 "y'  FSM.outputs M1"

          
          have s1: "length (γ @ [(x', y')])  depth"
            using length ((x, y) # γ @ [(x', y')])  Suc depth by auto
          have s2: "γ  LS M1 (after_initial M1 (u @ [(x, y)]))"
            using (x, y) # γ  LS M1 (after_initial M1 u)
            by (metis u @ [(x, y)]  L M1 after_language_append_iff append_Cons assms(1) empty_append_eq_id)

          have pass': "L M1  (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))}) = L M2  (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))})"
          and  preserve': "preserves_divergence M1 M2 (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))})"
            using IH1[OF s1 s2 x'  FSM.inputs M1 y'  FSM.outputs M1]
            by blast+         


          have ***:"{ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}
                = {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))}  {u,v}"
            (is "?A = ?B")
          proof 
            show "?A  ?B"
            proof  
              fix w assume "w  ?A"
              then obtain ω ω' where "w = ω @ ω'" and "ω  {u, v}" and "ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))"
                by blast

              show "w  ?B"
              proof (cases ω')
                case Nil
                then show ?thesis unfolding w = ω @ ω' prefixes_set using ω  {u, v} by auto
              next
                case (Cons a list)
                then have "a = (x,y)" and "list  list.set (prefixes (γ @ [(x', y')]))"
                  using ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))
                  by (meson prefixes_Cons)+ 
                moreover have "ω@[(x,y)]  {u @ [(x, y)], v @ [(x, y)]}"
                  using ω  {u, v}
                  by auto
                ultimately have "((ω@[(x,y)])@list)  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))}"
                  by blast
                then show ?thesis 
                  unfolding w = ω @ ω' Cons a = (x,y) 
                  by auto
              qed
            qed
            show "?B  ?A"
            proof 
              fix w assume "w  ?B"
              then consider "w  {u,v}" | "w  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))}"
                by blast
              then show "w  ?A" proof cases
                case 1
                then show ?thesis using prefixes_set_Nil[of " ((x, y) # γ @ [(x', y')])"]
                  using append.right_neutral by blast
              next
                case 2
                then obtain ω ω' where "w = ω @ ω'" and "ω  {u @ [(x, y)], v @ [(x, y)]}" and "ω'  list.set (prefixes (γ @ [(x', y')]))"
                  by blast

                obtain ω'' where "ω = ω''@[(x,y)]"
                  using ω  {u @ [(x, y)], v @ [(x, y)]} by auto
                then have "ω''  {u,v}"
                  using ω  {u @ [(x, y)], v @ [(x, y)]} by auto
                moreover have "[(x,y)]@ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))"
                  using prefixes_prepend[OF ω'  list.set (prefixes (γ @ [(x', y')]))]
                  by (metis append_Cons empty_append_eq_id)
                ultimately show "w  ?A"
                  unfolding w = ω @ ω' ω = ω''@[(x,y)]
                  using append_assoc by blast
              qed 
            qed
          qed

          have "list.set X  list.set X'"
            unfolding X' by auto
          then have pass'': "L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) = L M2  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})"
            using pass' u  L M1 v  L M1 u  L M2 v  L M2
            unfolding ***
            by blast

          have preserve'': "preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})"
          proof (cases notReferenced)
            case True
            then have "list.set X' = list.set X  {u,v}"
              unfolding X' by auto
            show ?thesis 
              using preserve'
              unfolding *** preserves_divergence.simps list.set X' = list.set X  {u,v}
              by blast
          next
            case False
            then consider "u = v" | "(u  v)  ¬( q  reachable_states M1 . V q  vClass)"
              unfolding notReferenced by blast
            then show ?thesis proof cases
              case 1
              then show ?thesis
                using "***" X' preserve' by fastforce                 
            next
              case 2

              then have **:"(list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) = (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))})  {v}"
                unfolding *** X' by auto
    
              obtain q where "q  reachable_states M1" and "V q  vClass"
                using 2 notReferenced by blast
              then have "V q  list.set (cg_lookup (snd TG') v)"
                unfolding vClass
                using convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') v  L M1 v  L M2
                unfolding convergence_graph_lookup_invar_def by blast
              then have "converge M1 (V q) v" and "converge M2 (V q) v"
                using convergence_graph_lookup_invar_simp[OF convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG') v  L M1 v  L M2, of "V q"]
                by auto
              
              have " β . β  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})  ¬converge M1 v β  ¬converge M2 v β"
              proof -
                fix β assume "β  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})" and "¬converge M1 v β"
                then consider "β = v" | "β  L M1  (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))})"
                  unfolding ** by blast
                then show "¬converge M2 v β"
                proof cases
                  case 1
                  then show ?thesis using ¬converge M1 v β v  L M1 by auto
                next
                  case 2
                  moreover have "¬converge M1 (V q) β"
                    using converge M1 (V q) v ¬converge M1 v β
                    by auto
                  moreover have "V q  list.set X'"
                    using Suc.prems(1) q  reachable_states M1 
                    unfolding X' by auto
                  moreover have "V q  L M1"
                    using converge M1 (V q) v converge.simps by blast 
                  ultimately have "¬converge M2 (V q) β"
                    using preserve'
                    unfolding preserves_divergence.simps
                    by blast
                  then show ?thesis 
                    using converge M2 (V q) v unfolding converge.simps by force
                qed 
              qed
              
              have " α β . α  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})  β  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})  ¬converge M1 α β  ¬converge M2 α β"
              proof - 
                fix α β assume "α  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})"
                               "β  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})"
                               "¬converge M1 α β"
                then consider "α = v  β  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})" | 
                              "β = v  α  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})" |
                              "α  L M1  (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))})  β  L M1  (list.set X'  {ω @ ω' |ω ω'. ω  {u @ [(x, y)], v @ [(x, y)]}  ω'  list.set (prefixes (γ @ [(x', y')]))})"
                  unfolding ** by auto
                then show "¬converge M2 α β" proof cases
                  case 1
                  then show ?thesis using  β . β  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})  ¬converge M1 v β  ¬converge M2 v β
                    using ¬ converge M1 α β by blast                
                next
                  case 2
                  then show ?thesis using  β . β  L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})  ¬converge M1 v β  ¬converge M2 v β[of α]
                    using ¬ converge M1 α β 
                    unfolding converge_sym[of _ α] by blast                
                next
                  case 3
                  then show ?thesis 
                    using preserve' ¬ converge M1 α β 
                    unfolding preserves_divergence.simps by blast
                qed
              qed
              then show ?thesis
                unfolding preserves_divergence.simps 
                by blast
            qed 
          qed

          show "L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) =
                      L M2  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) 
                      preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})"
            using pass'' preserve''
            by presburger
        qed

        show ?thesis 
          using IH3 p2 p3 p4
          by blast
      qed
    qed

    have foldl_handleIO_subset: " XY T G . set T  set (fst (foldl handleIO (T,G) XY))"
    proof -
      fix XY T G 
      show "set T  set (fst (foldl handleIO (T,G) XY))"
      proof (induction XY rule: rev_induct)
        case Nil
        then show ?case by auto
      next
        case (snoc x xs)
        then show ?case 
          using handleIO_subset[of "fst (foldl handleIO (T, G) xs)" "snd (foldl handleIO (T, G) xs)" "fst x" "snd x"] 
          by force
      qed  
    qed


    have "list.set XY = inputs M1 × outputs M1"
      unfolding XY
      by (metis inputs_as_list_set outputs_as_list_set set_product) 
    then have "list.set XY  inputs M1 × outputs M1"
      by auto
    moreover have "L M1  set (fst (foldl handleIO (fst TG'', snd TG'') XY)) = L M2  set (fst (foldl handleIO (fst TG'', snd TG'') XY))"
      using pass_result by auto
    ultimately have foldl_handleIO_props: "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleIO (fst TG'', snd TG'') XY))
                                            ( x y . (x,y)  list.set XY  
                                                    L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])}) = L M2  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})    
                                                     preserves_divergence M1 M2 (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])})
                                                     ( γ x' y' . length ((x,y)#γ@[(x',y')])  Suc depth 
                                                           ((x,y)#γ)  LS M1 (after_initial M1 u) 
                                                          x'  inputs M1  y'  outputs M1 
                                                          L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes ((x,y)#γ@[(x',y')]))}) = L M2  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes ((x,y)#γ@[(x',y')]))})
                                                           preserves_divergence M1 M2 (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes ((x,y)#γ@[(x',y')]))})))"
    proof (induction XY rule: rev_induct)
      case Nil

      have *:"(foldl handleIO (fst TG'', snd TG'') []) = (fst TG'', snd TG'')"
        by auto

      show ?case 
        using convergence_graph_lookup_invar M1 M2 cg_lookup (snd TG'')
        unfolding * snd_conv 
        by auto
    next
      case (snoc a XY)
      obtain x' y' where "a = (x',y')"
        using prod.exhaust by metis
      then have "x'  inputs M1" and "y'  outputs M1"
        using snoc.prems(1) by auto

      have "set T  set (fst TG'')"
        using Prefix_Tree.set (fst TG')  Prefix_Tree.set (fst TG'') Prefix_Tree.set T  Prefix_Tree.set (fst TG') by auto

      have "(foldl handleIO (fst TG'', snd TG'') (XY@[a])) = handleIO (foldl handleIO (fst TG'', snd TG'') XY) (x',y')"
        unfolding a = (x',y') by auto
      then have "set (fst (foldl handleIO (fst TG'', snd TG'') XY))  set (fst (foldl handleIO (fst TG'', snd TG'') (XY@[a])))"
        using handleIO_subset
        by (metis prod.collapse) 
      then have pass_XY: "L M1  set (fst (foldl handleIO (fst TG'', snd TG'') XY)) = L M2  set (fst (foldl handleIO (fst TG'', snd TG'') XY))"
        using snoc.prems(2) by blast
      have "set T  set (fst (foldl handleIO (fst TG'', snd TG'') XY))"
        using foldl_handleIO_subset set T  set (fst TG'')
        by blast 

      have "list.set XY  FSM.inputs M1 × FSM.outputs M1"
        using snoc.prems(1) by auto
      have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleIO (fst TG'', snd TG'') XY))"
        using snoc.IH[OF list.set XY  FSM.inputs M1 × FSM.outputs M1 pass_XY] by blast
      have pass_aXY: "L M1  Prefix_Tree.set (fst (handleIO (fst (foldl handleIO (fst TG'', snd TG'') XY), snd (foldl handleIO (fst TG'', snd TG'') XY)) (x',y') )) = L M2  Prefix_Tree.set (fst (handleIO (fst (foldl handleIO (fst TG'', snd TG'') XY), snd (foldl handleIO (fst TG'', snd TG'') XY)) (x',y') ))"
        using snoc.prems(2) 
        unfolding (foldl handleIO (fst TG'', snd TG'') (XY@[a])) = handleIO (foldl handleIO (fst TG'', snd TG'') XY) (x',y') 
        unfolding prod.collapse .


      show ?case (is "?P1  ?P2")
      proof 
        show "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleIO (fst TG'', snd TG'') (XY@[a])))"
          using handleIO_props[OF set T  set (fst (foldl handleIO (fst TG'', snd TG'') XY)) convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleIO (fst TG'', snd TG'') XY)) pass_aXY x'  inputs M1 y'  outputs M1]
          unfolding (foldl handleIO (fst TG'', snd TG'') (XY@[a])) = handleIO (foldl handleIO (fst TG'', snd TG'') XY) (x',y') 
          unfolding prod.collapse
          by blast

        have " x y. (x, y)  list.set (XY@[a]) 
          L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])}) = L M2  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])}) 
          preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes [(x, y)])}) 
          (γ x' y'.
              length ((x, y) # γ @ [(x', y')])  Suc depth 
              (x, y) # γ  LS M1 (after_initial M1 u) 
              x'  FSM.inputs M1 
              y'  FSM.outputs M1 
              L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) =
              L M2  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) 
              preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}))"
        proof -
          fix x y assume "(x, y)  list.set (XY@[a])"

          show "L M1  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])}) = L M2  (list.set X  {ω@ω' | ω ω' . ω  {u,v}  ω'  list.set (prefixes [(x,y)])}) 
                preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes [(x, y)])}) 
                  (γ x' y'.
                      length ((x, y) # γ @ [(x', y')])  Suc depth 
                      (x, y) # γ  LS M1 (after_initial M1 u) 
                      x'  FSM.inputs M1 
                      y'  FSM.outputs M1 
                      L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) =
                      L M2  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) 
                      preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}))"
          proof (cases "a = (x,y)")
            case True
            then have *:"(x',y') = (x,y)"
              using a = (x',y') by auto

            show ?thesis
              using handleIO_props[OF set T  set (fst (foldl handleIO (fst TG'', snd TG'') XY)) convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleIO (fst TG'', snd TG'') XY)) pass_aXY x'  inputs M1 y'  outputs M1]
              unfolding (foldl handleIO (fst TG'', snd TG'') (XY@[a])) = handleIO (foldl handleIO (fst TG'', snd TG'') XY) (x',y') 
              unfolding prod.collapse * 
              by presburger
          next
            case False
            then have "(x,y)  list.set XY"
              using (x, y)  list.set (XY@[a]) by auto
            
            then show ?thesis 
              using snoc.IH[OF list.set XY  FSM.inputs M1 × FSM.outputs M1 pass_XY]
              by presburger
          qed
        qed
        then show "?P2"
          by blast
      qed
    qed

    have " x y . (x,y)  list.set XY = (x  inputs M1  y  outputs M1)"
      unfolding list.set XY = inputs M1 × outputs M1 by auto

    have result_props_1: " x y γ x' y'. x  inputs M1  y  outputs M1 
             length ((x, y) # γ @ [(x', y')])  Suc depth 
             (x, y) # γ  LS M1 (after_initial M1 u) 
             x'  FSM.inputs M1 
             y'  FSM.outputs M1 
             L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) =
             L M2  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))}) 
             preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes ((x, y) # γ @ [(x', y')]))})"
      using foldl_handleIO_props
      unfolding  x y . (x,y)  list.set XY = (x  inputs M1  y  outputs M1)
      by blast


    have "?P1a X u v (Suc depth)"
    proof -
      have " γ x y.
               length (γ @ [(x, y)])  Suc depth 
               γ  LS M1 (after_initial M1 u) 
               x  FSM.inputs M1 
               y  FSM.outputs M1 
               L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) =
               L M2  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
               preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
      proof -
        fix γ x y
        assume "length (γ @ [(x, y)])  Suc depth"
               "γ  LS M1 (after_initial M1 u)"
               "x  FSM.inputs M1"
               "y  FSM.outputs M1"

        show "L M1  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) =
               L M2  (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
               preserves_divergence M1 M2 (list.set X  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
        proof (cases γ)
          case Nil
          then have *:"γ @ [(x,y)] = [(x,y)]"
            by auto
          have "(x,y)  list.set XY"
            unfolding list.set XY = inputs M1 × outputs M1
            using x  FSM.inputs M1 y  FSM.outputs M1
            by auto
          show ?thesis
            unfolding * 
            using foldl_handleIO_props  (x,y)  list.set XY
            by presburger
        next
          case (Cons a γ')
          obtain x' y' where "a = (x',y')"
            using prod.exhaust by metis
          then have *: "γ = (x',y')#γ'"
            unfolding Cons by auto
          then have **: "γ @ [(x, y)] = (x',y')#γ'@ [(x, y)]"
            by auto

          have x'  inputs M1 y'  outputs M1
            using language_io[OF γ  LS M1 (after_initial M1 u), of x' y']
            unfolding * 
            by auto
          have "length ((x', y') # (γ' @ [(x, y)]))  Suc depth"
            using length (γ @ [(x, y)])  Suc depth unfolding * by auto
          have "(x', y') # γ'  LS M1 (after_initial M1 u)"
            using γ  LS M1 (after_initial M1 u) unfolding * .

          show ?thesis 
            using result_props_1[OF x'  inputs M1 y'  outputs M1 length ((x', y') # (γ' @ [(x, y)]))  Suc depth (x', y') # γ'  LS M1 (after_initial M1 u) x  FSM.inputs M1 y  outputs M1]
            unfolding ** .
        qed
      qed
      then show ?thesis by blast
    qed

    moreover have "?P1b X u v"
      using preserves_divergence M1 M2 (Set.insert u (Set.insert v (list.set X))) by auto
            
    moreover have "?P2 T G u v X (Suc depth)"
      using foldl_handleIO_props
      unfolding result prod.collapse 
      by blast
    
    ultimately show ?case
      by blast
  qed

  then show "?P1a X u v depth" and "?P1b X u v" and "?P2 T G u v X depth"
    by presburger+
qed


lemma distinguish_from_set_establishes_convergence :
  assumes "observable M1"
      and "observable M2"
      and "minimal M1"
      and "minimal M2"
      and "size_r M1  m"
      and "size M2  m"
      and "inputs M2 = inputs M1"
      and "outputs M2 = outputs M1"
      and "is_state_cover_assignment M1 V"
      and "preserves_divergence M1 M2 (V ` reachable_states M1)"
      and "L M1  (V ` reachable_states M1) = L M2  V ` reachable_states M1"
      and "converge M1 u v"
      and "u  L M2"
      and "v  L M2"
      and "convergence_graph_lookup_invar M1 M2 cg_lookup G"
      and "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
      and " q1 q2 . q1  states M1  q2  states M1  q1  q2  distinguishes M1 q1 q2 (get_distinguishing_trace q1 q2)"
      and "L M1  set (fst (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v (map V (reachable_states_as_list M1)) k (m - size_r M1) completeInputTraces append_heuristic (u=v))) = L M2  set (fst (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v (map V (reachable_states_as_list M1)) k (m - size_r M1) completeInputTraces append_heuristic (u=v)))"
      and " T w u' uBest lBest . fst (append_heuristic T w (uBest,lBest) u')  {u',uBest}"
shows "converge M2 u v"
  and "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v (map V (reachable_states_as_list M1)) k (m - size_r M1) completeInputTraces append_heuristic (u=v)))"
proof -
  have d1: "V ` reachable_states M1  list.set (map V (reachable_states_as_list M1))"
    using reachable_states_as_list_set by auto 
  have d2: "preserves_divergence M1 M2 (list.set (map V (reachable_states_as_list M1)))"
    using assms(10) reachable_states_as_list_set
    by (metis image_set) 
  have d3: "(w. w  list.set (map V (reachable_states_as_list M1))  w'. converge M1 w w'  converge M2 w w')"
  proof -
    fix w assume "w  list.set (map V (reachable_states_as_list M1))"
    then have "w  V ` reachable_states M1"
      using reachable_states_as_list_set by auto
    moreover have "w  L M1"
      by (metis assms(1) assms(9) calculation image_iff state_cover_assignment_after(1))
    ultimately have "w  L M2"
      using assms(11) by blast

    have "converge M1 w w"
      using w  L M1 by auto
    moreover have "converge M2 w w"
      using w  L M2 by auto
    ultimately show "w'. converge M1 w w'  converge M2 w w'"
      by blast
  qed

  have "list.set (map V (reachable_states_as_list M1)) = V ` reachable_states M1"
    using reachable_states_as_list_set by auto


  have prop1: "γ x y.
     length (γ @ [(x, y)])  (m - size_r M1) 
     γ  LS M1 (after_initial M1 u) 
     x  FSM.inputs M1 
     y  FSM.outputs M1 
     L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) =
     L M2  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
     preserves_divergence M1 M2
      (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
  and prop2: "preserves_divergence M1 M2 (V ` reachable_states M1  {u, v})"
  and prop3: "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v (map V (reachable_states_as_list M1)) k (m - size_r M1) completeInputTraces append_heuristic (u=v)))"
    using distinguish_from_set_properties[OF assms(1-4,7,8,9) d1 d2 d3 assms(12-19)]
    unfolding list.set (map V (reachable_states_as_list M1)) = V ` reachable_states M1
    by presburger+
  then show "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (distinguish_from_set M1 V T G cg_lookup cg_insert get_distinguishing_trace u v (map V (reachable_states_as_list M1)) k (m - size_r M1) completeInputTraces append_heuristic (u=v)))"
    by presburger

  show "converge M2 u v"
    using establish_convergence_from_pass[OF assms(1-9,11-14) prop1 prop2]
    by blast
qed


definition establish_convergence_dynamic :: "bool  bool  ('a  'a  ('b × 'c) list)  
                                  ('a::linorder,'b::linorder,'c::linorder) fsm 
                                  ('a,'b,'c) state_cover_assignment 
                                  ('b×'c) prefix_tree  
                                  'd 
                                  ('d  ('b×'c) list  'd) 
                                  ('d  ('b×'c) list  ('b×'c) list list)  
                                  nat 
                                  ('a,'b,'c) transition   
                                  (('b×'c) prefix_tree × 'd)" where
  "establish_convergence_dynamic completeInputTraces useInputHeuristic dist_fun M1 V T G cg_insert cg_lookup m t = 
    distinguish_from_set M1 V T G cg_lookup cg_insert 
                         dist_fun
                         ((V (t_source t))@[(t_input t, t_output t)]) 
                         (V (t_target t)) 
                         (map V (reachable_states_as_list M1)) 
                         (2 * size M1) 
                         (m - size_r M1) 
                         completeInputTraces
                         (if useInputHeuristic then append_heuristic_input M1 else append_heuristic_io)
                         False"


lemma establish_convergence_dynamic_verifies_transition :
  assumes " q1 q2 . q1  states M1  q2  states M1  q1  q2  distinguishes M1 q1 q2 (dist_fun q1 q2)"
  shows "verifies_transition (establish_convergence_dynamic b c dist_fun) M1 M2 V T0 cg_insert cg_lookup"
proof -
  have *:" (M1::('a::linorder,'b::linorder,'c::linorder) fsm) V T (G::'d) cg_insert cg_lookup m t. Prefix_Tree.set T  Prefix_Tree.set (fst (establish_convergence_dynamic b c dist_fun M1 V T G cg_insert cg_lookup m t))"
    using distinguish_from_set_subset unfolding establish_convergence_dynamic_def
    by metis 

  have ***:" (M1::('a::linorder,'b::linorder,'c::linorder) fsm) V T (G::'d) cg_insert cg_lookup m t. finite_tree T  finite_tree (fst (establish_convergence_dynamic b c dist_fun M1 V T G cg_insert cg_lookup m t))"
    using distinguish_from_set_finite unfolding establish_convergence_dynamic_def
    by metis 

  have **:" V T (G::'d) cg_insert cg_lookup m t.
        observable M1 
        observable M2 
        minimal M1 
        minimal M2 
        size_r M1  m 
        FSM.size M2  m 
        FSM.inputs M2 = FSM.inputs M1 
        FSM.outputs M2 = FSM.outputs M1 
        is_state_cover_assignment M1 V 
        preserves_divergence M1 M2 (V ` reachable_states M1) 
        V ` reachable_states M1  set T 
        t  FSM.transitions M1 
        t_source t  reachable_states M1 
        ((V (t_source t)) @ [(t_input t,t_output t)])  (V (t_target t)) 
        V (t_source t) @ [(t_input t, t_output t)]  L M2 
        convergence_graph_lookup_invar M1 M2 cg_lookup G 
        convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
        L M1  Prefix_Tree.set (fst (establish_convergence_dynamic b c dist_fun M1 V T G cg_insert cg_lookup m t)) =
        L M2  Prefix_Tree.set (fst (establish_convergence_dynamic b c dist_fun M1 V T G cg_insert cg_lookup m t)) 
        converge M2 (V (t_source t) @ [(t_input t, t_output t)]) (V (t_target t)) 
        convergence_graph_lookup_invar M1 M2 cg_lookup (snd (establish_convergence_dynamic b c dist_fun M1 V T G cg_insert cg_lookup m t))"
  proof -
    
    fix G :: 'd
    fix V T cg_insert cg_lookup m t
    assume a01: "observable M1"
    assume a02: "observable M2"
    assume a03: "minimal M1"
    assume a04: "minimal M2"
    assume a05: "size_r M1  m"
    assume a06: "FSM.size M2  m"
    assume a07: "FSM.inputs M2 = FSM.inputs M1"
    assume a08: "FSM.outputs M2 = FSM.outputs M1"
    assume a09: "is_state_cover_assignment M1 V"
    assume a10: "preserves_divergence M1 M2 (V ` reachable_states M1)"
    assume a11: "V ` reachable_states M1  set T"
    assume a12: "t  FSM.transitions M1"
    assume a13: "t_source t  reachable_states M1"
    assume a14: "V (t_source t) @ [(t_input t, t_output t)]  L M2"
    assume a15: "convergence_graph_lookup_invar M1 M2 cg_lookup G"
    assume a16: "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
    assume a17: "L M1  Prefix_Tree.set (fst (establish_convergence_dynamic b c dist_fun M1 V T G cg_insert cg_lookup m t)) = L M2  Prefix_Tree.set (fst (establish_convergence_dynamic b c dist_fun M1 V T G cg_insert cg_lookup m t))"
    assume a18: "((V (t_source t)) @ [(t_input t,t_output t)])  (V (t_target t))"

    let ?heuristic = "(if c then append_heuristic_input M1 else append_heuristic_io)"

    have d2: "converge M1 (V (t_source t) @ [(t_input t, t_output t)]) (V (t_target t))"
      using state_cover_transition_converges[OF a01 a09 a12 a13] .

    have d1: "L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1"
      using a11 a17 *[of T M1 V G cg_insert cg_lookup m t]
      by blast

    then have d3: "V (t_target t)  L M2"
      using a11 is_state_cover_assignment_language[OF a09, of "t_target t"] reachable_states_next[OF a13 a12] by auto

    have d5: "L M1  Prefix_Tree.set  (fst (distinguish_from_set M1 V T G cg_lookup cg_insert dist_fun (V (t_source t) @ [(t_input t, t_output t)]) (V (t_target t)) (map V (reachable_states_as_list M1)) (2 * size M1) (m - size_r M1) b ?heuristic (((V (t_source t)) @ [(t_input t,t_output t)]) = (V (t_target t))))) = L M2  Prefix_Tree.set (fst (distinguish_from_set M1 V T G cg_lookup cg_insert dist_fun (V (t_source t) @ [(t_input t, t_output t)]) (V (t_target t)) (map V (reachable_states_as_list M1)) (2 * size M1) (m - size_r M1) b ?heuristic (((V (t_source t)) @ [(t_input t,t_output t)]) = (V (t_target t)))))"
      using a17 a18 unfolding establish_convergence_dynamic_def by force

    have d6: "(T w u' uBest lBest. fst (?heuristic T w (uBest, lBest) u')  {u', uBest})"
      using append_heuristic_input_in[of M1] append_heuristic_io_in
      by fastforce
    
    show "converge M2 (V (t_source t) @ [(t_input t, t_output t)]) (V (t_target t)) 
          convergence_graph_lookup_invar M1 M2 cg_lookup (snd (establish_convergence_dynamic b c dist_fun M1 V T G cg_insert cg_lookup m t))"
      using distinguish_from_set_establishes_convergence[OF a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 d1 d2 a14 d3 a15 a16 assms d5 d6] a18
      unfolding establish_convergence_dynamic_def by force
  qed

  show ?thesis
    unfolding verifies_transition_def
    using * *** ** by presburger
qed



definition handleUT_dynamic :: "bool  
                                   bool  
                                   ('a  'a  ('b × 'c) list)  
                                   (('a,'b,'c) fsm  ('a,'b,'c) state_cover_assignment  ('a,'b,'c) transition  ('a,'b,'c) transition list  nat  bool) 
                                   ('a::linorder,'b::linorder,'c::linorder) fsm 
                                   ('a,'b,'c) state_cover_assignment 
                                   ('b×'c) prefix_tree  
                                   'd 
                                   ('d  ('b×'c) list  'd) 
                                   ('d  ('b×'c) list  ('b×'c) list list)   
                                   ('d  ('b×'c) list  ('b×'c) list  'd) 
                                   nat 
                                   ('a,'b,'c) transition   
                                   ('a,'b,'c) transition list 
                                   (('a,'b,'c) transition list × ('b×'c) prefix_tree × 'd)" 
  where
  "handleUT_dynamic complete_input_traces 
                       use_input_heuristic 
                       dist_fun 
                       do_establish_convergence 
                       M 
                       V 
                       T 
                       G 
                       cg_insert 
                       cg_lookup 
                       cg_merge 
                       m 
                       t
                       X 
    = 
    (let k         = (2 * size M); 
         l         = (m - size_r M); 
         heuristic = (if use_input_heuristic then append_heuristic_input M 
                                             else append_heuristic_io);
         rstates   = (map V (reachable_states_as_list M));
         (T1,G1)   = handle_io_pair complete_input_traces 
                                    use_input_heuristic 
                                    M 
                                    V 
                                    T 
                                    G 
                                    cg_insert 
                                    cg_lookup 
                                    (t_source t) 
                                    (t_input t) 
                                    (t_output t);
         u         = ((V (t_source t))@[(t_input t, t_output t)]);
         v         = (V (t_target t));
         X'        = butlast X  
      in if (do_establish_convergence M V t X' l)
          then let (T2,G2) = distinguish_from_set M 
                                                  V
                                                  T1 
                                                  G1 
                                                  cg_lookup 
                                                  cg_insert 
                                                  dist_fun
                                                  u 
                                                  v
                                                  rstates 
                                                  k 
                                                  l 
                                                  complete_input_traces
                                                  heuristic
                                                  False;
                  G3 = cg_merge G2 u v  
               in
                  (X',T2,G3) 
          else (X',distinguish_from_set M 
                                        V
                                        T1 
                                        G1 
                                        cg_lookup 
                                        cg_insert 
                                        dist_fun
                                        u
                                        u 
                                        rstates 
                                        k 
                                        l 
                                        complete_input_traces
                                        heuristic
                                        True))"


lemma handleUT_dynamic_handles_transition :
  fixes M1::"('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2::"('e,'b,'c) fsm"
  assumes " q1 q2 . q1  states M1  q2  states M1  q1  q2  distinguishes M1 q1 q2 (dist_fun q1 q2)"
  shows "handles_transition (handleUT_dynamic b c dist_fun d) M1 M2 V T0 cg_insert cg_lookup cg_merge"
proof -       

  have " T G m t X . 
       Prefix_Tree.set T  Prefix_Tree.set (fst (snd (handleUT_dynamic b c dist_fun d M1 V T G cg_insert cg_lookup cg_merge m t X))) 
       (finite_tree T  finite_tree (fst (snd (handleUT_dynamic b c dist_fun d M1 V T G cg_insert cg_lookup cg_merge m t X)))) 
       (observable M1 
        observable M2 
        minimal M1 
        minimal M2 
        size_r M1  m 
        FSM.size M2  m 
        FSM.inputs M2 = FSM.inputs M1 
        FSM.outputs M2 = FSM.outputs M1 
        is_state_cover_assignment M1 V 
        preserves_divergence M1 M2 (V ` reachable_states M1) 
        V ` reachable_states M1  Prefix_Tree.set T 
        t  FSM.transitions M1 
        t_source t  reachable_states M1 
        V (t_source t) @ [(t_input t, t_output t)]  V (t_target t) 
        convergence_graph_lookup_invar M1 M2 cg_lookup G 
        convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
        convergence_graph_merge_invar M1 M2 cg_lookup cg_merge 
        L M1  Prefix_Tree.set (fst (snd (handleUT_dynamic b c dist_fun d M1 V T G cg_insert cg_lookup cg_merge m t X))) =
        L M2  Prefix_Tree.set (fst (snd (handleUT_dynamic b c dist_fun d M1 V T G cg_insert cg_lookup cg_merge m t X))) 
        Prefix_Tree.set T0  Prefix_Tree.set T 
        (γ. length γ  m - size_r M1  list.set γ  FSM.inputs M1 × FSM.outputs M1  butlast γ  LS M1 (t_target t) 
             L M1  (V ` reachable_states M1  {(V (t_source t) @ [(t_input t, t_output t)]) @ ω' |ω'. ω'  list.set (prefixes γ)}) =
             L M2  (V ` reachable_states M1  {(V (t_source t) @ [(t_input t, t_output t)]) @ ω' |ω'. ω'  list.set (prefixes γ)}) 
             preserves_divergence M1 M2 (V ` reachable_states M1  {(V (t_source t) @ [(t_input t, t_output t)]) @ ω' |ω'. ω'  list.set (prefixes γ)})) 
        convergence_graph_lookup_invar M1 M2 cg_lookup (snd (snd (handleUT_dynamic b c dist_fun d M1 V T G cg_insert cg_lookup cg_merge m t X))))"
    (is " T G m t X . ?P T G m t X")
  proof -

    fix T :: "('b×'c) prefix_tree"
    fix G :: 'd
    fix m :: nat
    fix t :: "('a,'b,'c) transition"
    fix X :: "('a,'b,'c) transition list"
  
    let ?TG = "snd (handleUT_dynamic b c dist_fun d M1 V T G cg_insert cg_lookup cg_merge m t X)"

    define k where "k = (2 * size M1)"
    define l where "l = (m - size_r M1)"
    define X' where "X' = butlast X"
    define heuristic where "heuristic = (if c then append_heuristic_input M1 else append_heuristic_io)"
    define rstates where "rstates   = (map V (reachable_states_as_list M1))"
    obtain T1 G1 where "(T1,G1)   = handle_io_pair b c M1 V T G cg_insert cg_lookup (t_source t) (t_input t) (t_output t)"
      using prod.collapse by blast
    then have T1_def: "T1 = fst (handle_io_pair b c M1 V T G cg_insert cg_lookup (t_source t) (t_input t) (t_output t))"
         and  G1_def: "G1 = snd (handle_io_pair b c M1 V T G cg_insert cg_lookup (t_source t) (t_input t) (t_output t))"
      using fst_conv[of T1 G1] snd_conv[of T1 G1] by force+
    define u where "u         = ((V (t_source t))@[(t_input t, t_output t)])"
    define v where "v         = (V (t_target t))"

    obtain T2 G2 where "(T2,G2) = distinguish_from_set M1 V T1 G1 cg_lookup cg_insert dist_fun u v rstates k l b heuristic False"
      using prod.collapse by blast
    then have T2_def: "T2 = fst (distinguish_from_set M1 V T1 G1 cg_lookup cg_insert dist_fun u v rstates k l b heuristic False)"
         and  G2_def: "G2 = snd (distinguish_from_set M1 V T1 G1 cg_lookup cg_insert dist_fun u v rstates k l b heuristic False)"
      using fst_conv[of T2 G2] snd_conv[of T2 G2] by force+

    define G3 where "G3 = cg_merge G2 u v"

    obtain TH GH where "(TH,GH) = distinguish_from_set M1 V T1 G1 cg_lookup cg_insert dist_fun u u rstates k l b heuristic True" 
    using prod.collapse by blast
    then have TH_def: "TH = fst (distinguish_from_set M1 V T1 G1 cg_lookup cg_insert dist_fun u u rstates k l b heuristic True)"
         and  GH_def: "GH = snd (distinguish_from_set M1 V T1 G1 cg_lookup cg_insert dist_fun u u rstates k l b heuristic True)"
      using fst_conv[of TH GH] snd_conv[of TH GH] by force+

    have TG_cases: "?TG = (if (d M1 V t X' l) then (T2,G3) else (TH,GH))"
      unfolding handleUT_dynamic_def Let_def
      unfolding u_def[symmetric] v_def[symmetric] rstates_def[symmetric] k_def[symmetric] l_def[symmetric] heuristic_def[symmetric]
      unfolding (T1,G1)   = handle_io_pair b c M1 V T G cg_insert cg_lookup (t_source t) (t_input t) (t_output t)[symmetric] case_prod_conv
      unfolding (T2,G2) = distinguish_from_set M1 V T1 G1 cg_lookup cg_insert dist_fun u v rstates k l b heuristic False[symmetric] case_prod_conv
      unfolding G3_def[symmetric]
      unfolding (TH,GH) = distinguish_from_set M1 V T1 G1 cg_lookup cg_insert dist_fun u u rstates k l b heuristic True[symmetric]
      unfolding X'_def[symmetric]
      by auto
    then have TG_cases_fst: "fst ?TG = (if (d M1 V t X' l) then T2 else TH)"
         and  TG_cases_snd: "snd ?TG = (if (d M1 V t X' l) then G3 else GH)"
      by auto


    have "set T  set T1" 
      unfolding T1_def handle_io_pair_def
      by (metis distribute_extension_subset) 
    moreover have "set T1  set T2"
      unfolding T2_def
      by (meson distinguish_from_set_subset) 
    moreover have "set T1  set TH"
      unfolding TH_def
      by (meson distinguish_from_set_subset) 
    ultimately have *:"set T  set (fst ?TG)"
      using TG_cases by auto

    have "finite_tree T  finite_tree T1"
      unfolding T1_def handle_io_pair_def
      by (metis distribute_extension_finite) 
    moreover have "finite_tree T1  finite_tree T2"
      unfolding T2_def
      by (meson distinguish_from_set_finite) 
    moreover have "finite_tree T1  finite_tree TH"
      unfolding TH_def
      by (meson distinguish_from_set_finite) 
    ultimately have **:"finite_tree T  finite_tree (fst ?TG)"
      using TG_cases by auto
  
    have ***: "observable M1 
              observable M2 
              minimal M1 
              minimal M2 
              size_r M1  m 
              size M2  m 
              inputs M2 = inputs M1 
              outputs M2 = outputs M1 
              is_state_cover_assignment M1 V 
              preserves_divergence M1 M2 (V ` reachable_states M1) 
              V ` reachable_states M1  set T 
              t  transitions M1 
              t_source t  reachable_states M1  
              V (t_source t) @ [(t_input t, t_output t)]  V (t_target t) 
              convergence_graph_lookup_invar M1 M2 cg_lookup G 
              convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
              convergence_graph_merge_invar M1 M2 cg_lookup cg_merge 
              L M1  set (fst ?TG) = L M2  set (fst ?TG) 
              (set T0  set T) 
              ( γ . (length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))
                       ((L M1  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})
                            = L M2  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)}))
                            preserves_divergence M1 M2 (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})))   
               convergence_graph_lookup_invar M1 M2 cg_lookup (snd ?TG)"
    proof -
      assume a01 : "observable M1"
      assume a02 : "observable M2"
      assume a03 : "minimal M1"
      assume a04 : "minimal M2"
      assume a05 : "size_r M1  m"
      assume a06 : "size M2  m"
      assume a07 : "inputs M2 = inputs M1"
      assume a08 : "outputs M2 = outputs M1"
      assume a09 : "is_state_cover_assignment M1 V"
      assume a10 : "preserves_divergence M1 M2 (V ` reachable_states M1)"
      assume a11 : "V ` reachable_states M1  set T"
      assume a12 : "t  transitions M1"
      assume a13 : "t_source t  reachable_states M1"
      assume a14 : "convergence_graph_lookup_invar M1 M2 cg_lookup G"
      assume a15 : "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
      assume a16 : "convergence_graph_merge_invar M1 M2 cg_lookup cg_merge"
      assume a17 : "L M1  set (fst ?TG) = L M2  set (fst ?TG)"
      assume a18 : "(set T0  set T)" 
      assume a19 : "V (t_source t) @ [(t_input t, t_output t)]  V (t_target t)"

      have pass_T1 : "L M1  set T1 = L M2  set T1"
        using a17 set T1  set T2 set T1  set TH unfolding TG_cases_fst 
        by (cases "d M1 V t X' l"; auto)
      then have pass_T : "L M1  set T = L M2  set T"
        using set T  set T1 by blast


      have "t_target t  reachable_states M1"
        using reachable_states_next[OF a13 a12] by auto
      then have "(V (t_target t))  L M1"
        using is_state_cover_assignment_language[OF a09] by blast
      moreover have "(V (t_target t))  set T"
        using a11 t_target t  reachable_states M1 by blast
      ultimately have "(V (t_target t))  L M2"
        using pass_T by blast
      then have "v  L M2"
        unfolding v_def .

      have "(V (t_source t))  L M1"
        using is_state_cover_assignment_language[OF a09 a13] by blast
      moreover have "(V (t_source t))  set T"
        using a11 a13 by blast
      ultimately have "(V (t_source t))  L M2"
        using pass_T by blast
      have "u  L M1"
        unfolding u_def
        using a01 a09 a12 a13 converge.simps state_cover_transition_converges by blast 


      have heuristic_prop: "(T w u' uBest lBest. fst (heuristic T w (uBest, lBest) u')  {u', uBest})"
        unfolding heuristic_def 
        using append_heuristic_input_in append_heuristic_io_in 
        by fastforce 

      have "convergence_graph_lookup_invar M1 M2 cg_lookup G1"
        using distribute_extension_adds_sequence(2)[OF a01 a03 (V (t_source t))  L M1 (V (t_source t))  L M2 a14 a15, of T "[(t_input t, t_output t)]" b heuristic, OF _ heuristic_prop]
        using pass_T1
        unfolding T1_def G1_def handle_io_pair_def
        unfolding heuristic_def[symmetric]
        by blast

      have "list.set rstates = V ` reachable_states M1"
        unfolding rstates_def
        using reachable_states_as_list_set by auto 
      then have "V ` reachable_states M1  list.set rstates"
        by auto 
      have "preserves_divergence M1 M2 (list.set rstates)"
        unfolding rstates_def
        using a10
        by (metis image_set reachable_states_as_list_set) 
      then have "preserves_divergence M1 M2 (V ` reachable_states M1)"
        unfolding list.set rstates = V ` reachable_states M1 .
      have "(w. w  list.set rstates  w'. converge M1 w w'  converge M2 w w')"
      proof -
        fix w assume "w  list.set rstates"
        then obtain q where "w = V q" and "q  reachable_states M1"
          unfolding rstates_def
          using reachable_states_as_list_set by auto
        then have "w  L M1" and "w  set T"
          using is_state_cover_assignment_language[OF a09] a11 by blast+
        then have "w  L M2"
          using pass_T by blast
        then have "converge M1 w w" and "converge M2 w w"
          using w  L M1 by auto
        then show "w'. converge M1 w w'  converge M2 w w'"
          by blast
      qed
      have "L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1"
        by (meson a11 inter_eq_subsetI pass_T)


      have "converge M1 u v"
        unfolding u_def v_def
        using a01 a09 a12 a13 state_cover_transition_converges by blast 
      have "u  L M2" 
        using distribute_extension_adds_sequence(1)[OF a01 a03 (V (t_source t))  L M1 (V (t_source t))  L M2 a14 a15, of T "[(t_input t, t_output t)]" b heuristic, OF _ heuristic_prop]
        using pass_T1
        unfolding T1_def G1_def handle_io_pair_def
        unfolding heuristic_def[symmetric]
        by (metis (no_types, lifting) Int_iff V (t_target t)  L M1 converge M1 u v a01 a02 append_Nil2 converge_append_language_iff u_def v_def)

      have "(u = v) = False"
        unfolding u_def v_def using a19 by simp

      

      have "after_initial M1 u = t_target t"
        using a09 unfolding u_def
        by (metis converge M1 u v t_target t  reachable_states M1 a01 a03 converge.elims(2) convergence_minimal is_state_cover_assignment_observable_after u_def v_def) 

      have " γ x y . {u @ ω' | ω'. ω'  list.set (prefixes (γ @ [(x, y)]))}  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}"
        by blast

      show "( γ . (length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))
                       ((L M1  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})
                            = L M2  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)}))
                            preserves_divergence M1 M2 (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})))   
               convergence_graph_lookup_invar M1 M2 cg_lookup (snd ?TG)"
      proof (cases "d M1 V t X' l")
        case True
        then have "?TG = (T2,G3)"
          unfolding TG_cases by auto

        have pass_T2: "L M1  set T2 = L M2  set T2"
          using a17 unfolding ?TG = (T2,G3) by auto

        have "convergence_graph_lookup_invar M1 M2 cg_lookup G2"  
        and  "converge M2 u v"
          using pass_T2
          using distinguish_from_set_establishes_convergence[OF a01 a02 a03 a04 a05 a06 a07 a08 a09 preserves_divergence M1 M2 (V ` reachable_states M1) L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1 converge M1 u v u  L M2 v  L M2 convergence_graph_lookup_invar M1 M2 cg_lookup G1 a15 assms, of T1 k b heuristic, OF _ _ _ _ heuristic_prop]
          unfolding G2_def T2_def (u = v) = False rstates_def[symmetric] l_def[symmetric]
          by blast+
        then have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd ?TG)"
          unfolding ?TG = (T2,G3) G3_def snd_conv using a16
          by (meson converge M1 u v convergence_graph_merge_invar_def) 


        have cons_prop: "γ x y.
                           length (γ @ [(x, y)])  l 
                           γ  LS M1 (after_initial M1 u) 
                           x  FSM.inputs M1 
                           y  FSM.outputs M1 
                           L M1  (list.set rstates  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) =
                           L M2  (list.set rstates  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
                           preserves_divergence M1 M2 (list.set rstates  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
         and nil_prop: "preserves_divergence M1 M2 (list.set rstates  {u, v})"        
          using pass_T2
          using distinguish_from_set_properties(1,2)[OF a01 a02 a03 a04 a07 a08 a09 V ` reachable_states M1  list.set rstates preserves_divergence M1 M2 (list.set rstates) (w. w  list.set rstates  w'. converge M1 w w'  converge M2 w w') converge M1 u v u  L M2 v  L M2 convergence_graph_lookup_invar M1 M2 cg_lookup G1 a15 assms, of T1 k l b heuristic, OF _ _ _ _ _ heuristic_prop ]
          unfolding G2_def T2_def (u = v) = False  
          by presburger+
        have " γ . (length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))
                       ((L M1  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})
                            = L M2  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)}))
                            preserves_divergence M1 M2 (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)}))"
          (is " γ . (length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))  ?P1 γ  ?P2 γ")          
        proof -
          fix γ assume assm:"(length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))"
          show "?P1 γ  ?P2 γ" 
          proof (cases γ rule: rev_cases)
            case Nil
            have *: "(V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})
                        = (V ` reachable_states M1  {u})"
              unfolding u_def[symmetric] list.set rstates = V ` reachable_states M1 Nil by auto

            have "?P1 γ"
              using L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1
                    u  L M1 u  L M2
              unfolding * by blast
            moreover have "?P2 γ"
              using preserves_divergence_subset[OF nil_prop]
              unfolding * list.set rstates = V ` reachable_states M1
              by (metis Un_empty_right Un_insert_right Un_upper1 insertI1 insert_subsetI)
            ultimately show ?thesis
              by simp 
          next
            case (snoc γ' xy)
            moreover obtain x y where "xy = (x,y)" 
              using prod.exhaust by metis
            ultimately have "γ = γ'@[(x,y)]"
              by auto

            have *: "(V ` reachable_states M1  {u @ ω' |ω'. ω'  list.set (prefixes γ)})  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes γ)})"
              by blast

            have "length (γ' @ [(x, y)])  l"
              using assm unfolding l_def γ = γ'@[(x,y)] by auto
            moreover have "γ'  LS M1 (after_initial M1 u)"
              using assm unfolding l_def γ = γ'@[(x,y)]
              by (simp add: after_initial M1 u = t_target t) 
            moreover have "x  FSM.inputs M1" and "y  FSM.outputs M1"
              using assm unfolding γ = γ'@[(x,y)] by auto
            ultimately show ?thesis
              using cons_prop[of γ' x y] preserves_divergence_subset[of M1 M2 "(V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes γ)})", OF _ *]
              unfolding γ = γ'@[(x,y)][symmetric] u_def[symmetric] list.set rstates = V ` reachable_states M1
              by blast
          qed 
        qed
        then show ?thesis
          using convergence_graph_lookup_invar M1 M2 cg_lookup (snd ?TG)
          by presburger
      next
        case False

        then have "?TG = (TH,GH)"
          unfolding TG_cases by auto

        have pass_TH: "L M1  set TH = L M2  set TH"
          using a17 unfolding ?TG = (TH,GH) by auto

        have "converge M1 u u"
          using u  L M1 by auto

        have cons_prop: "γ x y.
                           length (γ @ [(x, y)])  l 
                           γ  LS M1 (t_target t) 
                           x  FSM.inputs M1 
                           y  FSM.outputs M1 
                           L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, u}  ω'  list.set (prefixes (γ @ [(x, y)]))}) =
                           L M2  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, u}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
                           preserves_divergence M1 M2 (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, u}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
        and  nil_prop: "preserves_divergence M1 M2 (V ` reachable_states M1  {u,u})"  
        and  "convergence_graph_lookup_invar M1 M2 cg_lookup (snd ?TG)"
          using pass_TH
          using distinguish_from_set_properties[OF a01 a02 a03 a04 a07 a08 a09 V ` reachable_states M1  list.set rstates preserves_divergence M1 M2 (list.set rstates) (w. w  list.set rstates  w'. converge M1 w w'  converge M2 w w') converge M1 u u u  L M2 u  L M2 convergence_graph_lookup_invar M1 M2 cg_lookup G1 a15 assms, of T1 k l b heuristic, OF _ _ _ _ _ heuristic_prop ]
          unfolding ?TG = (TH,GH) snd_conv
          unfolding GH_def TH_def list.set rstates = V ` reachable_states M1 after_initial M1 u = t_target t 
          by presburger+

        have " γ . (length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))
                       ((L M1  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})
                            = L M2  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)}))
                            preserves_divergence M1 M2 (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)}))"
          (is " γ . (length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))  ?P1 γ  ?P2 γ")          
        proof -
          fix γ assume assm:"(length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))"
          show "?P1 γ  ?P2 γ" 
          proof (cases γ rule: rev_cases)
            case Nil
            have *: "(V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})
                        = (V ` reachable_states M1  {u})"
              unfolding u_def[symmetric] list.set rstates = V ` reachable_states M1 Nil by auto

            have "?P1 γ"
              using L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1
                    u  L M1 u  L M2
              unfolding * by blast
            moreover have "?P2 γ"
              using nil_prop
              unfolding * by auto
            ultimately show ?thesis
              by simp 
          next
            case (snoc γ' xy)
            moreover obtain x y where "xy = (x,y)" 
              using prod.exhaust by metis
            ultimately have "γ = γ'@[(x,y)]"
              by auto

            have *: "{ω @ ω' |ω ω'. ω  {u, u}  ω'  list.set (prefixes γ)} = {u @ ω' |ω'. ω'  list.set (prefixes γ)}"
              by blast

            have "length (γ' @ [(x, y)])  l"
              using assm unfolding l_def γ = γ'@[(x,y)] by auto
            moreover have "γ'  LS M1 (t_target t)"
              using assm unfolding l_def γ = γ'@[(x,y)]
              by simp 
            moreover have "x  FSM.inputs M1" and "y  FSM.outputs M1"
              using assm unfolding γ = γ'@[(x,y)] by auto
            ultimately show ?thesis
              using cons_prop[of γ' x y] 
              unfolding γ = γ'@[(x,y)][symmetric] u_def[symmetric] list.set rstates = V ` reachable_states M1 *
              by blast
          qed 
        qed
        then show ?thesis
          using convergence_graph_lookup_invar M1 M2 cg_lookup (snd ?TG)
          by presburger
      qed
    qed


  
    show "?P T G m t X"
      using * ** ***  by blast
  qed
  then show ?thesis
    unfolding handles_transition_def
    by blast
qed







subsubsection ‹Static›

fun traces_to_check :: "('a,'b::linorder,'c::linorder) fsm  'a  nat  ('b×'c) list list" where
  "traces_to_check M q 0 = []" |
  "traces_to_check M q (Suc k) = (let
      ios  = List.product (inputs_as_list M) (outputs_as_list M)
      in concat (map (λ(x,y) . case h_obs M q x y of None  [[(x,y)]] | Some q'  [(x,y)] # (map ((#) (x,y)) (traces_to_check M q' k))) ios))"  

lemma traces_to_check_set :
  fixes M :: "('a,'b::linorder,'c::linorder) fsm"
  assumes "observable M"
  and     "q  states M" 
shows "list.set (traces_to_check M q k) = {(γ @ [(x, y)]) | γ x y . length (γ @ [(x, y)])  k  γ  LS M q  x  inputs M  y  outputs M}"
  using assms(2) proof (induction k arbitrary: q)
  case 0
  then show ?case by auto
next
  case (Suc k)

  define ios where ios: "ios  = List.product (inputs_as_list M) (outputs_as_list M)"
  define f where f: "f = (λ(x,y) . case h_obs M q x y of None  [[(x,y)]] | Some q'  [(x,y)] # (map ((#) (x,y)) (traces_to_check M q' k)))"

  have "list.set ios = inputs M × outputs M"
    using inputs_as_list_set outputs_as_list_set unfolding ios by auto 
  moreover have "traces_to_check M q (Suc k) = concat (map f ios)"
    unfolding f ios by auto
  ultimately have in_ex : " io . io  list.set (traces_to_check M q (Suc k))  ( x y . x  inputs M  y  outputs M  io  list.set (f (x,y)))"
    by auto 

  show ?case
  proof 
    show "list.set (traces_to_check M q (Suc k))  {(γ @ [(x, y)]) | γ x y . length (γ @ [(x, y)])  (Suc k)  γ  LS M q  x  inputs M  y  outputs M}"
    proof 
      fix io assume "io  list.set (traces_to_check M q (Suc k))"
      then obtain x y where "x  inputs M" and "y  outputs M"
                        and "io  list.set (f (x,y))"
        using in_ex by blast

      have "[(x,y)]  {(γ @ [(x, y)]) | γ x y . length (γ @ [(x, y)])  (Suc k)  γ  LS M q  x  inputs M  y  outputs M}" 
      proof -
        have "length ([] @ [(x, y)])  Suc k"
          by auto
        moreover have "[]  LS M q"
          using Suc.prems by auto
        ultimately show ?thesis 
          using x  inputs M y  outputs M by blast
      qed


      show "io  {(γ @ [(x, y)]) | γ x y . length (γ @ [(x, y)])  (Suc k)  γ  LS M q  x  inputs M  y  outputs M}"
      proof (cases "h_obs M q x y")
        case None
        then have "io = [(x,y)]"
          using io  list.set (f (x,y)) unfolding f by auto
        then show ?thesis
          using [(x,y)]  {(γ @ [(x, y)]) | γ x y . length (γ @ [(x, y)])  (Suc k)  γ  LS M q  x  inputs M  y  outputs M}
          by blast
      next
        case (Some q')
        then consider "io = [(x,y)]" | "io  list.set (map ((#) (x,y)) (traces_to_check M q' k))"
          using io  list.set (f (x,y)) unfolding f by auto
        then show ?thesis proof cases
          case 1
          then show ?thesis
            using [(x,y)]  {(γ @ [(x, y)]) | γ x y . length (γ @ [(x, y)])  (Suc k)  γ  LS M q  x  inputs M  y  outputs M}
            by blast
        next
          case 2
          then obtain io' where "io = (x,y)#io'" and "io'  list.set (traces_to_check M q' k)"
            by auto
          then have "io'  {(γ @ [(x, y)]) | γ x y . length (γ @ [(x, y)])  k  γ  LS M q'  x  inputs M  y  outputs M}"
            using Suc.IH[OF h_obs_state[OF Some]] by blast
          then obtain γ x' y' where "io' = (γ @ [(x', y')])" and "length (γ @ [(x', y')])  k" and "γ  LS M q'" and "x'  inputs M" and "y'  outputs M"
            by auto
  
          have "length (((x,y)#γ) @ [(x', y')])  Suc k"
            using length (γ @ [(x', y')])  k by auto
          moreover have "((x,y)#γ)  LS M q"
            using γ  LS M q' Some assms(1)
            by (meson h_obs_language_iff) 
          ultimately show ?thesis 
            using x'  inputs M y'  outputs M unfolding io = (x,y)#io' io' = (γ @ [(x', y')])
            by auto
        qed
      qed
    qed

    show "{γ @ [(x, y)] |γ x y. length (γ @ [(x, y)])  Suc k  γ  LS M q  x  FSM.inputs M  y  FSM.outputs M}  list.set (traces_to_check M q (Suc k))"
    proof 
      fix io assume "io  {γ @ [(x, y)] |γ x y. length (γ @ [(x, y)])  Suc k  γ  LS M q  x  FSM.inputs M  y  FSM.outputs M}"
      then obtain γ x' y' where "io = (γ @ [(x', y')])" and "length (γ @ [(x', y')])  Suc k" and "γ  LS M q" and "x'  inputs M" and "y'  outputs M"
        by auto
      show "io  list.set (traces_to_check M q (Suc k))"
      proof (cases γ)
        case Nil
        then have "io = [(x',y')]"
          using io = (γ @ [(x', y')]) by auto
        have "io  list.set (f (x',y'))"
          unfolding f case_prod_conv io = [(x',y')] 
          by (cases "FSM.h_obs M q x' y'"; auto)
        then show ?thesis 
          using in_ex[of io] x'  inputs M y'  outputs M by blast
      next
        case (Cons xy γ')

        obtain x y where "xy = (x,y)"
          using prod.exhaust by metis

        obtain q' where "h_obs M q x y = Some q'"  and "x  inputs M" and "y  outputs M" and "γ'  LS M q'"
          using γ  LS M q unfolding Cons xy = (x,y)
          by (meson assms(1) h_obs_language_iff language_io(1) language_io(2) list.set_intros(1))
        then have "γ'@[(x',y')]  {γ @ [(x, y)] |γ x y. length (γ @ [(x, y)])  k  γ  LS M q'  x  FSM.inputs M  y  FSM.outputs M}"
          using length (γ @ [(x', y')])  Suc k x'  inputs M y'  outputs M unfolding Cons by auto
        then have "γ'@[(x',y')]  list.set (traces_to_check M q' k)"
          using Suc.IH[OF h_obs_state[OF h_obs M q x y = Some q']] by blast
        then have "io  list.set (f (x,y))"
          unfolding f case_prod_conv h_obs M q x y = Some q' unfolding io = (γ @ [(x', y')]) Cons xy = (x,y)
          by auto
        then show ?thesis 
          using in_ex[of io] x  inputs M y  outputs M by blast
      qed
    qed
  qed
qed 

fun establish_convergence_static :: "(nat  'a  ('b×'c) prefix_tree)  
                                  ('a::linorder,'b::linorder,'c::linorder) fsm  
                                  ('a,'b,'c) state_cover_assignment  
                                  ('b×'c) prefix_tree  
                                  'd  
                                  ('d  ('b×'c) list  'd)  
                                  ('d  ('b×'c) list  ('b×'c) list list)  
                                  nat  
                                  ('a,'b,'c) transition  
                                  (('b×'c) prefix_tree × 'd)" 
  where
  "establish_convergence_static dist_fun M V T G cg_insert cg_lookup m t =
    (let 
        α = V (t_source t);
        xy = (t_input t, t_output t);
        β = V (t_target t);
        qSource = (after_initial M (V (t_source t)));
        qTarget = (after_initial M (V (t_target t)));
        k = m - size_r M;
        ttc = [] # traces_to_check M qTarget k;
        handleTrace = (λ (T,G) u . 
          if is_in_language M qTarget u 
            then let
                qu = FSM.after M qTarget u; 
                ws = sorted_list_of_maximal_sequences_in_tree (dist_fun (Suc (length u)) qu);
                appendDistTrace = (λ (T,G) w . let
                                                  (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M)
                                                in distribute_extension M T' G' cg_lookup cg_insert β (u@w) False (append_heuristic_input M))
                in foldl appendDistTrace (T,G) ws
            else let
                  (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u) False (append_heuristic_input M)
                 in distribute_extension M T' G' cg_lookup cg_insert β u False (append_heuristic_input M))
    in 
      foldl handleTrace (T,G) ttc)"



lemma appendDistTrace_subset_helper :
  assumes "appendDistTrace = (λ (T,G) w . let
                                            (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M)
                                            in distribute_extension M T' G' cg_lookup cg_insert β (u@w) False (append_heuristic_input M))"
shows "set T  set (fst (appendDistTrace (T,G) w))"
proof -
  obtain T' G' where ***: "distribute_extension M T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M) = (T',G')"
    using prod.exhaust by metis

  show "set T  set (fst (appendDistTrace (T,G) w))"            
    using distribute_extension_subset[of T M G cg_lookup cg_insert α "xy#u@w" False "(append_heuristic_input M)"]
    using distribute_extension_subset[of T' M G' cg_lookup cg_insert β "u@w" False "(append_heuristic_input M)"]
    unfolding assms case_prod_conv *** Let_def fst_conv 
    by blast
qed

lemma handleTrace_subset_helper :
  assumes "handleTrace = (λ (T,G) u . 
          if is_in_language M qTarget u 
            then let
                qu = FSM.after M qTarget u; 
                ws = sorted_list_of_maximal_sequences_in_tree (dist_fun (Suc (length u)) qu);
                appendDistTrace = (λ (T,G) w . let
                                                  (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M)
                                                in distribute_extension M T' G' cg_lookup cg_insert β (u@w) False (append_heuristic_input M))
                in foldl appendDistTrace (T,G) ws               
            else let
                (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u) False (append_heuristic_input M)
                in distribute_extension M T' G' cg_lookup cg_insert β u False (append_heuristic_input M))"
shows "set T  set (fst (handleTrace (T,G) u))"
proof (cases "is_in_language M qTarget u")
  case True

  define qu where qu: "qu = FSM.after M qTarget u"
  define ws where ws: "ws = sorted_list_of_maximal_sequences_in_tree (dist_fun (Suc (length u)) qu)"
  define appendDistTrace where appendDistTrace: "appendDistTrace = (λ (T,G) w . let
                                            (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M)
                                            in distribute_extension M T' G' cg_lookup cg_insert β (u@w) False (append_heuristic_input M))"

  have **: "handleTrace (T,G) u = foldl appendDistTrace (T,G) ws"
    unfolding qu ws appendDistTrace Let_def case_prod_conv assms using True by force

  show ?thesis
    using appendDistTrace_subset_helper[OF appendDistTrace]
    unfolding ** 
    apply (induction ws rule: rev_induct; simp)
    by (metis (no_types, opaque_lifting) Collect_mono_iff fst_conv old.prod.exhaust) 
next
  case False

  obtain T' G' where ***: "distribute_extension M T G cg_lookup cg_insert α (xy#u) False (append_heuristic_input M) = (T',G')"
      using prod.exhaust by metis

  show "set T  set (fst (handleTrace (T, G) u))"            
    using distribute_extension_subset[of T M G cg_lookup cg_insert α "xy#u" False "(append_heuristic_input M)"]
    using distribute_extension_subset[of T' M G' cg_lookup cg_insert β "u" False "(append_heuristic_input M)"]
    using False
    unfolding case_prod_conv *** Let_def fst_conv assms 
    by force
qed


lemma establish_convergence_static_subset :
  "set T  set (fst (establish_convergence_static dist_fun M V T G cg_insert cg_lookup m t))"
proof -
  define α where α: "α = V (t_source t)"
  define xy where xy: "xy = (t_input t, t_output t)"
  define β where β: "β = V (t_target t)"
  define qSource where qSource: "qSource = (after_initial M (V (t_source t)))"
  define qTarget where qTarget: "qTarget = (after_initial M (V (t_target t)))"
  define k where k: "k = m - size_r M"
  define ttc where ttc : "ttc = [] # traces_to_check M qTarget k"
  define handleTrace where handleTrace: "handleTrace = (λ (T,G) u . 
          if is_in_language M qTarget u 
            then let
                qu = FSM.after M qTarget u; 
                ws = sorted_list_of_maximal_sequences_in_tree (dist_fun (Suc (length u)) qu);
                appendDistTrace = (λ (T,G) w . let
                                                  (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M)
                                                in distribute_extension M T' G' cg_lookup cg_insert β (u@w) False (append_heuristic_input M))
                in foldl appendDistTrace (T,G) ws
            else let
                (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u) False (append_heuristic_input M)
                in distribute_extension M T' G' cg_lookup cg_insert β u False (append_heuristic_input M))"

  have *:"establish_convergence_static dist_fun M V T G cg_insert cg_lookup m t = foldl handleTrace (T,G) ttc"
    unfolding establish_convergence_static.simps α xy β qSource qTarget k ttc handleTrace Let_def by force

  
  show ?thesis
    unfolding * proof (induction ttc rule: rev_induct)
    case Nil
    then show ?case by auto
  next
    case (snoc io ttc)

    have *:"foldl handleTrace (T, G) (ttc@[io]) = handleTrace (foldl handleTrace (T,G) ttc) io"
      by auto

    have " u T G . set T  set (fst (handleTrace (T,G) u))"
      using handleTrace_subset_helper[of handleTrace] handleTrace
      unfolding α xy β qSource qTarget k ttc by blast
    then show ?case
      unfolding *
      by (metis (no_types, opaque_lifting) snoc.IH dual_order.trans fst_conv old.prod.exhaust) 
  qed
qed


lemma establish_convergence_static_finite :
  fixes M :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  assumes "finite_tree T"
shows "finite_tree (fst (establish_convergence_static dist_fun M V T G cg_insert cg_lookup m t))"
proof -
  define α where α: "α = V (t_source t)"
  define xy where xy: "xy = (t_input t, t_output t)"
  define β where β: "β = V (t_target t)"
  define qSource where qSource: "qSource = (after_initial M (V (t_source t)))"
  define qTarget where qTarget: "qTarget = (after_initial M (V (t_target t)))"
  define k where k: "k = m - size_r M"
  define ttc where ttc : "ttc = [] # traces_to_check M qTarget k"
  define handleTrace where handleTrace: "handleTrace = (λ (T,G) u . 
          if is_in_language M qTarget u 
            then let
                qu = FSM.after M qTarget u; 
                ws = sorted_list_of_maximal_sequences_in_tree (dist_fun (Suc (length u)) qu);
                appendDistTrace = (λ (T,G) w . let
                                                  (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M)
                                                in distribute_extension M T' G' cg_lookup cg_insert β (u@w) False (append_heuristic_input M))
                in foldl appendDistTrace (T,G) ws                
            else let
                (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u) False (append_heuristic_input M)
                in distribute_extension M T' G' cg_lookup cg_insert β u False (append_heuristic_input M))"

  have *:"establish_convergence_static dist_fun M V T G cg_insert cg_lookup m t = foldl handleTrace (T,G) ttc"
    unfolding establish_convergence_static.simps α xy β qSource qTarget k ttc handleTrace Let_def by force

  
  show ?thesis
    unfolding * proof (induction ttc rule: rev_induct)
    case Nil
    then show ?case using assms by auto
  next
    case (snoc io ttc)

    have *:"foldl handleTrace (T, G) (ttc@[io]) = handleTrace (foldl handleTrace (T,G) ttc) io"
      by auto

    have " u T G . finite_tree T  finite_tree (fst (handleTrace (T,G) u))"
    proof -
      fix T :: "('b×'c) prefix_tree"
      fix u G assume "finite_tree T"
      show "finite_tree (fst (handleTrace (T,G) u))" proof (cases "is_in_language M qTarget u")
        case True

        define qu where qu: "qu = FSM.after M qTarget u"
        define ws where ws: "ws = sorted_list_of_maximal_sequences_in_tree (dist_fun (Suc (length u)) qu)"
        define appendDistTrace where appendDistTrace: "appendDistTrace = (λ (T,G) w . let
                                                  (T',G') = distribute_extension M T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M)
                                                  in distribute_extension M T' G' cg_lookup cg_insert β (u@w) False (append_heuristic_input M))"

        have **: "handleTrace (T,G) u = foldl appendDistTrace (T,G) ws"
          unfolding handleTrace qu ws appendDistTrace Let_def case_prod_conv using True by force

        have " w T G . finite_tree T  finite_tree (fst (appendDistTrace (T,G) w))"
        proof -
          fix T :: "('b×'c) prefix_tree"
          fix w G assume "finite_tree T"

          obtain T' G' where ***: "distribute_extension M T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M) = (T',G')"
            using prod.exhaust by metis

          show "finite_tree (fst (appendDistTrace (T,G) w))"            
            using distribute_extension_finite[of T M G cg_lookup cg_insert α "xy#u@w" False "(append_heuristic_input M)", OF finite_tree T]
            using distribute_extension_finite[of T' M G' cg_lookup cg_insert β "u@w" False "(append_heuristic_input M)"]
            unfolding appendDistTrace case_prod_conv *** Let_def fst_conv 
            by blast
        qed
        then show ?thesis
          unfolding ** using finite_tree T
          apply (induction ws rule: rev_induct; simp)
          by (metis (no_types, opaque_lifting) fst_conv old.prod.exhaust) 
      next
        case False

        obtain T' G' where ***: "distribute_extension M T G cg_lookup cg_insert α (xy#u) False (append_heuristic_input M) = (T',G')"
            using prod.exhaust by metis

        show "finite_tree (fst (handleTrace (T, G) u))"            
          using distribute_extension_finite[of T M G cg_lookup cg_insert α "xy#u" False "(append_heuristic_input M)", OF finite_tree T]
          using distribute_extension_finite[of T' M G' cg_lookup cg_insert β "u" False "(append_heuristic_input M)"]
          using False
          unfolding case_prod_conv *** Let_def fst_conv handleTrace 
          by force
      qed
    qed

    then show ?case
      unfolding *
      by (metis (no_types, opaque_lifting) snoc.IH fst_conv old.prod.exhaust) 
  qed
qed


lemma establish_convergence_static_properties :
  assumes "observable M1"
      and "observable M2"
      and "minimal M1"
      and "minimal M2"
      and "inputs M2 = inputs M1"
      and "outputs M2 = outputs M1"
      and "t  transitions M1"
      and "t_source t  reachable_states M1"
      and "is_state_cover_assignment M1 V"
      and "V (t_source t) @ [(t_input t, t_output t)]  L M2"
      and "V ` reachable_states M1  set T"
      and "preserves_divergence M1 M2 (V ` reachable_states M1)"
      and "convergence_graph_lookup_invar M1 M2 cg_lookup G"
      and "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
      and " q1 q2 . q1  states M1  q2  states M1  q1  q2   io .  k1 k2 . io  set (dist_fun k1 q1)  set (dist_fun k2 q2)  distinguishes M1 q1 q2 io"
      and " q . q  reachable_states M1  set (dist_fun 0 q)  set (after T (V q))"
      and " q k . q  states M1  finite_tree (dist_fun k q)"
      and "L M1  set (fst (establish_convergence_static dist_fun M1 V T G cg_insert cg_lookup m t)) = L M2  set (fst (establish_convergence_static dist_fun M1 V T G cg_insert cg_lookup m t))"
shows " γ x y . length (γ@[(x,y)])  m - size_r M1 
                  γ  LS M1 (after_initial M1 (V (t_source t) @ [(t_input t, t_output t)])) 
                  x  inputs M1  y  outputs M1 
                  L M1  ((V ` reachable_states M1)  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))}) = L M2   ((V ` reachable_states M1)  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))})
                   preserves_divergence M1 M2 ((V ` reachable_states M1)  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))})"
(is "?P1a")
and   "preserves_divergence M1 M2 ((V ` reachable_states M1)  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))})"
(is "?P1b")
and   "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (establish_convergence_static dist_fun M1 V T G cg_insert cg_lookup m t))"
(is "?P2")
proof -

  
  define α where α: "α = V (t_source t)"
  define xy where xy: "xy = (t_input t, t_output t)"
  define β where β: "β = V (t_target t)"
  define qSource where qSource: "qSource = (after_initial M1 (V (t_source t)))"
  define qTarget where qTarget: "qTarget = (after_initial M1 (V (t_target t)))"
  define k where k: "k = m - size_r M1"
  define ttc where ttc : "ttc = [] # traces_to_check M1 qTarget k"
  define handleTrace where handleTrace: "handleTrace = (λ (T,G) u . 
          if is_in_language M1 qTarget u 
            then let
                qu = FSM.after M1 qTarget u; 
                ws = sorted_list_of_maximal_sequences_in_tree (dist_fun (Suc (length u)) qu);
                appendDistTrace = (λ (T,G) w . let
                                                  (T',G') = distribute_extension M1 T G cg_lookup cg_insert α (xy#u@w) False (append_heuristic_input M1)
                                                in distribute_extension M1 T' G' cg_lookup cg_insert β (u@w) False (append_heuristic_input M1))
                in foldl appendDistTrace (T,G) ws                
            else let
                (T',G') = distribute_extension M1 T G cg_lookup cg_insert α (xy#u) False (append_heuristic_input M1)
                in distribute_extension M1 T' G' cg_lookup cg_insert β u False (append_heuristic_input M1))"


  have result: "establish_convergence_static dist_fun M1 V T G cg_insert cg_lookup m t = foldl handleTrace (T,G) ttc"
    unfolding establish_convergence_static.simps α xy β qSource qTarget k ttc handleTrace Let_def by force
  then have result_pass: "L M1  set (fst (foldl handleTrace (T,G) ttc)) = L M2  set (fst (foldl handleTrace (T,G) ttc))"
    using assms(18) by auto

  have "V (t_source t)  L M1" and "t_source t = qSource"
    using state_cover_assignment_after[OF assms(1,9,8)] unfolding qSource by auto
  then have "qSource  states M1"
    unfolding qSource
    by (simp add: assms(8) reachable_state_is_state) 
  have "α  L M1"
    using V (t_source t)  L M1 unfolding α by auto
  have "α  L M2"
    by (metis α assms(10) language_prefix)


  have "qTarget  reachable_states M1"
    using reachable_states_next[OF assms(8,7)] unfolding qTarget
    by (metis assms(1) assms(9) is_state_cover_assignment_observable_after) 
  then have "qTarget  states M1"
    using reachable_state_is_state by metis
  have "V (t_target t)  L M1"
    by (meson assms(7) assms(8) assms(9) is_state_cover_assignment_language reachable_states_next) 
  then have "β  L M1"
    unfolding β by auto
  have "t_target t = qTarget"
    by (metis assms(1) assms(7) assms(8) assms(9) is_state_cover_assignment_observable_after qTarget reachable_states_next)
  have "converge M1 (α@[xy]) β"
    using state_cover_transition_converges[OF assms(1,9,7,8)]
    unfolding α xy β .
  then have "α@[xy]  L M1"
    by auto

  have "L M1  set T = L M2  set T"
    using assms(18) establish_convergence_static_subset[of T dist_fun M1 V G cg_insert cg_lookup m t]
    by blast
  then have "β  L M2"
    using reachable_states_next[OF assms(8,7)] assms(11) β  L M1
    unfolding β qTarget by blast   

  have "( u w . u  list.set ttc  u  LS M1 qTarget  w  set (dist_fun (Suc (length u)) (FSM.after M1 qTarget u))  L M1  {α @ [xy] @ u @ w, β @ u @ w} = L M2  {α @ [xy] @ u @ w, β @ u @ w})
         ( u w . u  list.set ttc  u  LS M1 qTarget  L M1  {α@[xy]@u,β@u} = L M2  {α@[xy]@u,β@u})
         (convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleTrace (T,G) ttc)))"
    using result_pass
  proof (induction ttc rule: rev_induct)
    case Nil
    then show ?case using assms(13) by auto
  next
    case (snoc a ttc)

    have *:"foldl handleTrace (T, G) (ttc@[a]) = handleTrace (foldl handleTrace (T,G) ttc) a"
      by auto
    have "L M1  Prefix_Tree.set (fst (foldl handleTrace (T, G) ttc)) = L M2  Prefix_Tree.set (fst (foldl handleTrace (T, G) ttc))"
      using snoc.prems handleTrace_subset_helper[of handleTrace M1 qTarget dist_fun cg_lookup cg_insert, OF handleTrace]
      unfolding *
      by (metis (no_types, opaque_lifting) fst_conv inter_eq_subsetI old.prod.exhaust)
    then have IH1: " u w. u  list.set ttc  u  LS M1 qTarget  w  Prefix_Tree.set (dist_fun (Suc (length u)) (FSM.after M1 qTarget u))  L M1  {α @ [xy] @ u @ w, β @ u @ w} = L M2  {α @ [xy] @ u @ w, β @ u @ w}"
          and IH2: "u w. u  list.set ttc  u  LS M1 qTarget  L M1  {α @ [xy] @ u, β @ u} = L M2  {α @ [xy] @ u, β @ u}"
          and IH3: "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleTrace (T, G) ttc))"
      using snoc.IH
      by presburger+


    show ?case proof (cases "is_in_language M1 qTarget a")
      case True

      define qa where qa: "qa = FSM.after M1 qTarget a"
      define ws where ws: "ws = sorted_list_of_maximal_sequences_in_tree (dist_fun (Suc (length a)) qa)"
      define appendDistTrace where appendDistTrace: "appendDistTrace = (λ (T,G) w . let
                                                (T',G') = distribute_extension M1 T G cg_lookup cg_insert α (xy#a@w) False (append_heuristic_input M1)
                                                in distribute_extension M1 T' G' cg_lookup cg_insert β (a@w) False (append_heuristic_input M1))"


      have **: " TG . handleTrace TG a = foldl appendDistTrace TG ws"
        using is_in_language M1 qTarget a 
        unfolding qa ws appendDistTrace Let_def case_prod_conv assms True handleTrace by force
      have "foldl handleTrace (T, G) (ttc@[a]) = foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws"
        unfolding *  
        unfolding True 
        unfolding ** by auto
      then have "L M1  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws)) = L M2  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws))"
        using snoc.prems by metis

      then have handleTrace_props: "( w . w  list.set ws  (( α' . converge M1 α α'  (α'@[xy]@a@w)  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws))  converge M2 α α')
                                         ( β' . converge M1 β β'  (β'@a@w)  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws))  converge M2 β β')))
             convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws))"
      proof (induction ws rule: rev_induct)
        case Nil
        then show ?case using IH3 by auto
      next
        case (snoc v ws)

        have *:"foldl appendDistTrace (foldl handleTrace (T, G) ttc) (ws@[v]) = appendDistTrace (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws) v"
          by auto

            
        define Tws where Tws: "Tws = fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws)"
        define Gws where Gws: "Gws = snd (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws)"

        have "(foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws) = (Tws,Gws)"
          unfolding Tws Gws by auto

        obtain T' G' where "distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1) = (T',G')"
          using prod.exhaust by metis

        have **: "appendDistTrace (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws) v
                = distribute_extension M1 T' G' cg_lookup cg_insert β (a@v) False (append_heuristic_input M1)"
          using distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy # a @ v) False (append_heuristic_input M1) = (T', G') foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws = (Tws, Gws) appendDistTrace by auto 

        have pass_outer : "L M1  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert β (a@v) False (append_heuristic_input M1)))
                            = L M2  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert β (a@v) False (append_heuristic_input M1)))"  
          using snoc.prems unfolding * ** .
        moreover have "set (fst (distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1)))  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert β (a@v) False (append_heuristic_input M1)))"
          using distribute_extension_subset[of T' M1 G' cg_lookup cg_insert β "(a@v)" False "(append_heuristic_input M1)"]
          using distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1) = (T',G')
          by (metis fst_conv)
        ultimately have pass_inner: "L M1  set (fst (distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1)))
                            = L M2  set (fst (distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1)))"  
          by blast
        then have pass_ws: "L M1  Prefix_Tree.set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws)) =
                              L M2  Prefix_Tree.set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws))"
          using distribute_extension_subset[of Tws M1 Gws cg_lookup cg_insert]
          unfolding Tws Gws
          by blast


        have "set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws))  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) (ws@[v])))"
          using appendDistTrace_subset_helper[OF appendDistTrace]
          by (metis "*" Tws foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws = (Tws, Gws))  

        have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws))"
          using snoc.IH[OF pass_ws ] by auto
        then have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1)))"
          using distribute_extension_adds_sequence(2)[OF assms(1,3) α  L M1 α  L M2 _ assms(14) pass_inner append_heuristic_input_in]
          unfolding Gws by blast
        then have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (appendDistTrace (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws) v))"
          unfolding ** distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1) = (T',G') snd_conv
          using distribute_extension_adds_sequence(2)[OF assms(1,3) β  L M1 β  L M2 _ assms(14) pass_outer append_heuristic_input_in]
          by blast
        moreover have " w . w  list.set (ws@[v])  (( α' . converge M1 α α'  (α'@[xy]@a@w)  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) (ws@[v])))  converge M2 α α')
                                         ( β' . converge M1 β β'  (β'@a@w)  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) (ws@[v])))  converge M2 β β'))"
        proof -
          fix w assume "w  list.set (ws@[v])"
          then consider "w  list.set ws" | "v = w"
            by auto
          then show "(( α' . converge M1 α α'  (α'@[xy]@a@w)  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) (ws@[v])))  converge M2 α α')
                                         ( β' . converge M1 β β'  (β'@a@w)  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) (ws@[v])))  converge M2 β β'))"
          proof cases
            case 1
            then show ?thesis using snoc.IH[OF pass_ws] 
              using set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws))  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) (ws@[v])))
              by blast
          next
            case 2

            have "u'. converge M1 α u'  u' @ xy # a @ w  set T'  converge M2 α u'"
              using distribute_extension_adds_sequence(1)[OF assms(1,3) α  L M1 α  L M2 _ assms(14) pass_inner append_heuristic_input_in]
                    convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl appendDistTrace (foldl handleTrace (T, G) ttc) ws))
              unfolding Gws[symmetric] 
              unfolding distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1) = (T',G')  
              unfolding 2 fst_conv
              by blast
            then have "( α' . converge M1 α α'  (α'@[xy]@a@w)  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) (ws@[v])))  converge M2 α α')"
              using "**" Prefix_Tree.set (fst (distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy # a @ v) False (append_heuristic_input M1)))  Prefix_Tree.set (fst (distribute_extension M1 T' G' cg_lookup cg_insert β (a @ v) False (append_heuristic_input M1))) distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy # a @ v) False (append_heuristic_input M1) = (T', G') by auto
            moreover have "( β' . converge M1 β β'  (β'@a@w)  set (fst (foldl appendDistTrace (foldl handleTrace (T, G) ttc) (ws@[v])))  converge M2 β β')"
              using distribute_extension_adds_sequence(1)[OF assms(1,3) β  L M1 β  L M2 _ assms(14) pass_outer append_heuristic_input_in]
              using convergence_graph_lookup_invar M1 M2 cg_lookup (snd (distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1)))
              unfolding distribute_extension M1 Tws Gws cg_lookup cg_insert α (xy#a@v) False (append_heuristic_input M1) = (T',G') snd_conv
              unfolding * ** 
              unfolding 2
              by blast
            ultimately show ?thesis by blast
          qed
        qed
        ultimately show ?case 
          by fastforce
      qed

      have " u w. u  list.set (ttc@[a])  u  LS M1 qTarget  w  Prefix_Tree.set (dist_fun (Suc (length u)) (FSM.after M1 qTarget u))  L M1  {α @ [xy] @ u @ w, β @ u @ w} = L M2  {α @ [xy] @ u @ w, β @ u @ w}"
      proof -
        fix u w assume "u  list.set (ttc@[a])" and a1:"u  LS M1 qTarget" and a2:"w  Prefix_Tree.set (dist_fun (Suc (length u)) (FSM.after M1 qTarget u))"
        then consider "u  list.set ttc" | "a = u"
          by auto
        then show "L M1  {α @ [xy] @ u @ w, β @ u @ w} = L M2  {α @ [xy] @ u @ w, β @ u @ w}" 
        proof cases
          case 1
          then show ?thesis 
            using IH1[OF _ a1 a2] by blast
        next
          case 2

          obtain w' where "w@w'  list.set ws"
          proof -
            have "qa  reachable_states M1"
              using qTarget  reachable_states M1 u  LS M1 qTarget
              by (metis "2" after_reachable assms(1) qa)
            then have "finite_tree (dist_fun (Suc (length u)) qa)"  
              using  q k . q  states M1  finite_tree (dist_fun k q) reachable_state_is_state[of qa M1]
              by blast
            moreover have "w  set (dist_fun (Suc (length u)) qa)"
              using w  set (dist_fun (Suc (length u)) (FSM.after M1 qTarget u))
              unfolding qa 2 .
            ultimately show ?thesis
              using sorted_list_of_maximal_sequences_in_tree_ob[of "dist_fun (Suc (length u)) qa" w]
              using that unfolding ws 2 by blast
          qed
          then obtain α' β' where "converge M1 α α'" and "α' @ [xy] @ a @ w@w'  Prefix_Tree.set (fst (foldl handleTrace (T, G) (ttc@[a])))" and "converge M2 α α'"
                               and "converge M1 β β'" and "β' @ a @ w@w'  Prefix_Tree.set (fst (foldl handleTrace (T, G) (ttc@[a])))" and "converge M2 β β'"
            using handleTrace_props
            unfolding **[symmetric] *[symmetric]
            by blast
          then have "α' @ [xy] @ a @ w  Prefix_Tree.set (fst (foldl handleTrace (T, G) (ttc@[u])))"
                and "β' @ a @ w  Prefix_Tree.set (fst (foldl handleTrace (T, G) (ttc@[u])))"
            using set_prefix[of "α' @ [xy] @ a @ w" w']
            using set_prefix[of "β' @ a @ w" w']
            unfolding 2
            by auto

          
          have "α @ [xy] @ u @ w  L M1 = (α' @ [xy] @ u @ w  L M1)"
            using converge M1 α α'
            using assms(1) converge_append_language_iff by blast
          also have " = (α' @ [xy] @ u @ w  L M2)"
            using α' @ [xy] @ a @ w  Prefix_Tree.set (fst (foldl handleTrace (T, G) (ttc@[u])))
            using snoc.prems unfolding 2
            by blast
          also have " = (α @ [xy] @ u @ w  L M2)"
            using converge M2 α α'
            using assms(2) converge_append_language_iff by blast
          finally have "α @ [xy] @ u @ w  L M1 = (α @ [xy] @ u @ w  L M2)" .

          have "β @ u @ w  L M1 = (β' @ u @ w  L M1)"
            using converge M1 β β'
            using assms(1) converge_append_language_iff by blast
          also have " = (β' @ u @ w  L M2)"
            using β' @ a @ w  Prefix_Tree.set (fst (foldl handleTrace (T, G) (ttc@[u])))
            using snoc.prems unfolding 2
            by blast
          also have " = (β @ u @ w  L M2)"
            using converge M2 β β'
            using assms(2) converge_append_language_iff by blast
          finally have "β @ u @ w  L M1 = (β @ u @ w  L M2)" .

          then show ?thesis
            using α @ [xy] @ u @ w  L M1 = (α @ [xy] @ u @ w  L M2) 
            by blast
        qed 
      qed
      moreover have " u w . u  list.set (ttc@[a])  u  LS M1 qTarget  L M1  {α @ [xy] @ u, β @ u} = L M2  {α @ [xy] @ u, β @ u}"
      proof -
        fix u w assume "u  list.set (ttc@[a])" and "u  LS M1 qTarget"

        then have "u  a"
          using True 
          unfolding is_in_language_iff[OF assms(1) qTarget  states M1]
          by auto
        then have "u  list.set ttc"
          using u  list.set (ttc@[a]) by auto
        then show "L M1  {α @ [xy] @ u, β @ u} = L M2  {α @ [xy] @ u, β @ u}"
          using IH2[OF _ u  LS M1 qTarget] by blast
      qed
      moreover have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleTrace (T, G) (ttc@[a])))"
        using handleTrace_props unfolding * ** by blast
      ultimately show ?thesis
        by blast
    next
      case False

      define Tc where Tc: "Tc = fst (foldl handleTrace (T, G) ttc)"
      define Gc where Gc: "Gc = snd (foldl handleTrace (T, G) ttc)"

      have "(foldl handleTrace (T, G) ttc) = (Tc,Gc)"
        unfolding Tc Gc by auto

      define T' where T': "T' = fst (distribute_extension M1 Tc Gc cg_lookup cg_insert α (xy#a) False (append_heuristic_input M1))"
      define G' where G': "G' = snd (distribute_extension M1 Tc Gc cg_lookup cg_insert α (xy#a) False (append_heuristic_input M1))"

      have **: "handleTrace (foldl handleTrace (T,G) ttc) a = distribute_extension M1 T' G' cg_lookup cg_insert β a False (append_heuristic_input M1)"
        using False
        unfolding (foldl handleTrace (T, G) ttc) = (Tc,Gc)
        unfolding handleTrace 
        unfolding case_prod_conv Let_def 
        unfolding T' G' Tc Gc
        by (meson case_prod_beta') 


      have pass_outer : "L M1  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert β a False (append_heuristic_input M1)))
                            = L M2  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert β a False (append_heuristic_input M1)))"  
        using snoc.prems unfolding * ** .
      moreover have "set (fst (distribute_extension M1 Tc Gc cg_lookup cg_insert α (xy#a) False (append_heuristic_input M1)))  set (fst (distribute_extension M1 T' G' cg_lookup cg_insert β (a) False (append_heuristic_input M1)))"
        using distribute_extension_subset[of T' M1 G' cg_lookup cg_insert β "a" False "(append_heuristic_input M1)"]
        using (foldl handleTrace (T, G) ttc) = (Tc,Gc)
        using T' by blast
      ultimately have pass_inner: "L M1  set (fst (distribute_extension M1 Tc Gc cg_lookup cg_insert α (xy#a) False (append_heuristic_input M1)))
                          = L M2  set (fst (distribute_extension M1 Tc Gc cg_lookup cg_insert α (xy#a) False (append_heuristic_input M1)))"  
        by blast
        
      
      have "convergence_graph_lookup_invar M1 M2 cg_lookup Gc"
        using snoc.IH[OF L M1  Prefix_Tree.set (fst (foldl handleTrace (T, G) ttc)) = L M2  Prefix_Tree.set (fst (foldl handleTrace (T, G) ttc))]
        unfolding Gc by blast
      then have "convergence_graph_lookup_invar M1 M2 cg_lookup G'"
        using distribute_extension_adds_sequence(2)[OF assms(1,3) α  L M1 α  L M2 _ assms(14) pass_inner append_heuristic_input_in]
        unfolding G' by blast  
      then have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleTrace (T, G) (ttc@[a])))"
          unfolding * **
          using distribute_extension_adds_sequence(2)[OF assms(1,3) β  L M1 β  L M2 _ assms(14) pass_outer append_heuristic_input_in]
          by blast
      moreover have " u w. u  list.set (ttc@[a])  u  LS M1 qTarget  w  Prefix_Tree.set (dist_fun (Suc (length u)) (FSM.after M1 qTarget u))  L M1  {α @ [xy] @ u @ w, β @ u @ w} = L M2  {α @ [xy] @ u @ w, β @ u @ w}"
      proof -
        fix u w assume "u  list.set (ttc@[a])" and a1:"u  LS M1 qTarget" and a2:"w  Prefix_Tree.set (dist_fun (Suc (length u)) (FSM.after M1 qTarget u))"
        then have "u  a"
          using False 
          unfolding is_in_language_iff[OF assms(1) qTarget  states M1]
          by auto
        then have "u  list.set ttc"
          using u  list.set (ttc@[a]) by auto
        then show "L M1  {α @ [xy] @ u @ w, β @ u @ w} = L M2  {α @ [xy] @ u @ w, β @ u @ w}"
          using IH1[OF _ a1 a2]
          by blast
      qed
      moreover have " u w . u  list.set (ttc@[a])  u  LS M1 qTarget  L M1  {α @ [xy] @ u, β @ u} = L M2  {α @ [xy] @ u, β @ u}"
      proof -
        fix u w assume "u  list.set (ttc@[a])" and "u  LS M1 qTarget"
        then consider "u  list.set ttc" | "a = u"
          by auto
        then show "L M1  {α @ [xy] @ u, β @ u} = L M2  {α @ [xy] @ u, β @ u}" proof cases
          case 1
          then show ?thesis 
            using IH2[OF _ u  LS M1 qTarget] by blast
        next
          case 2

          obtain α' where "converge M1 α α'" and "α' @ xy # a  set (fst (foldl handleTrace (T, G) (ttc@[a])))" and "converge M2 α α'"
            using distribute_extension_adds_sequence(1)[OF assms(1,3) α  L M1 α  L M2 _ assms(14) pass_inner append_heuristic_input_in] convergence_graph_lookup_invar M1 M2 cg_lookup Gc
            unfolding T'[symmetric]
            using distribute_extension_subset[of T' M1 G' cg_lookup cg_insert β "a" False "(append_heuristic_input M1)"] 
            unfolding * ** by blast
          have " α' . α' @ xy # u = α' @ [xy] @ u"
            by auto

          obtain β' where "converge M1 β β'" and "β' @ a  set (fst (foldl handleTrace (T, G) (ttc@[a])))" and "converge M2 β β'"
            using distribute_extension_adds_sequence(1)[OF assms(1,3) β  L M1 β  L M2 _ assms(14) pass_outer append_heuristic_input_in] convergence_graph_lookup_invar M1 M2 cg_lookup G'
            unfolding * ** by blast

          have "α @ [xy] @ u  L M1 = (α' @ [xy] @ u  L M1)"
            using converge M1 α α'
            using assms(1) converge_append_language_iff by blast
          also have " = (α' @ [xy] @ u  L M2)"
            using α' @ xy # a  Prefix_Tree.set (fst (foldl handleTrace (T, G) (ttc@[a])))
            using snoc.prems unfolding 2  α' . α' @ xy # u = α' @ [xy] @ u 
            by blast
          also have " = (α @ [xy] @ u  L M2)"
            using converge M2 α α'
            using assms(2) converge_append_language_iff by blast
          finally have "α @ [xy] @ u  L M1 = (α @ [xy] @ u  L M2)" .

          have "β @ u  L M1 = (β' @ u  L M1)"
            using converge M1 β β'
            using assms(1) converge_append_language_iff by blast
          also have " = (β' @ u  L M2)"
            using β' @ a  Prefix_Tree.set (fst (foldl handleTrace (T, G) (ttc@[a])))
            using snoc.prems unfolding 2
            by blast
          also have " = (β @ u  L M2)"
            using converge M2 β β'
            using assms(2) converge_append_language_iff by blast
          finally have "β @ u  L M1 = (β @ u  L M2)" .
          then show ?thesis
            using α @ [xy] @ u  L M1 = (α @ [xy] @ u  L M2)
            by blast
        qed 
      qed
      ultimately show ?thesis 
        by blast
    qed
  qed

  

  then have handleTrace_foldl_props_1: " u w. u  list.set ttc 
            u  LS M1 qTarget 
            w  Prefix_Tree.set (dist_fun (Suc (length u)) (FSM.after M1 qTarget u)) 
            L M1  {α @ [xy] @ u @ w, β @ u @ w} = L M2  {α @ [xy] @ u @ w, β @ u @ w}"
  and  handleTrace_foldl_props_2: "u w. u  list.set ttc  u  LS M1 qTarget  L M1  {α @ [xy] @ u, β @ u} = L M2  {α @ [xy] @ u, β @ u}"
  and  "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (foldl handleTrace (T, G) ttc))"
    by presburger+

  then show "?P2"
    unfolding result by blast

  show "preserves_divergence M1 M2 ((V ` reachable_states M1)  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))})"
  proof -
    let ?w = "((V (t_source t)) @ [(t_input t,t_output t)])"

    

    have "V (t_target t)  (V ` reachable_states M1)"
      by (simp add: qTarget  reachable_states M1 t_target t = qTarget)
    then have "((V ` reachable_states M1)  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}) = Set.insert ((V (t_source t)) @ [(t_input t,t_output t)]) (V ` reachable_states M1)"
      by blast
    moreover have "Set.insert ?w (V ` reachable_states M1)  L M1"
      using state_cover_assignment_language[OF assms(9)]
      using α converge M1 (α @ [xy]) β xy by auto 
    ultimately have *:"L M1  (V ` reachable_states M1  {V (t_source t) @ [(t_input t, t_output t)], V (t_target t)}) = Set.insert ?w (V ` reachable_states M1)"
                and **:"L M1  (V ` reachable_states M1) = (V ` reachable_states M1)"
      by blast+

    have " u . u  Set.insert ?w (V ` reachable_states M1)  ¬converge M1 u ?w  ¬converge M2 u ?w"
    proof -
      fix u assume "u  Set.insert ?w (V ` reachable_states M1)" and "¬converge M1 u ?w"
      moreover have "converge M1 ?w ?w"
        using α@[xy]  L M1 unfolding α xy by auto
      ultimately have "u  (V ` reachable_states M1)" 
        by auto
      
      have "¬converge M1 u β"
        using ¬converge M1 u ?w converge M1 (α@[xy]) β unfolding α xy β
        by auto  

      have "β = V qTarget"
        by (simp add: β t_target t = qTarget) 

      obtain qU where "qU  reachable_states M1" and "u = V qU"
        using u  (V ` reachable_states M1) by blast
      then have "qU = after_initial M1 u"
        using state_cover_assignment_after[OF assms(1,9)] by metis
      then have "qU  qTarget"
        using ¬converge M1 u β
        using β β  L M1 t_target t = qTarget u = V qU by fastforce 

      then obtain w where " k1 k2 . w  set (dist_fun k1 qU)  set (dist_fun k2 qTarget)" and "distinguishes M1 qU qTarget w"
        using assms(15)[OF reachable_state_is_state[OF qU  reachable_states M1] qTarget  states M1]
        by blast
      then have "w  set (after T (V qU))" and "w  set (after T (V qTarget))"
        using assms(16)[OF qU  reachable_states M1]
        using assms(16)[OF qTarget  reachable_states M1]
        by blast+


      have "[]  list.set ttc"
        unfolding ttc by auto
      moreover have "[]  LS M1 qTarget"
        using qTarget  states M1 by auto
      moreover have "w  set (dist_fun (Suc (length [])) (FSM.after M1 qTarget []))"
        using  k1 k2 . w  set (dist_fun k1 qU)  set (dist_fun k2 qTarget) by auto
      ultimately have "L M1  {?w @ w, β @ w} = L M2  {?w @ w, β @ w}"
        using handleTrace_foldl_props_1[of "[]" w]
        unfolding α xy
        by auto
      moreover have "(?w @ w  L M1) = (β@w  L M1)"
        using converge_extend[OF assms(1) converge M1 (α@[xy]) β _ β  L M1, of w]
        using converge_extend[OF assms(1) _ _ α@[xy]  L M1, of β w] 
        using converge M1 (α@[xy]) β unfolding converge_sym[where u=β]
        unfolding α[symmetric] xy[symmetric]
        by blast
      ultimately have "(?w @ w  L M2) = (β@w  L M2)"
        by blast


      have "(w  LS M1 qU)  (w  LS M1 qTarget)"
        using distinguishes M1 qU qTarget w
        unfolding distinguishes_def
        by blast 
      moreover have "(w  LS M1 qU) = (u@w  L M1)"
        by (metis "**" IntD1 qU = after_initial M1 u u  V ` reachable_states M1 after_language_iff assms(1))
      moreover have "(w  LS M1 qTarget) = (β@w  L M1)"
        by (metis β = V qTarget β  L M1 qTarget  reachable_states M1 after_language_iff assms(1) assms(9) is_state_cover_assignment_observable_after)
      ultimately have "(u@w  L M1)  (β@w  L M1)"
        by blast
      moreover have "u@w  set T" 
        using w  set (after T (V qU))
        unfolding after_set u = V qU[symmetric]
        using u  V ` reachable_states M1 assms(11) by auto
      moreover have "β@w  set T"
        using w  set (after T (V qTarget))
        unfolding after_set β = V qTarget
        using qTarget  reachable_states M1 assms(11) by auto   
      ultimately have "(u@w  L M2)  (β@w  L M2)"
        using L M1  set T = L M2  set T by blast
      then have "(u@w  L M2)  (?w@w  L M2)"
        unfolding (?w @ w  L M2) = (β@w  L M2) .
      moreover have "(u@w  L M2) = (w  LS M2 (after_initial M2 u))"
        by (metis (no_types, lifting) "**" Int_iff L M1  Prefix_Tree.set T = L M2  Prefix_Tree.set T u  V ` reachable_states M1 after_language_iff assms(11) assms(2) inter_eq_subsetI)
      moreover have "(?w@w  L M2) = (w  LS M2 (after_initial M2 ?w))"
        using assms(10) unfolding α[symmetric] xy[symmetric]
        by (metis assms(2) observable_after_language_append observable_after_language_none) 
      ultimately show "¬converge M2 u ?w"
        using converge.elims(2) by blast
    qed
    moreover have " v . v  (V ` reachable_states M1)  ¬converge M1 ?w v  ¬converge M2 ?w v"
      using calculation unfolding converge_sym[where v="?w"]
      by blast
    ultimately show ?thesis
      using assms(12)
      unfolding preserves_divergence.simps
      unfolding * **
      by blast
  qed    

  have " γ x y . length (γ@[(x,y)])  m - size_r M1 
                  γ  LS M1 (after_initial M1 (V (t_source t) @ [(t_input t, t_output t)])) 
                  x  inputs M1  y  outputs M1 
                  L M1  ((V ` reachable_states M1)  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))}) = L M2   ((V ` reachable_states M1)  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))})
                   preserves_divergence M1 M2 ((V ` reachable_states M1)  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))})"
  proof 
    fix γ x y 
    assume "length (γ@[(x,y)])  m - size_r M1"
    and    "γ  LS M1 (after_initial M1 (V (t_source t) @ [(t_input t, t_output t)]))"
    and    "x  inputs M1"
    and    "y  outputs M1"

    have "(after_initial M1 (V (t_source t) @ [(t_input t, t_output t)])) = qTarget"
      using converge M1 (α@[xy]) β
      unfolding α[symmetric] xy[symmetric] qTarget β[symmetric]
      using α @ [xy]  L M1 β  L M1 assms(1) assms(3) convergence_minimal by blast
    then have "γ  LS M1 qTarget"
      using γ  LS M1 (after_initial M1 (V (t_source t) @ [(t_input t, t_output t)]))
      by auto

    then have "γ@[(x,y)]  list.set (traces_to_check M1 qTarget k)"
      unfolding traces_to_check_set[OF assms(1) qTarget  states M1] k
      using length (γ@[(x,y)])  m - size_r M1 x  inputs M1 y  outputs M1
      by blast
    then have "(γ@[(x,y)])  list.set ttc"
      unfolding ttc by auto

    have " γ' . γ'  list.set (prefixes γ)  γ'  list.set ttc  γ'  LS M1 qTarget"
    proof 
      fix γ' assume "γ'  list.set (prefixes γ)"
      then obtain γ'' where "γ = γ'@γ''"
        using prefixes_set_ob by blast
      then show "γ'  LS M1 qTarget"
        using γ  LS M1 qTarget language_prefix by metis

      show "γ'  list.set ttc" proof (cases γ' rule: rev_cases)
        case Nil
        then show ?thesis unfolding ttc by auto
      next
        case (snoc ioI ioL)
        then obtain xL yL where "γ' = ioI@[(xL,yL)]"
          using prod.exhaust by metis
        then have "xL  inputs M1" and "yL  outputs M1"
          using language_io[OF γ'  LS M1 qTarget, of xL yL]
          by auto
        moreover have "length γ'  m - size_r M1"
          using length (γ@[(x,y)])  m - size_r M1 γ = γ'@γ'' by auto
        moreover have "ioI  LS M1 qTarget"
          using γ'  LS M1 qTarget γ' = ioI@[(xL,yL)] language_prefix by metis
        ultimately have "γ'  list.set (traces_to_check M1 qTarget k)"
          unfolding traces_to_check_set[OF assms(1) qTarget  states M1] k γ' = ioI@[(xL,yL)]
          by blast
        then show ?thesis 
          unfolding ttc by auto
      qed
    qed



    show "L M1  ((V ` reachable_states M1)  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))}) = L M2   ((V ` reachable_states M1)  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))})"
    proof -
      have "L M1  (V ` reachable_states M1) = L M2  (V ` reachable_states M1)"
        using assms(11) L M1  set T = L M2  set T
        by blast
      moreover have "L M1  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))} = L M2  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))}"
      proof -
        have *:"{ω@ω' | ω ω' . ω  {α@[xy],β}  ω'  list.set (prefixes (γ@[(x,y)]))}
                = {ω@ω' | ω ω' . ω  {α@[xy],β}  ω'  list.set (prefixes γ)}  {(α@[xy])@(γ@[(x,y)]),β@(γ@[(x,y)])}"
          unfolding prefixes_set_Cons_insert by blast
        have "L M1  {ω@ω' | ω ω' . ω  {α@[xy],β}  ω'  list.set (prefixes γ)} = L M2  {ω@ω' | ω ω' . ω  {α@[xy],β}  ω'  list.set (prefixes γ)}"
        proof -
          have " io . io  {ω@ω' | ω ω' . ω  {α@[xy],β}  ω'  list.set (prefixes γ)}  (io  L M1) = (io  L M2)"
          proof -
            fix io assume "io  {ω@ω' | ω ω' . ω  {α@[xy],β}  ω'  list.set (prefixes γ)}"
            then obtain γ' where "io  {α@[xy]@γ',β@γ'}" and "γ'  list.set (prefixes γ)"
              by force
            then have "γ'  list.set ttc" and "γ'  LS M1 qTarget"
              using  γ' . γ'  list.set (prefixes γ)  γ'  list.set ttc  γ'  LS M1 qTarget
              by blast+
            moreover have "[]  Prefix_Tree.set (dist_fun (length γ') (FSM.after M1 qTarget γ'))"
              by simp
            ultimately have "L M1  {α@[xy]@γ',β@γ'} = L M2  {α@[xy]@γ',β@γ'}"
              using handleTrace_foldl_props_1[of γ' "[]"]
              by auto 
            then show "(io  L M1) = (io  L M2)"
              using io  {α@[xy]@γ',β@γ'} by blast
          qed
          then show ?thesis by blast
        qed
        moreover have "L M1  {(α@[xy])@(γ@[(x,y)]),β@(γ@[(x,y)])} = L M2  {(α@[xy])@(γ@[(x,y)]),β@(γ@[(x,y)])}"
        proof (cases "(γ@[(x,y)])  LS M1 qTarget")
          case True
          show ?thesis 
            using handleTrace_foldl_props_1[OF (γ@[(x,y)])  list.set ttc True, of "[]"] 
            by auto
        next
          case False
          show ?thesis 
            using handleTrace_foldl_props_2[OF (γ@[(x,y)])  list.set ttc False] 
            by auto
        qed
        ultimately show ?thesis 
          unfolding α[symmetric] xy[symmetric] β[symmetric] *
          by (metis (no_types, lifting) Int_Un_distrib) 
      qed
      ultimately show ?thesis 
        by (metis (no_types, lifting) Int_Un_distrib) 
    qed
          
    show "preserves_divergence M1 M2 ((V ` reachable_states M1)  {ω@ω' | ω ω' . ω  {((V (t_source t)) @ [(t_input t,t_output t)]), (V (t_target t))}  ω'  list.set (prefixes (γ@[(x,y)]))})"
    proof -

      have " u v . u  L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
                     v  L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
                     ¬ converge M1 u v  
                     ¬ converge M2 u v"
      proof -
        fix u v assume "u  L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
                   and "v  L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
                   and "¬ converge M1 u v"

        then have "u  L M1" and "v  L M1" and "after_initial M1 u  after_initial M1 v" 
          by auto
        then have "after_initial M1 u  states M1"
              and "after_initial M1 v  states M1"
          using after_is_state[OF assms(1)] by auto

        have pass_dist: " u . u  L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
                     ( k .  w  Prefix_Tree.set (dist_fun k (after_initial M1 u)) . (u@w  L M1) = (u@w  L M2))"
        proof -
          fix u assume "u  L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
          then consider "u  V ` reachable_states M1" | "u  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))}"
            by blast
          then show "( k .  w  Prefix_Tree.set (dist_fun k (after_initial M1 u)) . (u@w  L M1) = (u@w  L M2))"
          proof cases
            case 1
            then obtain qU where "qU  reachable_states M1" and "V qU = u"
              by blast
            have "after_initial M1 u = qU"
              by (metis V qU = u qU  reachable_states M1 assms(1) assms(9) is_state_cover_assignment_observable_after) 

            have "w . w  Prefix_Tree.set (dist_fun 0 (after_initial M1 u))  (u@w  L M1) = (u@w  L M2)"
            proof -
              fix w assume "w  Prefix_Tree.set (dist_fun 0 (after_initial M1 u))"
              then have "w  Prefix_Tree.set (Prefix_Tree.after T u)"
                using assms(16)[OF qU  reachable_states M1] 
                unfolding V qU = u after_initial M1 u = qU
                by blast
              moreover have "u  set T"
                using "1" assms(11) by auto
              ultimately have "u@w  set T" 
                unfolding after_set
                by auto 
              then show "(u@w  L M1) = (u@w  L M2)"
                using L M1  set T = L M2  set T by blast
            qed
            then show ?thesis
              by blast
          next 
            case 2
            then obtain γ' where "u  {(α @ [xy]) @ γ', β @ γ'}" and "γ'  list.set (prefixes (γ @ [(x, y)]))"
              by blast
            then have "γ'  list.set ttc"
              using (γ @ [(x, y)])  list.set ttc  γ' . γ'  list.set (prefixes γ)  γ'  list.set ttc  γ'  LS M1 qTarget
              unfolding prefixes_set_Cons_insert by blast
            
            have "γ'  LS M1 qTarget"
            proof -
              have "u  L M1"
                using u  L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))}) by blast
              then show ?thesis
                using u  {(α @ [xy]) @ γ', β @ γ'} converge M1 (α @ [xy]) β 
                unfolding qTarget β[symmetric]
                by (metis β  L M1 assms(1) converge_append_language_iff insert_iff observable_after_language_none singleton_iff) 
            qed

            then have "(FSM.after M1 qTarget γ') = (after_initial M1 u)"
              using u  {(α @ [xy]) @ γ', β @ γ'} converge M1 (α @ [xy]) β 
              unfolding qTarget β[symmetric]
              by (metis α @ [xy]  L M1 β  L M1 after_split assms(1) assms(3) convergence_minimal insert_iff observable_after_language_append singleton_iff)
            have " w . {α @ [xy] @ γ' @ w, β @ γ' @ w} = {((α @ [xy]) @ γ') @ w, (β @ γ') @ w}"
              by auto

            have " w . w  set (dist_fun (Suc (length γ')) (after_initial M1 u))  (u @ w  L M1) = (u @ w  L M2)"
              using handleTrace_foldl_props_1[OF γ'  list.set ttc γ'  LS M1 qTarget] 
              unfolding (FSM.after M1 qTarget γ') = (after_initial M1 u)
              using u  {(α @ [xy]) @ γ', β @ γ'} 
              unfolding  w . {α @ [xy] @ γ' @ w, β @ γ' @ w} = {((α @ [xy]) @ γ') @ w, (β @ γ') @ w} by blast

            then show ?thesis
              by blast
          qed
        qed

        obtain ku where " w . w  set (dist_fun ku (after_initial M1 u))  (u@w  L M1) = (u@w  L M2)"
          using pass_dist[OF u  L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))})]
          by blast

        obtain kv where " w . w  set (dist_fun kv (after_initial M1 v))  (v@w  L M1) = (v@w  L M2)"
          using pass_dist[OF v  L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {α @ [xy], β}  ω'  list.set (prefixes (γ @ [(x, y)]))})]
          by blast

        obtain w where "w  set (dist_fun ku (after_initial M1 u))" 
                   and "w  set (dist_fun kv (after_initial M1 v))"
                   and "distinguishes M1 (after_initial M1 u) (after_initial M1 v) w"
          using assms(15)[OF after_initial M1 u  states M1 after_initial M1 v  states M1 after_initial M1 u  after_initial M1 v]
          by blast

        then have "(w  LS M1 (after_initial M1 u))  (w  LS M1 (after_initial M1 v))"
          unfolding distinguishes_def by blast
        moreover have "w  LS M1 (after_initial M1 u) = (w  LS M2 (after_initial M2 u))"
          by (metis w. w  Prefix_Tree.set (dist_fun ku (after_initial M1 u))  (u @ w  L M1) = (u @ w  L M2) u  L M1 w  Prefix_Tree.set (dist_fun ku (after_initial M1 u)) append_Nil2 assms(1) assms(2) observable_after_language_append observable_after_language_none set_Nil)
        moreover have "w  LS M1 (after_initial M1 v) = (w  LS M2 (after_initial M2 v))"
          by (metis w. w  Prefix_Tree.set (dist_fun kv (after_initial M1 v))  (v @ w  L M1) = (v @ w  L M2) v  L M1 w  Prefix_Tree.set (dist_fun kv (after_initial M1 v)) append_Nil2 assms(1) assms(2) observable_after_language_append observable_after_language_none set_Nil)
        ultimately have "(w  LS M2 (after_initial M2 u))  (w  LS M2 (after_initial M2 v))" 
          by blast
        then have "after_initial M2 u  after_initial M2 v"
          by auto
        then show "¬ converge M2 u v"
          using assms(2) assms(4) converge.simps convergence_minimal by blast 
      qed
  
      then show ?thesis
        unfolding preserves_divergence.simps α[symmetric] xy[symmetric] β[symmetric]
        by blast
    qed
  qed
  then show "?P1a"
    by blast
qed




lemma establish_convergence_static_establishes_convergence :
  assumes "observable M1"
      and "observable M2"
      and "minimal M1"
      and "minimal M2"
      and "size_r M1  m"
      and "size M2  m"
      and "inputs M2 = inputs M1"
      and "outputs M2 = outputs M1"
      and "t  transitions M1"
      and "t_source t  reachable_states M1"
      and "is_state_cover_assignment M1 V"
      and "V (t_source t) @ [(t_input t, t_output t)]  L M2"
      and "V ` reachable_states M1  set T"
      and "preserves_divergence M1 M2 (V ` reachable_states M1)"
      and "convergence_graph_lookup_invar M1 M2 cg_lookup G"
      and "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
      and " q1 q2 . q1  states M1  q2  states M1  q1  q2   io .  k1 k2 . io  set (dist_fun k1 q1)  set (dist_fun k2 q2)  distinguishes M1 q1 q2 io"
      and " q . q  reachable_states M1  set (dist_fun 0 q)  set (after T (V q))"
      and " q k . q  states M1  finite_tree (dist_fun k q)"
      and "L M1  set (fst (establish_convergence_static dist_fun M1 V T G cg_insert cg_lookup m t)) = L M2  set (fst (establish_convergence_static dist_fun M1 V T G cg_insert cg_lookup m t))"
shows "converge M2 (V (t_source t) @ [(t_input t, t_output t)]) (V (t_target t))"
(is "converge M2 ?u ?v")
proof -

   have prop1: "γ x y.
     length (γ @ [(x, y)])  (m - size_r M1) 
     γ  LS M1 (after_initial M1 ?u) 
     x  FSM.inputs M1 
     y  FSM.outputs M1 
     L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {?u, ?v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) =
     L M2  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {?u, ?v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
     preserves_divergence M1 M2
      (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {?u, ?v}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
  and prop2: "preserves_divergence M1 M2 (V ` reachable_states M1  {?u, ?v})"
     using establish_convergence_static_properties(1,2)[OF assms(1-4,7-20)]
     by presburger+

  have "L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1" 
    using assms(13,20) 
    using establish_convergence_static_subset[of T dist_fun M1 V G cg_insert cg_lookup m t ]
    by blast
  then have "V (t_target t)  L M2"
    by (metis Int_iff assms(10) assms(11) assms(9) imageI is_state_cover_assignment_language reachable_states_next)
    
  have "converge M1 ?u ?v"
    using state_cover_transition_converges[OF assms(1,11,9,10)] .

  show ?thesis
    using establish_convergence_from_pass[OF assms(1-8,11) L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1 converge M1 ?u ?v V (t_source t) @ [(t_input t, t_output t)]  L M2 V (t_target t)  L M2 prop1 prop2]
    by blast
qed

 


lemma establish_convergence_static_verifies_transition :
  assumes " q1 q2 . q1  states M1  q2  states M1  q1  q2   io .  k1 k2 . io  set (dist_fun k1 q1)  set (dist_fun k2 q2)  distinguishes M1 q1 q2 io"
      and " q k . q  states M1  finite_tree (dist_fun k q)"
shows "verifies_transition (establish_convergence_static dist_fun) M1 M2 V (fst (handle_state_cover_static dist_fun M1 V cg_initial cg_insert cg_lookup)) cg_insert cg_lookup"
proof -
  have *:" V T (G::'d) m t. set T  set (fst ((establish_convergence_static dist_fun) M1 V T G cg_insert cg_lookup m t))"
    using establish_convergence_static_subset 
    by metis 

  have ***:" V T (G::'d) m t. finite_tree T  finite_tree (fst ((establish_convergence_static dist_fun) M1 V T G cg_insert cg_lookup m t))"
    using establish_convergence_static_finite 
    by metis 

  let ?distinguish_traces = "(λ α t' q' β t'' g'' . dist_fun 0 q')"

  have **:" T (G::'d) m t.
        observable M1 
        observable M2 
        minimal M1 
        minimal M2 
        size_r M1  m 
        FSM.size M2  m 
        FSM.inputs M2 = FSM.inputs M1 
        FSM.outputs M2 = FSM.outputs M1 
        is_state_cover_assignment M1 V 
        preserves_divergence M1 M2 (V ` reachable_states M1) 
        V ` reachable_states M1  set T 
        t  FSM.transitions M1 
        t_source t  reachable_states M1 
        V (t_source t) @ [(t_input t, t_output t)]  L M2 
        convergence_graph_lookup_invar M1 M2 cg_lookup G 
        convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
        set (fst (handle_state_cover_static dist_fun M1 V cg_initial cg_insert cg_lookup))  set T 
        L M1  Prefix_Tree.set (fst ((establish_convergence_static dist_fun) M1 V T G cg_insert cg_lookup m t)) =
        L M2  Prefix_Tree.set (fst ((establish_convergence_static dist_fun) M1 V T G cg_insert cg_lookup m t)) 
        converge M2 (V (t_source t) @ [(t_input t, t_output t)]) (V (t_target t)) 
        convergence_graph_lookup_invar M1 M2 cg_lookup (snd ((establish_convergence_static dist_fun) M1 V T G cg_insert cg_lookup m t))"
  proof 
    fix G :: 'd
    fix T m t
    assume a01: "observable M1"
    assume a02: "observable M2"
    assume a03: "minimal M1"
    assume a04: "minimal M2"
    assume a05: "size_r M1  m"
    assume a06: "FSM.size M2  m"
    assume a07: "FSM.inputs M2 = FSM.inputs M1"
    assume a08: "FSM.outputs M2 = FSM.outputs M1"
    assume a09: "is_state_cover_assignment M1 V"
    assume a10: "preserves_divergence M1 M2 (V ` reachable_states M1)"
    assume a11: "V ` reachable_states M1  set T"
    assume a12: "t  FSM.transitions M1"
    assume a13: "t_source t  reachable_states M1"
    assume a14: "V (t_source t) @ [(t_input t, t_output t)]  L M2"
    assume a15: "convergence_graph_lookup_invar M1 M2 cg_lookup G"
    assume a16: "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
    assume a17: "L M1  Prefix_Tree.set (fst ((establish_convergence_static dist_fun) M1 V T G cg_insert cg_lookup m t)) = L M2  Prefix_Tree.set (fst ((establish_convergence_static dist_fun) M1 V T G cg_insert cg_lookup m t))"
    assume a18: "set (fst (handle_state_cover_static dist_fun M1 V cg_initial cg_insert cg_lookup))  set T"

    have "L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1"
      using a11 a17 *
      by blast
    then have d2: "V (t_target t)  L M2"
      using a11 is_state_cover_assignment_language[OF a09, of "t_target t"] reachable_states_next[OF a13 a12]
      by blast

    have d1: " q . q  reachable_states M1  set (dist_fun 0 q)  set (after T (V q))" 
      using handle_state_cover_static_applies_dist_sets[of _ M1 dist_fun V cg_initial cg_insert cg_lookup] a18
      by (meson in_mono subsetI subset_after_subset) 

    show "converge M2 (V (t_source t) @ [(t_input t, t_output t)]) (V (t_target t))"
      using establish_convergence_static_establishes_convergence[where dist_fun=dist_fun, OF a01 a02 a03 a04 a05 a06 a07 a08 a12 a13 a09 a14 a11 a10 a15 a16 assms(1) d1 assms(2) a17]
      by force

    show "convergence_graph_lookup_invar M1 M2 cg_lookup (snd (establish_convergence_static dist_fun M1 V T G cg_insert cg_lookup m t))"
      using establish_convergence_static_properties(3)[where dist_fun=dist_fun, OF a01 a02 a03 a04 a07 a08 a12 a13 a09 a14 a11 a10 a15 a16 assms(1) d1 assms(2) a17]
      by blast
  qed

  show ?thesis
    unfolding verifies_transition_def
    using * *** ** 
    by presburger
qed



definition handleUT_static :: "(nat  'a  ('b×'c) prefix_tree) 
                                     (('a::linorder,'b::linorder,'c::linorder) fsm 
                                     ('a,'b,'c) state_cover_assignment 
                                     ('b×'c) prefix_tree  
                                     'd 
                                     ('d  ('b×'c) list  'd) 
                                     ('d  ('b×'c) list  ('b×'c) list list) 
                                     ('d  ('b×'c) list  ('b×'c) list  'd)  
                                     nat 
                                     ('a,'b,'c) transition  
                                     ('a,'b,'c) transition list    
                                     (('a,'b,'c) transition list × ('b×'c) prefix_tree × 'd))"
  where 
  "handleUT_static dist_fun M V T G cg_insert cg_lookup cg_merge l t X = (let
      (T1,G1) = handle_io_pair False False M V T G cg_insert cg_lookup (t_source t) (t_input t) (t_output t);
      (T2,G2) = establish_convergence_static dist_fun M V T1 G1 cg_insert cg_lookup l t;
      G3      = cg_merge G2 ((V (t_source t))@[(t_input t, t_output t)]) (V (t_target t))
    in (X,T2,G3))"


lemma handleUT_static_handles_transition :
  fixes M1::"('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2::"('e,'b,'c) fsm"
  assumes " q1 q2 . q1  states M1  q2  states M1  q1  q2   io .  k1 k2 . io  set (dist_fun k1 q1)  set (dist_fun k2 q2)  distinguishes M1 q1 q2 io"
      and " q k . q  states M1  finite_tree (dist_fun k q)"
    shows "handles_transition (handleUT_static dist_fun) M1 M2 V (fst (handle_state_cover_static dist_fun M1 V cg_initial cg_insert cg_lookup)) cg_insert cg_lookup cg_merge"
proof -

  let ?T0 = "(fst (handle_state_cover_static dist_fun M1 V cg_initial cg_insert cg_lookup))"

  have " T G m t X . 
       Prefix_Tree.set T  Prefix_Tree.set (fst (snd (handleUT_static dist_fun M1 V T G cg_insert cg_lookup cg_merge m t X))) 
       (finite_tree T  finite_tree (fst (snd (handleUT_static dist_fun M1 V T G cg_insert cg_lookup cg_merge m t X)))) 
       (observable M1 
        observable M2 
        minimal M1 
        minimal M2 
        size_r M1  m 
        FSM.size M2  m 
        FSM.inputs M2 = FSM.inputs M1 
        FSM.outputs M2 = FSM.outputs M1 
        is_state_cover_assignment M1 V 
        preserves_divergence M1 M2 (V ` reachable_states M1) 
        V ` reachable_states M1  Prefix_Tree.set T 
        t  FSM.transitions M1 
        t_source t  reachable_states M1 
        V (t_source t) @ [(t_input t, t_output t)]  V (t_target t) 
        convergence_graph_lookup_invar M1 M2 cg_lookup G 
        convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
        convergence_graph_merge_invar M1 M2 cg_lookup cg_merge 
        L M1  Prefix_Tree.set (fst (snd (handleUT_static dist_fun M1 V T G cg_insert cg_lookup cg_merge m t X))) =
        L M2  Prefix_Tree.set (fst (snd (handleUT_static dist_fun M1 V T G cg_insert cg_lookup cg_merge m t X))) 
        Prefix_Tree.set ?T0  Prefix_Tree.set T 
        (γ. length γ  m - size_r M1  list.set γ  FSM.inputs M1 × FSM.outputs M1  butlast γ  LS M1 (t_target t) 
             L M1  (V ` reachable_states M1  {(V (t_source t) @ [(t_input t, t_output t)]) @ ω' |ω'. ω'  list.set (prefixes γ)}) =
             L M2  (V ` reachable_states M1  {(V (t_source t) @ [(t_input t, t_output t)]) @ ω' |ω'. ω'  list.set (prefixes γ)}) 
             preserves_divergence M1 M2 (V ` reachable_states M1  {(V (t_source t) @ [(t_input t, t_output t)]) @ ω' |ω'. ω'  list.set (prefixes γ)})) 
        convergence_graph_lookup_invar M1 M2 cg_lookup (snd (snd (handleUT_static dist_fun M1 V T G cg_insert cg_lookup cg_merge m t X))))"
    (is " T G m t X . ?P T G m t X")
  proof -

    fix T :: "('b×'c) prefix_tree"
    fix G :: 'd
    fix m :: nat
    fix t :: "('a,'b,'c) transition"
    fix X :: "('a,'b,'c) transition list"
  
    let ?TG = "snd (handleUT_static dist_fun M1 V T G cg_insert cg_lookup cg_merge m t X)"

    obtain T1 G1 where "(T1,G1)   = handle_io_pair False False M1 V T G cg_insert cg_lookup (t_source t) (t_input t) (t_output t)"
      using prod.collapse by blast
    then have T1_def: "T1 = fst (handle_io_pair False False M1 V T G cg_insert cg_lookup (t_source t) (t_input t) (t_output t))"
         and  G1_def: "G1 = snd (handle_io_pair False False M1 V T G cg_insert cg_lookup (t_source t) (t_input t) (t_output t))"
      using fst_conv[of T1 G1] snd_conv[of T1 G1] by force+

    obtain T2 G2 where "(T2,G2)   = establish_convergence_static dist_fun M1 V T1 G1 cg_insert cg_lookup m t"
      using prod.collapse by blast
    have T2_def: "T2 = fst (establish_convergence_static dist_fun M1 V T1 G1 cg_insert cg_lookup m t)"
    and  G2_def: "G2 = snd (establish_convergence_static dist_fun M1 V T1 G1 cg_insert cg_lookup m t)"
      unfolding (T2,G2)   = establish_convergence_static dist_fun M1 V T1 G1 cg_insert cg_lookup m t[symmetric] by auto
    define u where "u         = ((V (t_source t))@[(t_input t, t_output t)])"
    define v where "v         = (V (t_target t))"

    define G3 where "G3 = cg_merge G2 u v"

    have TG_cases: "?TG = (T2,G3)"
      unfolding handleUT_static_def Let_def
      unfolding (T1,G1)   = handle_io_pair False False M1 V T G cg_insert cg_lookup (t_source t) (t_input t) (t_output t)[symmetric] case_prod_conv
      unfolding (T2,G2)   = establish_convergence_static dist_fun M1 V T1 G1 cg_insert cg_lookup m t[symmetric] case_prod_conv
      unfolding G3_def u_def v_def 
      by simp


    have "set T1  set T2"
    and  "finite_tree T1  finite_tree T2"
      using establish_convergence_static_verifies_transition[OF assms, of M2 V cg_initial cg_insert cg_lookup]
      unfolding T2_def verifies_transition_def by blast+
    moreover have "set T  set T1"
             and  "finite_tree T  finite_tree T1"
      using handle_io_pair_verifies_io_pair[of False False M1 M2 cg_insert cg_lookup]
      unfolding T1_def verifies_io_pair_def 
      by blast+
    ultimately have *:"set T  set (fst ?TG)"
               and **:"finite_tree T  finite_tree (fst ?TG)"
      using TG_cases by auto

    
    have ***: "observable M1 
              observable M2 
              minimal M1 
              minimal M2 
              size_r M1  m 
              size M2  m 
              inputs M2 = inputs M1 
              outputs M2 = outputs M1 
              is_state_cover_assignment M1 V 
              preserves_divergence M1 M2 (V ` reachable_states M1) 
              V ` reachable_states M1  set T 
              t  transitions M1 
              t_source t  reachable_states M1  
              V (t_source t) @ [(t_input t, t_output t)]  V (t_target t) 
              convergence_graph_lookup_invar M1 M2 cg_lookup G 
              convergence_graph_insert_invar M1 M2 cg_lookup cg_insert 
              convergence_graph_merge_invar M1 M2 cg_lookup cg_merge 
              L M1  set (fst ?TG) = L M2  set (fst ?TG) 
              (set ?T0  set T) 
              ( γ . (length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))
                       ((L M1  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})
                            = L M2  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)}))
                            preserves_divergence M1 M2 (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})))   
               convergence_graph_lookup_invar M1 M2 cg_lookup (snd ?TG)"
    proof -
      assume a01 : "observable M1"
      assume a02 : "observable M2"
      assume a03 : "minimal M1"
      assume a04 : "minimal M2"
      assume a05 : "size_r M1  m"
      assume a06 : "size M2  m"
      assume a07 : "inputs M2 = inputs M1"
      assume a08 : "outputs M2 = outputs M1"
      assume a09 : "is_state_cover_assignment M1 V"
      assume a10 : "preserves_divergence M1 M2 (V ` reachable_states M1)"
      assume a11 : "V ` reachable_states M1  set T"
      assume a12 : "t  transitions M1"
      assume a13 : "t_source t  reachable_states M1"
      assume a14 : "convergence_graph_lookup_invar M1 M2 cg_lookup G"
      assume a15 : "convergence_graph_insert_invar M1 M2 cg_lookup cg_insert"
      assume a16 : "convergence_graph_merge_invar M1 M2 cg_lookup cg_merge"
      assume a17 : "L M1  set (fst ?TG) = L M2  set (fst ?TG)"
      assume a18 : "(set ?T0  set T)" 
      assume a19 : "V (t_source t) @ [(t_input t, t_output t)]  V (t_target t)"

      have pass_T1 : "L M1  set T1 = L M2  set T1"
        using a17 set T1  set T2 unfolding TG_cases by auto
      then have pass_T : "L M1  set T = L M2  set T"
        using set T  set T1 by blast


      have "t_target t  reachable_states M1"
        using reachable_states_next[OF a13 a12] by auto
      then have "(V (t_target t))  L M1"
        using is_state_cover_assignment_language[OF a09] by blast
      moreover have "(V (t_target t))  set T"
        using a11 t_target t  reachable_states M1 by blast
      ultimately have "(V (t_target t))  L M2"
        using pass_T by blast
      then have "v  L M2"
        unfolding v_def .

      have "(V (t_source t))  L M1"
        using is_state_cover_assignment_language[OF a09 a13] by blast
      moreover have "(V (t_source t))  set T"
        using a11 a13 by blast
      ultimately have "(V (t_source t))  L M2"
        using pass_T by blast
      have "u  L M1" 
        unfolding u_def
        using a01 a09 a12 a13 converge.simps state_cover_transition_converges by blast
      
      have "after_initial M1 u = t_target t"
        using a09 unfolding u_def
        by (metis u  L M1 a01 a12 a13 after_split after_transition_exhaust is_state_cover_assignment_observable_after u_def)


      have "u  L M2" 
        using distribute_extension_adds_sequence(1)[OF a01 a03 (V (t_source t))  L M1 (V (t_source t))  L M2 a14 a15, of T "[(t_input t, t_output t)]", of False "(if False then append_heuristic_input M1 else append_heuristic_io)"]
        using pass_T1 append_heuristic_io_in
        unfolding T1_def G1_def handle_io_pair_def u_def
        by (metis (no_types, lifting) Int_iff u  L M1 a01 a02 converge_append_language_iff u_def) 
      then have "V (t_source t) @ [(t_input t, t_output t)]  L M2"
        unfolding u_def .
      have "L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1"
        using a11 a17 *
        by blast
      have "V ` reachable_states M1  set T1"
        using a11 set T  set T1 by blast
      have " q . q  reachable_states M1  set (dist_fun 0 q)  set (after T (V q))" 
        using handle_state_cover_static_applies_dist_sets[of _ M1 dist_fun V cg_initial cg_insert cg_lookup] a18
        by (meson in_mono subsetI subset_after_subset) 
      then have " q . q  reachable_states M1  set (dist_fun 0 q)  set (after T1 (V q))" 
        using set T  set T1
        by (meson dual_order.trans subset_after_subset) 

      have pass_T2: "L M1  Prefix_Tree.set (fst (establish_convergence_static dist_fun M1 V T1 G1 cg_insert cg_lookup m t)) = L M2  Prefix_Tree.set (fst (establish_convergence_static dist_fun M1 V T1 G1 cg_insert cg_lookup m t))"
        using a17 unfolding TG_cases T2_def fst_conv .
      have "convergence_graph_lookup_invar M1 M2 cg_lookup G1"
        using handle_io_pair_verifies_io_pair[of False False M1 M2 cg_insert cg_lookup] 
        using a01 a02 a03 a04 a07 a08 a09 L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1 pass_T1 a13 fsm_transition_input[OF a12] fsm_transition_output[OF a12] a14 a15
        unfolding T1_def G1_def verifies_io_pair_def
        by blast


      have cons_prop: "γ x y.
                           length (γ @ [(x, y)])  m-size_r M1 
                           γ  LS M1 (after_initial M1 u) 
                           x  FSM.inputs M1 
                           y  FSM.outputs M1 
                           L M1  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) =
                           L M2  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))}) 
                           preserves_divergence M1 M2 (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes (γ @ [(x, y)]))})"
       and nil_prop: "preserves_divergence M1 M2 (V ` reachable_states M1  {u, v})"  
       and conv_G2: "convergence_graph_lookup_invar M1 M2 cg_lookup G2"
        using establish_convergence_static_properties[OF a01 a02 a03 a04 a07 a08 a12 a13 a09 V (t_source t) @ [(t_input t, t_output t)]  L M2 V ` reachable_states M1  set T1 a10 convergence_graph_lookup_invar M1 M2 cg_lookup G1 a15 assms(1)  q . q  reachable_states M1  set (dist_fun 0 q)  set (after T1(V q)) assms(2) pass_T2]
        unfolding G2_def[symmetric] u_def[symmetric] v_def[symmetric]
        by blast+

      have "converge M2 u v"
        using establish_convergence_static_establishes_convergence[OF a01 a02 a03 a04 a05 a06 a07 a08 a12 a13 a09 V (t_source t) @ [(t_input t, t_output t)]  L M2 V ` reachable_states M1  set T1 a10 convergence_graph_lookup_invar M1 M2 cg_lookup G1 a15 assms(1)  q . q  reachable_states M1  set (dist_fun 0 q)  set (after T1(V q)) assms(2) pass_T2]
        unfolding u_def v_def by blast
      moreover have "converge M1 u v" 
        unfolding u_def v_def using a09 a12 a13
        using a01 state_cover_transition_converges by blast
      ultimately have "convergence_graph_lookup_invar M1 M2 cg_lookup G3"
        using convergence_graph_lookup_invar M1 M2 cg_lookup G2 a16
        unfolding G3_def
        by (meson convergence_graph_merge_invar_def) 
      then have "convergence_graph_lookup_invar M1 M2 cg_lookup (snd ?TG)"
        unfolding TG_cases by auto

      moreover have " γ . (length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))
                     ((L M1  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})
                          = L M2  (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)}))
                          preserves_divergence M1 M2 (V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)}))"
        (is " γ . (length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))  ?P1 γ  ?P2 γ")          
      proof -
        fix γ assume assm:"(length γ  (m-size_r M1)  list.set γ  inputs M1 × outputs M1  butlast γ  LS M1 (t_target t))"
        show "?P1 γ  ?P2 γ" 
        proof (cases γ rule: rev_cases)
          case Nil
          have *: "(V ` reachable_states M1  {((V (t_source t))@[(t_input t,t_output t)]) @ ω' | ω'. ω'  list.set (prefixes γ)})
                      = (V ` reachable_states M1  {u})"
            unfolding u_def[symmetric] Nil by auto

          have "?P1 γ"
            using L M1  V ` reachable_states M1 = L M2  V ` reachable_states M1
                  u  L M1 u  L M2
            unfolding * by blast
          moreover have "?P2 γ"
            using preserves_divergence_subset[OF nil_prop]
            unfolding * 
            by (metis Un_empty_right Un_insert_right Un_upper1 insertI1 insert_subsetI)
          ultimately show ?thesis
            by simp 
        next
          case (snoc γ' xy)
          moreover obtain x y where "xy = (x,y)" 
            using prod.exhaust by metis
          ultimately have "γ = γ'@[(x,y)]"
            by auto

          have *: "(V ` reachable_states M1  {u @ ω' |ω'. ω'  list.set (prefixes γ)})  (V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes γ)})"
            by blast

          have "length (γ' @ [(x, y)])  m - size_r M1"
            using assm unfolding γ = γ'@[(x,y)] by auto
          moreover have "γ'  LS M1 (after_initial M1 u)"
            using assm unfolding γ = γ'@[(x,y)]
            by (simp add: after_initial M1 u = t_target t) 
          moreover have "x  FSM.inputs M1" and "y  FSM.outputs M1"
            using assm unfolding γ = γ'@[(x,y)] by auto
          ultimately show ?thesis
            using cons_prop[of γ' x y] preserves_divergence_subset[of M1 M2 "(V ` reachable_states M1  {ω @ ω' |ω ω'. ω  {u, v}  ω'  list.set (prefixes γ)})", OF _ *]
            unfolding γ = γ'@[(x,y)][symmetric] u_def[symmetric] 
            by blast
        qed 
      qed
      then show ?thesis
        using convergence_graph_lookup_invar M1 M2 cg_lookup (snd ?TG)
        by presburger
    qed  
    show "?P T G m t X"
      using * ** ***  by blast
  qed
  then show ?thesis
    unfolding handles_transition_def
    by blast
qed


subsection ‹Distinguishing Traces›

subsubsection ‹Symmetry›
text ‹The following lemmata serve to show that the function to choose distinguishing sequences
      returns the same sequence for reversed pairs, thus ensuring that the HSIs do not contain two
      sequences for the same pair of states.›





lemma select_diverging_ofsm_table_io_sym :
  assumes "observable M"
  and     "q1  states M"
  and     "q2  states M"
  and     "ofsm_table M (λq . states M)  (Suc k) q1  ofsm_table M (λq . states M)  (Suc k) q2"
  assumes "(select_diverging_ofsm_table_io M q1 q2 (Suc k)) = (io,(a,b))"
  shows "(select_diverging_ofsm_table_io M q2 q1 (Suc k)) = (io,(b,a))"
proof -
  define xs where xs: "xs = (List.product (inputs_as_list M) (outputs_as_list M))"

  define f1' where f1': "f1' = (λ(x, y)  (case (h_obs M q1 x y, h_obs M q2 x y) of 
                    (None, None)  None | 
                    (None, Some q2')  Some ((x, y), None, Some q2') | 
                    (Some q1', None)  Some ((x, y), Some q1', None) | 
                    (Some q1', Some q2')  (if ofsm_table M (λq . states M)  ((Suc k) - 1) q1'  ofsm_table M (λq . states M)  ((Suc k) - 1) q2' then Some ((x, y), Some q1', Some q2') else None)))"
  define f1 where f1: "f1 = (λxs . (hd (List.map_filter f1' xs)))"

  define f2' where f2': "f2' = (λ(x, y)  (case (h_obs M q2 x y, h_obs M q1 x y) of 
                    (None, None)  None | 
                    (None, Some q2')  Some ((x, y), None, Some q2') | 
                    (Some q1', None)  Some ((x, y), Some q1', None) | 
                    (Some q1', Some q2')  (if ofsm_table M (λq . states M)  ((Suc k) - 1) q1'  ofsm_table M (λq . states M)  ((Suc k) - 1) q2' then Some ((x, y), Some q1', Some q2') else None)))"
  define f2 where f2: "f2 = (λxs . (hd (List.map_filter f2' xs)))"

  obtain x y where "select_diverging_ofsm_table_io M q1 q2 (Suc k) = ((x,y),(h_obs M q1 x y, h_obs M q2 x y))"
    using select_diverging_ofsm_table_io_Some(1)[OF assms(1-4)]
    by meson


  have " xy io a b . f1' xy = Some (io,(a,b))  f2' xy = Some (io,(b,a))"
  proof -
    fix xy io a b assume *: "f1' xy = Some (io,(a,b))"
    obtain x y where "xy = (x,y)"
      using prod.exhaust by metis

    show "f2' xy = Some (io,(b,a))"      
    proof (cases "h_obs M q1 x y")
      case None
      show ?thesis proof (cases "h_obs M q2 x y")
        case None
        then show ?thesis using h_obs M q1 x y = None * unfolding f1' f2' xy = (x,y) by auto
      next
        case (Some q2')
        
        show ?thesis using * unfolding f1' f2'
          unfolding case_prod_conv None Some xy = (x,y) by auto
      qed 
    next
      case (Some q1')
      show ?thesis proof (cases "h_obs M q2 x y")
        case None
        show ?thesis using * unfolding f1' f2'
          unfolding case_prod_conv None Some xy = (x,y) by auto
      next
        case (Some q2')
        have "ofsm_table M (λq . states M)  ((Suc k) - 1) q2'  ofsm_table M (λq . states M)  ((Suc k) - 1) q1'" 
          using * unfolding f1' case_prod_conv h_obs M q1 x y = Some q1' Some xy = (x,y) by auto
        then have "f1' (x,y) = Some ((x,y),(h_obs M q1 x y,h_obs M q2 x y))"
          unfolding f1' case_prod_conv h_obs M q1 x y = Some q1' Some by auto
        then have "io = (x,y)" and "b = h_obs M q2 x y" and "a = h_obs M q1 x y"
          using * xy = (x,y) by auto
          
        show ?thesis unfolding f2'
          unfolding case_prod_conv h_obs M q1 x y = Some q1' Some io = (x,y) b = h_obs M q2 x y a = h_obs M q1 x y xy = (x,y)
          using ofsm_table M (λq . states M)  ((Suc k) - 1) q2'  ofsm_table M (λq . states M)  ((Suc k) - 1) q1' by simp
      qed 
    qed
  qed
  moreover have " xy io a b . f2' xy = Some (io,(a,b))  f1' xy = Some (io,(b,a))"
  proof -
    fix xy io a b assume *: "f2' xy = Some (io,(a,b))"
    obtain x y where "xy = (x,y)"
      using prod.exhaust by metis

    show "f1' xy = Some (io,(b,a))"      
    proof (cases "h_obs M q1 x y")
      case None
      show ?thesis proof (cases "h_obs M q2 x y")
        case None
        then show ?thesis using h_obs M q1 x y = None * unfolding f1' f2' xy = (x,y) by auto
      next
        case (Some q2')
        
        show ?thesis using * unfolding f1' f2'
          unfolding case_prod_conv None Some xy = (x,y) by auto
      qed 
    next
      case (Some q1')
      show ?thesis proof (cases "h_obs M q2 x y")
        case None
        show ?thesis using * unfolding f1' f2'
          unfolding case_prod_conv None Some xy = (x,y) by auto
      next
        case (Some q2')
        have "ofsm_table M (λq . states M)  ((Suc k) - 1) q2'  ofsm_table M (λq . states M)  ((Suc k) - 1) q1'" 
          using * unfolding f2' case_prod_conv h_obs M q1 x y = Some q1' Some xy = (x,y) by auto
        then have "f2' (x,y) = Some ((x,y),(h_obs M q2 x y,h_obs M q1 x y))"
          unfolding f2' case_prod_conv h_obs M q1 x y = Some q1' Some by auto
        then have "io = (x,y)" and "b = h_obs M q1 x y" and "a = h_obs M q2 x y"
          using * xy = (x,y) by auto
          
        show ?thesis unfolding f1'
          unfolding case_prod_conv h_obs M q1 x y = Some q1' Some io = (x,y) b = h_obs M q1 x y a = h_obs M q2 x y xy = (x,y)
          using ofsm_table M (λq . states M)  ((Suc k) - 1) q2'  ofsm_table M (λq . states M)  ((Suc k) - 1) q1' by simp
      qed 
    qed
  qed
  ultimately have " xy io a b . f2' xy = Some (io,(a,b))  f1' xy = Some (io,(b,a))" 
    by blast

  moreover have " xs . ( xy io a b . f1' xy = Some (io,(a,b))  f2' xy = Some (io,(b,a)))   xy  list.set xs . f1' xy  None  f1 xs = (io,(a,b))  f2 xs = (io,(b,a))"
  proof -
    fix xs assume "( xy io a b . f1' xy = Some (io,(a,b))  f2' xy = Some (io,(b,a)))" 
                  " xy  list.set xs . f1' xy  None" 
                  "f1 xs = (io,(a,b))"
    then show "f2 xs = (io,(b,a))"
    proof (induction xs)
      case Nil
      then show ?case by auto
    next
      case (Cons xy xs)
      show ?case proof (cases "f1' xy")
        case None
        then have " io a b . f1' xy = Some (io,(a,b))"
          by auto
        then have "f2' xy = None"
          using Cons.prems(1)
          by (metis option.exhaust prod_cases3) 
        then have "f2 (xy#xs) = f2 xs"
          unfolding f2 map_filter_simps by auto
        moreover have "f1 (xy#xs) = f1 xs"
          using None unfolding f1 map_filter_simps by auto
        ultimately show ?thesis
          using Cons.IH Cons.prems(1) Cons.prems(2) Cons.prems(3) None by fastforce          
      next
        case (Some ioab)
        then have "f1 (xy#xs) = ioab"
          unfolding f1 map_filter_simps
          by simp 
        then have "ioab = (io,(a,b))"
          using Cons.prems(3) by auto
        then have "f2' xy = Some (io,(b,a))"
          using Cons.prems(1) Some by auto
        then show "f2 (xy#xs) = (io,(b,a))"
          unfolding f2 map_filter_simps by auto
      qed
    qed
  qed

  moreover have "f1 xs = (io,(a,b))"
    using (select_diverging_ofsm_table_io M q1 q2 (Suc k)) = (io,(a,b)) 
    unfolding select_diverging_ofsm_table_io.simps f1 f1' xs Let_def by auto

  moreover have " xy  list.set xs . f1' xy  None"
  proof -
    let ?P = " x y . x  inputs M  y  outputs M  (h_obs M q1 x y = None  h_obs M q2 x y = None)"
    show ?thesis proof (cases ?P)
      case False
      then obtain x y where "x  inputs M" and "y  outputs M" and "¬ (h_obs M q1 x y = None  h_obs M q2 x y = None)"
        by blast
      then consider "h_obs M q1 x y = None  ( q2' . h_obs M q2 x y = Some q2')" |
                    "h_obs M q2 x y = None  ( q1' . h_obs M q1 x y = Some q1')"
        by fastforce
      then show ?thesis proof cases
        case 1
        then obtain q2' where "h_obs M q1 x y = None" and "h_obs M q2 x y = Some q2'" by blast
        then have "f1' (x,y) = Some ((x,y),(None, Some q2'))"
          unfolding f1' by force
        moreover have "(x,y)  list.set xs"
          unfolding xs
          using y  outputs M outputs_as_list_set[of M]
          using x  inputs M inputs_as_list_set[of M] 
          using image_iff by fastforce 
        ultimately show ?thesis 
          by blast
      next
        case 2
        then obtain q1' where "h_obs M q2 x y = None" and "h_obs M q1 x y = Some q1'" by blast
        then have "f1' (x,y) = Some ((x,y),(Some q1', None))"
          unfolding f1' by force
        moreover have "(x,y)  list.set xs"
          unfolding xs
          using y  outputs M outputs_as_list_set[of M]
          using x  inputs M inputs_as_list_set[of M] 
          using image_iff by fastforce 
        ultimately show ?thesis 
          by blast
      qed
    next 
      case True
  
      obtain io where "length io  Suc k" and "io  LS M q1  LS M q2" and "io  LS M q1  LS M q2"
        using ofsm_table M (λq . states M)  (Suc k) q1  ofsm_table M (λq . states M)  (Suc k) q2
        unfolding ofsm_table_set_observable[OF assms(1,2) minimise_initial_partition] ofsm_table_set_observable[OF assms(1,3) minimise_initial_partition] by blast
    
      then have "io  []"
        using assms(2) assms(3) by auto 
      then have "io = [hd io] @ tl io"
        by (metis append.left_neutral append_Cons list.exhaust_sel)    
      then obtain x y where "hd io = (x,y)"
        by (meson prod.exhaust_sel)
    
      have "[(x,y)]  LS M q1  LS M q2"
      proof -
        have "[(x,y)]  LS M q1  LS M q2"
          using io  LS M q1  LS M q2 language_prefix hd io = (x,y) io = [hd io] @ tl io
          by (metis Un_iff) 
        then have "x  inputs M" and "y  outputs M"
          by auto
        
        consider "[(x,y)]  LS M q1" | "[(x,y)]  LS M q2"
          using [(x,y)]  LS M q1  LS M q2 by blast
        then show ?thesis 
        proof cases
          case 1
          then have "h_obs M q1 x y  None"
            using h_obs_None[OF observable M] unfolding LS_single_transition by auto
          then have "h_obs M q2 x y  None"
            using True x  inputs M y  outputs M by meson
          then show ?thesis 
            using 1 h_obs_None[OF observable M] 
            by (metis IntI LS_single_transition fst_conv snd_conv) 
        next
          case 2
          then have "h_obs M q2 x y  None"
            using h_obs_None[OF observable M] unfolding LS_single_transition by auto
          then have "h_obs M q1 x y  None"
            using True x  inputs M y  outputs M by meson
          then show ?thesis 
            using 2 h_obs_None[OF observable M] 
            by (metis IntI LS_single_transition fst_conv snd_conv) 
        qed
      qed
      then obtain q1' q2' where "(q1,x,y,q1')  transitions M" 
                            and "(q2,x,y,q2')  transitions M"
        using LS_single_transition by force
      then have "q1'  states M" and "q2'  states M" using fsm_transition_target by auto
    
      have "tl io  LS M q1'  LS M q2'"
        using observable_language_transition_target[OF observable M (q1,x,y,q1')  transitions M]
              observable_language_transition_target[OF observable M (q2,x,y,q2')  transitions M]
              io  LS M q1  LS M q2
        unfolding fst_conv snd_conv
        by (metis Un_iff hd io = (x, y) io = [hd io] @ tl io append_Cons append_Nil) 
      moreover have "tl io  LS M q1'  LS M q2'"
        using observable_language_transition_target[OF observable M (q1,x,y,q1')  transitions M]
              observable_language_transition_target[OF observable M (q2,x,y,q2')  transitions M]
              io  LS M q1  LS M q2
        unfolding fst_conv snd_conv
        by (metis Int_iff LS_prepend_transition (q1, x, y, q1')  FSM.transitions M (q2, x, y, q2')  FSM.transitions M hd io = (x, y) io  [] io  LS M q1  LS M q2 fst_conv list.collapse snd_conv)    
      ultimately have "((tl io)  LS M q1')  (tl io  LS M q2')"
        by blast
      moreover have "length (tl io)  k"
        using length io  Suc k by auto
      ultimately have "q2'  ofsm_table M (λq . states M)  k q1'"
        unfolding ofsm_table_set_observable[OF assms(1) q1'  states M minimise_initial_partition] 
        by blast
      then have "ofsm_table M (λq . states M)  k q1'  ofsm_table M (λq . states M)  k q2'"
        by (metis q2'  FSM.states M ofsm_table_containment) 
      moreover have "h_obs M q1 x y = Some q1'"
        using (q1,x,y,q1')  transitions M observable M unfolding h_obs_Some[OF observable M] observable_alt_def by auto
      moreover have "h_obs M q2 x y = Some q2'"
        using (q2,x,y,q2')  transitions M observable M unfolding h_obs_Some[OF observable M] observable_alt_def by auto
      ultimately have "f1' (x,y) = Some ((x,y),(Some q1', Some q2'))"
        unfolding f1' by force
          
      moreover have "(x,y)  list.set xs"
        unfolding xs 
        using fsm_transition_output[OF (q1,x,y,q1')  transitions M] outputs_as_list_set[of M]
        using fsm_transition_input[OF (q1,x,y,q1')  transitions M] inputs_as_list_set[of M] 
        using image_iff by fastforce 
      ultimately show ?thesis 
        by blast
    qed
  qed

  ultimately have "f2 xs = (io,(b,a))"
    by blast
  then show ?thesis
    unfolding select_diverging_ofsm_table_io.simps f2 f2' xs Let_def by auto
qed


lemma assemble_distinguishing_sequence_from_ofsm_table_sym :
  assumes "observable M"
  and     "q1  states M"
  and     "q2  states M"
  and     "ofsm_table M (λq . states M)  k q1  ofsm_table M (λq . states M)  k q2"
shows "assemble_distinguishing_sequence_from_ofsm_table M q1 q2 k = assemble_distinguishing_sequence_from_ofsm_table M q2 q1 k"
  using assms(2,3,4) proof (induction k arbitrary: q1 q2)
  case 0
  then show ?case by auto
next
  case (Suc k)
  obtain xy a b where "select_diverging_ofsm_table_io M q1 q2 (Suc k) = (xy,(a,b))"
    using prod_cases3 by blast
  then have "select_diverging_ofsm_table_io M q2 q1 (Suc k) = (xy,(b, a))"
      using select_diverging_ofsm_table_io_sym[OF assms(1) Suc.prems] by auto

  consider " q1' q2' . a = Some q1'  b = Some q2'" | "a = None  b = None"
    using option.exhaust_sel by auto 
  then show ?case proof cases
    case 1
    then obtain q1' q2' where "select_diverging_ofsm_table_io M q1 q2 (Suc k) = (xy,(Some q1', Some q2'))"
      using select_diverging_ofsm_table_io M q1 q2 (Suc k) = (xy,(a,b)) by auto
    then have "select_diverging_ofsm_table_io M q2 q1 (Suc k) = (xy,(Some q2', Some q1'))"
      using select_diverging_ofsm_table_io_sym[OF assms(1) Suc.prems] by auto

    obtain x y where "select_diverging_ofsm_table_io M q1 q2 (Suc k) = ((x,y),(h_obs M q1 x y, h_obs M q2 x y))"
                 and " q1' q2' . h_obs M q1 x y = Some q1'  h_obs M q2 x y = Some q2'  ofsm_table M (λq . states M)  k q1'  ofsm_table M (λq . states M)  k q2'"
                 and "h_obs M q1 x y  None  h_obs M q2 x y  None"
      using select_diverging_ofsm_table_io_Some(1)[OF assms(1) Suc.prems]
      by blast
    then have "xy = (x,y)" and "h_obs M q1 x y = Some q1'" and "h_obs M q2 x y = Some q2'"
      using select_diverging_ofsm_table_io M q1 q2 (Suc k) = (xy,(Some q1', Some q2')) by auto
    then have "q1'  states M" and "q2'  states M"
      unfolding h_obs_Some[OF assms(1)] using fsm_transition_target by fastforce+
    moreover have "ofsm_table M (λq . states M)  k q1'  ofsm_table M (λq . states M)  k q2'"
      using h_obs M q1 x y = Some q1' h_obs M q2 x y = Some q2'  q1' q2' . h_obs M q1 x y = Some q1'  h_obs M q2 x y = Some q2'  ofsm_table M (λq . states M)  k q1'  ofsm_table M (λq . states M)  k q2'
      by blast
    ultimately have "assemble_distinguishing_sequence_from_ofsm_table M  q1' q2' k = assemble_distinguishing_sequence_from_ofsm_table M  q2' q1' k"
      using Suc.IH by auto
    then show ?thesis
      using select_diverging_ofsm_table_io M q1 q2 (Suc k) = (xy,(Some q1', Some q2'))
            select_diverging_ofsm_table_io M q2 q1 (Suc k) = (xy,(Some q2', Some q1'))
      by auto
  next
    case 2

    obtain x y where "xy = (x,y)"
      using prod.exhaust by metis
    have helper: " f f1 f2 .(case ((x,y),(a,b)) of ((x,y),(Some a',Some b'))  f1 x y a' b' | ((x,y),_)  f2 x y) = f2 x y"
      using 2 by (metis case_prod_conv option.case_eq_if)
    have helper2: " f f1 f2 .(case ((x,y),(b,a)) of ((x,y),(Some a',Some b'))  f1 x y a' b' | ((x,y),_)  f2 x y) = f2 x y"
      using 2 by (metis case_prod_conv option.case_eq_if)
    

    have "assemble_distinguishing_sequence_from_ofsm_table M  q1 q2 (Suc k) = [xy]"
      unfolding assemble_distinguishing_sequence_from_ofsm_table.simps
                select_diverging_ofsm_table_io M q1 q2 (Suc k) = (xy,(a, b))  xy = (x,y) helper 
      by simp
    moreover have "assemble_distinguishing_sequence_from_ofsm_table M  q2 q1 (Suc k) = [xy]"
      unfolding assemble_distinguishing_sequence_from_ofsm_table.simps
                select_diverging_ofsm_table_io M q2 q1 (Suc k) = (xy,(b, a))  xy = (x,y) helper2 
      by simp
    ultimately show ?thesis 
      by simp 
  qed
qed 

lemma find_first_distinct_ofsm_table_sym :
  assumes "q1  FSM.states M" 
      and "q2  FSM.states M"
      and "ofsm_table_fix M (λq . states M) 0 q1  ofsm_table_fix M (λq . states M) 0 q2"
shows  "find_first_distinct_ofsm_table M q1 q2 = find_first_distinct_ofsm_table M q2 q1"
proof -
  have " q1 q2 . q1  FSM.states M  q2  FSM.states M  ofsm_table_fix M (λq . states M) 0 q1  ofsm_table_fix M (λq . states M) 0 q2  find_first_distinct_ofsm_table M q2 q1 < find_first_distinct_ofsm_table M q1 q2  False"
  proof -
    fix q1 q2 assume "q1  FSM.states M" and "q2  FSM.states M"
                 and "ofsm_table_fix M (λq . states M) 0 q1  ofsm_table_fix M (λq . states M) 0 q2"
                 and "find_first_distinct_ofsm_table M q2 q1 < find_first_distinct_ofsm_table M q1 q2"
  
    show False
      using find_first_distinct_ofsm_table_is_first(1)[OF q1  FSM.states M q2  FSM.states M ofsm_table_fix M (λq . states M) 0 q1  ofsm_table_fix M (λq . states M) 0 q2]
            find_first_distinct_ofsm_table_is_first(2)[OF q1  FSM.states M q2  FSM.states M ofsm_table_fix M (λq . states M) 0 q1  ofsm_table_fix M (λq . states M) 0 q2 find_first_distinct_ofsm_table M q2 q1 < find_first_distinct_ofsm_table M q1 q2]
            find_first_distinct_ofsm_table M q2 q1 < find_first_distinct_ofsm_table M q1 q2
      by (metis ofsm_table_fix M (λq . states M) 0 q1  ofsm_table_fix M (λq . states M) 0 q2 q1  FSM.states M q2  FSM.states M find_first_distinct_ofsm_table_gt_is_first_gt(1))
  qed
  then show ?thesis
    using assms
    by (metis linorder_neqE_nat) 
qed


lemma get_distinguishing_sequence_from_ofsm_tables_sym :
  assumes "observable M"
  and     "minimal M"
  and     "q1  states M"
  and     "q2  states M"
  and     "q1  q2"
shows "get_distinguishing_sequence_from_ofsm_tables M q1 q2 = get_distinguishing_sequence_from_ofsm_tables M q2 q1"
proof -

  have "ofsm_table_fix M (λq . states M) 0 q1  ofsm_table_fix M (λq . states M) 0 q2"
    using minimal M unfolding minimal_observable_code[OF assms(1)]
    using assms(3,4,5) by blast

  let ?k = "find_first_distinct_ofsm_table_gt M q1 q2 0"
  have "ofsm_table M (λq . states M)  ?k q1  ofsm_table M (λq . states M)  ?k q2"
    using find_first_distinct_ofsm_table_is_first(1)[OF assms(3,4) ofsm_table_fix M (λq . states M) 0 q1  ofsm_table_fix M (λq . states M) 0 q2] .

  show ?thesis
    using assemble_distinguishing_sequence_from_ofsm_table_sym[OF assms(1,3,4) ofsm_table M (λq . states M)  ?k q1  ofsm_table M (λq . states M)  ?k q2]
    unfolding get_distinguishing_sequence_from_ofsm_tables.simps Let_def
              find_first_distinct_ofsm_table_sym[OF assms(3,4) ofsm_table_fix M (λq . states M) 0 q1  ofsm_table_fix M (λq . states M) 0 q2] .
qed

subsubsection ‹Harmonised State Identifiers›


fun add_distinguishing_sequence :: "('a,'b::linorder,'c::linorder) fsm  (('b×'c) list × 'a) × (('b×'c) list × 'a)  ('b×'c) prefix_tree  ('b×'c) prefix_tree" where
  "add_distinguishing_sequence M ((α,q1), (β,q2)) t = insert empty (get_distinguishing_sequence_from_ofsm_tables M q1 q2)"

lemma add_distinguishing_sequence_distinguishes :
  assumes "observable M"
  and     "minimal M"
  and     "α  L M"
  and     "β  L M" 
  and     "after_initial M α  after_initial M β" 
shows " io  set (add_distinguishing_sequence M ((α,after_initial M α),(β,after_initial M β)) t)  (set (after t α)  set (after t β)) .  distinguishes M (after_initial M α) (after_initial M β) io"
proof -
  have "set (add_distinguishing_sequence M ((α,after_initial M α),(β,after_initial M β)) t) = set (insert empty (get_distinguishing_sequence_from_ofsm_tables M (after_initial M α) (after_initial M β)))"
    by auto
  then have "get_distinguishing_sequence_from_ofsm_tables M (after_initial M α) (after_initial M β)  set (add_distinguishing_sequence M ((α,after_initial M α),(β,after_initial M β)) t)  (set (after t α)  set (after t β))"
    unfolding insert_set by auto
  then show ?thesis 
    using get_distinguishing_sequence_from_ofsm_tables_is_distinguishing_trace(1,2)[OF assms(1,2) after_is_state[OF assms(1,3)] after_is_state[OF assms(1,4)] assms(5)]
    by (meson distinguishes_def) 
qed

lemma add_distinguishing_sequence_finite : 
  "finite_tree (add_distinguishing_sequence M ((α,after_initial M α),(β,after_initial M β)) t)"
  unfolding add_distinguishing_sequence.simps
  using insert_finite_tree[OF empty_finite_tree] by metis



fun get_HSI :: "('a::linorder,'b::linorder,'c::linorder) fsm  'a  ('b×'c) prefix_tree" where
  "get_HSI M q = from_list (map (λq' . get_distinguishing_sequence_from_ofsm_tables M q q') (filter ((≠) q) (states_as_list M)))"


lemma get_HSI_elem :
  assumes "q2  states M"
  and     "q2  q1"
shows "get_distinguishing_sequence_from_ofsm_tables M q1 q2  set (get_HSI M q1)"
proof -
  have "q2  list.set (filter ((≠) q1) (states_as_list M))"
    using assms unfolding states_as_list_set[of M,symmetric] by auto
  then have *:"get_distinguishing_sequence_from_ofsm_tables M q1 q2  list.set (map (λq' . get_distinguishing_sequence_from_ofsm_tables M q1 q') (filter ((≠) q1) (states_as_list M)))"
    by auto
  show ?thesis
    using from_list_set_elem[OF *]
    unfolding get_HSI.simps .
qed

lemma get_HSI_distinguishes :
  assumes "observable M"
  and     "minimal M"
  and     "q1  states M" and "q2  states M" and "q1  q2"
shows " io  set (get_HSI M q1)  set (get_HSI M q2) . distinguishes M q1 q2 io"
proof -

  have "get_distinguishing_sequence_from_ofsm_tables M q2 q1  set (get_HSI M q1)"
    using get_HSI_elem[OF assms(4), of q1] assms(5) 
    unfolding get_distinguishing_sequence_from_ofsm_tables_sym[OF assms]
    by metis
  moreover have "get_distinguishing_sequence_from_ofsm_tables M q2 q1  set (get_HSI M q2)"
    using get_HSI_elem[OF assms(3)] assms(5) by metis
  moreover have "distinguishes M q1 q2 (get_distinguishing_sequence_from_ofsm_tables M q2 q1)"
    using get_distinguishing_sequence_from_ofsm_tables_is_distinguishing_trace(1,2)[OF assms]
    unfolding get_distinguishing_sequence_from_ofsm_tables_sym[OF assms]
    unfolding distinguishes_def
    by blast
  ultimately show ?thesis
    by blast
qed
    
lemma get_HSI_finite :
  "finite_tree (get_HSI M q)"
  unfolding get_HSI.simps using from_list_finite_tree by metis


subsubsection ‹Distinguishing Sets›

fun distinguishing_set :: "('a :: linorder, 'b :: linorder, 'c :: linorder) fsm  ('b × 'c) prefix_tree" where
  "distinguishing_set M = (let 
    pairs = filter (λ (x,y) . x  y) (list_ordered_pairs (states_as_list M))
  in from_list (map (case_prod (get_distinguishing_sequence_from_ofsm_tables M)) pairs))"



lemma distinguishing_set_distinguishes :
  assumes "observable M"
  and     "minimal M"
  and     "q1  states M"
  and     "q2  states M" 
  and     "q1  q2"   
shows " io  set (distinguishing_set M) .  distinguishes M q1 q2 io"
proof -
  define pairs where pairs: "pairs = filter (λ (x,y) . x  y) (list_ordered_pairs (states_as_list M))"
  then have *: "distinguishing_set M = from_list (map (case_prod (get_distinguishing_sequence_from_ofsm_tables M)) pairs)"
    by auto

  have "q1  list.set (states_as_list M)" and "q2  list.set (states_as_list M)"
    unfolding states_as_list_set using assms(3,4) by blast+
  then have "(q1,q2)  list.set pairs  (q2,q1)  list.set pairs"
    using list_ordered_pairs_set_containment[OF _ _ assms(5)] assms(5) unfolding pairs by auto
  then have "get_distinguishing_sequence_from_ofsm_tables M q1 q2  list.set (map (case_prod (get_distinguishing_sequence_from_ofsm_tables M)) pairs)
              | get_distinguishing_sequence_from_ofsm_tables M q2 q1  list.set (map (case_prod (get_distinguishing_sequence_from_ofsm_tables M)) pairs)"
    by (metis image_iff old.prod.case set_map)
  then have "get_distinguishing_sequence_from_ofsm_tables M q1 q2  set (distinguishing_set M) 
               get_distinguishing_sequence_from_ofsm_tables M q2 q1  set (distinguishing_set M)"
    unfolding * from_list_set by blast
  then show ?thesis
    using get_distinguishing_sequence_from_ofsm_tables_is_distinguishing_trace(1,2)[OF assms]
          get_distinguishing_sequence_from_ofsm_tables_is_distinguishing_trace(1,2)[OF assms(1,2,4,3)] assms(5)
    unfolding distinguishes_def by blast
qed


lemma distinguishing_set_finite :
  "finite_tree (distinguishing_set M)"
  unfolding distinguishing_set.simps Let_def
  using from_list_finite_tree by metis




function (domintros) intersection_is_distinguishing :: "('a,'b,'c) fsm  ('b × 'c) prefix_tree  'a  ('b × 'c) prefix_tree  'a  bool" where
  "intersection_is_distinguishing M (PT t1) q1 (PT t2) q2 = 
    ( (x,y)  dom t1  dom t2 .
      case h_obs M q1 x y of
        None  h_obs M q2 x y  None |
        Some q1'  (case h_obs M q2 x y of
          None  True |
          Some q2'  intersection_is_distinguishing M (the (t1 (x,y))) q1' (the (t2 (x,y))) q2'))"
  by pat_completeness auto
termination 
proof -
  {
    fix M :: "('a,'b,'c) fsm"
    fix t1
    fix q1
    fix t2
    fix q2
  
    have "intersection_is_distinguishing_dom (M, t1,q1, t2,q2)" 
    proof (induction t1 arbitrary: t2 q1 q2)
      case (PT m1)
  
      obtain m2 where "t2 = PT m2"
        by (metis prefix_tree.exhaust)
  
      have "(xy t1' t2' q1' q2' . m1 xy = Some t1'  intersection_is_distinguishing_dom (M, t1', q1', t2', q2'))"
      proof -
        fix xy t1' t2' q1' q2' assume "m1 xy = Some t1'"
  
        then have "Some t1'  range m1"
          by (metis  range_eqI) 
        
        show "intersection_is_distinguishing_dom (M, t1', q1', t2', q2')"
          using PT(1)[OF Some t1'  range m1]
          by simp 
      qed
  
      then show ?case
        using intersection_is_distinguishing.domintros[of q1 M q2 m1 m2] unfolding t2 = PT m2 by blast
    qed
  }
  then show ?thesis by auto
qed


        

lemma intersection_is_distinguishing_code[code] :
  "intersection_is_distinguishing M (MPT t1) q1 (MPT t2) q2 = 
    ( (x,y)  Mapping.keys t1  Mapping.keys t2 .
      case h_obs M q1 x y of
        None  h_obs M q2 x y  None |
        Some q1'  (case h_obs M q2 x y of
          None  True |
          Some q2'  intersection_is_distinguishing M (the (Mapping.lookup t1 (x,y))) q1' (the (Mapping.lookup  t2 (x,y))) q2'))"
  unfolding intersection_is_distinguishing.simps MPT_def
  by (simp add: keys_dom_lookup) 

lemma intersection_is_distinguishing_correctness :
  assumes "observable M"
  and     "q1  states M"
  and     "q2  states M"
shows "intersection_is_distinguishing M t1 q1 t2 q2 = ( io . isin t1 io  isin t2 io  distinguishes M q1 q2 io)"
  (is "?P1 = ?P2")
proof 
  show "?P1  ?P2"
  proof (induction t1 arbitrary: t2 q1 q2)
    case (PT m1)

    obtain m2 where "t2 = PT m2"
      using prefix_tree.exhaust by blast
    then obtain x y where "(x,y)  dom m1" and "(x,y)  dom m2"
                            and *: "case h_obs M q1 x y of
                                    None  h_obs M q2 x y  None |
                                    Some q1'  (case h_obs M q2 x y of
                                      None  True |
                                      Some q2'  intersection_is_distinguishing M (the (m1 (x,y))) q1' (the (m2 (x,y))) q2')"
      using PT.prems(1) intersection_is_distinguishing.simps by force

    obtain t1' where "m1 (x,y) = Some t1'"
      using (x,y)  dom m1 by auto
    then have "isin (PT m1) [(x,y)]"
      by auto

    obtain t2' where "m2 (x,y) = Some t2'"
      using (x,y)  dom m2 by auto
    then have "isin t2 [(x,y)]"
      unfolding t2 = PT m2 by auto

    show ?case proof (cases "h_obs M q1 x y")
      case None
      then have "h_obs M q2 x y  None"
        using * by auto
      then have "[(x,y)]  LS M q2"
        unfolding LS_single_transition h_obs_None[OF observable M]
        by fastforce
      moreover have "[(x,y)]  LS M q1"
        using None unfolding LS_single_transition h_obs_None[OF observable M]
        by auto
      ultimately have "distinguishes M q1 q2 [(x,y)]"
        unfolding distinguishes_def by blast
      then show ?thesis 
        using isin (PT m1) [(x,y)] isin t2 [(x,y)] by blast
    next
      case (Some q1')
      then have "[(x,y)]  LS M q1"
        unfolding LS_single_transition h_obs_Some[OF observable M]
        using insert_compr by fastforce
        
      
      show ?thesis proof (cases "h_obs M q2 x y")
        case None
        then have "[(x,y)]  LS M q2"
          unfolding LS_single_transition h_obs_None[OF observable M]
          by auto
        then have "distinguishes M q1 q2 [(x,y)]"
          using [(x,y)]  LS M q1 unfolding distinguishes_def by blast
        then show ?thesis 
          using isin (PT m1) [(x,y)] isin t2 [(x,y)] by blast
      next
        case (Some q2')
        then have "intersection_is_distinguishing M (the (m1 (x,y))) q1' (the (m2 (x,y))) q2'"
          using h_obs M q1 x y = Some q1' * by auto
        moreover have "(the (m1 (x,y))) = t1'"
          using m1 (x,y) = Some t1' by auto
        moreover have "(the (m2 (x,y))) = t2'"
          using m2 (x,y) = Some t2' by auto
        ultimately have "intersection_is_distinguishing M t1' q1' t2' q2'"
          by simp
        then have "io. isin t1' io  isin t2' io  distinguishes M q1' q2' io"
          using PT.IH[of "Some t1'" t1' q1' t2' q2']
          by (metis m1 (x, y) = Some t1' option.set_intros rangeI) 
        then obtain io where "isin t1' io"
                         and "isin t2' io"
                         and "distinguishes M q1' q2' io"
          by blast

        have "isin (PT m1) ((x,y)#io)"
          using m1 (x, y) = Some t1' isin t1' io by auto
        moreover have "isin t2 ((x,y)#io)"
          using t2 = PT m2 m2 (x, y) = Some t2' isin t2' io by auto
        moreover have "distinguishes M q1 q2 ((x,y)#io)"
          using h_obs_language_iff[OF observable M, of x y io  q1] unfolding h_obs M q1 x y = Some q1' 
          using h_obs_language_iff[OF observable M, of x y io  q2] unfolding Some
          using distinguishes M q1' q2' io
          unfolding distinguishes_def
          by auto
        ultimately show ?thesis
          by blast
      qed
    qed
  qed

  show "?P2  ?P1"
  proof -
    assume ?P2
    then obtain io where "isin t1 io" 
                     and "isin t2 io" 
                     and "distinguishes M q1 q2 io"
      by blast
    then show ?P1 
    using assms(2,3) proof (induction io arbitrary: t1 t2 q1 q2)
      case Nil 
      then have "[]  LS M q1  LS M q2"
        by auto
      then have "¬ distinguishes M q1 q2 []"
        unfolding distinguishes_def by blast
      then show ?case 
        using distinguishes M q1 q2 [] by simp
    next
      case (Cons a io)

      obtain x y where "a = (x,y)"
        by fastforce

      obtain m1 where "t1 = PT m1"
        using prefix_tree.exhaust by blast
      obtain t1' where "m1 (x,y) = Some t1'"
                   and "isin t1' io"
        using isin t1 (a # io) unfolding a = (x,y) t1 = PT m1 isin.simps
        using case_optionE by blast 
  
      obtain m2 where "t2 = PT m2"
        using prefix_tree.exhaust by blast
      obtain t2' where "m2 (x,y) = Some t2'"
                   and "isin t2' io"
        using isin t2 (a # io) unfolding a = (x,y) t2 = PT m2 isin.simps
        using case_optionE by blast
      then have "(x,y)  dom m1  dom m2"
        using m1 (x,y) = Some t1' by auto
    

      show ?case proof (cases "h_obs M q1 x y")
        case None
        then have "[(x,y)]  LS M q1"
          unfolding LS_single_transition h_obs_None[OF observable M]
          by auto
        then have "a#io  LS M q1"
          unfolding a = (x,y)
          by (metis None assms(1) h_obs_language_iff option.distinct(1))
        then have "a#io  LS M q2"
          using distinguishes M q1 q2 (a#io) unfolding distinguishes_def by blast
        then have "[(x,y)]  LS M q2"
          unfolding a = (x,y)
          using language_prefix
          by (metis append_Cons append_Nil) 
        then have "h_obs M q2 x y  None"
          unfolding h_obs_None[OF observable M] LS_single_transition by force
        then show ?thesis
          using None (x,y)  dom m1  dom m2 unfolding t1 = PT m1 t2 = PT m2 
          by force
      next
        case (Some q1') 
        then have "[(x,y)]  LS M q1"
          unfolding LS_single_transition h_obs_Some[OF observable M]
          by (metis Some assms(1) fst_conv h_obs_None option.distinct(1) snd_conv) 
  
        show ?thesis proof (cases "h_obs M q2 x y")
          case None
          then show ?thesis 
            using Some (x,y)  dom m1  dom m2 unfolding t1 = PT m1 t2 = PT m2  
            unfolding intersection_is_distinguishing.simps
            by (metis (no_types, lifting) case_prodI option.case_eq_if option.distinct(1)) 
        next
          case (Some q2')

          have "distinguishes M q1' q2' io"
            using h_obs_language_iff[OF observable M, of x y io  q1] unfolding h_obs M q1 x y = Some q1' 
            using h_obs_language_iff[OF observable M, of x y io  q2] unfolding Some
            using distinguishes M q1 q2 (a#io) unfolding a = (x,y) distinguishes_def 
            by blast
          moreover have "q1'  states M" and "q2'  states M"
            using Some h_obs M q1 x y = Some q1' unfolding h_obs_Some[OF observable M]
            using fsm_transition_target[where M=M]
            by fastforce+
          ultimately have "intersection_is_distinguishing M t1' q1' t2' q2'"
            using Cons.IH[OF isin t1' io isin t2' io]
            by auto
          then show ?thesis 
            using (x,y)  dom m1  dom m2 Some h_obs M q1 x y = Some q1' 
            unfolding t1 = PT m1 t2 = PT m2
            unfolding intersection_is_distinguishing.simps
            by (metis (no_types, lifting) m1 (x, y) = Some t1' m2 (x, y) = Some t2' case_prodI option.case_eq_if option.distinct(1) option.sel) 
        qed
      qed
    qed
  qed
qed


fun contains_distinguishing_trace :: "('a,'b,'c) fsm  ('b × 'c) prefix_tree  'a  'a  bool" where
  "contains_distinguishing_trace M T q1 q2 = intersection_is_distinguishing M T q1 T q2"

lemma contains_distinguishing_trace_code[code] :
  "contains_distinguishing_trace M (MPT t1) q1 q2 = 
    ( (x,y)  Mapping.keys t1.
      case h_obs M q1 x y of
        None  h_obs M q2 x y  None |
        Some q1'  (case h_obs M q2 x y of
          None  True |
          Some q2'  contains_distinguishing_trace M (the (Mapping.lookup t1 (x,y))) q1' q2'))"
  unfolding intersection_is_distinguishing.simps MPT_def
  by (simp add: keys_dom_lookup) 

lemma contains_distinguishing_trace_correctness :
  assumes "observable M"
  and     "q1  states M"
  and     "q2  states M"
shows "contains_distinguishing_trace M t q1 q2 = ( io . isin t io  distinguishes M q1 q2 io)"
  using intersection_is_distinguishing_correctness[OF assms]
  by simp  


fun distinguishing_set_reduced :: "('a :: linorder, 'b :: linorder, 'c :: linorder) fsm  ('b × 'c) prefix_tree" where
  "distinguishing_set_reduced M = (let 
    pairs = filter (λ (q,q') . q  q') (list_ordered_pairs (states_as_list M));
    handlePair = (λ W (q,q') . if contains_distinguishing_trace M W q q'
                                then W
                                else insert W (get_distinguishing_sequence_from_ofsm_tables M q q'))
   in foldl handlePair empty pairs)" 


lemma distinguishing_set_reduced_distinguishes :
  assumes "observable M"
  and     "minimal M"
  and     "q1  states M"
  and     "q2  states M" 
  and     "q1  q2"   
shows " io  set (distinguishing_set_reduced M) . distinguishes M q1 q2 io"
proof -
  define pairs where pairs: "pairs = filter (λ (x,y) . x  y) (list_ordered_pairs (states_as_list M))"
  
  
  define handlePair where "handlePair = (λ W (q,q') . if contains_distinguishing_trace M W q q'
                                then W
                                else insert W (get_distinguishing_sequence_from_ofsm_tables M q q'))"

  have "distinguishing_set_reduced M = foldl handlePair empty pairs"
    unfolding distinguishing_set_reduced.simps handlePair_def pairs Let_def by metis
  
  have handlePair_subset: " W q q' . set W  set (handlePair W (q,q'))"
    unfolding handlePair_def
    using insert_set unfolding case_prod_conv
    by (metis (mono_tags) Un_upper1 order_refl)


  have "q1  list.set (states_as_list M)" and "q2  list.set (states_as_list M)"
    unfolding states_as_list_set using assms(3,4) by blast+
  then have "(q1,q2)  list.set pairs  (q2,q1)  list.set pairs"
    using list_ordered_pairs_set_containment[OF _ _ assms(5)] assms(5) unfolding pairs by auto
  moreover have " pairs' . list.set pairs'  list.set pairs  (q1,q2)  list.set pairs'  (q2,q1)  list.set pairs'  ( io  set (foldl handlePair empty pairs') .  distinguishes M q1 q2 io)"
  proof -
    fix pairs' assume "list.set pairs'  list.set pairs" and "(q1,q2)  list.set pairs'  (q2,q1)  list.set pairs'"
    then show "( io  set (foldl handlePair empty pairs') .  distinguishes M q1 q2 io)"
    proof (induction pairs' rule: rev_induct)
      case Nil
      then show ?case by auto
    next
      case (snoc qq qqs)

      define W where "W = foldl handlePair empty qqs"
      have "foldl handlePair empty (qqs@[qq]) = handlePair W qq"
        unfolding W_def by auto
      then have W_subset: "set W  set (foldl handlePair empty (qqs@[qq]))"
        by (metis handlePair_subset prod.collapse)


      have handlePair_sym : "handlePair W (q1,q2) = handlePair W (q2,q1)"
        unfolding handlePair_def case_prod_conv
        unfolding contains_distinguishing_trace_correctness[OF assms(1,3,4)] contains_distinguishing_trace_correctness[OF assms(1,4,3)]
        unfolding get_distinguishing_sequence_from_ofsm_tables_sym[OF assms]
        using distinguishes_sym
        by metis

      show ?case proof (cases "qq = (q1,q2)  qq = (q2,q1)")
        case True
        then have "foldl handlePair empty (qqs@[qq]) = handlePair W (q1,q2)"
          unfolding foldl handlePair empty (qqs@[qq]) = handlePair W qq
          using handlePair_sym
          by auto

        show ?thesis proof (cases "contains_distinguishing_trace M W q1 q2")
          case True
          then show ?thesis 
            unfolding contains_distinguishing_trace_correctness[OF assms(1,3,4)]
            using W_subset
            by auto 
        next
          case False
          then have "foldl handlePair empty (qqs@[qq]) = insert W (get_distinguishing_sequence_from_ofsm_tables M q1 q2)"
            unfolding foldl handlePair empty (qqs@[qq]) = handlePair W (q1,q2)
            unfolding handlePair_def case_prod_conv
            by auto
          then have "get_distinguishing_sequence_from_ofsm_tables M q1 q2  set (foldl handlePair empty (qqs@[qq]))"
            using insert_isin
            by metis 
          then show ?thesis 
            using get_distinguishing_sequence_from_ofsm_tables_distinguishes[OF assms]
            by blast
        qed
      next
        case False
        then have "(q1, q2)  list.set qqs  (q2, q1)  list.set qqs"
          using snoc.prems by auto
        then show ?thesis using snoc W_subset unfolding W_def
          by (meson dual_order.trans list_prefix_subset subsetD)
      qed
    qed
  qed
  ultimately show ?thesis
    unfolding distinguishing_set_reduced M = foldl handlePair empty pairs
    by blast
qed


lemma distinguishing_set_reduced_finite :
  "finite_tree (distinguishing_set_reduced M)"
proof -
  define pairs where pairs: "pairs = filter (λ (x,y) . x  y) (list_ordered_pairs (states_as_list M))"
  
  
  define handlePair where "handlePair = (λ W (q,q') . if contains_distinguishing_trace M W q q'
                                then W
                                else insert W (get_distinguishing_sequence_from_ofsm_tables M q q'))"

  have "distinguishing_set_reduced M = foldl handlePair empty pairs"
    unfolding distinguishing_set_reduced.simps handlePair_def pairs Let_def by metis

  show ?thesis
    unfolding distinguishing_set_reduced M = foldl handlePair empty pairs
  proof (induction pairs rule: rev_induct)
    case Nil
    then show ?case using empty_finite_tree by auto
  next
    case (snoc qq qqs)
    define W where "W = foldl handlePair empty qqs"
    have "foldl handlePair empty (qqs@[qq]) = handlePair W qq"
      unfolding W_def by auto 

    have "finite_tree W"
      using snoc W_def by auto
    then show ?case
      unfolding foldl handlePair empty (qqs@[qq]) = handlePair W qq
      unfolding handlePair_def
      using insert_finite_tree[of W]
      by (simp add: case_prod_unfold) 
  qed
qed
  


fun add_distinguishing_set :: "('a :: linorder, 'b :: linorder, 'c :: linorder) fsm  (('b×'c) list × 'a) × (('b×'c) list × 'a)  ('b×'c) prefix_tree  ('b×'c) prefix_tree" where
  "add_distinguishing_set M _ t = distinguishing_set M"



lemma add_distinguishing_set_distinguishes :
  assumes "observable M"
  and     "minimal M"
  and     "α  L M"
  and     "β  L M" 
  and     "after_initial M α  after_initial M β"   
shows " io  set (add_distinguishing_set M ((α,after_initial M α),(β,after_initial M β)) t)  (set (after t α)  set (after t β)) . distinguishes M (after_initial M α) (after_initial M β) io"
  using distinguishing_set_distinguishes[OF assms(1,2) after_is_state[OF assms(1,3)] after_is_state[OF assms(1,4)] assms(5)]
  by force

lemma add_distinguishing_set_finite : 
  "finite_tree ((add_distinguishing_set M) x t)"
  unfolding add_distinguishing_set.simps distinguishing_set.simps Let_def
  using from_list_finite_tree
  by simp



subsection ‹Transition Sorting›

definition sort_unverified_transitions_by_state_cover_length :: "('a :: linorder,'b :: linorder,'c :: linorder) fsm  ('a,'b,'c) state_cover_assignment  ('a,'b,'c) transition list  ('a,'b,'c) transition list" where
  "sort_unverified_transitions_by_state_cover_length M V ts = (let
      default_weight = 2 * size M;
      weights = mapping_of (map (λt . (t, length (V (t_source t)) + length (V (t_target t)))) ts);
      weight  = (λq . case Mapping.lookup weights q of Some w  w | None  default_weight)
    in mergesort_by_rel (λ t1 t2 . weight t1  weight t2) ts)"

lemma sort_unverified_transitions_by_state_cover_length_retains_set :
  "List.set xs = List.set (sort_unverified_transitions_by_state_cover_length M1 (get_state_cover M1) xs)"
  unfolding sort_unverified_transitions_by_state_cover_length_def Let_def
  unfolding set_mergesort_by_rel
  by simp 

end