Perl Weekly Challenge #016
Task #1: Pythagoras Pie Puzzle
This puzzle’s connection with Pythagoras is tenuous indeed: it originally appeared in the Dutch magazine Pythagoras (see here and here)! But the puzzle is interesting. Of course, the real challenge is to work out the answer mathematically, but for those of us who are mathematically declined a Perl script is the way to go.
The first draft of my solution was tied to the 100 guests specified in the puzzle statement, but it’s easy to extend the puzzle to allow any (positive integer) number of guests. So I include the number of guests as a constant $GUESTS and the central calculation becomes:
$piece = ($guest / $GUESTS) * $pie;
where $guest is any number in the series 1 .. $GUESTS and $pie is the fraction of original pie remaining at this point in the distribution.
Perl 5 solution
For my own interest I added code to display the size of each guest’s piece of pie. This code can be omitted from compilation by setting DEBUG to a false value.
File ch-1.pl
use strict;
use warnings;
use Const::Fast;
use constant DEBUG => 0;
const my $GUESTS => 100;
MAIN:
{
my $pie = 1;
my $max_guest = 1;
my $max_piece = 1 / $GUESTS;
my $sum = $max_piece if DEBUG;
$pie -= $max_piece;
printf("\nGuest %*d gets %43.40f%% of the original pie\n",
length $GUESTS, $max_guest, $max_piece * 100) if DEBUG;
for my $guest (2 .. $GUESTS)
{
my $piece = ($guest / $GUESTS) * $pie;
$pie -= $piece;
if (DEBUG)
{
printf "Guest %*d gets %43.40f%% of the original pie\n",
length $GUESTS, $guest, $piece * 100;
$sum += $piece;
}
if ($piece > $max_piece)
{
$max_piece = $piece;
$max_guest = $guest;
}
}
printf "\nGuest %d of %d gets the largest piece, which is " .
"%.2f%% of the original pie\n", $max_guest, $GUESTS,
$max_piece * 100;
printf("\nCheck: sum of pieces = %.13f%%\n", $sum * 100)
if DEBUG;
}
Perl 6 solution
Same logic here as in the Perl 5 solution, but minus the DEBUG functionality. Perl 6 supplies a round method for Real values, which makes a nice alternative to the use of printf.
File ch-1.p6
use v6;
my UInt constant $GUESTS = 100;
sub MAIN()
{
my Real $pie = 1;
my UInt $max-guest = 1;
my Real $max-piece = 1 / $GUESTS;
$pie -= $max-piece;
for 2 .. $GUESTS -> UInt $guest
{
my Real $piece = ($guest / $GUESTS) * $pie;
$pie -= $piece;
if ($piece > $max-piece)
{
$max-piece = $piece;
$max-guest = $guest;
}
}
my Real $max-piece-pc = $max-piece * 100;
say "\nGuest $max-guest of $GUESTS gets the largest piece, ",
"which is $max-piece-pc.round(0.01)% of the original pie";
}
Results
The answer to the puzzle is that the 10th guest gets 6.28% of the pie, which is the largest share.
I was also interested to know who gets the smallest share. That turns out to be the last (i.e., 100th) guest, whose share is about 9.33×10-41% of the original pie. I’m still trying to get my head around that figure.
Suppose the last guest’s share is a single atom of carbon-12 (I don’t see how a “piece of the pie” can be smaller than that). Now, 1 Dalton, or atomic mass unit, has a mass of 1.66×10-27 kg, and 1 carbon-12 atom has an atomic weight of 12; so the smallest “piece” of pie has a mass of 12 × 1.66×10-27 = 1.992×10-26 kg.
Which means the original pie must weight at least 1.992×10-26 ÷ 9.33×10-41 = 2.14×1013 kg or 21.4 billion metric tonnes. That must’ve been some party!
Task #2: Bitcoin address validation
Prior to this task I knew nothing about Bitcoin; now, I still don’t know much! But I found a useful introduction, Learn Me a Bitcoin, which explains the technology basics quite well. (But not the rationale behind the technology. I now understand what Bitcoin mining is, but not why it’s needed; and I know how the difficulty is adjusted to keep the average mining time around 10 minutes, but not why that target is important in the first place.)
From this site it appears that valid Bitcoin addresses can take 3 forms:
- Pubkey hash (P2PKH address) with prefix 1
- Script hash (P2SH address) with prefix 3
- SegWit mainnet (P2WPKH address) with prefix bc1
However, for this exercise I’ve assumed that only P2PKH and P2SH addresses are included. For the record, details of P2WPKH (or Bech32) validation can be found here.
Perl 5 solution
CPAN’s Digest::SHA module has a nice OO interface and supports many SHA variants including SHA-256. For decoding Base58 using the Bitcoin alphabet, module Crypt::Misc has the function decode_b58b. After that, it’s just a question of applied logic.
The trickiest part for me was the code to verify the checksum, which required disentangling all the different encodings. The details are given in the comments to function validate_checksum, below.
File ch-2.pl
use strict;
use warnings;
use Const::Fast;
use Crypt::Misc qw( decode_b58b );
use Digest::SHA;
const my $DEFAULT_ADDR => '1BvBMSEYstWetqTFn5Au4m4GFg7xJaNVN2';
const my %ADDR_FORMATS => (1 => 'P2PKH', 3 => 'P2SH',
bc1 => 'Bech32');
const my $INVALID_CHARS => qr{([^1-9A-HJ-NP-Za-km-z])};
const my $MAX_CHARS => 35;
const my $MIN_CHARS => 26;
const my $SHA_ALGORITHM => 256;
const my $TAB => ' ';
MAIN:
{
my $address = $ARGV[0] // $DEFAULT_ADDR;
print "\nBitcoin address: \"$address\"\n";
if (my $error = validate_format($address, \my $format))
{
print "${TAB}Format validation FAILED: $error\n";
}
elsif ($format eq 'Bech32')
{
print "${TAB}Bech32 format not currently supported\n";
}
else
{
print "${TAB}Format is \"$format\"\n";
if ($error = validate_chars($address))
{
print "${TAB}Character validation FAILED: $error\n";
}
elsif (validate_checksum($address))
{
print "${TAB}Checksum validation PASSED\n";
}
else
{
print "${TAB}Checksum validation FAILED\n";
}
}
}
sub validate_format
{
my ($address, $format) = @_;
my $error;
for my $prefix (keys %ADDR_FORMATS)
{
if ($address =~ qr/^$prefix/)
{
$$format = $ADDR_FORMATS{$prefix};
last;
}
}
unless (defined $$format)
{
my $len = substr($address, 0, 1) eq 'b' ?
substr($address, 1, 1) eq 'c' ? 3 : 2 : 1;
$error = 'invalid prefix "' . substr($address, 0, $len) .
'", unknown format';
}
return $error;
}
sub validate_chars
{
my ($address) = @_;
my $chars = length $address;
my $error;
if ($chars < $MIN_CHARS)
{
$error = "invalid length $chars (minimum is $MIN_CHARS)";
}
elsif ($chars > $MAX_CHARS)
{
$error = "invalid length $chars (maximum is $MAX_CHARS)";
}
elsif ($address =~ $INVALID_CHARS)
{
$error = "invalid character \"$1\"";
}
return $error;
}
sub validate_checksum
{
my ($address) = @_;
my $rawdata = decode_b58b($address); # Base58 to bytes
my $hexdata = unpack 'H*', $rawdata; # Bytes to hex
my $checksum1 = substr $hexdata, -8; # Checksum 1 in hex
my $payload = substr $hexdata, 0, -8; # Payload in hex
my $sha_obj = Digest::SHA->new($SHA_ALGORITHM);
$sha_obj->add(pack 'H*', $payload); # Hex to bytes
my $digest1 = $sha_obj->hexdigest; # 1st digest in hex
$sha_obj->add(pack 'H*', $digest1); # hex to bytes
my $digest2 = $sha_obj->hexdigest; # 2nd digest in hex
my $checksum2 = substr $digest2, 0, 8; # Checksum 2 in hex
return $checksum1 eq $checksum2; # Compare checksums
}
Perl 6 solution
I was surprised to find that pack and unpack are still considered experimental in Perl 6. Fortunately, the functionality I needed was available. I found Digest::SHA256::Native as a replacement for Perl 5’s Digest::SHA, but had to re-use the Perl 5 module Crypt::Misc here.
Note: I created $decode_b58b as an alias for Crypt::Misc::decode_b58b only to keep Comma happy! This worked (it removed the error message), but I couldn’t find any way to make Comma happy with the call to pack, which is a function only and so can’t be called as a method.
As usual, my approach to Perl 6 coding is to use functional-style method calls and explicity-declared variable types wherever possible. This is overkill for a script like this, but it helps me to learn. Blob[uint8] was a type I hadn’t come across before. Note also the regex
rx{ ( <-[1..9A..HJ..NP..Za..km..z]> ) }
which uses a negated character class (<-[...]>) to match any character outside the allowed Bitcoin address alphabet.
File ch-2.p6
use v6;
use experimental :pack;
use Crypt::Misc:from<Perl5> <decode_b58b>;
use Digest::SHA256::Native;
my Sub $decode_b58b := &Crypt::Misc::decode_b58b;
my constant %ADDR-FORMATS =
(1 => 'P2PKH', 3 => 'P2SH', bc1 => 'Bech32');
my Str constant $DEFAULT-ADDR =
'1BvBMSEYstWetqTFn5Au4m4GFg7xJaNVN2';
my Regex constant $INVALID-CHARS =
rx{ ( <-[1..9A..HJ..NP..Za..km..z]> ) };
my UInt constant $MAX-CHARS = 35;
my UInt constant $MIN-CHARS = 26;
my Str constant $TAB = ' ';
sub MAIN(Str:D $address = $DEFAULT-ADDR)
{
print "\nBitcoin address: \"$address\"\n";
my Str:D $format = '';
if my $error = validate-format($address, $format)
{
print "{$TAB}Format validation FAILED: $error\n";
}
elsif $format eq 'Bech32'
{
print "{$TAB}Bech32 format not currently supported\n";
}
else
{
print "{$TAB}Format is \"$format\"\n";
if $error = validate-chars($address)
{
print "{$TAB}Character validation FAILED: $error\n";
}
elsif validate-checksum($address)
{
print "{$TAB}Checksum validation PASSED\n";
}
else
{
print "{$TAB}Checksum validation FAILED\n";
}
}
}
sub validate-format(Str:D $address, Str:D $format is rw)
{
my Str $error;
for keys %ADDR-FORMATS -> Str $prefix
{
if $address ~~ /^$prefix/
{
$format = %ADDR-FORMATS{$prefix};
last;
}
}
unless $format
{
my UInt $len = $address.substr(0, 1) eq 'b' ??
$address.substr(1, 1) eq 'c' ?? 3 !! 2 !! 1;
$error = 'invalid prefix "' ~ $address.substr(0, $len) ~
'", unknown format';
}
return $error;
}
sub validate-chars(Str:D $address)
{
my $chars = $address.chars;
my Str $error;
if $chars < $MIN-CHARS
{
$error = "invalid length $chars (minimum is $MIN-CHARS)";
}
elsif $chars > $MAX-CHARS
{
$error = "invalid length $chars (maximum is $MAX-CHARS)";
}
elsif $address ~~ $INVALID-CHARS
{
$error = "invalid character \"$0\"";
}
return $error;
}
sub validate-checksum(Str:D $address)
{
my Blob[uint8] $raw-data = $decode_b58b($address);
my Str $hex-data = $raw-data.unpack('H*');
my Str $hex-checksum1 = $hex-data.substr(*-8);
my Str $hex-payload = $hex-data.substr(0, *-8);
my Blob[uint8] $raw-payload = pack('H*', $hex-payload);
my Str $hex-digest1 = sha256-hex($raw-payload);
my Blob[uint8] $raw_digest1 = pack('H*', $hex-digest1);
my Str $hex-digest2 = sha256-hex($raw_digest1);
my Str $hex-checksum2 = $hex-digest2.substr(0, 8);
return $hex-checksum1 eq $hex-checksum2;
}
Task #3: Winning Email API
I signed up for a Winning Email account and received the requisite email in reply. However, when I try to confirm my email address I get this message:
Username and password combination not found or your account is inactive.
:-(
PerlMonk; experienced Perl5 hacker; learning Perl6.
Leave a comment