example.vote

A>B>C>D: 00.00%
A>B>D>C: 05.60%
A>C>B>D: 06.80%
A>C>D>B: 07.00%
A>D>B>C: 01.50%
A>D>C>B: 06.30%
B>A>C>D: 04.40%
B>A>D>C: 06.70%
B>C>A>D: 02.30%
B>C>D>A: 06.60%
B>D>A>C: 00.00%
B>D>C>A: 05.50%
C>A>B>D: 01.10%
C>A>D>B: 00.00%
C>B>A>D: 07.10%
C>B>D>A: 04.30%
C>D>A>B: 03.90%
C>D>B>A: 05.00%
D>A>B>C: 05.00%
D>A>C>B: 00.00%
D>B>A>C: 06.30%
D>B>C>A: 04.10%
D>C>A>B: 03.70%
D>C>B>A: 06.80%

gistfile1.txt

A>B>C>D: 00.00%
A>B>D>C: 07.70%
A>C>B>D: 03.70%
A>C>D>B: 04.60%
A>D>B>C: 04.00%
A>D>C>B: 08.70%
B>A>C>D: 01.50%
B>A>D>C: 03.50%
B>C>A>D: 05.90%
B>C>D>A: 01.70%
B>D>A>C: 03.30%
B>D>C>A: 06.70%
C>A>B>D: 03.50%
C>A>D>B: 00.00%
C>B>A>D: 09.00%
C>B>D>A: 01.30%
C>D>A>B: 07.00%
C>D>B>A: 06.00%
D>A>B>C: 03.50%
D>A>C>B: 03.10%
D>B>A>C: 04.20%
D>B>C>A: 06.00%
D>C>A>B: 01.50%
D>C>B>A: 03.60%

recursive-voting.pl

#! /usr/local/bin/perl -w

## See <URL: https://mathoverflow.net/questions/420356/recursive-runoff-voting-schemes >
## and <URL: https://twitter.com/gro_tsen/status/1514593018552143876 >

## This script draws a random distribution of orders of preferences
## among N candidates, and then elects a candidate using the voting
## schemes defined above for various runoff depths k from 0 (which is
## just fptp voting) to 7.

use strict;
use warnings;
use Getopt::Std;

## Options are:
## -c <list>: use this comma-separated list of candidate names (mandatory)
## -r <file>: read votes from this file (format the same as produced by -w)
##            (otherwise, will be randomly-generated)
## -w <file>: write votes to this file
my %opts;
getopts("c:r:w:", \%opts);

unless ( defined($opts{c}) ) {
    die "please pass -c option with comma-separated list of candidate names";
}

my @candnames = split /\,/, $opts{c};
my $nbcandidates = scalar(@candnames);

## Generate a table of all permutations of 0..$nbcandidates-1:
my @permtab;
my @ordernames;
my %revorderhash;
sub genperms {
    my @t = ();
    my $i = 0;
  genloop:
    while ( 1 ) {
	if ( $i >= $nbcandidates ) {
	    if ( scalar(@t) == 0 ) {
		last genloop;
	    }
	    $i = pop @t;
	    $i++;
	    next genloop;
	}
	for ( my $j=0 ; $j<scalar(@t) ; $j++ ) {
	    if ( $i == $t[$j] ) {
		$i++;
		next genloop;
	    }
	}
	push @t, $i;
	if ( scalar(@t) >= $nbcandidates ) {
	    my $order = join(">",map {$candnames[$_]} @t);
	    $ordernames[scalar(@permtab)] = $order;
	    die "the universe has collapsed" if defined($revorderhash{$order});
	    $revorderhash{$order} = scalar(@permtab);
	    push @permtab, [ @t ];  # Copy!
	    pop @t;
	    $i++;
	} else {
	    $i = 0;
	}
    }
}
genperms;

my @votetab;  # Shared global variable with voting results

## Generate random distribution of preferences and store it in @votetab.
sub randomvote {
    @votetab = ();
    my $sum = 0;
    for ( my $p=0 ; $p<scalar(@permtab) ; $p++ ) {
	my $val = rand();
	push @votetab, $val;
	$sum += $val;
    }
    # Normalize:
    for ( my $p=0 ; $p<scalar(@permtab) ; $p++ ) {
	$votetab[$p] /= $sum;
    }
}

## Read distribution from a file.
sub readvote {
    my $inf = shift;
    @votetab = ();
    my $sum = 0;
    while (<$inf>) {
	die "bad input format" unless m/^([^\s\:]+)\:\s*([0-9]*(?:\.[0-9]+)?|[0-9]+(?:\.[0-9]*)?)\%?/;
	my $order = $1;
	my $val = $2 + 0;
	die "bad permutation $order" unless defined($revorderhash{$order});
	my $p = $revorderhash{$order};
	die "duplicate line $order" if defined($votetab[$p]);
	$votetab[$p] = $val;
	$sum += $val;
    }
    die "no votes" if $sum <= 0;
    # Normalize:
    for ( my $p=0 ; $p<scalar(@permtab) ; $p++ ) {
	$votetab[$p] = 0 unless defined($votetab[$p]);
	$votetab[$p] /= $sum;
    }
}

## Write distribution to a file.
sub writevote {
    my $outf = shift;
    for ( my $p=0 ; $p<scalar(@permtab) ; $p++ ) {
        printf $outf "%s: %05.2f%%\n", $ordernames[$p], $votetab[$p]*100;
    }
}

my $warned_equality;

## The lowest recursion step (perform a simple fptp vote), possibly
## excluding some candidates, and possibly inverted in one or two ways:
## - simplevote(0,0) returns the candidate having the MOST TOP votes,
##   i.e., the "best" (most liked) candidate
## - simplevote(1,0) returns the candidate having the LEAST BOTTOM votes
##   i.e., the "dual best" (least disliked) candidate
## - simplevote(0,1) returns the candidate having the LEAST TOP votes,
##   i.e., the "worst" (least liked) candidate
## - simplevote(1,1) returns the candidate having the MOST BOTTOM votes
##   i.e., the "dual worst" (most disliked) candidate
sub simplevote {
    my $revorder = !!shift;  # Whether to reverse individual preferences
    my $worst = !!shift;  # Whether to find worst candidate
    my $minimize = $revorder^$worst;  # Whether to minimize votes
    my $excl = shift || {};  # Ignore these candidates when sorting
    # First, tally the number of (top or bottom) votes for each candidate:
    my @stats = ();
    for ( my $p=0 ; $p<scalar(@permtab) ; $p++ ) {
      candloop:
	for ( my $j=0 ; $j<$nbcandidates ; $j++ ) {
	    # Loop through candidates in appropriate order
	    my $i = $revorder ? $permtab[$p][$nbcandidates-1-$j] : $permtab[$p][$j];
	    # Stop at first non-excluded
	    if ( ! $excl->{$i} ) {
		$stats[$i] += $votetab[$p];
		last candloop;
	    }
	}
    }
    # Now find the candidate with the best (or worst) tally:
    my $besti = -1;
    my $also_besti = -1;
    my $bests = $minimize ? 2 : -1;
    for ( my $i=0 ; $i<$nbcandidates ; $i++ ) {
	if ( ( ! $excl->{$i} ) && ( $minimize ? $stats[$i] <= $bests : $stats[$i] >= $bests ) ) {
	    $besti = $i unless $stats[$i] == $bests;
	    $also_besti = $i;
	    $bests = $stats[$i];
	}
    }
    if ( $besti != $also_besti && ! $warned_equality ) {
	my $excllist = join(",",map {$candnames[$_]} (keys(%{$excl})));
	$excllist = "<nobody>" if $excllist eq "";
	printf STDERR "warning: exact equality between candidates %s and %s at %05.2f%% when excluding %s\n", $candnames[$besti], $candnames[$also_besti], $bests*100, $excllist;
	$warned_equality = 1;
    }
    return $worst ? $also_besti : $besti;
}

## The general recursive voting scheme: at level 0 this simply calls
## simplevote above (with the same parameters).  At higher level k,
## this excludes candidates using the same function at level k-1 but
## with the "worst" parameter flipped, eliminating them one by one
## until only one is left standing, and return that one.
sub recursive_vote {
    my $level = shift;
    my $revorder = !!shift;  # Whether to reverse individual preferences
    my $worst = !!shift;  # Whether to find worst candidate
    my $excl = shift || {};  # Ignore these candidates when sorting
    if ( $level <= 0 ) {
	return simplevote($revorder, $worst, $excl);
    }
    my $lastexcl = -1;
    my @excltab;
    while ( 1 ) {
	my $newexcl = recursive_vote($level-1, $revorder, !$worst, $excl);
	if ( $newexcl == -1 ) {
	    foreach my $i ( @excltab ) {
		$excl->{$i} = undef;
	    }
	    return $lastexcl;
	} else {
	    die "this is impossible" if $excl->{$newexcl};
	    push @excltab, $newexcl;
	    $lastexcl = $newexcl;
	    $excl->{$newexcl} = 1;
	}
    }
}

# mainloop:
# while ( 1 ) {

if ( defined($opts{"r"}) ) {
    my $fname = $opts{"r"} // "-";
    if ( $fname eq "-" ) {
	readvote \*STDIN;
    } else {
	open my $inf, "<", $fname or die "can't open $fname for reading: $!";
	readvote $inf;
	close $inf;
    }
} else {
    randomvote;
}

if ( defined($opts{"w"}) ) {
    my $fname = $opts{"w"} // "-";
    if ( $fname eq "-" ) {
	writevote \*STDOUT;
    } else {
	open my $outf, ">", $fname or die "can't open $fname for writing: $!";
	writevote $outf;
	close $outf;
    }
}

for ( my $level=0 ; $level<8 ; $level++ ) {
    printf "best level %d candidate: %s; dual: %s\n", $level, $candnames[recursive_vote($level,0,0)], $candnames[recursive_vote($level,1,0)];
}

# my %elected = ();
# my @elected = ();
# for ( my $level=0 ; $level<6 ; $level++ ) {
#     my $elected = recursive_vote($level,0,0);
#     push @elected, $elected;
#     $elected{$elected} = $level;
# }
# if ( scalar(%elected) >= 4 && $elected[5]==$elected[4] ) {
#     for ( my $level=0 ; $level<6 ; $level++ ) {
# 	printf "best level %d candidate: %d; dual: %d\n", $level, $elected[$level], recursive_vote($level,1,0);
#     }
#     last mainloop;
# }

# }

See https://mathoverflow.net/questions/420356/recursive-runoff-voting-schemes and https://twitter.com/gro_tsen/status/1514593018552143876 and https://twitter.com/gro_tsen/status/1514998645581619208 for explanations as to what this is all about.