File Coverage

blib/lib/Vote/Count/Method/CondorcetVsIRV.pm
Criterion Covered Total %
statement 176 181 97.2
branch 45 50 90.0
condition 4 9 44.4
subroutine 25 25 100.0
pod 2 8 25.0
total 252 273 92.3


line stmt bran cond sub pod time code
1 2     2   1426 use strict;
  2         7  
  2         72  
2 2     2   13 use warnings;
  2         5  
  2         73  
3 2     2   45 use 5.024;
  2         10  
4 2     2   13 use feature qw /postderef signatures/;
  2         4  
  2         218  
5              
6             package Vote::Count::Method::CondorcetVsIRV;
7 2     2   13 use namespace::autoclean;
  2         5  
  2         25  
8 2     2   278 use Moose;
  2         4  
  2         22  
9              
10             with 'Vote::Count::Log';
11              
12 2     2   15966 use Storable 3.15 'dclone';
  2         54  
  2         137  
13 2     2   15 use Vote::Count::ReadBallots qw/read_ballots write_ballots/;
  2         6  
  2         100  
14 2     2   1265 use Vote::Count::Redact qw/RedactSingle RedactPair RedactBullet/;
  2         6  
  2         155  
15 2     2   1071 use Vote::Count::Method::CondorcetIRV;
  2         10  
  2         130  
16 2     2   16 use Try::Tiny;
  2         7  
  2         154  
17 2     2   15 use Data::Dumper;
  2         6  
  2         149  
18              
19             our $VERSION='2.00';
20              
21             # no warnings 'uninitialized';
22 2     2   14 no warnings qw/experimental/;
  2         5  
  2         4133  
23              
24             =head1 NAME
25              
26             Vote::Count::Method::CondorcetVsIRV
27              
28             =head1 VERSION 2.00
29              
30             =cut
31              
32             # ABSTRACT: Condorcet versus IRV
33              
34             =pod
35              
36             =head1 SYNOPSIS
37              
38             use Vote::Count::Method::CondorcetVsIRV;
39              
40             my $Election = Vote::Count::Method::CondorcetVsIRV->new( ... );
41             my $result = $Election->CondorcetVsIRV();
42             or
43             my $Election = Vote::Count->new( TieBreakMethod => 'approval' );
44             my $result = $Election->CondorcetVsIRV( relaxed => 1 );
45             equivalent to default:
46             my $result = $Election->CondorcetVsIRV( relaxed => 0, smithsetirv => 0 );
47              
48             say $result->{'winner'};
49              
50             $Election->WriteAllLogs();
51              
52             Returns a HashRef with a key for winner.
53              
54             =head1 Method Common Name: Condorcet vs IRV
55              
56             Condorcet vs IRV Methods determine if the Condorcet Winner needed votes from the IRV winner; electing the Condorcet Winner if there was not a later harm violation, electing the IRV winner if there was. If there is no Condorcet Winner the IRV Winner is chosen.
57              
58             To determine if there was a violation the ballots of one or more choices are redacted, with later choice on those ballots removed.
59              
60             With these methods it is also possible to allow a tolerance for Later Harm.
61              
62             =head3 Double Redaction
63              
64             The Double Redaction method (default) measures the later harm effect between a Condorcet Winner and the IRV Winner.
65              
66             Considering the Margin of the Condorcet Winner over the IRV Winner and the number of votes needed by the Condorcet Winner from the IRV winner as measures of Preference for the Condorcet Winner and of Later Harm, it is also possible to establish a Later Harm Tolerance Threshold.
67              
68             The Relaxed Later Harm option will select the Condorcet Winner when their margin of victory over the IRV Winner is greater than the number of later votes they need from the IRV Winner to be a Condorcet Winner. Although not presently implemented a different ratio or percentage could be used.
69              
70             Because in most cases where the IRV and Condorcet winners are different there are Later Harm effects, without relaxed this method will almost always confirm the IRV winner.
71              
72             =head3 Simple (Single Redaction)
73              
74             This variation only redacts the ballots that choose the IRV Winner as their first choice. This gives the voters confidence that if their first choice wins by the later harm safe method, that their vote will not be used against that choice.
75              
76             The simplest form is:
77              
78             1. Determine the IRV Winner
79              
80             2. Treating the ballots cast with the IRV Winner as their first choice as ballots cast only for the IRV Winner, determine the Condorcet Winner.
81              
82             3. Elect the Condorcet Winner, if there is none, elect the IRV Winner.
83              
84             Unfortunately, this simplest form, in cases where more than one choice defeats the IRV Winner in pairing and later choices of the IRV Winner's ballots determine which becomes the Condorcet Winner, removes the supporters of the IRV Winner from the final decision.
85              
86             The form implemented by Vote::Count is:
87              
88             =over
89              
90             1. Determine both the IRV and Condorcet Winner. If they are the same, elect that choice. If there is no Condorcet Winner, elect the IRV Winner.
91              
92             2. Treating the ballots cast with the IRV Winner as their first choice as ballots cast for only the IRV Winner determine the Condorcet Winner.
93              
94             3. If there is a Condorcet Winner, elect the first Condorcet Winner, if there is none, elect the IRV Winner. (The redaction cannot make the IRV Winner a Condorcet Winner if it isn't already one).
95              
96             =back
97              
98             =cut
99              
100             =head1 Criteria
101              
102             The double redaction version is later harm safe if the relaxed option is not used. The simple version later harm protects first choice votes only, it also does not protect the first Condorcet Winner's votes at all.
103              
104             =head2 Simplicity
105              
106             The simple version does not require Condorcet Loop resolution, and thus can be considered to be on par with Benham for complexity, and like Benham is Hand Countable. The double redaction version is more complex, but is perhaps more valuable as an approach for measuring later harm.
107              
108             =head2 Later Harm
109              
110             This method meets Later Harm with the default strict option.
111              
112             The relaxed option allows a finite Later Harm effect.
113              
114             Using the TCA Floor Rule and or Smith Set IRV add small Later Harm effects.
115              
116             =head2 Condorcet Criteria
117              
118             This method only meets Condorcet Loser, when the IRV winner is chosen instead of the Condorcet Winner, the winner may be outside the Smith Set.
119              
120             =head2 Consistency
121              
122             Because this method chooses between the outcomes of two different methods, it is subject to the consistency failings of both. Given that Cloning is an important consistency issue in real elections, the clone handling should be an improvement over IRV.
123              
124             =head1 Implementation
125              
126             Details specific to this implementation.
127              
128             The Tie Breaker is defaulted to (modified) Grand Junction for resolvability. Any Tie Breaker supported by Vote::Count::TieBreaker may be used, 'all' and 'none' are not recommended.
129              
130             =head2 Function Name: CondorcetVsIRV
131              
132             Runs the election, returns a hashref containing the winner, similar to how other Vote::Count Methods such as RunIRV behave.
133              
134             =head3 Arguments for CondorcetVsIRV()
135              
136             =over
137              
138             =item* relaxed
139              
140             =item* simple
141              
142             =item* smithsetirv
143              
144             =back
145              
146             =head2 LogTo, LogPath, LogBaseName, LogRedactedTo
147              
148             The first three behave as normal Vote::Count::Log methods, except that the default is /tmp/condorcetvsirv.
149              
150             LogRedactedTo defaults to appending _redacted into the log names for the redacted election, it can be overridden by setting a value (which should be /path/basename) like LogTo.
151              
152             =head2 WriteLog WriteAllLogs
153              
154             WriteLog behaves normally, there is a log set for the CondorcetVSIRV object as well as child logs for the Election and RedactedElection, each of which has a set of logs for PairMatrix as well. WriteAllLogs will write all of these logs.
155              
156             =cut
157              
158             # LogTo over-writes role LogTo changing default filename.
159             has 'LogTo' => (
160             is => 'rw',
161             isa => 'Str',
162             default => '/tmp/condorcetvsirv',
163             );
164              
165             has 'LogRedactedTo' => (
166             is => 'lazy',
167             is => 'rw',
168             isa => 'Str',
169             builder => '_setredactedlog',
170             );
171              
172 22     22   66146 sub _setredactedlog ( $self ) {
  22         61  
  22         37  
173             # There is a bug with LogTo being uninitialized despite having a default
174 22 100       722 my $logto
175             = defined $self->LogTo()
176             ? $self->LogTo() . '_redacted'
177             : '/tmp/condorcetvsirv_redacted';
178 22         78 return $logto;
179             }
180              
181             has 'TieBreakMethod' => (
182             is => 'ro',
183             isa => 'Str',
184             default => 'grandjunction',
185             );
186              
187             has 'BallotSet' => ( is => 'ro', isa => 'HashRef', required => 1 );
188              
189             has 'Active' => (
190             is => 'rw',
191             isa => 'HashRef',
192             lazy => 1,
193             builder => '_InitialActive',
194             );
195              
196 22     22   50 sub _InitialActive ( $I ) { return dclone $I->BallotSet()->{'choices'} }
  22         51  
  22         63  
  22         677  
197              
198 4     4 0 8 sub SetActive ( $I, $active ) {
  4         8  
  4         7  
  4         8  
199 4         137 $I->{'Active'} = dclone $active;
200 4         41 $I->{'Election'}->SetActive($active);
201 4 100       21 if ( defined $I->{'RedactedElection'} ) {
202 2         10 $I->{'RedactedElection'}->SetActive($active);
203             }
204             }
205              
206 1     1 0 3 sub ResetActive ( $self ) {
  1         4  
  1         1  
207 1         44 my $new = dclone $self->BallotSet()->{'choices'};
208 1         7 $self->SetActive($new);
209 1         3 return $new;
210             }
211              
212             # sub ResetActive ( $self ) { return dclone $self->BallotSet()->{'choices'} }
213              
214 19     19   44 sub _CVI_IRV ( $I, $active, $smithsetirv ) {
  19         38  
  19         46  
  19         37  
  19         40  
215 19         45 my $WonIRV = undef;
216 19         52 my $irvresult = undef;
217 19 100       69 if ($smithsetirv) {
218 2         63 $irvresult = $I->SmithSetIRV( $I->TieBreakMethod() );
219             }
220             else {
221 17         562 $irvresult = $I->RunIRV( $active, $I->TieBreakMethod() );
222             }
223 19         153 $I->logd( 'IRV Result: ' . Dumper $irvresult );
224 19 100       158 return $irvresult->{'winner'} if $irvresult->{'winner'};
225 1         4 $I->logt("IRV ended with a Tie.");
226             $I->logt(
227 1         7 "Active (Tied) Choices are: " . join( ', ', $irvresult->{'tied'} ) );
228 1         18 $I->SetActiveFromArrayRef( $irvresult->{'tied'} );
229 1         5 return 0;
230             }
231              
232             sub BUILD {
233 22     22 0 44591 my $self = shift;
234             $self->{'Election'} = Vote::Count::Method::CondorcetIRV->new(
235             BallotSet => $self->BallotSet(),
236             TieBreakMethod => $self->TieBreakMethod(),
237             Active => $self->Active(),
238             BallotSetType => 'rcv',
239 22         879 LogTo => $self->{'LogTo'} . '_unredacted',
240             );
241 22         370 $self->{'RedactedElection'} = undef,;
242             }
243              
244 1     1 1 4 sub WriteAllLogs ($I) {
  1         2  
  1         3  
245 1         7 $I->WriteLog();
246 1         467 $I->Election()->WriteLog();
247 1         494 $I->RedactedElection()->WriteLog();
248 1         483 $I->Election()->PairMatrix()->WriteLog();
249 1         482 $I->RedactedElection()->PairMatrix()->WriteLog();
250             }
251              
252 35     35 0 99 sub Election ($self) { return $self->{'Election'} }
  35         70  
  35         59  
  35         185  
253              
254 15     15 0 34 sub RedactedElection ( $self, $ballotset = undef, $active = undef ) {
  15         28  
  15         37  
  15         30  
  15         26  
255 15         180 return $self->{'RedactedElection'};
256             }
257              
258 11     11 0 37 sub CreateRedactedElection ( $self, $WonCondorcet, $WonIRV, $simpleflag=0 ) {
  11         23  
  11         31  
  11         22  
  11         23  
  11         24  
259 11 100       420 my $ballotset = $simpleflag
260             ? RedactBullet ( $self->BallotSet(), $WonIRV )
261             : RedactPair( $self->BallotSet(), $WonCondorcet, $WonIRV );
262 11         560 $self->{'RedactedElection'} = Vote::Count->new(
263             BallotSet => $ballotset,
264             TieBreakMethod => $self->TieBreakMethod(),
265             Active => $self->Active(),
266             BallotSetType => 'rcv',
267             LogTo => $self->LogRedactedTo(),
268             );
269             $self->logd(
270             'Created Redacted Election.',
271             $self->{'RedactedElection'}->PairMatrix()->PairingVotesTable(),
272 11         307 $self->{'RedactedElection'}->PairMatrix()->MatrixTable(),
273             );
274             }
275              
276 10     10   25 sub _CVI_RedactRun ( $I, $WonCondorcet, $WonIRV, $active, $options ) {
  10         20  
  10         28  
  10         21  
  10         24  
  10         19  
  10         25  
277             my $smithsetirv
278 10 50       106 = $options->{'smithsetirv'} ? 1 : 0;
279 10 100       44 my $relaxed = $options->{'relaxed'} ? $options->{'relaxed'} : 0;
280 10 100       34 my $simpleflag = $options->{'simple'} ? 1 : 0;
281 10         51 my $E = $I->Election();
282 10         38 my $R = $I->RedactedElection();
283 10         360 my $ConfirmC = $R->PairMatrix->CondorcetWinner();
284 10         54 my $ConfirmI = _CVI_IRV( $R, $active, $smithsetirv );
285 10 100       49 if ( $ConfirmC ) {
286 9 100 66     66 if ( $simpleflag ) {
    100          
287 3         17 $I->logt("Elected $WonCondorcet, Redacted Ballots had a Condorcet Winner.");
288 3 100       17 $I->logv("The Redacted Condorcet Winner was $ConfirmC.")
289             if ( $ConfirmC ne $WonCondorcet);
290 3         11 return $WonCondorcet ;
291             } elsif ( $ConfirmC eq $WonCondorcet or $ConfirmC eq $WonIRV ) {
292 3         24 $I->logt("Elected $ConfirmC, Redacted Ballots Condorcet Winner.");
293 3         14 return $ConfirmC;
294             }
295             } else {
296 1         6 $ConfirmI = _CVI_IRV( $R, $active, $smithsetirv );
297 1 50 33     11 if ( $ConfirmI eq $WonCondorcet or $ConfirmI eq $WonIRV ) {
298 0         0 $I->logt("Elected $ConfirmI, Redacted Ballots IRV Winner.");
299 0         0 return $ConfirmI;
300             }
301             }
302 4 100       21 $ConfirmC = 'NONE' unless $ConfirmC;
303 4         34 $I->logt("Neither $WonCondorcet nor $WonIRV were confirmed.");
304 4         28 $I->logt(
305             "Redacted Ballots Winners: Condorcet = $ConfirmC, IRV = $ConfirmI");
306 4 100       18 if ($relaxed) {
307 2         61 my $GreatestLoss = $R->PairMatrix()->GreatestLoss($WonCondorcet);
308             my $Margin = $E->PairMatrix()->GetPairResult( $WonCondorcet, $WonIRV )
309 2         62 ->{'margin'};
310 2         13 $I->logt(
311             "The margin of the Condorcet over the IRV winner was: $Margin");
312 2         15 $I->logt(
313             "$WonCondorcet\'s greatest loss with redacted ballots was $GreatestLoss."
314             );
315 2 100       10 if ( $Margin > $GreatestLoss ) {
316 1         6 $I->logt("Elected: $WonCondorcet");
317 1         7 return $WonCondorcet;
318             }
319             }
320 3         19 $I->logt("Elected: $WonIRV");
321 3         14 return $WonIRV;
322             }
323              
324 21     21 1 3128 sub CondorcetVsIRV ( $self, %args ) {
  21         56  
  21         73  
  21         40  
325 21         82 my $E = $self->Election();
326 21 100       89 my $smithsetirv = defined $args{'smithsetirv'} ? $args{'smithsetirv'} : 0;
327 21 100       83 my $simpleflag = defined $args{'simple'} ? $args{'simple'} : 0;
328 21         880 my $active = $self->Active();
329             # check for majority winner.
330 21         134 my $majority = $E->EvaluateTopCountMajority()->{'winner'};
331 21 50       71 return $majority if $majority;
332 21         53 my $WonIRV = undef;
333 21         764 my $WonCondorcet = $E->PairMatrix()->CondorcetWinner();
334 21 100       80 if ($WonCondorcet) {
335 13         95 $self->logt("Condorcet Winner is $WonCondorcet");
336             # Even if SmithSetIRV requested, it would return the condorcet winner
337             # We need to know if a different choice would win IRV.
338 13         810 $WonIRV = $E->RunIRV( $active, $E->TieBreakMethod() )->{'winner'};
339             }
340             else {
341 8         52 $self->logt("No Condorcet Winner");
342 8         41 $WonIRV = _CVI_IRV( $E, $active, $smithsetirv );
343 8 100       31 if ($WonIRV) {
344 7         43 $self->logt("Electing IRV Winner $WonIRV");
345 7         83 return { 'winner' => $WonIRV };
346             }
347             else { ;
348 1         5 $self->logt("There is no Condorcet or IRV winner.");
349 1         15 return { 'winner' => 0 };
350             }
351             }
352              
353             # IRV private already logged tie, now return the false value.
354             # Edge case IRV tie with Condorcet Winner, I guess CW wins?
355 13 100       62 unless ($WonIRV) {
356 1 50       6 if ($WonCondorcet) {
357 1         8 $self->logt("Electing Condorcet Winner $WonCondorcet, IRV tied.");
358 1         10 return { 'winner' => $WonCondorcet};
359             }
360 0         0 return { 'winner' => 0 };
361             }
362 12 100       54 if ( $WonIRV eq $WonCondorcet ) {
363 2         16 $self->logt("Electing $WonIRV the winner by both Condorcet and IRV.");
364 2         18 return { 'winner' => $WonIRV };
365             }
366 10 50 33     69 if ( $WonIRV and !$WonCondorcet ) {
367 0         0 $self->logt(
368             "Electing IRV Winner $WonIRV. There was no Condorcet Winner.");
369 0         0 return { 'winner' => $WonIRV };
370             }
371 10         63 $self->CreateRedactedElection( $WonCondorcet, $WonIRV, $simpleflag );
372 10         255 my $winner
373             = $self->_CVI_RedactRun( $WonCondorcet, $WonIRV, $active, \%args );
374 10         89 return { 'winner' => $winner };
375              
376             }
377              
378             1;
379              
380             #FOOTER
381              
382             =pod
383              
384             BUG TRACKER
385              
386             L<https://github.com/brainbuz/Vote-Count/issues>
387              
388             AUTHOR
389              
390             John Karr (BRAINBUZ) brainbuz@cpan.org
391              
392             CONTRIBUTORS
393              
394             Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org.
395              
396             LICENSE
397              
398             This module is released under the GNU Public License Version 3. See license file for details. For more information on this license visit L<http://fsf.org>.
399              
400             SUPPORT
401              
402             This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author.
403              
404             =cut
405