Perl Weekly Challenge 016: Pythagoras Pie Puzzle and Bitcoin Address Validation

Pythagoras Pie Puzzle

At a party a pie is to be shared by 100 guest. The first guest gets 1% of the pie, the second guest gets 2% of the remaining pie, the third gets 3% of the remaining pie, the fourth gets 4% and so on. Write a script that figures out which guest gets the largest piece of pie.

I started with a straightforward implementation of the specification. Start with the pie of size 1; in each step, find out the size of the corresponding guest’s part, remember it if it’s largest one so far, and decrease the size of the pie.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my $pie = 1;
my @max = (0, -1);

for (1 .. 100) {
    my $part = $pie / 100 * $_;
    $pie -= $part;
    @max = ($_, $part) if $part > $max[1];
}

say "@max";

Dealing with floats is usually tricky, so I verified the result stays the same under bignum. Both solutions claim the luckiest guest will be the number 10, getting 0.0628156509555295 of the pie (or 0.062815650955529472 under bignum).

The graph of how much each guest gets is below. I included a logarithmic scale, too, because otherwise it seems the later guests get nothing.

Bitcoin Address Validation

I don’t know much about Bitcoin. But I know that programming anything related to security and cryptography is extremely demanding, as the slightest error in a rare edge case can cause a large damage. Therefore, I don’t recommend to use my below presented code for any real interaction with Bitcoin.

After reading the linked wiki I tried to implement the validator. I wasn’t able to get it work and I felt like a substantial piece of information was still missing.

In the end, I found a Bitcoin address validator at Rosetta Code. I rewrote it following my preferred style, but I still felt like cheating.

I pondered rewriting it without the help of Digest::SHA, implementing the SHA-256 myself, but in the end, I found another way how to improve my solution. I decided to follow another link from the wiki page, which described the new Bech32 addresses. In the end, I used the PHP code from PHP Bitcoin Address Validator and translated it to Perl. It seems Bitcoin::Crypto still lists Bech32 in its TODO section, but as I said, I’m not sure my solution could be reused in any way.

So, here's my solution validating both address formats:

#!/usr/bin/perl
use warnings;
use strict;

use Digest::SHA qw(sha256);

my @B58 = grep /[^0IOl]/, 0 .. 9, 'A' .. 'Z', 'a' .. 'z';
my %B58 = map { $B58[$_] => $_ } 0 .. $#B58;
my @GENERATOR = (0x3b6a57b2, 0x26508e6d, 0x1ea119fa, 0x3d4233dd, 0x2a1462b3);

my %BECH32 = qw(0 15  2 10  3 17  4 21  5 20  6 26  7 30  8  7
                9  5  a 29  c 24  d 13  e 25  f  9  g  8  h 23
                j 18  k 22  l 31  m 27  n 19  p  1  q  0  r  3
                s 16  t 11  u 28  v 12  w 14  x  6  y  4  z  2);

sub unbase58 {
    my ($in) = @_;
    my @out;
    for my $d (@B58{ split //, $_[0] }) {
        my $c = $d;
        my $j = 25;
        while ($j--) {
            $c += 58 * ($out[$j] // 0);
            $out[$j] = $c % 256;
            $c /= 256;
        }
    }
    return @out
}

sub check_bitcoin_address {
    my ($address) = @_;
    if ($address =~ /^[13]/) {
        return check_bitcoin_address_b58($address)
    } elsif ($address =~ /^(?:bc|tb)1/i) {
        return check_bitcoin_address_bech32(lc $address)
    }
    return
}

sub check_bitcoin_address_bech32 {
    my ($address) = @_;
    my ($human_readable, $data) = $address
        =~ /^(bc|tb)1([023456789acdefghjklmnpqrstuvwxyz]{7,})$/
    or return;

    return 1 == poly_mod(hrp_expand($human_readable),
                         map $BECH32{ +chr } // -1, unpack 'C*', $data);
}

sub poly_mod {
    my @values = @_;
    my $chk = 1;
    for my $i (0 .. $#values) {
        my $top = $chk >> 25;
        $chk = ($chk & 0x1ffffff) << 5 ^ $values[$i];
        for (my $j = 0; $j < 5; $j++) {
            $chk ^= (($top >> $j) & 1) ? $GENERATOR[$j] : 0;
        }
    }
    return $chk
}

sub hrp_expand {
    my ($hrp) = @_;
    my (@expand1, @expand2);
    for my $i (1 .. length $hrp) {
        my $o = ord substr $hrp, $i - 1, 1;
        push @expand1, $o >> 5;
        push @expand2, $o & 31;
    }
    return @expand1, 0, @expand2
}

sub check_bitcoin_address_b58 {
    my ($address) = @_;
    my @byte = unbase58 $address;
    return pack('C*', @byte[ 21 .. 24 ])
        eq substr sha256(sha256(pack 'C*', @byte[0..20])), 0, 4;
}

my @valid = qw( 1BvBMSEYstWetqTFn5Au4m4GFg7xJaNVN2
                3J98t1WpEZ73CNmQviecrnyiWrnqRhWNLy
                bc1qar0srrr7xfkvy5l643lydnw9re59gtzzwf5mdq
                bc1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3qccfmv3
                tb1qw508d6qejxtdg4y5r3zarvary0c5xw7kxpjzsx
                tb1qrp33g0q5c5txsp9ARYSRX4K6ZDKFS4NCE4XJ0GDCCCEFVPYSXF3Q0SL5K7
);

my @invalid = qw( 1BvBMSEYstWetqTFn5Au4m4GFg7xJaNVN3
                  bc1qar0srrs7xfkvy5l643lydnw9re59gtzzwf5mdq
                  bc1qrp33f0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3qccfmv3
                  tb1qw508d6qejytdg4y5r3zarvary0c5xw7kxpjzsx
                  tb1qrp33g0q5c5twsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7
);

use Test::More;
plan tests => @valid + @invalid;

for (@valid) {
    ok check_bitcoin_address($_), "valid $_";
}
for (@invalid) {
    ok ! check_bitcoin_address($_), "invalid $_";
}
      

The invalid addresses were obtained from the valid ones by randomly altering some of their characters.

Leave a comment

About E. Choroba

user-pic I blog about Perl.