diff options
| -rw-r--r-- | challenge-213/bob-lied/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-214/bob-lied/README | 6 | ||||
| -rw-r--r-- | challenge-214/bob-lied/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-214/bob-lied/perl/ch-1.pl | 84 | ||||
| -rw-r--r-- | challenge-214/bob-lied/perl/ch-2.pl | 134 |
5 files changed, 223 insertions, 3 deletions
diff --git a/challenge-213/bob-lied/blog.txt b/challenge-213/bob-lied/blog.txt new file mode 100644 index 0000000000..3288347232 --- /dev/null +++ b/challenge-213/bob-lied/blog.txt @@ -0,0 +1 @@ +https://dev.to/boblied/pwc-213-a-fun-sort-and-a-run-short-41d5 diff --git a/challenge-214/bob-lied/README b/challenge-214/bob-lied/README index ca4d14b3b4..4f6ce65387 100644 --- a/challenge-214/bob-lied/README +++ b/challenge-214/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 213 by Bob Lied +Solutions to weekly challenge 214 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-213/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-213/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-214/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-214/bob-lied diff --git a/challenge-214/bob-lied/blog.txt b/challenge-214/bob-lied/blog.txt new file mode 100644 index 0000000000..17c030c202 --- /dev/null +++ b/challenge-214/bob-lied/blog.txt @@ -0,0 +1 @@ +https://dev.to/boblied/pwc-214-1-rank-score-2-collect-points-3-4-profit-4adh diff --git a/challenge-214/bob-lied/perl/ch-1.pl b/challenge-214/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..ef028763ac --- /dev/null +++ b/challenge-214/bob-lied/perl/ch-1.pl @@ -0,0 +1,84 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge 214 Task 1 Rank Score +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given a list of scores (>=1). +# Write a script to rank each score in descending order. First three will get +# medals i.e. G (Gold), S (Silver) and B (Bronze). Rest will just get the +# ranking number. +# Using the standard model of giving equal scores equal rank, +# then advancing that number of ranks. +# Example 1 Input: @scores = (1,2,4,3,5) Output: (5,4,S,B,G) +# Example 2 Input: @scores = (8,5,6,7,4) Output: (G,4,B,S,5) +# Example 3 Input: @list = (3,5,4,2) Output: (B,G,S,4) +# Example 4 Input: @scores = (2,5,2,1,7,5,1) Output: (4,S,4,6,G,S,6) +#============================================================================= + +use v5.36; + +use FindBin qw($Bin); +use lib "$FindBin::Bin"; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say "(", join(",", rankScore(@ARGV)->@*), ")"; + +sub rankScore(@scoreList) +{ + return [] unless @scoreList; + + # Record position of each score if it was sorted descending. + # Example: [0] [1] [2] [3] [4] + # @scoreList = ( 1 2 4 3 5 ) + # --> @position = ( 4 3 1 2 0 ) + my @position = sort { $scoreList[$b] <=> $scoreList[$a] } 0 .. $#scoreList; + + # The colors or places that will be assigned. + my @rank = ( qw(G S B), 4 .. (@scoreList) ); + my $r = 0; # Index into @rank + + # In a copy of the scores, replace each score by its medal or rank. + my @ranked = @scoreList; + + # The first position is always gold. + my $place = $position[0]; + $ranked[ $place ] = $rank[$r]; + + # Move through consecutive pairs of positions to see when to switch + # rank colors. + for my $index ( 1 .. $#position ) + { + my $next = $position[$index]; + if ( $scoreList[$next] < $scoreList[$place] ) + { + # Lower score, so advance rank + $r = $index; + } + $ranked[$next] = $rank[$r]; + $place = $next; + } + return \@ranked; +} + +sub runTest +{ + use Test2::V0; + + is( rankScore(1,2,4,3,5), [ qw(5 4 S B G) ], "Example 1"); + is( rankScore(8,5,6,7,4), [ qw(G 4 B S 5) ], "Example 2"); + is( rankScore(3,5,4,2), [ qw(B G S 4) ], "Example 3"); + is( rankScore(2,5,2,1,7,5,1), [ qw(4 S 4 6 G S 6) ], "Example 4"); + is( rankScore(2,7,7,1,7,5,1), [ qw(5 G G 6 G 4 6) ], "Gold only"); + is( rankScore(3,5 ), [ qw(S G ) ], "Two players"); + + done_testing; +} + diff --git a/challenge-214/bob-lied/perl/ch-2.pl b/challenge-214/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..c1260bb297 --- /dev/null +++ b/challenge-214/bob-lied/perl/ch-2.pl @@ -0,0 +1,134 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge 214 Task 2 Collect Points +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given a list of numbers. +# You will perform a series of removal operations. For each operation, you +# remove from the list N (one or more) equal and consecutive numbers, and add +# to your score N × N. Determine the maximum possible score. +# Example 1: Input: @numbers = (2,4,3,3,3,4,5,4,2) Output: 23 +# We see three 3's next to each other so let us remove that first and +# collect 3 x 3 points. So now the list is (2,4,4,5,4,2). +# Let us now remove 5 so that all 4's can be next to each other and +# collect 1 x 1 point. So now the list is (2,4,4,4,2). +# Time to remove three 4's and collect 3 x 3 points. Now the list is (2,2). +# Finally remove both 2's and collect 2 x 2 points. +# So the total points collected is 9 + 1 + 9 + 4 => 23. +# Example 2: Input: @numbers = (1,2,2,2,2,1) Output: 20 +# Remove four 2's first and collect 4 x 4 points. Now the list is (1,1). +# Finally remove the two 1's and collect 2 x 2 points. +# So the total points collected is 16 + 4 => 20. +# Example 3: Input: @numbers = (1) Output: 1 +# Example 4: Input: @numbers = (2,2,2,1,1,2,2,2) Output: 40 +# Remove two 1's = 2 x 2 points. Now the list is (2,2,2,2,2,2). +# Then reomove six 2's = 6 x 6 points. +#============================================================================= + +use v5.36; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say collectPoints(@ARGV); + +# Return pairs of [offset, length] for each span of equal values in list +sub findSpan($list) +{ + my $listLength = @$list; + if ( $listLength == 0 ) { return [] } + elsif ( $listLength == 1 ) { return [ [0, 1] ] } + + my @span; + + my $beg = my $end = 0; + my $len = 1; + while ( $end < $listLength ) + { + while ( $end < $list->$#* && $list->[$end+1] == $list->[$end] ) + { + $end++; + $len++; + } + push @span, [ $beg, $len ]; + $beg = ++$end; + $len = 1; + } + return \@span; +} + +# Recursive function to do depth-first searches for best score +sub _collect($list, $scoreSoFar, $indent) +{ + say "$indent _collect[ $list->@* ], $scoreSoFar" if $Verbose; + + my $numLen = @$list; + if ( $numLen == 0 ) { return $scoreSoFar; } + elsif ( $numLen == 1 ) { return $scoreSoFar + 1; } + elsif ( $numLen == 2 ) + { + return $scoreSoFar + ($list->[0] == $list->[1] ? 4 : 2 ); + } + + my $spanList = findSpan($list); + + my $bestScore = 0; + for my $span ( @$spanList ) + { + my ($beg, $length) = $span->@*; + my $score = $length * $length; + + # Remove the span from the list and recurse + my @copy = $list->@*; + if ( $Verbose ) + { + my @rmv = $list->@[$beg .. $beg+$length-1]; + splice(@copy, $beg, $length, ('*')x$length); + say "$indent RMV [@rmv], copy=[@copy] score=$score"; + } + + splice(@copy, $beg, $length); + + $score = _collect(\@copy, $score, " $indent"); + if ( $score > $bestScore ) + { + $bestScore = $score; + say "$indent BEST: $bestScore" if $Verbose; + } + } + return $scoreSoFar + $bestScore; +} + +sub collectPoints(@numbers) +{ + return _collect(\@numbers, 0, ""); +} + +sub runTest +{ + use Test2::V0; + + is( findSpan( [9] ), [ [0,1] ], "findSpan singleton"); + is( findSpan( [4,5,6] ), [ [0,1],[1,1],[2,1] ], "unique"); + is( findSpan( [4,4,5,6] ), [ [0,2],[2,1],[3,1] ], "leading span"); + is( findSpan( [4,5,6,6] ), [ [0,1],[1,1],[2,2] ], "trailing span"); + is( findSpan( [4,5,5,6] ), [ [0,1],[1,2],[3,1] ], "middle span"); + + is( collectPoints(2), 1, "Singleton"); + is( collectPoints(2,3), 2, "Small"); + is( collectPoints(2,2), 4, "Pair"); + is( collectPoints(2,2,2), 9, "Triplet"); + is( collectPoints(2,4,3,3,3,4,5,4,2), 23, "Example 1"); + is( collectPoints(1,2,2,2,2,1 ), 20, "Example 2"); + is( collectPoints(1 ), 1, "Example 3"); + is( collectPoints(2,2,2,1,1,2,2,2 ), 40, "Example 4"); + + done_testing; +} + |