diff options
| author | Dave Jacoby <jacoby.david@gmail.com> | 2020-09-23 15:59:25 -0400 |
|---|---|---|
| committer | Dave Jacoby <jacoby.david@gmail.com> | 2020-09-23 15:59:25 -0400 |
| commit | 112c3a994af94170d039b9b265bc48389244ec54 (patch) | |
| tree | acdc888f9633333a4ebe6227adcbe5f155edac20 | |
| parent | 4003228d0dad17e305cf0f40f3e8449d02c3f61f (diff) | |
| download | perlweeklychallenge-club-112c3a994af94170d039b9b265bc48389244ec54.tar.gz perlweeklychallenge-club-112c3a994af94170d039b9b265bc48389244ec54.tar.bz2 perlweeklychallenge-club-112c3a994af94170d039b9b265bc48389244ec54.zip | |
Challenge 79
| -rw-r--r-- | challenge-079/dave-jacoby/perl/= | 0 | ||||
| -rwxr-xr-x | challenge-079/dave-jacoby/perl/ch-1.pl | 30 | ||||
| -rwxr-xr-x | challenge-079/dave-jacoby/perl/ch-2.pl | 70 |
3 files changed, 100 insertions, 0 deletions
diff --git a/challenge-079/dave-jacoby/perl/= b/challenge-079/dave-jacoby/perl/= new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/challenge-079/dave-jacoby/perl/= diff --git a/challenge-079/dave-jacoby/perl/ch-1.pl b/challenge-079/dave-jacoby/perl/ch-1.pl new file mode 100755 index 0000000000..b1e4bff87e --- /dev/null +++ b/challenge-079/dave-jacoby/perl/ch-1.pl @@ -0,0 +1,30 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ say signatures state }; +no warnings qw{ experimental }; + +use Carp; +use List::Util qw{ sum }; +use Getopt::Long; + +my $n = 4; +GetOptions( 'n=i' => \$n, ); +croak 'Non-positive number' if $n < 0; + +my $total = count_set_bits($n); +say $total; + +sub count_set_bits( $n ) { + my $total = 0; + my $t = 0; + for my $i ( 0 .. $n ) { + my $b = sprintf '%b', $i; + my $c = sum split m{|}, $b; + $total += $c; + $t = $total % 1000000007; + } + + return $t; +} diff --git a/challenge-079/dave-jacoby/perl/ch-2.pl b/challenge-079/dave-jacoby/perl/ch-2.pl new file mode 100755 index 0000000000..b2b8265e48 --- /dev/null +++ b/challenge-079/dave-jacoby/perl/ch-2.pl @@ -0,0 +1,70 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ say signatures state }; +no warnings qw{ experimental }; + +use Getopt::Long; +use List::Util qw{ max sum0 }; + +my @n = grep { $_ >= 1 } @ARGV; +@n = ( 2, 1, 4, 1, 2, 5 ) unless scalar @n; + +# make_histogram(@n); +my $trapped = trap_rain_water(@n); + +my $units = $trapped == 1 ? 'unit' : 'units'; +say qq{$trapped $units trapped}; + +sub make_histogram ( @n ) { + my $max = max @n; + say ''; + for my $i ( reverse 1 .. $max ) { + my @h = map { $i <= $_ ? '#' : ' ' } @n; + say join ' ', $i, @h; + } + say join '-', ' ', map { '-' } @n; + say join ' ', ' ', @n; + say ''; +} + +sub trap_rain_water ( @n ) { + my $max = max @n; + my $s = scalar @n; + my $c = 0; + + my @hist; + + for my $i ( reverse 1 .. $max ) { + my $z = sum0 map { $i <= $_ ? 1 : 0 } @n; + my @h; + my $hh = []; + push $hh->@*, $i, ''; + + for my $j ( 0 .. $s - 1 ) { + my $e = $n[$j]; # equals + my $p = $e >= $i ? 1 : 0; # is peak + + my @lt = @n[ 0 .. $j - 1 ]; + my @gt = @n[ $j + 1 .. $s - 1 ]; + my $lt = scalar grep { $_ >= $i } @lt; # is peak to left + my $gt = scalar grep { $_ >= $i } @gt; # is peak to right + my $t = $p != 1 && $lt > 0 && $gt > 0 ? 1 : 0; # has trapped + $c += $t; + + push @h, $e >= $i ? '#' : $t; + my $v = ' '; + $v = '#' if $p; + $v = '.' if $t; + push $hh->@*, $v; + } + + push @hist, $hh; + } + + say join "\n", map { join ' ', $_->@* } @hist, [], [ ' ', '', @n ]; + say ''; + + return $c; +} |
