diff --git a/thys/Transition_Systems_and_Automata/Automata/Deterministic.thy b/thys/Transition_Systems_and_Automata/Automata/Deterministic.thy --- a/thys/Transition_Systems_and_Automata/Automata/Deterministic.thy +++ b/thys/Transition_Systems_and_Automata/Automata/Deterministic.thy @@ -1,556 +1,556 @@ theory Deterministic imports "../Transition_Systems/Transition_System" "../Transition_Systems/Transition_System_Extra" "../Transition_Systems/Transition_System_Construction" "../Basic/Degeneralization" begin type_synonym ('label, 'state) trans = "'label \ 'state \ 'state" (* TODO: is there a way to be less verbose in these locales? do we need to specify all the types? *) locale automaton = fixes automaton :: "'label set \ 'state \ ('label, 'state) trans \ 'condition \ 'automaton" fixes alphabet :: "'automaton \ 'label set" fixes initial :: "'automaton \ 'state" fixes transition :: "'automaton \ ('label, 'state) trans" fixes condition :: "'automaton \ 'condition" assumes automaton[simp]: "automaton (alphabet A) (initial A) (transition A) (condition A) = A" assumes alphabet[simp]: "alphabet (automaton a i t c) = a" assumes initial[simp]: "initial (automaton a i t c) = i" assumes transition[simp]: "transition (automaton a i t c) = t" assumes condition[simp]: "condition (automaton a i t c) = c" begin (* TODO: is there a way to use defines without renaming the constants? *) sublocale transition_system_initial "transition A" "\ a p. a \ alphabet A" "\ p. p = initial A" for A defines path' = path and run' = run and reachable' = reachable and nodes' = nodes by this lemma path_alt_def: "path A w p \ set w \ alphabet A" unfolding lists_iff_set[symmetric] proof show "w \ lists (alphabet A)" if "path A w p" using that by (induct arbitrary: p) (auto) show "path A w p" if "w \ lists (alphabet A)" using that by (induct arbitrary: p) (auto) qed lemma run_alt_def: "run A w p \ sset w \ alphabet A" unfolding streams_iff_sset[symmetric] proof show "w \ streams (alphabet A)" if "run A w p" using that by (coinduction arbitrary: w p) (force elim: run.cases) show "run A w p" if "w \ streams (alphabet A)" using that by (coinduction arbitrary: w p) (force elim: streams.cases) qed end - (* TODO: create analogous locale for DFAs (automaton_target) *) + (* TODO: create analogous locale for DFAs (automaton_path) *) locale automaton_trace = automaton automaton alphabet initial transition condition for automaton :: "'label set \ 'state \ ('label, 'state) trans \ 'condition \ 'automaton" and alphabet :: "'automaton \ 'label set" and initial :: "'automaton \ 'state" and transition :: "'automaton \ ('label, 'state) trans" and condition :: "'automaton \ 'condition" + fixes test :: "'condition \ 'state stream \ bool" begin definition language :: "'automaton \ 'label stream set" where "language A \ {w. run A w (initial A) \ test (condition A) (trace A w (initial A))}" lemma language[intro]: assumes "run A w (initial A)" "test (condition A) (trace A w (initial A))" shows "w \ language A" using assms unfolding language_def by auto lemma language_elim[elim]: assumes "w \ language A" obtains "run A w (initial A)" "test (condition A) (trace A w (initial A))" using assms unfolding language_def by auto lemma language_alphabet: "language A \ streams (alphabet A)" unfolding language_def run_alt_def using sset_streams by auto end locale automaton_degeneralization = a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 + b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state \ ('label, 'state) trans \ 'state pred gen \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'state pred gen" and automaton\<^sub>2 :: "'label set \ 'state degen \ ('label, 'state degen) trans \ 'state degen pred \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state degen" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state degen) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'state degen pred" begin definition degeneralize :: "'automaton\<^sub>1 \ 'automaton\<^sub>2" where "degeneralize A \ automaton\<^sub>2 (alphabet\<^sub>1 A) (initial\<^sub>1 A, 0) (\ a (p, k). (transition\<^sub>1 A a p, count (condition\<^sub>1 A) p k)) (degen (condition\<^sub>1 A))" lemma degeneralize_simps[simp]: "alphabet\<^sub>2 (degeneralize A) = alphabet\<^sub>1 A" "initial\<^sub>2 (degeneralize A) = (initial\<^sub>1 A, 0)" "transition\<^sub>2 (degeneralize A) a (p, k) = (transition\<^sub>1 A a p, count (condition\<^sub>1 A) p k)" "condition\<^sub>2 (degeneralize A) = degen (condition\<^sub>1 A)" unfolding degeneralize_def by auto lemma degeneralize_target[simp]: "b.target (degeneralize A) w (p, k) = (a.target A w p, fold (count (condition\<^sub>1 A)) (butlast (p # a.states A w p)) k)" by (induct w arbitrary: p k) (auto) lemma degeneralize_states[simp]: "b.states (degeneralize A) w (p, k) = a.states A w p || scan (count (condition\<^sub>1 A)) (p # a.states A w p) k" by (induct w arbitrary: p k) (auto) lemma degeneralize_trace[simp]: "b.trace (degeneralize A) w (p, k) = a.trace A w p ||| sscan (count (condition\<^sub>1 A)) (p ## a.trace A w p) k" by (coinduction arbitrary: w p k) (auto) lemma degeneralize_path[iff]: "b.path (degeneralize A) w (p, k) \ a.path A w p" unfolding a.path_alt_def b.path_alt_def by simp lemma degeneralize_run[iff]: "b.run (degeneralize A) w (p, k) \ a.run A w p" unfolding a.run_alt_def b.run_alt_def by simp lemma degeneralize_reachable_fst[simp]: "fst ` b.reachable (degeneralize A) (p, k) = a.reachable A p" unfolding a.reachable_alt_def b.reachable_alt_def image_def by simp lemma degeneralize_reachable_snd_empty[simp]: assumes "condition\<^sub>1 A = []" shows "snd ` b.reachable (degeneralize A) (p, k) = {k}" proof - have "snd ql = k" if "ql \ b.reachable (degeneralize A) (p, k)" for ql using that assms by induct auto then show ?thesis by auto qed lemma degeneralize_reachable_empty[simp]: assumes "condition\<^sub>1 A = []" shows "b.reachable (degeneralize A) (p, k) = a.reachable A p \ {k}" using degeneralize_reachable_fst degeneralize_reachable_snd_empty assms by (metis prod_singleton(2)) lemma degeneralize_reachable_snd: "snd ` b.reachable (degeneralize A) (p, k) \ insert k {0 ..< length (condition\<^sub>1 A)}" by (cases "condition\<^sub>1 A = []") (auto) lemma degeneralize_reachable: "b.reachable (degeneralize A) (p, k) \ a.reachable A p \ insert k {0 ..< length (condition\<^sub>1 A)}" by (cases "condition\<^sub>1 A = []") (auto 0 3) lemma degeneralize_nodes_fst[simp]: "fst ` b.nodes (degeneralize A) = a.nodes A" unfolding a.nodes_alt_def b.nodes_alt_def by simp lemma degeneralize_nodes_snd_empty: assumes "condition\<^sub>1 A = []" shows "snd ` b.nodes (degeneralize A) = {0}" using assms unfolding b.nodes_alt_def by auto lemma degeneralize_nodes_empty: assumes "condition\<^sub>1 A = []" shows "b.nodes (degeneralize A) = a.nodes A \ {0}" using assms unfolding b.nodes_alt_def by auto lemma degeneralize_nodes_snd: "snd ` b.nodes (degeneralize A) \ insert 0 {0 ..< length (condition\<^sub>1 A)}" using degeneralize_reachable_snd unfolding b.nodes_alt_def by auto lemma degeneralize_nodes: "b.nodes (degeneralize A) \ a.nodes A \ insert 0 {0 ..< length (condition\<^sub>1 A)}" using degeneralize_reachable unfolding a.nodes_alt_def b.nodes_alt_def by simp lemma degeneralize_nodes_finite[iff]: "finite (b.nodes (degeneralize A)) \ finite (a.nodes A)" proof show "finite (a.nodes A)" if "finite (b.nodes (degeneralize A))" using that by (auto simp flip: degeneralize_nodes_fst) show "finite (b.nodes (degeneralize A))" if "finite (a.nodes A)" using finite_subset degeneralize_nodes that by blast qed lemma degeneralize_nodes_card: "card (b.nodes (degeneralize A)) \ max 1 (length (condition\<^sub>1 A)) * card (a.nodes A)" proof (cases "finite (a.nodes A)") case True have "card (b.nodes (degeneralize A)) \ card (a.nodes A \ insert 0 {0 ..< length (condition\<^sub>1 A)})" using degeneralize_nodes True by (blast intro: card_mono) also have "\ = card (insert 0 {0 ..< length (condition\<^sub>1 A)}) * card (a.nodes A)" unfolding card_cartesian_product by simp also have "card (insert 0 {0 ..< length (condition\<^sub>1 A)}) = max 1 (length (condition\<^sub>1 A))" by (simp add: card_insert_if Suc_leI max_absorb2) finally show ?thesis by this next case False then have "card (a.nodes A) = 0" "card (b.nodes (degeneralize A)) = 0" by auto then show ?thesis by simp qed end locale automaton_degeneralization_trace = automaton_degeneralization automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 + a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state \ ('label, 'state) trans \ 'state pred gen \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'state pred gen" and test\<^sub>1 :: "'state pred gen \ 'state stream \ bool" and automaton\<^sub>2 :: "'label set \ 'state degen \ ('label, 'state degen) trans \ 'state degen pred \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state degen" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state degen) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'state degen pred" and test\<^sub>2 :: "'state degen pred \ 'state degen stream \ bool" + assumes test[iff]: "test\<^sub>2 (degen cs) (r ||| sscan (count cs) (p ## r) k) \ test\<^sub>1 cs r" begin lemma degeneralize_language[simp]: "b.language (degeneralize A) = a.language A" by (force simp del: sscan_scons) end locale automaton_combination = a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 + b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 + c: automaton automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 for automaton\<^sub>1 :: "'label set \ 'state\<^sub>1 \ ('label, 'state\<^sub>1) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state\<^sub>1" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state\<^sub>1) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and automaton\<^sub>2 :: "'label set \ 'state\<^sub>2 \ ('label, 'state\<^sub>2) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state\<^sub>2" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state\<^sub>2) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and automaton\<^sub>3 :: "'label set \ 'state\<^sub>1 \ 'state\<^sub>2 \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans \ 'condition\<^sub>3 \ 'automaton\<^sub>3" and alphabet\<^sub>3 :: "'automaton\<^sub>3 \ 'label set" and initial\<^sub>3 :: "'automaton\<^sub>3 \ 'state\<^sub>1 \ 'state\<^sub>2" and transition\<^sub>3 :: "'automaton\<^sub>3 \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans" and condition\<^sub>3 :: "'automaton\<^sub>3 \ 'condition\<^sub>3" + fixes condition :: "'condition\<^sub>1 \ 'condition\<^sub>2 \ 'condition\<^sub>3" begin definition combine :: "'automaton\<^sub>1 \ 'automaton\<^sub>2 \ 'automaton\<^sub>3" where "combine A B \ automaton\<^sub>3 (alphabet\<^sub>1 A \ alphabet\<^sub>2 B) (initial\<^sub>1 A, initial\<^sub>2 B) (\ a (p, q). (transition\<^sub>1 A a p, transition\<^sub>2 B a q)) (condition (condition\<^sub>1 A) (condition\<^sub>2 B))" lemma combine_simps[simp]: "alphabet\<^sub>3 (combine A B) = alphabet\<^sub>1 A \ alphabet\<^sub>2 B" "initial\<^sub>3 (combine A B) = (initial\<^sub>1 A, initial\<^sub>2 B)" "transition\<^sub>3 (combine A B) a (p, q) = (transition\<^sub>1 A a p, transition\<^sub>2 B a q)" "condition\<^sub>3 (combine A B) = condition (condition\<^sub>1 A) (condition\<^sub>2 B)" unfolding combine_def by auto lemma combine_target[simp]: "c.target (combine A B) w (p, q) = (a.target A w p, b.target B w q)" by (induct w arbitrary: p q) (auto) lemma combine_states[simp]: "c.states (combine A B) w (p, q) = a.states A w p || b.states B w q" by (induct w arbitrary: p q) (auto) lemma combine_trace[simp]: "c.trace (combine A B) w (p, q) = a.trace A w p ||| b.trace B w q" by (coinduction arbitrary: w p q) (auto) lemma combine_path[iff]: "c.path (combine A B) w (p, q) \ a.path A w p \ b.path B w q" unfolding a.path_alt_def b.path_alt_def c.path_alt_def by simp lemma combine_run[iff]: "c.run (combine A B) w (p, q) \ a.run A w p \ b.run B w q" unfolding a.run_alt_def b.run_alt_def c.run_alt_def by simp lemma combine_reachable[simp]: "c.reachable (combine A B) (p, q) \ a.reachable A p \ b.reachable B q" unfolding c.reachable_alt_def by auto lemma combine_nodes[simp]: "c.nodes (combine A B) \ a.nodes A \ b.nodes B" unfolding a.nodes_alt_def b.nodes_alt_def c.nodes_alt_def by auto lemma combine_reachable_fst[simp]: assumes "alphabet\<^sub>1 A \ alphabet\<^sub>2 B" shows "fst ` c.reachable (combine A B) (p, q) = a.reachable A p" using assms unfolding a.reachable_alt_def a.path_alt_def unfolding b.reachable_alt_def b.path_alt_def unfolding c.reachable_alt_def c.path_alt_def by auto force lemma combine_reachable_snd[simp]: assumes "alphabet\<^sub>1 A \ alphabet\<^sub>2 B" shows "snd ` c.reachable (combine A B) (p, q) = b.reachable B q" using assms unfolding a.reachable_alt_def a.path_alt_def unfolding b.reachable_alt_def b.path_alt_def unfolding c.reachable_alt_def c.path_alt_def by auto force lemma combine_nodes_fst[simp]: assumes "alphabet\<^sub>1 A \ alphabet\<^sub>2 B" shows "fst ` c.nodes (combine A B) = a.nodes A" using assms combine_reachable_fst unfolding a.nodes_alt_def b.nodes_alt_def c.nodes_alt_def by fastforce lemma combine_nodes_snd[simp]: assumes "alphabet\<^sub>1 A \ alphabet\<^sub>2 B" shows "snd ` c.nodes (combine A B) = b.nodes B" using assms combine_reachable_snd unfolding a.nodes_alt_def b.nodes_alt_def c.nodes_alt_def by fastforce lemma combine_nodes_finite[intro]: assumes "finite (a.nodes A)" "finite (b.nodes B)" shows "finite (c.nodes (combine A B))" proof (rule finite_subset) show "c.nodes (combine A B) \ a.nodes A \ b.nodes B" using combine_nodes by this show "finite (a.nodes A \ b.nodes B)" using assms by simp qed lemma combine_nodes_finite_strong[iff]: assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B" shows "finite (c.nodes (combine A B)) \ finite (a.nodes A) \ finite (b.nodes B)" proof safe show "finite (a.nodes A)" if "finite (c.nodes (combine A B))" using combine_nodes_fst assms that by (metis finite_imageI equalityD1) show "finite (b.nodes B)" if "finite (c.nodes (combine A B))" using combine_nodes_snd assms that by (metis finite_imageI equalityD2) show "finite (c.nodes (combine A B))" if "finite (a.nodes A)" "finite (b.nodes B)" using that by rule qed lemma combine_nodes_card[intro]: assumes "finite (a.nodes A)" "finite (b.nodes B)" shows "card (c.nodes (combine A B)) \ card (a.nodes A) * card (b.nodes B)" proof - have "card (c.nodes (combine A B)) \ card (a.nodes A \ b.nodes B)" proof (rule card_mono) show "finite (a.nodes A \ b.nodes B)" using assms by simp show "c.nodes (combine A B) \ a.nodes A \ b.nodes B" using combine_nodes by this qed also have "\ = card (a.nodes A) * card (b.nodes B)" using card_cartesian_product by this finally show ?thesis by this qed lemma combine_nodes_card_strong[intro]: assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B" shows "card (c.nodes (combine A B)) \ card (a.nodes A) * card (b.nodes B)" proof (cases "finite (a.nodes A) \ finite (b.nodes B)") case True show ?thesis using True by auto next case False have 1: "card (c.nodes (combine A B)) = 0" using False assms by simp have 2: "card (a.nodes A) * card (b.nodes B) = 0" using False by auto show ?thesis using 1 2 by simp qed end locale automaton_intersection_trace = automaton_combination automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 condition + a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 + c: automaton_trace automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 test\<^sub>3 for automaton\<^sub>1 :: "'label set \ 'state\<^sub>1 \ ('label, 'state\<^sub>1) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state\<^sub>1" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state\<^sub>1) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and test\<^sub>1 :: "'condition\<^sub>1 \ 'state\<^sub>1 stream \ bool" and automaton\<^sub>2 :: "'label set \ 'state\<^sub>2 \ ('label, 'state\<^sub>2) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state\<^sub>2" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state\<^sub>2) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and test\<^sub>2 :: "'condition\<^sub>2 \ 'state\<^sub>2 stream \ bool" and automaton\<^sub>3 :: "'label set \ 'state\<^sub>1 \ 'state\<^sub>2 \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans \ 'condition\<^sub>3 \ 'automaton\<^sub>3" and alphabet\<^sub>3 :: "'automaton\<^sub>3 \ 'label set" and initial\<^sub>3 :: "'automaton\<^sub>3 \ 'state\<^sub>1 \ 'state\<^sub>2" and transition\<^sub>3 :: "'automaton\<^sub>3 \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans" and condition\<^sub>3 :: "'automaton\<^sub>3 \ 'condition\<^sub>3" and test\<^sub>3 :: "'condition\<^sub>3 \ ('state\<^sub>1 \ 'state\<^sub>2) stream \ bool" and condition :: "'condition\<^sub>1 \ 'condition\<^sub>2 \ 'condition\<^sub>3" + assumes test[iff]: "test\<^sub>3 (condition c\<^sub>1 c\<^sub>2) (u ||| v) \ test\<^sub>1 c\<^sub>1 u \ test\<^sub>2 c\<^sub>2 v" begin lemma combine_language[simp]: "c.language (combine A B) = a.language A \ b.language B" by force end locale automaton_union_trace = automaton_combination automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 condition + a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 + c: automaton_trace automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 test\<^sub>3 for automaton\<^sub>1 :: "'label set \ 'state\<^sub>1 \ ('label, 'state\<^sub>1) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state\<^sub>1" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state\<^sub>1) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and test\<^sub>1 :: "'condition\<^sub>1 \ 'state\<^sub>1 stream \ bool" and automaton\<^sub>2 :: "'label set \ 'state\<^sub>2 \ ('label, 'state\<^sub>2) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state\<^sub>2" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state\<^sub>2) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and test\<^sub>2 :: "'condition\<^sub>2 \ 'state\<^sub>2 stream \ bool" and automaton\<^sub>3 :: "'label set \ 'state\<^sub>1 \ 'state\<^sub>2 \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans \ 'condition\<^sub>3 \ 'automaton\<^sub>3" and alphabet\<^sub>3 :: "'automaton\<^sub>3 \ 'label set" and initial\<^sub>3 :: "'automaton\<^sub>3 \ 'state\<^sub>1 \ 'state\<^sub>2" and transition\<^sub>3 :: "'automaton\<^sub>3 \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans" and condition\<^sub>3 :: "'automaton\<^sub>3 \ 'condition\<^sub>3" and test\<^sub>3 :: "'condition\<^sub>3 \ ('state\<^sub>1 \ 'state\<^sub>2) stream \ bool" and condition :: "'condition\<^sub>1 \ 'condition\<^sub>2 \ 'condition\<^sub>3" + assumes test[iff]: "test\<^sub>3 (condition c\<^sub>1 c\<^sub>2) (u ||| v) \ test\<^sub>1 c\<^sub>1 u \ test\<^sub>2 c\<^sub>2 v" begin lemma combine_language[simp]: assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B" shows "c.language (combine A B) = a.language A \ b.language B" using assms by (force simp: a.run_alt_def b.run_alt_def) end (* TODO: complete this in analogy to the pair case *) locale automaton_combination_list = a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 + b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state \ ('label, 'state) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and automaton\<^sub>2 :: "'label set \ 'state list \ ('label, 'state list) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state list" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state list) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" + fixes condition :: "'condition\<^sub>1 list \ 'condition\<^sub>2" begin definition combine :: "'automaton\<^sub>1 list \ 'automaton\<^sub>2" where "combine AA \ automaton\<^sub>2 (\ (alphabet\<^sub>1 ` set AA)) (map initial\<^sub>1 AA) (\ a pp. map2 (\ A p. transition\<^sub>1 A a p) AA pp) (condition (map condition\<^sub>1 AA))" lemma combine_simps[simp]: "alphabet\<^sub>2 (combine AA) = \ (alphabet\<^sub>1 ` set AA)" "initial\<^sub>2 (combine AA) = map initial\<^sub>1 AA" "transition\<^sub>2 (combine AA) a pp = map2 (\ A p. transition\<^sub>1 A a p) AA pp" "condition\<^sub>2 (combine AA) = condition (map condition\<^sub>1 AA)" unfolding combine_def by auto (* TODO: get rid of indices, express this using stranspose and listset *) lemma combine_trace_smap: assumes "length pp = length AA" "k < length AA" shows "smap (\ pp. pp ! k) (b.trace (combine AA) w pp) = a.trace (AA ! k) w (pp ! k)" using assms by (coinduction arbitrary: w pp) (force) lemma combine_nodes_length: assumes "pp \ b.nodes (combine AA)" shows "length pp = length AA" using assms by induct auto lemma combine_nodes[intro]: assumes "pp \ b.nodes (combine AA)" "k < length pp" shows "pp ! k \ a.nodes (AA ! k)" using assms by induct auto lemma combine_nodes_finite[intro]: assumes "list_all (finite \ a.nodes) AA" shows "finite (b.nodes (combine AA))" proof (rule finite_subset) (* TODO: this is used more than once, make top level theorem *) show "b.nodes (combine AA) \ listset (map a.nodes AA)" by (force simp: listset_member list_all2_conv_all_nth combine_nodes_length) show "finite (listset (map a.nodes AA))" using list.pred_map assms by auto qed lemma combine_nodes_card: assumes "list_all (finite \ a.nodes) AA" shows "card (b.nodes (combine AA)) \ prod_list (map (card \ a.nodes) AA)" proof - have "card (b.nodes (combine AA)) \ card (listset (map a.nodes AA))" proof (rule card_mono) show "finite (listset (map a.nodes AA))" using list.pred_map assms by auto show "b.nodes (combine AA) \ listset (map a.nodes AA)" by (force simp: listset_member list_all2_conv_all_nth combine_nodes_length) qed also have "\ = prod_list (map (card \ a.nodes) AA)" by simp finally show ?thesis by this qed end locale automaton_intersection_list_trace = automaton_combination_list automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 condition + a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state \ ('label, 'state) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and test\<^sub>1 :: "'condition\<^sub>1 \ 'state stream \ bool" and automaton\<^sub>2 :: "'label set \ 'state list \ ('label, 'state list) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state list" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state list) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and test\<^sub>2 :: "'condition\<^sub>2 \ 'state list stream \ bool" and condition :: "'condition\<^sub>1 list \ 'condition\<^sub>2" + assumes test[iff]: "test\<^sub>2 (condition cs) w \ (\ k < length cs. test\<^sub>1 (cs ! k) (smap (\ pp. pp ! k) w))" begin lemma combine_language[simp]: "b.language (combine AA) = \ (a.language ` set AA)" unfolding a.language_def b.language_def unfolding a.run_alt_def b.run_alt_def by (auto simp: combine_trace_smap iff: in_set_conv_nth) end locale automaton_union_list_trace = automaton_combination_list automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 condition + a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state \ ('label, 'state) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and test\<^sub>1 :: "'condition\<^sub>1 \ 'state stream \ bool" and automaton\<^sub>2 :: "'label set \ 'state list \ ('label, 'state list) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state list" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state list) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and test\<^sub>2 :: "'condition\<^sub>2 \ 'state list stream \ bool" and condition :: "'condition\<^sub>1 list \ 'condition\<^sub>2" + assumes test[iff]: "test\<^sub>2 (condition cs) w \ (\ k < length cs. test\<^sub>1 (cs ! k) (smap (\ pp. pp ! k) w))" begin lemma combine_language[simp]: assumes "\ (alphabet\<^sub>1 ` set AA) = \ (alphabet\<^sub>1 ` set AA)" shows "b.language (combine AA) = \ (a.language ` set AA)" using assms unfolding a.language_def b.language_def unfolding a.run_alt_def b.run_alt_def by (auto simp: combine_trace_smap iff: in_set_conv_nth) (metis INT_subset_iff in_set_conv_nth) end end \ No newline at end of file diff --git a/thys/Transition_Systems_and_Automata/Automata/NBA/NBA.thy b/thys/Transition_Systems_and_Automata/Automata/NBA/NBA.thy --- a/thys/Transition_Systems_and_Automata/Automata/NBA/NBA.thy +++ b/thys/Transition_Systems_and_Automata/Automata/NBA/NBA.thy @@ -1,100 +1,100 @@ section \Nondeterministic Büchi Automata\ theory NBA imports "../Nondeterministic" begin datatype ('label, 'state) nba = nba (alphabet: "'label set") (initial: "'state set") (transition: "'label \ 'state \ 'state set") (accepting: "'state pred") global_interpretation nba: automaton nba alphabet initial transition accepting defines path = nba.path and run = nba.run and reachable = nba.reachable and nodes = nba.nodes by unfold_locales auto - global_interpretation nba: automaton_trace nba alphabet initial transition accepting "\ P w r p. infs P r" + global_interpretation nba: automaton_run nba alphabet initial transition accepting "\ P w r p. infs P r" defines language = nba.language by standard abbreviation target where "target \ nba.target" abbreviation states where "states \ nba.states" abbreviation trace where "trace \ nba.trace" abbreviation successors where "successors \ nba.successors TYPE('label)" instantiation nba :: (type, type) order begin definition less_eq_nba :: "('a, 'b) nba \ ('a, 'b) nba \ bool" where "A \ B \ alphabet A \ alphabet B \ initial A \ initial B \ transition A \ transition B \ accepting A \ accepting B" definition less_nba :: "('a, 'b) nba \ ('a, 'b) nba \ bool" where "less_nba A B \ A \ B \ A \ B" instance by (intro_classes) (auto simp: less_eq_nba_def less_nba_def nba.expand) end lemma nodes_mono: "mono nodes" proof fix A B :: "('label, 'state) nba" assume 1: "A \ B" have 2: "alphabet A \ alphabet B" using 1 unfolding less_eq_nba_def by auto have 3: "initial A \ initial B" using 1 unfolding less_eq_nba_def by auto have 4: "transition A a p \ transition B a p" for a p using 1 unfolding less_eq_nba_def le_fun_def by auto have 5: "p \ nodes B" if "p \ nodes A" for p using that 2 3 4 by induct fastforce+ show "nodes A \ nodes B" using 5 by auto qed lemma language_mono: "mono language" proof fix A B :: "('label, 'state) nba" assume 1: "A \ B" have 2: "alphabet A \ alphabet B" using 1 unfolding less_eq_nba_def by auto have 3: "initial A \ initial B" using 1 unfolding less_eq_nba_def by auto have 4: "transition A a p \ transition B a p" for a p using 1 unfolding less_eq_nba_def le_fun_def by auto have 5: "accepting A p \ accepting B p" for p using 1 unfolding less_eq_nba_def by auto have 6: "run B wr p" if "run A wr p" for wr p using that 2 4 by coinduct auto have 7: "infs (accepting B) w" if "infs (accepting A) w" for w using infs_mono that 5 by metis show "language A \ language B" using 3 6 7 by blast qed lemma simulation_language: assumes "alphabet A \ alphabet B" assumes "\ p. p \ initial A \ \ q \ initial B. (p, q) \ R" assumes "\ a p p' q. p' \ transition A a p \ (p, q) \ R \ \ q' \ transition B a q. (p', q') \ R" assumes "\ p q. (p, q) \ R \ accepting A p \ accepting B q" shows "language A \ language B" proof fix w assume 1: "w \ language A" obtain r p where 2: "p \ initial A" "run A (w ||| r) p" "infs (accepting A) r" using 1 by rule define P where "P n q \ (target (stake n (w ||| r)) p, q) \ R" for n q obtain q where 3: "q \ initial B" "(p, q) \ R" using assms(2) 2(1) by auto obtain ws where 4: "run B ws q" "\ i. P (0 + i) (target (stake i ws) q)" "\ i. fst (ws !! i) = w !! (0 + i)" proof (rule nba.invariant_run_index) have "stake k (w ||| r) @- (w !! k, target (stake (Suc k) (w ||| r)) p) ## sdrop (Suc k) (w ||| r) = w ||| r" for k by (metis id_stake_snth_sdrop snth_szip sscan_snth szip_smap_snd nba.trace_alt_def) also have "run A \ p" using 2(2) by this finally show "\ a. (fst a \ alphabet B \ snd a \ transition B (fst a) q) \ P (Suc n) (snd a) \ fst a = w !! n" if "P n q" for n q using assms(1, 3) that unfolding P_def by fastforce show "P 0 q" unfolding P_def using 3(2) by auto qed rule obtain s where 5: "ws = w ||| s" using 4(3) by (metis add.left_neutral eqI_snth snth_smap szip_smap) show "w \ language B" proof show "q \ initial B" using 3(1) by this show "run B (w ||| s) q" using 4(1) unfolding 5 by this have 6: "(\ a b. (a, b) \ R) \ (\ a b. accepting A a \ accepting B b)" using assms(4) by auto have 7: "stream_all2 (\ p q. (p, q) \ R) (trace (w ||| r) p) (trace (w ||| s) q)" using 4(2) unfolding P_def 5 by (simp add: stream_rel_snth del: stake.simps(2)) have 8: "stream_all2 (\ a b. accepting A a \ accepting B b) r s" using stream.rel_mono 6 7 unfolding nba.trace_alt_def by auto show "infs (accepting B) s" using infs_mono_strong 8 2(3) by this qed qed end \ No newline at end of file diff --git a/thys/Transition_Systems_and_Automata/Automata/NBA/NBA_Combine.thy b/thys/Transition_Systems_and_Automata/Automata/NBA/NBA_Combine.thy --- a/thys/Transition_Systems_and_Automata/Automata/NBA/NBA_Combine.thy +++ b/thys/Transition_Systems_and_Automata/Automata/NBA/NBA_Combine.thy @@ -1,89 +1,89 @@ section \Nondeterministic Büchi Automata Combinations\ theory NBA_Combine imports NBA NGBA begin - global_interpretation degeneralization: automaton_degeneralization_trace + global_interpretation degeneralization: automaton_degeneralization_run ngba ngba.alphabet ngba.initial ngba.transition ngba.accepting "\ P w r p. gen infs P r" nba nba.alphabet nba.initial nba.transition nba.accepting "\ P w r p. infs P r" defines degeneralize = degeneralization.degeneralize by unfold_locales auto lemmas degeneralize_language[simp] = degeneralization.degeneralize_language[folded NBA.language_def] lemmas degeneralize_nodes_finite[iff] = degeneralization.degeneralize_nodes_finite[folded NBA.nodes_def] - global_interpretation intersection: automaton_intersection_trace + global_interpretation intersection: automaton_intersection_run nba nba.alphabet nba.initial nba.transition nba.accepting "\ P w r p. infs P r" nba nba.alphabet nba.initial nba.transition nba.accepting "\ P w r p. infs P r" ngba ngba.alphabet ngba.initial ngba.transition ngba.accepting "\ P w r p. gen infs P r" "\ c\<^sub>1 c\<^sub>2. [c\<^sub>1 \ fst, c\<^sub>2 \ snd]" defines intersect' = intersection.intersect by unfold_locales auto lemmas intersect'_language[simp] = intersection.intersect_language[folded NGBA.language_def] lemmas intersect'_nodes_finite[intro] = intersection.intersect_nodes_finite[folded NGBA.nodes_def] - global_interpretation intersection_list: automaton_intersection_list_trace + global_interpretation intersection_list: automaton_intersection_list_run nba nba.alphabet nba.initial nba.transition nba.accepting "\ P w r p. infs P r" ngba ngba.alphabet ngba.initial ngba.transition ngba.accepting "\ P w r p. gen infs P r" "\ cs. map (\ k ps. (cs ! k) (ps ! k)) [0 ..< length cs]" defines intersect_list' = intersection_list.intersect proof unfold_locales fix cs :: "('b \ bool) list" and rs :: "'b stream list" and w :: "'a stream" and ps :: "'b list" assume 1: "length rs = length cs" "length ps = length cs" have "gen infs (map (\ k pp. (cs ! k) (pp ! k)) [0 ..< length cs]) (stranspose rs) \ (\ k < length cs. infs (\ pp. (cs ! k) (pp ! k)) (stranspose rs))" by (auto simp: gen_def) also have "\ \ (\ k < length cs. infs (cs ! k) (smap (\ pp. pp ! k) (stranspose rs)))" by (simp add: comp_def) also have "\ \ (\ k < length cs. infs (cs ! k) (rs ! k))" using 1 by simp also have "\ \ list_all (\ (c, r, p). infs c r) (cs || rs || ps)" using 1 unfolding list_all_length by simp finally show "gen infs (map (\ k ps. (cs ! k) (ps ! k)) [0 ..< length cs]) (stranspose rs) \ list_all (\ (c, r, p). infs c r) (cs || rs || ps)" by this qed lemmas intersect_list'_language[simp] = intersection_list.intersect_language[folded NGBA.language_def] lemmas intersect_list'_nodes_finite[intro] = intersection_list.intersect_nodes_finite[folded NGBA.nodes_def] - global_interpretation union: automaton_union_trace + global_interpretation union: automaton_union_run nba nba.alphabet nba.initial nba.transition nba.accepting "\ P w r p. infs P r" nba nba.alphabet nba.initial nba.transition nba.accepting "\ P w r p. infs P r" nba nba.alphabet nba.initial nba.transition nba.accepting "\ P w r p. infs P r" case_sum defines union = union.union by (unfold_locales) (auto simp: comp_def) lemmas union_language = union.union_language lemmas union_nodes_finite = union.union_nodes_finite - global_interpretation union_list: automaton_union_list_trace + global_interpretation union_list: automaton_union_list_run nba nba.alphabet nba.initial nba.transition nba.accepting "\ P w r p. infs P r" nba nba.alphabet nba.initial nba.transition nba.accepting "\ P w r p. infs P r" "\ cs (k, p). (cs ! k) p" defines union_list = union_list.union by (unfold_locales) (auto simp: szip_sconst_smap_fst comp_def) lemmas union_list_language = union_list.union_language lemmas union_list_nodes_finite = union_list.union_nodes_finite abbreviation intersect where "intersect A B \ degeneralize (intersect' A B)" lemma intersect_language[simp]: "NBA.language (intersect A B) = NBA.language A \ NBA.language B" by simp lemma intersect_nodes_finite[intro]: assumes "finite (NBA.nodes A)" "finite (NBA.nodes B)" shows "finite (NBA.nodes (intersect A B))" using intersect'_nodes_finite assms by simp abbreviation intersect_list where "intersect_list AA \ degeneralize (intersect_list' AA)" lemma intersect_list_language[simp]: "NBA.language (intersect_list AA) = \ (NBA.language ` set AA)" by simp lemma intersect_list_nodes_finite[intro]: assumes "list_all (finite \ NBA.nodes) AA" shows "finite (NBA.nodes (intersect_list AA))" using intersect_list'_nodes_finite assms by simp end \ No newline at end of file diff --git a/thys/Transition_Systems_and_Automata/Automata/NBA/NGBA.thy b/thys/Transition_Systems_and_Automata/Automata/NBA/NGBA.thy --- a/thys/Transition_Systems_and_Automata/Automata/NBA/NGBA.thy +++ b/thys/Transition_Systems_and_Automata/Automata/NBA/NGBA.thy @@ -1,25 +1,25 @@ section \Nondeterministic Generalized Büchi Automata\ theory NGBA imports "../Nondeterministic" begin datatype ('label, 'state) ngba = ngba (alphabet: "'label set") (initial: "'state set") (transition: "'label \ 'state \ 'state set") (accepting: "'state pred gen") global_interpretation ngba: automaton ngba alphabet initial transition accepting defines path = ngba.path and run = ngba.run and reachable = ngba.reachable and nodes = ngba.nodes by unfold_locales auto - global_interpretation ngba: automaton_trace ngba alphabet initial transition accepting "\ P w r p. gen infs P r" + global_interpretation ngba: automaton_run ngba alphabet initial transition accepting "\ P w r p. gen infs P r" defines language = ngba.language by standard abbreviation target where "target \ ngba.target" abbreviation states where "states \ ngba.states" abbreviation trace where "trace \ ngba.trace" abbreviation successors where "successors \ ngba.successors TYPE('label)" end \ No newline at end of file diff --git a/thys/Transition_Systems_and_Automata/Automata/Nondeterministic.thy b/thys/Transition_Systems_and_Automata/Automata/Nondeterministic.thy --- a/thys/Transition_Systems_and_Automata/Automata/Nondeterministic.thy +++ b/thys/Transition_Systems_and_Automata/Automata/Nondeterministic.thy @@ -1,734 +1,734 @@ theory Nondeterministic imports "../Transition_Systems/Transition_System" "../Transition_Systems/Transition_System_Extra" "../Transition_Systems/Transition_System_Construction" "../Basic/Degeneralization" begin type_synonym ('label, 'state) trans = "'label \ 'state \ 'state set" locale automaton = fixes automaton :: "'label set \ 'state set \ ('label, 'state) trans \ 'condition \ 'automaton" fixes alphabet :: "'automaton \ 'label set" fixes initial :: "'automaton \ 'state set" fixes transition :: "'automaton \ ('label, 'state) trans" fixes condition :: "'automaton \ 'condition" assumes automaton[simp]: "automaton (alphabet A) (initial A) (transition A) (condition A) = A" assumes alphabet[simp]: "alphabet (automaton a i t c) = a" assumes initial[simp]: "initial (automaton a i t c) = i" assumes transition[simp]: "transition (automaton a i t c) = t" assumes condition[simp]: "condition (automaton a i t c) = c" begin sublocale transition_system_initial "\ a p. snd a" "\ a p. fst a \ alphabet A \ snd a \ transition A (fst a) p" "\ p. p \ initial A" for A defines path' = path and run' = run and reachable' = reachable and nodes' = nodes by this lemma states_alt_def: "states r p = map snd r" by (induct r arbitrary: p) (auto) lemma trace_alt_def: "trace r p = smap snd r" by (coinduction arbitrary: r p) (auto) lemma successors_alt_def: "successors A p = (\ a \ alphabet A. transition A a p)" by auto lemma reachable_transition[intro]: assumes "a \ alphabet A" "q \ reachable A p" "r \ transition A a q" shows "r \ reachable A p" using reachable.execute assms by force lemma nodes_transition[intro]: assumes "a \ alphabet A" "p \ nodes A" "q \ transition A a p" shows "q \ nodes A" using nodes.execute assms by force lemma run_alphabet: assumes "run A (w ||| r) p" shows "w \ streams (alphabet A)" using assms by (coinduction arbitrary: w r p) (metis run.cases stream.map szip_smap szip_smap_fst) definition restrict :: "'automaton \ 'automaton" where "restrict A \ automaton (alphabet A) (initial A) (\ a p. if a \ alphabet A then transition A a p else {}) (condition A)" lemma restrict_simps[simp]: "alphabet (restrict A) = alphabet A" "initial (restrict A) = initial A" "transition (restrict A) a p = (if a \ alphabet A then transition A a p else {})" "condition (restrict A) = condition A" unfolding restrict_def by auto lemma restrict_path[simp]: "path (restrict A) = path A" proof (intro ext iffI) show "path A wr p" if "path (restrict A) wr p" for wr p using that by induct auto show "path (restrict A) wr p" if "path A wr p" for wr p using that by induct auto qed lemma restrict_run[simp]: "run (restrict A) = run A" proof (intro ext iffI) show "run A wr p" if "run (restrict A) wr p" for wr p using that by coinduct auto show "run (restrict A) wr p" if "run A wr p" for wr p using that by coinduct auto qed end - (* TODO: create analogous thing for NFAs (automaton_target) *) - (* TODO: this should be _stream or _run *) - locale automaton_trace = + (* TODO: create analogous thing for NFAs (automaton_path) *) + (* TODO: adjust deterministic theory to the same test type *) + locale automaton_run = automaton automaton alphabet initial transition condition for automaton :: "'label set \ 'state set \ ('label, 'state) trans \ 'condition \ 'automaton" and alphabet :: "'automaton \ 'label set" and initial :: "'automaton \ 'state set" and transition :: "'automaton \ ('label, 'state) trans" and condition :: "'automaton \ 'condition" + fixes test :: "'condition \ 'label stream \ 'state stream \ 'state \ bool" begin definition language :: "'automaton \ 'label stream set" where "language A \ {w |w r p. p \ initial A \ run A (w ||| r) p \ test (condition A) w r p}" lemma language[intro]: assumes "p \ initial A" "run A (w ||| r) p" "test (condition A) w r p" shows "w \ language A" using assms unfolding language_def by auto lemma language_elim[elim]: assumes "w \ language A" obtains r p where "p \ initial A" "run A (w ||| r) p" "test (condition A) w r p" using assms unfolding language_def by auto lemma language_alphabet: "language A \ streams (alphabet A)" by (auto dest: run_alphabet) lemma restrict_language[simp]: "language (restrict A) = language A" by force end locale automaton_degeneralization = a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 + b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state set \ ('label, 'state) trans \ 'state pred gen \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'state pred gen" and automaton\<^sub>2 :: "'label set \ 'state degen set \ ('label, 'state degen) trans \ 'state degen pred \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state degen set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state degen) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'state degen pred" begin definition degeneralize :: "'automaton\<^sub>1 \ 'automaton\<^sub>2" where "degeneralize A \ automaton\<^sub>2 (alphabet\<^sub>1 A) (initial\<^sub>1 A \ {0}) (\ a (p, k). transition\<^sub>1 A a p \ {count (condition\<^sub>1 A) p k}) (degen (condition\<^sub>1 A))" lemma degeneralize_simps[simp]: "alphabet\<^sub>2 (degeneralize A) = alphabet\<^sub>1 A" "initial\<^sub>2 (degeneralize A) = initial\<^sub>1 A \ {0}" "transition\<^sub>2 (degeneralize A) a (p, k) = transition\<^sub>1 A a p \ {count (condition\<^sub>1 A) p k}" "condition\<^sub>2 (degeneralize A) = degen (condition\<^sub>1 A)" unfolding degeneralize_def by auto lemma run_degeneralize: assumes "a.run A (w ||| r) p" shows "b.run (degeneralize A) (w ||| r ||| sscan (count (condition\<^sub>1 A)) (p ## r) k) (p, k)" using assms by (coinduction arbitrary: w r p k) (force elim: a.run.cases) lemma degeneralize_run: assumes "b.run (degeneralize A) (w ||| rs) pk" obtains r s p k where "rs = r ||| s" "pk = (p, k)" "a.run A (w ||| r) p" "s = sscan (count (condition\<^sub>1 A)) (p ## r) k" proof show "rs = smap fst rs ||| smap snd rs" "pk = (fst pk, snd pk)" by auto show "a.run A (w ||| smap fst rs) (fst pk)" using assms by (coinduction arbitrary: w rs pk) (force elim: b.run.cases) show "smap snd rs = sscan (count (condition\<^sub>1 A)) (fst pk ## smap fst rs) (snd pk)" using assms by (coinduction arbitrary: w rs pk) (force elim: b.run.cases) qed lemma degeneralize_nodes: "b.nodes (degeneralize A) \ a.nodes A \ insert 0 {0 ..< length (condition\<^sub>1 A)}" proof fix pk assume "pk \ b.nodes (degeneralize A)" then show "pk \ a.nodes A \ insert 0 {0 ..< length (condition\<^sub>1 A)}" by (induct) (force, cases "condition\<^sub>1 A = []", auto) qed lemma nodes_degeneralize: "a.nodes A \ fst ` b.nodes (degeneralize A)" proof fix p assume "p \ a.nodes A" then show "p \ fst ` b.nodes (degeneralize A)" proof induct case (initial p) have "(p, 0) \ b.nodes (degeneralize A)" using initial by auto then show ?case using image_iff fst_conv by force next case (execute p aq) obtain k where "(p, k) \ b.nodes (degeneralize A)" using execute(2) by auto then have "(snd aq, count (condition\<^sub>1 A) p k) \ b.nodes (degeneralize A)" using execute(3) by auto then show ?case using image_iff snd_conv by force qed qed lemma degeneralize_nodes_finite[iff]: "finite (b.nodes (degeneralize A)) \ finite (a.nodes A)" proof show "finite (a.nodes A)" if "finite (b.nodes (degeneralize A))" using finite_subset nodes_degeneralize that by blast show "finite (b.nodes (degeneralize A))" if "finite (a.nodes A)" using finite_subset degeneralize_nodes that by blast qed end - locale automaton_degeneralization_trace = + locale automaton_degeneralization_run = automaton_degeneralization automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 + - a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + - b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 + a: automaton_run automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + + b: automaton_run automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state set \ ('label, 'state) trans \ 'state pred gen \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'state pred gen" and test\<^sub>1 :: "'state pred gen \ 'label stream \ 'state stream \ 'state \ bool" and automaton\<^sub>2 :: "'label set \ 'state degen set \ ('label, 'state degen) trans \ 'state degen pred \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state degen set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state degen) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'state degen pred" and test\<^sub>2 :: "'state degen pred \ 'label stream \ 'state degen stream \ 'state degen \ bool" + assumes test[iff]: "test\<^sub>2 (degen cs) w (r ||| sscan (count cs) (p ## r) k) (p, k) \ test\<^sub>1 cs w r p" begin lemma degeneralize_language[simp]: "b.language (degeneralize A) = a.language A" unfolding a.language_def b.language_def by (auto dest: run_degeneralize elim!: degeneralize_run) end locale automaton_intersection = a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 + b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 + c: automaton automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 for automaton\<^sub>1 :: "'label set \ 'state\<^sub>1 set \ ('label, 'state\<^sub>1) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state\<^sub>1 set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state\<^sub>1) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and automaton\<^sub>2 :: "'label set \ 'state\<^sub>2 set \ ('label, 'state\<^sub>2) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state\<^sub>2 set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state\<^sub>2) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and automaton\<^sub>3 :: "'label set \ ('state\<^sub>1 \ 'state\<^sub>2) set \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans \ 'condition\<^sub>3 \ 'automaton\<^sub>3" and alphabet\<^sub>3 :: "'automaton\<^sub>3 \ 'label set" and initial\<^sub>3 :: "'automaton\<^sub>3 \ ('state\<^sub>1 \ 'state\<^sub>2) set" and transition\<^sub>3 :: "'automaton\<^sub>3 \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans" and condition\<^sub>3 :: "'automaton\<^sub>3 \ 'condition\<^sub>3" + fixes condition :: "'condition\<^sub>1 \ 'condition\<^sub>2 \ 'condition\<^sub>3" begin definition intersect :: "'automaton\<^sub>1 \ 'automaton\<^sub>2 \ 'automaton\<^sub>3" where "intersect A B \ automaton\<^sub>3 (alphabet\<^sub>1 A \ alphabet\<^sub>2 B) (initial\<^sub>1 A \ initial\<^sub>2 B) (\ a (p, q). transition\<^sub>1 A a p \ transition\<^sub>2 B a q) (condition (condition\<^sub>1 A) (condition\<^sub>2 B))" lemma intersect_simps[simp]: "alphabet\<^sub>3 (intersect A B) = alphabet\<^sub>1 A \ alphabet\<^sub>2 B" "initial\<^sub>3 (intersect A B) = initial\<^sub>1 A \ initial\<^sub>2 B" "transition\<^sub>3 (intersect A B) a (p, q) = transition\<^sub>1 A a p \ transition\<^sub>2 B a q" "condition\<^sub>3 (intersect A B) = condition (condition\<^sub>1 A) (condition\<^sub>2 B)" unfolding intersect_def by auto lemma intersect_path[iff]: assumes "length w = length r" "length r = length s" shows "c.path (intersect A B) (w || r || s) (p, q) \ a.path A (w || r) p \ b.path B (w || s) q" using assms by (induct arbitrary: p q rule: list_induct3) (auto) lemma intersect_run[iff]: "c.run (intersect A B) (w ||| r ||| s) (p, q) \ a.run A (w ||| r) p \ b.run B (w ||| s) q" proof safe show "a.run A (w ||| r) p" if "c.run (intersect A B) (w ||| r ||| s) (p, q)" using that by (coinduction arbitrary: w r s p q) (force elim: c.run.cases) show "b.run B (w ||| s) q" if "c.run (intersect A B) (w ||| r ||| s) (p, q)" using that by (coinduction arbitrary: w r s p q) (force elim: c.run.cases) show "c.run (intersect A B) (w ||| r ||| s) (p, q)" if "a.run A (w ||| r) p" "b.run B (w ||| s) q" using that by (coinduction arbitrary: w r s p q) (auto elim: a.run.cases b.run.cases) qed lemma intersect_nodes: "c.nodes (intersect A B) \ a.nodes A \ b.nodes B" proof fix pq assume "pq \ c.nodes (intersect A B)" then show "pq \ a.nodes A \ b.nodes B" by induct auto qed lemma intersect_nodes_finite[intro]: assumes "finite (a.nodes A)" "finite (b.nodes B)" shows "finite (c.nodes (intersect A B))" using finite_subset intersect_nodes assms by blast end - locale automaton_intersection_trace = + locale automaton_intersection_run = automaton_intersection automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 condition + - a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + - b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 + - c: automaton_trace automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 test\<^sub>3 + a: automaton_run automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + + b: automaton_run automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 + + c: automaton_run automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 test\<^sub>3 for automaton\<^sub>1 :: "'label set \ 'state\<^sub>1 set \ ('label, 'state\<^sub>1) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state\<^sub>1 set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state\<^sub>1) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and test\<^sub>1 :: "'condition\<^sub>1 \ 'label stream \ 'state\<^sub>1 stream \ 'state\<^sub>1 \ bool" and automaton\<^sub>2 :: "'label set \ 'state\<^sub>2 set \ ('label, 'state\<^sub>2) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state\<^sub>2 set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state\<^sub>2) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and test\<^sub>2 :: "'condition\<^sub>2 \ 'label stream \ 'state\<^sub>2 stream \ 'state\<^sub>2 \ bool" and automaton\<^sub>3 :: "'label set \ ('state\<^sub>1 \ 'state\<^sub>2) set \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans \ 'condition\<^sub>3 \ 'automaton\<^sub>3" and alphabet\<^sub>3 :: "'automaton\<^sub>3 \ 'label set" and initial\<^sub>3 :: "'automaton\<^sub>3 \ ('state\<^sub>1 \ 'state\<^sub>2) set" and transition\<^sub>3 :: "'automaton\<^sub>3 \ ('label, 'state\<^sub>1 \ 'state\<^sub>2) trans" and condition\<^sub>3 :: "'automaton\<^sub>3 \ 'condition\<^sub>3" and test\<^sub>3 :: "'condition\<^sub>3 \ 'label stream \ ('state\<^sub>1 \ 'state\<^sub>2) stream \ 'state\<^sub>1 \ 'state\<^sub>2 \ bool" and condition :: "'condition\<^sub>1 \ 'condition\<^sub>2 \ 'condition\<^sub>3" + assumes test[iff]: "test\<^sub>3 (condition c\<^sub>1 c\<^sub>2) w (u ||| v) (p, q) \ test\<^sub>1 c\<^sub>1 w u p \ test\<^sub>2 c\<^sub>2 w v q" begin lemma intersect_language[simp]: "c.language (intersect A B) = a.language A \ b.language B" unfolding a.language_def b.language_def c.language_def by (fastforce iff: split_szip) end locale automaton_intersection_list = a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 + b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state set \ ('label, 'state) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and automaton\<^sub>2 :: "'label set \ 'state list set \ ('label, 'state list) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state list set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state list) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" + fixes condition :: "'condition\<^sub>1 list \ 'condition\<^sub>2" begin definition intersect :: "'automaton\<^sub>1 list \ 'automaton\<^sub>2" where "intersect AA \ automaton\<^sub>2 (\ (alphabet\<^sub>1 ` set AA)) (listset (map initial\<^sub>1 AA)) (\ a ps. listset (map2 (\ A p. transition\<^sub>1 A a p) AA ps)) (condition (map condition\<^sub>1 AA))" lemma intersect_simps[simp]: "alphabet\<^sub>2 (intersect AA) = \ (alphabet\<^sub>1 ` set AA)" "initial\<^sub>2 (intersect AA) = listset (map initial\<^sub>1 AA)" "transition\<^sub>2 (intersect AA) a ps = listset (map2 (\ A p. transition\<^sub>1 A a p) AA ps)" "condition\<^sub>2 (intersect AA) = condition (map condition\<^sub>1 AA)" unfolding intersect_def by auto lemma intersect_run_length: assumes "length ps = length AA" assumes "b.run (intersect AA) (w ||| r) ps" assumes "qs \ sset r" shows "length qs = length AA" proof - have "pred_stream (\ qs. length qs = length AA) r" using assms(1, 2) by (coinduction arbitrary: w r ps) (force elim: b.run.cases simp: listset_member list_all2_conv_all_nth) then show ?thesis using assms(3) unfolding stream.pred_set by auto qed lemma intersect_run_stranspose: assumes "length ps = length AA" assumes "b.run (intersect AA) (w ||| r) ps" obtains rs where "r = stranspose rs" "length rs = length AA" proof define rs where "rs \ map (\ k. smap (\ ps. ps ! k) r) [0 ..< length AA]" have "length qs = length AA" if "qs \ sset r" for qs using intersect_run_length assms that by this then show "r = stranspose rs" unfolding rs_def by (coinduction arbitrary: r) (auto intro: nth_equalityI simp: comp_def) show "length rs = length AA" unfolding rs_def by auto qed lemma run_intersect: assumes "length rs = length AA" "length ps = length AA" assumes "\ k. k < length AA \ a.run (AA ! k) (w ||| rs ! k) (ps ! k)" shows "b.run (intersect AA) (w ||| stranspose rs) ps" using assms proof (coinduction arbitrary: w rs ps) case (run ap r) then show ?case proof (intro conjI exI) show "fst ap \ alphabet\<^sub>2 (intersect AA)" using run by (force elim: a.run.cases simp: set_conv_nth) show "snd ap \ transition\<^sub>2 (intersect AA) (fst ap) ps" using run by (force elim: a.run.cases simp: listset_member list_all2_conv_all_nth) show "\ k < length AA. a.run' (AA ! k) (stl w ||| map stl rs ! k) (map shd rs ! k)" using run by (force elim: a.run.cases) qed auto qed lemma intersect_run: assumes "length rs = length AA" "length ps = length AA" assumes "b.run (intersect AA) (w ||| stranspose rs) ps" shows "k < length AA \ a.run (AA ! k) (w ||| rs ! k) (ps ! k)" using assms proof (coinduction arbitrary: w rs ps) case (run ap wr) then show ?case proof (intro exI conjI) show "fst ap \ alphabet\<^sub>1 (AA ! k)" using run by (force elim: b.run.cases) show "snd ap \ transition\<^sub>1 (AA ! k) (fst ap) (ps ! k)" using run by (force elim: b.run.cases simp: listset_member list_all2_conv_all_nth) show "b.run' (intersect AA) (stl w ||| stranspose (map stl rs)) (shd (stranspose rs))" using run by (force elim: b.run.cases) qed auto qed lemma intersect_nodes: "b.nodes (intersect AA) \ listset (map a.nodes AA)" proof show "ps \ listset (map a.nodes AA)" if "ps \ b.nodes (intersect AA)" for ps using that by (induct) (auto 0 3 simp: listset_member list_all2_conv_all_nth) qed lemma intersect_nodes_finite[intro]: assumes "list_all (finite \ a.nodes) AA" shows "finite (b.nodes (intersect AA))" proof (rule finite_subset) show "b.nodes (intersect AA) \ listset (map a.nodes AA)" using intersect_nodes by this show "finite (listset (map a.nodes AA))" using list.pred_map assms by auto qed end - locale automaton_intersection_list_trace = + locale automaton_intersection_list_run = automaton_intersection_list automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 condition + - a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + - b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 + a: automaton_run automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + + b: automaton_run automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state set \ ('label, 'state) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and test\<^sub>1 :: "'condition\<^sub>1 \ 'label stream \ 'state stream \ 'state \ bool" and automaton\<^sub>2 :: "'label set \ 'state list set \ ('label, 'state list) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state list set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state list) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and test\<^sub>2 :: "'condition\<^sub>2 \ 'label stream \ 'state list stream \ 'state list \ bool" and condition :: "'condition\<^sub>1 list \ 'condition\<^sub>2" + assumes test[iff]: "length rs = length cs \ length ps = length cs \ test\<^sub>2 (condition cs) w (stranspose rs) ps \ list_all (\ (c, r, p). test\<^sub>1 c w r p) (cs || rs || ps)" begin lemma intersect_language[simp]: "b.language (intersect AA) = \ (a.language ` set AA)" proof safe fix A w assume 1: "w \ b.language (intersect AA)" "A \ set AA" obtain r ps where 2: "ps \ initial\<^sub>2 (intersect AA)" "b.run (intersect AA) (w ||| r) ps" "test\<^sub>2 (condition\<^sub>2 (intersect AA)) w r ps" using 1(1) by auto have 3: "length ps = length AA" using 2(1) by (simp add: listset_member list_all2_conv_all_nth) obtain rs where 4: "r = stranspose rs" "length rs = length AA" using intersect_run_stranspose 3 2(2) by this obtain k where 5: "k < length AA" "A = AA ! k" using 1(2) unfolding set_conv_nth by auto show "w \ a.language A" proof show "ps ! k \ initial\<^sub>1 A" using 2(1) 5 by (auto simp: listset_member list_all2_conv_all_nth) show "a.run A (w ||| rs ! k) (ps ! k)" using 2(2) 3 4 5 by (auto intro: intersect_run) show "test\<^sub>1 (condition\<^sub>1 A) w (rs ! k) (ps ! k)" using 2(3) 3 4 5 by (simp add: list_all_length) qed next fix w assume 1: "w \ \ (a.language ` set AA)" have 2: "\ A \ set AA. \ r p. p \ initial\<^sub>1 A \ a.run A (w ||| r) p \ test\<^sub>1 (condition\<^sub>1 A) w r p" using 1 by blast obtain rs ps where 3: "length rs = length AA" "length ps = length AA" "\ k. k < length AA \ ps ! k \ initial\<^sub>1 (AA ! k)" "\ k. k < length AA \ a.run (AA ! k) (w ||| rs ! k) (ps ! k)" "\ k. k < length AA \ test\<^sub>1 (condition\<^sub>1 (AA ! k)) w (rs ! k) (ps ! k)" using 2 unfolding Ball_set list_choice_zip list_choice_pair unfolding list.pred_set set_conv_nth by force show "w \ b.language (intersect AA)" proof show "ps \ initial\<^sub>2 (intersect AA)" using 3 by (auto simp: listset_member list_all2_conv_all_nth) show "b.run (intersect AA) (w ||| stranspose rs) ps" using 3 by (auto intro: run_intersect) show "test\<^sub>2 (condition\<^sub>2 (intersect AA)) w (stranspose rs) ps" using 3 by (auto simp: list_all_length) qed qed end locale automaton_union = a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 + b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 + c: automaton automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 for automaton\<^sub>1 :: "'label set \ 'state\<^sub>1 set \ ('label, 'state\<^sub>1) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state\<^sub>1 set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state\<^sub>1) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and automaton\<^sub>2 :: "'label set \ 'state\<^sub>2 set \ ('label, 'state\<^sub>2) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state\<^sub>2 set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state\<^sub>2) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and automaton\<^sub>3 :: "'label set \ ('state\<^sub>1 + 'state\<^sub>2) set \ ('label, 'state\<^sub>1 + 'state\<^sub>2) trans \ 'condition\<^sub>3 \ 'automaton\<^sub>3" and alphabet\<^sub>3 :: "'automaton\<^sub>3 \ 'label set" and initial\<^sub>3 :: "'automaton\<^sub>3 \ ('state\<^sub>1 + 'state\<^sub>2) set" and transition\<^sub>3 :: "'automaton\<^sub>3 \ ('label, 'state\<^sub>1 + 'state\<^sub>2) trans" and condition\<^sub>3 :: "'automaton\<^sub>3 \ 'condition\<^sub>3" + fixes condition :: "'condition\<^sub>1 \ 'condition\<^sub>2 \ 'condition\<^sub>3" begin definition union :: "'automaton\<^sub>1 \ 'automaton\<^sub>2 \ 'automaton\<^sub>3" where "union A B \ automaton\<^sub>3 (alphabet\<^sub>1 A \ alphabet\<^sub>2 B) (initial\<^sub>1 A <+> initial\<^sub>2 B) (\ a. \ Inl p \ Inl ` transition\<^sub>1 A a p | Inr q \ Inr ` transition\<^sub>2 B a q) (condition (condition\<^sub>1 A) (condition\<^sub>2 B))" lemma union_simps[simp]: "alphabet\<^sub>3 (union A B) = alphabet\<^sub>1 A \ alphabet\<^sub>2 B" "initial\<^sub>3 (union A B) = initial\<^sub>1 A <+> initial\<^sub>2 B" "transition\<^sub>3 (union A B) a (Inl p) = Inl ` transition\<^sub>1 A a p" "transition\<^sub>3 (union A B) a (Inr q) = Inr ` transition\<^sub>2 B a q" "condition\<^sub>3 (union A B) = condition (condition\<^sub>1 A) (condition\<^sub>2 B)" unfolding union_def by auto lemma run_union_a: assumes "a.run A (w ||| r) p" shows "c.run (union A B) (w ||| smap Inl r) (Inl p)" using assms by (coinduction arbitrary: w r p) (force elim: a.run.cases) lemma run_union_b: assumes "b.run B (w ||| s) q" shows "c.run (union A B) (w ||| smap Inr s) (Inr q)" using assms by (coinduction arbitrary: w s q) (force elim: b.run.cases) lemma run_union: assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B" assumes "c.run (union A B) (w ||| rs) pq" obtains (a) r p where "rs = smap Inl r" "pq = Inl p" "a.run A (w ||| r) p" | (b) s q where "rs = smap Inr s" "pq = Inr q" "b.run B (w ||| s) q" proof (cases pq) case (Inl p) have 1: "rs = smap Inl (smap projl rs)" using assms(2) unfolding Inl by (coinduction arbitrary: w rs p) (force elim: c.run.cases) have 2: "a.run A (w ||| smap projl rs) p" using assms unfolding Inl by (coinduction arbitrary: w rs p) (force elim: c.run.cases) show ?thesis using a 1 Inl 2 by this next case (Inr q) have 1: "rs = smap Inr (smap projr rs)" using assms(2) unfolding Inr by (coinduction arbitrary: w rs q) (force elim: c.run.cases) have 2: "b.run B (w ||| smap projr rs) q" using assms unfolding Inr by (coinduction arbitrary: w rs q) (force elim: c.run.cases) show ?thesis using b 1 Inr 2 by this qed lemma union_nodes: assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B" shows "c.nodes (union A B) \ a.nodes A <+> b.nodes B" proof fix pq assume "pq \ c.nodes (union A B)" then show "pq \ a.nodes A <+> b.nodes B" using assms by (induct) (auto 0 3) qed lemma union_nodes_finite[intro]: assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B" assumes "finite (a.nodes A)" "finite (b.nodes B)" shows "finite (c.nodes (union A B))" using finite_subset union_nodes assms by (auto intro: finite_Plus) end - locale automaton_union_trace = + locale automaton_union_run = automaton_union automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 condition + - a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + - b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 + - c: automaton_trace automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 test\<^sub>3 + a: automaton_run automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + + b: automaton_run automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 + + c: automaton_run automaton\<^sub>3 alphabet\<^sub>3 initial\<^sub>3 transition\<^sub>3 condition\<^sub>3 test\<^sub>3 for automaton\<^sub>1 :: "'label set \ 'state\<^sub>1 set \ ('label, 'state\<^sub>1) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state\<^sub>1 set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state\<^sub>1) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and test\<^sub>1 :: "'condition\<^sub>1 \ 'label stream \ 'state\<^sub>1 stream \ 'state\<^sub>1 \ bool" and automaton\<^sub>2 :: "'label set \ 'state\<^sub>2 set \ ('label, 'state\<^sub>2) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ 'state\<^sub>2 set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, 'state\<^sub>2) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and test\<^sub>2 :: "'condition\<^sub>2 \ 'label stream \ 'state\<^sub>2 stream \ 'state\<^sub>2 \ bool" and automaton\<^sub>3 :: "'label set \ ('state\<^sub>1 + 'state\<^sub>2) set \ ('label, 'state\<^sub>1 + 'state\<^sub>2) trans \ 'condition\<^sub>3 \ 'automaton\<^sub>3" and alphabet\<^sub>3 :: "'automaton\<^sub>3 \ 'label set" and initial\<^sub>3 :: "'automaton\<^sub>3 \ ('state\<^sub>1 + 'state\<^sub>2) set" and transition\<^sub>3 :: "'automaton\<^sub>3 \ ('label, 'state\<^sub>1 + 'state\<^sub>2) trans" and condition\<^sub>3 :: "'automaton\<^sub>3 \ 'condition\<^sub>3" and test\<^sub>3 :: "'condition\<^sub>3 \ 'label stream \ ('state\<^sub>1 + 'state\<^sub>2) stream \ 'state\<^sub>1 + 'state\<^sub>2 \ bool" and condition :: "'condition\<^sub>1 \ 'condition\<^sub>2 \ 'condition\<^sub>3" + assumes test\<^sub>1[iff]: "test\<^sub>3 (condition c\<^sub>1 c\<^sub>2) w (smap Inl u) (Inl p) \ test\<^sub>1 c\<^sub>1 w u p" assumes test\<^sub>2[iff]: "test\<^sub>3 (condition c\<^sub>1 c\<^sub>2) w (smap Inr v) (Inr q) \ test\<^sub>2 c\<^sub>2 w v q" begin lemma union_language[simp]: assumes "alphabet\<^sub>1 A = alphabet\<^sub>2 B" shows "c.language (union A B) = a.language A \ b.language B" using assms unfolding a.language_def b.language_def c.language_def by (auto dest: run_union_a run_union_b elim!: run_union) end locale automaton_union_list = a: automaton automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 + b: automaton automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state set \ ('label, 'state) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and automaton\<^sub>2 :: "'label set \ (nat \ 'state) set \ ('label, nat \ 'state) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ (nat \ 'state) set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, nat \ 'state) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" + fixes condition :: "'condition\<^sub>1 list \ 'condition\<^sub>2" begin definition union :: "'automaton\<^sub>1 list \ 'automaton\<^sub>2" where "union AA \ automaton\<^sub>2 (\ (alphabet\<^sub>1 ` set AA)) (\ k < length AA. {k} \ initial\<^sub>1 (AA ! k)) (\ a (k, p). {k} \ transition\<^sub>1 (AA ! k) a p) (condition (map condition\<^sub>1 AA))" lemma union_simps[simp]: "alphabet\<^sub>2 (union AA) = \ (alphabet\<^sub>1 ` set AA)" "initial\<^sub>2 (union AA) = (\ k < length AA. {k} \ initial\<^sub>1 (AA ! k))" "transition\<^sub>2 (union AA) a (k, p) = {k} \ transition\<^sub>1 (AA ! k) a p" "condition\<^sub>2 (union AA) = condition (map condition\<^sub>1 AA)" unfolding union_def by auto lemma run_union: assumes "\ (alphabet\<^sub>1 ` set AA) = \ (alphabet\<^sub>1 ` set AA)" assumes "A \ set AA" assumes "a.run A (w ||| s) p" obtains k where "k < length AA" "A = AA ! k" "b.run (union AA) (w ||| sconst k ||| s) (k, p)" proof - obtain k where 1: "k < length AA" "A = AA ! k" using assms(2) unfolding set_conv_nth by auto show ?thesis proof show "k < length AA" "A = AA ! k" using 1 by this show "b.run (union AA) (w ||| sconst k ||| s) (k, p)" using assms 1(2) by (coinduction arbitrary: w s p) (force elim: a.run.cases) qed qed lemma union_run: assumes "\ (alphabet\<^sub>1 ` set AA) = \ (alphabet\<^sub>1 ` set AA)" assumes "k < length AA" assumes "b.run (union AA) (w ||| r) (k, p)" obtains s where "r = sconst k ||| s" "a.run (AA ! k) (w ||| s) p" proof show "r = sconst k ||| smap snd r" using assms by (coinduction arbitrary: w r p) (force elim: b.run.cases) show "a.run (AA ! k) (w ||| smap snd r) p" using assms by (coinduction arbitrary: w r p) (force elim: b.run.cases) qed lemma union_nodes: assumes "\ (alphabet\<^sub>1 ` set AA) = \ (alphabet\<^sub>1 ` set AA)" shows "b.nodes (union AA) \ (\ k < length AA. {k} \ a.nodes (AA ! k))" proof show "kp \ (\ k < length AA. {k} \ a.nodes (AA ! k))" if "kp \ b.nodes (union AA)" for kp using that assms by (induct) (auto 0 4) qed lemma union_nodes_finite[intro]: assumes "\ (alphabet\<^sub>1 ` set AA) = \ (alphabet\<^sub>1 ` set AA)" assumes "list_all (finite \ a.nodes) AA" shows "finite (b.nodes (union AA))" proof (rule finite_subset) show "b.nodes (union AA) \ (\ k < length AA. {k} \ a.nodes (AA ! k))" using union_nodes assms(1) by this show "finite (\ k < length AA. {k} \ a.nodes' (AA ! k))" using assms(2) unfolding list_all_length by auto qed end - locale automaton_union_list_trace = + locale automaton_union_list_run = automaton_union_list automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 condition + - a: automaton_trace automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + - b: automaton_trace automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 + a: automaton_run automaton\<^sub>1 alphabet\<^sub>1 initial\<^sub>1 transition\<^sub>1 condition\<^sub>1 test\<^sub>1 + + b: automaton_run automaton\<^sub>2 alphabet\<^sub>2 initial\<^sub>2 transition\<^sub>2 condition\<^sub>2 test\<^sub>2 for automaton\<^sub>1 :: "'label set \ 'state set \ ('label, 'state) trans \ 'condition\<^sub>1 \ 'automaton\<^sub>1" and alphabet\<^sub>1 :: "'automaton\<^sub>1 \ 'label set" and initial\<^sub>1 :: "'automaton\<^sub>1 \ 'state set" and transition\<^sub>1 :: "'automaton\<^sub>1 \ ('label, 'state) trans" and condition\<^sub>1 :: "'automaton\<^sub>1 \ 'condition\<^sub>1" and test\<^sub>1 :: "'condition\<^sub>1 \ 'label stream \ 'state stream \ 'state \ bool" and automaton\<^sub>2 :: "'label set \ (nat \ 'state) set \ ('label, nat \ 'state) trans \ 'condition\<^sub>2 \ 'automaton\<^sub>2" and alphabet\<^sub>2 :: "'automaton\<^sub>2 \ 'label set" and initial\<^sub>2 :: "'automaton\<^sub>2 \ (nat \ 'state) set" and transition\<^sub>2 :: "'automaton\<^sub>2 \ ('label, nat \ 'state) trans" and condition\<^sub>2 :: "'automaton\<^sub>2 \ 'condition\<^sub>2" and test\<^sub>2 :: "'condition\<^sub>2 \ 'label stream \ (nat \ 'state) stream \ nat \ 'state \ bool" and condition :: "'condition\<^sub>1 list \ 'condition\<^sub>2" + assumes test[iff]: "k < length cs \ test\<^sub>2 (condition cs) w (sconst k ||| r) (k, p) \ test\<^sub>1 (cs ! k) w r p" begin lemma union_language[simp]: assumes "\ (alphabet\<^sub>1 ` set AA) = \ (alphabet\<^sub>1 ` set AA)" shows "b.language (union AA) = \ (a.language ` set AA)" proof show "b.language (union AA) \ \ (a.language ` set AA)" using assms unfolding a.language_def b.language_def by (force elim: union_run) show "\ (a.language ` set AA) \ b.language (union AA)" using assms unfolding a.language_def b.language_def by (force elim!: run_union) qed end end \ No newline at end of file