section "Equality VS Proofs"
subsection "Linear Case"
theory LinearCase
  imports VSAlgos
begin

theorem var_not_in_linear :
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  shows "freeIn var (Atom (linear_substitution var b c A))"
proof(cases A)
  case (Less p) define d where "d = MPoly_Type.degree p var"
  then show ?thesis using Less apply simp unfolding d_def[symmetric]
    apply simp using not_in_sum
    using not_in_isovarspar assms  not_in_mult not_in_neg not_in_pow not_in_add
    by (metis (no_types, lifting))
next
  case (Eq p)
  define d where "d = MPoly_Type.degree p var"
  then show ?thesis using Eq apply simp unfolding d_def[symmetric]
    apply simp using not_in_sum
    using not_in_isovarspar assms  not_in_mult not_in_neg not_in_pow not_in_add
    by (metis (no_types, lifting))
next
  case (Leq p)
  define d where "d = MPoly_Type.degree p var"
  then show ?thesis using Leq apply simp unfolding d_def[symmetric]
    apply simp using not_in_sum
    using not_in_isovarspar assms  not_in_mult not_in_neg not_in_pow not_in_add
    by (metis (no_types, lifting))
next
  case (Neq p)
  define d where "d = MPoly_Type.degree p var"
  then show ?thesis using Neq apply simp unfolding d_def[symmetric]
    apply simp using not_in_sum
    using not_in_isovarspar assms  not_in_mult not_in_neg not_in_pow not_in_add
    by (metis (no_types, lifting))
qed

(* ----------------------------------------------------------------------------------------------- *)
lemma linear_eq :
  assumes lLength : "length L > var"
  assumes nonzero : "C \<noteq> 0"
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  assumes hb :  "insertion (nth_default 0 (list_update L var( B/C))) b = (B::real)"
  assumes hc : "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval (Eq(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Eq(p))) (list_update L var v))"
proof -
  define d where "d = MPoly_Type.degree p var"
  define f where "f i = (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i::real)" for i
  have h : "((\<Sum>i = 0..<d+1. f i / C ^ i) = 0) =((\<Sum>i = 0..<d+1. (f i) * C ^ (d - i)) = 0)"
    using normalize_summation nonzero by(auto)
  have "aEval (linear_substitution var b c (Eq(p))) (list_update L var (B/C)) =
    aEval (Eq(\<Sum>i = 0..<d+1. isolate_variable_sparse p var i * (b) ^ i * c ^ (d - i))) (list_update L var (B/C))"
    by (metis (no_types, lifting) d_def linear_substitution.simps(1) sum.cong)
  also have "... = ((\<Sum>i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i * C ^ (d - i)) = 0)"
    using assms by(simp add: insertion_sum insertion_mult insertion_add insertion_pow insertion_neg lLength)
  also have "... = ((\<Sum>i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i/ (C ^ i)) = 0)"
    using h by(simp add: f_def)
  also have "... = ((\<Sum>i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * ((B/C) ^ i)) = 0)"
    by (metis (no_types, lifting) power_divide sum.cong times_divide_eq_right)
  also have "... = aEval (Eq(p :: real mpoly)) (list_update L var (B/C))"
    using sum_over_degree_insertion d_def lLength by auto
  finally show ?thesis using assms plugInLinear var_not_in_linear var_not_in_eval
    by (meson var_not_in_aEval)
qed

(* -------------------------------------------------------------------------------------------- *)

lemma linear_less :
  assumes lLength : "length L > var"
  assumes nonzero : "C \<noteq> 0"
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval (Less(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Less(p))) (list_update L var v))"
proof-
  define d where "d = MPoly_Type.degree p var"
  define f where "f i = (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i::real)" for i
  have h : "(\<Sum>i = 0..<(d+1). (f i) * C ^ (d - i)) * C ^ (d mod 2) < 0  \<longleftrightarrow> (\<Sum>i = 0..<((d::nat)+1). (f i::real) / (C ^ i)) < 0"
    using nonzero normalize_summation_less by auto
  have "aEval (linear_substitution var b c (Less(p))) (list_update L var (B/C))=aEval (Less((\<Sum>i\<in>{0..<(d+1)}. isolate_variable_sparse p var i * (b^i) * (c^(d-i))) * (c ^ (d mod 2)))) (list_update L var (B/C))"
    by (metis (no_types, lifting) d_def linear_substitution.simps(2) sum.cong)
  also have "... = ((\<Sum>i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i * C ^ (d - i)) * C ^ (d mod 2) < 0)"
    using assms by(simp add: insertion_sum insertion_mult insertion_add insertion_pow insertion_neg lLength)
  also have "... = ((\<Sum>i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (((B) ^ i) / (C ^ i))) < 0)"
    using f_def h by auto
  also have "... = ((\<Sum>i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B/C)^i) < 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have "... = aEval (Less(p)) (list_update L var (B/C))"
    using d_def sum_over_degree_insertion lLength by auto
  finally show ?thesis using assms plugInLinear var_not_in_linear var_not_in_eval
    by (meson var_not_in_aEval)
qed

(* -------------------------------------------------------------------------------------------- *)

lemma linear_leq :
  assumes lLength : "length L > var"
  assumes nonzero : "C \<noteq> 0"
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval (Leq(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Leq(p))) (list_update L var v))"
proof -
  define d where "d = MPoly_Type.degree p var"
  define f where "f i = (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i::real)" for i
  have h1a : "((\<Sum>i = 0..<(d+1). (f i) * C ^ (d - i)) * C ^ (d mod 2) < 0 ) = ((\<Sum>i = 0..<((d::nat)+1). (f i::real) / (C ^ i)) < 0)"
    using nonzero normalize_summation_less by auto
  have "((\<Sum>i = 0..<d+1. f i / C ^ i) = 0) =((\<Sum>i = 0..<d+1. (f i) * C ^ (d - i)) = 0)"
    using normalize_summation nonzero by(auto)
  also have "... =((\<Sum>i = 0..<d+1. (f i) * C ^ (d - i))* C ^ (d mod 2) = 0)"
    using mult_eq_0_iff nonzero power_not_zero by blast
  finally have h1 : "((\<Sum>i = 0..<(d+1). (f i) * C ^ (d - i)) * C ^ (d mod 2) \<le> 0 ) = ((\<Sum>i = 0..<((d::nat)+1). (f i::real) / (C ^ i)) \<le> 0)"
    using h1a by smt
  have "aEval (linear_substitution var b c (Leq(p))) (list_update L var (B/C))=aEval (Leq((\<Sum>i\<in>{0..<(d+1)}. isolate_variable_sparse p var i * (b^i) * (c^(d-i))) * (c ^ (d mod 2)))) (list_update L var (B/C))"
    by (metis (no_types, lifting) d_def linear_substitution.simps(3) sum.cong)
  also have "... = ((\<Sum>i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i * C ^ (d - i)) * C ^ (d mod 2) \<le> 0)"
    using assms by(simp add: insertion_sum insertion_mult insertion_add insertion_pow insertion_neg lLength)
  also have"...= ((\<Sum>i = 0..<(d+1). (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i) / (C ^ i)) \<le> 0)"
    using h1 f_def by auto
  also have "... = ((\<Sum>i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (((B) ^ i) / (C ^ i))) \<le> 0)"
    by auto
  also have "... = ((\<Sum>i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B/C)^i) \<le> 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have  "... = aEval (Leq(p)) (list_update L var (B/C))"
    using d_def sum_over_degree_insertion lLength by auto
  finally show ?thesis using assms plugInLinear var_not_in_eval var_not_in_linear
    by (meson var_not_in_aEval)
qed
  (* ----------------------------------------------------------------------------------------------- *)

lemma linear_neq :
  assumes lLength : "length L > var"
  assumes nonzero : "C \<noteq> 0"
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval (Neq(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Neq(p))) (list_update L var v))"
proof -
  define d where "d = MPoly_Type.degree p var"
  have "aEval (Eq(p)) (list_update L var (B/C)) = (\<forall>v. aEval (linear_substitution var b c (Eq(p))) (list_update L var v))"
    using linear_eq assms by auto
  also have "... = (\<forall>v. eval (Atom (Eq ((\<Sum>i = 0..<d+1. isolate_variable_sparse p var i * (b) ^ i * c ^ (d - i))))) (list_update L var v))"
    by (metis (no_types, lifting) d_def eval.simps(1) linear_substitution.simps(1) sum.cong)
  also have "... = (\<not>(\<forall>v. eval (Atom (Neq ((\<Sum>i = 0..<d+1. isolate_variable_sparse p var i * (b) ^ i * c ^ (d - i))))) (list_update L var v)))"
    by (metis (no_types, lifting) aEval.simps(1) aEval.simps(4) eval.simps(1) assms(3) assms(4) not_contains_insertion not_in_isovarspar not_in_mult not_in_pow not_in_sum)
  also have "... = (\<not>(\<forall>v. aEval (linear_substitution var b c (Neq(p))) (list_update L var v)))"
    by (metis (full_types) d_def eval.simps(1) linear_substitution.simps(4))
  finally have "... = (\<not>(aEval (Neq(p)) (list_update L var (B/C))))" by simp
  then show ?thesis
    using assms(3) assms(4) var_not_in_aEval var_not_in_linear by blast
qed

(* -------------------------------------------------------------------------------------------- *)

theorem linear :
  assumes lLength : "length L > var"
  assumes "C \<noteq> 0"
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval A (list_update L var (B/C))  = (aEval (linear_substitution var b c A) (list_update L var v))"
  apply(cases A) using linear_less[OF assms(1-6)] linear_eq[OF assms(1-6)] linear_leq[OF assms(1-6)] linear_neq[OF assms(1-6)] by auto

lemma var_not_in_linear_fm_helper :
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  shows "freeIn (var+z) (linear_substitution_fm_helper var b c F z)"
proof(induction F arbitrary: z)
  case TrueF
  then show ?case by(simp)
next
  case FalseF
  then show ?case by simp
next
  case (Atom x)
  show ?case unfolding linear_substitution_fm_helper.simps liftmap.simps
    using var_not_in_linear[OF not_in_lift[OF assms(1)] not_in_lift[OF assms(2)], of z] by blast
next
  case (And F1 F2)
  then show ?case by simp
next
  case (Or F1 F2)
  then show ?case by simp
next
  case (Neg F)
  then show ?case by simp
next
  case (ExQ F)
  show ?case using ExQ[of "z+1"] by simp
next
  case (AllQ F)
  show ?case using AllQ[of "z+1"] by simp
next
  case (ExN x1 \<phi>)
  then show ?case
    by (metis (no_types, lifting) freeIn.simps(13) group_cancel.add1 liftmap.simps(10) linear_substitution_fm_helper.simps)
next
  case (AllN x1 \<phi>)
  then show ?case
    by (metis (no_types, lifting) freeIn.simps(12) group_cancel.add1 liftmap.simps(9) linear_substitution_fm_helper.simps)
qed

theorem var_not_in_linear_fm :
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  shows "freeIn var (linear_substitution_fm var b c F)"
  using var_not_in_linear_fm_helper[OF assms, of 0] by auto

lemma linear_fm_helper :
  assumes "C \<noteq> 0"
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  assumes "insertion (nth_default 0 (list_update (drop z L) var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update (drop z L) var (B/C))) c = (C::real)"
  assumes lLength : "length L > var+z"
  shows "eval F (list_update L (var+z) (B/C))  = (eval (linear_substitution_fm_helper var b c F z) (list_update L (var+z) v))"
  using assms proof(induction F arbitrary:z L)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom x)
  define L1 where "L1 = drop z L"
  define L2 where "L2 = take z L"
  have L_def : "L = L2 @ L1" using L1_def L2_def by auto
  have h1a : "insertion (nth_default 0 L1) b = B"
    using not_contains_insertion[OF Atom(2), of L1 "B/C" B] Atom(4) unfolding L1_def nth_default_def
    by (metis list_update_id)
  have lengthl2 : "length L2 = z" using L2_def
    using Atom.prems(6) min.absorb2 by auto
  have "(\<forall>I amount.
         length I = amount \<longrightarrow>
         (\<forall>xs. eval (fm.Atom (Eq (b - Const B))) ([] @ xs) =
               eval (liftFm 0 amount (fm.Atom (Eq (b - Const B)))) ([] @ I @ xs)))"
    by (metis eval_liftFm_helper list.size(3))
  then have "eval (Atom(Eq (b-Const B))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (b- Const B)))) ([] @ L2 @ L1)"
    using lengthl2 by auto
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (b - Const B)) = 0)"
    apply(simp add: insertion_sub insertion_const) using h1a by auto
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z b) = B"
    using lift_minus by blast
  then have h1 : "insertion (nth_default 0 (L[var + z := B/C])) (liftPoly 0 z b) = B"
    using not_in_lift[OF Atom(2), of z] L_def
    by (metis list_update_id not_contains_insertion)
  have h2a : "insertion (nth_default 0 L1) c = C"
    using not_contains_insertion[OF Atom(3), of L1 "B/C" C] Atom(5) unfolding L1_def
    by (metis list_update_id)
  have "(\<forall>I amount.
         length I = amount \<longrightarrow>
         (\<forall>xs. eval (fm.Atom (Eq (c - Const C))) ([] @ xs) =
               eval (liftFm 0 amount (fm.Atom (Eq (c - Const C)))) ([] @ I @ xs)))"
    by (metis eval_liftFm_helper list.size(3))
  then have "eval (Atom(Eq (c-Const C))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (c- Const C)))) ([] @ L2 @ L1)"
    using lengthl2 by auto
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (c - Const C)) = 0)"
    apply(simp add: insertion_sub insertion_const) using h2a by auto
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = C"
    using lift_minus by blast
  then have h2 : "insertion (nth_default 0 (L[var + z := B/C])) (liftPoly 0 z c) = C"
    using not_in_lift[OF Atom(3), of z] L_def
    by (metis list_update_id not_contains_insertion)
  show ?case using linear[OF Atom(6) Atom(1) not_in_lift[OF Atom(2)] not_in_lift[OF Atom(3)], of B, of x, OF h1 h2] unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps
    .
next
  case (And F1 F2)
  then show ?case by auto
next
  case (Or F1 F2)
  then show ?case using var_not_in_linear_fm_helper var_not_in_eval unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps
    by blast
next
  case (Neg F)
  then show ?case using var_not_in_linear_fm_helper var_not_in_eval  unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps
    by blast
next
  case (ExQ F)
  have droph : "(drop (z + 1) (x#L)) = (drop z L)" for x by auto
  have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v
    by auto
  have "eval (ExQ F) (L[var + z := B/C]) =
        (\<exists>x. eval F ((x # L)[var + (z + 1) := B/C])) "
    apply(simp) unfolding l done

  also have "... = (\<exists>x. eval
              (liftmap (\<lambda>x. \<lambda>a. Atom(linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) a)) F (z + 1))
              ((x # L)[var + (z + 1) := v]))"
    apply(rule ex_cong1)
    using ExQ(1)[of "z+1", OF assms(1) assms(2) assms(3)] droph
    unfolding linear_substitution_fm_helper.simps liftmap.simps
    by (metis (mono_tags, lifting) ExQ.prems(4) ExQ.prems(5) ExQ.prems(6) One_nat_def Suc_eq_plus1 Suc_less_eq add_Suc_right list.size(4))
  also have "... = (eval (linear_substitution_fm_helper var b c (ExQ F) z) (L[var + z := v]))"
    unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps l by simp
  finally show ?case by simp
next
  case (AllQ F)
  have droph : "(drop (z + 1) (x#L)) = (drop z L)" for x by auto
  have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v
    by auto
  have "eval (AllQ F) (L[var + z := B/C]) =
        (\<forall>x. eval F ((x # L)[var + (z + 1) := B/C])) "
    apply(simp) unfolding l done
  also have "... = (\<forall>x. eval
             (liftmap (\<lambda>x.\<lambda>a. Atom(linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) a)) F (z + 1))
              ((x # L)[var + (z + 1) := v]))"
    apply(rule all_cong1)
    using AllQ(1)[of "z+1", OF assms(1) assms(2) assms(3)]
      var_not_in_linear_fm_helper[OF assms(2) assms(3)] var_not_in_eval droph
    unfolding linear_substitution_fm_helper.simps liftmap.simps
    by (metis (mono_tags, lifting) AllQ(7) AllQ.prems(4) AllQ.prems(5) One_nat_def Suc_eq_plus1 Suc_less_eq add_Suc_right list.size(4))
  also have "... = (eval (linear_substitution_fm_helper var b c (AllQ F) z) (L[var + z := v]))"
    unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps l by auto
  finally show ?case by simp
next
  case (ExN x1 \<phi>)
  have list : "\<And>l. length l=x1 \<Longrightarrow> ((drop (z + x1) l @ drop (z + x1 - length l) L)[var := B / C]) = ((drop z L)[var := B / C])"
    by auto
  have map : "\<And> z L. eval (liftmap (\<lambda>x A. fm.Atom (linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) A)) \<phi> (z + x1))
      L = eval (liftmap (\<lambda>x A. fm.Atom (linear_substitution (var + x1 + x) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) A)) \<phi> z)
      L"
    apply(induction \<phi>) apply(simp_all add:add.commute add.left_commute)
    apply force
    apply force
    by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+
  show ?case
    apply simp apply(rule ex_cong1)
    subgoal for l
      using map[of z] ExN(1)[OF ExN(2-4), of "z+x1" "l@L"] ExN(5-7) list
      apply simp
      by (smt (z3) add.commute add.left_commute add_diff_cancel_left' add_mono_thms_linordered_field(4) list list_update_append not_add_less1 order_refl)
    done
next
  case (AllN x1 \<phi>)
  have list : "\<And>l. length l=x1 \<Longrightarrow> ((drop (z + x1) l @ drop (z + x1 - length l) L)[var := B / C]) = ((drop z L)[var := B / C])"
    by auto
  have map : "\<And> z L. eval (liftmap (\<lambda>x A. fm.Atom (linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) A)) \<phi> (z + x1))
      L = eval (liftmap (\<lambda>x A. fm.Atom (linear_substitution (var + x1 + x) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) A)) \<phi> z)
      L"
    apply(induction \<phi>) apply(simp_all add:add.commute add.left_commute)
    apply force
    apply force
    by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+
  show ?case
    apply simp apply(rule all_cong1)
    subgoal for l
      using map[of z] AllN(1)[OF AllN(2-4), of "z+x1" "l@L"] AllN(5-7) list
      apply simp
      by (smt (z3) add.commute add.left_commute add_diff_cancel_left' add_mono_thms_linordered_field(4) list list_update_append not_add_less1 order_refl)
    done
qed

theorem linear_fm :
  assumes lLength : "length L > var"
  assumes "C \<noteq> 0"
  assumes "var \<notin> vars b"
  assumes "var \<notin> vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "eval F (list_update L var (B/C))  = (\<forall>v. eval (linear_substitution_fm var b c F) (list_update L var v))"
  unfolding linear_substitution_fm.simps using linear_fm_helper[OF assms(2) assms(3) assms(4), of 0 L B] assms(1) assms(5) assms(6)
  by (simp add: lLength)
end


(*  Title:      ZF/Induct/FoldSet.thy
    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory

A "fold" functional for finite sets.  For n non-negative we have
fold f e {x1,...,xn} = f x1 (... (f xn e)) where f is at
least left-commutative.
*)

theory FoldSet imports Main begin

consts fold_set :: "[i, i, [i,i]=>i, i] => i"

inductive
  domains "fold_set(A, B, f,e)" \<subseteq> "Fin(A)*B"
  intros
    emptyI: "e\<in>B ==> <0, e>\<in>fold_set(A, B, f,e)"
    consI:  "[| x\<in>A; x \<notin>C;  <C,y> \<in> fold_set(A, B,f,e); f(x,y):B |]
                ==>  <cons(x,C), f(x,y)>\<in>fold_set(A, B, f, e)"
  type_intros Fin.intros

definition
  fold :: "[i, [i,i]=>i, i, i] => i"  ("fold[_]'(_,_,_')")  where
   "fold[B](f,e, A) == THE x. <A, x>\<in>fold_set(A, B, f,e)"

definition
   setsum :: "[i=>i, i] => i"  where
   "setsum(g, C) == if Finite(C) then
                     fold[int](%x y. g(x) $+ y, #0, C) else #0"

(** foldSet **)

inductive_cases empty_fold_setE: "<0, x> \<in> fold_set(A, B, f,e)"
inductive_cases cons_fold_setE: "<cons(x,C), y> \<in> fold_set(A, B, f,e)"

(* add-hoc lemmas *)

lemma cons_lemma1: "[| x\<notin>C; x\<notin>B |] ==> cons(x,B)=cons(x,C) \<longleftrightarrow> B = C"
by (auto elim: equalityE)

lemma cons_lemma2: "[| cons(x, B)=cons(y, C); x\<noteq>y; x\<notin>B; y\<notin>C |]
    ==>  B - {y} = C-{x} & x\<in>C & y\<in>B"
apply (auto elim: equalityE)
done

(* fold_set monotonicity *)
lemma fold_set_mono_lemma:
     "<C, x> \<in> fold_set(A, B, f, e)
      ==> \<forall>D. A<=D \<longrightarrow> <C, x> \<in> fold_set(D, B, f, e)"
apply (erule fold_set.induct)
apply (auto intro: fold_set.intros)
done

lemma fold_set_mono: " C<=A ==> fold_set(C, B, f, e) \<subseteq> fold_set(A, B, f, e)"
apply clarify
apply (frule fold_set.dom_subset [THEN subsetD], clarify)
apply (auto dest: fold_set_mono_lemma)
done

lemma fold_set_lemma:
     "<C, x>\<in>fold_set(A, B, f, e) ==> <C, x>\<in>fold_set(C, B, f, e) & C<=A"
apply (erule fold_set.induct)
apply (auto intro!: fold_set.intros intro: fold_set_mono [THEN subsetD])
done

(* Proving that fold_set is deterministic *)
lemma Diff1_fold_set:
     "[| <C-{x},y> \<in> fold_set(A, B, f,e);  x\<in>C; x\<in>A; f(x, y):B |]
      ==> <C, f(x, y)> \<in> fold_set(A, B, f, e)"
apply (frule fold_set.dom_subset [THEN subsetD])
apply (erule cons_Diff [THEN subst], rule fold_set.intros, auto)
done

locale fold_typing =
 fixes A and B and e and f
 assumes ftype [intro,simp]:  "[|x \<in> A; y \<in> B|] ==> f(x,y) \<in> B"
     and etype [intro,simp]:  "e \<in> B"
     and fcomm:  "[|x \<in> A; y \<in> A; z \<in> B|] ==> f(x, f(y, z))=f(y, f(x, z))"

lemma (in fold_typing) Fin_imp_fold_set:
     "C\<in>Fin(A) ==> (\<exists>x. <C, x> \<in> fold_set(A, B, f,e))"
apply (erule Fin_induct)
apply (auto dest: fold_set.dom_subset [THEN subsetD]
            intro: fold_set.intros etype ftype)
done

lemma Diff_sing_imp:
     "[|C - {b} = D - {a}; a \<noteq> b; b \<in> C|] ==> C = cons(b,D) - {a}"
by (blast elim: equalityE)

lemma (in fold_typing) fold_set_determ_lemma [rule_format]:
"n\<in>nat
 ==> \<forall>C. |C|<n \<longrightarrow>
   (\<forall>x. <C, x> \<in> fold_set(A, B, f,e)\<longrightarrow>
           (\<forall>y. <C, y> \<in> fold_set(A, B, f,e) \<longrightarrow> y=x))"
apply (erule nat_induct)
 apply (auto simp add: le_iff)
apply (erule fold_set.cases)
 apply (force elim!: empty_fold_setE)
apply (erule fold_set.cases)
 apply (force elim!: empty_fold_setE, clarify)
(*force simplification of "|C| < |cons(...)|"*)
apply (frule_tac a = Ca in fold_set.dom_subset [THEN subsetD, THEN SigmaD1])
apply (frule_tac a = Cb in fold_set.dom_subset [THEN subsetD, THEN SigmaD1])
apply (simp add: Fin_into_Finite [THEN Finite_imp_cardinal_cons])
apply (case_tac "x=xb", auto)
apply (simp add: cons_lemma1, blast)
txt\<open>case @{term "x\<noteq>xb"}\<close>
apply (drule cons_lemma2, safe)
apply (frule Diff_sing_imp, assumption+)
txt\<open>* LEVEL 17\<close>
apply (subgoal_tac "|Ca| \<le> |Cb|")
 prefer 2
 apply (rule succ_le_imp_le)
 apply (simp add: Fin_into_Finite Finite_imp_succ_cardinal_Diff
                  Fin_into_Finite [THEN Finite_imp_cardinal_cons])
apply (rule_tac C1 = "Ca-{xb}" in Fin_imp_fold_set [THEN exE])
 apply (blast intro: Diff_subset [THEN Fin_subset])
txt\<open>* LEVEL 24 *\<close>
apply (frule Diff1_fold_set, blast, blast)
apply (blast dest!: ftype fold_set.dom_subset [THEN subsetD])
apply (subgoal_tac "ya = f(xb,xa) ")
 prefer 2 apply (blast del: equalityCE)
apply (subgoal_tac "<Cb-{x}, xa> \<in> fold_set(A,B,f,e)")
 prefer 2 apply simp
apply (subgoal_tac "yb = f (x, xa) ")
 apply (drule_tac [2] C = Cb in Diff1_fold_set, simp_all)
  apply (blast intro: fcomm dest!: fold_set.dom_subset [THEN subsetD])
 apply (blast intro: ftype dest!: fold_set.dom_subset [THEN subsetD], blast)
done

lemma (in fold_typing) fold_set_determ:
     "[| <C, x>\<in>fold_set(A, B, f, e);
         <C, y>\<in>fold_set(A, B, f, e)|] ==> y=x"
apply (frule fold_set.dom_subset [THEN subsetD], clarify)
apply (drule Fin_into_Finite)
apply (unfold Finite_def, clarify)
apply (rule_tac n = "succ (n)" in fold_set_determ_lemma)
apply (auto intro: eqpoll_imp_lepoll [THEN lepoll_cardinal_le])
done

(** The fold function **)

lemma (in fold_typing) fold_equality:
     "<C,y> \<in> fold_set(A,B,f,e) ==> fold[B](f,e,C) = y"
apply (unfold fold_def)
apply (frule fold_set.dom_subset [THEN subsetD], clarify)
apply (rule the_equality)
 apply (rule_tac [2] A=C in fold_typing.fold_set_determ)
apply (force dest: fold_set_lemma)
apply (auto dest: fold_set_lemma)
apply (simp add: fold_typing_def, auto)
apply (auto dest: fold_set_lemma intro: ftype etype fcomm)
done

lemma fold_0 [simp]: "e \<in> B ==> fold[B](f,e,0) = e"
apply (unfold fold_def)
apply (blast elim!: empty_fold_setE intro: fold_set.intros)
done

text\<open>This result is the right-to-left direction of the subsequent result\<close>
lemma (in fold_typing) fold_set_imp_cons:
     "[| <C, y> \<in> fold_set(C, B, f, e); C \<in> Fin(A); c \<in> A; c\<notin>C |]
      ==> <cons(c, C), f(c,y)> \<in> fold_set(cons(c, C), B, f, e)"
apply (frule FinD [THEN fold_set_mono, THEN subsetD])
 apply assumption
apply (frule fold_set.dom_subset [of A, THEN subsetD])
apply (blast intro!: fold_set.consI intro: fold_set_mono [THEN subsetD])
done

lemma (in fold_typing) fold_cons_lemma [rule_format]:
"[| C \<in> Fin(A); c \<in> A; c\<notin>C |]
     ==> <cons(c, C), v> \<in> fold_set(cons(c, C), B, f, e) \<longleftrightarrow>
         (\<exists>y. <C, y> \<in> fold_set(C, B, f, e) & v = f(c, y))"
apply auto
 prefer 2 apply (blast intro: fold_set_imp_cons)
 apply (frule_tac Fin.consI [of c, THEN FinD, THEN fold_set_mono, THEN subsetD], assumption+)
apply (frule_tac fold_set.dom_subset [of A, THEN subsetD])
apply (drule FinD)
apply (rule_tac A1 = "cons(c,C)" and f1=f and B1=B and C1=C and e1=e in fold_typing.Fin_imp_fold_set [THEN exE])
apply (blast intro: fold_typing.intro ftype etype fcomm)
apply (blast intro: Fin_subset [of _ "cons(c,C)"] Finite_into_Fin
             dest: Fin_into_Finite)
apply (rule_tac x = x in exI)
apply (auto intro: fold_set.intros)
apply (drule_tac fold_set_lemma [of C], blast)
apply (blast intro!: fold_set.consI
             intro: fold_set_determ fold_set_mono [THEN subsetD]
             dest: fold_set.dom_subset [THEN subsetD])
done

lemma (in fold_typing) fold_cons:
     "[| C\<in>Fin(A); c\<in>A; c\<notin>C|]
      ==> fold[B](f, e, cons(c, C)) = f(c, fold[B](f, e, C))"
apply (unfold fold_def)
apply (simp add: fold_cons_lemma)
apply (rule the_equality, auto)
 apply (subgoal_tac [2] "\<langle>C, y\<rangle> \<in> fold_set(A, B, f, e)")
  apply (drule Fin_imp_fold_set)
apply (auto dest: fold_set_lemma  simp add: fold_def [symmetric] fold_equality)
apply (blast intro: fold_set_mono [THEN subsetD] dest!: FinD)
done

lemma (in fold_typing) fold_type [simp,TC]:
     "C\<in>Fin(A) ==> fold[B](f,e,C):B"
apply (erule Fin_induct)
apply (simp_all add: fold_cons ftype etype)
done

lemma (in fold_typing) fold_commute [rule_format]:
     "[| C\<in>Fin(A); c\<in>A |]
      ==> (\<forall>y\<in>B. f(c, fold[B](f, y, C)) = fold[B](f, f(c, y), C))"
apply (erule Fin_induct)
apply (simp_all add: fold_typing.fold_cons [of A B _ f]
                     fold_typing.fold_type [of A B _ f]
                     fold_typing_def fcomm)
done

lemma (in fold_typing) fold_nest_Un_Int:
     "[| C\<in>Fin(A); D\<in>Fin(A) |]
      ==> fold[B](f, fold[B](f, e, D), C) =
          fold[B](f, fold[B](f, e, (C \<inter> D)), C \<union> D)"
apply (erule Fin_induct, auto)
apply (simp add: Un_cons Int_cons_left fold_type fold_commute
                 fold_typing.fold_cons [of A _ _ f]
                 fold_typing_def fcomm cons_absorb)
done

lemma (in fold_typing) fold_nest_Un_disjoint:
     "[| C\<in>Fin(A); D\<in>Fin(A); C \<inter> D = 0 |]
      ==> fold[B](f,e,C \<union> D) =  fold[B](f, fold[B](f,e,D), C)"
by (simp add: fold_nest_Un_Int)

lemma Finite_cons_lemma: "Finite(C) ==> C\<in>Fin(cons(c, C))"
apply (drule Finite_into_Fin)
apply (blast intro: Fin_mono [THEN subsetD])
done

subsection\<open>The Operator @{term setsum}\<close>

lemma setsum_0 [simp]: "setsum(g, 0) = #0"
by (simp add: setsum_def)

lemma setsum_cons [simp]:
     "Finite(C) ==>
      setsum(g, cons(c,C)) =
        (if c \<in> C then setsum(g,C) else g(c) $+ setsum(g,C))"
apply (auto simp add: setsum_def Finite_cons cons_absorb)
apply (rule_tac A = "cons (c, C)" in fold_typing.fold_cons)
apply (auto intro: fold_typing.intro Finite_cons_lemma)
done

lemma setsum_K0: "setsum((%i. #0), C) = #0"
apply (case_tac "Finite (C) ")
 prefer 2 apply (simp add: setsum_def)
apply (erule Finite_induct, auto)
done

(*The reversed orientation looks more natural, but LOOPS as a simprule!*)
lemma setsum_Un_Int:
     "[| Finite(C); Finite(D) |]
      ==> setsum(g, C \<union> D) $+ setsum(g, C \<inter> D)
        = setsum(g, C) $+ setsum(g, D)"
apply (erule Finite_induct)
apply (simp_all add: Int_cons_right cons_absorb Un_cons Int_commute Finite_Un
                     Int_lower1 [THEN subset_Finite])
done

lemma setsum_type [simp,TC]: "setsum(g, C):int"
apply (case_tac "Finite (C) ")
 prefer 2 apply (simp add: setsum_def)
apply (erule Finite_induct, auto)
done

lemma setsum_Un_disjoint:
     "[| Finite(C); Finite(D); C \<inter> D = 0 |]
      ==> setsum(g, C \<union> D) = setsum(g, C) $+ setsum(g,D)"
apply (subst setsum_Un_Int [symmetric])
apply (subgoal_tac [3] "Finite (C \<union> D) ")
apply (auto intro: Finite_Un)
done

lemma Finite_RepFun [rule_format (no_asm)]:
     "Finite(I) ==> (\<forall>i\<in>I. Finite(C(i))) \<longrightarrow> Finite(RepFun(I, C))"
apply (erule Finite_induct, auto)
done

lemma setsum_UN_disjoint [rule_format (no_asm)]:
     "Finite(I)
      ==> (\<forall>i\<in>I. Finite(C(i))) \<longrightarrow>
          (\<forall>i\<in>I. \<forall>j\<in>I. i\<noteq>j \<longrightarrow> C(i) \<inter> C(j) = 0) \<longrightarrow>
          setsum(f, \<Union>i\<in>I. C(i)) = setsum (%i. setsum(f, C(i)), I)"
apply (erule Finite_induct, auto)
apply (subgoal_tac "\<forall>i\<in>B. x \<noteq> i")
 prefer 2 apply blast
apply (subgoal_tac "C (x) \<inter> (\<Union>i\<in>B. C (i)) = 0")
 prefer 2 apply blast
apply (subgoal_tac "Finite (\<Union>i\<in>B. C (i)) & Finite (C (x)) & Finite (B) ")
apply (simp (no_asm_simp) add: setsum_Un_disjoint)
apply (auto intro: Finite_Union Finite_RepFun)
done

lemma setsum_addf: "setsum(%x. f(x) $+ g(x),C) = setsum(f, C) $+ setsum(g, C)"
apply (case_tac "Finite (C) ")
 prefer 2 apply (simp add: setsum_def)
apply (erule Finite_induct, auto)
done

lemma fold_set_cong:
     "[| A=A'; B=B'; e=e'; (\<forall>x\<in>A'. \<forall>y\<in>B'. f(x,y) = f'(x,y)) |]
      ==> fold_set(A,B,f,e) = fold_set(A',B',f',e')"
apply (simp add: fold_set_def)
apply (intro refl iff_refl lfp_cong Collect_cong disj_cong ex_cong, auto)
done

lemma fold_cong:
"[| B=B'; A=A'; e=e';
    !!x y. [|x\<in>A'; y\<in>B'|] ==> f(x,y) = f'(x,y) |] ==>
   fold[B](f,e,A) = fold[B'](f', e', A')"
apply (simp add: fold_def)
apply (subst fold_set_cong)
apply (rule_tac [5] refl, simp_all)
done

lemma setsum_cong:
 "[| A=B; !!x. x\<in>B ==> f(x) = g(x) |] ==>
     setsum(f, A) = setsum(g, B)"
by (simp add: setsum_def cong add: fold_cong)

lemma setsum_Un:
     "[| Finite(A); Finite(B) |]
      ==> setsum(f, A \<union> B) =
          setsum(f, A) $+ setsum(f, B) $- setsum(f, A \<inter> B)"
apply (subst setsum_Un_Int [symmetric], auto)
done

lemma setsum_zneg_or_0 [rule_format (no_asm)]:
     "Finite(A) ==> (\<forall>x\<in>A. g(x) $\<le> #0) \<longrightarrow> setsum(g, A) $\<le> #0"
apply (erule Finite_induct)
apply (auto intro: zneg_or_0_add_zneg_or_0_imp_zneg_or_0)
done

lemma setsum_succD_lemma [rule_format]:
     "Finite(A)
      ==> \<forall>n\<in>nat. setsum(f,A) = $# succ(n) \<longrightarrow> (\<exists>a\<in>A. #0 $< f(a))"
apply (erule Finite_induct)
apply (auto simp del: int_of_0 int_of_succ simp add: not_zless_iff_zle int_of_0 [symmetric])
apply (subgoal_tac "setsum (f, B) $\<le> #0")
apply simp_all
prefer 2 apply (blast intro: setsum_zneg_or_0)
apply (subgoal_tac "$# 1 $\<le> f (x) $+ setsum (f, B) ")
apply (drule zdiff_zle_iff [THEN iffD2])
apply (subgoal_tac "$# 1 $\<le> $# 1 $- setsum (f,B) ")
apply (drule_tac x = "$# 1" in zle_trans)
apply (rule_tac [2] j = "#1" in zless_zle_trans, auto)
done

lemma setsum_succD:
     "[| setsum(f, A) = $# succ(n); n\<in>nat |]==> \<exists>a\<in>A. #0 $< f(a)"
apply (case_tac "Finite (A) ")
apply (blast intro: setsum_succD_lemma)
apply (unfold setsum_def)
apply (auto simp del: int_of_0 int_of_succ simp add: int_succ_int_1 [symmetric] int_of_0 [symmetric])
done

lemma g_zpos_imp_setsum_zpos [rule_format]:
     "Finite(A) ==> (\<forall>x\<in>A. #0 $\<le> g(x)) \<longrightarrow> #0 $\<le> setsum(g, A)"
apply (erule Finite_induct)
apply (simp (no_asm))
apply (auto intro: zpos_add_zpos_imp_zpos)
done

lemma g_zpos_imp_setsum_zpos2 [rule_format]:
     "[| Finite(A); \<forall>x. #0 $\<le> g(x) |] ==> #0 $\<le> setsum(g, A)"
apply (erule Finite_induct)
apply (auto intro: zpos_add_zpos_imp_zpos)
done

lemma g_zspos_imp_setsum_zspos [rule_format]:
     "Finite(A)
      ==> (\<forall>x\<in>A. #0 $< g(x)) \<longrightarrow> A \<noteq> 0 \<longrightarrow> (#0 $< setsum(g, A))"
apply (erule Finite_induct)
apply (auto intro: zspos_add_zspos_imp_zspos)
done

lemma setsum_Diff [rule_format]:
     "Finite(A) ==> \<forall>a. M(a) = #0 \<longrightarrow> setsum(M, A) = setsum(M, A-{a})"
apply (erule Finite_induct)
apply (simp_all add: Diff_cons_eq Finite_Diff)
done

end


theory T184
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(x, join(y, z)) = join(undr(x, y), undr(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(x, meet(y, z)) = join(over(x, y), over(x, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


(* Property from Case-Analysis for Rippling and Inductive Proof,
   Moa Johansson, Lucas Dixon and Alan Bundy, ITP 2010.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_prop_23
  imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun max :: "Nat => Nat => Nat" where
  "max (Z) y = y"
| "max (S z) (Z) = S z"
| "max (S z) (S x2) = S (max z x2)"

theorem property0 :
  "((max a b) = (max b a))"
  oops
end


theory prop_19
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun minus :: "Nat => Nat => Nat" where
  "minus (Z) y = Z"
  | "minus (S z) (Z) = S z"
  | "minus (S z) (S x2) = minus z x2"
  fun len :: "'a list => Nat" where
  "len (Nil2) = Z"
  | "len (Cons2 y xs) = S (len xs)"
  fun drop :: "Nat => 'a list => 'a list" where
  "drop (Z) y = y"
  | "drop (S z) (Nil2) = Nil2"
  | "drop (S z) (Cons2 x2 x3) = drop z x3"
  (*hipster minus len drop *)
(*hipster minus*)
lemma lemma_a [thy_expl]: "minus x2 x2 = Z"
by (hipster_induct_schemes minus.simps)

lemma lemma_aa [thy_expl]: "minus x3 Z = x3"
by (hipster_induct_schemes minus.simps)

lemma lemma_ab [thy_expl]: "minus x2 (S x2) = Z"
by (hipster_induct_schemes)

lemma lemma_ac [thy_expl]: "minus (S x2) x2 = S Z"
by (hipster_induct_schemes)

lemma lemma_ad [thy_expl]: "minus (minus x3 y3) (minus y3 x3) =
minus x3 y3"
by (hipster_induct_schemes minus.simps)

lemma lemma_ae [thy_expl]: "minus (minus x3 y3) (S Z) = minus x3 (S y3)"
by (hipster_induct_schemes minus.simps)

lemma lemma_af [thy_expl]: "minus (minus x4 y4) x4 = Z"
by (hipster_induct_schemes minus.simps)

setup\<open>Hip_Tac_Ops.set_metis_to @{context} 600\<close>
lemma woop []: "minus (minus x y) z = minus (minus x z) y"
by (hipster_induct_schemes minus.simps Nat.exhaust)
setup\<open>Hip_Tac_Ops.set_metis_to @{context} 400\<close>

lemma unknown [thy_expl]: "minus x (minus x y) = minus y (minus y x)"
oops

lemma unknown [thy_expl]: "minus (minus x y) (minus z y) = minus (minus x z) (minus y z)"
oops

lemma unknown [thy_expl]: "minus (minus x y) (S z) =
minus (minus x z) (S y)"
oops

lemma unknown [thy_expl]: "minus (minus x y) (minus z y) =
minus (minus x y) z"
oops

lemma unknown [thy_expl]: "minus (minus x y) (minus z y) =
minus (minus x z) y"
oops

lemma unknown [thy_expl]: "minus (minus x y) (minus x z) =
minus (minus z y) (minus z x)"
oops

lemma unknown [thy_expl]: "minus (S x) (minus x y) =
minus (S y) (minus y x)"
oops
  theorem x0 :
    "(len (drop n xs)) = (minus (len xs) n)"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_nat_acc_plus_comm
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun accplus :: "Nat => Nat => Nat" where
"accplus (Z) y = y"
| "accplus (S z) y = accplus z (S y)"

theorem property0 :
  "((accplus x y) = (accplus y x))"
  oops

end


theory T134
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(x, meet(y, z)) = join(over(x, y), over(x, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


theory T131
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(x, meet(y, z)) = join(over(x, y), over(x, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


(*  Title:      statecharts/CTL/Kripke.thy

    Author:     Steffen Helke, Software Engineering Group
    Copyright   2010 Technische Universitaet Berlin
*)

section \<open>Kripke Structures and CTL\<close>
theory Kripke
imports Main
begin

definition
  Kripke :: "['s set,
              's set,
              ('s * 's) set,
              ('s \<rightharpoonup> 'a set)]
             => bool" where

  "Kripke S S0 R L =
                (S0 \<subseteq> S \<and>
                 R <= S \<times> S \<and>
                 (Domain R) = S \<and>
                 (dom L) = S)"

lemma Kripke_EmptySet:
 "({@x. True}, {@x. True},{(@x. True, @x. True)}, Map.empty(@x. True \<mapsto> {@x. True})) \<in>
   {(S,S0,R,L) | S S0 R L. Kripke S S0 R L}"
by (unfold Kripke_def Domain_unfold, auto)

definition
  "kripke =
    {(S,S0,T,L) |
        (S::('s set))
        (S0::('s set))
        (T::(('s * 's) set))
        (L::('s \<rightharpoonup> ('a  set))).
                      Kripke S S0 T L}"

typedef ('s,'a) kripke =
    "kripke :: ('s set * 's set * ('s * 's) set * ('s \<rightharpoonup> 'a set)) set"
  unfolding kripke_def
  apply (rule exI)
  apply (rule Kripke_EmptySet)
  done

definition
  Statuses :: "('s,'a) kripke => 's set" where
  "Statuses = fst o Rep_kripke"

definition
   InitStatuses :: "('s,'a) kripke  => 's set" where
  "InitStatuses == fst o snd o Rep_kripke"

definition
   StepRel :: "('s,'a) kripke => ('s * 's) set" where
  "StepRel == fst o snd o snd o Rep_kripke"

definition
   LabelFun :: "('s,'a) kripke => ('s \<rightharpoonup> 'a set)" where
  "LabelFun == snd o snd o snd o Rep_kripke"

definition
   Paths :: "[('s,'a) kripke, 's] =>
             (nat => 's) set" where
  "Paths M S == { p . S = p (0::nat) \<and> (\<forall>i. (p i, p (i+1)) \<in> (StepRel M))}"

datatype ('s,'a) ctl =  Atom "'a"
                          | AND "('s,'a) ctl" "('s,'a) ctl"
                          | OR  "('s,'a) ctl" "('s,'a) ctl"
                          | IMPLIES "('s,'a) ctl" "('s,'a) ctl"
                          | CAX "('s,'a) ctl"
                          | AF  "('s,'a) ctl"
                          | AG  "('s,'a) ctl"
                          | AU  "('s,'a) ctl" "('s,'a) ctl"
                          | AR  "('s,'a) ctl" "('s,'a) ctl"

primrec
   eval_ctl :: "[('s,'a) kripke, 's, ('s,'a) ctl] => bool"  ("_,_ |=c= _" [92,91,90]90)
   where
     "(M,S |=c= (Atom P))        = (P \<in> the ((LabelFun M) S))"
   | "(M,S |=c= (AND F1 F2))     = ((M,S |=c= F1) \<and> (M,S |=c= F2))"
   | "(M,S |=c= (OR F1 F2))      = ((M,S |=c= F1) \<or> (M,S |=c= F2))"
   | "(M,S |=c= (IMPLIES F1 F2)) = ((M,S |=c= F1) \<longrightarrow> (M,S |=c= F2))"
   | "(M,S |=c= (CAX F))         = (\<forall> T. (S,T) \<in> (StepRel M) \<longrightarrow> (M,T |=c= F))"
   | "(M,S |=c= (AF F))          = (\<forall> P \<in> Paths M S. \<exists> i. (M,(P i) |=c= F))"
   | "(M,S |=c= (AG F))          = (\<forall> P \<in> Paths M S. \<forall> i. (M,(P i) |=c= F))"
   | "(M,S |=c= (AU F G))        = (\<forall> P \<in> Paths M S.
                                     \<exists> i. (M,(P i) |=c= G) \<and>
                                       (\<forall> j. j < i \<longrightarrow> (M,(P j) |=c= F)))"
   | "(M,S |=c= (AR F G))        = (\<forall> P \<in> Paths M S.
                                     \<forall> i. (M,(P i) |=c= G) \<or>
                                       (\<exists> j. j < i \<and> (M,(P j) |=c= F)))"

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_sort_nat_NStoogeSortPermutes
  imports "../../Test_Base"
begin

datatype ('a, 'b) pair = pair2 "'a" "'b"

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun reverse :: "'a list => 'a list" where
  "reverse (nil2) = nil2"
| "reverse (cons2 z xs) = x (reverse xs) (cons2 z (nil2))"

fun plus :: "Nat => Nat => Nat" where
  "plus (Z) z = z"
| "plus (S z2) z = S (plus z2 z)"

fun minus :: "Nat => Nat => Nat" where
  "minus (Z) z = Z"
| "minus (S z2) (S y2) = minus z2 y2"

(*fun did not finish the proof*)
function third :: "Nat => Nat" where
  "third y =
   (if (y = (S (S Z))) then Z else
      (if (y = (S Z)) then Z else
         (case y of
            Z => Z
            | S z => plus (S Z) (third (minus y (S (S (S Z))))))))"
  by pat_completeness auto

fun length :: "'a list => Nat" where
  "length (nil2) = Z"
| "length (cons2 z l) = plus (S Z) (length l)"

fun le :: "Nat => Nat => bool" where
  "le (Z) z = True"
| "le (S z2) (Z) = False"
| "le (S z2) (S x2) = le z2 x2"

fun sort2 :: "Nat => Nat => Nat list" where
  "sort2 y z =
   (if le y z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun take :: "Nat => 'a list => 'a list" where
  "take y z =
   (if le y Z then nil2 else
      (case z of
         nil2 => nil2
         | cons2 z2 xs => (case y of S x2 => cons2 z2 (take x2 xs))))"

fun elem :: "'a => 'a list => bool" where
  "elem y (nil2) = False"
| "elem y (cons2 z2 xs) = ((z2 = y) | (elem y xs))"

fun drop :: "Nat => 'a list => 'a list" where
  "drop y z =
   (if le y Z then z else
      (case z of
         nil2 => nil2
         | cons2 z2 xs1 => (case y of S x2 => drop x2 xs1)))"

fun splitAt :: "Nat => 'a list =>
              (('a list), ('a list)) pair" where
  "splitAt y z = pair2 (take y z) (drop y z)"

function nstooge1sort2 :: "Nat list => Nat list"
  and nstoogesort :: "Nat list => Nat list"
  and nstooge1sort1 :: "Nat list => Nat list" where
  "nstooge1sort2 y =
   (case splitAt (third (length y)) (reverse y) of
      pair2 ys2 zs2 => x (nstoogesort zs2) (reverse ys2))"
| "nstoogesort (nil2) = nil2"
| "nstoogesort (cons2 z (nil2)) = cons2 z (nil2)"
| "nstoogesort (cons2 z (cons2 y2 (nil2))) = sort2 z y2"
| "nstoogesort (cons2 z (cons2 y2 (cons2 x3 x4))) =
     nstooge1sort2
       (nstooge1sort1 (nstooge1sort2 (cons2 z (cons2 y2 (cons2 x3 x4)))))"
| "nstooge1sort1 y =
     (case splitAt (third (length y)) y of
        pair2 ys2 zs1 => x ys2 (nstoogesort zs1))"
  by pat_completeness auto

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
  "deleteBy y z (nil2) = nil2"
| "deleteBy y z (cons2 y2 ys) =
     (if (y z) y2 then ys else cons2 y2 (deleteBy y z ys))"

fun isPermutation :: "'a list => 'a list => bool" where
  "isPermutation (nil2) (nil2) = True"
| "isPermutation (nil2) (cons2 z2 x2) = False"
| "isPermutation (cons2 x3 xs) z =
     ((elem x3 z) &
        (isPermutation
           xs (deleteBy (% (x4 :: 'a) => % (x5 :: 'a) => (x4 = x5)) x3 z)))"

theorem property0 :
  "isPermutation (nstoogesort xs) xs"
  oops

end