(*  Title:      RSAPSS/Wordarith.thy
    Author:     Christina Lindenberg, Kai Wirt, Technische Universität Darmstadt
    Copyright:  2005 - Technische Universität Darmstadt
*)

section "Extensions to the Word theory required for PSS"

theory Wordarith
imports WordOperations "HOL-Computational_Algebra.Primes"
begin

definition
  nat_to_bv_length :: "nat \<Rightarrow> nat \<Rightarrow>  bv" where
    (* nat_to_bv_length converts nat (if 0 \<le> nat \<and> nat < 2^nat) nato a bit string of length l *)
  nat_to_bv_length:
  "nat_to_bv_length n l = (if length(nat_to_bv n) \<le> l then bv_extend l \<zero> (nat_to_bv n) else [])"

lemma length_nat_to_bv_length:
  "nat_to_bv_length x y \<noteq> [] \<Longrightarrow> length (nat_to_bv_length x y) = y"
  unfolding nat_to_bv_length by auto

lemma bv_to_nat_nat_to_bv_length:
  "nat_to_bv_length x y \<noteq> [] \<Longrightarrow> bv_to_nat (nat_to_bv_length x y) = x"
  unfolding nat_to_bv_length by auto

definition
  roundup :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  roundup: "roundup x y = (if (x mod y = 0) then (x div y) else (x div y) + 1)"

lemma rnddvd: "b dvd a \<Longrightarrow> roundup a b * b = a"
  by (auto simp add: roundup dvd_eq_mod_eq_0)

lemma bv_to_nat_zero_prepend: "bv_to_nat a = bv_to_nat (\<zero>#a)"
  by auto

primrec remzero:: "bv \<Rightarrow> bv" where
  "remzero [] = []"
| "remzero (a#b) = (if a = \<one> then (a#b) else remzero b)"

lemma remzeroeq: "bv_to_nat a = bv_to_nat (remzero a)"
proof (induct a)
  show "bv_to_nat [] = bv_to_nat (remzero [])"
    by simp
next
  case (Cons a1 a2)
  show "bv_to_nat a2 = bv_to_nat (remzero a2) \<Longrightarrow>
       bv_to_nat (a1 # a2) = bv_to_nat (remzero (a1 # a2))"
  proof (cases a1)
    assume a: "a1=\<zero>" then have "bv_to_nat (a1#a2) = bv_to_nat a2"
      using bv_to_nat_zero_prepend by simp
    moreover have "remzero (a1 # a2) = remzero a2" using a by simp
    ultimately show ?thesis using Cons by simp
  next
    assume "a1=\<one>" then show ?thesis by simp
  qed
qed

lemma len_nat_to_bv_pos: assumes x: "1 < a" shows "0< length (nat_to_bv a)"
proof (auto)
  assume b: "nat_to_bv a = []"
  have a: "bv_to_nat [] = 0" by simp
  have c: "bv_to_nat (nat_to_bv a) = 0" using a and b by simp
  from x have d: "bv_to_nat (nat_to_bv a) = a" by simp
  from d and c have "a=0" by simp
  then show False using x by simp
qed

lemma remzero_replicate: "remzero ((replicate n \<zero>)@l) = remzero l"
by (induct n, auto)

lemma length_bvxor_bound: "a <= length l \<Longrightarrow> a <= length (bvxor l l2)"
proof (induct a)
  case 0
  then show ?case by simp
next
  case (Suc a)
  have a: "Suc a \<le> length l" by fact
  with Suc.hyps have b: "a \<le> length (bvxor l l2)" by simp
  show "Suc a \<le> length (bvxor l l2)"
  proof cases
    assume c: "a = length (bvxor l l2)"
    show "Suc a \<le> length (bvxor l l2)"
    proof (simp add: bvxor)
      have "length l <= max (length l) (length l2)" by simp
      then show "Suc a \<le> max (length l) (length l2)" using a by simp
    qed
  next
    assume "a \<noteq> length (bvxor l l2)"
    then have "a < length (bvxor l l2)" using b by simp
    then show ?thesis by simp
  qed
qed

lemma nat_to_bv_helper_legacy_induct:
  "(\<And>n. n \<noteq> (0::nat) \<longrightarrow> P (n div 2) \<Longrightarrow> P n) \<Longrightarrow> P x"
unfolding atomize_imp[symmetric]
by (induction_schema, simp, lexicographic_order)

lemma len_lower_bound:
  assumes "0 < n"
  shows "2^(length (nat_to_bv n) - Suc 0) \<le> n"
proof (cases "1<n")
  assume l1: "1<n"
  then show ?thesis
  proof (simp add: nat_to_bv_def, induct n rule: nat_to_bv_helper_legacy_induct, auto)
    fix n
    assume a: "Suc 0 < (n::nat)" and b: "~Suc 0<n div 2"
    then have "n=2 \<or> n=3"
    proof (cases "n<=3")
      assume "n<=3" and "Suc 0<n"
      then show "n=2 \<or> n=3" by auto
    next
      assume "~n<=3" then have "3<n" by simp
      then have "1 < n div 2" by arith
      then show "n=2 \<or> n=3" using b by simp
    qed
    then show "2 ^ (length (nat_to_bv_helper n []) - Suc 0) \<le> n"
    proof (cases "n=2")
      assume a: "n=2" then have "nat_to_bv_helper n [] = [\<one>, \<zero>]"
      proof -
        have "nat_to_bv_helper n [] = nat_to_bv n" using b by (simp add: nat_to_bv_def)
        then show ?thesis using a by (simp add: nat_to_bv_non0)
      qed
      then show "2 ^ (length (nat_to_bv_helper n []) - Suc 0) \<le> n" using a by simp
    next
      assume "n=2 \<or> n=3" and "n~=2"
      then have a: "n=3" by simp
      then have "nat_to_bv_helper n [] = [\<one>, \<one>]"
      proof -
        have "nat_to_bv_helper n [] = nat_to_bv n" using a by (simp add: nat_to_bv_def)
        then show ?thesis using a by (simp add: nat_to_bv_non0)
      qed
      then show "2^(length (nat_to_bv_helper n []) - Suc 0) <=n" using a by simp
    qed
  next
    fix n
    assume a: "Suc 0<n" and
      b: "2 ^ (length (nat_to_bv_helper (n div 2) []) - Suc 0) \<le> n div 2"
    have "(2::nat) ^ (length (nat_to_bv_helper n []) - Suc 0) =
      2^(length (nat_to_bv_helper (n div 2) []) + 1 - Suc 0)"
    proof -
      have "length (nat_to_bv n) = length (nat_to_bv (n div 2)) + 1"
        using a by (simp add: nat_to_bv_non0)
      then show ?thesis by (simp add: nat_to_bv_def)
    qed
    moreover have "(2::nat)^(length (nat_to_bv_helper (n div 2) []) + 1 - Suc 0) =
      2^(length (nat_to_bv_helper (n div 2) []) - Suc 0) * 2"
    proof auto
      have "(2::nat)^(length (nat_to_bv_helper (n div 2) []) -Suc 0)*2 =
        2^(length (nat_to_bv_helper (n div 2) []) - Suc 0 + 1)" by simp
      moreover have "(2::nat)^(length (nat_to_bv_helper (n div 2) []) - Suc 0 + 1) =
        2^(length (nat_to_bv_helper (n div 2) []))"
      proof -
        have "0<n div 2" using a by arith
        then have "0<length (nat_to_bv (n div 2))" by (simp add: nat_to_bv_non0)
        then have "0< length (nat_to_bv_helper (n div 2) [])" using a by (simp add: nat_to_bv_def)
        then show ?thesis by simp
      qed
      ultimately show "(2::nat) ^ length (nat_to_bv_helper (n div 2) []) =
        2 ^ (length (nat_to_bv_helper (n div 2) []) - Suc 0) * 2" by simp
    qed
    ultimately show  "2 ^ (length (nat_to_bv_helper n []) - Suc 0) <= n"
      using b by (simp add: nat_to_bv_def) arith
  qed
next
  assume c: "~1<n"
  show ?thesis
  proof (cases "n=1")
    assume a: "n=1" then have "nat_to_bv n = [\<one>]" by (simp add: nat_to_bv_non0)
    then show "2^(length (nat_to_bv n) - Suc 0) <= n" using a by simp
  next
    assume "n~=1"
    with \<open>0 < n\<close> show "2^(length (nat_to_bv n) - Suc 0) <= n" using c by simp
  qed
qed

lemma length_lower: assumes a: "length a < length b" and b: "(hd b) ~= \<zero>" shows "bv_to_nat a < bv_to_nat b"
proof -
  have ha: "bv_to_nat a < 2^length a" by (simp add: bv_to_nat_upper_range)
  have "b ~= []" using a by auto
  then have "b=(hd b)#(tl b)" by simp
  then have "bv_to_nat b = bitval (hd b) * 2^(length (tl b)) + bv_to_nat (tl b)" using bv_to_nat_helper[of "hd b" "tl b"] by simp
  moreover have "bitval (hd b) = 1"
  proof (cases "hd b")
    assume "hd b = \<zero> "
    then show  "bitval (hd b) = 1" using b by simp
  next
    assume "hd b = \<one>"
    then show "bitval (hd b) = 1" by simp
  qed
  ultimately have hb: "2^length (tl b) <= bv_to_nat b" by simp
  have "2^(length a) <= (2::nat)^length (tl b)" using a by auto
  then show ?thesis using hb and ha by arith
qed

lemma nat_to_bv_non_empty: assumes a: "0<n" shows "nat_to_bv n ~= []"
proof -
  from nat_to_bv_non0[of n] have "\<exists>x. nat_to_bv n = x@[if n mod 2 = 0 then \<zero> else \<one>]" using a by simp
  then show ?thesis by auto
qed

lemma hd_append: "x ~= [] \<Longrightarrow> hd (x @ xs) = hd x"
  by (induct x) auto

lemma hd_one: "0<n \<Longrightarrow> hd (nat_to_bv_helper n []) = \<one>"
proof (induct n rule: nat_to_bv_helper_legacy_induct)
  fix n
  assume *: "n \<noteq> 0 \<longrightarrow> 0 < n div 2 \<longrightarrow> hd (nat_to_bv_helper (n div 2) []) = \<one>"
    and "0 < n"
  show "hd (nat_to_bv_helper n []) = \<one>"
  proof (cases "1<n")
    assume a: "1<n"
    with * have b: "0 < n div 2 \<longrightarrow> hd (nat_to_bv_helper (n div 2) []) = \<one>" by simp
    from a have c: "0<n div 2" by arith
    then have d: "hd (nat_to_bv_helper (n div 2) []) = \<one>" using b by simp
    also from a have "0<n" by simp
    then have "hd (nat_to_bv_helper n []) =
        hd (nat_to_bv (n div 2) @ [if n mod 2 = 0 then \<zero> else \<one>])"
      using nat_to_bv_def and nat_to_bv_non0[of n] by auto
    then have "hd (nat_to_bv_helper n []) =
        hd (nat_to_bv (n div 2))"
      using nat_to_bv_non0[of "n div 2"] and c and
        nat_to_bv_non_empty[of "n div 2"] and hd_append[of " nat_to_bv (n div 2)"] by auto
    then have "hd (nat_to_bv_helper n []) = hd (nat_to_bv_helper (n div 2) [])"
      using nat_to_bv_def by simp
    then show "hd (nat_to_bv_helper n []) = \<one>" using b and c by simp
  next
    assume "~1 < n" with \<open>0<n\<close> have c: "n=1" by simp
    have "nat_to_bv_helper 1 [] = [\<one>]" by (simp add: nat_to_bv_helper.simps)
    then show "hd (nat_to_bv_helper n []) = \<one>" using c by simp
  qed
qed

lemma prime_hd_non_zero:
  fixes p::nat assumes a: "prime p" and b: "prime q" shows "hd (nat_to_bv (p*q)) ~= \<zero>"
proof -
  have "0 < p*q"
    by (metis a b mult_is_0 neq0_conv not_prime_0)
  then show ?thesis using hd_one[of "p*q"] and nat_to_bv_def by auto
qed

lemma primerew: fixes p::nat shows  "\<lbrakk>m dvd p; m~=1; m~=p\<rbrakk> \<Longrightarrow> ~ prime p"
  by (auto simp add: prime_nat_iff)

lemma two_dvd_exp: "0<x \<Longrightarrow> (2::nat) dvd 2^x"
  by (induct x) auto

lemma exp_prod1: "\<lbrakk>1<b;2^x=2*(b::nat)\<rbrakk> \<Longrightarrow> 2 dvd b"
proof -
  assume a: "1<b" and b: "2^x=2*(b::nat)"
  have s1: "1<x"
  proof (cases "1<x")
    assume "1<x" then show ?thesis by simp
  next
   assume x: "~1 < x" then have "2^x <= (2::nat)" using b
   proof (cases "x=0")
      assume "x=0" then show "2^x <= (2::nat)" by simp
    next
      assume "x~=0" then have "x=1" using x by simp
      then show "2^x <= (2::nat)" by simp
    qed
    then have "b<=1" using b by simp
    then show ?thesis using a by simp
  qed
  have s2: "2^(x-(1::nat)) = b"
  proof -
    from s1 b have "2^((x-Suc 0)+1) = 2*b" by simp
    then have "2*2^(x-Suc 0) = 2*b" by simp
    then show "2^(x-(1::nat)) = b" by simp
  qed
  from s1 and s2 show ?thesis using two_dvd_exp[of "x-(1::nat)"] by simp
qed

lemma exp_prod2: "\<lbrakk>1<a; 2^x=a*2\<rbrakk> \<Longrightarrow> (2::nat) dvd a"
proof -
  assume "2^x=a*2"
  then have "2^x=2*a" by simp
  moreover assume "1<a"
  ultimately show "2 dvd a" using exp_prod1 by simp
qed

lemma odd_mul_odd: "\<lbrakk>~(2::nat) dvd p; ~2 dvd q\<rbrakk> \<Longrightarrow> ~2 dvd p*q"
  by simp

lemma prime_equal: fixes p::nat shows "\<lbrakk>prime p; prime q; 2^x=p*q\<rbrakk> \<Longrightarrow> (p=q)"
proof -
  assume a: "prime p" and b: "prime q" and c: "2^x=p*q"
  from a have d: "1 < p" by (simp add: prime_nat_iff)
  moreover from b have e: "1<q" by (simp add: prime_nat_iff)
  show "p=q"
  proof (cases "p=2")
    assume p: "p=2" then have "2 dvd q" using c and exp_prod1[of q x] and e by simp
    then have "2=q" using primerew[of 2 q] and b by auto
    then show ?thesis using p by simp
  next
    assume p: "p~=2" show "p=q"
    proof (cases "q=2")
      assume q: "q=2" then have "2 dvd p" using c and exp_prod1[of p x] and d by simp
      then have "2=p" using primerew[of 2 p] and a by auto
      then show ?thesis using p by simp
    next
      assume q: "q~=2" show "p=q"
      proof -
        from p have "~ 2 dvd p" using primerew and a by auto
        moreover from q have "~2 dvd q" using primerew and b by auto
        ultimately have "~2 dvd p*q" by (simp add: odd_mul_odd)
        then have "odd ((2 :: nat) ^ x)" by (simp only: c) simp
        moreover have "(2::nat) dvd 2^x"
        proof (cases "x=0")
          assume "x=0" then have "(2::nat)^x=1" by simp
          then show ?thesis using c and d and e by simp
        next
          assume "x~=0" then have "0<x" by simp
          then show ?thesis using two_dvd_exp by simp
        qed
        ultimately show ?thesis by simp
      qed
    qed
  qed
qed

lemma nat_to_bv_length_bv_to_nat:
  "length xs = n \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> nat_to_bv_length (bv_to_nat xs) n = xs"
  apply (simp only: nat_to_bv_length)
  apply (auto)
  apply (simp add: bv_extend_norm_unsigned)
  done

end


theory Evasive
  imports
    Bij_betw_simplicial_complex_bool_func
    MkIfex
begin

section\<open>Relation between type @{typ "bool vec => bool"}
    and type @{typ "'a boolfunc"}\<close>

definition vec_to_boolfunc :: "nat \<Rightarrow> (bool vec => bool) => (nat boolfunc)"
  where "vec_to_boolfunc n f = (\<lambda>i. f (vec n i))"

lemma
  ris: "reads_inside_set (\<lambda>i. bool_fun_threshold_2_3 (vec 4 i)) (set [0,1,2,3])"
  unfolding reads_inside_set_def
  unfolding bool_fun_threshold_2_3_def
  unfolding count_true_def
  unfolding dim_vec
  unfolding set_list_four [symmetric] by simp

lemma
  shows "val_ifex (mk_ifex (vec_to_boolfunc 4 bool_fun_threshold_2_3) [0,1,2,3])
    = vec_to_boolfunc 4 bool_fun_threshold_2_3"
  apply (rule ext)
  apply (rule val_ifex_mk_ifex_equal)
  unfolding vec_to_boolfunc_def
  using ris .

text\<open>For any Boolean function in dimension @{term n},
  its ifex representation is @{const ifex_ordered} and @{const ifex_minimal}.\<close>

lemma mk_ifex_boolean_function:
  fixes f :: "bool vec => bool"
  shows "ro_ifex (mk_ifex (vec_to_boolfunc n f) [0..n])"
  using mk_ifex_ro by fast

text\<open>Any Boolean function in dimension @{term n} can be
  seen as an expression over the underlying set of variables.\<close>

lemma
  reads_inside_set_boolean_function:
  fixes f :: "bool vec => bool"
  shows "reads_inside_set (vec_to_boolfunc n f) {..<n}"
  unfolding vec_to_boolfunc_def
  unfolding reads_inside_set_def
  by (smt (verit, best) dim_vec eq_vecI index_vec lessThan_iff)

text\<open>Any Boolean function of a finite dimension
  is equal to its ifex representation
  by means of @{const mk_ifex}.\<close>

lemma
  mk_ifex_equivalence:
  fixes f :: "bool vec => bool"
  shows "val_ifex (mk_ifex (vec_to_boolfunc n f) [0..n])
    = vec_to_boolfunc n f"
  apply (rule ext)
  apply (rule val_ifex_mk_ifex_equal)
  using reads_inside_set_boolean_function [of n f]
  unfolding reads_inside_set_def by auto

definition bcount_true :: "nat => (nat=> bool) => nat"
  where "bcount_true n f =  (\<Sum>i = 0..<n. if f i then 1 else (0::nat))"

definition boolfunc_threshold_2_3 :: "(nat => bool) => bool"
  where "boolfunc_threshold_2_3 = (\<lambda>v. 2 \<le> bcount_true 4 v)"

(*definition boolfunc_threshold_2_3 :: "(nat => bool) => bool"
  where "boolfunc_threshold_2_3 = (\<lambda>v. if 2 \<le> bcount_true 4 v then True else False)"*)

definition proj_2 :: "(nat => bool) => bool"
  where "proj_2 = (\<lambda>v. v 2)"

definition proj_2_n3 :: "(nat => bool) => bool"
  where "proj_2_n3 = (\<lambda>v. v 2 \<and> \<not> v 3)"

text\<open>The following definition computes the height of a @{typ "'a ifex"} expression.\<close>

fun height :: "'a ifex => nat"
  where "height Trueif = 0"
  | "height Falseif = 0"
  | "height (IF v va vb) = 1 + max (height va) (height vb)"

text\<open>Both @{term mk_ifex} and @{term height} can be used in computations.\<close>

lemma "height (mk_ifex (boolfunc_threshold_2_3) [0,1,2,3]) = 4"
  by eval

lemma "height (mk_ifex (proj_2) [0,1,2,3]) = 1"
  by eval

lemma "mk_ifex (proj_2) [0] = Falseif" by eval

lemma "height (mk_ifex (proj_2) [0]) = 0" by eval

lemma "mk_ifex (proj_2) [3,2,1,0] = IF 2 Trueif Falseif"
  by eval

lemma "mk_ifex (proj_2) [0,1,2,3] = IF 2 Trueif Falseif"
  by eval

lemma "height (mk_ifex (proj_2) [0,1,2,3]) = 1" by eval

lemma "mk_ifex (proj_2_n3) [0,1,2,3] = IF 2 (IF 3 Falseif Trueif) Falseif" by eval

lemma "mk_ifex (bf_False::nat boolfunc) [0,1,2,3] = Falseif" by eval

lemma "height (mk_ifex (bf_False::nat boolfunc) [0,1,2,3]) = 0" by eval

lemma "mk_ifex (bf_True::nat boolfunc) [0,1,2,3] = Trueif" by eval

lemma "height (mk_ifex (bf_True::nat boolfunc) [0,1,2,3]) = 0" by eval

section\<open>Definition of \emph{evasive} Boolean function\<close>

text\<open>Now we introduce the definition of evasive Boolean function.
  It is based on the height of the ifex expression of the given function.
  The definition is inspired by the one by Scoville~\<^cite>\<open>\<open>Ex. 6.19\<close> in "SC19"\<close>.\<close>

definition evasive :: "nat => ((nat => bool) => bool) => bool"
  where "evasive n f \<equiv> (height (mk_ifex f [0..n])) = n"

corollary "evasive 4 boolfunc_threshold_2_3" by eval

lemma "\<not> evasive 4 proj_2" by eval

lemma "\<not> evasive 4 proj_2_n3" by eval

lemma "\<not> evasive 4 bf_True" by eval

lemma "\<not> evasive 4 bf_False" by eval

end


theory nat_acc_alt_mul_assoc
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype Nat = Z | S "Nat"

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

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

(*hipster accplus accaltmul *)

theorem x0 :
  "!! (x :: Nat) (y :: Nat) (z :: Nat) .
     (accaltmul x (accaltmul y z)) = (accaltmul (accaltmul x y) z)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


section \<open>Plurality Module\<close>

theory abs_module
  imports
 "Component_Types/Elimination_Module"
 "Component_Types/Social_Choice_Types/Profile"
 "Defer_Module"
 "Drop_Module"

begin

subsection \<open>Definition Eliminator\<close>

fun eliminate_least_score :: "'a Evaluation_Function \<Rightarrow> 'a Preference_Relation \<Rightarrow> 'a Electoral_Module" where
  "eliminate_least_score e r A p =
    (if A = {} then ({}, {}, {})
     else
        (if card A = 1 then defer_module A p
        else
          let scores = {e x A p | x. x \<in> A};
              min_score = Min scores;
              candidates_with_min_score = {x \<in> A. e x A p = min_score}
          in
            if candidates_with_min_score = {} then ({}, {}, A)
            else
              if card candidates_with_min_score = 1 then ({}, candidates_with_min_score, A-candidates_with_min_score)
              else
                let (_, to_eliminate, _) = drop_module 1 r candidates_with_min_score p
                in
                  if to_eliminate = {} then ({},{},A)
                  else ({}, to_eliminate, A - to_eliminate)))"

subsection \<open>Soundness Proofs \<close>

lemma eliminate_least_score_sound_for_empty_A:
  assumes "finite_profile A p"
    and "A = {}"
  shows "well_formed A (eliminate_least_score e r A p)"
proof -
  from assms have "eliminate_least_score e r A p = ({}, {}, {})" by simp
  hence "({} \<union> {} \<union> {}) = A"
    by (simp add: assms(2))
  have "disjoint3 ({}, {}, {})" by simp
  moreover have "set_equals_partition {} ({}, {}, {})" by simp
  ultimately show "well_formed A (eliminate_least_score e r A p)"
    unfolding well_formed.simps using assms(2) by simp
qed

lemma eliminate_least_score_sound_for_A_eq_1:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A =1"
  shows "well_formed A (eliminate_least_score e r A p)"
proof -
  from assms obtain c where "A = {c}"
    by (auto simp: card_Suc_eq)

  have elim_res: "eliminate_least_score e r A p = ({}, {}, A)"
    using `A = {c}` assms(2) assms(3) by simp

  have "disjoint3 ({}, {}, A)" by simp
  moreover have "set_equals_partition A ({}, {}, A)" using `A = {c}` by simp
  ultimately show "well_formed A (eliminate_least_score e r A p)"
    unfolding well_formed.simps using elim_res by simp
qed

lemma eliminate_least_score_sound_for_cwms_empty:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A \<noteq>1"
    and "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}={}"
  shows "well_formed A (eliminate_least_score e r A p)"
proof -
  have elim_res: "eliminate_least_score e r A p = ({}, {}, A)"
    using assms(4) by auto
  have "disjoint3 ({}, {}, A)" by simp
  moreover have "set_equals_partition A ({}, {}, A)" by simp
  ultimately show "well_formed A (eliminate_least_score e r A p)"
    unfolding well_formed.simps using elim_res by simp
qed

lemma eliminate_least_score_sound_for_cwms_one:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A \<noteq>1"
    and "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>{}"
    and "card {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}=1"
  shows "well_formed A (eliminate_least_score e r A p)"
proof -
  let ?candidates_with_min_score = "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}"
  obtain e_set r_set d_set where
    elim_result: "eliminate_least_score e r A p = (e_set, r_set, d_set)"
    using prod_cases3 by blast

  have "e_set = {}"
  proof -
    have "\<not>(\<forall>x. x \<in> A \<longrightarrow> e x A p \<noteq> Min {e x A p | x. x \<in> A})"
      using assms(4) by blast
    hence "eliminate_least_score e r A p = ({}, ?candidates_with_min_score, A - ?candidates_with_min_score)"
      by (smt (verit) Collect_cong assms(2) assms(3) assms(4) assms(5) eliminate_least_score.simps)
    thus "e_set = {}" using elim_result by simp
  qed

  have "r_set = ?candidates_with_min_score"
    proof -
    have "fst (snd (eliminate_least_score e r A p)) = r_set"
      using elim_result by auto

    moreover have "fst (snd (eliminate_least_score e r A p)) = ?candidates_with_min_score"
    unfolding eliminate_least_score.simps
    using assms(4) assms(5)
    by (smt (verit) Collect_cong \<open>e_set = {}\<close> assms(1) assms(2) assms(3) calculation elim_result fst_conv prod.collapse snd_conv)

    ultimately show "r_set = ?candidates_with_min_score"
      by simp
  qed

  have "d_set = A - r_set"
    proof -
    have "snd (snd (eliminate_least_score e r A p)) = A - ?candidates_with_min_score"
      using `card ?candidates_with_min_score = 1` `?candidates_with_min_score \<noteq> {}` `eliminate_least_score e r A p = (e_set, r_set, d_set)`
      unfolding eliminate_least_score.simps
      by (smt (verit, ccfv_SIG) assms(2) assms(3) snd_conv)

    moreover have "snd (snd (eliminate_least_score e r A p)) = d_set"
      using elim_result by auto
    ultimately show "d_set = A - r_set"
    using \<open>r_set = ?candidates_with_min_score\<close> by auto
  qed

  have partition_subsets: "e_set \<subseteq> A \<and> r_set \<subseteq> A \<and> d_set \<subseteq> A"
    using `e_set = {}` `r_set = ?candidates_with_min_score` `d_set = A - r_set` by auto
  have partition_inter_empty: "e_set \<inter> r_set = {} \<and> e_set \<inter> d_set = {} \<and> r_set \<inter> d_set = {}"
    using `e_set = {}` `d_set = A - r_set` by auto
  have partition_union_is_A: "e_set \<union> r_set \<union> d_set = A"
    using `e_set = {}` `d_set = A - r_set` `r_set = ?candidates_with_min_score` by auto

  show "well_formed A (eliminate_least_score e r A p)"
    using elim_result partition_inter_empty partition_union_is_A by auto
qed

lemma eliminate_least_score_sound_for_te_empty:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A \<noteq>1"
    and "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>{}"
    and "card {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>1"
    and "\<exists>a b. drop_module 1 r {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} p = (a, {}, b)"
  shows "well_formed A (eliminate_least_score e r A p)"
proof-
  let ?candidates_with_min_score = "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}"
  obtain e_set r_set d_set where
    elim_result: "eliminate_least_score e r A p = (e_set, r_set, d_set)"
    using prod_cases3 by blast

  obtain a b where drop_module_res: "drop_module 1 r ?candidates_with_min_score p = (a, {}, b)"
    using assms(6) by auto

 obtain some_var to_eliminate another_var where to_eliminate_def: "(some_var, to_eliminate, another_var) = drop_module 1 r ?candidates_with_min_score p"
   by auto

have "to_eliminate ={}"
      using drop_module_res to_eliminate_def by auto

then have "eliminate_least_score e r A p = ({}, {}, A)"
    using assms(2) assms(3) assms(4) assms(5) to_eliminate_def `to_eliminate = {}`
    by (simp add: Let_def)

     have "e_set = {}" using `eliminate_least_score e r A p = ({}, {}, A)`
       using elim_result by auto

 have "r_set = {}" using `eliminate_least_score e r A p = ({}, {}, A)`
   using elim_result by auto

 have "d_set = A" using `eliminate_least_score e r A p = ({}, {}, A)`
   using elim_result by auto

   show "well_formed A (eliminate_least_score e r A p)"
     using \<open>eliminate_least_score e r A p = ({}, {}, A)\<close> by auto

qed

lemma eliminate_least_score_sound_for_te_non_empty:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A \<noteq>1"
    and "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>{}"
    and "card {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>1"
    and "\<exists>a b c . drop_module 1 r {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} p =(a, to_eliminate, b)"
    and "to_eliminate \<noteq>{}"
  shows "well_formed A (eliminate_least_score e r A p)"
proof-
  let ?candidates_with_min_score = "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}"
  obtain e_set r_set d_set where
    elim_result: "eliminate_least_score e r A p = (e_set, r_set, d_set)"
    using prod_cases3 by blast

  obtain a to_eliminate b  where drop_module_res: "drop_module 1 r ?candidates_with_min_score p = (a,to_eliminate, b)"
    using assms(6) by auto

  then have "eliminate_least_score e r A p = ({}, to_eliminate, A - to_eliminate)"
    using assms(2) assms(3) assms(4) assms(5) drop_module_res
    by (simp add: Let_def)

 have "e_set = {}" using `eliminate_least_score e r A p =  ({}, to_eliminate, A - to_eliminate)`
       using elim_result by auto

 have "r_set = to_eliminate" using `eliminate_least_score e r A p =  ({}, to_eliminate, A - to_eliminate)`
   using elim_result by auto

 have "d_set = A-to_eliminate" using `eliminate_least_score e r A p = ({}, to_eliminate, A - to_eliminate)`
   using elim_result by auto

  have  "e_set \<subseteq> A"
    by (simp add: \<open>e_set = {}\<close>)

 have  "?candidates_with_min_score \<subseteq> A"
   by simp

    have "to_eliminate \<subseteq> ?candidates_with_min_score"
  proof -
    have "to_eliminate = {a \<in> ?candidates_with_min_score. card(above (limit ?candidates_with_min_score r) a) \<le> 1}"
      using drop_module_res by simp
    thus ?thesis by auto
  qed

   have  "to_eliminate \<subseteq> A" using `to_eliminate \<subseteq> ?candidates_with_min_score` `?candidates_with_min_score \<subseteq> A` drop_module_res
     by blast
   have "d_set \<subseteq> A"
     by (simp add: \<open>d_set = A - to_eliminate\<close>)

    have partition_subsets: "e_set \<subseteq> A \<and> r_set \<subseteq> A \<and> d_set \<subseteq> A"
      by (simp add: \<open>d_set \<subseteq> A\<close> \<open>e_set \<subseteq> A\<close> \<open>r_set = to_eliminate\<close> \<open>to_eliminate \<subseteq> A\<close>)
   have partition_inter_empty: "e_set \<inter> r_set = {} \<and> e_set \<inter> d_set = {} \<and> r_set \<inter> d_set = {}"
    using `e_set = {}` `d_set = A - to_eliminate`
    by (simp add: \<open>r_set = to_eliminate\<close>)
  have partition_union_is_A: "e_set \<union> r_set \<union> d_set = A"
    using \<open>d_set = A - to_eliminate\<close> \<open>r_set = to_eliminate\<close> partition_subsets by auto

 show "well_formed A (eliminate_least_score e r A p)"
   using elim_result partition_inter_empty partition_union_is_A by fastforce
qed

theorem eliminate_least_score_soundness:
  assumes "finite_profile A p"
  shows "well_formed A (eliminate_least_score e r A p)"
proof (cases "A = {}")
  case True
  then show ?thesis
    using assms eliminate_least_score_sound_for_empty_A by simp
next
  case False
  then show ?thesis
  proof (cases "card A = 1")
    case True
    then show ?thesis
      using assms eliminate_least_score_sound_for_A_eq_1 by simp
  next
    case False
    then show ?thesis
    proof (cases "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} = {}")
      case True
      then show ?thesis
        using assms eliminate_least_score_sound_for_cwms_empty by simp
    next
      case False
      then show ?thesis
      proof (cases "card {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} = 1")
        case True
        then show ?thesis
          using assms eliminate_least_score_sound_for_cwms_one
          by (smt (verit) Collect_cong False eliminate_least_score_sound_for_A_eq_1 empty_def mem_Collect_eq)
      next
        case False
        then show ?thesis
        proof (cases "\<exists>a b. drop_module 1 r {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} p = (a, {}, b)")
          case True
          then show ?thesis
            using assms `A \<noteq> {}` `card A \<noteq> 1` `{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} \<noteq> {}` `card {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} \<noteq> 1` eliminate_least_score_sound_for_te_empty
            by blast
        next
          case False
         then obtain a b c where drop_mod_res: "drop_module 1 r {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} p = (a, c, b)"
  by (meson assms drop_module.elims)
then have "c \<noteq> {}"
  using False by auto
  then show ?thesis
    sorry
        qed
      qed
    qed
  qed
qed

subsection \<open>Non-Electing Proofs\<close>

subsection \<open>Cardinality Eliminations\<close>

lemma eliminate_least_score_card_for_empty_A:
  assumes "finite_profile A p"
    and "A = {}"
  shows "card (reject_r (eliminate_least_score e r A p))< 2"
proof -
  from assms have "eliminate_least_score e r A p = ({}, {}, {})" by simp
  hence "({} \<union> {} \<union> {}) = A"
    by (simp add: assms(2))
  show "card (reject_r (eliminate_least_score e r A p))< 2"
    using \<open>eliminate_least_score e r A p = ({}, {}, {})\<close> by auto
qed

lemma eliminate_least_score_card_for_A_eq_1:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A =1"
  shows "card (reject_r (eliminate_least_score e r A p))< 2"
proof -
  from assms obtain c where "A = {c}"
    by (auto simp: card_Suc_eq)

  have elim_res: "eliminate_least_score e r A p = ({}, {}, A)"
    using `A = {c}` assms(2) assms(3) by simp
  show "card (reject_r (eliminate_least_score e r A p))< 2"
    by (simp add: assms(3))
qed

lemma eliminate_least_score_card_for_cwms_empty:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A \<noteq>1"
    and "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}={}"
  shows"card (reject_r (eliminate_least_score e r A p))< 2"
proof -
  have elim_res: "eliminate_least_score e r A p = ({}, {}, A)"
    using assms(4) by auto
  have "disjoint3 ({}, {}, A)" by simp
  show "card (reject_r (eliminate_least_score e r A p))< 2"
    using elim_res by auto
qed

lemma eliminate_least_score_card_for_cwms_one:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A \<noteq>1"
    and "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>{}"
    and "card {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}=1"
  shows "card (reject_r (eliminate_least_score e r A p))< 2"
proof -
  let ?candidates_with_min_score = "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}"
  obtain e_set r_set d_set where
    elim_result: "eliminate_least_score e r A p = (e_set, r_set, d_set)"
    using prod_cases3 by blast

  have "e_set = {}"
  proof -
    have "\<not>(\<forall>x. x \<in> A \<longrightarrow> e x A p \<noteq> Min {e x A p | x. x \<in> A})"
      using assms(4) by blast
    hence "eliminate_least_score e r A p = ({}, ?candidates_with_min_score, A - ?candidates_with_min_score)"
      by (smt (verit) Collect_cong assms(2) assms(3) assms(4) assms(5) eliminate_least_score.simps)
    thus "e_set = {}" using elim_result by simp
  qed

  have "r_set = ?candidates_with_min_score"
    proof -
    have "fst (snd (eliminate_least_score e r A p)) = r_set"
      using elim_result by auto

    moreover have "fst (snd (eliminate_least_score e r A p)) = ?candidates_with_min_score"
    unfolding eliminate_least_score.simps
    using assms(4) assms(5)
    by (smt (verit) Collect_cong \<open>e_set = {}\<close> assms(1) assms(2) assms(3) calculation elim_result fst_conv prod.collapse snd_conv)

    ultimately show "r_set = ?candidates_with_min_score"
      by simp
  qed

  have "card (?candidates_with_min_score)<2"
    by (simp add: assms(5))

  have "card (r_set) <2" using `card (?candidates_with_min_score)<2` `r_set = ?candidates_with_min_score`
    by blast

  have "d_set = A - r_set"
    proof -
    have "snd (snd (eliminate_least_score e r A p)) = A - ?candidates_with_min_score"
      using `card ?candidates_with_min_score = 1` `?candidates_with_min_score \<noteq> {}` `eliminate_least_score e r A p = (e_set, r_set, d_set)`
      unfolding eliminate_least_score.simps
      by (smt (verit, ccfv_SIG) assms(2) assms(3) snd_conv)

    moreover have "snd (snd (eliminate_least_score e r A p)) = d_set"
      using elim_result by auto
    ultimately show "d_set = A - r_set"
    using \<open>r_set = ?candidates_with_min_score\<close> by auto
  qed
    show "card (reject_r (eliminate_least_score e r A p))< 2"
      using \<open>card r_set < 2\<close> elim_result by fastforce
  qed

lemma eliminate_least_score_card_for_te_empty:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A \<noteq>1"
    and "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>{}"
    and "card {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>1"
    and "\<exists>a b. drop_module 1 r {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} p = (a, {}, b)"
  shows "card (reject_r (eliminate_least_score e r A p))< 2"
proof-
  let ?candidates_with_min_score = "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}"
  obtain e_set r_set d_set where
    elim_result: "eliminate_least_score e r A p = (e_set, r_set, d_set)"
    using prod_cases3 by blast

  obtain a b where drop_module_res: "drop_module 1 r ?candidates_with_min_score p = (a, {}, b)"
    using assms(6) by auto

 obtain some_var to_eliminate another_var where to_eliminate_def: "(some_var, to_eliminate, another_var) = drop_module 1 r ?candidates_with_min_score p"
   by auto

have "to_eliminate ={}"
      using drop_module_res to_eliminate_def by auto

then have "eliminate_least_score e r A p = ({}, {}, A)"
    using assms(2) assms(3) assms(4) assms(5) to_eliminate_def `to_eliminate = {}`
    by (simp add: Let_def)

     have "e_set = {}" using `eliminate_least_score e r A p = ({}, {}, A)`
       using elim_result by auto

 have "r_set = {}" using `eliminate_least_score e r A p = ({}, {}, A)`
   using elim_result by auto

 have "d_set = A" using `eliminate_least_score e r A p = ({}, {}, A)`
   using elim_result by auto

     show "card (reject_r (eliminate_least_score e r A p))< 2"
       using \<open>r_set = {}\<close> elim_result by force

   qed

lemma eliminate_least_score_card_for_te_non_empty:
  assumes "finite_profile A p"
    and "A \<noteq> {}"
    and "card A \<noteq>1"
    and "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>{}"
    and "card {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}\<noteq>1"
    and "\<exists>a b c . drop_module 1 r {x \<in> A. e x A p = Min {e x A p | x. x \<in> A}} p =(a, to_eliminate, b)"
    and "to_eliminate \<noteq>{}"
  shows "card (reject_r (eliminate_least_score e r A p))< 2"
proof-
  let ?candidates_with_min_score = "{x \<in> A. e x A p = Min {e x A p | x. x \<in> A}}"
  obtain e_set r_set d_set where
    elim_result: "eliminate_least_score e r A p = (e_set, r_set, d_set)"
    using prod_cases3 by blast

  obtain a to_eliminate b  where drop_module_res: "drop_module 1 r ?candidates_with_min_score p = (a,to_eliminate, b)"
    using assms(6) by auto

  have "card (to_eliminate)<2"

  then have "eliminate_least_score e r A p = ({}, to_eliminate, A - to_eliminate)"
    using assms(2) assms(3) assms(4) assms(5) drop_module_res
    by (simp add: Let_def)

 have "e_set = {}" using `eliminate_least_score e r A p =  ({}, to_eliminate, A - to_eliminate)`
       using elim_result by auto

 have "r_set = to_eliminate" using `eliminate_least_score e r A p =  ({}, to_eliminate, A - to_eliminate)`
   using elim_result by auto

 have "d_set = A-to_eliminate" using `eliminate_least_score e r A p = ({}, to_eliminate, A - to_eliminate)`
   using elim_result by auto

  have  "e_set \<subseteq> A"
    by (simp add: \<open>e_set = {}\<close>)

 have  "?candidates_with_min_score \<subseteq> A"
   by simp

    have "to_eliminate \<subseteq> ?candidates_with_min_score"
  proof -
    have "to_eliminate = {a \<in> ?candidates_with_min_score. card(above (limit ?candidates_with_min_score r) a) \<le> 1}"
      using drop_module_res by simp
    thus ?thesis by auto
  qed
     show "card (reject_r (eliminate_least_score e r A p))< 2"

   have  "to_eliminate \<subseteq> A" using `to_eliminate \<subseteq> ?candidates_with_min_score` `?candidates_with_min_score \<subseteq> A` drop_module_res
     by blast
   have "d_set \<subseteq> A"
     by (simp add: \<open>d_set = A - to_eliminate\<close>)

    have partition_subsets: "e_set \<subseteq> A \<and> r_set \<subseteq> A \<and> d_set \<subseteq> A"
      by (simp add: \<open>d_set \<subseteq> A\<close> \<open>e_set \<subseteq> A\<close> \<open>r_set = to_eliminate\<close> \<open>to_eliminate \<subseteq> A\<close>)
   have partition_inter_empty: "e_set \<inter> r_set = {} \<and> e_set \<inter> d_set = {} \<and> r_set \<inter> d_set = {}"
    using `e_set = {}` `d_set = A - to_eliminate`
    by (simp add: \<open>r_set = to_eliminate\<close>)
  have partition_union_is_A: "e_set \<union> r_set \<union> d_set = A"
    using \<open>d_set = A - to_eliminate\<close> \<open>r_set = to_eliminate\<close> partition_subsets by auto

 show "well_formed A (eliminate_least_score e r A p)"
   using elim_result partition_inter_empty partition_union_is_A by fastforce
qed

(*Some functions might need reordering*)
subsection \<open>Functions absolute module\<close>

fun abs_winner :: "'a set \<Rightarrow> 'a Profile \<Rightarrow> 'a \<Rightarrow> bool" where
  "abs_winner A p w =
  (finite_profile A p \<and> w \<in> A \<and> (has_majority p w))"

fun abs_score :: "'a Evaluation_Function" where
  "abs_score x A p =
    (if (abs_winner A p x) then 1 else 0)"

fun abs_existence:: "'a set \<Rightarrow> 'a Profile  \<Rightarrow> bool" where
  "abs_existence A p = (\<exists> x \<in> A . abs_winner A p x)"

(*default*)
fun absolute_max:: "'a Electoral_Module" where
  "absolute_max A p = (if (abs_existence A p) then ( max_eliminator abs_score A p) else defer_module A p)"

(*Garbage*)
(*
fun absolute_min:: "'a Electoral_Module" where
  "absolute_min A p = min_eliminator abs_score A p"
*)

end