(*  Title:       Operations on Iterators over Finite Sets
    Author:      Thomas Tuerk <tuerk@in.tum.de>
    Maintainer:  Thomas Tuerk <tuerk@in.tum.de>
*)
section \<open>Operations on Set Iterators\<close>
theory SetIteratorOperations
imports Main SetIterator
begin

text\<open>Many operations on sets can be lifted to iterators over sets. This theory tries to introduce
the most useful such operations.\<close>

subsection \<open>Empty set\<close>

text \<open>Iterators over empty sets and singleton sets are very easy to define.\<close>
definition set_iterator_emp :: "('a,'\<sigma>) set_iterator" where
  "set_iterator_emp c f \<sigma>0 = \<sigma>0"

lemma set_iterator_emp_foldli_conv :
  "set_iterator_emp = foldli []"
by (simp add: fun_eq_iff set_iterator_emp_def)

lemma set_iterator_genord_emp_correct :
  "set_iterator_genord set_iterator_emp {} R"
apply (rule set_iterator_genord.intro)
apply (rule exI[where x="[]"])
apply (simp add: set_iterator_emp_foldli_conv)
done

lemma set_iterator_emp_correct :
  "set_iterator set_iterator_emp {}"
using set_iterator_intro [OF set_iterator_genord_emp_correct] .

lemma (in linorder) set_iterator_linord_emp_correct :
  "set_iterator_linord set_iterator_emp {}"
unfolding set_iterator_linord_def
by (fact set_iterator_genord_emp_correct)

lemma (in linorder) set_iterator_rev_linord_emp_correct :
  "set_iterator_rev_linord set_iterator_emp {}"
unfolding set_iterator_rev_linord_def
by (fact set_iterator_genord_emp_correct)

lemma (in linorder) map_iterator_linord_emp_correct :
  "map_iterator_linord set_iterator_emp Map.empty"
  "set_iterator_map_linord set_iterator_emp {}"
unfolding set_iterator_map_linord_def
by (simp_all add: set_iterator_genord_emp_correct map_to_set_def)

lemma (in linorder) map_iterator_rev_linord_emp_correct :
  "map_iterator_rev_linord set_iterator_emp Map.empty"
  "set_iterator_map_rev_linord set_iterator_emp {}"
unfolding set_iterator_map_rev_linord_def
by (simp_all add: set_iterator_genord_emp_correct map_to_set_def)

subsection\<open>Singleton Sets\<close>

definition set_iterator_sng :: "'a \<Rightarrow> ('a,'\<sigma>) set_iterator" where
  "set_iterator_sng x c f \<sigma>0 = (if c \<sigma>0 then f x \<sigma>0 else \<sigma>0)"

lemma set_iterator_sng_foldli_conv :
  "set_iterator_sng x = foldli [x]"
by (simp add: fun_eq_iff set_iterator_sng_def)

lemma set_iterator_genord_sng_correct :
  "set_iterator_genord (set_iterator_sng (x::'a)) {x} R"
apply (rule set_iterator_genord.intro)
apply (rule exI[where x="[x]"])
apply (simp add: set_iterator_sng_foldli_conv)
done

lemma set_iterator_sng_correct :
  "set_iterator (set_iterator_sng x) {x}"
unfolding set_iterator_def
by (rule set_iterator_genord_sng_correct)

lemma (in linorder) set_iterator_linord_sng_correct :
  "set_iterator_linord (set_iterator_sng x) {x}"
unfolding set_iterator_linord_def
by (simp add: set_iterator_genord_sng_correct)

lemma (in linorder) set_iterator_rev_linord_sng_correct :
  "set_iterator_rev_linord (set_iterator_sng x) {x}"
unfolding set_iterator_rev_linord_def
by (simp add: set_iterator_genord_sng_correct)

lemma (in linorder) map_iterator_linord_sng_correct :
  "map_iterator_linord (set_iterator_sng (k,v)) (Map.empty (k \<mapsto> v))"
unfolding set_iterator_map_linord_def
by (simp add: set_iterator_genord_sng_correct)

lemma (in linorder) map_iterator_rev_linord_sng_correct :
  "map_iterator_rev_linord (set_iterator_sng (k,v)) (Map.empty (k \<mapsto> v))"
unfolding set_iterator_map_rev_linord_def
by (simp add: set_iterator_genord_sng_correct)

subsection \<open>Union\<close>

text \<open>Iterators over disjoint sets can be combined by first iterating over one and then the
other set. The result is an iterator over the union of the original sets.\<close>

definition set_iterator_union ::
    "('a,'\<sigma>) set_iterator \<Rightarrow> ('a, '\<sigma>) set_iterator \<Rightarrow> ('a,'\<sigma>) set_iterator" where
  "set_iterator_union it_a it_b \<equiv> \<lambda>c f \<sigma>0. (it_b c f (it_a c f \<sigma>0))"

lemma set_iterator_union_foldli_conv :
  "set_iterator_union (foldli as) (foldli bs) = foldli (as @ bs)"
by (simp add: fun_eq_iff set_iterator_union_def foldli_append)

lemma set_iterator_genord_union_correct :
  fixes it_a :: "('a,'\<sigma>) set_iterator"
  fixes it_b :: "('a,'\<sigma>) set_iterator"
  fixes R S_a S_b
  assumes it_a: "set_iterator_genord it_a S_a R"
  assumes it_b: "set_iterator_genord it_b S_b R"
  assumes dist_Sab: "S_a \<inter> S_b = {}"
  assumes R_OK: "\<And>a b. \<lbrakk>a \<in> S_a; b \<in> S_b\<rbrakk> \<Longrightarrow> R a b"
  shows "set_iterator_genord (set_iterator_union it_a it_b) (S_a \<union> S_b) R"
proof -
  from it_a obtain as where
    dist_as: "distinct as" and S_a_eq: "S_a = set as" and
    sorted_as: "sorted_wrt R as" and it_a_eq: "it_a = foldli as"
  unfolding set_iterator_genord_foldli_conv by blast

  from it_b obtain bs where
    dist_bs: "distinct bs" and S_b_eq: "S_b = set bs" and
    sorted_bs: "sorted_wrt R bs" and it_b_eq: "it_b = foldli bs"
  unfolding set_iterator_genord_foldli_conv by blast

  show ?thesis
  proof (rule set_iterator_genord_I [of "as @ bs"])
    from dist_Sab S_a_eq S_b_eq dist_as dist_bs
    show "distinct (as @ bs)" by simp
  next
    from S_a_eq S_b_eq
    show "S_a \<union> S_b = set (as @ bs)" by simp
  next
    from sorted_as sorted_bs R_OK S_a_eq S_b_eq
    show "sorted_wrt R (as @ bs)"
      by (simp add: sorted_wrt_append Ball_def)
  next
    show "set_iterator_union it_a it_b = (foldli (as @ bs))"
      unfolding it_a_eq it_b_eq set_iterator_union_foldli_conv by simp
  qed
qed

lemma set_iterator_union_emp [simp] :
  "set_iterator_union (set_iterator_emp) it = it"
  "set_iterator_union it (set_iterator_emp) = it"
unfolding set_iterator_emp_def set_iterator_union_def
by simp_all

lemma set_iterator_union_correct :
  assumes it_a: "set_iterator it_a S_a"
  assumes it_b: "set_iterator it_b S_b"
  assumes dist_Sab: "S_a \<inter> S_b = {}"
  shows "set_iterator (set_iterator_union it_a it_b) (S_a \<union> S_b)"
proof -
  note res' = set_iterator_genord_union_correct [OF it_a[unfolded set_iterator_def]
                                                    it_b[unfolded set_iterator_def] dist_Sab]
  from set_iterator_intro [OF res']
  show ?thesis by simp
qed

lemma (in linorder) set_iterator_linord_union_correct :
  assumes it_a: "set_iterator_linord it_a S_a"
  assumes it_b: "set_iterator_linord it_b S_b"
  assumes ord_Sab: "\<And>a b. \<lbrakk>a \<in> S_a; b \<in> S_b\<rbrakk> \<Longrightarrow> a < b"
  shows "set_iterator_linord (set_iterator_union it_a it_b) (S_a \<union> S_b)"
unfolding set_iterator_linord_def
apply (rule_tac set_iterator_genord_union_correct[
   OF it_a[unfolded set_iterator_linord_def] it_b[unfolded set_iterator_linord_def]])
apply (insert ord_Sab)
apply auto
apply (metis less_le_not_le ord_Sab)
done

lemma (in linorder) set_iterator_rev_linord_union_correct :
  assumes it_a: "set_iterator_rev_linord it_a S_a"
  assumes it_b: "set_iterator_rev_linord it_b S_b"
  assumes ord_Sab: "\<And>a b. \<lbrakk>a \<in> S_a; b \<in> S_b\<rbrakk> \<Longrightarrow> a > b"
  shows "set_iterator_rev_linord (set_iterator_union it_a it_b) (S_a \<union> S_b)"
unfolding set_iterator_rev_linord_def
apply (rule_tac set_iterator_genord_union_correct[
   OF it_a[unfolded set_iterator_rev_linord_def] it_b[unfolded set_iterator_rev_linord_def]])
apply (insert ord_Sab)
apply auto
apply (metis less_le_not_le ord_Sab)
done

lemma (in linorder) map_iterator_linord_union_correct :
  assumes it_a: "set_iterator_map_linord it_a S_a"
  assumes it_b: "set_iterator_map_linord it_b S_b"
  assumes ord_Sab: "\<And>kv kv'. \<lbrakk>kv \<in> S_a; kv' \<in> S_b\<rbrakk> \<Longrightarrow> fst kv < fst kv'"
  shows "set_iterator_map_linord (set_iterator_union it_a it_b) (S_a \<union> S_b)"
  unfolding set_iterator_map_linord_def
  apply (rule set_iterator_genord_union_correct [OF
    it_a[unfolded set_iterator_map_linord_def]
    it_b[unfolded set_iterator_map_linord_def]])
  apply (insert ord_Sab)
  apply auto
  apply (metis less_le_not_le)
done

lemma (in linorder) map_iterator_rev_linord_union_correct :
  assumes it_a: "set_iterator_map_rev_linord it_a S_a"
  assumes it_b: "set_iterator_map_rev_linord it_b S_b"
  assumes ord_Sab: "\<And>kv kv'. \<lbrakk>kv \<in> S_a; kv' \<in> S_b\<rbrakk> \<Longrightarrow> fst kv > fst kv'"
  shows "set_iterator_map_rev_linord (set_iterator_union it_a it_b) (S_a \<union> S_b)"
  unfolding set_iterator_map_rev_linord_def
  apply (rule set_iterator_genord_union_correct [OF
    it_a[unfolded set_iterator_map_rev_linord_def]
    it_b[unfolded set_iterator_map_rev_linord_def]])
  apply (insert ord_Sab)
  apply auto
  apply (metis less_le_not_le)
done

subsection \<open>Product\<close>

definition set_iterator_product ::
    "('a,'\<sigma>) set_iterator \<Rightarrow> ('a \<Rightarrow> ('b,'\<sigma>) set_iterator) \<Rightarrow> ('a \<times> 'b ,'\<sigma>) set_iterator" where
  "set_iterator_product it_a it_b \<equiv> \<lambda>c f \<sigma>0.
    it_a c (
      \<lambda>a \<sigma>. it_b a c (\<lambda>b \<sigma>. f (a,b) \<sigma>) \<sigma>
    ) \<sigma>0"

lemma set_iterator_product_foldli_conv:
  "set_iterator_product (foldli as) (\<lambda>a. foldli (bs a)) =
   foldli (concat (map (\<lambda>a. map (\<lambda>b. (a, b)) (bs a)) as))"
apply (induct as)
  apply (simp add: set_iterator_product_def)
apply (simp add: set_iterator_product_def foldli_append foldli_map o_def fun_eq_iff)
done

lemma set_iterator_product_it_b_cong:
assumes it_a_OK: "set_iterator it_a S_a"
    and it_b_b': "\<And>a. a \<in> S_a \<Longrightarrow> it_b a = it_b' a"
shows "set_iterator_product it_a it_b =
       set_iterator_product it_a it_b'"
proof -
  from it_a_OK obtain as where
    dist_as: "distinct as" and S_a_eq: "S_a = set as" and
    it_a_eq: "it_a = foldli as"
  unfolding set_iterator_foldli_conv by blast

  from it_b_b'[unfolded S_a_eq]
  show ?thesis unfolding it_a_eq
    by (induct as)
       (simp_all add: set_iterator_product_def it_b_b' fun_eq_iff)
qed

definition set_iterator_product_order ::
  "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow>
   ('a \<times> 'b) \<Rightarrow> ('a \<times> 'b) \<Rightarrow> bool" where
  "set_iterator_product_order R_a R_b ab ab' \<longleftrightarrow>
   (if (fst ab = fst ab') then R_b (fst ab) (snd ab) (snd ab') else
                               R_a (fst ab) (fst ab'))"

lemma set_iterator_genord_product_correct :
  fixes it_a :: "('a,'\<sigma>) set_iterator"
  fixes it_b :: "'a \<Rightarrow> ('b,'\<sigma>) set_iterator"
  assumes it_a: "set_iterator_genord it_a S_a R_a"
  assumes it_b: "\<And>a. a \<in> S_a \<Longrightarrow> set_iterator_genord (it_b a) (S_b a) (R_b a)"
  shows "set_iterator_genord (set_iterator_product it_a it_b) (Sigma S_a S_b)
             (set_iterator_product_order R_a R_b)"
proof -
  from it_a obtain as where
    dist_as: "distinct as" and S_a_eq: "S_a = set as" and
    sorted_as: "sorted_wrt R_a as" and it_a_eq: "it_a = foldli as"
  unfolding set_iterator_genord_foldli_conv by blast

  from it_b obtain bs where
    dist_bs: "\<And>a. a \<in> set as \<Longrightarrow> distinct (bs a)" and S_b_eq: "\<And>a. a \<in> set as \<Longrightarrow>  S_b a = set (bs a)" and
    sorted_bs: "\<And>a. a \<in> set as \<Longrightarrow> sorted_wrt (R_b a) (bs a)" and
    it_b_eq: "\<And>a. a \<in> set as \<Longrightarrow> it_b a = foldli (bs a)"
  unfolding set_iterator_genord_foldli_conv by (metis S_a_eq)

  let ?abs = "concat (map (\<lambda>a. map (\<lambda>b. (a, b)) (bs a)) as)"

  show ?thesis
  proof (rule set_iterator_genord_I[of ?abs])
    from set_iterator_product_it_b_cong[of it_a S_a it_b,
       OF set_iterator_intro[OF it_a] it_b_eq] it_a_eq S_a_eq
    have "set_iterator_product it_a it_b =
          set_iterator_product (foldli as) (\<lambda>a. foldli (bs a))" by simp
    thus "set_iterator_product it_a it_b = foldli ?abs"
      by (simp add: set_iterator_product_foldli_conv)
  next
    show "distinct ?abs"
    using dist_as dist_bs[unfolded S_a_eq]
    by (induct as)
       (simp_all add: distinct_map inj_on_def dist_bs set_eq_iff image_iff)
  next
    show "Sigma S_a S_b = set ?abs"
      unfolding S_a_eq using S_b_eq
      by (induct as) auto
  next
    from sorted_as sorted_bs dist_as
    show "sorted_wrt
           (set_iterator_product_order R_a R_b)
           (concat (map (\<lambda>a. map (Pair a) (bs a)) as))"
    proof (induct as rule: list.induct)
      case Nil thus ?case by simp
    next
      case (Cons a as)
      from Cons(2) have R_a_as: "\<And>a'. a' \<in> set as \<Longrightarrow> R_a a a'" and
                        sorted_as: "sorted_wrt R_a as" by simp_all
      from Cons(3) have sorted_bs_a: "sorted_wrt (R_b a) (bs a)"
                    and sorted_bs_as: "\<And>a. a \<in> set as \<Longrightarrow> sorted_wrt (R_b a) (bs a)" by simp_all
      from Cons(4) have dist_as: "distinct as" and a_nin_as: "a \<notin> set as" by simp_all
      note ind_hyp = Cons(1)[OF sorted_as sorted_bs_as dist_as]

      define bs_a where "bs_a = bs a"
      from sorted_bs_a
      have sorted_prod_a : "sorted_wrt (set_iterator_product_order R_a R_b) (map (Pair a) (bs a))"
        unfolding bs_a_def[symmetric]
        apply (induct bs_a rule: list.induct)
        apply (simp_all add: set_iterator_product_order_def Ball_def image_iff)
      done

      show ?case
        apply (simp add: sorted_wrt_append ind_hyp sorted_prod_a)
        apply (simp add: set_iterator_product_order_def R_a_as a_nin_as)
      done
    qed
  qed
qed

lemma set_iterator_product_correct :
  assumes it_a: "set_iterator it_a S_a"
  assumes it_b: "\<And>a. a \<in> S_a \<Longrightarrow> set_iterator (it_b a) (S_b a)"
  shows "set_iterator (set_iterator_product it_a it_b) (Sigma S_a S_b)"
proof -
  note res' = set_iterator_genord_product_correct [OF it_a[unfolded set_iterator_def],
     of it_b S_b "\<lambda>_ _ _. True", OF it_b[unfolded set_iterator_def]]
  note res = set_iterator_intro [OF res']
  thus ?thesis by simp
qed

subsection \<open>Filter and Image\<close>

text \<open>Filtering and applying an injective function on iterators is easily defineable as well.
  In contrast to sets the function really has to be injective, because an iterator guarentees to
  visit each element only once.\<close>

definition set_iterator_image_filter ::
    "('a \<Rightarrow> 'b option) \<Rightarrow> ('a,'\<sigma>) set_iterator \<Rightarrow> ('b,'\<sigma>) set_iterator" where
  "set_iterator_image_filter g it \<equiv> \<lambda>c f \<sigma>0. (it c
     (\<lambda>x \<sigma>. (case (g x) of Some x' \<Rightarrow> f x' \<sigma> | None \<Rightarrow> \<sigma>)) \<sigma>0)"

lemma set_iterator_image_filter_foldli_conv :
  "set_iterator_image_filter g (foldli xs) =
   foldli (List.map_filter g xs)"
by (induct xs) (auto simp add: List.map_filter_def set_iterator_image_filter_def fun_eq_iff)

lemma set_iterator_genord_image_filter_correct :
  fixes it :: "('a,'\<sigma>) set_iterator"
  fixes g :: "'a \<Rightarrow> 'b option"
  assumes it_OK: "set_iterator_genord it S R"
  assumes g_inj_on: "inj_on g (S \<inter> dom g)"
  assumes R'_prop: "\<And>x y x' y'. \<lbrakk>x \<in> S; g x = Some x'; y \<in> S; g y = Some y'; R x y\<rbrakk> \<Longrightarrow> R' x' y'"
  shows "set_iterator_genord (set_iterator_image_filter g it) {y. \<exists>x. x \<in> S \<and> g x = Some y} R'"
proof -
  from it_OK obtain xs where
    dist_xs: "distinct xs" and S_eq: "S = set xs" and
    sorted_xs: "sorted_wrt R xs" and it_eq: "it = foldli xs"
  unfolding set_iterator_genord_foldli_conv by blast

  show ?thesis
  proof (rule set_iterator_genord_I [of "List.map_filter g xs"])
    show "set_iterator_image_filter g it =
          foldli (List.map_filter g xs)"
      unfolding it_eq  set_iterator_image_filter_foldli_conv by simp
  next
    from dist_xs g_inj_on[unfolded S_eq]
    show "distinct (List.map_filter g xs)"
      apply (induct xs)
      apply (simp add: List.map_filter_simps)
      apply (simp add: List.map_filter_def image_iff inj_on_def Ball_def dom_def)
      apply (metis not_Some_eq option.sel)
    done
  next
    show "{y. \<exists>x. x \<in> S \<and> g x = Some y} =
          set (List.map_filter g xs)"
      unfolding S_eq set_map_filter by simp
  next
    from sorted_xs R'_prop[unfolded S_eq]
    show "sorted_wrt R' (List.map_filter g xs)"
    proof (induct xs rule: list.induct)
      case Nil thus ?case by (simp add: List.map_filter_simps)
    next
      case (Cons x xs)
      note sort_x_xs = Cons(2)
      note R'_x_xs = Cons(3)

      from Cons have ind_hyp: "sorted_wrt R' (List.map_filter g xs)" by auto

      show ?case
        apply (cases "g x")
        apply (simp add: List.map_filter_simps ind_hyp)
        apply (simp add: List.map_filter_simps set_map_filter Ball_def ind_hyp)
        apply (insert R'_x_xs[of x] sort_x_xs)
        apply (simp add: Ball_def)
        apply metis
      done
    qed
  qed
qed

lemma set_iterator_image_filter_correct :
  fixes it :: "('a,'\<sigma>) set_iterator"
  fixes g :: "'a \<Rightarrow> 'b option"
  assumes it_OK: "set_iterator it S"
  assumes g_inj_on: "inj_on g (S \<inter> dom g)"
  shows "set_iterator (set_iterator_image_filter g it) {y. \<exists>x. x \<in> S \<and> g x = Some y}"
proof -
  note res' = set_iterator_genord_image_filter_correct [OF it_OK[unfolded set_iterator_def],
     of g "\<lambda>_ _. True"]
  note res = set_iterator_intro [OF res']
  with g_inj_on show ?thesis by simp
qed

text \<open>Special definitions for only filtering or only appling a function are handy.\<close>
definition set_iterator_filter ::
    "('a \<Rightarrow> bool) \<Rightarrow> ('a,'\<sigma>) set_iterator \<Rightarrow> ('a,'\<sigma>) set_iterator" where
  "set_iterator_filter P \<equiv> set_iterator_image_filter (\<lambda>x. if P x then Some x else None)"

lemma set_iterator_filter_foldli_conv :
  "set_iterator_filter P (foldli xs) = foldli (filter P xs)"
  apply (simp add: set_iterator_filter_def set_iterator_image_filter_foldli_conv)
  apply (rule cong) apply simp
  apply (induct xs)
  apply (simp_all add: List.map_filter_def)
done

lemma set_iterator_filter_alt_def [code] :
  "set_iterator_filter P it = (\<lambda>c f. it c (\<lambda>(x::'a) (\<sigma>::'b). if P x then f x \<sigma> else \<sigma>))"
proof -
  have "\<And>f. (\<lambda>(x::'a) (\<sigma>::'b).
             case if P x then Some x else None of None \<Rightarrow> \<sigma>
             | Some x' \<Rightarrow> f x' \<sigma>) =
            (\<lambda>x \<sigma>. if P x then f x \<sigma> else \<sigma>)"
     by auto
  thus ?thesis
    unfolding set_iterator_filter_def
              set_iterator_image_filter_def[abs_def]
    by simp
qed

lemma set_iterator_genord_filter_correct :
  fixes it :: "('a,'\<sigma>) set_iterator"
  assumes it_OK: "set_iterator_genord it S R"
  shows "set_iterator_genord (set_iterator_filter P it) {x. x \<in> S \<and> P x} R"
proof -
  let ?g = "\<lambda>x. if P x then Some x else None"
  have in_dom_g: "\<And>x. x \<in> dom ?g \<longleftrightarrow> P x" unfolding dom_def by auto

  from set_iterator_genord_image_filter_correct [OF it_OK, of ?g R, folded set_iterator_filter_def]
  show ?thesis
    by (simp add: if_split_eq1 inj_on_def Ball_def in_dom_g)
qed

lemma set_iterator_filter_correct :
  assumes it_OK: "set_iterator it S"
  shows "set_iterator (set_iterator_filter P it) {x. x \<in> S \<and> P x}"
proof -
  note res' = set_iterator_genord_filter_correct [OF it_OK[unfolded set_iterator_def],
    of P]
  note res = set_iterator_intro [OF res']
  thus ?thesis by simp
qed

lemma (in linorder) set_iterator_linord_filter_correct :
  assumes it_OK: "set_iterator_linord it S"
  shows "set_iterator_linord (set_iterator_filter P it) {x. x \<in> S \<and> P x}"
using assms
unfolding set_iterator_linord_def
by (rule set_iterator_genord_filter_correct)

lemma (in linorder) set_iterator_rev_linord_filter_correct :
  assumes it_OK: "set_iterator_rev_linord it S"
  shows "set_iterator_rev_linord (set_iterator_filter P it) {x. x \<in> S \<and> P x}"
using assms
unfolding set_iterator_rev_linord_def
by (rule set_iterator_genord_filter_correct)

definition set_iterator_image ::
    "('a \<Rightarrow> 'b) \<Rightarrow> ('a,'\<sigma>) set_iterator \<Rightarrow> ('b,'\<sigma>) set_iterator" where
  "set_iterator_image g \<equiv> set_iterator_image_filter (\<lambda>x. Some (g x))"

lemma set_iterator_image_foldli_conv :
  "set_iterator_image g (foldli xs) = foldli (map g xs)"
  apply (simp add: set_iterator_image_def set_iterator_image_filter_foldli_conv)
  apply (rule cong) apply simp
  apply (induct xs)
  apply (simp_all add: List.map_filter_def)
done

lemma set_iterator_image_alt_def [code] :
  "set_iterator_image g it = (\<lambda>c f. it c (\<lambda>x. f (g x)))"
unfolding set_iterator_image_def
          set_iterator_image_filter_def[abs_def]
by simp

lemma set_iterator_genord_image_correct :
  fixes it :: "('a,'\<sigma>) set_iterator"
  assumes it_OK: "set_iterator_genord it S R"
  assumes g_inj: "inj_on g S"
  assumes R'_prop: "\<And>x y. \<lbrakk>x \<in> S; y \<in> S; R x y\<rbrakk> \<Longrightarrow> R' (g x) (g y)"
  shows "set_iterator_genord (set_iterator_image g it) (g ` S) R'"
proof -
  let ?g = "\<lambda>x. Some (g x)"
  have set_eq: "\<And>S. {y . \<exists>x. x \<in> S \<and> ?g x = Some y} = g ` S" by auto

  show ?thesis
    apply (rule set_iterator_genord_image_filter_correct [OF it_OK, of ?g R',
     folded set_iterator_image_def set_eq[symmetric]])
    apply (insert g_inj, simp add: inj_on_def) []
    apply (insert R'_prop, auto)
  done
qed

lemma set_iterator_image_correct :
  assumes it_OK: "set_iterator it S"
  assumes g_inj: "inj_on g S"
  assumes S'_OK: "S' = g ` S"
  shows "set_iterator (set_iterator_image g it) S'"
proof -
  note res' = set_iterator_genord_image_correct [OF it_OK[unfolded set_iterator_def] g_inj,
    of "\<lambda>_ _. True"]
  note res = set_iterator_intro [OF res', folded S'_OK]
  thus ?thesis by simp
qed

subsection \<open>Construction from list (foldli)\<close>

text \<open>Iterators correspond by definition to iteration over distinct lists. They fix an order
 in which the elements are visited. Therefore, it is trivial to construct an iterator from a
 distinct list.\<close>

lemma set_iterator_genord_foldli_correct :
"distinct xs \<Longrightarrow> sorted_wrt R xs \<Longrightarrow> set_iterator_genord (foldli xs) (set xs) R"
by (rule set_iterator_genord_I[of xs]) (simp_all)

lemma set_iterator_foldli_correct :
"distinct xs \<Longrightarrow> set_iterator (foldli xs) (set xs)"
by (rule set_iterator_I[of xs]) (simp_all)

lemma (in linorder) set_iterator_linord_foldli_correct :
assumes dist_xs: "distinct xs"
assumes sorted_xs: "sorted xs"
shows "set_iterator_linord (foldli xs) (set xs)"
using assms
by (rule_tac set_iterator_linord_I[of xs]) (simp_all)

lemma (in linorder) set_iterator_rev_linord_foldli_correct :
assumes dist_xs: "distinct xs"
assumes sorted_xs: "sorted (rev xs)"
shows "set_iterator_rev_linord (foldli xs) (set xs)"
using assms
by (rule_tac set_iterator_rev_linord_I[of xs]) (simp_all)

lemma map_iterator_genord_foldli_correct :
"distinct (map fst xs) \<Longrightarrow> sorted_wrt R xs \<Longrightarrow> map_iterator_genord (foldli xs) (map_of xs) R"
by (rule map_iterator_genord_I[of xs]) simp_all

lemma map_iterator_foldli_correct :
"distinct (map fst xs) \<Longrightarrow> map_iterator (foldli xs) (map_of xs)"
by (rule map_iterator_I[of xs]) (simp_all)

lemma (in linorder) map_iterator_linord_foldli_correct :
assumes dist_xs: "distinct (map fst xs)"
assumes sorted_xs: "sorted (map fst xs)"
shows "map_iterator_linord (foldli xs) (map_of xs)"
using assms
by (rule_tac map_iterator_linord_I[of xs]) (simp_all)

lemma (in linorder) map_iterator_rev_linord_foldli_correct :
assumes dist_xs: "distinct (map fst xs)"
assumes sorted_xs: "sorted (rev (map fst xs))"
shows "map_iterator_rev_linord (foldli xs) (map_of xs)"
using assms
by (rule_tac map_iterator_rev_linord_I[of xs]) (simp_all)

subsection \<open>Construction from list (foldri)\<close>

lemma set_iterator_genord_foldri_correct :
"distinct xs \<Longrightarrow> sorted_wrt R (rev xs) \<Longrightarrow> set_iterator_genord (foldri xs) (set xs) R"
by (rule set_iterator_genord_I[of "rev xs"]) (simp_all add: foldri_def)

lemma set_iterator_foldri_correct :
"distinct xs \<Longrightarrow> set_iterator (foldri xs) (set xs)"
by (rule set_iterator_I[of "rev xs"]) (simp_all add: foldri_def)

lemma (in linorder) set_iterator_linord_foldri_correct :
assumes dist_xs: "distinct xs"
assumes sorted_xs: "sorted (rev xs)"
shows "set_iterator_linord (foldri xs) (set xs)"
using assms
by (rule_tac set_iterator_linord_I[of "rev xs"]) (simp_all add: foldri_def)

lemma (in linorder) set_iterator_rev_linord_foldri_correct :
assumes dist_xs: "distinct xs"
assumes sorted_xs: "sorted xs"
shows "set_iterator_rev_linord (foldri xs) (set xs)"
using assms
by (rule_tac set_iterator_rev_linord_I[of "rev xs"]) (simp_all add: foldri_def)

lemma map_iterator_genord_foldri_correct :
"distinct (map fst xs) \<Longrightarrow> sorted_wrt R (rev xs) \<Longrightarrow> map_iterator_genord (foldri xs) (map_of xs) R"
by (rule map_iterator_genord_I[of "rev xs"])
   (simp_all add: rev_map[symmetric] foldri_def)

lemma map_iterator_foldri_correct :
"distinct (map fst xs) \<Longrightarrow> map_iterator (foldri xs) (map_of xs)"
by (rule map_iterator_I[of "rev xs"])
   (simp_all add: rev_map[symmetric] foldri_def)

lemma (in linorder) map_iterator_linord_foldri_correct :
assumes dist_xs: "distinct (map fst xs)"
assumes sorted_xs: "sorted (rev (map fst xs))"
shows "map_iterator_linord (foldri xs) (map_of xs)"
using assms
by (rule_tac map_iterator_linord_I[of "rev xs"])
   (simp_all add: rev_map[symmetric] foldri_def)

lemma (in linorder) map_iterator_rev_linord_foldri_correct :
assumes dist_xs: "distinct (map fst xs)"
assumes sorted_xs: "sorted (map fst xs)"
shows "map_iterator_rev_linord (foldri xs) (map_of xs)"
using assms
by (rule_tac map_iterator_rev_linord_I[of "rev xs"])
   (simp_all add: rev_map[symmetric] foldri_def)

subsection \<open>Iterators over Maps\<close>

text \<open>In the following iterator over the key-value pairs of a finite map are called
 iterators over maps. Operations for such iterators are presented.\<close>

subsubsection\<open>Domain Iterator\<close>

text \<open>One very simple such operation is iterating over only the keys of the map.\<close>

definition map_iterator_dom where
  "map_iterator_dom it = set_iterator_image fst it"

lemma map_iterator_dom_foldli_conv :
  "map_iterator_dom (foldli kvs) = foldli (map fst kvs)"
unfolding map_iterator_dom_def set_iterator_image_foldli_conv by simp

lemma map_iterator_genord_dom_correct :
  assumes it_OK: "map_iterator_genord it m R"
  assumes R'_prop: "\<And>k v k' v'. \<lbrakk>m k = Some v; m k' = Some v'; R (k, v) (k', v')\<rbrakk> \<Longrightarrow> R' k k'"
  shows "set_iterator_genord (map_iterator_dom it) (dom m) R'"
proof -
  have pre1: "inj_on fst (map_to_set m)"
     unfolding inj_on_def map_to_set_def by simp

  from set_iterator_genord_image_correct[OF it_OK pre1, of R'] R'_prop
  show ?thesis
    unfolding map_iterator_dom_def map_to_set_dom[symmetric]
    by (auto simp add: map_to_set_def)
qed

lemma map_iterator_dom_correct :
  assumes it_OK: "map_iterator it m"
  shows "set_iterator (map_iterator_dom it) (dom m)"
using assms
unfolding set_iterator_def
apply (rule_tac map_iterator_genord_dom_correct)
apply simp_all
done

lemma (in linorder) map_iterator_linord_dom_correct :
  assumes it_OK: "map_iterator_linord it m"
  shows "set_iterator_linord (map_iterator_dom it) (dom m)"
using assms
unfolding set_iterator_linord_def set_iterator_map_linord_def
apply (rule_tac map_iterator_genord_dom_correct)
apply assumption
apply auto
done

lemma (in linorder) map_iterator_rev_linord_dom_correct :
  assumes it_OK: "map_iterator_rev_linord it m"
  shows "set_iterator_rev_linord (map_iterator_dom it) (dom m)"
using assms
unfolding set_iterator_rev_linord_def set_iterator_map_rev_linord_def
apply (rule_tac map_iterator_genord_dom_correct)
apply assumption
apply auto
done

subsubsection\<open>Domain Iterator with Filter\<close>

text \<open>More complex is iterating over only the keys such that the key-value pairs satisfy some
        property.\<close>

definition map_iterator_dom_filter ::
    "('a \<times> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<times> 'b,'\<sigma>) set_iterator \<Rightarrow> ('a,'\<sigma>) set_iterator" where
  "map_iterator_dom_filter P it \<equiv> set_iterator_image_filter
     (\<lambda>xy. if P xy then Some (fst xy) else None) it"

lemma map_iterator_dom_filter_alt_def [code] :
  "map_iterator_dom_filter P it =
   (\<lambda>c f. it c (\<lambda>kv \<sigma>. if P kv then f (fst kv) \<sigma> else \<sigma>))"
unfolding map_iterator_dom_filter_def set_iterator_image_filter_def
apply (rule ext)
apply (rule ext)
apply (rule arg_cong2[where f="it"])
apply (simp)
apply (simp add: fun_eq_iff split: option.splits)
done

lemma map_iterator_genord_dom_filter_correct :
  fixes it :: "('a \<times> 'b, '\<sigma>) set_iterator"
  assumes it_OK: "set_iterator_genord it (map_to_set m) R"
  assumes R'_prop: "\<And>k1 v1 k2 v2.
      \<lbrakk>m k1 = Some v1; P (k1, v1);
       m k2 = Some v2; P (k2, v2); R (k1, v1) (k2, v2)\<rbrakk> \<Longrightarrow> R' k1 k2"
  shows "set_iterator_genord (map_iterator_dom_filter P it) {k . \<exists>v. m k = Some v \<and> P (k, v)} R'"
proof -
  define g where "g xy = (if P xy then Some (fst xy) else None)" for xy :: "'a \<times> 'b"

  note set_iterator_genord_image_filter_correct [OF it_OK, of g R']

  have g_eq_Some: "\<And>kv k. g kv = Some k \<longleftrightarrow> ((k = fst kv) \<and> P kv)"
    unfolding g_def by (auto split: prod.splits option.splits)

  have "\<And>x1 x2 y. x1 \<in> map_to_set m \<Longrightarrow> x2 \<in> map_to_set m \<Longrightarrow>
                  g x1 = Some y \<Longrightarrow> g x2 = Some y \<Longrightarrow> x1 = x2"
  proof -
    fix x1 x2 y
    assume x1_in: "x1 \<in> map_to_set m"
       and x2_in: "x2 \<in> map_to_set m"
       and g1_eq: "g x1 = Some y"
       and g2_eq: "g x2 = Some y"

    obtain k1 v1 where x1_eq[simp] : "x1 = (k1, v1)" by (rule prod.exhaust)
    obtain k2 v2 where x2_eq[simp] : "x2 = (k2, v2)" by (rule prod.exhaust)

    from g1_eq g2_eq g_eq_Some have k1_eq: "k1 = k2" by simp
    with x1_in x2_in have v1_eq: "v1 = v2"
      unfolding map_to_set_def by simp
    from k1_eq v1_eq show "x1 = x2" by simp
  qed
  hence g_inj_on: "inj_on g (map_to_set m \<inter> dom g)"
    unfolding inj_on_def dom_def by auto

  have g_eq_Some: "\<And>x y. (g x = Some y) \<longleftrightarrow> (P x \<and> y = (fst x))"
    unfolding g_def by auto

  have "set_iterator_genord (set_iterator_image_filter g it)
            {y. \<exists>x. x \<in> map_to_set m \<and> g x = Some y} R'"
    apply (rule set_iterator_genord_image_filter_correct [OF it_OK, of g R', OF g_inj_on])
    apply (insert R'_prop)
    apply (auto simp add: g_eq_Some map_to_set_def)
  done
  thus ?thesis
    unfolding map_iterator_dom_filter_def g_def[symmetric]
    by (simp add: g_eq_Some map_to_set_def)
qed

lemma map_iterator_dom_filter_correct :
  assumes it_OK: "map_iterator it m"
  shows "set_iterator (map_iterator_dom_filter P it) {k. \<exists>v. m k = Some v \<and> P (k, v)}"
using assms
unfolding set_iterator_def
apply (rule_tac map_iterator_genord_dom_filter_correct)
apply simp_all
done

lemma (in linorder) map_iterator_linord_dom_filter_correct :
  assumes it_OK: "map_iterator_linord it m"
  shows "set_iterator_linord (map_iterator_dom_filter P it) {k. \<exists>v. m k = Some v \<and> P (k, v)}"
using assms
unfolding set_iterator_map_linord_def set_iterator_linord_def
apply (rule_tac map_iterator_genord_dom_filter_correct
  [where R = "\<lambda>(k,_) (k',_). k\<le>k'"])
apply (simp_all add: set_iterator_def)
done

lemma (in linorder) set_iterator_rev_linord_map_filter_correct :
  assumes it_OK: "map_iterator_rev_linord it m"
  shows "set_iterator_rev_linord (map_iterator_dom_filter P it)
  {k. \<exists>v. m k = Some v \<and> P (k, v)}"
using assms
unfolding set_iterator_map_rev_linord_def set_iterator_rev_linord_def
apply (rule_tac map_iterator_genord_dom_filter_correct
  [where R = "\<lambda>(k,_) (k',_). k\<ge>k'"])
apply (simp_all add: set_iterator_def)
done

subsubsection\<open>Product for Maps\<close>

definition map_iterator_product where
  "map_iterator_product it_a it_b =
   set_iterator_image (\<lambda>kvv'. (fst (fst kvv'), snd kvv'))
    (set_iterator_product it_a (\<lambda>kv. it_b (snd kv)))"

lemma map_iterator_product_foldli_conv :
"map_iterator_product (foldli as) (\<lambda>a. foldli (bs a)) =
 foldli (concat (map (\<lambda>(k, v). map (Pair k) (bs v)) as))"
unfolding map_iterator_product_def set_iterator_product_foldli_conv set_iterator_image_foldli_conv
by (simp add: map_concat o_def split_def)

lemma map_iterator_product_alt_def [code] :
  "map_iterator_product it_a it_b =
   (\<lambda>c f. it_a c (\<lambda>a. it_b (snd a) c (\<lambda>b. f (fst a, b))))"
unfolding map_iterator_product_def set_iterator_product_def set_iterator_image_alt_def
by simp

lemma map_iterator_genord_product_correct :
  fixes it_a :: "(('k \<times> 'v),'\<sigma>) set_iterator"
  fixes it_b :: "'v \<Rightarrow> ('e,'\<sigma>) set_iterator"
  fixes S_a S_b R_a R_b m
  assumes it_a: "map_iterator_genord it_a m R_a"
  assumes it_b: "\<And>k v. m k = Some v \<Longrightarrow> set_iterator_genord (it_b v) (S_b v) (R_b v)"
  assumes R'_prop: "\<And>k v u k' v' u'.
       m k = Some v \<Longrightarrow>
       u \<in> S_b v \<Longrightarrow>
       m k' = Some v' \<Longrightarrow>
       u' \<in> S_b v' \<Longrightarrow>
       if k = k' then R_b v u u'
       else R_a (k, v) (k', v') \<Longrightarrow>
       R_ab (k, u) (k', u')"
  shows "set_iterator_genord (map_iterator_product it_a it_b)
     {(k, e) . (\<exists>v. m k = Some v \<and> e \<in> S_b v)} R_ab"
proof -
  from it_b have it_b': "\<And>kv. kv \<in> map_to_set m \<Longrightarrow>
       set_iterator_genord (it_b (snd kv)) (S_b (snd kv)) (R_b (snd kv))"
    unfolding map_to_set_def by (case_tac kv, simp)

  have "(\<Union>x\<in>{(k, v). m k = Some v}. \<Union>y\<in>S_b (snd x). {(x, y)}) = {((k,v), e) .
          (m k = Some v) \<and> e \<in> S_b v}" by (auto)
  with set_iterator_genord_product_correct [OF it_a, of "\<lambda>kv. it_b (snd kv)"
    "\<lambda>kv. S_b (snd kv)" "\<lambda>kv. R_b (snd kv)", OF it_b']
  have it_ab': "set_iterator_genord (set_iterator_product it_a (\<lambda>kv. it_b (snd kv)))
      {((k,v), e) . (m k = Some v) \<and> e \<in> S_b v}
      (set_iterator_product_order R_a
        (\<lambda>kv. R_b (snd kv)))"
     (is "set_iterator_genord ?it_ab' ?S_ab' ?R_ab'")
    unfolding map_to_set_def
    by (simp add: Sigma_def)

  let ?g = "\<lambda>kvv'. (fst (fst kvv'), snd kvv')"
  have inj_g: "inj_on ?g ?S_ab'"
    unfolding inj_on_def by simp

  have R_ab_OK: "\<And>x y.
      x \<in> {((k, v), e). m k = Some v \<and> e \<in> S_b v} \<Longrightarrow>
      y \<in> {((k, v), e). m k = Some v \<and> e \<in> S_b v} \<Longrightarrow>
      set_iterator_product_order R_a (\<lambda>kv. R_b (snd kv)) x y \<Longrightarrow>
      R_ab (fst (fst x), snd x) (fst (fst y), snd y)"
    apply (simp add: set_iterator_product_order_def)
    apply clarify
    apply (simp)
    apply (unfold fst_conv snd_conv)
    apply (metis R'_prop option.inject)
  done

  have "(?g ` {((k, v), e). m k = Some v \<and> e \<in> S_b v}) = {(k, e). \<exists>v. m k = Some v \<and> e \<in> S_b v}"
    by (simp add: image_iff set_eq_iff)
  with set_iterator_genord_image_correct [OF it_ab' inj_g, of R_ab, OF R_ab_OK]
  show ?thesis
    by (simp add: map_iterator_product_def)
qed

lemma map_iterator_product_correct :
  assumes it_a: "map_iterator it_a m"
  assumes it_b: "\<And>k v. m k = Some v \<Longrightarrow> set_iterator (it_b v) (S_b v)"
  shows "set_iterator (map_iterator_product it_a it_b)
         {(k, e) . (\<exists>v. m k = Some v \<and> e \<in> S_b v)}"
proof -
  note res' = map_iterator_genord_product_correct [OF it_a[unfolded set_iterator_def],
     of it_b S_b "\<lambda>_ _ _. True"]
  note res = set_iterator_intro [OF res']
  with it_b show ?thesis unfolding set_iterator_def by simp
qed

subsubsection\<open>Key Filter\<close>

definition map_iterator_key_filter ::
    "('a \<Rightarrow> bool) \<Rightarrow> ('a \<times> 'b,'\<sigma>) set_iterator \<Rightarrow> ('a \<times> 'b,'\<sigma>) set_iterator" where
  "map_iterator_key_filter P \<equiv> set_iterator_filter (P \<circ> fst)"

lemma map_iterator_key_filter_foldli_conv :
  "map_iterator_key_filter P (foldli kvs) =  foldli (filter (\<lambda>(k, v). P k) kvs)"
unfolding map_iterator_key_filter_def set_iterator_filter_foldli_conv o_def split_def
by simp

lemma map_iterator_key_filter_alt_def [code] :
  "map_iterator_key_filter P it = (\<lambda>c f. it c (\<lambda>x \<sigma>. if P (fst x) then f x \<sigma> else \<sigma>))"
unfolding map_iterator_key_filter_def set_iterator_filter_alt_def
  set_iterator_image_filter_def by simp

lemma map_iterator_genord_key_filter_correct :
  fixes it :: "('a \<times> 'b, '\<sigma>) set_iterator"
  assumes it_OK: "map_iterator_genord it m R"
  shows "map_iterator_genord (map_iterator_key_filter P it) (m |` {k . P k}) R"
proof -
  from set_iterator_genord_filter_correct [OF it_OK, of "P \<circ> fst",
    folded map_iterator_key_filter_def]
  have step1: "set_iterator_genord (map_iterator_key_filter P it)
                  {x \<in> map_to_set m. (P \<circ> fst) x} R"
    by simp

  have "{x \<in> map_to_set m. (P \<circ> fst) x} = map_to_set (m |` {k . P k})"
    unfolding map_to_set_def restrict_map_def
    by (auto split: if_splits)
  with step1 show ?thesis by simp
qed

lemma map_iterator_key_filter_correct :
  assumes it_OK: "map_iterator it m"
  shows "set_iterator (map_iterator_key_filter P it) (map_to_set (m |` {k . P k}))"
using assms
unfolding set_iterator_def
apply (rule_tac map_iterator_genord_key_filter_correct)
apply simp_all
done

end


chapter \<open>Natural Deduction\<close>

(*<*)
theory Natural_Deduction imports Deduction
begin
(*>*)

text \<open>We develop a natural deduction system based on the Hilbert system.\<close>

context Deduct_with_False_Disj
begin

section \<open>Natural Deduction from the Hilbert System\<close>

definition nprv :: "'fmla set \<Rightarrow> 'fmla \<Rightarrow> bool" where
"nprv F \<phi> \<equiv> prv (imp (scnj F) \<phi>)"

lemma nprv_hyp[simp,intro]:
"\<phi> \<in> F \<Longrightarrow> F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> nprv F \<phi>"
unfolding nprv_def
by (simp add: prv_scnj_imp_in subset_iff)

section \<open>Structural Rules for the Natural Deduction Relation\<close>

lemma prv_nprv0I: "prv \<phi> \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> nprv {} \<phi>"
unfolding nprv_def by (simp add: prv_imp_triv)

lemma prv_nprv_emp: "\<phi> \<in> fmla \<Longrightarrow> prv \<phi> \<longleftrightarrow> nprv {} \<phi>"
using prv_nprv0I unfolding nprv_def
by (metis asList eqv finite.simps insert_not_empty lcnj.simps(1) ldsj.cases
  list.simps(15) prv_eqvI prv_imp_mp prv_imp_tru scnj_def tru)

lemma nprv_mono:
assumes "nprv G \<phi>"
and "F \<subseteq> fmla" "finite F" "G \<subseteq> F" "\<phi> \<in> fmla"
shows "nprv F \<phi>"
using assms unfolding nprv_def
by (meson order_trans prv_prv_imp_trans prv_scnj_mono rev_finite_subset scnj)

lemma nprv_cut:
assumes "nprv F \<phi>" and "nprv (insert \<phi> F) \<psi>"
and "F \<subseteq> fmla" "finite F"  "\<phi> \<in> fmla"  "\<psi> \<in> fmla"
shows "nprv F \<psi>"
using assms unfolding nprv_def
by (metis (full_types) cnj finite.insertI
  insert_subset prv_imp_cnj prv_imp_cnj_scnj prv_imp_refl prv_prv_imp_trans scnj)

lemma nprv_strong_cut2:
"nprv F \<phi>1 \<Longrightarrow> nprv (insert \<phi>1 F) \<phi>2 \<Longrightarrow> nprv (insert \<phi>2 (insert \<phi>1 F)) \<psi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F \<psi>"
by (meson finite.insertI insert_subsetI nprv_cut)

lemma nprv_cut2:
"nprv F \<phi>1 \<Longrightarrow> nprv F \<phi>2 \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv (insert \<phi>2 (insert \<phi>1 F)) \<psi> \<Longrightarrow> nprv F \<psi>"
by (meson finite.insertI insert_subsetI nprv_mono nprv_strong_cut2 subset_insertI)

text \<open>Useful for fine control of the eigenformula:\<close>

lemma nprv_insertShiftI:
"nprv (insert \<phi>1 (insert \<phi>2 F)) \<psi> \<Longrightarrow> nprv (insert \<phi>2 (insert \<phi>1 F)) \<psi>"
by (simp add: insert_commute)

lemma nprv_insertShift2I:
"nprv (insert \<phi>3 (insert \<phi>1 (insert \<phi>2 F))) \<psi> \<Longrightarrow> nprv (insert \<phi>1 (insert \<phi>2 (insert \<phi>3 F))) \<psi>"
by (simp add: insert_commute)

section \<open>Back and Forth between Hilbert and Natural Deduction\<close>

text \<open>This is now easy, thanks to the large number of facts we have
proved for Hilbert-style deduction\<close>

lemma prv_nprvI: "prv \<phi> \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> nprv F \<phi>"
using prv_nprv0I
by (simp add: nprv_def prv_imp_triv)

thm prv_nprv0I

lemma prv_nprv1I:
assumes "\<phi> \<in> fmla" "\<psi> \<in> fmla" and "prv (imp \<phi> \<psi>)"
shows "nprv {\<phi>} \<psi>"
using assms unfolding nprv_def by (simp add: prv_scnj_imp)

lemma prv_nprv2I:
assumes "prv (imp \<phi>1 (imp \<phi>2 \<psi>))" "\<phi>1 \<in> fmla" "\<phi>2 \<in> fmla" "\<psi> \<in> fmla"
shows "nprv {\<phi>1,\<phi>2} \<psi>"
using assms unfolding nprv_def
by (meson cnj empty_subsetI finite.simps insert_subsetI prv_cnj_imp_monoR2 prv_prv_imp_trans prv_scnj2_imp_cnj scnj)

lemma nprv_prvI: "nprv {} \<phi> \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> prv \<phi>"
using prv_nprv_emp by auto

section \<open>More Structural Properties\<close>

lemma nprv_clear: "nprv {} \<phi> \<Longrightarrow> F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> nprv F \<phi>"
by (rule nprv_mono) auto

lemma nprv_cut_set:
assumes F:  "finite F" "F \<subseteq> fmla" and G: "finite G" "G \<subseteq> fmla" "\<chi> \<in> fmla"
and n1: "\<And> \<psi>. \<psi> \<in> G \<Longrightarrow> nprv F \<psi>" and n2: "nprv (G \<union> F) \<chi>"
shows "nprv F \<chi>"
using G F n1 n2 proof(induction arbitrary: F \<chi>)
  case (insert \<psi> G F \<chi>)
  hence 0: "nprv F \<psi>" by auto
  have 1: "nprv (insert \<psi> F) \<chi>"
  using insert.prems  apply- apply(rule insert.IH)
  subgoal by auto
  subgoal by auto
  subgoal by auto
  subgoal by auto
  subgoal by (meson finite.simps insert_subset nprv_mono subsetD subset_insertI)
  by auto
  show ?case using insert.prems by (intro nprv_cut[OF 0 1]) auto
qed(insert nprv_clear, auto)

lemma nprv_clear2_1:
"nprv {\<phi>2} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear2_2:
"nprv {\<phi>1} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear3_1:
"nprv {\<phi>2,\<phi>3} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear3_2:
"nprv {\<phi>1,\<phi>3} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear3_3:
"nprv {\<phi>1,\<phi>2} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear4_1:
"nprv {\<phi>2,\<phi>3,\<phi>4} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<phi>4 \<in> fmla \<Longrightarrow>\<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear4_2:
"nprv {\<phi>1,\<phi>3,\<phi>4} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<phi>4 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear4_3:
"nprv {\<phi>1,\<phi>2,\<phi>4} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<phi>4 \<in> fmla \<Longrightarrow>\<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear4_4:
"nprv {\<phi>1,\<phi>2,\<phi>3} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<phi>4 \<in> fmla \<Longrightarrow>\<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear5_1:
"nprv {\<phi>2,\<phi>3,\<phi>4,\<phi>5} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<phi>4 \<in> fmla \<Longrightarrow> \<phi>5 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4,\<phi>5} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear5_2:
"nprv {\<phi>1,\<phi>3,\<phi>4,\<phi>5} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<phi>4 \<in> fmla \<Longrightarrow> \<phi>5 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4,\<phi>5} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear5_3:
"nprv {\<phi>1,\<phi>2,\<phi>4,\<phi>5} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<phi>4 \<in> fmla \<Longrightarrow> \<phi>5 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4,\<phi>5} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear5_4:
"nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>5} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<phi>4 \<in> fmla \<Longrightarrow> \<phi>5 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4,\<phi>5} \<psi>"
by (rule nprv_mono) auto

lemma nprv_clear5_5:
"nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4} \<psi> \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<phi>3 \<in> fmla \<Longrightarrow> \<phi>4 \<in> fmla \<Longrightarrow> \<phi>5 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv {\<phi>1,\<phi>2,\<phi>3,\<phi>4,\<phi>5} \<psi>"
by (rule nprv_mono) auto

section \<open>Properties Involving Substitution\<close>

lemma nprv_subst:
assumes "x \<in> var" "t \<in> trm" "\<psi> \<in> fmla" "finite F" "F \<subseteq> fmla"
and 1: "nprv F \<psi>"
shows "nprv ((\<lambda>\<phi>. subst \<phi> t x) ` F) (subst \<psi> t x)"
using assms using prv_subst[OF _ _ _ 1[unfolded nprv_def]]  unfolding nprv_def
by (intro prv_prv_imp_trans[OF _ _ _ prv_subst_scnj_imp]) auto

lemma nprv_subst_fresh:
assumes 0: "x \<in> var" "t \<in> trm" "\<psi> \<in> fmla" "finite F" "F \<subseteq> fmla"
"nprv F \<psi>" and 1: "x \<notin> \<Union> (Fvars ` F)"
shows "nprv F (subst \<psi> t x)"
proof-
  have 2: "(\<lambda>\<phi>. subst \<phi> t x) ` F = F" unfolding image_def using assms by force
  show ?thesis using nprv_subst[OF 0] unfolding 2 .
qed

lemma nprv_subst_rev:
assumes 0: "x \<in> var" "y \<in> var" "\<psi> \<in> fmla" "finite F" "F \<subseteq> fmla"
and f: "y = x \<or> (y \<notin> Fvars \<psi> \<and> y \<notin> \<Union> (Fvars ` F))"
and 1: "nprv ((\<lambda>\<phi>. subst \<phi> (Var y) x) ` F) (subst \<psi> (Var y) x)"
shows "nprv F \<psi>"
proof-
  have 0: "subst (subst \<psi> (Var y) x) (Var x) y = \<psi>"
  using assms by (auto simp: subst_compose_eq_or)
  have "nprv ((\<lambda>\<phi>. subst \<phi> (Var x) y) ` (\<lambda>\<phi>. subst \<phi> (Var y) x) ` F) \<psi>"
  using assms apply(subst 0[symmetric]) by (rule nprv_subst) auto
  moreover
  have "prv (imp (scnj F)
                 (scnj ((\<lambda>\<phi>. subst \<phi> (Var x) y) ` (\<lambda>\<phi>. subst \<phi> (Var y) x) ` F)))"
  using assms apply(intro prv_scnj_mono_imp)
  subgoal by auto
  subgoal by auto
  subgoal by auto
  subgoal by auto
  subgoal apply clarify
    subgoal for _ _ \<phi>
    by (auto simp: subst_compose_eq_or intro!: bexI[of _ \<phi>] prv_imp_refl2) . .
  ultimately show ?thesis
  unfolding nprv_def using assms
  apply- by(rule prv_prv_imp_trans) auto
qed

lemma nprv_psubst:
assumes 0: "snd ` set txs \<subseteq> var" "fst ` set txs \<subseteq> trm" "\<psi> \<in> fmla" "finite F" "F \<subseteq> fmla"
"distinct (map snd txs)"
and 1: "nprv F \<psi>"
shows "nprv ((\<lambda>\<phi>. psubst \<phi> txs) ` F) (psubst \<psi> txs)"
using assms  unfolding nprv_def
apply(intro prv_prv_imp_trans[OF _ _ _ prv_psubst_scnj_imp])
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by auto
subgoal using prv_psubst[OF _ _ _ 1[unfolded nprv_def]]
	by (metis imp psubst_imp scnj) .

section \<open>Introduction and Elimination Rules\<close>

text \<open>We systematically leave the side-conditions at the end, to simplify reasoning.\<close>

lemma nprv_impI:
"nprv (insert \<phi> F) \<psi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F (imp \<phi> \<psi>)"
unfolding nprv_def
by (metis cnj finite.insertI insert_subset prv_cnj_imp prv_imp_cnj_scnj prv_imp_com prv_prv_imp_trans scnj)

lemma nprv_impI_rev:
assumes "nprv F (imp \<phi> \<psi>)"
and "F \<subseteq> fmla" and "finite F" and "\<phi> \<in> fmla" and "\<psi> \<in> fmla"
shows "nprv (insert \<phi> F) \<psi>"
using assms unfolding nprv_def
by (metis cnj finite.insertI insert_subset prv_cnj_imp_monoR2 prv_eqv_imp_transi
    prv_eqv_scnj_insert prv_imp_com scnj)

lemma nprv_impI_rev2:
assumes "nprv F (imp \<phi> \<psi>)" and G: "insert \<phi> F \<subseteq> G"
and "G \<subseteq> fmla" and "finite G" and "\<phi> \<in> fmla" and "\<psi> \<in> fmla"
shows "nprv G \<psi>"
using assms apply- apply(rule nprv_mono[of "insert \<phi> F"])
subgoal by (meson nprv_impI_rev order_trans rev_finite_subset subset_insertI)
by auto

lemma nprv_mp:
"nprv F (imp \<phi> \<psi>) \<Longrightarrow> nprv F \<phi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F \<psi>"
unfolding nprv_def
by (metis (full_types) cnj prv_cnj_imp_monoR2 prv_imp_cnj prv_imp_refl prv_prv_imp_trans scnj)

lemma nprv_impE:
"nprv F (imp \<phi> \<psi>) \<Longrightarrow> nprv F \<phi> \<Longrightarrow>  nprv (insert \<psi> F) \<chi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow> \<chi> \<in> fmla \<Longrightarrow>
 nprv F \<chi>"
using nprv_cut nprv_mp by blast

lemmas nprv_impE0 = nprv_impE[OF nprv_hyp _ _, simped]
lemmas nprv_impE1 = nprv_impE[OF _ nprv_hyp _, simped]
lemmas nprv_impE2 = nprv_impE[OF _ _ nprv_hyp, simped]
lemmas nprv_impE01 = nprv_impE[OF nprv_hyp nprv_hyp _, simped]
lemmas nprv_impE02 = nprv_impE[OF nprv_hyp _ nprv_hyp, simped]
lemmas nprv_impE12 = nprv_impE[OF _ nprv_hyp nprv_hyp, simped]
lemmas nprv_impE012 = nprv_impE[OF nprv_hyp nprv_hyp nprv_hyp, simped]

lemma nprv_cnjI:
"nprv F \<phi> \<Longrightarrow> nprv F \<psi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F (cnj \<phi> \<psi>)"
unfolding nprv_def by (simp add: prv_imp_cnj)

lemma nprv_cnjE:
"nprv F (cnj \<phi>1 \<phi>2) \<Longrightarrow> nprv (insert \<phi>1 (insert \<phi>2 F)) \<psi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F \<psi>"
unfolding nprv_def
by (metis cnj nprv_cut2 nprv_def prv_imp_cnjL prv_imp_cnjR prv_prv_imp_trans scnj)

lemmas nprv_cnjE0 = nprv_cnjE[OF nprv_hyp _, simped]
lemmas nprv_cnjE1 = nprv_cnjE[OF _ nprv_hyp, simped]
lemmas nprv_cnjE01 = nprv_cnjE[OF nprv_hyp nprv_hyp, simped]

lemma nprv_dsjIL:
"nprv F \<phi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F (dsj \<phi> \<psi>)"
unfolding nprv_def by (meson dsj prv_dsj_impL prv_prv_imp_trans scnj)

lemma nprv_dsjE:
assumes "nprv F (dsj \<phi> \<psi>)"
and "nprv (insert \<phi> F) \<chi>" "nprv (insert \<psi> F) \<chi>"
and "F \<subseteq> fmla" "finite F" "\<phi> \<in> fmla" "\<psi> \<in> fmla" "\<chi> \<in> fmla"
shows "nprv F \<chi>"
proof-
  have "nprv F (imp (dsj \<phi> \<psi>) \<chi>)"
    by (meson assms dsj imp nprv_def nprv_impI prv_imp_com prv_imp_dsjEE scnj)
  hence "nprv (insert (dsj \<phi> \<psi>) F) \<chi>" using assms
    by (simp add: nprv_impI_rev)
  thus ?thesis using assms by (meson dsj nprv_cut)
qed

lemmas nprv_dsjE0 = nprv_dsjE[OF nprv_hyp _ _, simped]
lemmas nprv_dsjE1 = nprv_dsjE[OF _ nprv_hyp _, simped]
lemmas nprv_dsjE2 = nprv_dsjE[OF _ _ nprv_hyp, simped]
lemmas nprv_dsjE01 = nprv_dsjE[OF nprv_hyp nprv_hyp _, simped]
lemmas nprv_dsjE02 = nprv_dsjE[OF nprv_hyp _ nprv_hyp, simped]
lemmas nprv_dsjE12 = nprv_dsjE[OF _ nprv_hyp nprv_hyp, simped]
lemmas nprv_dsjE012 = nprv_dsjE[OF nprv_hyp nprv_hyp nprv_hyp, simped]

lemma nprv_flsE: "nprv F fls \<Longrightarrow> F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow>  nprv F \<phi>"
unfolding nprv_def using prv_prv_imp_trans scnj by blast

lemmas nprv_flsE0 = nprv_flsE[OF nprv_hyp, simped]

lemma nprv_truI: "F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> nprv F tru"
unfolding nprv_def by (simp add: prv_imp_tru)

lemma nprv_negI:
"nprv (insert \<phi> F) fls \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow>
 nprv F (neg \<phi>)"
unfolding neg_def by (auto intro: nprv_impI)

lemma nprv_neg_fls:
"nprv F (neg \<phi>) \<Longrightarrow> nprv F \<phi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F fls"
unfolding neg_def using nprv_mp by blast

lemma nprv_negE:
"nprv F (neg \<phi>) \<Longrightarrow> nprv F \<phi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F \<psi>"
using nprv_flsE nprv_neg_fls by blast

lemmas nprv_negE0 = nprv_negE[OF nprv_hyp _, simped]
lemmas nprv_negE1 = nprv_negE[OF _ nprv_hyp, simped]
lemmas nprv_negE01 = nprv_negE[OF nprv_hyp nprv_hyp, simped]

lemma nprv_scnjI:
"(\<And> \<psi>. \<psi> \<in> G \<Longrightarrow> nprv F \<psi>) \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> G \<subseteq> fmla \<Longrightarrow> finite G \<Longrightarrow>
 nprv F (scnj G)"
unfolding nprv_def by (simp add: prv_imp_scnj)

lemma nprv_scnjE:
"nprv F (scnj G) \<Longrightarrow> nprv (G \<union> F) \<psi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> G \<subseteq> fmla \<Longrightarrow> finite G \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F \<psi>"
apply(rule nprv_cut_set[of _ G])
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by (meson in_mono nprv_def prv_prv_imp_trans prv_scnj_imp_in scnj) .

lemmas nprv_scnjE0 = nprv_scnjE[OF nprv_hyp _, simped]
lemmas nprv_scnjE1 = nprv_scnjE[OF _ nprv_hyp, simped]
lemmas nprv_scnjE01 = nprv_scnjE[OF nprv_hyp nprv_hyp, simped]

lemma nprv_lcnjI:
"(\<And> \<psi>. \<psi> \<in> set \<psi>s \<Longrightarrow> nprv F \<psi>) \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> set \<psi>s \<subseteq> fmla \<Longrightarrow>
 nprv F (lcnj \<psi>s)"
unfolding nprv_def by (simp add: prv_imp_lcnj)

lemma nprv_lcnjE:
"nprv F (lcnj \<phi>s) \<Longrightarrow> nprv (set \<phi>s \<union> F) \<psi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> set \<phi>s \<subseteq> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv F \<psi>"
apply(rule nprv_cut_set[of _ "set \<phi>s \<union> F"])
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by auto
subgoal by auto
subgoal
  apply (elim UnE)
   apply (meson lcnj nprv_def prv_lcnj_imp_in prv_prv_imp_trans scnj subset_code(1))
  by auto
subgoal by auto .

lemmas nprv_lcnjE0 = nprv_lcnjE[OF nprv_hyp _, simped]
lemmas nprv_lcnjE1 = nprv_lcnjE[OF _ nprv_hyp, simped]
lemmas nprv_lcnjE01 = nprv_lcnjE[OF nprv_hyp nprv_hyp, simped]

lemma nprv_sdsjI:
"nprv F \<phi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> G \<subseteq> fmla \<Longrightarrow> finite G \<Longrightarrow> \<phi> \<in> G \<Longrightarrow>
 nprv F (sdsj G)"
unfolding nprv_def by (simp add: prv_imp_sdsj)

lemma nprv_sdsjE:
assumes "nprv F (sdsj G)"
and "\<And> \<psi>. \<psi> \<in> G \<Longrightarrow> nprv (insert \<psi> F) \<chi>"
and "F \<subseteq> fmla" "finite F" "G \<subseteq> fmla" "finite G" "\<chi> \<in> fmla"
shows "nprv F \<chi>"
proof-
  have 0: "prv (imp (sdsj G) (imp (scnj F) \<chi>))"
    using assms apply(intro prv_sdsj_imp)
    subgoal by auto
    subgoal by auto
    subgoal by auto
    subgoal by (meson nprv_def nprv_impI prv_imp_com scnj set_rev_mp) .
  hence "nprv F (imp (sdsj G) \<chi>)"
    by (simp add: 0 assms nprv_def prv_imp_com)
  thus ?thesis using assms nprv_mp by blast
qed

lemmas nprv_sdsjE0 = nprv_sdsjE[OF nprv_hyp _, simped]
lemmas nprv_sdsjE1 = nprv_sdsjE[OF _ nprv_hyp, simped]
lemmas nprv_sdsjE01 = nprv_sdsjE[OF nprv_hyp nprv_hyp, simped]

lemma nprv_ldsjI:
"nprv F \<phi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> set \<phi>s \<subseteq> fmla \<Longrightarrow>  \<phi> \<in> set \<phi>s \<Longrightarrow>
 nprv F (ldsj \<phi>s)"
unfolding nprv_def by(simp add: prv_imp_ldsj)

lemma nprv_ldsjE:
assumes "nprv F (ldsj \<psi>s)"
and "\<And> \<psi>. \<psi> \<in> set \<psi>s \<Longrightarrow> nprv (insert \<psi> F) \<chi>"
and "F \<subseteq> fmla" "finite F" "set \<psi>s \<subseteq> fmla"  "\<chi> \<in> fmla"
shows "nprv F \<chi>"
proof-
  have 0: "prv (imp (ldsj \<psi>s) (imp (scnj F) \<chi>))"
  using assms apply(intro prv_ldsj_imp)
    subgoal by auto
    subgoal by auto
    subgoal by (meson nprv_def nprv_impI prv_imp_com scnj set_rev_mp) .
  hence "nprv F (imp (ldsj \<psi>s) \<chi>)"
    by (simp add: 0 assms nprv_def prv_imp_com)
  thus ?thesis using assms nprv_mp by blast
qed

lemmas nprv_ldsjE0 = nprv_ldsjE[OF nprv_hyp _, simped]
lemmas nprv_ldsjE1 = nprv_ldsjE[OF _ nprv_hyp, simped]
lemmas nprv_ldsjE01 = nprv_ldsjE[OF nprv_hyp nprv_hyp, simped]

lemma nprv_allI:
"nprv F \<phi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> x \<in> var \<Longrightarrow> x \<notin> \<Union> (Fvars ` F) \<Longrightarrow>
 nprv F (all x \<phi>)"
unfolding nprv_def by (rule prv_all_imp_gen) auto

lemma nprv_allE:
assumes "nprv F (all x \<phi>)" "nprv (insert (subst \<phi> t x) F) \<psi>"
"F \<subseteq> fmla" "finite F" "\<phi> \<in> fmla" "t \<in> trm" "x \<in> var" "\<psi> \<in> fmla"
shows "nprv F \<psi>"
proof-
  have "nprv F (subst \<phi> t x)"
  using assms unfolding nprv_def by (meson all subst prv_all_inst prv_prv_imp_trans scnj)
  thus ?thesis by (meson assms local.subst nprv_cut)
qed

lemmas nprv_allE0 = nprv_allE[OF nprv_hyp _, simped]
lemmas nprv_allE1 = nprv_allE[OF _ nprv_hyp, simped]
lemmas nprv_allE01 = nprv_allE[OF nprv_hyp nprv_hyp, simped]

lemma nprv_exiI:
"nprv F (subst \<phi> t x) \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi> \<in> fmla \<Longrightarrow> t \<in> trm \<Longrightarrow> x \<in> var \<Longrightarrow>
 nprv F (exi x \<phi>)"
unfolding nprv_def by (meson exi local.subst prv_exi_inst prv_prv_imp_trans scnj)

lemma nprv_exiE:
assumes n: "nprv F (exi x \<phi>)"
and nn: "nprv (insert \<phi> F) \<psi>"
and 0[simp]: "F \<subseteq> fmla" "finite F" "\<phi> \<in> fmla" "x \<in> var" "\<psi> \<in> fmla"
and x: "x \<notin> \<Union> (Fvars ` F)" "x \<notin> Fvars \<psi>"
shows "nprv F \<psi>"
proof-
  have "nprv F (imp (exi x \<phi>) \<psi>)" unfolding nprv_def apply(rule prv_imp_com)
  subgoal by auto
  subgoal by auto
  subgoal by auto
  subgoal apply(rule prv_exi_imp_gen)
    subgoal by auto
    subgoal by auto
    subgoal by auto
    subgoal using x by auto
    subgoal apply(rule prv_imp_com)
      subgoal by auto
      subgoal by auto
      subgoal by auto
      subgoal using assms(3-5) assms(7) nn nprv_def nprv_impI by blast . . .
  thus ?thesis using n assms nprv_mp by blast
qed

lemmas nprv_exiE0 = nprv_exiE[OF nprv_hyp _, simped]
lemmas nprv_exiE1 = nprv_exiE[OF _ nprv_hyp, simped]
lemmas nprv_exiE01 = nprv_exiE[OF nprv_hyp nprv_hyp, simped]

section \<open>Adding Lemmas of Various Shapes into the Proof Context\<close>

lemma nprv_addLemmaE:
assumes "prv \<phi>" "nprv (insert \<phi> F) \<psi>"
and "\<phi> \<in> fmla" "\<psi> \<in> fmla" and "F \<subseteq> fmla" and "finite F"
shows "nprv F \<psi>"
using assms nprv_cut prv_nprvI by blast

lemmas nprv_addLemmaE1 = nprv_addLemmaE[OF _ nprv_hyp, simped]

lemma nprv_addImpLemmaI:
assumes "prv (imp \<phi>1 \<phi>2)"
and "F \<subseteq> fmla" "finite F" "\<phi>1 \<in> fmla" "\<phi>2 \<in> fmla"
and "nprv F \<phi>1"
shows "nprv F \<phi>2"
by (meson assms nprv_def prv_prv_imp_trans scnj)

lemma nprv_addImpLemmaE:
assumes "prv (imp \<phi>1 \<phi>2)" and "nprv F \<phi>1" and "nprv ((insert \<phi>2) F) \<psi>"
and "F \<subseteq> fmla" "finite F" "\<phi>1 \<in> fmla" "\<phi>2 \<in> fmla" "\<psi> \<in> fmla"
shows "nprv F \<psi>"
using assms nprv_addImpLemmaI nprv_cut by blast

lemmas nprv_addImpLemmaE1 = nprv_addImpLemmaE[OF _ nprv_hyp _, simped]
lemmas nprv_addImpLemmaE2 = nprv_addImpLemmaE[OF _ _ nprv_hyp, simped]
lemmas nprv_addImpLemmaE12 = nprv_addImpLemmaE[OF _ nprv_hyp nprv_hyp, simped]

lemma nprv_addImp2LemmaI:
assumes "prv (imp \<phi>1 (imp \<phi>2 \<phi>3))"
and "F \<subseteq> fmla" "finite F" "\<phi>1 \<in> fmla" "\<phi>2 \<in> fmla" "\<phi>3 \<in> fmla"
and "nprv F \<phi>1" "nprv F \<phi>2"
shows "nprv F \<phi>3"
by (meson assms imp nprv_addImpLemmaI nprv_mp)

lemma nprv_addImp2LemmaE:
assumes "prv (imp \<phi>1 (imp \<phi>2 \<phi>3))" and "nprv F \<phi>1" and "nprv F \<phi>2" and "nprv ((insert \<phi>3) F) \<psi>"
and "F \<subseteq> fmla" "finite F" "\<phi>1 \<in> fmla" "\<phi>2 \<in> fmla"  "\<phi>3 \<in> fmla" "\<psi> \<in> fmla"
shows "nprv F \<psi>"
by (meson assms nprv_addImp2LemmaI nprv_cut)

lemmas nprv_addImp2LemmaE1 = nprv_addImp2LemmaE[OF _ nprv_hyp _ _, simped]
lemmas nprv_addImp2LemmaE2 = nprv_addImp2LemmaE[OF _ _ nprv_hyp _, simped]
lemmas nprv_addImp2LemmaE3 = nprv_addImp2LemmaE[OF _ _ _ nprv_hyp, simped]
lemmas nprv_addImp2LemmaE12 = nprv_addImp2LemmaE[OF _ nprv_hyp nprv_hyp _, simped]
lemmas nprv_addImp2LemmaE13 = nprv_addImp2LemmaE[OF _ nprv_hyp _ nprv_hyp, simped]
lemmas nprv_addImp2LemmaE23 = nprv_addImp2LemmaE[OF _ _ nprv_hyp nprv_hyp, simped]
lemmas nprv_addImp2LemmaE123 = nprv_addImp2LemmaE[OF _ nprv_hyp nprv_hyp nprv_hyp, simped]

lemma nprv_addImp3LemmaI:
assumes "prv (imp \<phi>1 (imp \<phi>2 (imp \<phi>3 \<phi>4)))"
and "F \<subseteq> fmla" "finite F" "\<phi>1 \<in> fmla" "\<phi>2 \<in> fmla" "\<phi>3 \<in> fmla" "\<phi>4 \<in> fmla"
and "nprv F \<phi>1" "nprv F \<phi>2" "nprv F \<phi>3"
shows "nprv F \<phi>4"
by (meson assms imp nprv_addImpLemmaI nprv_mp)

lemma nprv_addImp3LemmaE:
assumes "prv (imp \<phi>1 (imp \<phi>2 (imp \<phi>3 \<phi>4)))"  and "nprv F \<phi>1" and "nprv F \<phi>2" and "nprv F \<phi>3"
and "nprv ((insert \<phi>4) F) \<psi>"
and "F \<subseteq> fmla" "finite F" "\<phi>1 \<in> fmla" "\<phi>2 \<in> fmla" "\<phi>3 \<in> fmla" "\<phi>4 \<in> fmla" "\<psi> \<in> fmla"
shows "nprv F \<psi>"
by (meson assms nprv_addImp3LemmaI nprv_cut)

lemmas nprv_addImp3LemmaE1 = nprv_addImp3LemmaE[OF _ nprv_hyp _ _ _, simped]
lemmas nprv_addImp3LemmaE2 = nprv_addImp3LemmaE[OF _ _ nprv_hyp _ _, simped]
lemmas nprv_addImp3LemmaE3 = nprv_addImp3LemmaE[OF _ _ _ nprv_hyp _, simped]
lemmas nprv_addImp3LemmaE4 = nprv_addImp3LemmaE[OF _ _ _ _ nprv_hyp, simped]
lemmas nprv_addImp3LemmaE12 = nprv_addImp3LemmaE[OF _ nprv_hyp nprv_hyp _ _, simped]
lemmas nprv_addImp3LemmaE13 = nprv_addImp3LemmaE[OF _ nprv_hyp _ nprv_hyp _, simped]
lemmas nprv_addImp3LemmaE14 = nprv_addImp3LemmaE[OF _ nprv_hyp _ _ nprv_hyp, simped]
lemmas nprv_addImp3LemmaE23 = nprv_addImp3LemmaE[OF _ _ nprv_hyp nprv_hyp _, simped]
lemmas nprv_addImp3LemmaE24 = nprv_addImp3LemmaE[OF _ _ nprv_hyp _ nprv_hyp, simped]
lemmas nprv_addImp3LemmaE34 = nprv_addImp3LemmaE[OF _ _ _ nprv_hyp nprv_hyp, simped]
lemmas nprv_addImp3LemmaE123 = nprv_addImp3LemmaE[OF _ nprv_hyp nprv_hyp nprv_hyp _, simped]
lemmas nprv_addImp3LemmaE124 = nprv_addImp3LemmaE[OF _ nprv_hyp nprv_hyp _ nprv_hyp, simped]
lemmas nprv_addImp3LemmaE134 = nprv_addImp3LemmaE[OF _ nprv_hyp _ nprv_hyp nprv_hyp, simped]
lemmas nprv_addImp3LemmaE234 = nprv_addImp3LemmaE[OF _ _ nprv_hyp nprv_hyp nprv_hyp, simped]
lemmas nprv_addImp3LemmaE1234 = nprv_addImp3LemmaE[OF _ nprv_hyp nprv_hyp nprv_hyp nprv_hyp, simped]

lemma nprv_addDsjLemmaE:
assumes "prv (dsj \<phi>1 \<phi>2)" and "nprv (insert \<phi>1 F) \<psi>" and "nprv ((insert \<phi>2) F) \<psi>"
and "F \<subseteq> fmla" "finite F" "\<phi>1 \<in> fmla" "\<phi>2 \<in> fmla" "\<psi> \<in> fmla"
shows "nprv F \<psi>"
by (meson assms dsj nprv_clear nprv_dsjE prv_nprv0I)

lemmas nprv_addDsjLemmaE1 = nprv_addDsjLemmaE[OF _ nprv_hyp _, simped]
lemmas nprv_addDsjLemmaE2 = nprv_addDsjLemmaE[OF _ _ nprv_hyp, simped]
lemmas nprv_addDsjLemmaE12 = nprv_addDsjLemmaE[OF _ nprv_hyp nprv_hyp, simped]

section \<open>Rules for Equality\<close>

text \<open>Reflexivity:\<close>
lemma nprv_eql_reflI: "F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> t \<in> trm \<Longrightarrow> nprv F (eql t t)"
by (simp add: prv_eql_reflT prv_nprvI)

lemma nprv_eq_eqlI: "t1 = t2 \<Longrightarrow> F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> t1 \<in> trm \<Longrightarrow> nprv F (eql t1 t2)"
by (simp add: prv_eql_reflT prv_nprvI)

text \<open>Symmetry:\<close>
lemmas nprv_eql_symI =  nprv_addImpLemmaI[OF prv_eql_sym, simped, rotated 4]
lemmas nprv_eql_symE =  nprv_addImpLemmaE[OF prv_eql_sym, simped, rotated 2]

lemmas nprv_eql_symE0 =  nprv_eql_symE[OF nprv_hyp _, simped]
lemmas nprv_eql_symE1 =  nprv_eql_symE[OF _ nprv_hyp, simped]
lemmas nprv_eql_symE01 =  nprv_eql_symE[OF nprv_hyp nprv_hyp, simped]

text \<open>Transitivity:\<close>
lemmas nprv_eql_transI = nprv_addImp2LemmaI[OF prv_eql_imp_trans, simped, rotated 5]
lemmas nprv_eql_transE = nprv_addImp2LemmaE[OF prv_eql_imp_trans, simped, rotated 3]

lemmas nprv_eql_transE0 = nprv_eql_transE[OF nprv_hyp _ _, simped]
lemmas nprv_eql_transE1 = nprv_eql_transE[OF _ nprv_hyp _, simped]
lemmas nprv_eql_transE2 = nprv_eql_transE[OF _ _ nprv_hyp, simped]
lemmas nprv_eql_transE01 = nprv_eql_transE[OF nprv_hyp nprv_hyp _, simped]
lemmas nprv_eql_transE02 = nprv_eql_transE[OF nprv_hyp _ nprv_hyp, simped]
lemmas nprv_eql_transE12 = nprv_eql_transE[OF _ nprv_hyp nprv_hyp, simped]
lemmas nprv_eql_transE012 = nprv_eql_transE[OF nprv_hyp nprv_hyp nprv_hyp, simped]

text \<open>Substitutivity:\<close>
lemmas nprv_eql_substI =
nprv_addImp2LemmaI[OF prv_eql_subst_trm_rev, simped, rotated 6]
lemmas nprv_eql_substE = nprv_addImp2LemmaE[OF prv_eql_subst_trm_rev, simped, rotated 4]

lemmas nprv_eql_substE0 = nprv_eql_substE[OF nprv_hyp _ _, simped]
lemmas nprv_eql_substE1 = nprv_eql_substE[OF _ nprv_hyp _, simped]
lemmas nprv_eql_substE2 = nprv_eql_substE[OF _ _ nprv_hyp, simped]
lemmas nprv_eql_substE01 = nprv_eql_substE[OF nprv_hyp nprv_hyp _, simped]
lemmas nprv_eql_substE02 = nprv_eql_substE[OF nprv_hyp _ nprv_hyp, simped]
lemmas nprv_eql_substE12 = nprv_eql_substE[OF _ nprv_hyp nprv_hyp, simped]
lemmas nprv_eql_substE012 = nprv_eql_substE[OF nprv_hyp nprv_hyp nprv_hyp, simped]

section \<open>Other Rules\<close>

lemma nprv_cnjH:
"nprv (insert \<phi>1 (insert \<phi>2 F)) \<psi> \<Longrightarrow>
 F \<subseteq> fmla \<Longrightarrow> finite F \<Longrightarrow> \<phi>1 \<in> fmla \<Longrightarrow> \<phi>2 \<in> fmla \<Longrightarrow> \<psi> \<in> fmla \<Longrightarrow>
 nprv (insert (cnj \<phi>1 \<phi>2) F) \<psi>"
apply(rule nprv_cut2[of _ \<phi>1 \<phi>2])
subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI)
subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI)
subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI)
subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI)
subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI)
subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI)
subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI)
by (meson cnj finite.insertI insert_iff insert_subset nprv_mono subset_insertI)

lemma nprv_exi_commute:
assumes [simp]: "x \<in> var" "y \<in> var" "\<phi> \<in> fmla"
shows "nprv {exi x (exi y \<phi>)} (exi y (exi x \<phi>))"
apply(rule nprv_exiE0[of x "exi y \<phi>"], auto)
apply(rule nprv_clear2_2, auto)
apply(rule nprv_exiE0[of y \<phi>], auto)
apply(rule nprv_clear2_2, auto)
apply(rule nprv_exiI[of _ _ "Var y"], auto)
by (rule nprv_exiI[of _ _ "Var x"], auto)

lemma prv_exi_commute:
assumes [simp]: "x \<in> var" "y \<in> var" "\<phi> \<in> fmla"
shows "prv (imp (exi x (exi y \<phi>)) (exi y (exi x \<phi>)))"
apply(rule nprv_prvI, auto)
apply(rule nprv_impI, auto)
by (rule nprv_exi_commute, auto)

end (* context Deduct_with_False_Disj *)

section \<open>Natural Deduction for the Exists-Unique Quantifier\<close>

context Deduct_with_False_Disj_Rename
begin

lemma nprv_exuI:
assumes n1: "nprv F (subst \<phi> t x)" and n2: "nprv (insert \<phi> F) (eql (Var x) t)"
and i[simp]: "F \<subseteq> fmla" "finite F" "\<phi> \<in> fmla" "t \<in> trm" "x \<in> var"   "x \<notin> FvarsT t"
and u: "x \<notin> (\<Union>\<phi> \<in> F. Fvars \<phi>)"
shows "nprv F (exu x \<phi>)"
proof-
  define z where "z \<equiv> getFr [x] [t] [\<phi>]"
  have z_facts[simp]: "z \<in> var" "z \<noteq> x" "x \<noteq> z"   "z \<notin> FvarsT t" "z \<notin> Fvars \<phi>"
  using getFr_FvarsT_Fvars[of "[x]" "[t]" "[\<phi>]"] unfolding z_def[symmetric] by auto
  have 0: "exu x \<phi> = cnj (exi x \<phi>) (exi z (all x (imp \<phi> (eql (Var x) (Var z)))))"
  by (simp add: exu_def_var[of _ z])
  show ?thesis
  unfolding 0
    apply(rule nprv_cnjI, auto)
    apply(rule nprv_exiI[of _ _ t], auto)
    apply(rule n1)
    (**)
    apply(rule nprv_exiI[of _ _ t], auto)
    apply(rule nprv_allI, insert u, auto)
    apply(rule nprv_impI, insert n2, auto)
  done
qed

lemma nprv_exuI_var:
assumes n1: "nprv F (subst \<phi> t x)" and n2: "nprv (insert (subst \<phi> (Var y) x) F) (eql (Var y) t)"
and i[simp]: "F \<subseteq> fmla" "finite F" "\<phi> \<in> fmla" "t \<in> trm" "x \<in> var"
"y \<in> var" "y \<notin> FvarsT t" and u: "y \<notin> (\<Union>\<phi> \<in> F. Fvars \<phi>)" and yx: "y = x \<or> y \<notin> Fvars \<phi>"
shows "nprv F (exu x \<phi>)"
apply(subst exu_rename2[of _ _ y])
subgoal by auto
subgoal by auto
subgoal by auto
subgoal using yx by auto
subgoal apply(intro nprv_exuI[of _ _ t])
  subgoal by (metis i(3) i(4) i(5) i(6) n1 subst_same_Var subst_subst yx)
  using n2 u by auto .

text \<open>This turned out to be the most useful introduction rule for arithmetic:\<close>
lemma nprv_exuI_exi:
assumes n1: "nprv F (exi x \<phi>)" and n2: "nprv (insert (subst \<phi> (Var y) x) (insert \<phi> F)) (eql (Var y) (Var x))"
and i[simp]: "F \<subseteq> fmla" "finite F" "\<phi> \<in> fmla" "x \<in> var" "y \<in> var" "y \<noteq> x" "y \<notin> Fvars \<phi>"
and u: "x \<notin> (\<Union>\<phi> \<in> F. Fvars \<phi>)" "y \<notin> (\<Union>\<phi> \<in> F. Fvars \<phi>)"
shows "nprv F (exu x \<phi>)"
proof-
  have e: "nprv (insert \<phi> F) (exu x \<phi>)"
  apply(rule nprv_exuI_var[of _ _ "Var x" _ y])
  using n2 u by auto
  show ?thesis
  apply(rule nprv_cut[OF n1], auto)
  apply(rule nprv_exiE0, insert u, auto)
  apply(rule nprv_mono[OF e], auto) .
qed

lemma prv_exu_imp_exi:
assumes [simp]: "\<phi> \<in> fmla" "x \<in> var"
shows "prv (imp (exu x \<phi>) (exi x \<phi>))"
proof-
  define z where z: "z \<equiv> getFr [x] [] [\<phi>]"
  have z_facts[simp]: "z \<in> var" "z \<noteq> x" "x \<noteq> z" "z \<notin> Fvars \<phi>"
  using getFr_FvarsT_Fvars[of "[x]" "[]" "[\<phi>]"] unfolding z by auto
  show ?thesis unfolding exu_def
  by (simp add: Let_def z[symmetric] prv_imp_cnjL)
qed

lemma prv_exu_exi:
  assumes "x \<in> var" "\<phi> \<in> fmla" "prv (exu x \<phi>)"
  shows "prv (exi x \<phi>)"
  by (meson assms exi exu prv_exu_imp_exi prv_imp_mp)

text \<open>This is just exu behaving for elimination and forward like exi:\<close>
lemma nprv_exuE_exi:
assumes n1: "nprv F (exu x \<phi>)" and n2: "nprv (insert \<phi> F) \<psi>"
and i[simp]: "F \<subseteq> fmla" "finite F" "\<phi> \<in> fmla" "x \<in> var" "\<psi> \<in> fmla" "x \<notin> Fvars \<psi>"
and u: "x \<notin> (\<Union>\<phi> \<in> F. Fvars \<phi>)"
shows "nprv F \<psi>"
using assms apply- apply(rule nprv_exiE[of _ x \<phi>])
subgoal by (rule nprv_addImpLemmaI[OF prv_exu_imp_exi[of \<phi> x]]) auto
by auto

lemma nprv_exuF_exi:
assumes n1: "exu x \<phi> \<in> F" and n2: "nprv (insert \<phi> F) \<psi>"
and i[simp]: "F \<subseteq> fmla" "finite F" "\<phi> \<in> fmla" "x \<in> var" "\<psi> \<in> fmla" "x \<notin> Fvars \<psi>"
and u: "x \<notin> (\<Union>\<phi> \<in> F. Fvars \<phi>)"
shows "nprv F \<psi>"
using assms  nprv_exuE_exi nprv_hyp by metis

lemma prv_exu_uni:
assumes [simp]: "\<phi> \<in> fmla" "x \<in> var" "t1 \<in> trm" "t2 \<in> trm"
shows "prv (imp (exu x \<phi>) (imp (subst \<phi> t1 x) (imp (subst \<phi> t2 x) (eql t1 t2))))"
proof-
  define z where z: "z \<equiv> getFr [x] [t1,t2] [\<phi>]"
  have z_facts[simp]: "z \<in> var" "z \<noteq> x" "x \<noteq> z" "z \<notin> Fvars \<phi>"  "z \<notin> FvarsT t1" "z \<notin> FvarsT t2"
  using getFr_FvarsT_Fvars[of "[x]" "[t1,t2]" "[\<phi>]"] unfolding z by auto
  show ?thesis
  apply(rule nprv_prvI, auto)
  apply(rule nprv_impI, auto)
  apply(simp add: exu_def_var[of _ z])
  apply(rule nprv_cnjE0, auto)
  apply(rule nprv_clear3_1, auto)
  apply(rule nprv_clear2_2, auto)
  apply(rule nprv_exiE0, auto)
  apply(rule nprv_clear2_2, auto)
  apply(rule nprv_allE0[of _ _ _ t1], auto)
  apply(rule nprv_allE0[of _ _ _ t2], auto)
  apply(rule nprv_clear3_3, auto)
  apply(rule nprv_impI, auto)
  apply(rule nprv_impI, auto)
  apply(rule nprv_impE01, auto)
  apply(rule nprv_clear5_2, auto)
  apply(rule nprv_clear4_3, auto)
  apply(rule nprv_impE01, auto)
  apply(rule nprv_clear4_3, auto)
  apply(rule nprv_clear3_3, auto)
  apply(rule nprv_eql_symE0[of t2 "Var z"], auto)
  apply(rule nprv_eql_transE012, auto) .
qed

lemmas nprv_exuE_uni = nprv_addImp3LemmaE[OF prv_exu_uni,simped,rotated 4]
lemmas nprv_exuF_uni = nprv_exuE_uni[OF nprv_hyp,simped]

end \<comment> \<open>context @{locale Deduct_with_False_Disj}\<close>

section \<open>Eisbach Notation for Natural Deduction Proofs\<close>

text \<open>The proof pattern will be: On a goal of the form @{term "nprv F \<phi>"},
we apply a rule (usually an introduction, elimination, or cut/lemma-addition
rule), then discharge the side-conditions with @{method auto}, ending up with zero,
one or two goals of the same nprv-shape. This process is abstracted away in the
Eisbach nrule method:\<close>

method nrule uses r = (rule r, auto?)
(* For future developments, in case we refine what we do
(and also for documentation): This is supposed to create two main nprv-subgoals: *)
method nrule2 uses r = (rule r, auto?)

text \<open>Methods for chaining several nrule applications:\<close>

method nprover2 uses r1 r2 =
  (-,(((nrule r: r1)?, (nrule r: r2)?) ; fail))
method nprover3 uses r1 r2 r3 =
  (-,(((nrule r: r1)?, (nrule r: r2)?, (nrule r: r3)?) ; fail))
method nprover4 uses r1 r2 r3 r4 =
  (-,(((nrule r: r1)?, (nrule r: r2)?, (nrule r: r3)?, (nrule r: r4)?) ; fail))
method nprover5 uses r1 r2 r3 r4 r5 =
  (-,((nrule r: r1)?, (nrule r: r2)?, (nrule r: r3)?,
   (nrule r: r4)?, (nrule r: r5)?) ; fail)
method nprover6 uses r1 r2 r3 r4 r5 r6 =
  (-,((nrule r: r1)?, (nrule r: r2)?, (nrule r: r3)?,
   (nrule r: r4)?, (nrule r: r5)?, (nrule r: r6)?) ; fail)

(*<*)
end
(*>*)