From 3e8f3db647754ea702c9efe149026c4a8d88b460 Mon Sep 17 00:00:00 2001 From: boblied Date: Wed, 26 Aug 2020 17:21:43 -0500 Subject: Update README --- challenge-075/bob-lied/README | 54 ++----------------------------------------- 1 file changed, 2 insertions(+), 52 deletions(-) diff --git a/challenge-075/bob-lied/README b/challenge-075/bob-lied/README index e3712fbb10..b4b27d55df 100644 --- a/challenge-075/bob-lied/README +++ b/challenge-075/bob-lied/README @@ -1,53 +1,3 @@ -Solutions to weekly challenge 74 by Bob Lied. +Solutions to weekly challenge 75 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’ +https://perlweeklychallenge.org/blog/perl-weekly-challenge-075/ -- cgit From 8e13e536204d931c47a27749f3347857c95d6cfc Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Sat, 29 Aug 2020 17:56:18 -0500 Subject: CoinSum first pass --- challenge-075/bob-lied/perl/ch-1.pl | 49 +++++++++++++++++++++++++ challenge-075/bob-lied/perl/lib/CoinSum.pm | 59 ++++++++++++++++++++++++++++++ challenge-075/bob-lied/perl/t/CoinSum.t | 24 ++++++++++++ 3 files changed, 132 insertions(+) create mode 100644 challenge-075/bob-lied/perl/ch-1.pl create mode 100644 challenge-075/bob-lied/perl/lib/CoinSum.pm create mode 100644 challenge-075/bob-lied/perl/t/CoinSum.t 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..42b51a19f3 --- /dev/null +++ b/challenge-075/bob-lied/perl/ch-1.pl @@ -0,0 +1,49 @@ +#!/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 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; + +# Sort denominations so largest is first. +@C = sort { $a < $b } @C; + +coinSum($S, @C); 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..a5a7f818a5 --- /dev/null +++ b/challenge-075/bob-lied/perl/lib/CoinSum.pm @@ -0,0 +1,59 @@ +# 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 @Combo; + +sub _coinSum +{ + my ($target, $denomList, $currentSum, $currentDenom, $comboNum = @_; + + return 0 if ( $currentSum > $target ); + + return 1 if ( $currentSum == $target ); + + my $count = 0; + for my $denom ( @$denomList ) + { + push @{$Combo[$comboNum]] $denom; + if ( $denom >= $currentDenom ) + { + $comboNum += _coinSum($target, $denomList, $currentSum + $currentDenom, $denom, $comboNum); + } + } + return $0; +} + +sub coinSum +{ + my ($sum, @coins) = @_; + + _coinSum($sum, \@coins, 0, $coins[0], 0); + + return 0; +} + +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(); + -- cgit From 6924c8ff668659c426e6c1355e71bd01b31b4aea Mon Sep 17 00:00:00 2001 From: boblied Date: Sat, 29 Aug 2020 18:13:52 -0500 Subject: Update README message --- challenge-075/bob-lied/README | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/challenge-075/bob-lied/README b/challenge-075/bob-lied/README index b4b27d55df..e0e8e4f76c 100644 --- a/challenge-075/bob-lied/README +++ b/challenge-075/bob-lied/README @@ -1,3 +1,2 @@ -Solutions to weekly challenge 75 by Bob Lied. - +Solutions to Perl Weekly Challenge 075 by Bob Lied https://perlweeklychallenge.org/blog/perl-weekly-challenge-075/ -- cgit From 366685526e868c02b3941cd66194395f813d3d80 Mon Sep 17 00:00:00 2001 From: boblied Date: Mon, 7 Sep 2020 06:56:08 -0500 Subject: Solution for challenge 75, Task #1 --- challenge-075/bob-lied/perl/ch-1.pl | 8 +++-- challenge-075/bob-lied/perl/lib/CoinSum.pm | 48 +++++++++++++++++++++--------- 2 files changed, 39 insertions(+), 17 deletions(-) diff --git a/challenge-075/bob-lied/perl/ch-1.pl b/challenge-075/bob-lied/perl/ch-1.pl index 42b51a19f3..c0e4a6bc8d 100644 --- a/challenge-075/bob-lied/perl/ch-1.pl +++ b/challenge-075/bob-lied/perl/ch-1.pl @@ -32,6 +32,8 @@ use strict; use warnings; use feature qw(say); +use Data::Dumper; + use lib "lib"; use CoinSum qw(coinSum); @@ -43,7 +45,7 @@ my @C = @ARGV; die Usage() unless $S; die Usage() unless @C; -# Sort denominations so largest is first. -@C = sort { $a < $b } @C; -coinSum($S, @C); +my $result = coinSum($S, @C); + +say "[ @$_ ]" foreach @$result; diff --git a/challenge-075/bob-lied/perl/lib/CoinSum.pm b/challenge-075/bob-lied/perl/lib/CoinSum.pm index a5a7f818a5..e95500aa60 100644 --- a/challenge-075/bob-lied/perl/lib/CoinSum.pm +++ b/challenge-075/bob-lied/perl/lib/CoinSum.pm @@ -24,35 +24,55 @@ our @EXPORT = qw(coinSum); our @EXPORT_OK = qw(); -my @Combo; +my @ComboList; sub _coinSum { - my ($target, $denomList, $currentSum, $currentDenom, $comboNum = @_; + my ($depth, $target, $coinList, $coin, $combo) = @_; - return 0 if ( $currentSum > $target ); + my $diff = $target - $coin; + # say " depth=$depth, target = $target, coin = $coin, diff = $diff, list = [ @$coinList ], combo = [ @$combo ]"; - return 1 if ( $currentSum == $target ); - my $count = 0; - for my $denom ( @$denomList ) + if ( $diff == 0 ) { - push @{$Combo[$comboNum]] $denom; - if ( $denom >= $currentDenom ) - { - $comboNum += _coinSum($target, $denomList, $currentSum + $currentDenom, $denom, $comboNum); - } + push @ComboList, [ @$combo ]; + # say "FOUND [ @$combo ]"; + return 0; } - 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; - _coinSum($sum, \@coins, 0, $coins[0], 0); + while ( @coins ) + { + # say "TOP: coin = $coins[0]"; + _coinSum(1, $sum, \@coins, $coins[0], [ $coins[0] ] ); + shift @coins; + } - return 0; + return \@ComboList; } 1; -- cgit From 1609503c7b0dc62dbd8481046db444f342f3288b Mon Sep 17 00:00:00 2001 From: boblied Date: Mon, 7 Sep 2020 07:03:38 -0500 Subject: Solution to challenge 075, Task 2 --- challenge-075/bob-lied/perl/ch-2.pl | 30 ++++ .../bob-lied/perl/lib/LargestRectangleHistogram.pm | 166 +++++++++++++++++++++ 2 files changed, 196 insertions(+) create mode 100644 challenge-075/bob-lied/perl/ch-2.pl create mode 100644 challenge-075/bob-lied/perl/lib/LargestRectangleHistogram.pm 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/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; + -- cgit