(*  Title:      FOL/ex/Locale_Test/Locale_Test1.thy
    Author:     Clemens Ballarin, TU Muenchen

Test environment for the locale implementation.
*)

theory Locale_Test1
imports FOL
begin

typedecl int
instance int :: "term" ..

consts plus :: "int => int => int" (infixl "+" 60)
  zero :: int ("0")
  minus :: "int => int" ("- _")

axiomatization where
  int_assoc: "(x + y::int) + z = x + (y + z)" and
  int_zero: "0 + x = x" and
  int_minus: "(-x) + x = 0" and
  int_minus2: "-(-x) = x"

section \<open>Inference of parameter types\<close>

locale param1 = fixes p
print_locale! param1

locale param2 = fixes p :: 'b
print_locale! param2

(*
locale param_top = param2 r for r :: "'b :: {}"
  Fails, cannot generalise parameter.
*)

locale param3 = fixes p (infix ".." 50)
print_locale! param3

locale param4 = fixes p :: "'a => 'a => 'a" (infix ".." 50)
print_locale! param4

subsection \<open>Incremental type constraints\<close>

locale constraint1 =
  fixes  prod (infixl "**" 65)
  assumes l_id: "x ** y = x"
  assumes assoc: "(x ** y) ** z = x ** (y ** z)"
print_locale! constraint1

locale constraint2 =
  fixes p and q
  assumes "p = q"
print_locale! constraint2

section \<open>Inheritance\<close>

locale semi =
  fixes prod (infixl "**" 65)
  assumes assoc: "(x ** y) ** z = x ** (y ** z)"
print_locale! semi thm semi_def

locale lgrp = semi +
  fixes one and inv
  assumes lone: "one ** x = x"
    and linv: "inv(x) ** x = one"
print_locale! lgrp thm lgrp_def lgrp_axioms_def

locale add_lgrp = semi "op ++" for sum (infixl "++" 60) +
  fixes zero and neg
  assumes lzero: "zero ++ x = x"
    and lneg: "neg(x) ++ x = zero"
print_locale! add_lgrp thm add_lgrp_def add_lgrp_axioms_def

locale rev_lgrp = semi "%x y. y ++ x" for sum (infixl "++" 60)
print_locale! rev_lgrp thm rev_lgrp_def

locale hom = f: semi f + g: semi g for f and g
print_locale! hom thm hom_def

locale perturbation = semi + d: semi "%x y. delta(x) ** delta(y)" for delta
print_locale! perturbation thm perturbation_def

locale pert_hom = d1: perturbation f d1 + d2: perturbation f d2 for f d1 d2
print_locale! pert_hom thm pert_hom_def

text \<open>Alternative expression, obtaining nicer names in \<open>semi f\<close>.\<close>
locale pert_hom' = semi f + d1: perturbation f d1 + d2: perturbation f d2 for f d1 d2
print_locale! pert_hom' thm pert_hom'_def

section \<open>Syntax declarations\<close>

locale logic =
  fixes land (infixl "&&" 55)
    and lnot ("-- _" [60] 60)
  assumes assoc: "(x && y) && z = x && (y && z)"
    and notnot: "-- (-- x) = x"
begin

definition lor (infixl "||" 50) where
  "x || y = --(-- x && -- y)"

end
print_locale! logic

locale use_decl = l: logic + semi "op ||"
print_locale! use_decl thm use_decl_def

locale extra_type =
  fixes a :: 'a
    and P :: "'a => 'b => o"
begin

definition test :: "'a => o"
  where "test(x) \<longleftrightarrow> (\<forall>b. P(x, b))"

end

term extra_type.test thm extra_type.test_def

interpretation var?: extra_type "0" "%x y. x = 0" .

thm var.test_def

text \<open>Under which circumstances notation remains active.\<close>

ML \<open>
  fun check_syntax ctxt thm expected =
    let
      val obtained =
        Print_Mode.setmp [] (Thm.string_of_thm (Config.put show_markup false ctxt)) thm;
    in
      if obtained <> expected
      then error ("Theorem syntax '" ^ obtained ^ "' obtained, but '" ^ expected ^ "' expected.")
      else ()
    end;
\<close>

declare [[show_hyps]]

locale "syntax" =
  fixes p1 :: "'a => 'b"
    and p2 :: "'b => o"
begin

definition d1 :: "'a => o" ("D1'(_')") where "d1(x) \<longleftrightarrow> \<not> p2(p1(x))"
definition d2 :: "'b => o" ("D2'(_')") where "d2(x) \<longleftrightarrow> \<not> p2(x)"

thm d1_def d2_def

end

thm syntax.d1_def syntax.d2_def

locale syntax' = "syntax" p1 p2 for p1 :: "'a => 'a" and p2 :: "'a => o"
begin

thm d1_def d2_def  (* should print as "D1(?x) <-> ..." and "D2(?x) <-> ..." *)

ML \<open>
  check_syntax @{context} @{thm d1_def} "D1(?x) \<longleftrightarrow> \<not> p2(p1(?x))";
  check_syntax @{context} @{thm d2_def} "D2(?x) \<longleftrightarrow> \<not> p2(?x)";
\<close>

end

locale syntax'' = "syntax" p3 p2 for p3 :: "'a => 'b" and p2 :: "'b => o"
begin

thm d1_def d2_def
  (* should print as "d1(?x) <-> ..." and "D2(?x) <-> ..." *)

ML \<open>
  check_syntax @{context} @{thm d1_def} "d1(?x) \<longleftrightarrow> \<not> p2(p3(?x))";
  check_syntax @{context} @{thm d2_def} "D2(?x) \<longleftrightarrow> \<not> p2(?x)";
\<close>

end

section \<open>Foundational versions of theorems\<close>

thm logic.assoc
thm logic.lor_def

section \<open>Defines\<close>

locale logic_def =
  fixes land (infixl "&&" 55)
    and lor (infixl "||" 50)
    and lnot ("-- _" [60] 60)
  assumes assoc: "(x && y) && z = x && (y && z)"
    and notnot: "-- (-- x) = x"
  defines "x || y == --(-- x && -- y)"
begin

thm lor_def

lemma "x || y = --(-- x && --y)"
  by (unfold lor_def) (rule refl)

end

(* Inheritance of defines *)

locale logic_def2 = logic_def
begin

lemma "x || y = --(-- x && --y)"
  by (unfold lor_def) (rule refl)

end

section \<open>Notes\<close>

(* A somewhat arcane homomorphism example *)

definition semi_hom where
  "semi_hom(prod, sum, h) \<longleftrightarrow> (\<forall>x y. h(prod(x, y)) = sum(h(x), h(y)))"

lemma semi_hom_mult:
  "semi_hom(prod, sum, h) \<Longrightarrow> h(prod(x, y)) = sum(h(x), h(y))"
  by (simp add: semi_hom_def)

locale semi_hom_loc = prod: semi prod + sum: semi sum
  for prod and sum and h +
  assumes semi_homh: "semi_hom(prod, sum, h)"
  notes semi_hom_mult = semi_hom_mult [OF semi_homh]

thm semi_hom_loc.semi_hom_mult
(* unspecified, attribute not applied in backgroud theory !!! *)

lemma (in semi_hom_loc) "h(prod(x, y)) = sum(h(x), h(y))"
  by (rule semi_hom_mult)

(* Referring to facts from within a context specification *)

lemma
  assumes x: "P \<longleftrightarrow> P"
  notes y = x
  shows True ..

section \<open>Theorem statements\<close>

lemma (in lgrp) lcancel:
  "x ** y = x ** z \<longleftrightarrow> y = z"
proof
  assume "x ** y = x ** z"
  then have "inv(x) ** x ** y = inv(x) ** x ** z" by (simp add: assoc)
  then show "y = z" by (simp add: lone linv)
qed simp
print_locale! lgrp

locale rgrp = semi +
  fixes one and inv
  assumes rone: "x ** one = x"
    and rinv: "x ** inv(x) = one"
begin

lemma rcancel:
  "y ** x = z ** x \<longleftrightarrow> y = z"
proof
  assume "y ** x = z ** x"
  then have "y ** (x ** inv(x)) = z ** (x ** inv(x))"
    by (simp add: assoc [symmetric])
  then show "y = z" by (simp add: rone rinv)
qed simp

end
print_locale! rgrp

subsection \<open>Patterns\<close>

lemma (in rgrp)
  assumes "y ** x = z ** x" (is ?a)
  shows "y = z" (is ?t)
proof -
  txt \<open>Weird proof involving patterns from context element and conclusion.\<close>
  {
    assume ?a
    then have "y ** (x ** inv(x)) = z ** (x ** inv(x))"
      by (simp add: assoc [symmetric])
    then have ?t by (simp add: rone rinv)
  }
  note x = this
  show ?t by (rule x [OF \<open>?a\<close>])
qed

section \<open>Interpretation between locales: sublocales\<close>

sublocale lgrp < right?: rgrp
print_facts
proof unfold_locales
  {
    fix x
    have "inv(x) ** x ** one = inv(x) ** x" by (simp add: linv lone)
    then show "x ** one = x" by (simp add: assoc lcancel)
  }
  note rone = this
  {
    fix x
    have "inv(x) ** x ** inv(x) = inv(x) ** one"
      by (simp add: linv lone rone)
    then show "x ** inv(x) = one" by (simp add: assoc lcancel)
  }
qed

(* effect on printed locale *)

print_locale! lgrp

(* use of derived theorem *)

lemma (in lgrp)
  "y ** x = z ** x \<longleftrightarrow> y = z"
  apply (rule rcancel)
  done

(* circular interpretation *)

sublocale rgrp < left: lgrp
proof unfold_locales
  {
    fix x
    have "one ** (x ** inv(x)) = x ** inv(x)" by (simp add: rinv rone)
    then show "one ** x = x" by (simp add: assoc [symmetric] rcancel)
  }
  note lone = this
  {
    fix x
    have "inv(x) ** (x ** inv(x)) = one ** inv(x)"
      by (simp add: rinv lone rone)
    then show "inv(x) ** x = one" by (simp add: assoc [symmetric] rcancel)
  }
qed

(* effect on printed locale *)

print_locale! rgrp
print_locale! lgrp

(* Duality *)

locale order =
  fixes less :: "'a => 'a => o" (infix "<<" 50)
  assumes refl: "x << x"
    and trans: "[| x << y; y << z |] ==> x << z"

sublocale order < dual: order "%x y. y << x"
  apply unfold_locales apply (rule refl) apply (blast intro: trans)
  done

print_locale! order  (* Only two instances of order. *)

locale order' =
  fixes less :: "'a => 'a => o" (infix "<<" 50)
  assumes refl: "x << x"
    and trans: "[| x << y; y << z |] ==> x << z"

locale order_with_def = order'
begin

definition greater :: "'a => 'a => o" (infix ">>" 50) where
  "x >> y \<longleftrightarrow> y << x"

end

sublocale order_with_def < dual: order' "op >>"
  apply unfold_locales
  unfolding greater_def
  apply (rule refl) apply (blast intro: trans)
  done

print_locale! order_with_def
(* Note that decls come after theorems that make use of them. *)

(* locale with many parameters ---
   interpretations generate alternating group A5 *)

locale A5 =
  fixes A and B and C and D and E
  assumes eq: "A \<longleftrightarrow> B \<longleftrightarrow> C \<longleftrightarrow> D \<longleftrightarrow> E"

sublocale A5 < 1: A5 _ _ D E C
print_facts
  using eq apply (blast intro: A5.intro) done

sublocale A5 < 2: A5 C _ E _ A
print_facts
  using eq apply (blast intro: A5.intro) done

sublocale A5 < 3: A5 B C A _ _
print_facts
  using eq apply (blast intro: A5.intro) done

(* Any even permutation of parameters is subsumed by the above. *)

print_locale! A5

(* Free arguments of instance *)

locale trivial =
  fixes P and Q :: o
  assumes Q: "P \<longleftrightarrow> P \<longleftrightarrow> Q"
begin

lemma Q_triv: "Q" using Q by fast

end

sublocale trivial < x: trivial x _
  apply unfold_locales using Q by fast

print_locale! trivial

context trivial begin thm x.Q [where ?x = True] end

sublocale trivial < y: trivial Q Q
  by unfold_locales
  (* Succeeds since previous interpretation is more general. *)

print_locale! trivial  (* No instance for y created (subsumed). *)

subsection \<open>Sublocale, then interpretation in theory\<close>

interpretation int?: lgrp "op +" "0" "minus"
proof unfold_locales
qed (rule int_assoc int_zero int_minus)+

thm int.assoc int.semi_axioms

interpretation int2?: semi "op +"
  by unfold_locales  (* subsumed, thm int2.assoc not generated *)

ML \<open>(Global_Theory.get_thms @{theory} "int2.assoc";
    raise Fail "thm int2.assoc was generated")
  handle ERROR _ => ([]:thm list);\<close>

thm int.lone int.right.rone
  (* the latter comes through the sublocale relation *)

subsection \<open>Interpretation in theory, then sublocale\<close>

interpretation fol: logic "op +" "minus"
  by unfold_locales (rule int_assoc int_minus2)+

locale logic2 =
  fixes land (infixl "&&" 55)
    and lnot ("-- _" [60] 60)
  assumes assoc: "(x && y) && z = x && (y && z)"
    and notnot: "-- (-- x) = x"
begin

definition lor (infixl "||" 50) where
  "x || y = --(-- x && -- y)"

end

sublocale logic < two: logic2
  by unfold_locales (rule assoc notnot)+

thm fol.two.assoc

subsection \<open>Declarations and sublocale\<close>

locale logic_a = logic
locale logic_b = logic

sublocale logic_a < logic_b
  by unfold_locales

subsection \<open>Interpretation\<close>

subsection \<open>Rewrite morphism\<close>

locale logic_o =
  fixes land (infixl "&&" 55)
    and lnot ("-- _" [60] 60)
  assumes assoc_o: "(x && y) && z \<longleftrightarrow> x && (y && z)"
    and notnot_o: "-- (-- x) \<longleftrightarrow> x"
begin

definition lor_o (infixl "||" 50) where
  "x || y \<longleftrightarrow> --(-- x && -- y)"

end

interpretation x: logic_o "op \<and>" "Not"
  rewrites bool_logic_o: "x.lor_o(x, y) \<longleftrightarrow> x \<or> y"
proof -
  show bool_logic_o: "PROP logic_o(op \<and>, Not)" by unfold_locales fast+
  show "logic_o.lor_o(op \<and>, Not, x, y) \<longleftrightarrow> x \<or> y"
    by (unfold logic_o.lor_o_def [OF bool_logic_o]) fast
qed

thm x.lor_o_def bool_logic_o

lemma lor_triv: "z \<longleftrightarrow> z" ..

lemma (in logic_o) lor_triv: "x || y \<longleftrightarrow> x || y" by fast

thm lor_triv [where z = True] (* Check strict prefix. *)
  x.lor_triv

subsection \<open>Inheritance of rewrite morphisms\<close>

locale reflexive =
  fixes le :: "'a => 'a => o" (infix "\<sqsubseteq>" 50)
  assumes refl: "x \<sqsubseteq> x"
begin

definition less (infix "\<sqsubset>" 50) where "x \<sqsubset> y \<longleftrightarrow> x \<sqsubseteq> y \<and> x \<noteq> y"

end

axiomatization
  gle :: "'a => 'a => o" and gless :: "'a => 'a => o" and
  gle' :: "'a => 'a => o" and gless' :: "'a => 'a => o"
where
  grefl: "gle(x, x)" and gless_def: "gless(x, y) \<longleftrightarrow> gle(x, y) \<and> x \<noteq> y" and
  grefl': "gle'(x, x)" and gless'_def: "gless'(x, y) \<longleftrightarrow> gle'(x, y) \<and> x \<noteq> y"

text \<open>Setup\<close>

locale mixin = reflexive
begin
lemmas less_thm = less_def
end

interpretation le: mixin gle rewrites "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
proof -
  show "mixin(gle)" by unfold_locales (rule grefl)
  note reflexive = this[unfolded mixin_def]
  show "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

text \<open>Rewrite morphism propagated along the locale hierarchy\<close>

locale mixin2 = mixin
begin
lemmas less_thm2 = less_def
end

interpretation le: mixin2 gle
  by unfold_locales

thm le.less_thm2  (* rewrite morphism applied *)
lemma "gless(x, y) \<longleftrightarrow> gle(x, y) \<and> x \<noteq> y"
  by (rule le.less_thm2)

text \<open>Rewrite morphism does not leak to a side branch.\<close>

locale mixin3 = reflexive
begin
lemmas less_thm3 = less_def
end

interpretation le: mixin3 gle
  by unfold_locales

thm le.less_thm3  (* rewrite morphism not applied *)
lemma "reflexive.less(gle, x, y) \<longleftrightarrow> gle(x, y) \<and> x \<noteq> y" by (rule le.less_thm3)

text \<open>Rewrite morphism only available in original context\<close>

locale mixin4_base = reflexive

locale mixin4_mixin = mixin4_base

interpretation le: mixin4_mixin gle
  rewrites "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
proof -
  show "mixin4_mixin(gle)" by unfold_locales (rule grefl)
  note reflexive = this[unfolded mixin4_mixin_def mixin4_base_def mixin_def]
  show "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

locale mixin4_copy = mixin4_base
begin
lemmas less_thm4 = less_def
end

locale mixin4_combined = le1?: mixin4_mixin le' + le2?: mixin4_copy le for le' le
begin
lemmas less_thm4' = less_def
end

interpretation le4: mixin4_combined gle' gle
  by unfold_locales (rule grefl')

thm le4.less_thm4' (* rewrite morphism not applied *)
lemma "reflexive.less(gle, x, y) \<longleftrightarrow> gle(x, y) \<and> x \<noteq> y"
  by (rule le4.less_thm4')

text \<open>Inherited rewrite morphism applied to new theorem\<close>

locale mixin5_base = reflexive

locale mixin5_inherited = mixin5_base

interpretation le5: mixin5_base gle
  rewrites "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
proof -
  show "mixin5_base(gle)" by unfold_locales
  note reflexive = this[unfolded mixin5_base_def mixin_def]
  show "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

interpretation le5: mixin5_inherited gle
  by unfold_locales

lemmas (in mixin5_inherited) less_thm5 = less_def

thm le5.less_thm5  (* rewrite morphism applied *)
lemma "gless(x, y) \<longleftrightarrow> gle(x, y) \<and> x \<noteq> y"
  by (rule le5.less_thm5)

text \<open>Rewrite morphism pushed down to existing inherited locale\<close>

locale mixin6_base = reflexive

locale mixin6_inherited = mixin5_base

interpretation le6: mixin6_base gle
  by unfold_locales
interpretation le6: mixin6_inherited gle
  by unfold_locales
interpretation le6: mixin6_base gle
  rewrites "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
proof -
  show "mixin6_base(gle)" by unfold_locales
  note reflexive = this[unfolded mixin6_base_def mixin_def]
  show "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

lemmas (in mixin6_inherited) less_thm6 = less_def

thm le6.less_thm6  (* mixin applied *)
lemma "gless(x, y) \<longleftrightarrow> gle(x, y) \<and> x \<noteq> y"
  by (rule le6.less_thm6)

text \<open>Existing rewrite morphism inherited through sublocale relation\<close>

locale mixin7_base = reflexive

locale mixin7_inherited = reflexive

interpretation le7: mixin7_base gle
  rewrites "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
proof -
  show "mixin7_base(gle)" by unfold_locales
  note reflexive = this[unfolded mixin7_base_def mixin_def]
  show "reflexive.less(gle, x, y) \<longleftrightarrow> gless(x, y)"
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

interpretation le7: mixin7_inherited gle
  by unfold_locales

lemmas (in mixin7_inherited) less_thm7 = less_def

thm le7.less_thm7  (* before, rewrite morphism not applied *)
lemma "reflexive.less(gle, x, y) \<longleftrightarrow> gle(x, y) \<and> x \<noteq> y"
  by (rule le7.less_thm7)

sublocale mixin7_inherited < mixin7_base
  by unfold_locales

lemmas (in mixin7_inherited) less_thm7b = less_def

thm le7.less_thm7b  (* after, mixin applied *)
lemma "gless(x, y) \<longleftrightarrow> gle(x, y) \<and> x \<noteq> y"
  by (rule le7.less_thm7b)

text \<open>This locale will be interpreted in later theories.\<close>

locale mixin_thy_merge = le: reflexive le + le': reflexive le' for le le'

subsection \<open>Rewrite morphisms in sublocale\<close>

text \<open>Simulate a specification of left groups where unit and inverse are defined
  rather than specified.  This is possible, but not in FOL, due to the lack of a
  selection operator.\<close>

axiomatization glob_one and glob_inv
  where glob_lone: "prod(glob_one(prod), x) = x"
    and glob_linv: "prod(glob_inv(prod, x), x) = glob_one(prod)"

locale dgrp = semi
begin

definition one where "one = glob_one(prod)"

lemma lone: "one ** x = x"
  unfolding one_def by (rule glob_lone)

definition inv where "inv(x) = glob_inv(prod, x)"

lemma linv: "inv(x) ** x = one"
  unfolding one_def inv_def by (rule glob_linv)

end

sublocale lgrp < "def"?: dgrp
  rewrites one_equation: "dgrp.one(prod) = one" and inv_equation: "dgrp.inv(prod, x) = inv(x)"
proof -
  show "dgrp(prod)" by unfold_locales
  from this interpret d: dgrp .
  \<comment> Unit
  have "dgrp.one(prod) = glob_one(prod)" by (rule d.one_def)
  also have "... = glob_one(prod) ** one" by (simp add: rone)
  also have "... = one" by (simp add: glob_lone)
  finally show "dgrp.one(prod) = one" .
  \<comment> Inverse
  then have "dgrp.inv(prod, x) ** x = inv(x) ** x" by (simp add: glob_linv d.linv linv)
  then show "dgrp.inv(prod, x) = inv(x)" by (simp add: rcancel)
qed

print_locale! lgrp

context lgrp begin

text \<open>Equations stored in target\<close>

lemma "dgrp.one(prod) = one" by (rule one_equation)
lemma "dgrp.inv(prod, x) = inv(x)" by (rule inv_equation)

text \<open>Rewrite morphisms applied\<close>

lemma "one = glob_one(prod)" by (rule one_def)
lemma "inv(x) = glob_inv(prod, x)" by (rule inv_def)

end

text \<open>Interpreted versions\<close>

lemma "0 = glob_one (op +)" by (rule int.def.one_def)
lemma "- x = glob_inv(op +, x)" by (rule int.def.inv_def)

text \<open>Roundup applies rewrite morphisms at declaration level in DFS tree\<close>

locale roundup = fixes x assumes true: "x \<longleftrightarrow> True"

sublocale roundup \<subseteq> sub: roundup x rewrites "x \<longleftrightarrow> True \<and> True"
  apply unfold_locales apply (simp add: true) done
lemma (in roundup) "True \<and> True \<longleftrightarrow> True" by (rule sub.true)

section \<open>Interpretation in named contexts\<close>

locale container
begin
interpretation "private": roundup True by unfold_locales rule
lemmas true_copy = private.true
end

context container begin
ML \<open>(Context.>> (fn generic => let val context = Context.proof_of generic
  val _ = Proof_Context.get_thms context "private.true" in generic end);
  raise Fail "thm private.true was persisted")
  handle ERROR _ => ([]:thm list);\<close>
thm true_copy
end

section \<open>Interpretation in proofs\<close>

lemma True
proof
  interpret "local": lgrp "op +" "0" "minus"
    by unfold_locales  (* subsumed *)
  {
    fix zero :: int
    assume "!!x. zero + x = x" "!!x. (-x) + x = zero"
    then interpret local_fixed: lgrp "op +" zero "minus"
      by unfold_locales
    thm local_fixed.lone
    print_dependencies! lgrp "op +" 0 minus + lgrp "op +" zero minus
  }
  assume "!!x zero. zero + x = x" "!!x zero. (-x) + x = zero"
  then interpret local_free: lgrp "op +" zero "minus" for zero
    by unfold_locales
  thm local_free.lone [where ?zero = 0]
qed

lemma True
proof
  {
    fix pand and pnot and por
    assume passoc: "\<And>x y z. pand(pand(x, y), z) \<longleftrightarrow> pand(x, pand(y, z))"
      and pnotnot: "\<And>x. pnot(pnot(x)) \<longleftrightarrow> x"
      and por_def: "\<And>x y. por(x, y) \<longleftrightarrow> pnot(pand(pnot(x), pnot(y)))"
    interpret loc: logic_o pand pnot
      rewrites por_eq: "\<And>x y. logic_o.lor_o(pand, pnot, x, y) \<longleftrightarrow> por(x, y)"  (* FIXME *)
    proof -
      show logic_o: "PROP logic_o(pand, pnot)" using passoc pnotnot by unfold_locales
      fix x y
      show "logic_o.lor_o(pand, pnot, x, y) \<longleftrightarrow> por(x, y)"
        by (unfold logic_o.lor_o_def [OF logic_o]) (rule por_def [symmetric])
    qed
    print_interps logic_o
    have "\<And>x y. por(x, y) \<longleftrightarrow> pnot(pand(pnot(x), pnot(y)))" by (rule loc.lor_o_def)
  }
qed

end


section \<open>independence_of_clones\<close>

theory independence_of_clones
  imports
        "Compositional_Structures/Basic_Modules/abs_module"
        "IRV_rule"
begin

subsection \<open>Definitions \<close>
definition is_clone_set :: "'a set \<Rightarrow> 'a Profile \<Rightarrow> bool" where
  "is_clone_set A p \<equiv> \<forall>r \<in> set p. \<forall>a \<in> A. \<forall>b \<in> A. a \<noteq> b \<longrightarrow> ((a, b) \<in> r \<longleftrightarrow> (b, a) \<in> r)"

(*funciona*)
definition dir_pref_in_ballot :: "'a \<Rightarrow> 'a \<Rightarrow> 'a Preference_Relation \<Rightarrow> bool" where
  "dir_pref_in_ballot a c r \<equiv>
    a \<noteq> c \<and> (a, c) \<in> r \<and> (\<forall>b. (b \<noteq> a \<and> b \<noteq> c) \<longrightarrow> \<not> ((a, b) \<in> r \<and> (b, c) \<in> r))"

fun clones_exist_in_A :: "'a set \<Rightarrow> 'a Profile \<Rightarrow> bool" where
"clones_exist_in_A A p =
  (\<exists>a\<in>A. \<exists>b\<in>A. a \<noteq> b \<and>
    (\<forall>r \<in> set p. (dir_pref_in_ballot a b r) \<or> (dir_pref_in_ballot b a r)))"

(*Corregir: p \<noteq> [] \<and> pc \<noteq> []*)
definition introduces_clone_in_candidate :: "'a \<Rightarrow> 'a \<Rightarrow> 'a set \<Rightarrow> 'a Profile \<Rightarrow> 'a set \<Rightarrow> 'a Profile \<Rightarrow> bool" where
  "introduces_clone_in_candidate a c A p Ac pc \<equiv>
    a \<noteq> c \<and> c \<notin> A \<and> profile A p \<and> profile Ac pc \<and> Ac = A \<union> {c} \<and>
  p \<noteq> [] \<and> pc \<noteq> [] \<and>
    (\<forall>r \<in> set pc. (dir_pref_in_ballot a c r) \<or> (dir_pref_in_ballot c a r)) \<and>
    (\<forall>r \<in> set p. \<forall>r' \<in> set pc.
        (\<forall>b d. b \<noteq> a \<and> b \<noteq> c \<and> d \<noteq> a \<and> d \<noteq> c \<longrightarrow> ((b, d) \<in> r \<longleftrightarrow> (b, d) \<in> r')) \<and>
        (\<forall>b. b \<noteq> a \<and> b \<noteq> c \<longrightarrow> ((b, a) \<in> r \<longrightarrow> ((b, a) \<in> r' \<and> (b, c) \<in> r'))) \<and>
        (\<forall>d. d \<noteq> a \<and> d \<noteq> c \<longrightarrow> ((a, d) \<in> r \<longrightarrow> ((a, d) \<in> r' \<and> (c, d) \<in> r'))))"

definition introduces_clone2 :: "'a set \<Rightarrow> 'a \<Rightarrow> 'a Profile \<Rightarrow> 'a Profile \<Rightarrow> bool" where
  "introduces_clone2 A c p q \<equiv> \<forall> a \<in> A. a \<noteq> c \<and> (\<forall>r \<in> set q. if r \<in> set p then dir_pref_in_ballot a c r else dir_pref_in_ballot c a r)"

definition is_winner :: "'a \<Rightarrow> 'a Electoral_Module \<Rightarrow> 'a set \<Rightarrow> 'a Profile \<Rightarrow> bool" where
  "is_winner x em A p \<equiv> x \<in> elect_r (em A p)"

definition is_deferred :: "'a \<Rightarrow> 'a Electoral_Module \<Rightarrow> 'a set \<Rightarrow> 'a Profile \<Rightarrow> bool" where
  "is_deferred x em A p \<equiv> x \<in> defer_r (em A p)"

definition independence_of_clones :: "'a Electoral_Module \<Rightarrow> bool" where
  "independence_of_clones em \<equiv>
    \<forall>A p Ac pc. (\<exists> a \<in> elect em A p. \<exists>c. c \<notin> A \<and>
      introduces_clone_in_candidate a c A p Ac pc
      \<longrightarrow> (is_winner a em Ac pc \<or> is_winner c em Ac pc))"

definition independence_of_clones_deferred :: "'a Electoral_Module \<Rightarrow> bool" where
  "independence_of_clones_deferred em \<equiv>
    \<forall>A p Ac pc. (\<exists> a \<in> defer em A p. \<exists>c. c \<notin> A \<and>
      introduces_clone_in_candidate a c A p Ac pc
      \<longrightarrow> (is_deferred a em (A \<union> {c}) pc \<or> is_deferred c em (A \<union> {c}) pc))"

subsection \<open>Basic Lemmas\<close>

lemma dir_pref_excludes_inverse:
  assumes "dir_pref_in_ballot a b r"
    and "linear_order_on A r"
    and "a \<in> A"
    and "b \<in> A"
  shows "\<not>(b, a) \<in> r"
proof
  assume "(b, a) \<in> r"
  moreover have "(a, b) \<in> r"
    using assms(1) unfolding dir_pref_in_ballot_def by simp
  moreover have "a \<noteq> b"
    using assms(1) unfolding dir_pref_in_ballot_def by simp
  ultimately show False
    using assms(2) unfolding linear_order_on_def partial_order_on_def
    by (metis antisym_def)
qed

lemma introduces_clone_implies_dir_pref:
  assumes "introduces_clone_in_candidate a c A p Ac pc"
  shows "\<forall>r \<in> set pc. dir_pref_in_ballot a c r \<or> dir_pref_in_ballot c a r"
  using assms
  unfolding introduces_clone_in_candidate_def
  by simp

subsection \<open>Reset Clones\<close>

lemma reset_clone_set:
  assumes "introduces_clone_in_candidate a c A p Ac pc"
  and "electoral_module m"
  and "c \<in> reject m Ac pc"
  shows "A = Ac - {c}"
proof-
  have "Ac = A \<union> {c}" using assms(1) unfolding introduces_clone_in_candidate_def by blast
  moreover have "c \<in> Ac" using assms(1) unfolding introduces_clone_in_candidate_def by blast
  have "c \<notin> A" using assms(1) unfolding introduces_clone_in_candidate_def by blast
  have "Ac - {c} = A"
    by (simp add: \<open>c \<notin> A\<close> calculation(1))
  thus ?thesis by simp
qed

lemma reset_clone_prof:
  assumes "introduces_clone_in_candidate a c A p Ac pc"
  and "electoral_module m"
  and "c \<in> reject m Ac pc"
  and "m Ac pc = An pn "
shows "p=pn"
proof -
  have Ac_def: "Ac = A \<union> {c}" using assms(1) unfolding introduces_clone_in_candidate_def by blast
  have profile_A_p: "profile A p" using assms(1) unfolding introduces_clone_in_candidate_def by blast
  have profile_Ac_pc: "profile Ac pc" using assms(1) unfolding introduces_clone_in_candidate_def by blast

  have profile_An_pn: "profile An pn" using assms(4)

  have "\<forall>r' \<in> set pn. \<exists>r \<in> set pc. r' = r"
  proof -
    {
      fix r' assume "r' \<in> set pn"
      obtain r where "r \<in> set pc" and r'_def: "r' = r"
        using assms(4) profile_Ac_pc profile_An_pn elect_in_candidates by metis
      hence "\<exists>r \<in> set pc. r' = r" by auto
    }
    thus ?thesis by auto
  qed
  hence "set pn \<subseteq> set pc" by auto
  hence "length pn \<le> length pc"
    using distinct_card[of pc] distinct_card[of pn] distinct_card_mono[of pc pn] profile_Ac_p profile_An_pn by auto
  moreover have "length pc \<le> length pn"
    using assms(3) profile_Ac_p profile_An_pn elect_elim_leq_length by metis
  ultimately have "length pn = length pc" by simp
  hence "length p = length pn"
    using assms(1) profile_Ac_p profile_An_pn introduces_clone_length_eq by metis
  moreover have "\<forall>i < length p. p!i = pn!i"
  proof -
    {
      fix i assume "i < length p"
      obtain r where "r \<in> set pc" and r_def: "pc!index pc r = r" and pref_eq: "p!i = removeCandidate a r"
        using assms(1) profile_Ac_p introduces_clone_preference_eq by metis
      have "i < length pn"
        using \<open>length pn = length pc\<close> \<open>i < length p\<close> assms(1) profile_Ac_p introduces_clone_length_eq by metis
      hence "pn!i = removeCandidate a r"
        using \<open>r \<in> set pc\<close> assms(4) profile_Ac_p profile_An_pn r_def elect_elim_candidates pref_eq by metis
      hence "p!i = pn!i"
        using pref_eq by simp
    }
    thus ?thesis by auto
  qed
  ultimately have "p = pn" by (simp add: nth_equalityI)
  thus ?thesis by simp
qed

  have restricted_relations_equal: "\<forall>r' \<in> set pc.  r' \<in> set p"
    by blast
    sorry -- Prove this using introduces_clone_in_candidate properties

  have "set p = set pc"
  proof
    show "set p \<subseteq> set pc"
      sorry -- Use restricted_relations_equal to show that each element of p is in pc
    show "set pc \<subseteq> set p"
      sorry -- Use restricted_relations_equal to show that each element of pc is in p
  qed
  moreover have "length p = length pc"
    using assms(1) unfolding introduces_clone_in_candidate_def by blast
  ultimately show ?thesis
    sorry -- Conclude that p and pc must be the same. You may not necessarily need multiset_eq_iff_counts_eq here.
qed
qed

lemma introduces_clone_preserves_elimination:
  assumes "introduces_clone_in_candidate a c A p Ac pc"
  shows "{a,c} \<notin> reject IRV_step_drop r  A p"
proof -
  obtain scores min_score candidates_with_min_score where
    scores_def: "scores = {IRV_score x (set A) p |x. x \<in> set A}"
    and min_score_def: "min_score = Min scores"
    and candidates_with_min_score_def: "candidates_with_min_score = {x \<in> set A. IRV_score x (set A) p = min_score}"
    by blast

  obtain q where q_def: "q = (IRV_step_drop r (set A) p)"
    by simp

  have "eliminate_least_score IRV_score r (set A) p = q"
    using q_def by simp

  have "snd q = set candidates_with_min_score"
    using candidates_with_min_score_def min_score_def scores_def q_def
    by (metis (mono_tags, lifting) case_prod_conv)

  hence "to_eliminate \<in> set candidates_with_min_score"
    using assms(2) q_def by simp

  have "c \<noteq> a" and "c \<noteq> b" and "a \<noteq> b" and "b \<noteq> a"
    using assms(1) unfolding introduces_clone_in_candidate_def' by auto

  have "\<forall>x. x \<noteq> a \<and> x \<noteq> c \<longrightarrow> (IRV_score x (set A) p \<noteq> min_score)"
  proof -
    {
      fix x
      assume "x \<noteq> a" and "x \<noteq> c"
      have "IRV_score x (set A) p \<noteq> min_score"
      proof (rule ccontr)
        assume "IRV_score x (set A) p = min_score"
        hence "x \<in> candidates_with_min_score"
          using candidates_with_min_score_def by simp
        have "x \<in> set A"
          using `x \<in> candidates_with_min_score` candidates_with_min_score_def by auto
        have "x \<in> to_eliminate"
          using `to_eliminate \<in> set candidates_with_min_score` `x \<in> candidates_with_min_score`
            `snd q = set candidates_with_min_score` assms(2) q_def by simp
        have "x \<noteq> a" and "x \<noteq> c"
          using `x \<in> set A` `introduces_clone_in_candidate a c A p Ac pc` unfolding introduces_clone_in_candidate_def' by auto
        have "x \<in> to_eliminate \<inter> (set A - {a})"

lemma introduces_clone_preserves_elimination:
  assumes "introduces_clone_in_candidate a c A p Ac pc"
    and "to_eliminate \<in> defer IRV_step_drop r A p"
  shows "c \<notin> to_eliminate"
proof -
  obtain scores min_score candidates_with_min_score where
    scores_def: "scores = {IRV_score x A p |x. x \<in> A}"
    and min_score_def: "min_score = Min scores"
    and candidates_with_min_score_def: "candidates_with_min_score = {x \<in> A. IRV_score x A p = min_score}"
    by blast

  obtain q where q_def: "q = (IRV_step_drop r A p)"
    by simp

  have "eliminate_least_score IRV_score r A p = q"
    using q_def by simp

  have "snd q = candidates_with_min_score"
    using candidates_with_min_score_def min_score_def scores_def q_def
    by (metis (mono_tags, lifting) case_prod_conv)

  hence "to_eliminate \<in> set candidates_with_min_score"
    using assms(2) q_def by simp

  have "c \<noteq> a" and "c \<noteq> b" and "a \<noteq> b" and "b \<noteq> a"
    using assms(1) unfolding introduces_clone_in_candidate_def' by auto

  have "\<forall>x. x \<noteq> a \<and> x \<noteq> c \<longrightarrow> (IRV_score x A p \<noteq> min_score)"
  proof -
    {
      fix x
      assume "x \<noteq> a" and "x \<noteq> c"
      have "IRV_score x A p \<noteq> min_score"
      proof (rule ccontr)
        assume "IRV_score x A p = min_score"
        hence "x \<in> candidates_with_min_score"
          using candidates_with_min_score_def by simp
        have "x \<in> A"
          using `x \<in> candidates_with_min_score` candidates_with_min_score_def by auto
        have "x \<in> to_eliminate"
          using `to_eliminate \<in> set candidates_with_min_score` `x \<in> candidates_with_min_score`
            `snd q = candidates_with_min_score` assms(2) q_def by simp
        have "x \<noteq> a" and "x \<noteq> c"
          using `x \<in> A` `introduces_clone_in_candidate a c A p Ac pc` unfolding introduces_clone_in_candidate_def' by auto
        have "x \<in> to_eliminate \<inter> (A - {a})"
          using `x \<in> to_eliminate` `x \<in> A` `x \<noteq> a` by blast
        have "to_eliminate \<inter> (A - {a}) \<noteq> {}"
          using `x \<in> to_eliminate \<inter> (A - {a})` by blast
        hence "to_eliminate \<inter> (A - {a}) \<noteq> {}" and "to_eliminate \<inter> (A - {c}) \<noteq> {}"
          using `to_eliminate \<in> set candidates_with_min_score` `snd q = candidates_with_min_score`
            `x \<noteq> a` `x \<noteq> c` assms(1) unfolding introduces_clone_in_candidate_def'
          by blast+
        hence "a \<in> to_eliminate" and "c \<in> to_eliminate"
          using `c \<notin> A` unfolding introduces_clone_in_candidate_def' by auto
        hence "a = c"
          using `introduces_clone_in_candidate a c A p Ac pc` unfolding introduces_clone_in_candidate_def

(*
lemma introduces_clone_preserves_abs_winner:
  assumes "introduces_clone_in_candidate a c A p Ac pc"
    and "abs_winner A p w"
  shows "abs_winner Ac pc w"
proof -
  have "finite_profile A p" and "w \<in> A" and "has_majority p w"
    using assms(2) by auto
  hence "finite_profile Ac pc" and "w \<in> Ac" and "has_majority pc w"
    using assms(1) unfolding introduces_clone_in_candidate_def' by auto
  thus "abs_winner Ac pc w"
    by (simp add: abs_winner.simps)
qed

lemma preservation_of_preferences:
  assumes "dir_pref_in_ballot a b r"
    and "linear_order_on A r"
    and "a \<in> A"
    and "b \<in> A"
    and "introduces_clone_in_candidate a c p pc"
    and "r \<in> set p"
    and "r' \<in> set pc"
  shows "(a, b) \<in> r' "
proof -
  have "dir_pref_in_ballot a c r' \<or> dir_pref_in_ballot c a r'"
    using assms(5) assms(7) unfolding introduces_clone_in_candidate_def by blast
  then show ?thesis
  proof
    assume ac: "dir_pref_in_ballot a c r'"
    then have "\<not>(c, b) \<in> r'"
      using assms(1) dir_pref_excludes_inverse[OF ac] assms(2) assms(3) assms(4)
      by (metis assms(5) assms(6) assms(7) introduces_clone_in_candidate_def)
    then show ?thesis
      using ac assms(2) assms(3) assms(4) unfolding linear_order_on_def partial_order_on_def preorder_on_def
      by (metis total_on_def)
  next
    assume ca: "dir_pref_in_ballot c a r'"
    then have "\<not>(b, c) \<in> r'"
      using assms(1) dir_pref_excludes_inverse[OF assms(1)] assms(2) assms(3) assms(4)
      by (metis assms(5) assms(6) assms(7) introduces_clone_in_candidate_def)
    then show ?thesis
      using ca assms(2) assms(3) assms(4) unfolding linear_order_on_def partial_order_on_def preorder_on_def
      by (metis total_on_def)
  qed
qed

lemma win_count_of_new_clone:
  assumes "introduces_clone_in_candidate a c p pc"
  shows "win_count pc c \<le> win_count p a"
*)

(**)

(*
lemma preservation_of_preferences:
  assumes a1: "a \<noteq> b"
      and a2: "(a, b) \<in> r"
      and a3: "r \<in> set p"
      and a4: "introduces_clone_in_candidate a c p pc"
  shows "\<exists>r' \<in> set pc. (a, b) \<in> r'"
proof -
  have dir_pref: "\<forall>r\<in>set pc. dir_pref_in_ballot a c r \<or> dir_pref_in_ballot c a r"
    using a4 unfolding introduces_clone_in_candidate_def by auto
  obtain r' where r'_def: "r' \<in> set pc \<and> ((a, c) \<in> r' \<or> (c, a) \<in> r')"
    using dir_pref by blast
  hence "a \<noteq> c" using a1 by auto
  then have "(a, b) \<in> r'"
    using a2 r'_def a3 dir_pref_in_ballot_def by metis
  thus ?thesis using r'_def by blast
qed*)

(*
definition independence_of_clones :: "'a Electoral_Module \<Rightarrow> bool" where
  "independence_of_clones em \<equiv>
    \<forall>A p a c q. is_winner a em A p \<and>  introduces_clone a c p q
      \<longrightarrow> (is_winner a em (A \<union> {c}) q \<or> is_winner c em (A \<union> {c}) q)"

definition independence_of_clones :: "'a Electoral_Module \<Rightarrow> bool" where
  "independence_of_clones em \<equiv>
    \<forall>A p c pc.
      (\<exists>a. a \<in> elect em A p \<and> introduces_clone_in_candidate a c p pc)
      \<longrightarrow> ((\<exists>a. a \<in> elect em (A \<union> {c}) pc) \<or> c \<in> elect em (A \<union> {c}) pc)"*)

(*Functional Prog*)
(*
definition clone_up_rel :: "'a \<Rightarrow> 'a \<Rightarrow> 'a rel \<Rightarrow> 'a rel" where
  "clone_up_rel a b R =
    {(if z = a then b else z, if w = a then b else w) | z w. (z, w) \<in> R} \<union> R \<union> {(a,b)} \<union> {(b,b)}"

definition clone_down_rel :: "'a \<Rightarrow> 'a \<Rightarrow> 'a rel \<Rightarrow> 'a rel" where
  "clone_down_rel a b R =
    {(if z = a then b else z, if w = a then b else w) | z w. (z, w) \<in> R} \<union> R \<union> {(b,a)}\<union> {(b,b)}"

fun modify_profile_with_clones :: "'a Profile \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a Profile" where
"modify_profile_with_clones p a b =
  map
    (\<lambda>(i, rel).
      if i mod 2 = 0
      then clone_up_rel a b rel
      else clone_down_rel a b rel
    ) (enumerate 0 p)"

fun clone_intro :: "'a set \<Rightarrow> 'a Profile \<Rightarrow> 'a \<Rightarrow> 'a set \<times> 'a Profile" where
  "clone_intro A p a =
    (if a \<in> A then
      let x = (SOME m. m \<notin> A) in
      let new_p = modify_profile_with_clones p a x in
      (A \<union> {x}, new_p)
    else (A, p))"
*)

(*

definition independence_of_clones :: "('a set \<Rightarrow> 'a Profile \<Rightarrow> 'a set \<times> 'a set \<times> 'a set) \<Rightarrow> bool" where
"independence_of_clones em \<equiv>
  \<forall>A p w.
    case em A p of
      (A1, d, e) \<Rightarrow>
        if A1 = A \<and> d = {} \<and> e = {w} then
          let (A', p') = clone_intro A p w in
            case em A' p' of
              (A1', d', e') \<Rightarrow>
                if A1' = A' \<and> d' = {} then
                  \<exists>w'. e' = {w'} \<and> (w' = w \<or> clones_exist_in_A {w', w} p')
                else False
        else False"
*)

(*w refers to winner, defined later
definition independence_of_clones :: "('a set \<Rightarrow> 'a Profile \<Rightarrow> 'a set \<times> 'a set \<times> 'a set) \<Rightarrow> bool" where
"independence_of_clones em \<equiv>
  \<forall>A p.
    let (e, r, A1) = em A p in
    if \<exists>w. (e = {w} \<and> A1 = A - {w} \<and> r = {}) then
      let w = the_elem e; (A', p') = clone_intro A p w in
        case em A' p' of
          (e', r', A1') \<Rightarrow>
            A1' = A' \<and> r' = {} \<and> (\<exists>w'. e' = {w'} \<and> (w' = w \<or> clones_exist_in_A {w', w} p'))
    else False"*)

(*
definition independence_of_clones :: "('a set \<Rightarrow> 'a Profile \<Rightarrow> 'a set \<times> 'a set \<times> 'a set) \<Rightarrow> bool" where
"independence_of_clones em \<equiv>
  \<forall>A p w.
    case em A p of
      (A1, d, e) \<Rightarrow>
        if A1 = A \<and> d = {} \<and> e = {w} then
          let (A', p') = clone_intro A p w in
            case em A' p' of
              (A1', d', e') \<Rightarrow>
                if A1' = A' \<and> d' = {} then
                  \<exists>w'. e' = {w'} \<and> (w' = w \<or> clones_exist_in_A {w', w} p')
                else False
        else False"*)

(*

fun clone_intro2 :: "('a set \<Rightarrow> 'a Profile \<Rightarrow> 'a Result) \<Rightarrow> 'a set \<Rightarrow> 'a Profile \<Rightarrow> 'a \<Rightarrow> 'a Result" where
"clone_intro2 em A p x =
  (if A \<noteq> {} then
    let a = (SOME m. m \<in> A) in
    let new_p = modify_profile_with_clones p a x in
    let new_A = A \<union> {x} in
    em new_A new_p
  else undefined)"

definition same_result :: "('a set \<Rightarrow> 'a Profile \<Rightarrow> 'a Result) \<Rightarrow> ('a set \<Rightarrow> 'a Profile \<Rightarrow> 'a Result) \<Rightarrow> ('a Result \<Rightarrow> 'a) \<Rightarrow> bool" where
  "same_result em1 em2 voting_rule \<equiv> \<forall> A p. em1 A p = em2 A p \<longrightarrow> voting_rule (em1 A p) = voting_rule (em2 A p)"

definition same_result :: "('a set \<Rightarrow> 'a Profile \<Rightarrow> 'a Result) \<Rightarrow> ('a set \<Rightarrow> 'a Profile \<Rightarrow> 'a Result) \<Rightarrow> ('a Result \<Rightarrow> 'a) \<Rightarrow> bool" where
  "same_result em1 em2 voting_rule \<equiv> \<forall> A p. em1 A p = em2 A p \<longrightarrow> voting_rule (em1 A p) = voting_rule (em2 A p)"

definition same_result :: "('a set \<Rightarrow> 'a Profile \<Rightarrow> 'a Result) \<Rightarrow> ('a Result \<Rightarrow> 'a) \<Rightarrow> bool" where
  "same_result em voting_rule \<equiv> \<forall> A p winner. em A p = OK winner \<longrightarrow>
    (\<forall>a_clone. a_clone \<noteq> winner \<longrightarrow> em (insert a_clone A) (modify_profile_with_clones p winner a_clone) = em A p) \<longrightarrow>
    voting_rule (em A p) = voting_rule (em (insert a_clone A) (modify_profile_with_clones p winner a_clone))"
*)
end