# [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});

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
=====================================================================
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