theory State_Separator_Completeness
imports State_Separator
begin

(* lemma s_states_exhaustiveness :
  assumes "r_distinguishable_k M q1 q2 k"
  and "q1 \<in> nodes M"
  and "q2 \<in> nodes M"
shows "\<exists> qqt \<in> set (s_states (product (from_FSM M q1) (from_FSM M q2)) (size (product (from_FSM M q1) (from_FSM M q2)))) . fst qqt = (q1,q2)"
using assms proof (induction k arbitrary: q1 q2)
  case 0

  let ?PM = "product (from_FSM M q1) (from_FSM M q2)"

  from 0 obtain x where "x \<in> (inputs M)"
                  and "\<not> (\<exists>t1\<in>(transitions M).
                            \<exists>t2\<in>(transitions M).
                               t_source t1 = q1 \<and>
                               t_source t2 = q2 \<and> t_input t1 = x \<and> t_input t2 = x \<and> t_output t1 = t_output t2)"
    unfolding r_distinguishable_k.simps by blast
  then have *: "\<not> (\<exists>t1 \<in> transitions (from_FSM M q1).
                            \<exists>t2 \<in> transitions (from_FSM M q2).
                               t_source t1 = q1 \<and>
                               t_source t2 = q2 \<and> t_input t1 = x \<and> t_input t2 = x \<and> t_output t1 = t_output t2)"
    using from_FSM_h[OF "0.prems"(2)] from_FSM_h[OF "0.prems"(3)] by blast

  then have "\<And> t . t \<in> transitions ?PM \<Longrightarrow> \<not>(t_source t = (q1,q2) \<and> t_input t = x)"
  proof -
    fix t assume "t \<in> transitions ?PM"
    show "\<not>(t_source t = (q1,q2) \<and> t_input t = x)"
    proof
      assume "t_source t = (q1, q2) \<and> t_input t = x"
      then have "(q1, x, t_output t, fst (t_target t)) \<in> (transitions (from_FSM M q1))"
            and "(q2, x, t_output t, snd (t_target t)) \<in> (transitions (from_FSM M q2))"
        using product_transition_split[OF \<open>t \<in> transitions ?PM\<close>] by auto
      then show "False"
        using * by force
    qed
  qed

  have "(q1,q2) \<in> set (nodes_from_distinct_paths ?PM)"
    using nodes_code nodes.initial product_simps(1) from_FSM_simps(1) by metis

  have p_find_1: "\<And> k' . (\<forall> t \<in> transitions ?PM . (t_source t = fst ((q1,q2),x) \<and> t_input t = snd ((q1,q2),x) \<longrightarrow> (\<exists> qx' \<in> set (s_states ?PM k') . fst qx' = (t_target t))))"
    by (simp add: \<open>\<And>t. t \<in> (transitions (product (from_FSM M q1) (from_FSM M q2))) \<Longrightarrow> \<not> (t_source t = (q1, q2) \<and> t_input t = x)\<close>)

  have p_find_2: "((q1,q2),x) \<in> set (concat (map (\<lambda> q . map (\<lambda> x . (q,x)) (inputs ?PM)) (nodes_from_distinct_paths ?PM)))"
    using concat_pair_set \<open>x \<in> (inputs M)\<close> \<open>(q1,q2) \<in> set (nodes_from_distinct_paths ?PM)\<close>
  proof -
    have f1: "\<forall>a ps aa f. set (concat (map (\<lambda>p. map (Pair (p::'a \<times> 'a)) (inputs (product (from_FSM (f::('a,'b,'c) fsm) a) (from_FSM f aa)))) ps)) = set (concat (map (\<lambda>p. map (Pair p) (inputs f)) ps))"
      by (simp add: from_FSM_product_inputs)
    have "\<forall>is p ps. p \<in> set (concat (map (\<lambda>p. map (Pair (p::'a \<times> 'a)) is) ps)) \<or> \<not> (fst p \<in> set ps \<and> (snd p::integer) \<in> set is)"
      using concat_pair_set by blast
    then show ?thesis
      using f1 by (metis \<open>(q1, q2) \<in> set (nodes_from_distinct_paths (product (from_FSM M q1) (from_FSM M q2)))\<close> \<open>x \<in> (inputs M)\<close> fst_conv snd_conv)
  qed

  have p_find: "\<And> k . (\<forall> qx' \<in> set (s_states ?PM k) . (q1,q2) \<noteq> fst qx') \<Longrightarrow>
               ((\<lambda> qx . (\<forall> qx' \<in> set (s_states ?PM k) . fst qx \<noteq> fst qx') \<and> (\<forall> t \<in> transitions ?PM . (t_source t = fst qx \<and> t_input t = snd qx) \<longrightarrow> (\<exists> qx' \<in> set (s_states ?PM k) . fst qx' = (t_target t)))) ((q1,q2),x))
                \<and> ((q1,q2),x) \<in> set (concat (map (\<lambda> q . map (\<lambda> x . (q,x)) (inputs ?PM)) (nodes_from_distinct_paths ?PM)))"
    using p_find_1 p_find_2
    by (metis fst_conv)

  have p_find_alt : "\<And> k . (\<forall> qx' \<in> set (s_states ?PM k) . (q1,q2) \<noteq> fst qx') \<Longrightarrow>
                            find
                              (\<lambda>qx. (\<forall>qx'\<in>set (s_states ?PM k).
                                        fst qx \<noteq> fst qx') \<and>
                                    (\<forall>t\<in>(transitions ?PM).
                                        t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow>
                                        (\<exists>qx'\<in>set (s_states ?PM k).
                                            fst qx' = t_target t)))
                              (concat
                                (map (\<lambda>q. map (Pair q) (inputs ?PM))
                                  (nodes_from_distinct_paths ?PM))) \<noteq> None"

  proof -
    fix k assume assm: "(\<forall> qx' \<in> set (s_states ?PM k) . (q1,q2) \<noteq> fst qx')"
    show "find
            (\<lambda>qx. (\<forall>qx'\<in>set (s_states ?PM k). fst qx \<noteq> fst qx') \<and> (\<forall>t\<in>(transitions ?PM). t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow> (\<exists>qx'\<in>set (s_states ?PM k). fst qx' = t_target t)))
            (concat (map (\<lambda>q. map (Pair q) (inputs ?PM)) (nodes_from_distinct_paths ?PM))) \<noteq> None"
      using find_None_iff[of "(\<lambda>qx. (\<forall>qx'\<in>set (s_states ?PM k). fst qx \<noteq> fst qx') \<and> (\<forall>t\<in>(transitions ?PM). t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow> (\<exists>qx'\<in>set (s_states ?PM k). fst qx' = t_target t)))"
                             "(concat (map (\<lambda>q. map (Pair q) (inputs ?PM)) (nodes_from_distinct_paths ?PM)))" ]
            p_find[OF assm] by blast
  qed

  have "\<exists> x . ((q1,q2),x) \<in> set (s_states ?PM (size ?PM))"
  proof (rule ccontr)
    assume "\<not> (\<exists> x . ((q1,q2),x) \<in> set (s_states ?PM (size ?PM)))"

    let ?l = "length (s_states ?PM (size ?PM))"
    have "s_states ?PM (size ?PM) = s_states ?PM ?l"
      by (metis (no_types, hide_lams) s_states_self_length)

    then have l_assm: "\<not> (\<exists> x . ((q1,q2),x) \<in> set (s_states ?PM ?l))"
      using \<open>\<not> (\<exists> x . ((q1,q2),x) \<in> set (s_states ?PM (size ?PM)))\<close> by auto

    then have "(q1,q2) \<notin> set (map fst (s_states ?PM ?l))" by auto

    have "?l \<le> size ?PM"
      using s_states_length by blast

    then consider
      (a) "?l = 0" |
      (b) "0 < ?l \<and> ?l < size ?PM" |
      (c) "?l = size ?PM"
      using nat_less_le by blast
    then show "False" proof cases
      case a

      then have "(s_states ?PM (Suc 0)) = []"
        by (metis s_states_prefix s_states_self_length s_states_size take_eq_Nil)
      then have *: "find
              (\<lambda>qx. (\<forall>qx'\<in>set []. fst qx \<noteq> fst qx') \<and>
                    (\<forall>t\<in>(transitions (product (from_FSM M q1) (from_FSM M q2))).
                        t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow>
                        (\<exists>qx'\<in>set []. fst qx' = t_target t)))
              (concat
                (map (\<lambda>q. map (Pair q) (inputs (product (from_FSM M q1) (from_FSM M q2))))
                  (nodes_from_distinct_paths (product (from_FSM M q1) (from_FSM M q2))))) = None"
        unfolding s_states.simps
        using find_None_iff by fastforce
      then have "\<not>(\<exists> qqt \<in> set (concat
                (map (\<lambda>q. map (Pair q) (inputs (product (from_FSM M q1) (from_FSM M q2))))
                  (nodes_from_distinct_paths (product (from_FSM M q1) (from_FSM M q2))))) . (\<lambda>qx. (\<forall>qx'\<in>set []. fst qx \<noteq> fst qx') \<and>
                    (\<forall>t\<in>(transitions (product (from_FSM M q1) (from_FSM M q2))).
                        t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow>
                        (\<exists>qx'\<in>set []. fst qx' = t_target t))) qqt)"
        unfolding s_states.simps
        using find_None_iff[of "(\<lambda>qx. (\<forall>qx'\<in>set []. fst qx \<noteq> fst qx') \<and>
                    (\<forall>t\<in>(transitions (product (from_FSM M q1) (from_FSM M q2))).
                        t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow>
                        (\<exists>qx'\<in>set []. fst qx' = t_target t)))" "(concat
                (map (\<lambda>q. map (Pair q) (inputs (product (from_FSM M q1) (from_FSM M q2))))
                  (nodes_from_distinct_paths (product (from_FSM M q1) (from_FSM M q2)))))" ] by blast
      then have "\<not>(\<exists> qqt \<in> set (concat
                (map (\<lambda>q. map (Pair q) (inputs (product (from_FSM M q1) (from_FSM M q2))))
                  (nodes_from_distinct_paths (product (from_FSM M q1) (from_FSM M q2))))) . (\<lambda>qx. (\<forall>qx'\<in>set (s_states ?PM 0). fst qx \<noteq> fst qx') \<and>
                    (\<forall>t\<in>(transitions (product (from_FSM M q1) (from_FSM M q2))).
                        t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow>
                        (\<exists>qx'\<in>set (s_states ?PM 0). fst qx' = t_target t))) qqt)"
        unfolding s_states.simps by assumption

      then show "False"
        using p_find[of 0]
        by (metis \<open>s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2))) = s_states (product (from_FSM M q1) (from_FSM M q2)) (length (s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2)))))\<close> a length_0_conv length_greater_0_conv length_pos_if_in_set)

    next
      case b

      then obtain l' where Suc: "?l = Suc l'" using gr0_conv_Suc by blast
      moreover obtain l where "l = ?l" by auto
      ultimately have "l = Suc l'" by auto

      have "s_states ?PM ?l = s_states ?PM (Suc ?l)"
        using s_states_prefix[of ?l "Suc ?l"] s_states_max_iterations
      proof -
        have "\<forall>n. n \<le> Suc n"
          by simp
        then show ?thesis
          by (metis Suc_le_mono \<open>s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2))) = s_states (product (from_FSM M q1) (from_FSM M q2)) (length (s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2)))))\<close> s_states_length s_states_max_iterations s_states_prefix take_all)
      qed

      have "length (s_states ?PM l') < length (s_states ?PM ?l)" using Suc
        using \<open>s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2))) = s_states (product (from_FSM M q1) (from_FSM M q2)) (length (s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2)))))\<close> less_Suc_eq_le s_states_length by auto

      have "length (s_states (product (from_FSM M q1) (from_FSM M q2)) l) = l"
        using \<open>l = length (s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2))))\<close> \<open>s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2))) = s_states (product (from_FSM M q1) (from_FSM M q2)) (length (s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2)))))\<close> by auto
      then have "\<not>(length (s_states (product (from_FSM M q1) (from_FSM M q2)) l) < l)"
        by force

      have "\<forall>qx'\<in>set (s_states (product (from_FSM M q1) (from_FSM M q2)) l). (q1, q2) \<noteq> fst qx'"
        using l_assm \<open>l = ?l\<close>
        by auto

      have "s_states ?PM l = s_states ?PM (Suc l)"
      proof -
        show ?thesis
          using \<open>length (s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2)))) = Suc l'\<close> \<open>s_states (product (from_FSM M q1) (from_FSM M q2)) (length (s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2))))) = s_states (product (from_FSM M q1) (from_FSM M q2)) (Suc (length (s_states (product (from_FSM M q1) (from_FSM M q2)) (FSM.size (product (from_FSM M q1) (from_FSM M q2))))))\<close>
          using \<open>l = Suc l'\<close>
          by presburger
      qed
      then have "s_states ?PM l = (case find
                (\<lambda>qx. (\<forall>qx'\<in>set (s_states (product (from_FSM M q1) (from_FSM M q2)) l).
                          fst qx \<noteq> fst qx') \<and>
                      (\<forall>t\<in>(transitions (product (from_FSM M q1) (from_FSM M q2))).
                          t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow>
                          (\<exists>qx'\<in>set (s_states (product (from_FSM M q1) (from_FSM M q2)) l).
                              fst qx' = t_target t)))
                (concat
                  (map (\<lambda>q. map (Pair q) (inputs (product (from_FSM M q1) (from_FSM M q2))))
                    (nodes_from_distinct_paths (product (from_FSM M q1) (from_FSM M q2))))) of
          None \<Rightarrow> s_states (product (from_FSM M q1) (from_FSM M q2)) l
          | Some qx \<Rightarrow> s_states (product (from_FSM M q1) (from_FSM M q2)) l @ [qx])"
        unfolding s_states.simps
        using \<open>\<not>(length (s_states (product (from_FSM M q1) (from_FSM M q2)) l) < l)\<close> by force

      then have "find
                (\<lambda>qx. (\<forall>qx'\<in>set (s_states (product (from_FSM M q1) (from_FSM M q2)) l).
                          fst qx \<noteq> fst qx') \<and>
                      (\<forall>t\<in>(transitions (product (from_FSM M q1) (from_FSM M q2))).
                          t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow>
                          (\<exists>qx'\<in>set (s_states (product (from_FSM M q1) (from_FSM M q2)) l).
                              fst qx' = t_target t)))
                (concat
                  (map (\<lambda>q. map (Pair q) (inputs (product (from_FSM M q1) (from_FSM M q2))))
                    (nodes_from_distinct_paths (product (from_FSM M q1) (from_FSM M q2))))) = None"
      proof -
        have "s_states (product (from_FSM M q1) (from_FSM M q2)) l @ [the (find (\<lambda>p. (\<forall>pa. pa \<in> set (s_states (product (from_FSM M q1) (from_FSM M q2)) l) \<longrightarrow> fst p \<noteq> fst pa) \<and> (\<forall>pa. pa \<in> (transitions (product (from_FSM M q1) (from_FSM M q2))) \<longrightarrow> t_source pa = fst p \<and> t_input pa = snd p \<longrightarrow> (\<exists>p. p \<in> set (s_states (product (from_FSM M q1) (from_FSM M q2)) l) \<and> fst p = t_target pa))) (concat (map (\<lambda>p. map (Pair p) (inputs (product (from_FSM M q1) (from_FSM M q2)))) (nodes_from_distinct_paths (product (from_FSM M q1) (from_FSM M q2))))))] \<noteq> s_states (product (from_FSM M q1) (from_FSM M q2)) l"
          by force
        then show ?thesis
          using \<open>s_states (product (from_FSM M q1) (from_FSM M q2)) l = (case find (\<lambda>qx. (\<forall>qx'\<in>set (s_states (product (from_FSM M q1) (from_FSM M q2)) l). fst qx \<noteq> fst qx') \<and> (\<forall>t\<in>(transitions (product (from_FSM M q1) (from_FSM M q2))). t_source t = fst qx \<and> t_input t = snd qx \<longrightarrow> (\<exists>qx'\<in>set (s_states (product (from_FSM M q1) (from_FSM M q2)) l). fst qx' = t_target t))) (concat (map (\<lambda>q. map (Pair q) (inputs (product (from_FSM M q1) (from_FSM M q2)))) (nodes_from_distinct_paths (product (from_FSM M q1) (from_FSM M q2))))) of None \<Rightarrow> s_states (product (from_FSM M q1) (from_FSM M q2)) l | Some qx \<Rightarrow> s_states (product (from_FSM M q1) (from_FSM M q2)) l @ [qx])\<close> by force
      qed

      then show "False" using p_find_alt[OF \<open>\<forall>qx'\<in>set (s_states (product (from_FSM M q1) (from_FSM M q2)) l). (q1, q2) \<noteq> fst qx'\<close>] by blast
    next
      case c
      have "distinct (map fst (s_states ?PM ?l))"
        using s_states_distinct_states by blast
      then have "card (set (map fst (s_states ?PM ?l))) = size ?PM"
        using c distinct_card by fastforce
      moreover have "set (map fst (s_states ?PM ?l)) \<subseteq> nodes ?PM"
        using s_states_nodes by metis
      ultimately have "set (map fst (s_states ?PM ?l)) = nodes ?PM"
        using nodes_finite[of ?PM]
        by (simp add: card_subset_eq)

      then  have "(q1,q2) \<notin> nodes ?PM"
        using \<open>(q1,q2) \<notin> set (map fst (s_states ?PM ?l))\<close>
        by blast
      moreover have "(q1,q2) \<in> nodes ?PM"
        using nodes.initial[of ?PM] product_simps(1) from_FSM_simps(1) by metis
      ultimately show "False"
        by blast
    qed
  qed

  then show ?case
    by (meson fst_conv)
next
  case (Suc k)

  (* sketch:
    \<longrightarrow> cases Suc k = LEAST,
      \<longrightarrow> FALSE: then also k \<longrightarrow> by IH
      \<longrightarrow> TRUE
        \<longrightarrow> \<noteq> 0
        \<longrightarrow> exists input x such that for every ((q1,q2),x,y,(s1,s2)) \<in> transitions ?PM , s1 and s2 are r(k)-d
          \<longrightarrow> (s1,s2) is contained in s_states for product for s1 s2
          \<longrightarrow> also: (s1,s2) (initial state of the above) is a node of product for q1 q2
          \<longrightarrow> then (s1,s2) is in s_states for product for q1 q2
          \<longrightarrow> by construction there must then exist some x' s.t. ((q1,q2),x') \<in> s_states
  *)

  let ?PM = "(product (from_FSM M q1) (from_FSM M q2))"

  show ?case proof (cases "r_distinguishable_k M q1 q2 k")
    case True
    show ?thesis using Suc.IH[OF True Suc.prems(2,3)] by assumption
  next
    case False
    then obtain x where "x \<in> (inputs M)"
                    and "\<forall>t1\<in>(transitions M).
                           \<forall>t2\<in>(transitions M).
                              t_source t1 = q1 \<and>
                              t_source t2 = q2 \<and> t_input t1 = x \<and> t_input t2 = x \<and> t_output t1 = t_output t2 \<longrightarrow>
                              r_distinguishable_k M (t_target t1) (t_target t2) k"
      using Suc.prems(1) unfolding r_distinguishable_k.simps by blast
    then have x_transitions: "\<forall>t1\<in>(transitions (from_FSM M q1)).
                               \<forall>t2\<in>(transitions (from_FSM M q2)).
                                  t_source t1 = q1 \<and>
                                  t_source t2 = q2 \<and> t_input t1 = x \<and> t_input t2 = x \<and> t_output t1 = t_output t2 \<longrightarrow>
                                  r_distinguishable_k M (t_target t1) (t_target t2) k"
      using from_FSM_h[OF Suc.prems(2)] from_FSM_h[OF Suc.prems(3)] by blast

    have x_prop: "\<And> t . t \<in> transitions ?PM \<Longrightarrow> t_source t = (q1,q2) \<Longrightarrow> t_input t = x \<Longrightarrow>
                (\<exists>qqt\<in>set (s_states ?PM (size ?PM)) .
                   fst qqt = t_target t)"
    proof -
      fix t assume "t \<in> transitions ?PM" and "t_source t = (q1,q2)" and "t_input t = x"

      have *: "(fst (t_source t), t_input t, t_output t, fst (t_target t)) \<in> (transitions (from_FSM M q1))"
      and **: "(snd (t_source t), t_input t, t_output t, snd (t_target t)) \<in> (transitions (from_FSM M q2))"
        using product_transition_t[of t "from_FSM M q1" "from_FSM M q2"] \<open>t \<in> transitions ?PM\<close>  by simp+

      then have "(q1,x,t_output t,fst (t_target t)) \<in> transitions (from_FSM M q1)"
           and  "(q2,x,t_output t,snd (t_target t)) \<in> transitions (from_FSM M q2)"
        using \<open>t_source t = (q1,q2)\<close> \<open>t_input t = x\<close> by simp+

      then have "r_distinguishable_k M (fst (t_target t)) (snd (t_target t)) k"
        using x_transitions by auto
      moreover have "fst (t_target t) \<in> nodes M"
        using from_FSM_nodes[OF Suc.prems(2)] wf_transition_target[OF *] by auto
      moreover have "snd (t_target t) \<in> nodes M"
        using from_FSM_nodes[OF Suc.prems(3)] wf_transition_target[OF **] by auto

      ultimately have "\<exists>qqt\<in>set (s_states (product (from_FSM M (fst (t_target t))) (from_FSM M (snd (t_target t))))
                                  (FSM.size (product (from_FSM M (fst (t_target t))) (from_FSM M (snd (t_target t)))))).
                         fst qqt = (fst (t_target t), snd (t_target t))"
        using Suc.IH[of "(fst (t_target t))" "(snd (t_target t))"] by blast

      then obtain qqt where qqt_def: "qqt\<in>set (s_states (product (from_FSM M (fst (t_target t))) (from_FSM M (snd (t_target t))))
                                  (FSM.size (product (from_FSM M (fst (t_target t))) (from_FSM M (snd (t_target t))))))"
                      and   "fst qqt = (fst (t_target t), snd (t_target t))"
        by blast

      let ?PM' = "product (from_FSM M (fst (t_source t))) (from_FSM M (snd (t_source t)))"
      have "?PM = ?PM'"
        using \<open>t_source t = (q1,q2)\<close> by auto
      then have "t \<in> transitions ?PM'"
        using \<open>t \<in> transitions ?PM\<close> by simp

      show "\<exists>qqt\<in>set (s_states (product (from_FSM M q1) (from_FSM M q2))
                     (FSM.size (product (from_FSM M q1) (from_FSM M q2)))).
            fst qqt = t_target t"
        using s_states_step_prod[OF qqt_def \<open>t \<in> transitions ?PM'\<close>] \<open>?PM = ?PM'\<close>
              \<open>fst qqt = (fst (t_target t), snd (t_target t))\<close>
        by (metis prod.collapse)
    qed

    let ?l = "length (s_states ?PM (size ?PM))"
    have "s_states ?PM (size ?PM) = s_states ?PM ?l"
      using s_states_self_length by blast
    then have "s_states ?PM ?l = s_states ?PM (Suc ?l)"
      by (metis Suc_n_not_le_n nat_le_linear s_states_max_iterations s_states_prefix take_all)

    have "\<exists>qqx'\<in>set (s_states ?PM ?l). (q1,q2) = fst qqx'"  proof (rule ccontr)
      assume c_assm: "\<not> (\<exists>qqx'\<in>set (s_states ?PM ?l). (q1,q2) = fst qqx')"

      have "(\<forall>qx'\<in>set (s_states ?PM ?l). (q1,q2) \<noteq> fst qx')"
        using c_assm by blast
      moreover have "\<And> t . t \<in> transitions ?PM \<Longrightarrow>
                t_source t = fst ((q1,q2),x) \<Longrightarrow>
                t_input t = snd ((q1,q2),x) \<Longrightarrow>
                (\<exists>qx'\<in>set (s_states ?PM ?l). fst qx' = t_target t)"
        using x_prop snd_conv[of "(q1,q2)" x] fst_conv[of "(q1,q2)" x] \<open>s_states ?PM (size ?PM) = s_states ?PM ?l\<close> by auto
      ultimately have "(\<lambda> qx . (\<forall> qx' \<in> set (s_states ?PM ?l) . fst qx \<noteq> fst qx') \<and> (\<forall> t \<in> transitions ?PM . (t_source t = fst qx \<and> t_input t = snd qx) \<longrightarrow> (\<exists> qx' \<in> set (s_states ?PM ?l) . fst qx' = (t_target t)))) ((q1,q2),x)"
        by auto
      moreover have "((q1,q2),x) \<in> set (concat (map (\<lambda>q. map (Pair q) (inputs ?PM)) (nodes_from_distinct_paths ?PM)))"
      proof -
        have "fst ((q1,q2),x) \<in> set (nodes_from_distinct_paths ?PM)"
          using nodes.initial nodes_code
                fst_conv product_simps(1) from_FSM_simps(1)
          by metis
        moreover have "snd ((q1,q2),x) \<in> (inputs ?PM)"
          using \<open>x \<in> (inputs M)\<close>
          by (simp add: from_FSM_simps(2) product_simps(2))
        ultimately show ?thesis using concat_pair_set[of "inputs ?PM" "nodes_from_distinct_paths ?PM"]
          by blast
      qed
      ultimately have "find
                  (\<lambda> qx . (\<forall> qx' \<in> set (s_states ?PM ?l) . fst qx \<noteq> fst qx') \<and> (\<forall> t \<in> transitions ?PM . (t_source t = fst qx \<and> t_input t = snd qx) \<longrightarrow> (\<exists> qx' \<in> set (s_states ?PM ?l) . fst qx' = (t_target t))))
                  (concat (map (\<lambda> q . map (\<lambda> x . (q,x)) (inputs ?PM)) (nodes_from_distinct_paths ?PM))) \<noteq> None"
        using find_from[of "(concat (map (\<lambda>q. map (Pair q) (inputs ?PM)) (nodes_from_distinct_paths ?PM)))" "(\<lambda> qx . (\<forall> qx' \<in> set (s_states ?PM ?l) . fst qx \<noteq> fst qx') \<and> (\<forall> t \<in> transitions ?PM . (t_source t = fst qx \<and> t_input t = snd qx) \<longrightarrow> (\<exists> qx' \<in> set (s_states ?PM ?l) . fst qx' = (t_target t))))"] by blast

      then have "s_states ?PM (Suc ?l) \<noteq> s_states ?PM ?l"
        unfolding s_states.simps
        using \<open>s_states ?PM (FSM.size ?PM) = s_states ?PM ?l\<close> by auto
      then show "False"
        using \<open>s_states ?PM ?l = s_states ?PM (Suc ?l)\<close>
        by simp
    qed

    then show ?thesis
      using \<open>s_states ?PM (size ?PM) = s_states ?PM ?l\<close>
      by force
  qed
qed

lemma calculate_state_separator_from_s_states_exhaustiveness :
  assumes "r_distinguishable_k M q1 q2 k"
  and "q1 \<in> nodes M"
  and "q2 \<in> nodes M"
shows "calculate_state_separator_from_s_states M q1 q2 \<noteq> None"
proof -

  let ?PM = "product (from_FSM M q1) (from_FSM M q2)"
  let ?SS = "s_states_opt ?PM (FSM.size ?PM)"

  have "\<exists> qqt \<in> set (s_states ?PM (size ?PM)) . fst qqt = (q1, q2)"
    using s_states_exhaustiveness[OF \<open>r_distinguishable_k M q1 q2 k\<close> assms(2,3)] by blast

  have "find_index (\<lambda>qqt. fst qqt = (q1, q2)) ?SS \<noteq> None"
    using find_index_exhaustive[OF \<open>\<exists> qqt \<in> set (s_states ?PM (size ?PM)) . fst qqt = (q1, q2)\<close>]
    by (simp add: s_states_code)

  then obtain S where "calculate_state_separator_from_s_states M q1 q2 = Some S"
    unfolding calculate_state_separator_from_s_states_def Let_def
    by (meson option.case_eq_if)

  then show ?thesis by auto
qed

*)

(* lemma r_distinguishability_implies_state_separator :
  assumes "r_distinguishable M q1 q2"
  and     "q1 \<in> nodes M"
  and     "q2 \<in> nodes M"
  and     "q1 \<noteq> q2"
  and     "completely_specified M"
shows "\<exists> S . is_state_separator_from_canonical_separator (canonical_separator M q1 q2) q1 q2 S"
proof -

  let ?PM = "product (from_FSM M q1) (from_FSM M q2)"
  let ?SS = "s_states_opt ?PM (FSM.size ?PM)"

  obtain k where "r_distinguishable_k M q1 q2 k"
    by (meson assms r_distinguishable_alt_def)

  then obtain S where "calculate_state_separator_from_s_states M q1 q2 = Some S"
    using calculate_state_separator_from_s_states_exhaustiveness[OF _ assms(2,3)] by blast

  show ?thesis
    using calculate_state_separator_from_s_states_soundness
            [OF \<open>calculate_state_separator_from_s_states M q1 q2 = Some S\<close> assms(2,3,4,5)] by blast
qed

lemma r_distinguishable_iff_state_separator_exists :
  assumes "q1 \<in> nodes M"
  and     "q2 \<in> nodes M"
  and     "q1 \<noteq> q2"
  and     "completely_specified M"
shows "r_distinguishable M q1 q2 \<longleftrightarrow> (\<exists> S . is_state_separator_from_canonical_separator (canonical_separator M q1 q2) q1 q2 S)"
  using r_distinguishability_implies_state_separator[OF _ assms] state_separator_r_distinguishes_k r_distinguishable_alt_def[OF assms(1,2)]
  by metis

*)

end


(*  Title:      HOL/MicroJava/BV/Opt.thy
    Author:     Tobias Nipkow
    Copyright   2000 TUM

More about options.
*)

section \<open>More about Options\<close>

theory Opt imports Err begin

definition le :: "'a ord \<Rightarrow> 'a option ord"
where
  "le r o\<^sub>1 o\<^sub>2 =
  (case o\<^sub>2 of None \<Rightarrow> o\<^sub>1=None | Some y \<Rightarrow> (case o\<^sub>1 of None \<Rightarrow> True | Some x \<Rightarrow> x \<sqsubseteq>\<^sub>r y))"

definition opt :: "'a set \<Rightarrow> 'a option set"
where
  "opt A = insert None {Some y |y. y \<in> A}"

definition sup :: "'a ebinop \<Rightarrow> 'a option ebinop"
where
  "sup f o\<^sub>1 o\<^sub>2 =
  (case o\<^sub>1 of None \<Rightarrow> OK o\<^sub>2
           | Some x \<Rightarrow> (case o\<^sub>2 of None \<Rightarrow> OK o\<^sub>1
                                 | Some y \<Rightarrow> (case f x y of Err \<Rightarrow> Err | OK z \<Rightarrow> OK (Some z))))"

definition esl :: "'a esl \<Rightarrow> 'a option esl"
where
  "esl = (\<lambda>(A,r,f). (opt A, le r, sup f))"

lemma unfold_le_opt:
  "o\<^sub>1 \<sqsubseteq>\<^bsub>le r\<^esub> o\<^sub>2 =
  (case o\<^sub>2 of None \<Rightarrow> o\<^sub>1=None |
              Some y \<Rightarrow> (case o\<^sub>1 of None \<Rightarrow> True | Some x \<Rightarrow> x \<sqsubseteq>\<^sub>r y))"
(*<*)
apply (unfold lesub_def le_def)
apply (rule refl)
done
(*>*)

lemma le_opt_refl: "order r A \<Longrightarrow>  x \<in> opt A \<Longrightarrow> x \<sqsubseteq>\<^bsub>le r\<^esub> x"
(*<*) by (auto simp add: unfold_le_opt opt_def split: option.split) (*<*)

lemma le_opt_trans [rule_format]:
  "order r A \<Longrightarrow> x \<in> opt A \<Longrightarrow> y \<in> opt A \<Longrightarrow> z \<in> opt A \<Longrightarrow> x \<sqsubseteq>\<^bsub>le r\<^esub> y \<longrightarrow> y \<sqsubseteq>\<^bsub>le r\<^esub> z \<longrightarrow> x \<sqsubseteq>\<^bsub>le r\<^esub> z"
(*<*)
apply (simp add: unfold_le_opt opt_def split: option.split)
apply (blast intro: order_trans)
done
(*>*)

lemma le_opt_antisym [rule_format]:
  "order r A \<Longrightarrow> x \<in> opt A \<Longrightarrow> y \<in> opt A \<Longrightarrow> z \<in> opt A \<Longrightarrow> x \<sqsubseteq>\<^bsub>le r\<^esub> y \<longrightarrow> y \<sqsubseteq>\<^bsub>le r\<^esub> x \<longrightarrow> x=y"
(*<*)
apply (simp add: unfold_le_opt opt_def split: option.split)
apply (blast intro: order_antisym)
done
(*>*)

lemma order_le_opt [intro!,simp]: "order r A \<Longrightarrow> order(le r) (opt A)"
(*<*)
apply (subst order_def)
apply (blast intro: le_opt_refl le_opt_trans le_opt_antisym)
done
(*>*)

lemma None_bot [iff]:  "None \<sqsubseteq>\<^bsub>le r\<^esub> ox"
(*<*)
apply (unfold lesub_def le_def)
apply (simp split: option.split)
done
(*>*)

lemma Some_le [iff]: "(Some x \<sqsubseteq>\<^bsub>le r\<^esub> z) = (\<exists>y. z = Some y \<and> x \<sqsubseteq>\<^sub>r y)"
(*<*)
apply (unfold lesub_def le_def)
apply (simp split: option.split)
done
(*>*)

lemma le_None [iff]: "(x \<sqsubseteq>\<^bsub>le r\<^esub> None) = (x = None)"
(*<*)
apply (unfold lesub_def le_def)
apply (simp split: option.split)
done
(*>*)

lemma OK_None_bot [iff]: "OK None \<sqsubseteq>\<^bsub>Err.le (le r)\<^esub> x"
(*<*) by (simp add: lesub_def Err.le_def le_def split: option.split err.split) (*>*)

lemma sup_None1 [iff]: "x \<squnion>\<^bsub>sup f\<^esub> None = OK x"
(*<*) by (simp add: plussub_def sup_def split: option.split) (*>*)

lemma sup_None2 [iff]: "None \<squnion>\<^bsub>sup f\<^esub> x = OK x"
(*<*) by (simp add: plussub_def sup_def split: option.split) (*>*)

lemma None_in_opt [iff]: "None \<in> opt A"
(*<*) by (simp add: opt_def) (*>*)

lemma Some_in_opt [iff]: "(Some x \<in> opt A) = (x \<in> A)"
(*<*) by (unfold opt_def) auto (*>*)

lemma semilat_opt [intro, simp]:
  "err_semilat L \<Longrightarrow> err_semilat (Opt.esl L)"
(*<*)
proof -
  assume s: "err_semilat L"
  obtain A r f where [simp]: "L = (A,r,f)" by (cases L)
  let ?A0 = "err A" and ?r0 = "Err.le r" and ?f0 = "lift2 f"
  from s obtain
    ord: "order ?r0 ?A" and
    clo: "closed ?A0 ?f0" and
    ub1: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. x \<sqsubseteq>\<^bsub>?r0\<^esub> x \<squnion>\<^bsub>?f0\<^esub> y" and
    ub2: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. y \<sqsubseteq>\<^bsub>?r0\<^esub> x \<squnion>\<^bsub>?f0\<^esub> y" and
    lub: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. \<forall>z\<in>?A0. x \<sqsubseteq>\<^bsub>?r0\<^esub> z \<and> y \<sqsubseteq>\<^bsub>?r0\<^esub> z \<longrightarrow> x \<squnion>\<^bsub>?f0\<^esub> y \<sqsubseteq>\<^bsub>?r0\<^esub> z"
    by (unfold semilat_def sl_def) simp

  let ?A = "err (opt A)" and ?r = "Err.le (Opt.le r)" and ?f = "lift2 (Opt.sup f)"

  from ord have "order ?r ?A" by simp
  moreover
  have "closed ?A ?f"
  proof (unfold closed_def, intro strip)
    fix x y assume x: "x \<in> ?A" and y: "y \<in> ?A"

    { fix a b assume ab: "x = OK a" "y = OK b"
      with x have a: "\<And>c. a = Some c \<Longrightarrow> c \<in> A" by (clarsimp simp add: opt_def)
      from ab y have b: "\<And>d. b = Some d \<Longrightarrow> d \<in> A" by (clarsimp simp add: opt_def)
      { fix c d assume "a = Some c" "b = Some d"
        with ab x y have "c \<in> A & d \<in> A" by (simp add: err_def opt_def Bex_def)
        with clo have "f c d \<in> err A"
          by (simp add: closed_def plussub_def err_def' lift2_def)
        moreover fix z assume "f c d = OK z"
        ultimately have "z \<in> A" by simp
      } note f_closed = this
      have "sup f a b \<in> ?A"
      proof (cases a)
        case None thus ?thesis
          by (simp add: sup_def opt_def) (cases b, simp, simp add: b Bex_def)
      next
        case Some thus ?thesis
          by (auto simp add: sup_def opt_def Bex_def a b f_closed split: err.split option.split)
      qed
    }
    thus "x \<squnion>\<^bsub>?f\<^esub> y \<in> ?A" by (simp add: plussub_def lift2_def split: err.split)
  qed
  moreover
  { fix a b c assume "a \<in> opt A" and "b \<in> opt A" and "a \<squnion>\<^bsub>sup f\<^esub> b = OK c"
    moreover from ord have "order r A" by simp
    moreover
    { fix x y z assume "x \<in> A" and "y \<in> A"
      hence "OK x \<in> err A \<and> OK y \<in> err A" by simp
      with ub1 ub2
      have "(OK x) \<sqsubseteq>\<^bsub>Err.le r\<^esub> (OK x) \<squnion>\<^bsub>lift2 f\<^esub> (OK y) \<and>
            (OK y) \<sqsubseteq>\<^bsub>Err.le r\<^esub> (OK x) \<squnion>\<^bsub>lift2 f\<^esub> (OK y)"
        by blast
      moreover assume "x \<squnion>\<^sub>f y = OK z"
      ultimately have "x \<sqsubseteq>\<^sub>r z \<and> y \<sqsubseteq>\<^sub>r z"
        by (auto simp add: plussub_def lift2_def Err.le_def lesub_def)
    }
    ultimately have "a \<sqsubseteq>\<^bsub>le r\<^esub> c \<and> b \<sqsubseteq>\<^bsub>le r\<^esub> c"
      by (auto simp add: sup_def le_def lesub_def plussub_def
               dest: order_refl split: option.splits err.splits)
  }
  hence "(\<forall>x\<in>?A. \<forall>y\<in>?A. x \<sqsubseteq>\<^bsub>?r\<^esub> x \<squnion>\<^bsub>?f\<^esub> y) \<and> (\<forall>x\<in>?A. \<forall>y\<in>?A. y \<sqsubseteq>\<^bsub>?r\<^esub> x \<squnion>\<^bsub>?f\<^esub> y)"
    by (auto simp add: lesub_def plussub_def Err.le_def lift2_def split: err.split)
  moreover
  have "\<forall>x\<in>?A. \<forall>y\<in>?A. \<forall>z\<in>?A. x \<sqsubseteq>\<^bsub>?r\<^esub> z \<and> y \<sqsubseteq>\<^bsub>?r\<^esub> z \<longrightarrow> x \<squnion>\<^bsub>?f\<^esub> y \<sqsubseteq>\<^bsub>?r\<^esub> z"
  proof (intro strip, elim conjE)
    fix x y z
    assume xyz: "x \<in> ?A"   "y \<in> ?A"   "z \<in> ?A"
    assume xz: "x \<sqsubseteq>\<^bsub>?r\<^esub> z" and yz: "y \<sqsubseteq>\<^bsub>?r\<^esub> z"
    { fix a b c assume ok: "x = OK a"  "y = OK b"  "z = OK c"
      { fix d e g  assume some: "a = Some d"  "b = Some e"  "c = Some g"
        with ok xyz obtain "OK d:err A" "OK e:err A" "OK g:err A"  by simp
        with lub
        have "\<lbrakk> OK d \<sqsubseteq>\<^bsub>Err.le r\<^esub> OK g; OK e \<sqsubseteq>\<^bsub>Err.le r\<^esub> OK g \<rbrakk> \<Longrightarrow> OK d \<squnion>\<^bsub>lift2 f\<^esub> OK e \<sqsubseteq>\<^bsub>Err.le r\<^esub> OK g"
          by blast
        hence "\<lbrakk> d \<sqsubseteq>\<^sub>r g; e \<sqsubseteq>\<^sub>r g \<rbrakk> \<Longrightarrow> \<exists>y. d \<squnion>\<^sub>f e = OK y \<and> y \<sqsubseteq>\<^sub>r g" by simp
        with ok some xyz xz yz have "x \<squnion>\<^bsub>?f\<^esub> y \<sqsubseteq>\<^bsub>?r\<^esub> z"
          by (auto simp add: sup_def le_def lesub_def lift2_def plussub_def Err.le_def)
      } note this [intro!]
      from ok xyz xz yz have "x \<squnion>\<^bsub>?f\<^esub> y \<sqsubseteq>\<^bsub>?r\<^esub> z"
        by - (cases a, simp, cases b, simp, cases c, simp, blast)
    }
    with xyz xz yz show "x \<squnion>\<^bsub>?f\<^esub> y \<sqsubseteq>\<^bsub>?r\<^esub> z"
      by - (cases x, simp, cases y, simp, cases z, simp+)
  qed
  ultimately show "err_semilat (Opt.esl L)"
    by (unfold semilat_def esl_def sl_def) simp
qed
(*>*)

lemma top_le_opt_Some [iff]: "top (le r) (Some T) = top r T"
(*<*)
apply (unfold top_def)
apply (rule iffI)
 apply blast
apply (rule allI)
apply (case_tac "x")
apply simp+
done
(*>*)

lemma Top_le_conv:  "\<lbrakk> order r A; top r T; x \<in> A; T \<in> A \<rbrakk> \<Longrightarrow> (T \<sqsubseteq>\<^sub>r x) = (x = T)"
(*<*)
apply (unfold top_def)
apply (blast intro: order_antisym)
done
(*>*)

lemma acc_le_optI [intro!]: "acc r \<Longrightarrow> acc(le r)"
(*<*)
apply (unfold acc_def lesub_def le_def lesssub_def)
apply (simp add: wf_eq_minimal split: option.split)
apply clarify
apply (case_tac "\<exists>a. Some a \<in> Q")
 apply (erule_tac x = "{a . Some a \<in> Q}" in allE)
 apply blast
apply (case_tac "x")
 apply blast
apply blast
done
(*>*)

lemma map_option_in_optionI:
  "\<lbrakk> ox \<in> opt S; \<forall>x\<in>S. ox = Some x \<longrightarrow> f x \<in> S \<rbrakk>
  \<Longrightarrow> map_option f ox \<in> opt S"
(*<*)
apply (unfold map_option_case)
apply (simp split: option.split)
apply blast
done
(*>*)

end


theory PRon
  imports "HOL-TLA.TLA"
begin

lemma temp_imp_trans [trans]:
  assumes "\<turnstile> F \<longrightarrow> G"
  assumes "\<turnstile> G \<longrightarrow> H"
  shows "\<turnstile> F \<longrightarrow> H"
  using assms unfolding Valid_def by auto

lemma temp_impI:
  assumes "sigma \<Turnstile> P \<Longrightarrow> sigma \<Turnstile> Q"
  shows "sigma \<Turnstile> P \<longrightarrow> Q"
  using assms by auto

locale PRon =
  fixes x :: "nat stfun"
  assumes basevars_x: "basevars x"
  fixes nxt spec
  defines "nxt \<equiv> ACT (#0 < $x \<and> x$ = $x - #1)"
  defines "spec \<equiv> TEMP \<box>[nxt]_x \<and> WF(nxt)_x"

context PRon
begin

lemma "\<turnstile> spec \<longrightarrow> \<box>[x$ < $x]_x"
proof -
  have "\<turnstile> spec \<longrightarrow> \<box>[nxt]_x" by (auto simp add: spec_def)
  also have "\<turnstile> \<box>[nxt]_x \<longrightarrow> \<box>[x$ < $x]_x" by (intro STL4, auto simp add: square_def nxt_def)
  finally show ?thesis .
qed

lemma "\<turnstile> spec \<longrightarrow> \<box>(Init (#0 < x) \<longrightarrow> \<diamond><x$ < $x>_x)"
  unfolding spec_def
  apply (fold leadsto_def)
proof (intro WF_leadsto)
  show "\<turnstile> [nxt]_x \<and> $(#0 < x) \<longrightarrow> $Enabled (<nxt>_x)"
    using basevars [OF basevars_x]
    apply (auto simp add: nxt_def square_def enabled_def angle_def)
    apply auto
    by fastforce

  show "\<turnstile> [nxt]_x \<and> <nxt>_x \<longrightarrow> <x$ < $x>_x"
    by (auto simp add: nxt_def square_def angle_def)

  have "\<turnstile> ([nxt]_x \<and> [\<not> nxt]_x) \<longrightarrow> unchanged x"
    by (auto simp add: square_def)
  from STL4 [OF this]
  show "\<turnstile> \<box>([nxt]_x \<and> [\<not> nxt]_x) \<longrightarrow> stable (#0 < x)"
    by (intro tempI temp_impI Stable [where A = "ACT unchanged x"], auto)
qed


theory ex_LFIs
  imports topo_negation_conditions
begin
nitpick_params[assms=true, user_axioms=true, show_all, expect=genuine, format=3] (*default Nitpick settings*)

section \<open>Example application: Logics of Formal Inconsistency (LFIs)\<close>
text\<open>\noindent{The LFIs @{cite LFI} @{cite RLFI} are a family of paraconsistent logics featuring a 'consistency'
operator @{text "\<^bold>\<circ>"} that can be used to recover some classical properties of negation (in particular ECQ).
We show how to semantically embed LFIs as extensions of Boolean algebras (here as frontier algebras).}\<close>

text\<open>\noindent{Logical validity can be defined as truth in all worlds/points (i.e. as denoting the top element)}\<close>
abbreviation gtrue::"\<sigma>\<Rightarrow>bool" ("[\<^bold>\<turnstile> _]") where  "[\<^bold>\<turnstile>  A] \<equiv> \<forall>w. A w"
lemma gtrue_def: "[\<^bold>\<turnstile> A] \<equiv> A \<^bold>\<approx> \<^bold>\<top>"  by (simp add: top_def)

text\<open>\noindent{When defining a logic over an existing algebra we have two choices: a global (truth preserving)
and a local (truth-degree preserving) notion of logical consequence. For LFIs we prefer the latter.}\<close>
abbreviation conseq_global1::"\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" ("[_ \<^bold>\<turnstile>\<^sub>g _]") where "[A \<^bold>\<turnstile>\<^sub>g B] \<equiv> [\<^bold>\<turnstile> A] \<longrightarrow> [\<^bold>\<turnstile> B]"
abbreviation conseq_global2::"\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" ("[_,_ \<^bold>\<turnstile>\<^sub>g _]") where "[A\<^sub>1, A\<^sub>2 \<^bold>\<turnstile>\<^sub>g B] \<equiv> [\<^bold>\<turnstile> A\<^sub>1] \<and> [\<^bold>\<turnstile> A\<^sub>2] \<longrightarrow> [\<^bold>\<turnstile> B]"
abbreviation conseq_global3::"\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" ("[_,_,_ \<^bold>\<turnstile>\<^sub>g _]") where "[A\<^sub>1, A\<^sub>2, A\<^sub>3 \<^bold>\<turnstile>\<^sub>g B] \<equiv> [\<^bold>\<turnstile> A\<^sub>1] \<and> [\<^bold>\<turnstile> A\<^sub>2] \<and> [\<^bold>\<turnstile> A\<^sub>3] \<longrightarrow> [\<^bold>\<turnstile> B]"
abbreviation conseq_local1::"\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" ("[_ \<^bold>\<turnstile> _]") where "[A \<^bold>\<turnstile> B] \<equiv> A \<^bold>\<preceq> B"
abbreviation conseq_local2::"\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" ("[_,_ \<^bold>\<turnstile> _]") where "[A\<^sub>1, A\<^sub>2 \<^bold>\<turnstile> B] \<equiv> A\<^sub>1 \<^bold>\<and> A\<^sub>2 \<^bold>\<preceq> B"
abbreviation conseq_local3::"\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" ("[_,_,_ \<^bold>\<turnstile> _]") where "[A\<^sub>1, A\<^sub>2, A\<^sub>3 \<^bold>\<turnstile> B] \<equiv> A\<^sub>1 \<^bold>\<and> A\<^sub>2 \<^bold>\<and> A\<^sub>3 \<^bold>\<preceq> B"
(*add more as the need arises...*)

text\<open>\noindent{For LFIs we use the (paraconsistent) closure-based negation previously defined (taking frontier as primitive). }\<close>
abbreviation cneg::"\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<not>") where "\<^bold>\<not>A \<equiv> \<^bold>\<not>\<^sup>CA"

text\<open>\noindent{In terms of the frontier operator the negation looks as follows:}\<close>
lemma "\<^bold>\<not>A \<^bold>\<approx> \<^bold>\<midarrow>A \<^bold>\<or> \<F>(\<^bold>\<midarrow>A)" by (simp add: neg_C_def pC2)
lemma cneg_prop: "Fr_2 \<F> \<Longrightarrow> \<^bold>\<not>A \<^bold>\<approx> \<^bold>\<midarrow>A \<^bold>\<or> \<F>(A)" using pC2 pF2 unfolding conn by blast

text\<open>\noindent{This negation is of course boldly paraconsistent.}\<close>
lemma "[a, \<^bold>\<not>a \<^bold>\<turnstile> b]" nitpick oops (*countermodel*)
lemma "[a, \<^bold>\<not>a \<^bold>\<turnstile> \<^bold>\<not>b]" nitpick oops (*countermodel*)
lemma "[a, \<^bold>\<not>a \<^bold>\<turnstile>\<^sub>g b]" nitpick oops (*countermodel*)
lemma "[a, \<^bold>\<not>a \<^bold>\<turnstile>\<^sub>g \<^bold>\<not>b]" nitpick oops (*countermodel*)

text\<open>\noindent{We define two pairs of in/consistency operators and show how they relate to each other.
Using LFIs terminology, the minimal logic so encoded corresponds to 'RmbC-ciw' (cf. @{cite RLFI}).}\<close>
abbreviation op_inc_a::"\<sigma>\<Rightarrow>\<sigma>" ("\<bullet>\<^sup>A_" [57]58) where "\<bullet>\<^sup>AA \<equiv> A \<^bold>\<and> \<^bold>\<not>A"
abbreviation op_con_a::"\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<circ>\<^sup>A_" [57]58) where "\<^bold>\<circ>\<^sup>AA \<equiv> \<^bold>\<midarrow>\<bullet>\<^sup>AA"
abbreviation op_inc_b::"\<sigma>\<Rightarrow>\<sigma>" ("\<bullet>\<^sup>B_" [57]58) where "\<bullet>\<^sup>BA \<equiv> \<B> A"
abbreviation op_con_b::"\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<circ>\<^sup>B_" [57]58) where "\<^bold>\<circ>\<^sup>BA \<equiv> \<B>\<^sup>c A"

text\<open>\noindent{Observe that assumming condition Fr-2 are we allowed to exchange A and B variants.}\<close>
lemma pincAB: "Fr_2 \<F> \<Longrightarrow> \<bullet>\<^sup>AA \<^bold>\<approx> \<bullet>\<^sup>BA" using Br_fr_def Cl_fr_def pF2 conn by auto
lemma pconAB: "Fr_2 \<F> \<Longrightarrow> \<^bold>\<circ>\<^sup>AA \<^bold>\<approx> \<^bold>\<circ>\<^sup>BA" using pincAB unfolding conn by simp

text\<open>\noindent{Variants A and B give us slightly different properties.}\<close>
lemma Prop1: "\<^bold>\<circ>\<^sup>BA \<^bold>\<approx> \<I>\<^sup>f\<^sup>p A" using fp1 unfolding conn equal_op_def by metis
lemma "\<^bold>\<circ>\<^sup>AA \<^bold>\<approx> A \<^bold>\<rightarrow> \<I> A" nitpick oops (*countermodel*)
lemma Prop2: "Cl A \<longleftrightarrow> \<^bold>\<circ>\<^sup>A\<^bold>\<midarrow>A \<^bold>\<approx> \<^bold>\<top>" using pC2 unfolding conn by auto
lemma "Cl A \<longrightarrow> \<^bold>\<circ>\<^sup>B\<^bold>\<midarrow>A \<^bold>\<approx> \<^bold>\<top>" nitpick oops (*countermodel*)
lemma Prop3: "Cl A \<longleftrightarrow> \<bullet>\<^sup>A\<^bold>\<midarrow>A \<^bold>\<approx> \<^bold>\<bottom>" using Cl_fr_def unfolding conn by auto
lemma "Cl A \<longrightarrow> \<bullet>\<^sup>B\<^bold>\<midarrow>A \<^bold>\<approx> \<^bold>\<bottom>" nitpick oops (*countermodel*)
lemma Prop4: "Op A \<longleftrightarrow> \<^bold>\<circ>\<^sup>BA \<^bold>\<approx> \<^bold>\<top>" using Op_Bzero unfolding conn by simp
lemma "Op A \<longrightarrow> \<^bold>\<circ>\<^sup>AA \<^bold>\<approx> \<^bold>\<top>" nitpick oops (*countermodel*)
lemma Prop5: "Op A \<longleftrightarrow> \<bullet>\<^sup>BA \<^bold>\<approx> \<^bold>\<bottom>" using Op_Bzero by simp
lemma "Op A \<longrightarrow> \<bullet>\<^sup>AA \<^bold>\<approx> \<^bold>\<bottom>" nitpick oops (*countermodel*)

text\<open>\noindent{Importantly, LFIs must satisfy the so-called 'principle of gentle explosion'. Only variant A works here:}\<close>
lemma "[\<^bold>\<circ>\<^sup>Aa, a, \<^bold>\<not>a \<^bold>\<turnstile> b]" using compl_def meet_def by auto
lemma "[\<^bold>\<circ>\<^sup>Aa, a, \<^bold>\<not>a \<^bold>\<turnstile>\<^sub>g b]" using compl_def meet_def by auto
lemma "[\<^bold>\<circ>\<^sup>Ba, a, \<^bold>\<not>a \<^bold>\<turnstile> b]" nitpick oops (*countermodel*)
lemma "[\<^bold>\<circ>\<^sup>Ba, a, \<^bold>\<not>a \<^bold>\<turnstile>\<^sub>g b]" nitpick oops (*countermodel*)

text\<open>\noindent{In what follows we employ the (minimal) A-variant and verify some properties.}\<close>
abbreviation op_inc :: "\<sigma>\<Rightarrow>\<sigma>" ("\<bullet>_" [57]58) where "\<bullet>A  \<equiv> \<bullet>\<^sup>AA"
abbreviation op_con :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<circ>_" [57]58) where "\<^bold>\<circ>A  \<equiv> \<^bold>\<midarrow>\<bullet>A"

lemma "TND(\<^bold>\<not>)" by (simp add: TND_C)
lemma "ECQm(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> LNC(\<^bold>\<not>)" by (simp add: LNC_C PF6)
lemma "\<FF> \<F> \<Longrightarrow> DNI(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma "\<FF> \<F> \<Longrightarrow> DNE(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> CoPw(\<^bold>\<not>)" by (simp add: CoPw_C PF6)
lemma "\<FF> \<F> \<Longrightarrow> CoP1(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma "\<FF> \<F> \<Longrightarrow> CoP2(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma "\<FF> \<F> \<Longrightarrow> CoP3(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma "Fr_1a \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> DM3(\<^bold>\<not>)" by (simp add: DM3_C)
lemma "\<FF> \<F> \<Longrightarrow> DM4(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma "nNor(\<^bold>\<not>)" by (simp add: nNor_C)
lemma "Fr_3 \<F> \<Longrightarrow> nDNor(\<^bold>\<not>)" by (simp add: nDNor_C)
lemma "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> MT0(\<^bold>\<not>)" by (simp add: MT0_C PF6)
lemma "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> MT1(\<^bold>\<not>)" by (simp add: MT1_C PF6)
lemma "\<FF> \<F> \<Longrightarrow> MT2(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> Fr_3 \<F> \<Longrightarrow> MT3(\<^bold>\<not>)" using MT3_C by auto

text\<open>\noindent{We show how all local contraposition variants (lCoP) can be recovered using the consistency operator.
Observe that we can recover in the same way other (weaker) properties: CoP, MT and DNI/DNE (local \& global).}\<close>
lemma "\<FF> \<F> \<Longrightarrow> lCoPw(\<^bold>\<rightarrow>)(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma cons_lcop1: "[\<^bold>\<circ>b, a \<^bold>\<rightarrow> b \<^bold>\<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> \<^bold>\<not>a]" using Cl_fr_def conn by auto
lemma "\<FF> \<F> \<Longrightarrow> lCoP1(\<^bold>\<rightarrow>)(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma cons_lcop2: "[\<^bold>\<circ>b, a \<^bold>\<rightarrow> \<^bold>\<not>b \<^bold>\<turnstile> b \<^bold>\<rightarrow> \<^bold>\<not>a]" using Cl_fr_def conn by auto
lemma "\<FF> \<F> \<Longrightarrow> lCoP2(\<^bold>\<rightarrow>)(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma cons_lcop3: "[\<^bold>\<circ>b, \<^bold>\<not>a \<^bold>\<rightarrow> b \<^bold>\<turnstile> \<^bold>\<not>b \<^bold>\<rightarrow> a]" using Cl_fr_def conn by auto
lemma "\<FF> \<F> \<Longrightarrow> lCoP3(\<^bold>\<rightarrow>)(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma cons_lcop4: "[\<^bold>\<circ>b, \<^bold>\<not>a \<^bold>\<rightarrow> \<^bold>\<not>b \<^bold>\<turnstile> b \<^bold>\<rightarrow> a]" using Cl_fr_def conn by auto
text\<open>\noindent{Disjunctive syllogism (DS).}\<close>
lemma "\<FF> \<F> \<Longrightarrow> DS1(\<^bold>\<rightarrow>)(\<^bold>\<not>)" nitpick oops (*countermodel*)
lemma cons_ds1: "[\<^bold>\<circ>a, a \<^bold>\<or> b \<^bold>\<turnstile> \<^bold>\<not>a \<^bold>\<rightarrow> b]" using conn by auto
lemma "DS2(\<^bold>\<rightarrow>)(\<^bold>\<not>)" by (metis Cl_fr_def DS2_def compl_def impl_def join_def neg_C_def)
text\<open>\noindent{Further properties.}\<close>
lemma "[a \<^bold>\<and> \<^bold>\<not>a \<^bold>\<turnstile> \<^bold>\<not>(\<^bold>\<circ>a)]" by (simp add: pC2 conn)
lemma "\<FF> \<F> \<Longrightarrow> [\<^bold>\<not>(\<^bold>\<circ>a) \<^bold>\<turnstile> a \<^bold>\<and> \<^bold>\<not>a]" nitpick oops (* countermodel found *)
lemma "[\<^bold>\<circ>a \<^bold>\<turnstile> \<^bold>\<not>(a \<^bold>\<and> \<^bold>\<not>a)]" by (simp add: pC2 conn)
lemma "\<FF> \<F> \<Longrightarrow> [\<^bold>\<not>(a \<^bold>\<and> \<^bold>\<not>a) \<^bold>\<turnstile> \<^bold>\<circ>a]" nitpick oops (* countermodel found *)

text\<open>\noindent{The following axioms are commonly employed in the literature on LFIs to obtain stronger logics.
We explore under which conditions they can be assumed while keeping the logic boldly paraconsistent.}\<close>
abbreviation cf where "cf \<equiv> DNE(\<^bold>\<not>)"
abbreviation ce where "ce \<equiv> DNI(\<^bold>\<not>)"
abbreviation ciw where "ciw \<equiv> \<forall>P. [\<^bold>\<turnstile> \<^bold>\<circ>P \<^bold>\<or> \<bullet>P]"
abbreviation ci  where  "ci \<equiv> \<forall>P.  [\<^bold>\<not>(\<^bold>\<circ>P) \<^bold>\<turnstile> \<bullet>P]"
abbreviation cl  where  "cl \<equiv> \<forall>P.  [\<^bold>\<not>(\<bullet>P) \<^bold>\<turnstile> \<^bold>\<circ>P]"
abbreviation ca_conj where "ca_conj \<equiv> \<forall>P Q. [\<^bold>\<circ>P,\<^bold>\<circ>Q \<^bold>\<turnstile> \<^bold>\<circ>(P \<^bold>\<and> Q)]"
abbreviation ca_disj where "ca_disj \<equiv> \<forall>P Q. [\<^bold>\<circ>P,\<^bold>\<circ>Q \<^bold>\<turnstile> \<^bold>\<circ>(P \<^bold>\<or> Q)]"
abbreviation ca_impl where "ca_impl \<equiv> \<forall>P Q. [\<^bold>\<circ>P,\<^bold>\<circ>Q \<^bold>\<turnstile> \<^bold>\<circ>(P \<^bold>\<rightarrow> Q)]"
abbreviation ca where "ca \<equiv> ca_conj \<and> ca_disj \<and> ca_impl"

text\<open>\noindent{cf}\<close>
lemma "\<FF> \<F> \<Longrightarrow> cf" nitpick oops
lemma "\<FF> \<F> \<and> cf \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
text\<open>\noindent{ce}\<close>
lemma "\<FF> \<F> \<Longrightarrow> ce" nitpick oops
lemma "Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> ce \<and> \<sim>ECQ(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
lemma "Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> ce \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
lemma "Fr_1a \<F> \<and> Fr_2 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> ce \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
lemma "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> ce \<longrightarrow> ECQm(\<^bold>\<not>)" unfolding Defs  using CoP1_XCoP CoP1_def2 CoPw_C DNI_def ECQw_def PF6 XCoP_def2 by auto
text\<open>\noindent{ciw}\<close>
lemma ciw by (simp add:conn)
text\<open>\noindent{ci}\<close>
lemma "\<FF> \<F> \<Longrightarrow> ci" nitpick oops
lemma "\<FF> \<F> \<and> ci \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
text\<open>\noindent{cl}\<close>
lemma "\<FF> \<F> \<Longrightarrow> cl" nitpick oops
lemma "Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> cl \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
lemma "Fr_1a \<F> \<and> Fr_2 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> cl \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
lemma "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> cl \<longrightarrow> ECQ(\<^bold>\<not>)" unfolding Defs  by (metis BC_rel Br_Border Br_cl_def bottom_def compl_def eq_ext' meet_def neg_C_def)
text\<open>\noindent{ca-conj/disj}\<close>
lemma "Fr_1a \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> ca_conj" using DM3_C DM3_def conn by auto
lemma "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> ca_disj" using ADDI_b_def MONO_ADDIb monI pB1 pincAB unfolding conn by metis
lemma "\<FF> \<F> \<Longrightarrow> ca_impl" nitpick oops
text\<open>\noindent{ca-impl}\<close>
lemma "ca_impl \<and> \<sim>ECQ(\<^bold>\<not>)" (*nitpick[satisfy]*) oops (*cannot find finite model*)
lemma "ca_impl \<longrightarrow> ECQm(\<^bold>\<not>)" oops (*nor proof yet*)
text\<open>\noindent{cf \& ci}\<close>
lemma "Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> cf \<and> ci \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
lemma "Fr_2 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> cf \<and> ci \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
lemma "Fr_1b \<F> \<and> Fr_2 \<F> \<and> cf \<and> ci \<and> \<sim>ECQ(\<^bold>\<not>)" (*nitpick[satisfy]*) oops (*cannot find finite model*)
lemma "\<FF> \<F> \<and> cf \<and> ci \<longrightarrow> ECQm(\<^bold>\<not>)" oops (*nor proof yet*)
text\<open>\noindent{cf \& cl}\<close>
lemma "Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> cf \<and> cl \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
lemma "Fr_2 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> cf \<and> cl \<and> \<sim>ECQm(\<^bold>\<not>)" nitpick[satisfy] oops (*model found*)
lemma "Fr_1b \<F> \<and> Fr_2 \<F> \<and> cf \<and> cl \<longrightarrow> ECQ(\<^bold>\<not>)" unfolding Defs by (smt Br_fr_def Fr_1b_def Prop2 Prop3 pF3 cneg_prop conn)

end