theory Hilbert
imports ZF
begin

axiomatization
  Choose :: "i \<Rightarrow> i"

axiomatization where
  Choose_def: "~(A = 0) \<Longrightarrow> Choose(A):A"

theorem Collect_not_empty: "\<lbrakk> EX x:A. P(x) \<rbrakk> \<Longrightarrow> ~({x:A. P(x)}=0)"
apply(auto)
done

theorem Choose_Collect: "\<And>P. \<lbrakk> EX x:A. P(x) \<rbrakk> \<Longrightarrow> P(Choose({x:A. P(x)}))"
apply(frule Collect_not_empty)
apply(insert Choose_def, auto)
done

theorem skolem_intro: "(ALL t:A. EX z:B. Q(t, z)) \<longleftrightarrow> (EX z1:A\<rightarrow>B. ALL t:A. Q(t, z1 ` t))"
apply(auto)
apply(rule bexI)
proof -
  assume a: "\<forall>t\<in>A. \<exists>z\<in>B. Q(t, z)"
  let ?z1.13 = "(\<lambda> t\<in>A. Choose({x:B. Q(t, x)}))"
  {
    fix t
    assume b: "t:A"
    then have c: "\<exists>z\<in>B. Q(t, z)" using a by(auto)
    then have imp: "Q(t, Choose({x:B. Q(t, x)}))"
      using Choose_Collect[of B "\<lambda> x. Q(t, x)"] by simp
    have d: "Choose({x:B. Q(t, x)}) = (\<lambda> t\<in>A. Choose({x:B. Q(t, x)})) ` t" using b by(auto)
    then have "Q(t, (\<lambda> t\<in>A. Choose({x:B. Q(t, x)})) ` t)" using imp by simp
  } then show "\<forall>t\<in>A. Q(t, ?z1.13 ` t)" by simp
  have e: "(\<lambda> t\<in>A. Choose({x:B. Q(t, x)})) : A \<rightarrow> {Choose({x:B. Q(t', x)}) . t' \<in> A}"
    using lam_funtype[of A "\<lambda> l. Choose({x \<in> B . Q(l, x)})"] by simp
  {
    fix l
    assume b: "l:A"
    then have c: "\<exists>z\<in>B. Q(l, z)" using a by(auto)
    have "{x \<in> B . Q(t, x)} \<subseteq> B" by(auto)
    then have "Choose({x:B. Q(l, x)}):B"
      using c Choose_def[of "{x \<in> B . Q(l, x)}"] by(auto)
  } then have "{Choose({x:B. Q(t', x)}) . t' \<in> A} \<subseteq> B"
     using RepFun_subset[of A "\<lambda> l. Choose({x \<in> B . Q(l, x)})" B] by simp
  then show "(\<lambda> t\<in>A. Choose({x:B. Q(t, x)})) : A \<rightarrow> B"
     using e fun_weaken_type by simp
qed

end


(* Author: Tobias Nipkow *)

subsection "Hoare Logic for Total Correctness"

theory Hoare_Total
imports Hoare_Examples
begin

subsubsection "Hoare Logic for Total Correctness --- Separate Termination Relation"

text{* Note that this definition of total validity @{text"\<Turnstile>\<^sub>t"} only
works if execution is deterministic (which it is in our case). *}

definition hoare_tvalid :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool"
  ("\<Turnstile>\<^sub>t {(1_)}/ (_)/ {(1_)}" 50) where
"\<Turnstile>\<^sub>t {P}c{Q}  \<longleftrightarrow>  (\<forall>s. P s \<longrightarrow> (\<exists>t. (c,s) \<Rightarrow> t \<and> Q t))"

text{* Provability of Hoare triples in the proof system for total
correctness is written @{text"\<turnstile>\<^sub>t {P}c{Q}"} and defined
inductively. The rules for @{text"\<turnstile>\<^sub>t"} differ from those for
@{text"\<turnstile>"} only in the one place where nontermination can arise: the
@{term While}-rule. *}

inductive
  hoaret :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool" ("\<turnstile>\<^sub>t ({(1_)}/ (_)/ {(1_)})" 50)
where

Skip:  "\<turnstile>\<^sub>t {P} SKIP {P}"  |

Assign:  "\<turnstile>\<^sub>t {\<lambda>s. P(s[a/x])} x::=a {P}"  |

Seq: "\<lbrakk> \<turnstile>\<^sub>t {P\<^sub>1} c\<^sub>1 {P\<^sub>2}; \<turnstile>\<^sub>t {P\<^sub>2} c\<^sub>2 {P\<^sub>3} \<rbrakk> \<Longrightarrow> \<turnstile>\<^sub>t {P\<^sub>1} c\<^sub>1;;c\<^sub>2 {P\<^sub>3}"  |

If: "\<lbrakk> \<turnstile>\<^sub>t {\<lambda>s. P s \<and> bval b s} c\<^sub>1 {Q}; \<turnstile>\<^sub>t {\<lambda>s. P s \<and> \<not> bval b s} c\<^sub>2 {Q} \<rbrakk>
  \<Longrightarrow> \<turnstile>\<^sub>t {P} IF b THEN c\<^sub>1 ELSE c\<^sub>2 {Q}"  |

While:
  "(\<And>n::nat.
    \<turnstile>\<^sub>t {\<lambda>s. P s \<and> bval b s \<and> T s n} c {\<lambda>s. P s \<and> (\<exists>n'<n. T s n')})
   \<Longrightarrow> \<turnstile>\<^sub>t {\<lambda>s. P s \<and> (\<exists>n. T s n)} WHILE b DO c {\<lambda>s. P s \<and> \<not>bval b s}"  |

conseq: "\<lbrakk> \<forall>s. P' s \<longrightarrow> P s; \<turnstile>\<^sub>t {P}c{Q}; \<forall>s. Q s \<longrightarrow> Q' s  \<rbrakk> \<Longrightarrow>
           \<turnstile>\<^sub>t {P'}c{Q'}"

text{* The @{term While}-rule is like the one for partial correctness but it
requires additionally that with every execution of the loop body some measure
relation @{term[source]"T :: state \<Rightarrow> nat \<Rightarrow> bool"} decreases.
The following functional version is more intuitive: *}

lemma While_fun:
  "\<lbrakk> \<And>n::nat. \<turnstile>\<^sub>t {\<lambda>s. P s \<and> bval b s \<and> n = f s} c {\<lambda>s. P s \<and> f s < n}\<rbrakk>
   \<Longrightarrow> \<turnstile>\<^sub>t {P} WHILE b DO c {\<lambda>s. P s \<and> \<not>bval b s}"
  by (rule While [where T="\<lambda>s n. n = f s", simplified])

text{* Building in the consequence rule: *}

lemma Assign': "\<forall>s. P s \<longrightarrow> Q(s[a/x]) \<Longrightarrow> \<turnstile>\<^sub>t {P} x ::= a {Q}"
by (simp add: strengthen_pre[OF _ Assign])

lemma While_fun':
assumes "\<And>n::nat. \<turnstile>\<^sub>t {\<lambda>s. P s \<and> bval b s \<and> n = f s} c {\<lambda>s. P s \<and> f s < n}"
    and "\<forall>s. P s \<and> \<not> bval b s \<longrightarrow> Q s"
shows "\<turnstile>\<^sub>t {P} WHILE b DO c {Q}"
by(blast intro: assms(1) weaken_post[OF While_fun assms(2)])

text{* Our standard example: *}

lemma "\<turnstile>\<^sub>t {\<lambda>s. s ''x'' = i} ''y'' ::= N 0;; wsum {\<lambda>s. s ''y'' = sum i}"
apply(rule Seq)
 prefer 2
 apply(rule While_fun' [where P = "\<lambda>s. (s ''y'' = sum i - sum(s ''x''))"
    and f = "\<lambda>s. nat(s ''x'')"])
   apply(rule Seq)
   prefer 2
   apply(rule Assign)
  apply(rule Assign')
  apply simp
 apply(simp)
apply(rule Assign')
apply simp
done

text{* The soundness theorem: *}

theorem hoaret_sound: "\<turnstile>\<^sub>t {P}c{Q}  \<Longrightarrow>  \<Turnstile>\<^sub>t {P}c{Q}"
proof(unfold hoare_tvalid_def, induction rule: hoaret.induct)
  case (While P b T c)
  {
    fix s n
    have "\<lbrakk> P s; T s n \<rbrakk> \<Longrightarrow> \<exists>t. (WHILE b DO c, s) \<Rightarrow> t \<and> P t \<and> \<not> bval b t"
    proof(induction "n" arbitrary: s rule: less_induct)
      case (less n)
      thus ?case by (metis While.IH WhileFalse WhileTrue)
    qed
  }
  thus ?case by auto
next
  case If thus ?case by auto blast
qed fastforce+

text{*
The completeness proof proceeds along the same lines as the one for partial
correctness. First we have to strengthen our notion of weakest precondition
to take termination into account: *}

definition wpt :: "com \<Rightarrow> assn \<Rightarrow> assn" ("wp\<^sub>t") where
"wp\<^sub>t c Q  =  (\<lambda>s. \<exists>t. (c,s) \<Rightarrow> t \<and> Q t)"

lemma [simp]: "wp\<^sub>t (x ::= e) Q = (\<lambda>s. Q(s(x := aval e s)))"
by(auto intro!: ext simp: wpt_def)

lemma [simp]: "wp\<^sub>t (c\<^sub>1;;c\<^sub>2) Q = wp\<^sub>t c\<^sub>1 (wp\<^sub>t c\<^sub>2 Q)"
unfolding wpt_def
apply(rule ext)
apply auto
done

lemma [simp]:
 "wp\<^sub>t (IF b THEN c\<^sub>1 ELSE c\<^sub>2) Q = (\<lambda>s. wp\<^sub>t (if bval b s then c\<^sub>1 else c\<^sub>2) Q s)"
apply(unfold wpt_def)
apply(rule ext)
apply auto
done

text{* Now we define the number of iterations @{term "WHILE b DO c"} needs to
terminate when started in state @{text s}. Because this is a truly partial
function, we define it as an (inductive) relation first: *}

inductive Its :: "bexp \<Rightarrow> com \<Rightarrow> state \<Rightarrow> nat \<Rightarrow> bool" where
Its_0: "\<not> bval b s \<Longrightarrow> Its b c s 0" |
Its_Suc: "\<lbrakk> bval b s;  (c,s) \<Rightarrow> s';  Its b c s' n \<rbrakk> \<Longrightarrow> Its b c s (Suc n)"

text{* The relation is in fact a function: *}

lemma Its_fun: "Its b c s n \<Longrightarrow> Its b c s n' \<Longrightarrow> n=n'"
proof(induction arbitrary: n' rule:Its.induct)
  case Its_0 thus ?case by(metis Its.cases)
next
  case Its_Suc thus ?case by(metis Its.cases big_step_determ)
qed

text{* For all terminating loops, @{const Its} yields a result: *}

lemma WHILE_Its: "(WHILE b DO c,s) \<Rightarrow> t \<Longrightarrow> \<exists>n. Its b c s n"
proof(induction "WHILE b DO c" s t rule: big_step_induct)
  case WhileFalse thus ?case by (metis Its_0)
next
  case WhileTrue thus ?case by (metis Its_Suc)
qed

lemma wpt_is_pre: "\<turnstile>\<^sub>t {wp\<^sub>t c Q} c {Q}"
proof (induction c arbitrary: Q)
  case SKIP show ?case by (auto intro:hoaret.Skip)
next
  case Assign show ?case by (auto intro:hoaret.Assign)
next
  case Seq thus ?case by (auto intro:hoaret.Seq)
next
  case If thus ?case by (auto intro:hoaret.If hoaret.conseq)
next
  case (While b c)
  let ?w = "WHILE b DO c"
  let ?T = "Its b c"
  have "\<forall>s. wp\<^sub>t ?w Q s \<longrightarrow> wp\<^sub>t ?w Q s \<and> (\<exists>n. Its b c s n)"
    unfolding wpt_def by (metis WHILE_Its)
  moreover
  { fix n
    let ?R = "\<lambda>s'. wp\<^sub>t ?w Q s' \<and> (\<exists>n'<n. ?T s' n')"
    { fix s t assume "bval b s" and "?T s n" and "(?w, s) \<Rightarrow> t" and "Q t"
      from `bval b s` and `(?w, s) \<Rightarrow> t` obtain s' where
        "(c,s) \<Rightarrow> s'" "(?w,s') \<Rightarrow> t" by auto
      from `(?w, s') \<Rightarrow> t` obtain n' where "?T s' n'"
        by (blast dest: WHILE_Its)
      with `bval b s` and `(c, s) \<Rightarrow> s'` have "?T s (Suc n')" by (rule Its_Suc)
      with `?T s n` have "n = Suc n'" by (rule Its_fun)
      with `(c,s) \<Rightarrow> s'` and `(?w,s') \<Rightarrow> t` and `Q t` and `?T s' n'`
      have "wp\<^sub>t c ?R s" by (auto simp: wpt_def)
    }
    hence "\<forall>s. wp\<^sub>t ?w Q s \<and> bval b s \<and> ?T s n \<longrightarrow> wp\<^sub>t c ?R s"
      unfolding wpt_def by auto
      (* by (metis WhileE Its_Suc Its_fun WHILE_Its lessI) *)
    note strengthen_pre[OF this While.IH]
  } note hoaret.While[OF this]
  moreover have "\<forall>s. wp\<^sub>t ?w Q s \<and> \<not> bval b s \<longrightarrow> Q s"
    by (auto simp add:wpt_def)
  ultimately show ?case by (rule conseq)
qed

text{*\noindent In the @{term While}-case, @{const Its} provides the obvious
termination argument.

The actual completeness theorem follows directly, in the same manner
as for partial correctness: *}

theorem hoaret_complete: "\<Turnstile>\<^sub>t {P}c{Q} \<Longrightarrow> \<turnstile>\<^sub>t {P}c{Q}"
apply(rule strengthen_pre[OF _ wpt_is_pre])
apply(auto simp: hoare_tvalid_def wpt_def)
done

corollary hoaret_sound_complete: "\<turnstile>\<^sub>t {P}c{Q} \<longleftrightarrow> \<Turnstile>\<^sub>t {P}c{Q}"
by (metis hoaret_sound hoaret_complete)

end


(*  Title:      Sequents/Washing.thy
    Author:     Sara Kalvala
*)

theory Washing
imports ILL
begin

axiomatization
  dollar :: o and
  quarter :: o and
  loaded :: o and
  dirty :: o and
  wet :: o and
  clean :: o
where
  change:
  "dollar |- (quarter >< quarter >< quarter >< quarter)" and

  load1:
  "quarter , quarter , quarter , quarter , quarter |- loaded" and

  load2:
  "dollar , quarter |- loaded" and

  wash:
  "loaded , dirty |- wet" and

  dry:
  "wet, quarter , quarter , quarter |- clean"

(* "activate" definitions for use in proof *)

ML {* ML_Thms.bind_thms ("changeI", [@{thm context1}] RL ([@{thm change}] RLN (2,[@{thm cut}]))) *}
ML {* ML_Thms.bind_thms ("load1I", [@{thm context1}] RL ([@{thm load1}] RLN (2,[@{thm cut}]))) *}
ML {* ML_Thms.bind_thms ("washI", [@{thm context1}] RL ([@{thm wash}] RLN (2,[@{thm cut}]))) *}
ML {* ML_Thms.bind_thms ("dryI", [@{thm context1}] RL ([@{thm dry}] RLN (2,[@{thm cut}]))) *}

(* a load of dirty clothes and two dollars gives you clean clothes *)

lemma "dollar , dollar , dirty |- clean"
  by (best add!: changeI load1I washI dryI)

(* order of premises doesn't matter *)

lemma "dollar , dirty , dollar |- clean"
  by (best add!: changeI load1I washI dryI)

(* alternative formulation *)

lemma "dollar , dollar |- dirty -o clean"
  by (best add!: changeI load1I washI dryI)

end


theory K_Approval_Rule
imports Scoring_Rules
        "Compositional_Structures/Basic_Modules/K_Approval_Module"
        "Compositional_Structures/Elect_Composition"

begin

lemma one_approval_elect:
  shows "electoral_module (elector one_approval)"
proof(unfold one_approval_def)
  show "electoral_module (elector (max_eliminator (scoring (vector_A_k_approval 1))))"
     using scoring_mod_A by blast
qed

lemma k_approval_elect:
  shows "electoral_module (elector (k_approval k))"
proof(unfold k_approval.simps)
  show "electoral_module (elector (max_eliminator (scoring (vector_A_k_approval k))))"
    using scoring_mod_A by blast
qed

lemma k_approval_hom:
  shows "homogeneity (elector (k_approval k))" unfolding k_approval.simps
  using scoring_rules_homogeneity
  by blast

lemma k_approval_reinforcement:
  shows "reinforcement (elector (k_approval k))" unfolding k_approval.simps
  using scoring_module_rein
  by blast

end


theory T117
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. undr(x, join(y, z)) = join(undr(x, y), undr(x, 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. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(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(join(x, y), z) = join(over(x, z), over(y, z)))
"
nitpick[card nat=7,timeout=86400]
oops
end


theory T99
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. undr(x, join(y, z)) = join(undr(x, y), undr(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. over(join(x, y), z) = join(over(x, z), over(y, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


section \<open> ODE Certification Tactic \<close>

theory ODE_Cert
  imports
    Derivative_extra
    "Ordinary_Differential_Equations.ODE_Analysis"
begin

text \<open> \emph{ode\_cert} is a simple tactic for certifying solutions to systems of differential equations \<close>

method ode_cert =
  \<comment> \<open> Apply the introduction rule \<close>
  (rule_tac solves_odeI,
  \<comment> \<open> Simplify away the set-wise vector derivative definition \<close>
    simp_all add: has_vderiv_on_def,
  \<comment> \<open> Split apart individual ODEs composed pair-wise \<close>
    safe intro!: has_vector_derivative_Pair,
  \<comment> \<open> Raise two goals, with a linking meta-variable: (1) the derivative goal, (2) a goal that
      the resulting derivative is equal to the target \<close>
    (rule has_vector_derivative_eq_rhs,
  \<comment> \<open> Recursively apply derivative introduction laws to (1) \<close>
      (rule derivative_intros; (simp)?)+,
  \<comment> \<open> Simplify away (2) using field laws \<close>
      simp add: field_simps)+)

type_synonym 'c ODE = "real \<Rightarrow> 'c \<Rightarrow> 'c"

text \<open> A simple example is the following system of ODEs for an objecting accelerating according to gravity. \<close>

abbreviation "grav \<equiv> 9.81"

abbreviation grav_ode :: "(real \<times> real) ODE" where
"grav_ode \<equiv> (\<lambda> t (v, h). (- grav, v))"

text \<open> We also present the following solution to the system of ODEs, which is a function from
  initial values of the continuous variables to a continuous function that shows how the variables
  change with time. \<close>

abbreviation grav_sol :: "real \<times> real \<Rightarrow> real \<Rightarrow>  real \<times> real" where
"grav_sol \<equiv> \<lambda> (v\<^sub>0, h\<^sub>0)  \<tau>. (v\<^sub>0 - grav * \<tau>, v\<^sub>0 * \<tau> - grav * (\<tau> * \<tau>) / 2 + h\<^sub>0)"

text \<open> Finally, we show how this solution to the ODEs can be certified. \<close>

lemma
  "(grav_sol (v\<^sub>0, h\<^sub>0) solves_ode grav_ode) T UNIV"
  by ode_cert

text \<open> More examples \<close>

lemma "((\<lambda> t. exp t) solves_ode (\<lambda> t y. y)) T UNIV"
  by ode_cert

lemma "((\<lambda> t. (cos t, sin t)) solves_ode (\<lambda> t (x, y). (-y, x))) T UNIV"
  by ode_cert

end


theory first_incompleteness_class
  imports embedding
begin
nitpick_params[assms=true, user_axioms=true, show_all, expect=genuine, format = 3]

section \<open>First Incompleteness Theorem (classical scenario)\<close>

(* Gödel's first incompleteness theorem:

Assume F is a consistent formal system which contains arithmetic.
Let G\<^sub>F be a formula (hinging on F) that satisfies the fixed-point
condition: \<^bold>\<turnstile> G\<^sub>F \<^bold>\<leftrightarrow> \<^bold>\<sim>\<^bold>\<box>G\<^sub>F, then:

-  G\<^sub>F is non-provable in F, i.e. F \<^bold>\<turnstile>/ G\<^sub>F
-  G\<^sub>F is non-refutable in F, i.e. F \<^bold>\<turnstile>/ \<^bold>\<sim>G\<^sub>F
*)

(* We employ the model finder Nitpick to verify that the problem is not trivial: *)
lemma "\<forall>P.  [\<^bold>\<turnstile> P] \<or>  [\<^bold>\<turnstile> \<^bold>\<sim>P]" nitpick[card w=2] oops (* countermodel found *)
lemma "\<exists>P. \<sim>[\<^bold>\<turnstile> P] \<and> \<sim>[\<^bold>\<turnstile> \<^bold>\<sim>P]" nitpick[card w=1] oops (* countermodel found *)

(* If F is consistent, then F \<^bold>\<turnstile>/ G\<^sub>(\<^sub>F\<^sub>) *)
lemma non_provable: fixes G                 (* G is fixed but arbitrary *)
                    assumes "[\<^bold>\<turnstile> G \<^bold>\<leftrightarrow> \<^bold>\<sim>\<^bold>\<box>G]"          (* G's fixed-point *)
                    shows   "\<sim>[\<^bold>\<turnstile> G]"              (* G is non-provable *)
proof
  assume Gprov: "[\<^bold>\<turnstile> G]"                       (* assume G were provable *)
  hence "[\<^bold>\<turnstile> \<^bold>\<box>G]" by simp                            (* by necessitation *)
  hence negGprov: "[\<^bold>\<turnstile> \<^bold>\<sim>G]" using assms(1) by blast  (* using fixed-point*)
  from Gprov negGprov have "[\<^bold>\<turnstile> \<^bold>\<bottom>]" by simp      (* by plain consistency *)
  thus False by simp
qed

(* If F is \<^bold>*-consistent, then F \<^bold>\<turnstile>/ \<^bold>\<sim>G\<^sub>(\<^sub>F\<^sub>) *)
lemma non_refutable_v1: fixes G             (* G is fixed but arbitrary *)
                        assumes "[\<^bold>\<turnstile> G \<^bold>\<leftrightarrow> \<^bold>\<sim>\<^bold>\<box>G]"      (* G's fixed-point *)
                        and     "\<forall>\<phi>. \<sim>[\<^bold>\<turnstile> \<^bold>\<sim>\<phi> \<^bold>\<and> \<^bold>\<box>\<phi>]"   (* *-consistency *)
                        shows   "\<sim>[\<^bold>\<turnstile> \<^bold>\<sim>G]"        (* G is non-refutable *)
proof
  assume negGprov: "[\<^bold>\<turnstile> \<^bold>\<sim>G]"                  (* assume G were refutable *)
  hence provGprov: "[\<^bold>\<turnstile> \<^bold>\<box>G]" using assms(1) by blast  (* using fixed-point*)
  have Gcons: "\<sim>[\<^bold>\<turnstile> \<^bold>\<sim>G \<^bold>\<and> \<^bold>\<box>G]" using assms(2) by (rule allE) (*G is *-con.*)
  from negGprov provGprov have "[\<^bold>\<turnstile> \<^bold>\<sim>G \<^bold>\<and> \<^bold>\<box>G]" by simp       (* by \<^bold>\<and>-intr.*)
  hence "[\<^bold>\<turnstile> \<^bold>\<bottom>]" using Gcons by simp         (* using *-consistency of G *)
  thus False by simp
qed

(* If F is S-consistent, then F \<^bold>\<turnstile>/ \<^bold>\<sim>G\<^sub>(\<^sub>F\<^sub>) *)
lemma non_refutable_v2: fixes G             (* G is fixed but arbitrary *)
                        assumes "[\<^bold>\<turnstile> G \<^bold>\<leftrightarrow> \<^bold>\<sim>\<^bold>\<box>G]"      (* G's fixed-point *)
                        and     "\<forall>\<phi>. [\<^bold>\<turnstile> \<^bold>\<box>\<phi>]\<longrightarrow>[\<^bold>\<turnstile> \<phi>]"  (* S-consistency *)
                        shows   "\<sim>[\<^bold>\<turnstile> \<^bold>\<sim>G]"        (* G is non-refutable *)
proof
  assume negGprov: "[\<^bold>\<turnstile> \<^bold>\<sim>G]"                  (* assume G were refutable *)
  hence provGprov: "[\<^bold>\<turnstile> \<^bold>\<box>G]" using assms(1) by blast (* using fixed-point*)
  have  "[\<^bold>\<turnstile> \<^bold>\<box>G] \<longrightarrow> [\<^bold>\<turnstile> G]" using assms(2) by (rule allE)  (* G is S-con.*)
  hence "[\<^bold>\<turnstile> G]" using provGprov by (rule mp)         (* by modus ponens *)
  hence "[\<^bold>\<turnstile> \<^bold>\<bottom>]" using negGprov by simp          (* by plain consistency *)
  thus False by simp
qed

section \<open>Experiments with other variants\<close>

abbreviation "P_consistency_a \<equiv>  \<sim>[\<^bold>\<turnstile> \<^bold>\<box>\<^bold>\<bottom>]"
abbreviation "P_consistency_b \<equiv>  [\<^bold>\<turnstile> \<^bold>\<sim>\<^bold>\<box>\<^bold>\<bottom>]"

(* If F is P-consistent-a, then F \<^bold>\<turnstile>/ \<^bold>\<sim>G\<^sub>F *)
lemma non_refutable_v3: fixes G
                        assumes "[\<^bold>\<turnstile> G \<^bold>\<leftrightarrow> \<^bold>\<sim>\<^bold>\<box>G]"
                        and     P_consistency_a
                        shows   "\<sim>[\<^bold>\<turnstile> \<^bold>\<sim>G]"
  using assms(1) assms(2) by blast

(* If F is P-consistent-b, then F \<^bold>\<turnstile>/ \<^bold>\<sim>G\<^sub>F *)
lemma non_refutable_v4: fixes G
                        assumes "[\<^bold>\<turnstile> G \<^bold>\<leftrightarrow> \<^bold>\<sim>\<^bold>\<box>G]"
                        and     P_consistency_b
                        shows   "\<sim>[\<^bold>\<turnstile> \<^bold>\<sim>G]"
  using assms(1) assms(2) by blast

end


theory Scoring_Rules
  imports
          "Compositional_Structures/Basic_Modules/Scoring_Module"
          "Compositional_Structures/Elect_Composition"
          "Compositional_Structures/Basic_Modules/Condorcet_Module"

(*Electoral_Module Evaluation_Function Elect_Module Elimination_Module Condorcet_Rule*)
begin

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

lemma scoring_mod_A[simp]:
  shows "electoral_module (elector(max_eliminator
        ((scoring (v:: 'a Vector_A))::'a Evaluation_Function)))"
  by auto

lemma scoring4_mod_A[simp]:
  shows "electoral_module (elector(max_eliminator
      ((scoring4 (v:: 'a Vector_A))::'a Evaluation_Function)))"
  by auto

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

(*Addieren von Profilen für scoring*)
lemma add_scoring_profiles:
  shows "(scoring v x A (b@p) (vs1@vs2) = (scoring v x A b vs1) + (scoring v x A p vs2))"
proof(induct b)
case Nil
then show ?case by auto
next
case (Cons a b)
  then show ?case by auto
qed

lemma times_profile:
  shows "times (Suc(n)) p = p @ (times n p)" by auto

lemma scoring_move_out:
  shows "scoring v x A (p @ (times n p)) (vs @ (times n vs))
  = scoring v x A p vs + scoring v x A (times n p) (times n vs)"
  by (metis add_scoring_profiles)

lemma times_scoring:
  shows "(scoring v x A (times n p) (times n vs)) = scoring v 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 scoring_move_out times_profile)
qed

lemma max_split_scoring:
  shows
    "Max {scoring v x A (b@p) (vs1@vs2) |x. x \<in> A} =
     Max {(scoring v x A b vs1) + (scoring v x A p vs2) |x. x \<in> A}"
  by (metis add_scoring_profiles)

lemma Max_homo_add:
  fixes k::nat
  assumes "finite A" and "A \<noteq> {}"
  shows "Max {scoring v x A p vs + k |x. x\<in>A} = Max {scoring v 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 "{scoring v x A p vs + k|x. x\<in>A} = (\<lambda>y. y + k) ` {scoring v x A p vs|x. x\<in>A}" by auto
  also have "Max \<dots> = Max {scoring v x A p vs|x. x\<in>A} + k"
    using assms hom_Max_commute [of "\<lambda>y. y+k" "{scoring v x A p vs|x. x\<in>A}", OF m, symmetric] by simp
  finally show ?thesis by simp
qed

lemma Max_homo_mult_eval:
  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:
  fixes k::nat
  assumes "finite A" and "A \<noteq> {}"
  shows "Max {scoring v x A p vs * k |x. x\<in>A} = Max {scoring v x A p vs|x. x\<in>A} * k" using Max_homo_mult_eval
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 "{scoring v x A p vs * k|x. x\<in>A} = (\<lambda>y. y * k) ` {scoring v x A p vs|x. x\<in>A}" by auto
  also have "Max \<dots> = Max {scoring v x A p vs|x. x\<in>A} * k"
    using assms hom_Max_commute [of "\<lambda>y. y*k" "{scoring v x A p vs|x. x\<in>A}", OF m, symmetric] by simp
  finally show ?thesis by simp
qed

(** Homogeneity Beweis**)
(*scoring*)
lemma for_goal1:
  shows "\<And>A p n x xb. x \<in> A \<Longrightarrow>finite A \<Longrightarrow>profile A p \<Longrightarrow> 0 < n \<Longrightarrow> xb \<in> A \<Longrightarrow>
scoring v xb A p vs < Max {scoring v x A p vs|x. x \<in> A} \<Longrightarrow>
scoring v xb A (concat (replicate n p)) vs < Max {scoring v x A (concat (replicate n 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 {scoring v x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} =
        Max {scoring v x A p vs * n |x. x \<in> A}"
      using times_scoring by (metis times.simps)
  then have 1:  "Max {scoring v x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} =
      n* Max {scoring v x A p vs|x. x \<in> A}"
  proof -
    have "\<And>A f rs n vs. infinite A \<or> A = Collect bot \<or>
        Max {scoring f (a::'a) A rs vs|a. a \<in> A} * n = Max {scoring f a A rs vs * n |a. a \<in> A}"
      using Max_homo_mult by fastforce
    then have f5: "\<And>f rs n vs. Max {scoring f a A rs vs|a. a \<in> A} * n =
              Max {scoring f a A rs vs * n |a. a \<in> A}"
      using a4 a1 by blast
    have
      "Max {scoring v a A (concat (replicate n p)) (concat (replicate n vs))|a. a \<in> A}
      = Max {scoring v a A p vs * n |a. a \<in> A}"
      using "0" by blast
    then show "Max {scoring v a A (concat (replicate n p)) (concat (replicate n vs))|a. a \<in> A} =
          n * Max {scoring v a A p vs|a. a \<in> A}"
      using f5 by (simp add: mult.commute)
  qed
  have 2:"scoring v xb A p vs < Max {scoring v x A p vs|x. x \<in> A} \<Longrightarrow>
            n* scoring v xb A p vs < n* Max {scoring v x A p vs|x. x \<in> A}"
    using a3 mult_less_mono2 by blast
  then have 3: "n* scoring v xb A p vs < n* Max {scoring v x A p vs|x. x \<in> A} \<Longrightarrow>
    scoring v xb A (concat (replicate n p)) (concat (replicate n vs)) <
    Max {scoring v 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 "scoring v xb A p vs < Max {scoring v x A p vs|x. x \<in> A} \<Longrightarrow>
    scoring v xb A (concat (replicate n p)) vs <
    Max {scoring v x A (concat (replicate n p)) vs|x. x \<in> A}"
    using 2 3 by auto
qed

lemma for_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>
       scoring v xb A (concat (replicate n p)) (concat (replicate n vs)) <
       Max {scoring v x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A}
        \<Longrightarrow> scoring v xb A p vs< Max {scoring v 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 {scoring v x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} =
    Max {scoring v x A p vs * n |x. x \<in> A}"
      using times_scoring by (metis times.simps)
    then have 1:  "Max {scoring v x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} =
          n* Max {scoring v x A p vs|x. x \<in> A}"
proof -
  have "\<And>A f rs n vs. infinite A \<or> A = Collect bot \<or> Max {scoring f (a::'a) A rs vs|a. a \<in> A} * n =
          Max {scoring f a A rs vs * n |a. a \<in> A}"
    using Max_homo_mult by fastforce
    then have f5:
      "\<And>f rs n. Max {scoring f a A rs vs|a. a \<in> A} * n = Max {scoring f a A rs vs * n |a. a \<in> A}"
      using a4 a1 by blast
    have
      "Max {scoring v a A (concat (replicate n p)) (concat (replicate n vs))|a. a \<in> A} =
      Max {scoring v a A p vs * n |a. a \<in> A}"
      using "0" by blast
    then show "Max {scoring v a A (concat (replicate n p)) (concat (replicate n vs))|a. a \<in> A} =
            n * Max {scoring v a A p vs|a. a \<in> A}"
      using f5 by (simp add: mult.commute)
  qed
  have 2:" n* scoring v xb A p vs < n* Max {scoring v x A p vs|x. x \<in> A} \<Longrightarrow>
            scoring v xb A p vs < Max {scoring v x A p vs|x. x \<in> A}"
    by simp
  then have 3: "n* scoring v xb A p vs < n* Max {scoring v x A p vs|x. x \<in> A} \<Longrightarrow>
     scoring v xb A (concat (replicate n p)) (concat (replicate n vs)) <
     Max {scoring v 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 "scoring v xb A (concat (replicate n p)) (concat (replicate n vs)) <
        Max {scoring v x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} \<Longrightarrow>
        scoring v xb A p vs < Max {scoring v x A p vs|x. x \<in> A}"
    using 2 3 by (metis (no_types, lifting) "1" mult.commute times.simps times_scoring)
qed

(***** Für Black's Rule bzw Condorcet *****)

lemma add_prefer_profiles_code:
  shows "(prefer_count_code (b@p) x y = (prefer_count_code b x y) + (prefer_count_code p x y))"
proof(induct b)
  case Nil
  then show ?case by auto
next
  case (Cons a b)
  then show ?case by auto
qed

lemma pref_count_test_code:
"(prefer_count_code p x y) * n = prefer_count_code (times n p) x y"
  proof(induct n)
    case 0
    then show ?case by auto
  next
    case (Suc n)
    then show ?case using times_profile mult_Suc_right add_prefer_profiles_code
      by metis
  qed

(*pref_count_equiv*)
lemma times_prefer:
  shows "(prefer_count p x y) * n = prefer_count (times n p) x y"
    using pref_count_test_code pref_count_equiv by metis

lemma lin_n_follows:
  shows "finite A \<Longrightarrow> (\<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>n \<ge> 0. \<forall>i<length (times (n+1) p). linear_order_on A ((times (n+1) p) ! i)) \<Longrightarrow>
        (\<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>n > 0. \<forall>i<length (times n p). linear_order_on A ((times n p) ! i))"
proof-
  have 3:"\<forall>n \<ge> 0. \<forall>i<length (times (Suc n) p). linear_order_on A ((times (Suc n) p) ! i) \<Longrightarrow>
        \<forall>n > 0. \<forall>i<length (times n p). linear_order_on A ((times n p) ! i) "
    by (metis gr0_implies_Suc less_Suc_eq_le)
  then have 4:"\<forall>n \<ge> 0. \<forall>i<length (times (n + 1) p). linear_order_on A ((times (n + 1) p) ! i) \<Longrightarrow>
        \<forall>n > 0. \<forall>i<length (times n p). linear_order_on A ((times n p) ! i) " by auto
  then show  "finite A \<Longrightarrow> (\<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>n \<ge> 0. \<forall>i<length (times (n+1) p). linear_order_on A ((times (n+1) p) ! i)) \<Longrightarrow>
        (\<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>n > 0. \<forall>i<length (times n p). linear_order_on A ((times n p) ! i))"
    by blast
qed

lemma lin_induct:
  assumes "n \<ge> 0"
  shows "finite A \<Longrightarrow> n \<ge> 0 \<Longrightarrow> \<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>i<length (times (n+1) p). linear_order_on A ((times (n+1) p) ! i)"
        proof(induct n)
          case 0
          then show ?case by simp
        next
          case (Suc n)
          then show ?case proof-
            have f0:"n \<ge> 0 \<Longrightarrow>(\<forall>i<length (Electoral_Module.times ((Suc n)+1) p).
            linear_order_on A (Electoral_Module.times ((Suc n)+1) p ! i)) =
            (\<forall>i<length (p@(Electoral_Module.times (n+1) p)).
            linear_order_on A ((p@(Electoral_Module.times (n+1) p)) ! i))"
              by simp
            have "n \<ge> 0 \<Longrightarrow> \<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
            (\<forall>i<length (p@(Electoral_Module.times (n+1) p)).
            linear_order_on A ((p@(Electoral_Module.times (n+1) p)) ! i)) =
            ((\<forall>i<length (Electoral_Module.times (n+1) p).
            linear_order_on A (Electoral_Module.times (n+1) p ! i)))"
              by (metis Suc.hyps add_diff_inverse_nat Suc.prems(1) length_append
                   nat_add_left_cancel_less nth_append)
            then show ?thesis using f0 Suc.hyps Suc.prems(1)
                      Suc.prems(2) Suc.prems(3) by blast
          qed
        qed

lemma n_times_lin:
  shows "n > 0 \<Longrightarrow> finite A \<Longrightarrow> \<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>i<length (times n p). linear_order_on A ((times n p) ! i)" using lin_n_follows lin_induct
  by metis

lemma value_same_for_mult_profile:
  assumes "finite A" and  "profile A p" and "0 < n" and "x \<in> A"
  shows "condorcet_score xb A p vs = condorcet_score xb A (concat (replicate n p)) (concat (replicate n vs))"
    unfolding condorcet_score.simps condorcet_winner.simps
  proof-
    have m0: "\<forall>x y. (prefer_count p x y) * n = prefer_count (times n p) x y"
      by (metis times_prefer)
    have 000:"\<forall>x\<in>A - {xb}. (prefer_count p x xb < prefer_count p xb x) =
    (prefer_count (times n p) x xb < prefer_count (times n p) xb x)"
      by (metis assms(3) m0 mult_less_cancel2)

    have "finite_profile A p = finite_profile A (concat (replicate n p))"
    proof(auto)
      show "finite A \<Longrightarrow> profile A p \<Longrightarrow> profile A (concat (replicate n p))"
      proof-
(*Linearität von n*p beweisen*)
         have "n > 0 \<Longrightarrow> finite A \<Longrightarrow> \<forall>i<length p. linear_order_on A (p ! i) \<Longrightarrow>
        \<forall>i<length (times n p). linear_order_on A ((times n p) ! i)" by (metis n_times_lin)
        then show "finite A \<Longrightarrow> profile A p \<Longrightarrow> profile A (concat (replicate n p))"
          by (simp add: profile_def assms(3))
      qed
      show "finite A \<Longrightarrow> profile A (concat (replicate n p)) \<Longrightarrow> profile A p"
      proof-
        have"finite A \<Longrightarrow>
        \<forall>i<length (concat (replicate n p)). linear_order_on A (concat (replicate n p) ! i)
        \<Longrightarrow> \<forall>i<length p. linear_order_on A (p ! i)"
          using assms(2) profile_def by blast
        then show "finite A \<Longrightarrow> profile A (concat (replicate n p)) \<Longrightarrow> profile A p"
          by (simp add: profile_def)
      qed
    qed
    then show "(if finite_profile A p \<and> xb \<in> A \<and> (\<forall>x \<in> A - {xb} . wins xb p x) then 1 else 0) =
    (if finite_profile A (concat (replicate n p)) \<and> xb \<in> A \<and>
    (\<forall>x \<in> A - {xb} . wins xb (concat (replicate n p)) x) then 1 else 0)" using 000 by simp
  qed

lemma max_same_for_mult_profile:
  assumes "finite A" and  "profile A p" and "vector_pair A vs" and "0 < n" and "x \<in> A"
  shows "Max {condorcet_score x A p vs|x. x \<in> A} = Max {condorcet_score x A (concat (replicate n p))
          (concat (replicate n vs))|x. x \<in> A}"
by (metis (no_types, lifting) assms(1) assms(2) assms(4) value_same_for_mult_profile)

lemma for_goal1_condorcet:
  shows "\<And>A p n x xb vs. x \<in> A \<Longrightarrow>finite A \<Longrightarrow>profile A p \<Longrightarrow>
        vector_pair  A vs \<Longrightarrow> 0 < n \<Longrightarrow> xb \<in> A \<Longrightarrow>
    condorcet_score xb A p vs < Max {condorcet_score x A p vs|x. x \<in> A} \<Longrightarrow>
    condorcet_score xb A (concat (replicate n p)) (concat (replicate n vs)) <
    Max {condorcet_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A}"
  by (metis (mono_tags, lifting) max_same_for_mult_profile value_same_for_mult_profile)

lemma for_goal2_condorcet:
  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>
    condorcet_score xb A (concat (replicate n p)) (concat (replicate n vs)) <
    Max {condorcet_score x A (concat (replicate n p)) (concat (replicate n vs))|x. x \<in> A} \<Longrightarrow>
    condorcet_score xb A p vs < Max {condorcet_score x A p vs|x. x \<in> A}"
  by (metis (mono_tags, lifting) max_same_for_mult_profile value_same_for_mult_profile)

(*******************************************)

lemma seq_hom:
  shows "homogeneity m \<Longrightarrow> homogeneity n \<Longrightarrow> homogeneity (m \<triangleright> n)"
  unfolding homogeneity_def
proof(auto)
  fix A:: "'a set" and p:: "'a Profile" and na :: "nat" and vs :: "'a Pair_Vectors"
  assume fin_A:"finite A" and
         prof:"profile A p" and
         vec:"vector_pair A vs" and
         bigger_0: "0 < na" and
         m:"electoral_module m" and
         n:"electoral_module n" and
        hom_m:"\<forall>A p n vs. finite A \<and> profile A p \<and> finite A \<and> vector_pair A vs \<and> 0 < n
        \<longrightarrow> m A p vs = m A (concat (replicate n p)) (concat (replicate n vs))" and
        hom_n:"\<forall>A p na vs. finite A \<and> profile A p \<and> finite A \<and> vector_pair A vs \<and> 0 < na
        \<longrightarrow> n A p vs = n A (concat (replicate na p)) (concat (replicate na vs))"
  show "(let new_A = defer m A (concat (replicate na p)) (concat (replicate na vs));
        new_p = map (limit new_A) p; new_vs = map (limit_pairs new_A) vs
        in (elect m A (concat (replicate na p)) (concat (replicate na vs)) \<union> elect n new_A new_p new_vs,
            reject m A (concat (replicate na p)) (concat (replicate na vs)) \<union> reject n new_A new_p new_vs,
          defer n new_A new_p new_vs)) =
       (let new_A = defer m A (concat (replicate na p)) (concat (replicate na vs));
        new_p = map (limit new_A) (concat (replicate na p));
            new_vs = map (limit_pairs new_A) (concat (replicate na vs))
        in (elect m A (concat (replicate na p)) (concat (replicate na vs)) \<union> elect n new_A new_p new_vs,
            reject m A (concat (replicate na p)) (concat (replicate na vs)) \<union> reject n new_A new_p new_vs,
          defer n new_A new_p new_vs))" using m n hom_m hom_n fin_A prof vec bigger_0
   by (smt (z3) def_presv_fin_prof limit_profile.simps map_concat map_replicate
          limit_pair_vectors.simps def_presv_fin_vector_pair)
qed

lemma elector_homogeneity:
  shows "homogeneity m \<Longrightarrow> homogeneity (elector m)"
proof(simp)
  have "homogeneity elect_module"
    by (simp add: homogeneity_def)
  then show "homogeneity m \<Longrightarrow> homogeneity (m \<triangleright> elect_module)" using seq_hom by auto
qed

(**Eval_Func Beweis: Evaluation_Function ***)

lemma max_value_same:
  assumes"\<forall>A p n vs. finite_profile A p \<and> vector_pair A vs \<and> 0 < n \<longrightarrow>
       elimination_set eval_func (Max {eval_func x A p vs|x. x \<in> A}) (<) A p vs =
       elimination_set eval_func (Max {eval_func 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)"
  shows"(\<forall>A p n vs. finite_profile A p \<and> vector_pair A vs \<and> 0 < n \<longrightarrow>
        max_eliminator eval_func A p vs =
        max_eliminator eval_func A (Electoral_Module.times n p) (Electoral_Module.times n vs))"
  unfolding max_eliminator.simps less_eliminator.simps elimination_module.simps using assms
  by fastforce

lemma eval_func_homogeneity:
  assumes "\<forall>A p n vs. finite_profile A p \<and> vector_pair A vs \<and> 0 < n \<longrightarrow>
       elimination_set eval_func (Max {eval_func x A p vs|x. x \<in> A}) (<) A p vs =
       elimination_set eval_func (Max {eval_func 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)"
  shows "homogeneity (max_eliminator eval_func)"
  unfolding homogeneity_def using assms
proof-
  show "\<forall>A p n vs.
       finite_profile A p \<and> vector_pair A vs \<and> 0 < n \<longrightarrow>
       elimination_set eval_func (Max {eval_func x A p vs |x. x \<in> A}) (<) A p vs =
       elimination_set eval_func
        (Max {eval_func 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) \<Longrightarrow>
    electoral_module (max_eliminator eval_func) \<and>
    (\<forall>A p n vs. finite_profile A p \<and> finite_pair_vectors A vs \<and> 0 < n \<longrightarrow>
        max_eliminator eval_func A p vs =
        max_eliminator eval_func A (Electoral_Module.times n p) (Electoral_Module.times n vs)) "
    proof-
    have 0:"electoral_module (max_eliminator eval_func)" by auto
    have "(\<forall>A p n vs.
        finite_profile A p \<and> vector_pair A vs \<and> 0 < n \<longrightarrow>
        max_eliminator eval_func A p vs=
        max_eliminator eval_func A (Electoral_Module.times n p) (Electoral_Module.times n vs))"
        using assms max_value_same
      by fastforce
    then show ?thesis
      using 0 by blast
  qed
qed

lemma scoring_homogeneity:
  shows "homogeneity (max_eliminator (scoring v))"
proof-
  have "\<forall>A p n vs. finite_profile A p \<and> finite_pair_vectors A vs \<and> 0 < n \<longrightarrow>
  elimination_set (scoring v) (Max {(scoring v) x A p vs|x. x \<in> A}) (<) A p vs =
       elimination_set (scoring v) (Max {(scoring v) 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)"
    using for_goal1 for_goal2 by auto
   then show "homogeneity (max_eliminator (scoring v))"
     by (simp add: eval_func_homogeneity)
 qed

lemma scoring_rules_homogeneity:
  shows "homogeneity (elector (max_eliminator (scoring vec_A_borda)))"
  using scoring_homogeneity elector_homogeneity by auto

lemma condorcet_homogeneity:
  shows "homogeneity (max_eliminator condorcet_score)"
  unfolding homogeneity_def
proof-
  have 0: "\<forall>A p vs. max_eliminator condorcet_score A p vs
        = elimination_module condorcet_score (Max {condorcet_score x A p vs| x. x \<in> A}) (<) A p vs"
    by force
  have 1:"\<forall>A p vs. elimination_module condorcet_score (Max {condorcet_score x A p vs| x. x \<in> A}) (<) A p vs =
  (if (elimination_set condorcet_score (Max {condorcet_score x A p vs| x. x \<in> A})  (<) A p vs) \<noteq> A
        then ({}, (elimination_set condorcet_score (Max {condorcet_score x A p vs| x. x \<in> A})  (<) A p vs), A
        - (elimination_set condorcet_score (Max {condorcet_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 condorcet_score (Max {condorcet_score x A p vs| x. x \<in> A})  (<) A p vs) \<noteq> A
    then ({}, (elimination_set condorcet_score (Max {condorcet_score x A p vs| x. x \<in> A})  (<) A p vs),
    A - (elimination_set condorcet_score (Max {condorcet_score x A p vs| x. x \<in> A}) (<) A p vs))
    else ({},{},A)) =
    (if (elimination_set condorcet_score (Max {condorcet_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 condorcet_score (Max {condorcet_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 condorcet_score (Max {condorcet_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_goal1_condorcet for_goal2_condorcet Collect_cong elimination_set.simps times.simps
     by (smt (z3))
  then have 3:"\<forall>A p n vs.  finite_profile A p \<and> finite_pair_vectors A vs \<and> 0 < n \<longrightarrow>
    max_eliminator condorcet_score A p vs =
        (if (elimination_set condorcet_score (Max {condorcet_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 condorcet_score (Max {condorcet_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 condorcet_score (Max {condorcet_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 condorcet_score A  (Electoral_Module.times n p) (Electoral_Module.times n vs) =
        (if (elimination_set condorcet_score (Max {condorcet_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 condorcet_score (Max {condorcet_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 condorcet_score (Max {condorcet_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" Collect_cong by fastforce
  then have "\<forall>A p n vs.  finite_profile A p \<and> finite_pair_vectors A vs \<and> 0 < n \<longrightarrow>
    max_eliminator condorcet_score A (Electoral_Module.times n p) (Electoral_Module.times n vs) =
    max_eliminator condorcet_score A p vs"
    by (smt (z3) "3")

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

 qed

(*****)

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

lemma combined_eqless_single:
  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 "scoring v x A p1 vs1 + scoring v x A p2 vs2 \<le> Max {scoring v x A p1 vs1|x. x \<in> A} +
          Max {scoring v x A p2 vs2|x. x \<in> A}"
proof-
  have "scoring v x A p1 vs1\<in> {scoring v x A p1 vs1|x. x \<in> A}" using assms(3) by blast
  then have 0:"scoring v x A p1 vs1 \<le> Max {scoring v x A p1 vs1|x. x \<in> A}" by (simp add: assms(1))
  have "scoring v x A p2 vs2\<in> {scoring v x A p2 vs2|x. x \<in> A}" using assms(3) by blast
  then have 1:"scoring v x A p2 vs2\<le> Max {scoring v x A p2 vs2|x. x \<in> A}" by (simp add: assms(1))
  then show ?thesis using "0" "1" add_mono by blast
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 "
    Max {scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A} \<le>
    Max {scoring v x A p1 vs1|x. x \<in> A} + Max {scoring v x A p2 vs2|x. x \<in> A}"
proof-
  have fin: "finite {scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A}" using assms(1) by simp
  have nonEmpty: "{scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A}  \<noteq> {}" using assms(2) by simp
  then have maxInSet:"Max {scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A}
        \<in> {scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A}"
    using "fin" "nonEmpty" eq_Max_iff by blast
  have eqToMax:"\<exists>x \<in> A. scoring v x A p1 vs1 + scoring v x A p2 vs2 =
        Max {scoring v x A p1 vs1 + scoring v x A p2 vs2 |x. x \<in> A}" using "maxInSet" by auto
  have allSmaller:"\<forall>x\<in> A. scoring v x A p1 vs1 + scoring v x A p2 vs2 \<le>
        Max {scoring v x A p1 vs1|x. x \<in> A} + Max {scoring v x A p2 vs2 |x. x \<in> A}"
    using combined_eqless_single all_not_in_conv assms(1) assms(3) assms(4) assms(5)
  proof -
  { fix aa :: 'a
    have "\<And>A a rs rsa Ps Psa f. 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> scoring f a A rsa Psa + scoring f a A rs Ps
  \<le> Max {scoring f a A rsa Psa |a. a \<in> A} + Max {scoring f a A rs Ps |a. a \<in> A}"
      using all_not_in_conv combined_eqless_single by fastforce
    then have "aa \<notin> A \<or> scoring v aa A p1 vs1 + scoring v aa A p2 vs2
  \<le> Max {scoring v a A p1 vs1 |a. a \<in> A} + Max {scoring v 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. scoring v x A p1 vs1 + scoring v x A p2 vs2 =
        Max {scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A}
  \<Longrightarrow> \<forall>x\<in> A. scoring v x A p1 vs1 + scoring v x A p2 vs2 \<le>
        Max {scoring v x A p1 vs1|x. x \<in> A} + Max {scoring v x A p2 vs2|x. x \<in> A}
  \<Longrightarrow> Max {scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A} \<le>
        Max {scoring v x A p1 vs1|x. x \<in> A} + Max {scoring v x A p2 vs2|x. x \<in> A}"
    by fastforce
  qed
  then show ?thesis
    using eqToMax by fastforce
qed

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

lemma add_scoring_profiles_all2:
  shows "\<forall>x. (scoring v x A (b@p) (vs1@vs2)=
(scoring v x A b vs1) + (scoring v x A p vs2))"
proof(induct b)
case Nil
then show ?case by auto
next
case (Cons a b)
  then show ?case by auto
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 (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
          scoring v a A p1 vs1 + scoring v a A p2 vs2 \<ge> Max {scoring v x A (p1@p2) (vs1@vs2)|x. x \<in> A} \<Longrightarrow>
    \<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
    a \<in> defer (max_eliminator (scoring v)) A (p1@p2) (vs1@vs2)"
proof -
  assume "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      scoring v a A p1 vs1 + scoring v a A p2 vs2 \<ge> Max {scoring v x A (p1 @ p2) (vs1@vs2)|x. x \<in> A}"
  then have
    "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
    Max {scoring v a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> scoring v a A (p1 @ p2) (vs1@vs2)"
    using assms by (metis (no_types, lifting) add_scoring_profiles_all)
  have
    "\<forall>a\<in>defer (max_eliminator (scoring v)) A p1 vs1\<inter> defer (max_eliminator (scoring v)) A p2 vs2.
      Max {scoring v a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> scoring v a A (p1 @ p2) (vs1@vs2) \<Longrightarrow>
     \<forall>a\<in>defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2.
    a \<in> defer (max_eliminator (scoring v)) 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 (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2.
      Max {scoring v a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> scoring v a A (p1 @ p2) (vs1@vs2)"
  { fix aa :: 'a
    { assume "Max {scoring v a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> scoring v aa A (p1 @ p2) (vs1@vs2)"
      moreover
      { assume "aa \<notin> A"
        then have "aa \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)\<or>
      aa \<notin> defer (max_eliminator (scoring v)) A p1 vs1\<inter> defer (max_eliminator (scoring v)) A p2 vs2"
          by simp }
      ultimately have "aa \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)\<or>
      aa \<notin> defer (max_eliminator (scoring v)) A p1 vs1\<inter> defer (max_eliminator (scoring v)) A p2 vs2"
        by simp }
    then have "aa \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2) \<or>
      aa \<notin> defer (max_eliminator (scoring v)) A p1 vs1\<inter> defer (max_eliminator (scoring v)) A p2 vs2"
      using a1 by meson }
  then show ?thesis
    by metis
qed
  then show ?thesis
    using \<open>\<forall>a\<in>defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2.
      Max {scoring v a A (p1 @ p2) (vs1@vs2)|a. a \<in> A} \<le> scoring v a A (p1 @ p2) (vs1@vs2)\<close>
    by linarith
qed

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

lemma max_alway_exists:
  assumes "finite A" and "A \<noteq> {}"
  shows "{a \<in> A. scoring v a A p vs < Max {scoring v x A p vs|x. x \<in> A}} = A \<Longrightarrow> False"
proof-
  have "\<exists>a \<in> A. scoring v a A p vs = Max {scoring v x A p vs|x. x \<in> A}" using assms max_alway_exists0
        by simp
  then show "{a \<in> A. scoring v a A p vs < Max {scoring v x A p vs|x. x \<in> A}} = A \<Longrightarrow> False"
    using nat_neq_iff by auto
qed

lemma max_alway_exists2:
  assumes "finite A" and "A \<noteq> {}" and "finite_profile A p"
  shows "(elimination_set (scoring v) (Max {(scoring v) x A p vs | x. x \<in> A}) (<) A p vs \<noteq> A) = True"
  using assms max_alway_exists by auto

lemma not_less_is_max:
  assumes "finite A"
  shows "a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      scoring v a A p vs =  Max {scoring v x A p vs|x. x \<in> A}"
proof-
  have "a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      a \<in> A" by clarify
  then have "a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      scoring v a A p vs \<in> {scoring v 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 (scoring v) (Max {(scoring v) x A p vs |x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      scoring v a A p vs \<le>  Max{scoring v 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 (scoring v) (Max {(scoring v) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      scoring v a A p vs \<ge>  Max{scoring v x A p vs|x. x \<in> A}"
    by auto
  have "a \<in> A \<Longrightarrow>\<not> scoring v a A p vs < Max {scoring v x A p vs|x. x \<in> A} \<Longrightarrow>
      scoring v a A p vs = Max {scoring v x A p vs|x. x \<in> A}" using "0" "1" by simp
  then show "a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      scoring v a A p vs =  Max {scoring v 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 (scoring v)) A p vs \<Longrightarrow>
            scoring v a A p vs = Max {scoring v x A p vs|x. x \<in> A}"
proof-
  have "({a \<in> A. scoring v a A p vs < Max {(scoring v) x A p vs|x. x \<in> A}} \<noteq> A) = True"
          using assms max_alway_exists by auto
        then have 0: "a \<in> defer (max_eliminator (scoring v)) A p vs \<Longrightarrow>
      a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p vs|x. x \<in> A}) (<) A p vs)"
    by simp
  have "a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      scoring v a A p vs =  Max {scoring v 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 (scoring v)) A p vs \<Longrightarrow> scoring v a A p vs =
      Max {scoring v x A p vs|x. x \<in> A}" using "0" by simp
  then show "a \<in> defer (max_eliminator (scoring v)) A p vs \<Longrightarrow>
      scoring v a A p vs = Max {scoring v 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 (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      a \<in> defer (max_eliminator (scoring v)) A p vs \<Longrightarrow>
      \<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      scoring v a A p vs = Max {scoring v x A p vs|x. x \<in> A}"
proof-

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

        have "a \<in> (A - elimination_set (scoring v) (Max {(scoring v) x A p vs|x. x \<in> A}) (<) A p vs) \<Longrightarrow>
      scoring v a A p vs =  Max {scoring v 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 (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
                a \<in> defer (max_eliminator (scoring v)) A p vs \<Longrightarrow>
                \<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter>
                defer (max_eliminator (scoring v)) A p2 vs2).
                scoring v a A p vs = Max {scoring v 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 (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      a \<in> defer (max_eliminator (scoring v)) A p vs \<Longrightarrow>
  \<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      scoring v a A p vs = Max {scoring v x A p vs|x. x \<in> A}"
    by simp
qed

lemma from_defer_follows_max2_all:
  assumes "finite A"  and "A \<noteq> {}"
  shows "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      (scoring v a A p1 vs1 = Max {scoring v 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 (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      (scoring v a A p1 vs1 = Max {scoring v x A p1 vs1|x. x \<in> A}) \<and>
      (scoring v a A p2 vs2 = Max {scoring v x A p2 vs2|x. x \<in> A})"
  using assms from_defer_follows_max2_all
  by blast

lemma max_in_both__than_in_combined_defer_all_test:
  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 (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
          a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)"
proof-
  have 00:
  "Max {scoring v x A p1 vs1|x. x \<in> A} + Max {scoring v x A p2 vs2|x. x \<in> A} \<ge>
      Max {scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A}"
    using assms combined_max_eqless_single_all
    by (metis (mono_tags, lifting) )

  have vs1: "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1\<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      scoring v a A p1 vs1 =  Max {scoring v x A p1 vs1|x. x \<in> A}" using assms
    using from_defer_follows_max2_all by blast
  have vs2: "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1\<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      scoring v a A p2 vs2 =  Max {scoring v x A p2 vs2|x. x \<in> A}" using assms
    using from_defer_follows_max2_all by blast

  have 11: "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1\<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      Max {scoring v x A p1 vs1|x. x \<in> A} + Max {scoring v x A p2 vs2|x. x \<in> A} = scoring v a A p1 vs1 +
          scoring v a A p2 vs2" using vs1 vs2
    by (metis (no_types, lifting))
  have 0:
  "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
    scoring v a A p1 vs1 + scoring v a A p2 vs2 \<ge> Max {scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A}"
      using "00" "11" by (metis (no_types, lifting))
  have 1 :"\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
    Max {scoring v x A p1 vs1 + scoring v x A p2 vs2|x. x \<in> A} = Max {scoring v x A (p1@p2) (vs1@vs2)|x. x \<in> A}"
     by auto
  have 2:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
        scoring v a A p1 vs1 + scoring v a A p2 vs2\<ge> Max {scoring v 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 (scoring v)) A p1 vs1\<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)"
    using assms max_is_defer_combined_than_in_both_all 2 by (metis (mono_tags, lifting))
  show "\<forall>a\<in>defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2.
       a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1 @ vs2) "
    using assms "2" "3" by blast
qed

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

lemma reinforcement_defer_scoring_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" and
    "defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2 \<noteq> {}"
  shows "defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2 =
      defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)"
proof-

  have all:
      "\<forall>a \<in> (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2).
      a \<in> defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)"
    using  max_in_both__than_in_combined_defer_all_test
      assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7)
    by metis

  then have d1:"(defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2)
      \<subseteq> defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)" by blast

  have "(defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)) \<subseteq>
     (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2)"
proof-

  have a_is_max_p1_p2:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)).
          scoring v a A (p1@p2) (vs1@vs2) = Max {scoring v x A (p1@p2) (vs1@vs2)|x. x \<in> A}"
     using assms(1) assms(2) from_defer_follows_max by (smt (z3) Collect_cong)

    have elem_A:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)). a \<in> A" by simp

      have "\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)). scoring v a A p1 vs1\<in>
      {scoring v x A p1 vs1|x. x \<in> A}"
       using assms(3) "elem_A" by blast
     then have smaller_max:
          "\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)). scoring v a A p1 vs1 \<le>
      Max {scoring v x A p1 vs1|x. x \<in> A}"
      using assms(1) by simp

     have "\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)). scoring v a A p2 vs2 \<in>
      {scoring v 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 (scoring v)) A (p1 @ p2) (vs1@vs2)).
      scoring v a A p2 vs2 \<le>  Max {scoring v x A p2 vs2|x. x \<in> A}"
      using assms(1) by simp

     have comb_is_eq:
          "\<forall>a\<in>defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2.
          Max {scoring v x A (p1@p2) (vs1@vs2)|x. x \<in> A} = scoring v a A p1 vs1 + scoring v a A p2 vs2"
      using a_is_max_p1_p2 add_scoring_profiles all
      by (metis (no_types, lifting))

    have "\<forall>a\<in>defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2.
          (scoring v a A p1 vs1 =  Max {scoring v x A p1 vs1|x. x \<in> A}) \<and> (scoring v a A p2 vs2 =
      Max {scoring v x A p2 vs2|x. x \<in> A})"
      using from_defer_follows_max2_all assms by blast

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

    then have from_single_follows_combined:
        "Max {scoring v x A (p1@p2) (vs1@vs2)|x. x \<in> A}
        = Max {scoring v x A p1 vs1|x. x \<in> A} + Max {scoring v x A p2 vs2|x. x \<in> A}"
      using assms by blast

  have 1:"\<forall>a \<in> (defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)).
        (scoring v a A p1 vs1 =  Max {scoring v x A p1 vs1|x. x \<in> A}) \<and>
      (scoring v a A p2 vs2 =  Max {scoring v x A p2 vs2|x. x \<in> A})"
    using assms "a_is_max_p1_p2" "from_single_follows_combined"
          "smaller_max" "smaller_max2" by fastforce

    have for_vs1:"(defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)) \<subseteq>
          (defer (max_eliminator (scoring v)) A p1 vs1)" using assms 1  sorry

   have for_vs2:"(defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)) \<subseteq>
          (defer (max_eliminator (scoring v)) A p2 vs2)" using assms 1  sorry

       then show
      "(defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)) \<subseteq>
     (defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2)"
            using assms "1" for_vs1 by blast
  qed

  then show "defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2 =
      defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2)"
    using assms "d1" by blast
qed

lemma reinforcement_defer_scoring:
  shows "reinforcement_defer (max_eliminator (scoring v))"
  unfolding reinforcement_defer_def
proof-
  have 0:"electoral_module (max_eliminator (scoring v))" 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 (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2\<noteq> {} \<longrightarrow>
        defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2 =
      defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2))"
    using  "0" Int_emptyI defer_in_alts equals0D in_mono reinforcement_defer_scoring_helper
    by (smt (z3))
  then show "electoral_module (max_eliminator (scoring v)) \<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 (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2 \<noteq> {} \<longrightarrow>
        defer (max_eliminator (scoring v)) A p1 vs1 \<inter> defer (max_eliminator (scoring v)) A p2 vs2 =
        defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1 @ vs2))"
    using "0"
    by presburger
qed

lemma reinforcement_scoring:
  shows "reinforcement (max_eliminator (scoring v))"
  unfolding reinforcement_def by simp

lemma elector_reinforcement:
  shows "reinforcement (elector(max_eliminator (scoring v)))"
proof(simp)
  have 0:"reinforcement elect_module"
    by (simp add: reinforcement_def)
  have def: "reinforcement_defer (max_eliminator (scoring v))"
    by (simp add: reinforcement_defer_scoring)
  then have 1:"electoral_module (max_eliminator (scoring v)) \<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 (scoring v)) A p1 vs1) \<inter> (defer (max_eliminator (scoring v)) A p2 vs2) \<noteq> {} \<longrightarrow>
    ((defer (max_eliminator (scoring v)) A p1 vs1) \<inter> (defer (max_eliminator (scoring v)) A p2 vs2) =
    defer (max_eliminator (scoring v)) A (p1 @ p2) (vs1@vs2))))"
    using reinforcement_defer_def by blast
  have emp: "\<forall>A p vs. elect (max_eliminator (scoring v)) A p vs = {}"
    using max_elim_non_electing by simp
  have def: "reinforcement_defer (max_eliminator (scoring v))"
    by (simp add: reinforcement_defer_scoring)
  have "defer (max_eliminator (scoring v)) A p vs =
      elect (elector((max_eliminator (scoring v)))) A p vs"
    by (simp add: reinforcement_def)
  then show "reinforcement ((max_eliminator (scoring v)) \<triangleright> elect_module)"
      unfolding reinforcement_def using 0 1 emp def by simp
  qed

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

end


(*
    Author:      René Thiemann
                 Akihisa Yamada
    License:     BSD
*)
section \<open>Polynomial Divisibility\<close>

text \<open>We make a connection between irreducibility of Missing-Polynomial and Factorial-Ring.\<close>

theory Polynomial_Divisibility
imports
  Polynomial_Interpolation.Missing_Polynomial
begin

lemma dvd_gcd_mult: fixes p :: "'a :: semiring_gcd"
  assumes dvd: "k dvd p * q" "k dvd p * r"
  shows "k dvd p * gcd q r"
  by (rule dvd_trans, rule gcd_greatest[OF dvd])
     (auto intro!: mult_dvd_mono simp: gcd_mult_left)

lemma poly_gcd_monic_factor:
  "monic p \<Longrightarrow>  gcd (p * q) (p * r) = p * gcd q r"
  by (rule gcdI [symmetric]) (simp_all add: normalize_mult normalize_monic dvd_gcd_mult)

context
  assumes "SORT_CONSTRAINT('a :: field)"
begin

lemma field_poly_irreducible_dvd_mult[simp]:
  assumes irr: "irreducible (p :: 'a poly)"
  shows "p dvd q * r \<longleftrightarrow> p dvd q \<or> p dvd r"
  using field_poly_irreducible_imp_prime[OF irr] by (simp add: prime_elem_dvd_mult_iff)

lemma irreducible_dvd_pow:
  fixes p :: "'a poly"
  assumes irr: "irreducible p"
  shows "p dvd q ^ n \<Longrightarrow> p dvd q"
  using field_poly_irreducible_imp_prime[OF irr] by (rule prime_elem_dvd_power)

lemma irreducible_dvd_prod: fixes p :: "'a poly"
  assumes irr: "irreducible p"
  and dvd: "p dvd prod f as"
  shows "\<exists> a \<in> as. p dvd f a"
  by (insert dvd, induct as rule: infinite_finite_induct, insert irr, auto)

lemma irreducible_dvd_prod_list: fixes p :: "'a poly"
  assumes irr: "irreducible p"
  and dvd: "p dvd prod_list as"
  shows "\<exists> a \<in> set as. p dvd a"
  by (insert dvd, induct as, insert irr, auto)

lemma dvd_mult_imp_degree: fixes p :: "'a poly"
  assumes "p dvd q * r"
  and "degree p > 0"
shows "\<exists> s t. irreducible s \<and> p = s * t \<and> (s dvd q \<or> s dvd r)"
proof -
  from irreducible\<^sub>d_factor[OF assms(2)] obtain s t
  where irred: "irreducible s" and p: "p = s * t" by auto
  from \<open>p dvd q * r\<close> p have s: "s dvd q * r" unfolding dvd_def by auto
  from s p irred show ?thesis by auto
qed

end

end