From 0ba97a2f9d9cad2e9392a567d979b63210251e10 Mon Sep 17 00:00:00 2001 From: boblied Date: Mon, 13 Mar 2023 20:01:30 -0500 Subject: Update README 208 --- challenge-208/bob-lied/README | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/challenge-208/bob-lied/README b/challenge-208/bob-lied/README index bb94b2f9bc..13fcdf5b47 100644 --- a/challenge-208/bob-lied/README +++ b/challenge-208/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 207 by Bob Lied +Solutions to weekly challenge 208 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-207/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-207/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-208/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-208/bob-lied -- cgit From d7b80c00f371f8b78e9b8b2a68c8a47e08667f52 Mon Sep 17 00:00:00 2001 From: boblied Date: Mon, 13 Mar 2023 21:28:45 -0500 Subject: Week 208 task 1 --- challenge-208/bob-lied/perl/ch-1.pl | 101 ++++++++++++++++++++++++++++++++++++ 1 file changed, 101 insertions(+) create mode 100644 challenge-208/bob-lied/perl/ch-1.pl diff --git a/challenge-208/bob-lied/perl/ch-1.pl b/challenge-208/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..d2b5351331 --- /dev/null +++ b/challenge-208/bob-lied/perl/ch-1.pl @@ -0,0 +1,101 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge Week 208 Task 1 Minimum Index Sum +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given two arrays of strings. +# Write a script to find out all common strings in the given two arrays with +# minimum index sum. If no common strings found returns an empty list. +# Example 1 Input: @list1 = ("Perl", "Raku", "Love") +# @list2 = ("Raku", "Perl", "Hate") +# Output: ("Perl", "Raku") +# There are two common strings "Perl" and "Raku". +# Index sum of "Perl": 0 + 1 = 1 +# Index sum of "Raku": 1 + 0 = 1 +# Example 2 Input: @list1 = ("A", "B", "C") +# @list2 = ("D", "E", "F") +# Output: () +# No common string found, so no result. +# Example 3 Input: @list1 = ("A", "B", "C") +# @list2 = ("C", "A", "B") +# Output: ("A") +# There are three common strings "A", "B" and "C". +# Index sum of "A": 0 + 1 = 1 +# Index sum of "B": 1 + 2 = 3 +# Index sum of "C": 2 + 0 = 2 +#============================================================================= + +use v5.36; + +use List::Util qw/min/; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +######### +# Command line +######### +use feature 'try'; no warnings "experimental::try"; +my @list1 = (); +my @list2 = (); +try +{ + @list1 = defined $ARGV[0] && split(/[ ,]/, $ARGV[0]); + @list2 = defined $ARGV[1] && split(/[ ,]/, $ARGV[1]); +} +catch ($e) { + say "Caught: ", $e; +} + +say "LIST1: [@list1]\nLIST2: [@list2]" if $Verbose; + +say "(", join(",", map { qq("$_") } minIndexSum(\@list1, \@list2)->@*), ")"; + +# Convert a list to an index lookup hash. Example: +# [ a, b ] becomes { a => 0, b => 1 } +sub asHash($list) +{ + my %h = map { $list->[$_] => $_ } 0 .. $#{$list}; + return \%h; +} + +sub minIndexSum($list1, $list2) +{ + my @result; + + my ($h1, $h2) = ( asHash($list1), asHash($list2) ); + + my %indexSum = map { $_ => ( $h1->{$_} + $h2->{$_} ) } + grep { exists $h2->{$_} } keys %$h1; + + my $min = min(values %indexSum); + + @result = grep { $indexSum{$_} == $min } keys %indexSum; + + return \@result; +} + +sub runTest +{ + use Test2::V0; + + is( minIndexSum( [ qw(Perl Raku Love) ], [ qw(Raku Perl Hate) ] ), + [ qw(Perl Raku) ], "Example 1"); + + is( minIndexSum( [ qw(A B C) ], [ qw(D E F) ] ), [], "Example 2"); + + is( minIndexSum( [ qw(A B C) ], [ qw(C A B) ] ), [ "A" ], "Example 3"); + + is( minIndexSum( [ ], [ qw(A B C) ] ), [], "list 1 empty"); + is( minIndexSum( [ qw(A B C) ], [ ] ), [], "list 2 empty"); + is( minIndexSum( [ ], [ ] ), [], "both lists empty"); + + done_testing; +} + -- cgit From e36233d423983f6752457402fd3c4a252f34ef11 Mon Sep 17 00:00:00 2001 From: boblied Date: Thu, 16 Mar 2023 14:12:47 -0500 Subject: Command-line cleanup --- challenge-208/bob-lied/perl/ch-1.pl | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/challenge-208/bob-lied/perl/ch-1.pl b/challenge-208/bob-lied/perl/ch-1.pl index d2b5351331..b62e9e0927 100644 --- a/challenge-208/bob-lied/perl/ch-1.pl +++ b/challenge-208/bob-lied/perl/ch-1.pl @@ -61,14 +61,18 @@ say "(", join(",", map { qq("$_") } minIndexSum(\@list1, \@list2)->@*), ")"; # [ a, b ] becomes { a => 0, b => 1 } sub asHash($list) { - my %h = map { $list->[$_] => $_ } 0 .. $#{$list}; + my %h; + # If there are duplicate values in the list, we want to + # retain only the first, lesser, index. + for my $i ( 0 .. $#{$list} ) + { + $h{$list->[$i]} = $i unless exists $h{$list->[$i]}; + } return \%h; } sub minIndexSum($list1, $list2) { - my @result; - my ($h1, $h2) = ( asHash($list1), asHash($list2) ); my %indexSum = map { $_ => ( $h1->{$_} + $h2->{$_} ) } @@ -76,9 +80,7 @@ sub minIndexSum($list1, $list2) my $min = min(values %indexSum); - @result = grep { $indexSum{$_} == $min } keys %indexSum; - - return \@result; + return [ sort grep { $indexSum{$_} == $min } keys %indexSum ]; } sub runTest @@ -96,6 +98,8 @@ sub runTest is( minIndexSum( [ qw(A B C) ], [ ] ), [], "list 2 empty"); is( minIndexSum( [ ], [ ] ), [], "both lists empty"); + is( minIndexSum( [ qw(A B C) ], [ qw(C B B) ] ), [ "B","C" ], "Non-unique list"); + done_testing; } -- cgit From e05c799c625a42c5201658f4780fded23188943b Mon Sep 17 00:00:00 2001 From: boblied Date: Thu, 16 Mar 2023 14:13:10 -0500 Subject: Command line cleanup --- challenge-208/bob-lied/perl/ch-2.pl | 100 ++++++++++++++++++++++++++++++++++++ 1 file changed, 100 insertions(+) create mode 100644 challenge-208/bob-lied/perl/ch-2.pl diff --git a/challenge-208/bob-lied/perl/ch-2.pl b/challenge-208/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..25ecac76b4 --- /dev/null +++ b/challenge-208/bob-lied/perl/ch-2.pl @@ -0,0 +1,100 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge Week 208 Task 2 Duplicate and Missing +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given an array of integers in sequence with one missing and one +# duplicate. Write a script to find the duplicate and missing integer in +# the given array. Return -1 if none found. +# For the sake of this task, let us assume the array contains no more than +# one duplicate and missing. +# Example 1: Input: @nums = (1,2,2,4) Output: (2,3) +# Duplicate is 2 and Missing is 3. +# Example 2: Input: @nums = (1,2,3,4) Output: -1 +# No duplicate and missing found. +# Example 3: Input: @nums = (1,2,3,3) Output: (3,4) +# Duplicate is 3 and Missing is 4. +# +# There are two ways to interpret this. One is the way shown in the examples, +# where a single integer in the sequence has been replaced by its neighbor. +# +# Another is that there might be two integers, one of which has a duplicate +# and another that is missing elsewhere in the list, such as 1,2,2,3,4,6. +#============================================================================= + +use v5.36; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +my $retval = dupAndMissing(@ARGV); +say "-1" if @$retval == 0; +say '(', join(',', $retval->@*), ')'; + + +# Find a dup-and-missing where one element of the list has +# been replaced by its neighbor, eg. 1,2,2,4 or 1,2,3,3 +# Returns [ dup, missing ], or [] if none found +sub dupAndMissing(@list) +{ + my $current = shift @list; + while ( my $next = shift @list ) + { + if ( $next == $current ) + { + return [ $current, $current+1 ]; + } + $current = $next; + } + return []; +} + +# Find a dup and a missing, assuming they might not be +# next to each other, e.g. 1,2,2,3,4,6 or 1,3,4,5,5 +sub dupAndMissing_B(@list) +{ + my ($dup, $missing); + my $current = shift @list; + while ( my $next = shift @list ) + { + if ( $current == $next ) + { + $dup = $current; + } + elsif ( $next > $current + 1 ) + { + $missing = $current + 1; + } + $current = $next; + } + return [] unless defined $dup && defined $missing; + return [ $dup, $missing ]; +} + +sub runTest +{ + use Test2::V0; + + is( dupAndMissing(1,2,2,4), [2,3], "Example 1"); + is( dupAndMissing(1,2,3,4), [ ], "Example 2"); + is( dupAndMissing(1,2,3,3), [3,4], "Example 3"); + + is( dupAndMissing(7,8,8,10), [8,9], "Start != 1"); + is( dupAndMissing(7,7,9,10), [7,8], "Start with dup"); + is( dupAndMissing(7,8,8), [8,9], "Short sequence dup last"); + is( dupAndMissing(7,7,9), [7,8], "Short sequence dup first"); + + is( dupAndMissing(-6,-5,-5,-3), [-5, -4], "Negative sequence"); + + is( dupAndMissing_B(1,2,2,3,4,6), [2,5], "Dup before missing"); + is( dupAndMissing_B(1,3,4,5,5,6), [5,2], "Missing before dup"); + + done_testing; +} + -- cgit From 0ca60a9d7192f3732e67377858c2d4c7bb212f98 Mon Sep 17 00:00:00 2001 From: boblied Date: Thu, 16 Mar 2023 15:12:16 -0500 Subject: Use each to iterate the array --- challenge-208/bob-lied/perl/ch-1.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/challenge-208/bob-lied/perl/ch-1.pl b/challenge-208/bob-lied/perl/ch-1.pl index b62e9e0927..a62f12156f 100644 --- a/challenge-208/bob-lied/perl/ch-1.pl +++ b/challenge-208/bob-lied/perl/ch-1.pl @@ -64,9 +64,9 @@ sub asHash($list) my %h; # If there are duplicate values in the list, we want to # retain only the first, lesser, index. - for my $i ( 0 .. $#{$list} ) + while ( my ($i, $val) = each @$list ) { - $h{$list->[$i]} = $i unless exists $h{$list->[$i]}; + $h{$val} = $i unless exists $h{$val}; } return \%h; } -- cgit From 4c85518ec9444669d534ae3d8b7be35c0c4a7d6b Mon Sep 17 00:00:00 2001 From: boblied Date: Thu, 16 Mar 2023 15:14:21 -0500 Subject: blog link --- challenge-208/bob-lied/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-208/bob-lied/blog.txt diff --git a/challenge-208/bob-lied/blog.txt b/challenge-208/bob-lied/blog.txt new file mode 100644 index 0000000000..be5ede8311 --- /dev/null +++ b/challenge-208/bob-lied/blog.txt @@ -0,0 +1 @@ +https://dev.to/boblied/pwc-208-smells-like-teen-sql-2bh6 -- cgit