theory State_1
imports "$HETS_LIB/Isabelle/MainHC"
uses "$HETS_LIB/Isabelle/prelude"
begin

typedecl "S"

consts
"GtXGtXEqX" :: "((S => (S * 'a) option) * ('a => (S => (S * 'a) option) option)) => (S => (S * 'a) option) option"   ( "GtXGtXEqX" )
"return" :: "'a => (S => (S * 'a) option) option"   ( "return" )

axioms
return_def: "app (Some return) (Some x) = (Some (% s . pair (Some s) (Some x)))"
bind_def: "app (Some GtXGtXEqX) (pair (Some m) (Some f)) = (Some (% s . app (Some (% (s', a) . app (app (Some f) (Some a)) (Some s'))) (app (Some m) (Some s))))"

lemmas return_def' = return_def [simplified]
lemmas bind_def' = bind_def [simplified]

declare return_def' [simp]
declare return_def [simp]
declare bind_def' [simp]
declare bind_def [simp]

theorem monad_assoc: "!! x :: 'a . app (Some GtXGtXEqX) (pair (app (Some GtXGtXEqX) (pair (app (Some f) (Some x)) (Some g))) (Some h)) = app (Some GtXGtXEqX) (pair (app (Some f) (Some x)) (Some (% y . app (Some GtXGtXEqX) (pair (app (Some g) (Some y)) (Some h)))))"
apply (simp)
apply (case_tac "f x")
apply (simp_all)
apply (rule ext)
apply (case_tac "a s")
apply (auto)
apply (case_tac "g b")
apply (simp_all)
done
theorem monad_unit1: "app (Some GtXGtXEqX) (pair (app (Some f) (Some x)) (Some return)) = app (Some f) (Some x)"
apply (simp)
apply (case_tac "f x")
apply (simp_all)
apply (rule ext)
apply (case_tac "a s")
apply (simp_all)
done
theorem monad_unit2a: "(defOp (app (Some f) (Some x))) --> app (Some GtXGtXEqX) (pair (app (Some return) (Some x)) (Some f)) = app (Some f) (Some x)"
apply (simp)
apply (case_tac "f x")
apply (simp_all)
done
theorem monad_unit2b: "app (Some GtXGtXEqX) (pair (Some m) (Some (% x . app (Some GtXGtXEqX) (pair (app (Some return) (Some x)) (Some f))))) = app (Some GtXGtXEqX) (pair (Some m) (Some f))"
apply (simp)
apply (rule ext)
apply (case_tac "m s")
apply (simp_all)
done

end


subsection\<open>Simplified Variant (Fig.~6 in \<^cite>\<open>"C85"\<close>)\<close>

theory SimpleVariant imports
  HOML
  MFilter
  BaseDefs
begin
text\<open>Axiom's of new, simplified variant.\<close>
axiomatization where
  A1': "\<lfloor>\<^bold>\<not>(\<P>(\<lambda>x.(x\<^bold>\<noteq>x)))\<rfloor>" and
  A2': "\<lfloor>\<^bold>\<forall>X Y.(((\<P> X) \<^bold>\<and> ((X\<^bold>\<sqsubseteq>Y) \<^bold>\<or> (X\<Rrightarrow>Y))) \<^bold>\<rightarrow> (\<P> Y))\<rfloor>" and
  A3:  "\<lfloor>\<^bold>\<forall>\<Z>.((\<P>\<o>\<s> \<Z>) \<^bold>\<rightarrow> (\<^bold>\<forall>X.((X\<Sqinter>\<Z>) \<^bold>\<rightarrow> (\<P> X))))\<rfloor>"

lemma T2: "\<lfloor>\<P> \<G>\<rfloor>" by (metis A3 G_def) \<comment>\<open>From A3\<close>
lemma L1: "\<lfloor>\<P>(\<lambda>x.(x\<^bold>=x))\<rfloor>" by (metis A2' A3)

text\<open>Necessary existence of a Godlike entity.\<close>
theorem T6: "\<lfloor>\<^bold>\<box>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>"  \<comment>\<open>Proof found by sledgehammer\<close>
proof -
  have T1: "\<lfloor>\<^bold>\<forall>X.((\<P> X) \<^bold>\<rightarrow> \<^bold>\<diamond>(\<^bold>\<exists>\<^sup>E X))\<rfloor>" by (metis A1' A2')
  have T3: "\<lfloor>\<^bold>\<diamond>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>" using T1 T2 by simp
  have T5: "\<lfloor>(\<^bold>\<diamond>(\<^bold>\<exists>\<^sup>E \<G>)) \<^bold>\<rightarrow> \<^bold>\<box>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>" by (metis A1' A2' T2)
  thus ?thesis using T3 by blast qed

lemma True nitpick[satisfy] oops \<comment>\<open>Consistency: model found\<close>

text\<open>Modal collapse and monotheism: not implied.\<close>
lemma MC: "\<lfloor>\<^bold>\<forall>\<Phi>.(\<Phi> \<^bold>\<rightarrow> \<^bold>\<box>\<Phi>)\<rfloor>" nitpick oops \<comment>\<open>Countermodel\<close>
lemma MT: "\<lfloor>\<^bold>\<forall>x y.(((\<G> x) \<^bold>\<and> (\<G> y)) \<^bold>\<rightarrow> (x\<^bold>=y))\<rfloor>"
  nitpick oops \<comment>\<open>Countermodel.\<close>

text\<open>Gödel's A1, A4, A5: not implied anymore.\<close>

text\<open>Checking filter and ultrafilter properties.\<close>
theorem F1: "\<lfloor>Filter \<P>\<rfloor>" oops \<comment>\<open>Proof found by sledgehammer, but reconstruction timeout\<close>
theorem U1: "\<lfloor>UFilter \<P>\<rfloor>" nitpick oops  \<comment>\<open>Countermodel\<close>
end


theory Range_Rules
  imports Scoring_Rules
          "Compositional_Structures/Basic_Modules/Range_Module"
          "Compositional_Structures/Elect_Composition"
          "Compositional_Structures/Basic_Modules/Condorcet_Module"

(*Electoral_Module Evaluation_Function Elect_Module Elimination_Module Condorcet_Rule*)
begin

(*******Lemmas*******)

lemma range_mod_A[simp]:
  shows "electoral_module (elector(max_eliminator
        (range_score::'a Evaluation_Function)))"
  by auto

(****************Homogeneity ****************)

(*Addieren von Profilen für scoring*)
lemma testing:
  shows "range_score x A (b @ p) vz = range_score x A p vz"
proof(induct vz)
  case Nil
  then show ?case by simp
next
  case (Cons a b)
  then show ?case by simp
qed

lemma add_range_vectors:
  shows "(range_score x A (b@p) (vs@vz) = (range_score x A b vs) + (range_score x A p vz))"
proof(induct vs)
case Nil
  then show ?case proof-
    have "range_score x A b [] = 0" by simp
    have "range_score x A (b @ p) ([] @ vz) = range_score x A (b @ p) (vz)" by simp
    have "range_score x A (b @ p) vz = range_score x A p vz" using testing by fastforce
    then show ?thesis by simp
  qed
next
case (Cons a vz)
  then show ?case by auto
qed

lemma times_range_vector:
  shows "times (Suc(n)) vs = vs @ (times n vs)" by auto

lemma range_move_out:
  shows "range_score x A (p @ (times n p)) (vs @ (times n vs)) =
        (range_score x A p vs) + (range_score x A (times n p) (times n vs))"
  by (metis add_range_vectors)

lemma times_scoring:
  shows "(range_score x A (times n p) (times n vs)) = range_score x A  p vs * n"
proof(induct n)
case 0
  then show ?case by auto
next
  case (Suc n)
  then show ?case
    by (metis mult_Suc_right range_move_out times_profile)
qed

lemma max_split_range:
  shows
    "Max {range_score x A (b@p) (vs@vz) |x. x \<in> A} =
      Max {(range_score x A b vs) + (range_score x A p vz) |x. x \<in> A}"
  by (metis add_range_vectors)

lemma Max_homo_add_range:
  fixes k::nat
  assumes "finite A" and "A \<noteq> {}"
  shows "Max {range_score x A p vs + k |x. x\<in>A} = Max {range_score x A p vs|x. x\<in>A} + k"
proof -
  have m: "\<And>x y. max x y + k = max (x+k) (y+k)"
    by(simp add: max_def antisym add_right_mono)
  have "{range_score x A p vs + k|x. x\<in>A} = (\<lambda>y. y + k) ` {range_score x A p vs|x. x\<in>A}" by auto
  also have "Max \<dots> = Max {range_score x A p vs|x. x\<in>A} + k"
    using assms hom_Max_commute [of "\<lambda>y. y+k" "{range_score x A p vs|x. x\<in>A}", OF m, symmetric] by simp
  finally show ?thesis by simp
qed

lemma Max_homo_mult_eval_range:
  fixes k::nat
  assumes "finite A" and "A \<noteq> {}"
  shows "Max {eval_func x A p vs * k |x. x\<in>A} = Max {eval_func x A p vs|x. x\<in>A} * k"
proof -
  have m: "\<And>x y. max x y * k = max (x*k) (y*k)"
    by(simp add: max_def antisym add_right_mono)
  have "{eval_func x A p vs * k|x. x\<in>A} = (\<lambda>y. y * k) ` {eval_func x A p vs|x. x\<in>A}" by auto
  also have "Max \<dots> = Max {eval_func x A p vs|x. x\<in>A} * k"
    using assms hom_Max_commute [of "\<lambda>y. y*k" "{eval_func x A p vs|x. x\<in>A}", OF m, symmetric] by simp
  finally show ?thesis by simp
qed

lemma Max_homo_mult_range:
  fixes k::nat
  assumes "finite A" and "A \<noteq> {}"
  shows "Max {range_score x A p vs * k |x. x\<in>A} = Max {range_score x A p vs|x. x\<in>A} * k"
    using Max_homo_mult_eval_range
proof-
  have m: "\<And>x y. max x y * k = max (x*k) (y*k)"
    by(simp add: max_def antisym add_right_mono)
  have "{range_score x A p vs * k|x. x\<in>A} = (\<lambda>y. y * k) ` {range_score x A p vs|x. x\<in>A}" by auto
  also have "Max \<dots> = Max {range_score x A p vs|x. x\<in>A} * k"
    using assms hom_Max_commute [of "\<lambda>y. y*k" "{range_score x A p vs|x. x\<in>A}", OF m, symmetric] by simp
  finally show ?thesis by simp
qed

(** Homogeneity Beweis**)
(*scoring*)
lemma for_range_goal1:
  shows "\<And>A p n x xb vs. x \<in> A \<Longrightarrow>finite A \<Longrightarrow>profile A p \<Longrightarrow> 0 < n \<Longrightarrow> xb \<in> A \<Longrightarrow>
range_score xb A p vs < Max {range_score x A p vs|x. x \<in> A} \<Longrightarrow>
range_score xb A (concat (replicate n p)) (concat (replicate n vs)) <
Max {range_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A}"
proof-
  fix A :: "'a set" and p :: "('a \<times> 'a) set list" and
    n :: "nat" and x :: "'a" and xb :: "'a" and vs :: "'a Pair_Vectors"
    assume a1: "finite A"
    assume a2: "profile A p"
    assume a3: "0 < n"
    assume a4: "x \<in> A"
    have 0 :"Max {range_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} =
        Max {range_score x A p vs * n |x. x \<in> A}"
      using times_scoring by (metis times.simps)
  then have 1:  "Max {range_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} =
      n* Max {range_score x A p vs|x. x \<in> A}"
  proof -
    have "\<And>A f rs n vs. infinite A \<or> A = Collect bot \<or>
        Max {range_score (a::'a) A rs vs|a. a \<in> A} * n = Max {range_score a A rs vs * n |a. a \<in> A}"
      using Max_homo_mult_range by fastforce
    then have f5: "\<And>f rs n vs. Max {range_score a A rs vs|a. a \<in> A} * n =
              Max {range_score a A rs vs * n |a. a \<in> A}"
      using a4 a1 by blast
    have
      "Max {range_score a A (concat (replicate n p)) (concat (replicate n vs))|a. a \<in> A} =
      Max {range_score a A p vs * n |a. a \<in> A}"
      using "0" by blast
    then show "Max {range_score a A (concat (replicate n p)) (concat (replicate n vs))|a. a \<in> A} =
          n * Max {range_score a A p vs|a. a \<in> A}"
      using f5 by (simp add: mult.commute)
  qed
  have 2:"range_score xb A p vs < Max {range_score x A p vs|x. x \<in> A} \<Longrightarrow>
            n* range_score xb A p vs < n* Max {range_score x A p vs|x. x \<in> A}"
    using a3 mult_less_mono2 by blast
  then have 3: "n* range_score xb A p vs < n* Max {range_score x A p vs|x. x \<in> A} \<Longrightarrow>
    range_score xb A (concat (replicate n p)) (concat (replicate n vs))  <
    Max {range_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A}"
    by (metis (no_types, lifting) "1" mult.commute times.simps times_scoring)
  then show "range_score xb A p vs < Max {range_score x A p vs|x. x \<in> A} \<Longrightarrow>
    range_score xb A (concat (replicate n p)) (concat (replicate n vs))  <
    Max {range_score x A (concat (replicate n p)) (concat (replicate n vs)) |x. x \<in> A}"
    using 2 3 by auto
qed

lemma for_range_goal2:
  shows "\<And>A p n x xa xb vs. x \<in> A \<Longrightarrow> finite A \<Longrightarrow> profile A p \<Longrightarrow> vector_pair A vs
      \<Longrightarrow> 0 < n \<Longrightarrow> xa \<in> A \<Longrightarrow> xb \<in> A \<Longrightarrow>
       range_score xb A (concat (replicate n p)) (concat (replicate n vs)) <
       Max {range_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A}
        \<Longrightarrow> range_score xb A p vs< Max {range_score x A p vs|x. x \<in> A}"
proof-
  fix A :: "'a set" and p :: "('a \<times> 'a) set list"
      and n :: nat and x :: 'a and xb :: 'a and vs :: "'a Pair_Vectors"
    assume a1: "finite A"
    assume a2: "profile A p"
    assume a3: "0 < n"
    assume a4: "x \<in> A"
  have 0 :"
   Max {range_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} =
   Max {range_score x A p vs * n |x. x \<in> A}"
      using times_scoring by (metis times.simps)
  then have 1:  "Max {range_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} =
          n* Max {range_score x A p vs|x. x \<in> A}"
proof -
  have "\<And>A rs n vs. infinite A \<or> A = Collect bot \<or> Max {range_score (a::'a) A rs vs|a. a \<in> A} * n =
          Max {range_score a A rs vs * n |a. a \<in> A}"
    using Max_homo_mult_range by fastforce
    then have f5:
      "\<And>rs n. Max {range_score a A rs vs|a. a \<in> A} * n = Max {range_score a A rs vs * n |a. a \<in> A}"
      using a4 a1 by blast
    have
      "Max {range_score a A (concat (replicate n p)) (concat (replicate n vs))|a. a \<in> A} =
      Max {range_score a A p vs * n |a. a \<in> A}"
      using "0" by blast
    then show "Max {range_score a A (concat (replicate n p)) (concat (replicate n vs))|a. a \<in> A} =
            n * Max {range_score a A p vs|a. a \<in> A}"
      using f5 by (simp add: mult.commute)
  qed
  have 2:" n* range_score xb A p vs < n* Max {range_score x A p vs|x. x \<in> A} \<Longrightarrow>
            range_score xb A p vs< Max {range_score x A p vs|x. x \<in> A}"
    by simp
  then have 3: "n* range_score xb A p vs < n* Max {range_score x A p vs|x. x \<in> A} \<Longrightarrow>
     range_score xb A (concat (replicate n p)) (concat (replicate n vs)) <
     Max {range_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A}"
    by (metis (no_types, lifting) "1" mult.commute times.simps times_scoring)
  then show "range_score xb A (concat (replicate n p)) (concat (replicate n vs)) <
        Max {range_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} \<Longrightarrow>
        range_score xb A p vs < Max {range_score x A p vs|x. x \<in> A}"
    using 2 3 by (metis (no_types, lifting) "1" mult.commute times.simps times_scoring)
qed

 lemma range_homogeneity:
  shows "homogeneity (max_eliminator range_score)"
  unfolding homogeneity_def
proof-
  have 0: "\<forall>A p vs. max_eliminator range_score A p vs
        = elimination_module range_score (Max {range_score x A p vs| x. x \<in> A}) (<) A p vs"
    by force
  have 1:"\<forall>A p vs. elimination_module range_score (Max {range_score x A p vs| x. x \<in> A}) (<) A p vs =
  (if (elimination_set range_score (Max {range_score x A p vs| x. x \<in> A})  (<) A p vs) \<noteq> A
        then ({}, (elimination_set range_score (Max {range_score x A p vs| x. x \<in> A})  (<) A p vs), A
        - (elimination_set range_score (Max {range_score x A p vs| x. x \<in> A}) (<) A p vs))
        else ({},{},A))"
    using elimination_module.simps by blast
   have 2:"\<forall>A p n vs. finite_profile A p \<and> finite_pair_vectors A vs \<and> 0 < n \<longrightarrow>
    (if (elimination_set range_score (Max {range_score x A p vs| x. x \<in> A})  (<) A p vs) \<noteq> A
    then ({}, (elimination_set range_score (Max {range_score x A p vs| x. x \<in> A})  (<) A p vs),
    A - (elimination_set range_score (Max {range_score x A p vs| x. x \<in> A}) (<) A p vs))
    else ({},{},A)) =
    (if (elimination_set range_score (Max {range_score x A (Electoral_Module.times n p)
    (Electoral_Module.times n vs)| x. x \<in> A})
    (<) A (Electoral_Module.times n p) (Electoral_Module.times n vs)) \<noteq> A
    then ({}, (elimination_set range_score (Max {range_score x A (Electoral_Module.times n p)
    (Electoral_Module.times n vs)| x. x \<in> A})
    (<) A (Electoral_Module.times n p ) (Electoral_Module.times n vs)), A
    - (elimination_set range_score (Max {range_score x A (Electoral_Module.times n p)
    (Electoral_Module.times n vs)| x. x \<in> A})
    (<) A (Electoral_Module.times n p) (Electoral_Module.times n vs)))
    else ({},{},A))"
     using 1 for_range_goal1 for_range_goal2
     by (smt (z3) Collect_cong elimination_set.simps times.simps)
  then have 3:"\<forall>A p n vs.  finite_profile A p \<and> finite_pair_vectors A vs \<and> 0 < n \<longrightarrow>
    max_eliminator range_score A p vs =
        (if (elimination_set range_score (Max {range_score x A (Electoral_Module.times n p)
      (Electoral_Module.times n vs)| x. x \<in> A})
    (<) A (Electoral_Module.times n p) (Electoral_Module.times n vs)) \<noteq> A
    then ({}, (elimination_set range_score (Max {range_score x A (Electoral_Module.times n p)
      (Electoral_Module.times n vs)| x. x \<in> A})
    (<) A (Electoral_Module.times n p) (Electoral_Module.times n vs)), A
    - (elimination_set range_score (Max {range_score x A (Electoral_Module.times n p)
      (Electoral_Module.times n vs)| x. x \<in> A})
    (<) A (Electoral_Module.times n p) (Electoral_Module.times n vs)))
    else ({},{},A))" using 0 1 by (smt (z3))
  then have "\<forall>A p n vs.  finite_profile A p \<and> finite_pair_vectors A vs \<and> 0 < n \<longrightarrow>
    max_eliminator range_score A  (Electoral_Module.times n p) (Electoral_Module.times n vs) =
        (if (elimination_set range_score (Max {range_score x A (Electoral_Module.times n p)
      (Electoral_Module.times n vs)| x. x \<in> A})
    (<) A (Electoral_Module.times n p) (Electoral_Module.times n vs)) \<noteq> A
    then ({}, (elimination_set range_score (Max {range_score x A (Electoral_Module.times n p)
    (Electoral_Module.times n vs)| x. x \<in> A})
    (<) A (Electoral_Module.times n p) (Electoral_Module.times n vs)), A
    - (elimination_set range_score (Max {range_score x A (Electoral_Module.times n p)
    (Electoral_Module.times n vs)| x. x \<in> A})
    (<) A (Electoral_Module.times n p) (Electoral_Module.times n vs)))
    else ({},{},A))"
    by (smt (z3) "0" "1" Collect_cong)
  then have "\<forall>A p n vs.  finite_profile A p \<and> finite_pair_vectors A vs \<and> 0 < n \<longrightarrow>
    max_eliminator range_score A (Electoral_Module.times n p) (Electoral_Module.times n vs) =
    max_eliminator range_score A p vs"
    by (smt (z3) "3")

   then show "electoral_module (max_eliminator range_score) \<and>
        (\<forall>A p n vs. finite_profile A p \<and> finite_pair_vectors A vs \<and> 0 < n \<longrightarrow>
        max_eliminator range_score A p vs=
        max_eliminator range_score A (Electoral_Module.times n p) (Electoral_Module.times n vs))"
     by (smt (z3) max_elim_sound)

 qed

lemma range_rules_homogeneity:
  shows "homogeneity (elector (max_eliminator range_score))"
  using range_homogeneity elector_homogeneity by simp

(*****)

(********************reinforcement proof**********************************)

lemma combined_eqless_single_range:
  assumes "finite A" and "A \<noteq> {}" and "x \<in> A" and "profile A p1" and "profile A p2" and
    "vector_pair A vs1" and "vector_pair A vs2"
  shows "range_score x A p1 vs1 + range_score x A p2 vs2 \<le> Max {range_score x A p1 vs1|x. x \<in> A} +
          Max {range_score x A p2 vs2|x. x \<in> A}"
proof-
  have "range_score x A p1 vs1\<in> {range_score x A p1 vs1|x. x \<in> A}" using assms(3) by blast
  then have 0:"range_score x A p1 vs1 \<le> Max {range_score x A p1 vs1|x. x \<in> A}" by (simp add: assms(1))
  have "range_score x A p2 vs2\<in> {range_score x A p2 vs2|x. x \<in> A}" using assms(3) by blast
  then have 1:"range_score x A p2 vs2\<le> Max {range_score x A p2 vs2|x. x \<in> A}" by (simp add: assms(1))
  then show ?thesis using "0" "1" add_mono by auto
qed

lemma combined_max_eqless_single_all:
  assumes "finite A" and "A \<noteq> {}" and "x \<in> A" and "profile A p1" and "profile A p2" and
    "vector_pair A vs1" and "vector_pair A vs2"
  shows "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
    Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A} \<le>
    Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2|x. x \<in> A}"
proof-
  have fin: "finite {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}" using assms(1) by simp
  have nonEmpty: "{range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}  \<noteq> {}" using assms(2) by simp
  then have maxInSet:"Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}
        \<in> {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}"
    using "fin" "nonEmpty" eq_Max_iff by blast
  have eqToMax:"\<exists>x \<in> A. range_score x A p1 vs1 + range_score x A p2 vs2 =
        Max {range_score x A p1 vs1 + range_score x A p2 vs2 |x. x \<in> A}" using "maxInSet" by auto
  have allSmaller:"\<forall>x\<in> A. range_score x A p1 vs1 + range_score x A p2 vs2 \<le>
        Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2 |x. x \<in> A}"
    using combined_eqless_single_range
 all_not_in_conv assms(1) assms(3) assms(4) assms(5)
  proof -
  { fix aa :: 'a
    have "\<And>A a rs rsa Ps Psa. infinite A \<or> (a::'a) \<notin> A \<or> \<not> profile A rs \<or> \<not> profile A rsa
  \<or> \<not> vector_pair A Ps \<or> \<not> vector_pair A Psa \<or> range_score a A rsa Psa + range_score a A rs Ps
  \<le> Max {range_score a A rsa Psa |a. a \<in> A} + Max {range_score a A rs Ps |a. a \<in> A}"
      by (smt (z3) all_not_in_conv combined_eqless_single_range)
    then have "aa \<notin> A \<or> range_score aa A p1 vs1 + range_score aa A p2 vs2
  \<le> Max {range_score a A p1 vs1 |a. a \<in> A} + Max {range_score a A p2 vs2 |a. a \<in> A}"
      using assms(1) assms(4) assms(5) assms(6) assms(7) by blast }
  then show ?thesis
    by meson
  have following:"\<exists>x \<in> A. range_score x A p1 vs1 + range_score x A p2 vs2 =
        Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}
  \<Longrightarrow> \<forall>x\<in> A. range_score x A p1 vs1 + range_score x A p2 vs2\<le>
        Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2|x. x \<in> A}
  \<Longrightarrow> Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A} \<le>
        Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2|x. x \<in> A}"
    by fastforce
  qed
  then show ?thesis
    using eqToMax by fastforce
qed

lemma add_range_profiles_all:
  shows "\<forall>x \<in> (defer (max_eliminator (range_score)) A p1 vs1
      \<inter> defer (max_eliminator (range_score)) A p2 vs2).
        (range_score x A (b@p) (vs@vz) = (range_score x A b vs) + (range_score x A p vz))"
proof(induct vs)
case Nil
then show ?case
  by (metis add_range_vectors)
next
case (Cons a b)
  then show ?case by auto
qed

lemma combined_eqless_single_eval:
  assumes "finite A" and "A \<noteq> {}" and "x \<in> A" and "profile A p1" and "profile A p2" and
    "vector_pair A vs1" and "vector_pair A vs2"
  shows "range_score x A p1 vs1 + range_score x A p2 vs2 \<le> Max {range_score x A p1 vs1|x. x \<in> A} +
          Max {range_score x A p2 vs2|x. x \<in> A}"
proof-
  have "range_score x A p1 vs1 \<in> {range_score x A p1 vs1|x. x \<in> A}" using assms(3) by blast
  then have 0:"range_score x A p1 vs1 \<le> Max {range_score x A p1 vs1|x. x \<in> A}" by (simp add: assms(1))
  have "range_score x A p2 vs2 \<in> {range_score x A p2 vs2|x. x \<in> A}" using assms(3) by blast
  then have 1:"range_score x A p2 vs2 \<le> Max {range_score x A p2 vs2|x. x \<in> A}" by (simp add: assms(1))
  then show ?thesis using "0" "1" add_mono assms
    by blast
qed

lemma combined_max_eqless_single_all_eval:
  assumes "finite A" and "A \<noteq> {}" and "x \<in> A" and "profile A p1" and "profile A p2" and
    "vector_pair A vs1" and "vector_pair A vs2"
  shows "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
    Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A} \<le>
    Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2|x. x \<in> A}"
proof-
  have fin: "finite {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}" using assms(1) by simp
  have nonEmpty: "{range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}  \<noteq> {}" using assms(2) by simp
  then have maxInSet:"Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}
        \<in> {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}"
    using "fin" "nonEmpty" eq_Max_iff by blast
  have eqToMax:"\<exists>x \<in> A. range_score x A p1 vs1 + range_score x A p2 vs2 =
        Max {range_score x A p1 vs1 + range_score x A p2 vs2 |x. x \<in> A}" using "maxInSet" by auto
  have allSmaller:"\<forall>x\<in> A. range_score x A p1 vs1 + range_score x A p2 vs2 \<le>
        Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2 |x. x \<in> A}"
    using combined_eqless_single_range
 all_not_in_conv assms(1) assms(3) assms(4) assms(5)
  proof -
    { fix aa :: 'a
    have "\<And>A a rs rsa Ps Psa. infinite A \<or> (a::'a) \<notin> A \<or> \<not> profile A rs \<or> \<not> profile A rsa
  \<or> \<not> vector_pair A Ps \<or> \<not> vector_pair A Psa \<or> range_score a A rsa Psa + range_score a A rs Ps
  \<le> Max {range_score a A rsa Psa |a. a \<in> A} + Max {range_score a A rs Ps |a. a \<in> A}"
      using combined_eqless_single_eval all_not_in_conv by fastforce
      (*by (smt (z3) all_not_in_conv combined_eqless_single_range)*)
    then have "aa \<notin> A \<or> range_score aa A p1 vs1 + range_score aa A p2 vs2
  \<le> Max {range_score a A p1 vs1 |a. a \<in> A} + Max {range_score a A p2 vs2 |a. a \<in> A}"
      using assms(1) assms(4) assms(5) assms(6) assms(7) by blast }
  then show ?thesis
    by meson
  have following:"\<exists>x \<in> A. range_score x A p1 vs1 + range_score x A p2 vs2 =
        Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}
  \<Longrightarrow> \<forall>x\<in> A. range_score x A p1 vs1 + range_score x A p2 vs2\<le>
        Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2|x. x \<in> A}
  \<Longrightarrow> Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A} \<le>
        Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2|x. x \<in> A}"
    by fastforce
  qed
  then show ?thesis
    using eqToMax by fastforce
qed

lemma max_is_defer_combined_than_in_both_all:
  assumes "finite A" and "A \<noteq> {}" and "a \<in> A" and "profile A p1" and "profile A p2" and
    "vector_pair A vs1" and "vector_pair A vs2"
  shows "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
          range_score a A p1 vs1 + range_score a A p2 vs2 \<ge> Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A} \<Longrightarrow>
    \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
    a \<in> defer (max_eliminator (range_score)) A (p1@p2) (vs1@vs2)"
proof -
  assume "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
      range_score a A p1 vs1 + range_score a A p2 vs2 \<ge> Max {range_score x A (p1 @ p2) (vs1@vs2)|x. x \<in> A}"
  then have
    "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
    Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> range_score a A (p1 @ p2) (vs1@vs2)"
    using assms by (metis (no_types, lifting) add_range_profiles_all)
  have
    "\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2.
      Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> range_score a A (p1 @ p2) (vs1@vs2) \<Longrightarrow>
     \<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
    a \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)"
    (*by (smt (z3) Collect_cong add_scoring_profiles_all max_is_defer_combined)*)
proof -
  assume a1: "\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
      Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> range_score a A (p1 @ p2) (vs1@vs2)"
  { fix aa :: 'a
    { assume "Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> range_score aa A (p1 @ p2) (vs1@vs2)"
      moreover
      { assume "aa \<notin> A"
        then have "aa \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)\<or>
      aa \<notin> defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2"
          by simp }
      ultimately have "aa \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)\<or>
      aa \<notin> defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2"
        by simp }
    then have "aa \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2) \<or>
      aa \<notin> defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2"
      using a1 by meson }
  then show ?thesis
    by metis
qed
  then show ?thesis
    using \<open>\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
      Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> range_score a A (p1 @ p2) (vs1@vs2)\<close>
    by linarith
qed

lemma max_in_both__than_in_combined_defer_all:
  assumes "finite_profile A p1" and "finite_profile A p2" and "a \<in> A" "finite A" and "A \<noteq> {}" and
    "vector_pair A vs1" and "vector_pair A vs2"
  shows "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
        range_score a A p1 vs1 =  Max {range_score x A p1 vs1|x. x \<in> A} \<and>
        range_score a A p2 vs2 =  Max {range_score x A p2 vs2|x. x \<in> A} \<Longrightarrow>
        \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
          a \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)"
proof-
  have 00:
  "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
    Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2|x. x \<in> A} \<ge>
      Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}"
    using assms combined_max_eqless_single_all
    by fastforce
  have 11:
    "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2).
      range_score a A p1 vs1 =  Max {range_score x A p1 vs1|x. x \<in> A} \<Longrightarrow>
    \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2).
      range_score a A p2 vs2 =  Max {range_score x A p2 vs2|x. x \<in> A} \<Longrightarrow>
    \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2).
      Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2|x. x \<in> A} = range_score a A p1 vs1 +
          range_score a A p2 vs2"
    by (metis (no_types, lifting))
  have 0:
  "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2).
    range_score a A p1 vs1 =  Max {range_score x A p1 vs1|x. x \<in> A} \<Longrightarrow>
  \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2).
    range_score a A p2 vs2 =  Max {range_score x A p2 vs2|x. x \<in> A} \<Longrightarrow>
  \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
    range_score a A p1 vs1 + range_score a A p2 vs2 \<ge> Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}"
    using "00" "11" by (metis (no_types, lifting))
  have 1 :"\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
    Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A} = Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A}"
    by (simp add: max_split_range)
  have 2:"\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
    range_score a A p1 vs1=  Max {range_score x A p1 vs1|x. x \<in> A} \<Longrightarrow>
    \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
        range_score a A p2 vs2 =  Max {range_score x A p2 vs2|x. x \<in> A} \<Longrightarrow>
    \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2).
        range_score a A p1 vs1 + range_score a A p2 vs2\<ge> Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A}"
    using assms "1" "0" by (metis (no_types, lifting))
  have 3:"\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2).
      range_score a A p1 vs1 + range_score a A p2 vs2\<ge> Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A} \<Longrightarrow>
      \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2).
      a \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)"
    using assms max_is_defer_combined_than_in_both_all by (metis (mono_tags, lifting))
  show "\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
       range_score a A p1 vs1 = Max {range_score x A p1 vs1 |x. x \<in> A} \<and>
       range_score a A p2 vs2 = Max {range_score x A p2 vs2 |x. x \<in> A} \<Longrightarrow>
    \<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
       a \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1 @ vs2) "
    using assms "2" "3" by blast
qed

lemma max_always_exists0:
  assumes "finite A" and "A \<noteq> {}"
  shows "\<exists>a \<in> A. Evaluation_Function a A p vs = Max {Evaluation_Function x A p vs|x. x \<in> A}"
proof-
  have fin: "finite {Evaluation_Function x A p vs|x. x \<in> A}" using assms(1) by simp
  have nonEmpty: "{Evaluation_Function x A p vs|x. x \<in> A}  \<noteq> {}" using assms(2) by simp
  then have maxInSet:"Max {Evaluation_Function x A p vs|x. x \<in> A} \<in> {Evaluation_Function x A p vs|x. x \<in> A}"
    using "fin" "nonEmpty" eq_Max_iff by blast
  have "Max {Evaluation_Function x A p vs|x. x \<in> A} \<in> {Evaluation_Function x A p vs|x. x \<in> A} \<Longrightarrow>
        \<exists>a \<in> A. Evaluation_Function a A p vs = Max {Evaluation_Function x A p vs|x. x \<in> A}" by auto
  then show ?thesis using maxInSet by simp
qed

lemma max_always_exists:
  assumes "finite A" and "A \<noteq> {}"
  shows "{a \<in> A. Evaluation_Function a A p vs <
    Max {Evaluation_Function x A p vs|x. x \<in> A}} = A \<Longrightarrow> False"
proof-
    have "\<exists>a \<in> A. Evaluation_Function a A p vs = Max {Evaluation_Function x A p vs|x. x \<in> A}"
      using assms by (simp add: Range_Rules.max_always_exists0)
    then show "{a \<in> A. Evaluation_Function a A p vs <
    Max {Evaluation_Function x A p vs|x. x \<in> A}} = A \<Longrightarrow> False"
    using neq_iff by fastforce
qed

lemma not_less_is_max:
  assumes "finite A"
  shows "a \<in> (A - elimination_set (Evaluation_Function) (Max {(Evaluation_Function) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      Evaluation_Function a A p vs =  Max {Evaluation_Function x A p vs|x. x \<in> A}"
proof-
  have "a \<in> (A - elimination_set (Evaluation_Function) (Max {(Evaluation_Function) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      a \<in> A" by clarify
  then have "a \<in> (A - elimination_set (Evaluation_Function) (Max {(Evaluation_Function) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      Evaluation_Function a A p vs \<in> {Evaluation_Function x A p vs|x. x \<in> A}"
    by blast
      (*sc a p nicht größer als Max*)
  then have 0:"a \<in> (A - elimination_set (Evaluation_Function) (Max {(Evaluation_Function) x A p vs |x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      Evaluation_Function a A p vs \<le>  Max{Evaluation_Function x A p vs|x. x \<in> A}"
    using assms (1) by auto
      (*sc a p nicht kleiner als Max*)
  have 1:"a \<in> (A - elimination_set (Evaluation_Function) (Max {(Evaluation_Function) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      Evaluation_Function a A p vs \<ge>  Max{Evaluation_Function x A p vs|x. x \<in> A}"
    by auto
  have "a \<in> A \<Longrightarrow>\<not> Evaluation_Function a A p vs < Max {Evaluation_Function x A p vs|x. x \<in> A} \<Longrightarrow>
      Evaluation_Function a A p vs = Max {Evaluation_Function x A p vs|x. x \<in> A}" using "0" "1" by simp
  then show "a \<in> (A - elimination_set (Evaluation_Function) (Max {(Evaluation_Function) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      Evaluation_Function a A p vs =  Max {Evaluation_Function x A p vs|x. x \<in> A}"
    by simp
qed

(** from defer follows Max value **)

lemma from_defer_follows_max:
  assumes "finite A" and "A \<noteq> {}"
  shows "a \<in> defer (max_eliminator (Evaluation_Function)) A p vs \<Longrightarrow>
            Evaluation_Function a A p vs = Max {Evaluation_Function x A p vs|x. x \<in> A}"
proof-
  have "({a \<in> A. Evaluation_Function a A p vs < Max {(Evaluation_Function) x A p vs|x. x \<in> A}} \<noteq> A) = True"
          using assms Range_Rules.max_always_exists by fastforce
        then have 0: "a \<in> defer (max_eliminator (Evaluation_Function)) A p vs \<Longrightarrow>
      a \<in> (A - elimination_set (Evaluation_Function) (Max {(Evaluation_Function) x A p vs|x. x \<in> A}) (<) A p vs)"
    by simp
  have "a \<in> (A - elimination_set (Evaluation_Function) (Max {(Evaluation_Function) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      Evaluation_Function a A p vs =  Max {Evaluation_Function x A p vs|x. x \<in> A}"
    using assms(1) not_less_is_max by simp
  then have 1:"a \<in> defer (max_eliminator (Evaluation_Function)) A p vs \<Longrightarrow> Evaluation_Function a A p vs =
      Max {Evaluation_Function x A p vs|x. x \<in> A}" using "0" by simp
  then show "a \<in> defer (max_eliminator (Evaluation_Function)) A p vs \<Longrightarrow>
      Evaluation_Function a A p vs = Max {Evaluation_Function x A p vs|x. x \<in> A}"
     by simp
 qed

lemma from_defer_follows_max_all:
  assumes "finite A" and "A \<noteq> {}"
  shows "\<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
      a \<in> defer (max_eliminator (Evaluation_Function)) A p vs \<Longrightarrow>
      \<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
      Evaluation_Function a A p vs = Max {Evaluation_Function x A p vs|x. x \<in> A}"
proof-

  have 0:"\<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
        ({a \<in> A. Evaluation_Function a A p vs < Max {(Evaluation_Function) x A p vs|x. x \<in> A}} \<noteq> A) = True"
          using assms max_always_exists by fastforce

        have "a \<in> (A - elimination_set (Evaluation_Function) (Max {(Evaluation_Function) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      Evaluation_Function a A p vs =  Max {Evaluation_Function x A p vs|x. x \<in> A}"
    using assms(1) not_less_is_max by simp
  then have 1:
        "\<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
                a \<in> defer (max_eliminator (Evaluation_Function)) A p vs \<Longrightarrow>
                \<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter>
                defer (max_eliminator (Evaluation_Function)) A p2 vs2).
                Evaluation_Function a A p vs = Max {Evaluation_Function x A p vs|x. x \<in> A}" using "0"
    by (metis (mono_tags, lifting) assms(1) assms(2) from_defer_follows_max)
  then show
      "\<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
      a \<in> defer (max_eliminator (Evaluation_Function)) A p vs \<Longrightarrow>
  \<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
      Evaluation_Function a A p vs = Max {Evaluation_Function x A p vs|x. x \<in> A}" by fastforce
qed

lemma from_defer_follows_max2_all:
  assumes "finite A"  and "A \<noteq> {}"
  shows "\<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
  a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2)
  \<Longrightarrow> \<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
      (Evaluation_Function a A p1 vs1 = Max {Evaluation_Function x A p1 vs1|x. x \<in> A})"
  by (metis (mono_tags, lifting) IntD1 assms from_defer_follows_max_all)

lemma from_defer_follows_max3_for_all:
  assumes "finite A"  and "A \<noteq> {}"
  shows "\<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
   a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2) \<Longrightarrow>
   \<forall>a \<in> (defer (max_eliminator (Evaluation_Function)) A p1 vs1 \<inter> defer (max_eliminator (Evaluation_Function)) A p2 vs2).
      (Evaluation_Function a A p1 vs1 = Max {Evaluation_Function x A p1 vs1|x. x \<in> A}) \<and>
      (Evaluation_Function a A p2 vs2 = Max {Evaluation_Function x A p2 vs2|x. x \<in> A})"
  using assms from_defer_follows_max2_all
  by blast

lemma reinforcement_defer_range_helper:
  assumes "finite A" and "A \<noteq> {}" and "a \<in> A" and "profile A p1" and "profile A p2" and
    "vector_pair A vs1" and "vector_pair A vs2"
  shows "defer (max_eliminator range_score) A p1 vs1 \<inter>
  defer (max_eliminator range_score) A p2 vs2 \<noteq> {} \<Longrightarrow>
  defer (max_eliminator range_score) A p1 vs1 \<inter>
  defer (max_eliminator range_score) A p2 vs2 =
  defer (max_eliminator range_score) A (p1 @ p2) (vs1@vs2)"
proof-

  have all:
      "\<forall>a \<in> (defer (max_eliminator range_score) A p1 vs1 \<inter>
      defer (max_eliminator range_score) A p2 vs2).
      a \<in> defer (max_eliminator range_score) A (p1 @ p2) (vs1@vs2)"
    by (meson from_defer_follows_max3_for_all max_in_both__than_in_combined_defer_all assms)

  then have d1:"(defer (max_eliminator range_score) A p1 vs1 \<inter>
      defer (max_eliminator range_score) A p2 vs2)
      \<subseteq> defer (max_eliminator range_score) A (p1 @ p2) (vs1@vs2)"
    using assms by blast
(***********)
  have 00:"\<forall>a \<in> (defer (max_eliminator range_score) A p1 vs1 \<inter> defer (max_eliminator range_score) A p2 vs2).
  a \<in> (defer (max_eliminator range_score) A p1 vs1\<inter> defer (max_eliminator range_score) A p2 vs2) \<Longrightarrow>
      \<forall>a \<in> (defer (max_eliminator range_score) A p1 vs1 \<inter> defer (max_eliminator range_score) A p2 vs2).
   (range_score a A p1 vs1= Max {range_score x A p1 vs1|x. x \<in> A}) \<and>
      (range_score a A p2 vs2= Max {range_score x A p2 vs2|x. x \<in> A})"
    using from_defer_follows_max3_for_all assms(1) assms(2)
    by blast

   have 11:"range_score a A p1 vs1=  Max {range_score x A p1 vs1|x. x \<in> A} \<and>
      range_score a A p2 vs2= Max {range_score x A p2 vs2|x. x \<in> A} \<Longrightarrow>
   \<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2).
      a \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)"
    using assms max_in_both__than_in_combined_defer_all all by blast
  have all:
    "\<forall>a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2).
    a \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)" using assms "00" "11"
    using all by blast (*by simp*)
  then have d1:"(defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2)
      \<subseteq> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)"
    using assms by blast

  have "defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2\<noteq> {} \<Longrightarrow>
    \<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
    a \<in> (defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2)"
proof-
(*1)*)
(*relevant für "comb_is_eq"*)
  have a_is_max_p1_p2:"\<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
          range_score a A (p1@p2) (vs1@vs2) = Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A}"
    using assms by (smt (z3) Collect_cong from_defer_follows_max)

  have same_as_add:"\<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
      (range_score a A (p1@p2) (vs1@vs2) = (range_score a A p1 vs1) + (range_score a A p2 vs2))"
      using add_range_vectors by fastforce

    have elem_A2:
        "\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2. a\<in>A"
      using assms(1) assms(4) defer_in_alts max_elim_sound
      using Int_iff assms(6) in_mono by auto
    have elem_A:"\<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)). a \<in> A" by simp

(*relevant für "1"*)
    then have "\<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)). range_score a A p1 vs1\<in>
      {range_score x A p1 vs1|x. x \<in> A}"
      using assms(3) by blast
    then have smaller_max:
          "\<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)). range_score a A p1 vs1 \<le>
      Max {range_score x A p1 vs1|x. x \<in> A}"
      using assms(1) by simp
    then have "\<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)). range_score a A p2 vs2 \<in>
      {range_score x A p2 vs2|x. x \<in> A}"
      using assms(3) "elem_A" by blast
    then have smaller_max2:"\<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
      range_score a A p2 vs2 \<le>  Max {range_score x A p2 vs2|x. x \<in> A}"
      using assms(1) by simp
(*relevant für "from_single_follows_combined"*)
    have 11:"defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2 \<noteq> {}
      \<Longrightarrow> \<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
          (range_score a A p1 vs1 =  Max {range_score x A p1 vs1|x. x \<in> A}) \<and> (range_score a A p2 vs2 =
      Max {range_score x A p2 vs2|x. x \<in> A})"
      using "00" by blast

        have elem_of:
          "\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2.
                        range_score a A p1 vs1 + range_score a A p2 vs2\<in> {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A}"
      using same_as_add
      by (metis (mono_tags, lifting) all elem_A2 mem_Collect_eq)

    have 001:"\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
        Max {range_score x A p1 vs1|x. x \<in> A} + Max {range_score x A p2 vs2|x. x \<in> A} \<ge>
        Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}"
      using assms combined_max_eqless_single_all by (metis (mono_tags, lifting) )

    then have 000:
        "\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
         range_score a A p1 vs1 + range_score a A p2 vs2\<ge> Max {range_score x A p1 vs1 + range_score x A p2 vs2|x. x \<in> A}"
      using assms by (metis (no_types, lifting) "11" equals0D)

    then  have
        "\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
                  Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A} \<le> range_score a A p1 vs1 + range_score a A p2 vs2"
      by (metis (no_types, lifting) a_is_max_p1_p2 all dual_order.eq_iff same_as_add)

    then have comb_is_eq:
          "\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
          Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A} = range_score a A p1 vs1 + range_score a A p2 vs2"
      using elem_of
          proof -
            { fix aa :: 'a
              have "\<And>a. a \<notin> defer (max_eliminator (range_score)) A p1 vs1 \<inter>
                  defer (max_eliminator (range_score)) A p2 vs2\<or>
                  Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> range_score a A (p1 @ p2) (vs1@vs2)"
                using a_is_max_p1_p2 all dual_order.order_iff_strict by blast
              moreover
              {assume "aa \<in> A \<and> Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> range_score aa A (p1 @ p2) (vs1@vs2)"
                then have m1:"aa \<in> defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)"
                  by simp
            then have "Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} = range_score aa A (p1 @ p2) (vs1@vs2)"
              by (smt (z3) a_is_max_p1_p2)
            then have
              "range_score aa A p1 vs1 + range_score aa A p2 vs2= Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A}
        \<or> aa \<notin> defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2"
              using m1 same_as_add by fastforce}

          ultimately have "range_score aa A p1 vs1 + range_score aa A p2 vs2 =
              Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<or>
             aa \<notin> defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2"
            using \<open>\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter>
                  defer (max_eliminator (range_score)) A p2 vs2. a \<in> A\<close> by blast }
        then have "\<forall>a. range_score a A p1 vs1 + range_score a A p2 vs2=
                    Max {range_score a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<or>
              a \<notin> defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2"
              by satx
            then show ?thesis
              by (smt (z3))
                 qed

    have eq:"\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
            Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A} = range_score a A p1 vs1+ range_score a A p2 vs2 \<Longrightarrow>
            \<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
            range_score a A p1 vs1 =  Max {range_score x A p1 vs1|x. x \<in> A} \<and> range_score a A p2 vs2 =
                  Max {range_score x A p2 vs2|x. x \<in> A} \<Longrightarrow>
            \<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
            Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A} = Max {range_score x A p1 vs1|x. x \<in> A} +
            Max {range_score x A p2 vs2|x. x \<in> A}"
      by (metis (no_types, lifting))

    then have "\<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
          (range_score a A p1 vs1 =  Max {range_score x A p1 vs1|x. x \<in> A}) \<and>
          (range_score a A p2 vs2 =  Max {range_score x A p2 vs2|x. x \<in> A}) \<Longrightarrow>
            \<forall>a\<in>defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2.
            Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A} = range_score a A p1 vs1 + range_score a A p2 vs2"
              using assms comb_is_eq
      by linarith

    then have from_single_follows_combined:
        "defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2 \<noteq> {} \<Longrightarrow>
        Max {range_score x A (p1@p2) (vs1@vs2)|x. x \<in> A} = Max {range_score x A p1 vs1|x. x \<in> A} +
        Max {range_score x A p2 vs2|x. x \<in> A}"
    using assms "11" "eq" by blast

  have 00:"defer (max_eliminator (range_score)) A p1 vs1\<inter> defer (max_eliminator (range_score)) A p2 vs2\<noteq> {}
      \<Longrightarrow> \<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
        range_score a A p1 vs1 + range_score a A p2 vs2 = Max {range_score x A p1 vs1|x. x \<in> A} +
        Max {range_score x A p2 vs2|x. x \<in> A}"
    using a_is_max_p1_p2 from_single_follows_combined same_as_add by fastforce

  have 1:"defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2\<noteq> {}
      \<Longrightarrow> \<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
        (range_score a A p1 vs1 =  Max {range_score x A p1 vs1|x. x \<in> A}) \<and>
      (range_score a A p2 vs2 =  Max {range_score x A p2 vs2|x. x \<in> A})"
    using assms "a_is_max_p1_p2" "from_single_follows_combined" "same_as_add"
          "smaller_max" "smaller_max2" "00"
    using add.commute add_le_cancel_right le_antisym by fastforce

    have 3:"\<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
          range_score a A p1 vs1 =  Max {range_score x A p1 vs1|x. x \<in> A} \<Longrightarrow>
          \<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
          range_score a A p2 vs2=  Max {range_score x A p2 vs2|x. x \<in> A} \<Longrightarrow>
          \<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
          a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter>
          defer (max_eliminator (range_score)) A p2 vs2)"
      using assms sorry

          then show
            "defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2\<noteq> {}
      \<Longrightarrow> \<forall>a \<in> (defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)).
      a \<in> (defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2)"
            using assms "1" "3" by blast
  qed

  then show "defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2 \<noteq> {}
      \<Longrightarrow> defer (max_eliminator (range_score)) A p1 vs1 \<inter> defer (max_eliminator (range_score)) A p2 vs2 =
      defer (max_eliminator (range_score)) A (p1 @ p2) (vs1@vs2)"
    using assms "d1" by blast
qed

lemma reinforcement_defer_range:
  shows "reinforcement_defer (max_eliminator range_score)"
  unfolding reinforcement_defer_def
proof-
  have 0:"electoral_module (max_eliminator range_score)" by simp
  have 1:"(\<forall>A p1 p2 vs1 vs2.
        finite_profile A p1 \<and> finite_profile A p2 \<and> finite_pair_vectors A vs1
        \<and> finite_pair_vectors A vs2 \<longrightarrow>
        defer (max_eliminator range_score) A p1 vs1 \<inter>
        defer (max_eliminator range_score) A p2 vs2\<noteq> {} \<longrightarrow>
        defer (max_eliminator range_score) A p1 vs1 \<inter>
        defer (max_eliminator range_score) A p2 vs2 =
      defer (max_eliminator range_score) A (p1 @ p2) (vs1@vs2))"
    using  "0" Int_emptyI defer_in_alts equals0D in_mono reinforcement_defer_range_helper
    by (smt (z3))
  then show "electoral_module (max_eliminator range_score) \<and>
    (\<forall>A p1 p2 vs1 vs2.
        finite_profile A p1 \<and> finite_pair_vectors A vs1 \<and> finite_profile A p2
        \<and> finite_pair_vectors A vs2 \<longrightarrow>
        defer (max_eliminator range_score) A p1 vs1 \<inter>
        defer (max_eliminator range_score) A p2 vs2 \<noteq> {} \<longrightarrow>
        defer (max_eliminator range_score) A p1 vs1 \<inter>
        defer (max_eliminator range_score) A p2 vs2 =
        defer (max_eliminator range_score) A (p1 @ p2) (vs1 @ vs2))"
    using "0"
    by blast
qed

lemma reinforcement_range:
  shows "reinforcement (max_eliminator (range_score))"
  unfolding reinforcement_def by simp

lemma elector_reinforcement:
  shows "reinforcement (elector(max_eliminator range_score))"
proof(simp)
  have def: "reinforcement_defer (max_eliminator range_score)"
    by (simp add: reinforcement_defer_range)
  have "reinforcement elect_module"
    by (simp add: reinforcement_def)
  have emp: "\<forall>A p vs. elect (max_eliminator range_score) A p vs = {}"
    using max_elim_non_electing by simp
  have "\<forall>A p vs. elect (max_eliminator range_score) A p vs = {} \<Longrightarrow>
        \<forall>A p vs. defer (max_eliminator range_score) A p vs =
    elect (elector(max_eliminator range_score)) A p vs"
      by (simp add: reinforcement_def)
    then show "reinforcement (max_eliminator range_score \<triangleright> elect_module)"
      using emp def elect_mod_sound elector.elims reinforcement_def reinforcement_defer_def seq_comp_sound
      by (smt (z3))
qed

lemma range_module_rein:
  shows "reinforcement (elector(max_eliminator range_score))"
proof-
  have 0:"\<forall>A p vs. elect (max_eliminator range_score) A p vs = {}" by simp
  have "\<forall>A p vs. well_formed A ((max_eliminator range_score) A p vs)" by auto
  then show ?thesis using elector_reinforcement reinforcement_defer_range 0 by blast
qed

end


(*  Title:      ZF/Induct/Tree_Forest.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1994  University of Cambridge
*)

section \<open>Trees and forests, a mutually recursive type definition\<close>

theory Tree_Forest imports ZF begin

subsection \<open>Datatype definition\<close>

consts
  tree :: "i \<Rightarrow> i"
  forest :: "i \<Rightarrow> i"
  tree_forest :: "i \<Rightarrow> i"

datatype "tree(A)" = Tcons ("a \<in> A", "f \<in> forest(A)")
  and "forest(A)" = Fnil | Fcons ("t \<in> tree(A)", "f \<in> forest(A)")

(* FIXME *)
lemmas tree'induct =
    tree_forest.mutual_induct [THEN conjunct1, THEN spec, THEN [2] rev_mp, of concl: _ t, consumes 1]
  and forest'induct =
    tree_forest.mutual_induct [THEN conjunct2, THEN spec, THEN [2] rev_mp, of concl: _ f, consumes 1]
  for t f

declare tree_forest.intros [simp, TC]

lemma tree_def: "tree(A) \<equiv> Part(tree_forest(A), Inl)"
  by (simp only: tree_forest.defs)

lemma forest_def: "forest(A) \<equiv> Part(tree_forest(A), Inr)"
  by (simp only: tree_forest.defs)

text \<open>
  \medskip \<^term>\<open>tree_forest(A)\<close> as the union of \<^term>\<open>tree(A)\<close>
  and \<^term>\<open>forest(A)\<close>.
\<close>

lemma tree_subset_TF: "tree(A) \<subseteq> tree_forest(A)"
    unfolding tree_forest.defs
  apply (rule Part_subset)
  done

lemma treeI [TC]: "x \<in> tree(A) \<Longrightarrow> x \<in> tree_forest(A)"
  by (rule tree_subset_TF [THEN subsetD])

lemma forest_subset_TF: "forest(A) \<subseteq> tree_forest(A)"
    unfolding tree_forest.defs
  apply (rule Part_subset)
  done

lemma treeI' [TC]: "x \<in> forest(A) \<Longrightarrow> x \<in> tree_forest(A)"
  by (rule forest_subset_TF [THEN subsetD])

lemma TF_equals_Un: "tree(A) \<union> forest(A) = tree_forest(A)"
  apply (insert tree_subset_TF forest_subset_TF)
  apply (auto intro!: equalityI tree_forest.intros elim: tree_forest.cases)
  done

lemma tree_forest_unfold:
  "tree_forest(A) = (A \<times> forest(A)) + ({0} + tree(A) \<times> forest(A))"
    \<comment> \<open>NOT useful, but interesting \dots\<close>
  supply rews = tree_forest.con_defs tree_def forest_def
    unfolding tree_def forest_def
  apply (fast intro!: tree_forest.intros [unfolded rews, THEN PartD1]
    elim: tree_forest.cases [unfolded rews])
  done

lemma tree_forest_unfold':
  "tree_forest(A) =
    A \<times> Part(tree_forest(A), \<lambda>w. Inr(w)) +
    {0} + Part(tree_forest(A), \<lambda>w. Inl(w)) * Part(tree_forest(A), \<lambda>w. Inr(w))"
  by (rule tree_forest_unfold [unfolded tree_def forest_def])

lemma tree_unfold: "tree(A) = {Inl(x). x \<in> A \<times> forest(A)}"
    unfolding tree_def forest_def
  apply (rule Part_Inl [THEN subst])
  apply (rule tree_forest_unfold' [THEN subst_context])
  done

lemma forest_unfold: "forest(A) = {Inr(x). x \<in> {0} + tree(A)*forest(A)}"
    unfolding tree_def forest_def
  apply (rule Part_Inr [THEN subst])
  apply (rule tree_forest_unfold' [THEN subst_context])
  done

text \<open>
  \medskip Type checking for recursor: Not needed; possibly interesting?
\<close>

lemma TF_rec_type:
  "\<lbrakk>z \<in> tree_forest(A);
      \<And>x f r. \<lbrakk>x \<in> A;  f \<in> forest(A);  r \<in> C(f)
\<rbrakk> \<Longrightarrow> b(x,f,r) \<in> C(Tcons(x,f));
      c \<in> C(Fnil);
      \<And>t f r1 r2. \<lbrakk>t \<in> tree(A);  f \<in> forest(A);  r1 \<in> C(t); r2 \<in> C(f)
\<rbrakk> \<Longrightarrow> d(t,f,r1,r2) \<in> C(Fcons(t,f))
\<rbrakk> \<Longrightarrow> tree_forest_rec(b,c,d,z) \<in> C(z)"
  by (induct_tac z) simp_all

lemma tree_forest_rec_type:
  "\<lbrakk>\<And>x f r. \<lbrakk>x \<in> A;  f \<in> forest(A);  r \<in> D(f)
\<rbrakk> \<Longrightarrow> b(x,f,r) \<in> C(Tcons(x,f));
      c \<in> D(Fnil);
      \<And>t f r1 r2. \<lbrakk>t \<in> tree(A);  f \<in> forest(A);  r1 \<in> C(t); r2 \<in> D(f)
\<rbrakk> \<Longrightarrow> d(t,f,r1,r2) \<in> D(Fcons(t,f))
\<rbrakk> \<Longrightarrow> (\<forall>t \<in> tree(A).    tree_forest_rec(b,c,d,t) \<in> C(t)) \<and>
          (\<forall>f \<in> forest(A). tree_forest_rec(b,c,d,f) \<in> D(f))"
    \<comment> \<open>Mutually recursive version.\<close>
    unfolding Ball_def
  apply (rule tree_forest.mutual_induct)
  apply simp_all
  done

subsection \<open>Operations\<close>

consts
  map :: "[i \<Rightarrow> i, i] \<Rightarrow> i"
  size :: "i \<Rightarrow> i"
  preorder :: "i \<Rightarrow> i"
  list_of_TF :: "i \<Rightarrow> i"
  of_list :: "i \<Rightarrow> i"
  reflect :: "i \<Rightarrow> i"

primrec
  "list_of_TF (Tcons(x,f)) = [Tcons(x,f)]"
  "list_of_TF (Fnil) = []"
  "list_of_TF (Fcons(t,tf)) = Cons (t, list_of_TF(tf))"

primrec
  "of_list([]) = Fnil"
  "of_list(Cons(t,l)) = Fcons(t, of_list(l))"

primrec
  "map (h, Tcons(x,f)) = Tcons(h(x), map(h,f))"
  "map (h, Fnil) = Fnil"
  "map (h, Fcons(t,tf)) = Fcons (map(h, t), map(h, tf))"

primrec
  "size (Tcons(x,f)) = succ(size(f))"
  "size (Fnil) = 0"
  "size (Fcons(t,tf)) = size(t) #+ size(tf)"

primrec
  "preorder (Tcons(x,f)) = Cons(x, preorder(f))"
  "preorder (Fnil) = Nil"
  "preorder (Fcons(t,tf)) = preorder(t) @ preorder(tf)"

primrec
  "reflect (Tcons(x,f)) = Tcons(x, reflect(f))"
  "reflect (Fnil) = Fnil"
  "reflect (Fcons(t,tf)) =
    of_list (list_of_TF (reflect(tf)) @ Cons(reflect(t), Nil))"

text \<open>
  \medskip \<open>list_of_TF\<close> and \<open>of_list\<close>.
\<close>

lemma list_of_TF_type [TC]:
    "z \<in> tree_forest(A) \<Longrightarrow> list_of_TF(z) \<in> list(tree(A))"
  by (induct set: tree_forest) simp_all

lemma of_list_type [TC]: "l \<in> list(tree(A)) \<Longrightarrow> of_list(l) \<in> forest(A)"
  by (induct set: list) simp_all

text \<open>
  \medskip \<open>map\<close>.
\<close>

lemma
  assumes "\<And>x. x \<in> A \<Longrightarrow> h(x): B"
  shows map_tree_type: "t \<in> tree(A) \<Longrightarrow> map(h,t) \<in> tree(B)"
    and map_forest_type: "f \<in> forest(A) \<Longrightarrow> map(h,f) \<in> forest(B)"
  using assms
  by (induct rule: tree'induct forest'induct) simp_all

text \<open>
  \medskip \<open>size\<close>.
\<close>

lemma size_type [TC]: "z \<in> tree_forest(A) \<Longrightarrow> size(z) \<in> nat"
  by (induct set: tree_forest) simp_all

text \<open>
  \medskip \<open>preorder\<close>.
\<close>

lemma preorder_type [TC]: "z \<in> tree_forest(A) \<Longrightarrow> preorder(z) \<in> list(A)"
  by (induct set: tree_forest) simp_all

text \<open>
  \medskip Theorems about \<open>list_of_TF\<close> and \<open>of_list\<close>.
\<close>

lemma forest_induct [consumes 1, case_names Fnil Fcons]:
  "\<lbrakk>f \<in> forest(A);
      R(Fnil);
      \<And>t f. \<lbrakk>t \<in> tree(A);  f \<in> forest(A);  R(f)\<rbrakk> \<Longrightarrow> R(Fcons(t,f))
\<rbrakk> \<Longrightarrow> R(f)"
  \<comment> \<open>Essentially the same as list induction.\<close>
  apply (erule tree_forest.mutual_induct
      [THEN conjunct2, THEN spec, THEN [2] rev_mp])
    apply (rule TrueI)
   apply simp
  apply simp
  done

lemma forest_iso: "f \<in> forest(A) \<Longrightarrow> of_list(list_of_TF(f)) = f"
  by (induct rule: forest_induct) simp_all

lemma tree_list_iso: "ts: list(tree(A)) \<Longrightarrow> list_of_TF(of_list(ts)) = ts"
  by (induct set: list) simp_all

text \<open>
  \medskip Theorems about \<open>map\<close>.
\<close>

lemma map_ident: "z \<in> tree_forest(A) \<Longrightarrow> map(\<lambda>u. u, z) = z"
  by (induct set: tree_forest) simp_all

lemma map_compose:
    "z \<in> tree_forest(A) \<Longrightarrow> map(h, map(j,z)) = map(\<lambda>u. h(j(u)), z)"
  by (induct set: tree_forest) simp_all

text \<open>
  \medskip Theorems about \<open>size\<close>.
\<close>

lemma size_map: "z \<in> tree_forest(A) \<Longrightarrow> size(map(h,z)) = size(z)"
  by (induct set: tree_forest) simp_all

lemma size_length: "z \<in> tree_forest(A) \<Longrightarrow> size(z) = length(preorder(z))"
  by (induct set: tree_forest) (simp_all add: length_app)

text \<open>
  \medskip Theorems about \<open>preorder\<close>.
\<close>

lemma preorder_map:
    "z \<in> tree_forest(A) \<Longrightarrow> preorder(map(h,z)) = List.map(h, preorder(z))"
  by (induct set: tree_forest) (simp_all add: map_app_distrib)

end


theory Datatype_Record_Examples
imports "HOL-Library.Datatype_Records"
begin

text \<open>Standard usage\<close>

datatype_record ('a, 'b) foo =
  field_1 :: 'a
  field_2 :: 'b

lemma "\<lparr> field_1 = 3, field_2 = () \<rparr> = (make_foo 3 () :: (nat, unit) foo)" ..

lemma "(make_foo a b) \<lparr> field_1 := y \<rparr> = make_foo y b"
  by (simp add: datatype_record_update)

lemma "(make_foo a b) \<lparr> foo.field_1 := y \<rparr> = make_foo y b"
  by (simp add: datatype_record_update)

text \<open>Existing datatypes\<close>

datatype x = X (a: int) (b: int)

lemma "\<lparr> a = 1, b = 2 \<rparr> = X 1 2" ..

local_setup \<open>Datatype_Records.mk_update_defs \<^type_name>\<open>x\<close>\<close>

lemma "(X 1 2) \<lparr> b := 3 \<rparr> = X 1 3"
  by (simp add: datatype_record_update)

text \<open>Nested recursion\<close>

datatype_record 'a container =
  content :: "'a option"

datatype 'a contrived = Contrived "'a contrived container"

term "Contrived \<lparr> content = None \<rparr>"

text \<open>Supports features of @{command datatype}\<close>

datatype_record (plugins del: code) (dead 'a :: finite, b_set: 'b) rec =
  field_1 :: 'a
  field_2 :: 'b

lemma "b_set \<lparr> field_1 = True, field_2 = False \<rparr> = {False}"
  by simp

text \<open>More tests\<close>

datatype_record ('a, 'b) test1 =
  field_t11 :: 'a
  field_t12 :: 'b
  field_t13 :: nat
  field_t14 :: int

thm test1.record_simps

definition ID where "ID x = x"
lemma ID_cong[cong]: "ID x = ID x" by (rule refl)

lemma "update_field_t11 f (update_field_t12 g (update_field_t11 h x)) = ID (update_field_t12 g (update_field_t11 (\<lambda>x. f (h x)) x))"
  apply (simp only: test1.record_simps)
  apply (subst ID_def)
  apply (rule refl)
  done

end


section {*lists\_set*}
theory
  lists_set

imports
  lists_append_Cons

begin

lemma nset_diff: "
  x  \<in> set w
  \<Longrightarrow> set w \<subseteq> A - {x}
  \<Longrightarrow> P"
  apply(force)
  done

lemma not_in_diff: "
  set x \<subseteq> A - {y}
  \<Longrightarrow> y \<notin> set x"
  apply(force)
  done

lemma triv_compl: "
  set w \<subseteq> A - {X}
  \<Longrightarrow> X \<notin> set w"
  apply(force)
  done

lemma set_append_contra1: "
  a \<in> set w
  \<Longrightarrow>a\<notin>(set (w@v))
  \<Longrightarrow>P"
  apply(force)
  done

lemma set_append_contra2: "
  a \<in> set w
  \<Longrightarrow>a\<notin>(set (v@w))
  \<Longrightarrow>P"
  apply(force)
  done

lemma set_Cons: "
  set (a#w) = {a} \<union> set w"
  apply(force)
  done

lemma map_set_subset: "
  set w \<subseteq> A
  \<Longrightarrow> set (map f w) \<subseteq> f ` A"
  apply(auto)
  done

lemma set_app_subset: "
  set w \<subseteq> set (w@v)"
  apply(force)
  done

lemma elim_Some_from_list: "
  None \<notin> set w
  \<Longrightarrow> \<exists>v. map Some v = w"
  apply(induct w)
   apply(auto)
  apply(rename_tac a v)(*strict*)
  apply(case_tac a)
   apply(rename_tac a v)(*strict*)
   apply(auto)
  apply(rename_tac v aa)(*strict*)
  apply(rule_tac
      x = "aa#v"
      in exI)
  apply(auto)
  done

lemma set_append1: "
  set a \<subseteq> set (a@b)"
  apply(clarsimp)
  done

lemma set_append2: "
  set a \<subseteq> set (b@a)"
  apply(clarsimp)
  done

lemma not_set_append: "
  a\<notin> set w
  \<Longrightarrow> a\<notin>set v
  \<Longrightarrow> a\<notin>(set (w@v))"
  apply(force)
  done

lemma set_bi_append: "
  set w \<subseteq> set (w1@w@w2)"
  apply(induct w)
   apply(clarsimp)
  apply(rename_tac a w)(*strict*)
  apply(clarsimp)
  done

lemma elem_set_app: "
  a \<notin> set (w @ v)
  \<Longrightarrow> a  \<in> set v
  \<Longrightarrow> P"
  apply(auto)
  done

lemma set_subset_in: "
  set ([q]) \<subseteq> A
  \<Longrightarrow> q  \<in> A"
  apply(force)
  done

lemma set_subset_in2: "
  q  \<in> A
  \<Longrightarrow> set ([q]) \<subseteq> A"
  apply(force)
  done

lemma set_take_head: "
  a \<noteq> b
  \<Longrightarrow> a \<notin> set w
  \<Longrightarrow> a \<notin> set(b#w)"
  apply(auto)
  done

lemma head_in_set: "
  w = a#w'
  \<Longrightarrow> a \<in> set w"
  apply(force)
  done

lemma set_take_head2: "
  a \<in> A
  \<Longrightarrow> set w \<subseteq> A
  \<Longrightarrow> set (a#w) \<subseteq> A"
  apply(auto)
  done

lemma set_concat_subset: "
  set a \<subseteq> A
  \<Longrightarrow> set b \<subseteq> A
  \<Longrightarrow> set (a@b)\<subseteq>A"
  apply(auto)
  done

end