aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-075/bob-lied/README55
-rw-r--r--challenge-075/bob-lied/perl/ch-1.pl51
-rw-r--r--challenge-075/bob-lied/perl/ch-2.pl30
-rw-r--r--challenge-075/bob-lied/perl/lib/CoinSum.pm79
-rw-r--r--challenge-075/bob-lied/perl/lib/LargestRectangleHistogram.pm166
-rw-r--r--challenge-075/bob-lied/perl/t/CoinSum.t24
6 files changed, 352 insertions, 53 deletions
diff --git a/challenge-075/bob-lied/README b/challenge-075/bob-lied/README
index e3712fbb10..e0e8e4f76c 100644
--- a/challenge-075/bob-lied/README
+++ b/challenge-075/bob-lied/README
@@ -1,53 +1,2 @@
-Solutions to weekly challenge 74 by Bob Lied.
-
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-074/
-
-* TASK #1 > Majority Element
-
-** Initial thoughts
-
-This is going to be an exercise in hashes and grep.
-
-** Post Solution Thoughts
-
-Use a hash to count to count elements, then use grep with a code block to select the match.
-
-** Problem Statement
-
-You are given an array of integers of size $N.
-Write a script to find the majority element. If none found then print -1.
-Majority element in the list is the one that appears more than floor(size_of_list/2).
-
-
-
-* TASK #2 > FNR Character
-
-** Initial Thoughts
-
-The specification is a little odd and doesn't match the example. But, OK, whatever.
-Similar to the first task, another hash to count occurrences and grep to find the answers.
-
-** Post Solution Thoughts
-
-Going through the string could be either done with substr one character at a time,
-or splitting the string into an array of characters. Finding the first char could be
-a search through the character positions, or a sort and picking off the first element.
-Sort is the easy answer, but I'm always wary of scaling. Like in many of these
-problems, it's not an issue for "reasonable" strings, but could become a performance
-question if the strings were a thousand or a million times bigger.
-
-
-** Problem Statement
-
-You are given a string $S.
-
-Write a script to print the series of first non-repeating character
-(left -> right) for the given string. Print # if none found.
-Example 1
-Input: $S = ‘ababc’
-Output: ‘abb#c’
-Pass 1: “a”, the FNR character is ‘a’
-Pass 2: “ab”, the FNR character is ‘b’
-Pass 3: “aba”, the FNR character is ‘b’
-Pass 4: “abab”, no FNR found, hence ‘#’
-Pass 5: “ababc” the FNR character is ‘c’
+Solutions to Perl Weekly Challenge 075 by Bob Lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-075/
diff --git a/challenge-075/bob-lied/perl/ch-1.pl b/challenge-075/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..c0e4a6bc8d
--- /dev/null
+++ b/challenge-075/bob-lied/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu syntax=perl:
+#
+# Copyright (c) 2020 Bob Lied
+# The copyright notice above does not evidence any actual
+# or intended publication of such source code.
+
+#===============================================================================
+# ch-1.pl
+#
+# Description:
+# Perl Weekly Challenge 075 Task #1 > Coins Sum
+#===============================================================================
+# You are given a set of coins @C, assuming you have infinite amount of each coin in the set.
+# Write a script to find how many ways you make sum $S using the coins from the set @C.
+#
+# Example:
+# Input:
+# @C = (1, 2, 4)
+# $S = 6
+#
+# Output: 6
+# There are 6 possible ways to make sum 6.
+# a) (1, 1, 1, 1, 1, 1)
+# b) (1, 1, 1, 1, 2)
+# c) (1, 1, 2, 2)
+# d) (1, 1, 4)
+# e) (2, 2, 2)
+# f) (2, 4)
+
+use strict;
+use warnings;
+use feature qw(say);
+
+use Data::Dumper;
+
+use lib "lib";
+use CoinSum qw(coinSum);
+
+sub Usage { "Usage: $0 SUM coin1 [coin2..coinN]" };
+
+my $S = shift;
+my @C = @ARGV;
+
+die Usage() unless $S;
+die Usage() unless @C;
+
+
+my $result = coinSum($S, @C);
+
+say "[ @$_ ]" foreach @$result;
diff --git a/challenge-075/bob-lied/perl/ch-2.pl b/challenge-075/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..387d76ffe5
--- /dev/null
+++ b/challenge-075/bob-lied/perl/ch-2.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge 075 TASK #2> Largest Rectangle Histogram
+#=============================================================================
+# You are given an array of positive numbers @A.
+# Write a script to find the largest rectangle histogram created by the given array.
+# BONUS: Try to print the histogram as shown in the example, if possible.
+
+use strict;
+use warnings;
+use feature q(say);
+
+use lib "lib";
+use LargestRectangleHistogram;
+
+my @A = @ARGV;
+die "Usage: list of positive integers" unless @A;
+
+my $lrh = LargestRectangleHistogram->new(@A);
+
+# $lrh->_show();
+say "Max area: ", $lrh->findLRH();
+
+$lrh->display();
+
diff --git a/challenge-075/bob-lied/perl/lib/CoinSum.pm b/challenge-075/bob-lied/perl/lib/CoinSum.pm
new file mode 100644
index 0000000000..e95500aa60
--- /dev/null
+++ b/challenge-075/bob-lied/perl/lib/CoinSum.pm
@@ -0,0 +1,79 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu syntax=perl:
+#
+# Copyright (c) 2020 Bob Lied
+# The copyright notice above does not evidence any actual
+# or intended publication of such source code.
+
+#===============================================================================
+# CoinSum.pm
+#
+# Description:
+#
+#===============================================================================
+
+package CoinSum;
+
+use strict;
+use warnings;
+use 5.010;
+use Carp;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(coinSum);
+our @EXPORT_OK = qw();
+
+
+my @ComboList;
+
+sub _coinSum
+{
+ my ($depth, $target, $coinList, $coin, $combo) = @_;
+
+ my $diff = $target - $coin;
+ # say " depth=$depth, target = $target, coin = $coin, diff = $diff, list = [ @$coinList ], combo = [ @$combo ]";
+
+
+ if ( $diff == 0 )
+ {
+ push @ComboList, [ @$combo ];
+ # say "FOUND [ @$combo ]";
+ return 0;
+ }
+
+ if ( $diff < 0 )
+ {
+ pop @$combo;
+ # say "TOO FAR";
+ return $diff;
+ }
+
+ my @remainingCoin = sort { $a < $b } grep { $_ <= $diff } @$coinList;
+ for my $denom ( @remainingCoin )
+ {
+ push @$combo, $denom;
+ _coinSum( $depth+1, $diff, \@remainingCoin, $denom, $combo );
+ pop @$combo;
+ }
+
+}
+
+sub coinSum
+{
+ my ($sum, @coins) = @_;
+
+ # Sort denominations so largest is first.
+ @coins = sort { $a < $b } @coins;
+
+ while ( @coins )
+ {
+ # say "TOP: coin = $coins[0]";
+ _coinSum(1, $sum, \@coins, $coins[0], [ $coins[0] ] );
+ shift @coins;
+ }
+
+ return \@ComboList;
+}
+
+1;
+
diff --git a/challenge-075/bob-lied/perl/lib/LargestRectangleHistogram.pm b/challenge-075/bob-lied/perl/lib/LargestRectangleHistogram.pm
new file mode 100644
index 0000000000..f136a5efa1
--- /dev/null
+++ b/challenge-075/bob-lied/perl/lib/LargestRectangleHistogram.pm
@@ -0,0 +1,166 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# LargestRectangleHistogram.pm
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Description:
+#=============================================================================
+
+package LargestRectangleHistogram;
+
+use strict;
+use warnings;
+use feature qw(say);
+
+use List::Util qw(max min);
+use List::MoreUtils qw(arrayify); # Flattens 2D array into a list
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw();
+our @EXPORT_OK = qw();
+
+sub _setup
+{
+ my $self = shift;
+
+ for my $row ( 0 .. $self->{_numRow} -1 )
+ {
+ for my $col ( 0 .. $self->{_numCol}-1 )
+ {
+ $self->{_grid}->[$row][$col] = ( $self->{_list}->[$col] > $row ? '*' : ' ' );
+ $self->{_area}->[$row][$col] = 0;
+ }
+ }
+}
+
+sub new
+{
+ my $class = shift;
+ $class = ref($class) || $class;
+ my $self = {
+ _list => [ @_ ],
+ _numCol => scalar(@_),
+ _numRow => List::Util::max( @_ ),
+
+ _grid => undef,
+ _area => undef,
+ _extent => undef,
+
+ };
+ bless $self, $class;
+
+ $self->_setup();
+ return $self;
+}
+
+sub _extendLeft
+{
+ my $self = shift;
+ my ($r, $col) = @_;
+ my $row = $self->{_grid}->[$r];
+
+ $col-- while ( $col >= 0 && $row->[$col] eq '*' );
+ return $col+1;
+}
+
+sub _extendRight
+{
+ my $self = shift;
+ my ($r, $col) = @_;
+ my $row = $self->{_grid}->[$r];
+
+ $col++ while ( $col < $self->{_numCol} && $row->[$col] eq '*' );
+ return $col -1;
+}
+
+sub _extend
+{
+ my $self = shift;
+ my ($row, $col) = @_;
+ my $ext = $self->{_extent};
+
+ # Memoize the range if already calculated
+ return @{$ext->[$row][$col]} if exists $ext->[$row][$col];
+
+ my $maxCol = $self->_extendRight($row, $col);
+ my $minCol = $self->_extendLeft($row, $col);
+
+ $ext->[$row][$col] = [ $minCol, $maxCol ] for $minCol .. $maxCol;
+ return ($minCol, $maxCol);
+}
+
+sub _findArea
+{
+ my $self = shift;
+ my ($row, $col) = @_;
+ my $grid = $self->{_grid};
+
+ my ($minCol, $maxCol) = $self->_extend($row, $col);
+
+ my $height = List::Util::min( @{$self->{_list}}[$minCol..$maxCol] );
+
+ my $a = $self->{_area}->[$row][$col] = ( ( $maxCol - $minCol + 1) * $height );
+
+ # say "[$row][$col] : maxL=$minCol maxR=$maxCol height=$height area=$a";
+ return $a;
+
+}
+sub findLRH
+{
+ my $self = shift;
+
+ my $grid = $self->{_grid};
+
+ for my $row ( 0 .. $self->{_numRow}-1 )
+ {
+ for my $col ( 0 .. $self->{_numCol}-1 )
+ {
+ next unless $grid->[$row][$col] eq '*';
+ my $area = $self->_findArea($row, $col);
+ }
+ }
+
+ return max(arrayify( @{$self->{_area}} ) );
+}
+
+sub _show
+{
+ my $self = shift;
+ my $g = $self->{_grid};
+ my $numRow = $self->{_numRow}-1;
+ my $numCol = $self->{_numCol}-1;
+
+ print " ";
+ for my $c ( 0 .. $numCol )
+ {
+ print "[$c]";
+ }
+ print "\n";
+ for my $r ( 0 .. $numRow )
+ {
+ print "[$r] ";
+ say " ", join(' ', @{$g->[$r]}), " ";
+ }
+
+
+}
+
+sub display
+{
+ my $self = shift;
+ my @chart;
+
+ for ( my $row = $self->{_numRow}-1 ; $row >= 0 ; $row-- )
+ {
+ printf("%2d| ", $row+1);
+ my $line = join(' ', @{$self->{_grid}->[$row]});
+ say $line;
+ }
+ say ' +', ('-' x ($self->{_numCol}*2));
+ say ' ', join(' ', @{$self->{_list}});
+}
+
+1;
+
diff --git a/challenge-075/bob-lied/perl/t/CoinSum.t b/challenge-075/bob-lied/perl/t/CoinSum.t
new file mode 100644
index 0000000000..2157772195
--- /dev/null
+++ b/challenge-075/bob-lied/perl/t/CoinSum.t
@@ -0,0 +1,24 @@
+#===============================================================================
+#
+# FILE: CoinSum.t
+#
+# DESCRIPTION:
+#
+# FILES: ---
+# BUGS: ---
+# NOTES: ---
+# AUTHOR: Bob Lied (RL), bob.lied@nokia.com
+# ORGANIZATION: PNM
+# VERSION: 1.0
+# CREATED: 2020-08-24 10:10:03 AM
+# REVISION: ---
+#===============================================================================
+
+use strict;
+use warnings;
+use 5.010;
+
+use Test2::V0;
+
+done_testing();
+
generated by cgit (git 2.34.1) at 2026-07-02 17:56:32 +0000