[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):

View TEX and LaTeX documents in a webbrowser:


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

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

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;

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;
%%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;

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;


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

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);
   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;
   return {vs,CW,W};

procedure randcondor(); begin
   scalar k;
   write vs, condor();
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.

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

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
       Public Proxies, MEDLINE Search, Multithreaded Add-URL

More information about the Election-Methods mailing list