From 4c0fff852641dac9557ef62d248810aec92e023e Mon Sep 17 00:00:00 2001 From: boblied Date: Sat, 28 Jan 2023 08:00:48 -0600 Subject: Update README for w182 --- challenge-182/bob-lied/README | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/challenge-182/bob-lied/README b/challenge-182/bob-lied/README index c231e3a589..6fb1b537d5 100644 --- a/challenge-182/bob-lied/README +++ b/challenge-182/bob-lied/README @@ -1,3 +1,3 @@ -Solutions to weekly challenge 138 by Bob Lied +Solutions to weekly challenge 182 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/ +https://perlweeklychallenge.org/blog/perl-weekly-challenge-182/ -- cgit From 4f82681e6189b8792cd6c73887a52efaee457def Mon Sep 17 00:00:00 2001 From: boblied Date: Sat, 28 Jan 2023 08:31:48 -0600 Subject: Week 182 Task 1 --- challenge-182/bob-lied/perl/ch-1.pl | 62 +++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) create mode 100644 challenge-182/bob-lied/perl/ch-1.pl diff --git a/challenge-182/bob-lied/perl/ch-1.pl b/challenge-182/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..425f8dcebc --- /dev/null +++ b/challenge-182/bob-lied/perl/ch-1.pl @@ -0,0 +1,62 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge Week 182 Task 1 Max Index +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given a list of integers. +# Write a script to find the index of the first biggest number in the list. +# Example 1: Input: @n = (5, 2, 9, 1, 7, 6) +# Output: 2 (as 3rd element in the list is the biggest number) +# Example 2: Input: @n = (4, 2, 3, 1, 5, 0) +# Output: 4 (as 5th element in the list is the biggest number) +#============================================================================= + +use v5.36; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +use Scalar::Util qw/looks_like_number/; + +my @list = grep { looks_like_number($_) } @ARGV; + +my $mi = maxIndex(@list); +print "maxIndex(@list) = " if $Verbose; +print $mi; +print " (list[$mi]=$list[$mi])" if $Verbose; +print "\n"; + +sub maxIndex(@list) +{ + my $max = $list[0]; + my $indexOfMax = 0; + for ( my $i = 1; $i < @list ; $i++ ) + { + if ( $list[$i] > $max ) + { + $max = $list[$i]; + $indexOfMax = $i + } + } + return $indexOfMax; +} + +sub runTest +{ + use Test2::V0; + + is( maxIndex(5,2,9,1,7,6), 2, "Example 1"); + is( maxIndex(4,2,3,1,5,0), 4, "Example 1"); + is( maxIndex(9,2,5,1,7,6), 0, "At 0"); + is( maxIndex(6,2,5,1,7,9), 5, "At end"); + is( maxIndex(7,7,7,7,7,7), 0, "Multiple"); + + done_testing; +} + -- cgit From 87ec4a2349637d2123785722d44c4bb746bde8c3 Mon Sep 17 00:00:00 2001 From: boblied Date: Sat, 28 Jan 2023 11:30:08 -0600 Subject: Week 182 Task 2 --- challenge-182/bob-lied/perl/ch-2.pl | 133 ++++++++++++++++++++++++++++++++++++ 1 file changed, 133 insertions(+) create mode 100644 challenge-182/bob-lied/perl/ch-2.pl diff --git a/challenge-182/bob-lied/perl/ch-2.pl b/challenge-182/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..fe2549009c --- /dev/null +++ b/challenge-182/bob-lied/perl/ch-2.pl @@ -0,0 +1,133 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge Week 182 Task 2 Common Path +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# Given a list of absolute Linux file paths, determine the deepest path +# to the directory that contains all of them. +# Example Input: /a/b/c/1/x.pl +# /a/b/c/d/e/2/x.pl +# /a/b/c/d/3/x.pl +# /a/b/c/4/x.pl +# /a/b/c/d/5/x.pl +# Ouput: /a/b/c +# +# We are going to infer that "absolute" means that the paths are +# always full paths, starting from "/". That implies that "/" will +# always be common to all the paths. +#============================================================================= + +use v5.36; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +# Allow a file name as an argument, or read standard input. +my $fh = *STDIN; +if ( @ARGV ) +{ + open($fh, '<', $ARGV[0]) || die "can't open $ARGV[0], $!"; +} + +say commonPath( parseInput($fh) ); + +# Open a string as a file handle, to allow testing without depending +# on extra files. +sub parseInputFromString($s) +{ + open(my $fh, "<", \$s) || die "open input string failed, $!"; + return parseInput($fh); +} + +# Read the list of inputs and return an array of path segments, +# Example: +# /a/b/d [ [ 'a', 'b', 'd' ], +# /a/b/f [ 'a', 'b', 'f' ] ] +sub parseInput($fh) +{ + # String input has some extra white space around it. + # Opportunity to use a v5.36 feature. + use builtin qw/trim/; no warnings 'experimental::builtin'; + + my @pathList = (); # Don't trip over undef + while ( <$fh> ) + { + push @pathList, [ split '/', trim($_) ]; + } + return \@pathList; +} + +sub commonPath($pathList) +{ + use List::Util qw/all min/; + + return '' if scalar(@$pathList) == 0; + + my $depth = 0; + + # We only have to go as deep as the shortest path. + my $maxDepth = (min map { scalar(@$_) } $pathList->@* ); + + # We go deeper as long as all paths are the same at this depth. + # The map takes a vertical column slice out of the pathList array. + $depth++ while ( $depth < $maxDepth && + all { $_ eq $pathList->[0][$depth] } + map { $_->[$depth] } $pathList->@* ); + + return "/".join("/", $pathList->[0]->@[1..$depth-1]); +} + +sub runTest +{ + use Test2::V0; + + my @TestCase = ( + { in => '/a/b/c/1/x.pl + /a/b/c/d/e/2/x.pl + /a/b/c/d/3/x.pl + /a/b/c/4/x.pl + /a/b/c/d/5/x.pl ', + out => '/a/b/c', + desc => "Example" + }, + { in => '/a/b/c + /b/c/d + /d/e/f ', + out => '/', + desc => "Root only" + }, + { in => '/a/b + /a/b', + out => '/a/b', + desc => 'Identical' + }, + { in => '/a a/b/c + /a a/b c/d', + out => '/a a', + desc => 'White space' + }, + { in => '/a/b/c', + out => '/a/b/c', + desc => "Singleton" + }, + { in => '', + out => '', + desc => "Empty list" + }, + ); + + for my $t ( 0 .. $#TestCase ) + { + my $test = $TestCase[$t]; + is( commonPath( parseInputFromString($test->{in}) ), $test->{out}, $test->{desc} ); + } + + done_testing; +} + -- cgit