[EM] Programming voting systems in REDUCE
Craig Carey
research at ijs.co.nz
Sun Sep 19 21:08:52 PDT 1999
REDUCE can be used in preferential voting.
Some REDUCE code follows. It might be suitable for
numerically testing preferential voting formulae.
I wrote the following code partly to prove that Condorcet
is failed by that the principle (P1) I wrote on.
However can be seen rather easily to survive that (P1)
test after boundaries and interiors of paradox regions
are carefully excluded.
(P1) is:
-------------------------------------------------------
Preferential Voting Principle (P1)
For all c (c is a candidate), all V, all V' (where
V and V' are election systems), then if
V' in AltAtAfter(V,c) and c loses V, then c
also loses V'.
[AltAtAfter(V,c) is a set of possible alterations
including the deletion of preferences (or papers if
the preference is the first].
-------------------------------------------------------
Home of REDUCE (along with RAND):
http://www.zib.de/Symbolik/reduce/
View TEX and LaTeX documents in a webbrowser:
http://www.alphaworks.ibm.com/formula/techexplorer
%--------------------------------------------------
load sets; % get the set subtraction "\" operator
procedure combi(S); begin
scalar S,k; % make a set of all combinations of S
if (length S <= 1) then return ({S});
return mkset(append({S}, (foreach k in S join (combi(S \ {k})))));
end;
combi({1,2,3});
procedure perm2(R,S); begin % make a set of all permutations of S
scalar R,S,k;
if 1 >= length S then return {append(R, S)};
return foreach k in S join perm2(append(R,{k}), S \ {k});
end;
procedure permu(S); begin scalar S; return perm2({},S); end;
procedure pc0(x); begin % for comparions, convert 'c' to 3, etc.
if member(x, {1, a}) then return 1;
if member(x, {2, b}) then return 2;
if member(x, {3, c}) then return 3;
if member(x, {4, d}) then return 4;
if member(x, {5, e}) then return 5;
if member(x, {6, f}) then return 6;
if member(x, {7, g}) then return 7;
if member(x, {8, h}) then return 8;
if member(x, {9, i}) then return 9;
write 1/0;
end;
procedure pc1(A,B); begin % returns 1 if order is Ok else 0
scalar k,A,B,T1,T2,R3;
R3 := -1;
for k:=1:min(length A, length B) do begin
T1:=pc0(part(A,k)); T2:=pc0(part(B,k));
if T1 neq T2 then begin R3 := (if T1 > T2 then 0 else 1);
go to c0nt; end;
end; c0nt:
if (-1 neq R3) then return R3;
return if (length A) <= (length B) then 1 else 0;
end;
procedure papers(S); begin % make a set of all preferential papers
scalar S,k,R; R := {};
foreach k in (combi(S)) do
if (length S) > (length k) then R := append (R, permu(k));
return R;
end;
%%procedure pc1a(A,B); begin; return 1; end;
%sort(papers({a,b,c}), pc1);
% 2-dim Matrix versus Array. Prefer matrix as they print better.
% Can't pass a 'matrix' into a procedure through parameters.
% Can 'return' a matrix. Can't 'return' an 'array'. Can return
% an array by reference through parameters. 'Matrix'es print
% better. Matrix type with pass by global var preferred.
% procedure candset(); begin % input is in global array/matrix 'vs'
% % Reads global matrix 'vs'. find all candidates in a voting system
% % join all lists in column 1 and remove duplicates with mkset
% scalar k;
% return mkset(for k:=1:part((length vs),1) join vs(k,2));
% end;
procedure vpapers(S); begin % make new array of voting paper counts
% Input: S are the candidates, e.g. S={a,b,c} or {1,2,3}.
% Sets globals cs, pa, np, vs, nc
% Sets globals cs, pa, np, vs, nc
scalar S,k,R; S := mkset(S);
R := papers(S); pa := sort(R, pc1);
np := length pa;
cs := S;
nc := length cs;
clear vs; matrix vs(np, 3);
for k:=1:np do begin
vs(k,1):=k; vs(k,2):=part(pa,k); vs(k,3):=0; end;
write "Matrix vs = ", vs;
end;
vpapers({a,b,c});
load linalg;
on not_negative;
on only_integer;
procedure randvs(); begin
scalar k;
clear randvs2;
randvs2 := random_matrix(np,1,10);
for k:=1:np do vs(k,3) := randvs2(k,1);
return vs;
end;
randvs();
%=====================================================
procedure condc(P,c1,c2); begin % Condorcet: return -1:0:1 for c1:{}:c2
scalar P,c1,c2,k,cc1,R;
cc1 := append({c1}, {c2}); R := 0;
%write "condc1:",P,", ",c1,", ",c2,", ",cc1;
foreach k in P do begin
%write "condc2: ", k, ", ", cc1;
if k member cc1 then << R:=(if c1 = k then -1 else 1);
go to c0nt; >>; end;
c0nt: return R
end;
condc({1,2,3},2,3);
procedure condor(); begin % The Condorcet method
scalar k,k1,k2,c1,c2,T2,T3,j,wL;
% Reads global matrix 'vs' & 'cs', writes global matrix CW
matrix CW(nc,nc); % global var
for k1:=1:nc do for k2:=(k1+1):nc do CW(k1,k2):=0;
for k1:=1:nc do
for k2:=(k1+1):nc do
for j:=1:np do begin
T3 := vs(j,2);
T2 := condc(T3,part(cs,k1),part(cs,k2));
%write T2,", ",T3,", ",vs(j,2),", ",part(cs,k1),", ",part(cs,k2);
if T2 > 0 then CW(k1,k2) := CW(k1,k2) - vs(j,3);
if T2 > 0 then CW(k2,k1) := CW(k2,k1) + vs(j,3);
if T2 < 0 then CW(k1,k2) := CW(k1,k2) + vs(j,3);
if T2 < 0 then CW(k2,k1) := CW(k2,k1) - vs(j,3);
end;
matrix W(2,nc);
for k1:=1:nc do
for k2:=1:nc do
if CW(k1,k2) neq 0 then begin
wL := (if 0 < CW(k1,k2) then 1 else 2);
W(wL,k1) := W(wL,k1) + 1;
end;
return {vs,CW,W};
end;
condor();
procedure randcondor(); begin
scalar k;
randvs();
write vs, condor();
end;
randcondor();
==========================================================
The above does not much more than print the following:
{
[1 {a} 3]
[ ]
[2 {a,b} 8]
[ ]
[3 {a,c} 0]
[ ]
[4 {b} 7]
[ ]
[5 {b,a} 4]
[ ]
[6 {b,c} 4]
[ ]
[7 {c} 7]
[ ]
[8 {c,a} 2]
[ ]
[9 {c,b} 9]
,
[0 -11 -7]
[ ]
[11 0 5 ]
[ ]
[7 -5 0 ]
,
[0 2 1]
[ ]
[2 0 1]
}
The last matrix shows A is a Condorcet loser 2 in position
(2,1), and that B is a Condorcet winner 2 in position (1,2).
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
REDUCE can take up a lot of disk space.
REDUCE has a quality MS Windows help file (redref.hlp).
Use "load" .. for compiled ".b" files, and "in" for not
compiled ".red" REDUCE files.
REDUCE.BAT
----------------------------------
set reduce=R:\REDUCE\ZIB\fix95
rem some of this may be wrong...
set psl=%reduce%\psl
set proot=%psl%
set pl=%psl%\lap
set psys=%psl%\bin\%machine%
set rfasl=%reduce%\fasl
set rpsl=%reduce%\psl
set rutil=%reduce%\util
set rsrc=%reduce%\src
set rlib=%reduce%\lib
set rplot=%reduce%\plot
set rxmpl=%reduce%\xmpl
set rlog=%reduce%\log
set rpl=%pl%
R:\REDUCE\ZIB\fix95\bin\win95\bpsl.exe -f R:\REDUCE\ZIB\fix95\bin\win95\reduce.img -td 16000000
----------------------------------
A BPSL.EXE & REDUCE.IMG that I got running are 393,728 & 1,470,712
bytes in size.
REDLOG (which can prove theorems about polytope equations) runs in
REDUCE. REDLOG:
http://www.fmi.uni-passau.de/~redlog/
http://www.fmi.uni-passau.de/~redlog/pc/
A top of a file called SETS.RED follows (but SET.B) would be used
instead...
=====================================================================
module sets; % Operators for basic set theory.
%% Author: F.J.Wright at Maths.QMW.ac.uk.
%% Date: 20 Feb 1994.
%% WARNING: This module patches mk!*sq.
%% To do:
%% Improve symbolic set-Boolean analysis.
%% Rationalize the coding?
%% A nice illustration of fancy maths printing in the graphics mode
%% of PSL-REDUCE under MS-Windows and X, but it works properly only with
%% interface versions compiled from sources dated after 14 Feb 1994.
%% Defines the set-valued infix operators (with synonyms):
%% union, intersection (intersect), setdiff (minus, \),
%% and the Boolean-valued infix operators:
%% member, subset_eq, subset, set_eq.
%% Arguments may be algebraic-mode lists representing explicit sets,
%% or identifiers representing symbolic sets, or set-valued expressions.
%% Lists are converted to sets by deleting any duplicate elements, and
%% sets are sorted into a canonical ordering before being returned.
%% This can also be done explicitly by applying the unary operator
%% mkset. The set-valued operators may remain symbolic, but
%% REDUCE does not currently support this concept for Boolean-valued
%% operators, and so neither does this package (although it could).
...
=====================================================================
_____________________________________________________________
Mr G. A. Craig Carey
E-mail: research at ijs.co.nz
Auckland, Nth Island, New Zealand
Pages: Snooz Metasearch: http://www.ijs.co.nz/info/snooz.htm
Public Proxies, MEDLINE Search, Multithreaded Add-URL
_____________________________________________________________
More information about the Election-Methods
mailing list