diff options
| -rwxr-xr-x | challenge-114/e-choroba/perl/ch-1.pl | 51 | ||||
| -rwxr-xr-x | challenge-114/e-choroba/perl/ch-2.pl | 101 |
2 files changed, 152 insertions, 0 deletions
diff --git a/challenge-114/e-choroba/perl/ch-1.pl b/challenge-114/e-choroba/perl/ch-1.pl new file mode 100755 index 0000000000..194710fa97 --- /dev/null +++ b/challenge-114/e-choroba/perl/ch-1.pl @@ -0,0 +1,51 @@ +#!/usr/bin/perl +use warnings; +use strict; +use feature qw{ say }; + +sub next_palindrome_number_slow { + my ($n) = @_; + 1 until ++$n eq reverse $n; + return $n +} + +sub next_palindrome_number { + my ($n) = @_; + my $p = $n + 1; + my $l = length $p; + my $l2 = int($l / 2); + substr $p, -$_, 1, substr $p, $_ - 1, 1 for 1 .. $l2; + return $p if $p > $n; + + substr $p, $l2 + $l % 2, $l2, ""; + ++$p; + $p .= '0' x $l2; + substr $p, -$_, 1, substr $p, $_ - 1, 1 for 1 .. $l2; + return $p +} + +use Test::More; + +is next_palindrome_number(1234), 1331, 'Example 1'; +is next_palindrome_number(999), 1001, 'Example 2'; + +my @random_data = map { my $m = 10 ** $_; map int rand $m, 1 .. $_ } 1 .. 10; + +for my $r (@random_data) { + is next_palindrome_number($r), + next_palindrome_number_slow($r), + "after $r"; +} + +done_testing(); + +use Benchmark qw{ cmpthese }; +cmpthese(-3, { + slow => sub { next_palindrome_number_slow($_) for @random_data }, + fast => sub { next_palindrome_number($_) for @random_data }, +}); + +__END__ + Rate slow fast +slow 13.1/s -- -100% +fast 9768/s 74709% -- diff --git a/challenge-114/e-choroba/perl/ch-2.pl b/challenge-114/e-choroba/perl/ch-2.pl new file mode 100755 index 0000000000..1bfdcca5fa --- /dev/null +++ b/challenge-114/e-choroba/perl/ch-2.pl @@ -0,0 +1,101 @@ +#!/usr/bin/perl +use warnings; +use strict; + +# Uncomment the following line to suppress warnings on 64 bit integers. You can +# than set MAX to 2 ** 64 (at least on some platforms). +# +# no warnings 'portable'; + +use constant MAX => 2 ** 32; + +sub higher_integer_set_bits_naive { + my ($n) = @_; + my $bits = unpack '%b*', pack 'l', $n; + 1 until $bits == unpack '%b*', pack 'l', ++$n; + return $n +} + +sub higher_integer_set_bits { + my ($n) = @_; + + my $binary = sprintf '%b', $n; + if (-1 != (my $pos = rindex $binary, '01')) { + substr $binary, $pos, 2, '10'; + my $suffix = substr $binary, $pos + 2, length $binary, ""; + my $ones = $suffix =~ tr/1//d; + $suffix .= 1 x $ones; + return oct "0b$binary$suffix"; + } + + my $pos = rindex $binary, '1'; + my $zeros = substr $binary, $pos + 1, length $binary, ""; + substr $binary, 1, 0, "0$zeros"; + return oct "0b$binary" +} + +use Test::More; + +is higher_integer_set_bits(3), 5, 'Example 1'; +is higher_integer_set_bits(12), 17, 'Example 2'; + +is higher_integer_set_bits(2 ** 14 + 2 ** 15), 2 ** 16 + 1, '2^14 + 2^15'; + +my @random_data = map 1 + int rand MAX, 1 .. 1000; +for my $r (1 .. 100, @random_data) { + is higher_integer_set_bits($r), + higher_integer_set_bits_naive($r), + "over $r"; +} + +done_testing(); + +use Benchmark qw{ cmpthese }; +cmpthese(-3, { + naive => sub { higher_integer_set_bits_naive($_) for @random_data }, + clever => sub { higher_integer_set_bits($_) for @random_data }, +}); + +=head1 Higher Integer Set Bits + +The naive variant uses the trick mentioned in L<perlfunc/unpack>: + + unpack '%b*', pack 'l', $n + +It's a fast way to count number of 1's in the binary representation of $n. + +"clever" is usually faster than "naive", but the results are widely +inconsistent. With 64 bit numbers, naive becomes faster. + +Nevertheless, how does the "clever" algorithm work? + +=over + +=item 1. + +If the binary number contains 01 anywhere, let's split the binary number into +four parts: + + | chaos | last 01 | maybe ones | maybe zeros | + | 10011011001...| 01 | 111 | 000 | + +(Note that both ones and zeros might be empty.) + +The next number is C<< chaos . 10 . zeros . ones >>. + +=item 2. + +The number has the form 11110000 (it doesn't contain 01 anywhere). We cut the +final zeros (might be none) and insert one more zeros after the first one. + + 11110000 240 + 1111 cut the zeros + 1 0000 111 insert them after the first 1 + 1 0 0000 111 insert one more + 100000111 263 + +=back + +A proof of correctness left as an exercise for the reader. + +=cut |