From a243ee509e2e8cff20e72b6f9a11be93f135f6f2 Mon Sep 17 00:00:00 2001 From: boblied Date: Mon, 30 Jan 2023 12:13:05 -0600 Subject: Week 179 Task 2 --- challenge-179/bob-lied/perl/ch-1.pl | 46 +++++++++++++++++++++ challenge-179/bob-lied/perl/ch-2.pl | 79 +++++++++++++++++++++++++++++++++++++ 2 files changed, 125 insertions(+) create mode 100644 challenge-179/bob-lied/perl/ch-1.pl create mode 100644 challenge-179/bob-lied/perl/ch-2.pl diff --git a/challenge-179/bob-lied/perl/ch-1.pl b/challenge-179/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..2db9c74966 --- /dev/null +++ b/challenge-179/bob-lied/perl/ch-1.pl @@ -0,0 +1,46 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge Week 179 Task 1 Ordinal Number Spelling +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given a positive number, $n. +# Write a script to spell the ordinal number. +# Examples +# 11 => eleventh +# 62 => sixty-second +# 99 => ninety-ninth +#============================================================================= + +use v5.36; + +my @Ones = qw( zeroth first second third fourth + fifth sixth seventh eighth ninth + tenth eleventh twelfth thirteenth fourteenth + fifteenth sixteenth seventeenth eighteenth nineteenth ); + +my %Extra = ( 1 => "first", 2 => "second", 3 => "third", 5 => "fifth" ); + +my @Tens = qw( zero teen twenty thirty forty + fifty sixty seventy eighty ninety ); + +my @BigName = qw(none thousand million billion trillion quatrillion quintillion + sextillion septillion octillion nonillion decillion ); + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +sub runTest +{ + use Test2::V0; + + is(0, 1, "FAIL"); + + done_testing; +} + diff --git a/challenge-179/bob-lied/perl/ch-2.pl b/challenge-179/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..168bb2c396 --- /dev/null +++ b/challenge-179/bob-lied/perl/ch-2.pl @@ -0,0 +1,79 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge Week 179 Task 2 Unicode Sparkline +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given a list of positive numbers, @n. +# Write a script to print sparkline in Unicode for the given list of numbers. +# +# This seems to be a very brief description of the challenge from RosettaCode +# https://rosettacode.org/wiki/Sparkline_in_unicode +# Use the following series of Unicode characters to create a program that +# takes a series of numbers separated by one or more whitespace or comma +# characters and generates a sparkline-type bar graph of the values on a +# single line of output. +# The eight characters: '▁▂▃▄▅▆▇█' (Unicode values U+2581 through U+2588). +# Use your program to show sparklines for the following input, here on this page: +# 1 2 3 4 5 6 7 8 7 6 5 4 3 2 1 ▁▂▃▄▅▆▇█▇▆▅▄▃▂▁ +# 1.5, 0.5 3.5, 2.5 5.5, 4.5 7.5, 6.5 ▂▁▄▃▆▅█▇ +# (note the mix of separators in this second case)! +# Notes +# A space is not part of the generated sparkline. +# The sparkline may be accompanied by simple statistics of the data such as +# its range. +# A suggestion emerging in later discussion (see Discussion page) is that +# the bounds between bins should ideally be set to yield the following +# results for two particular edge cases: +# 0, 1, 19, 20 -> ▁▁██ (Aiming to use just two spark levels) +# 0, 999, 4000, 4999, 7000, 7999 -> ▁▁▅▅██ (Aiming for three spark levels) +#============================================================================= + +use v5.36; +binmode(STDOUT, ":encoding(UTF-8)"); + +use List::SomeUtils qw/minmax/; + +my @Level = ( "\N{LOWER ONE EIGHTH BLOCK}", + "\N{LOWER ONE QUARTER BLOCK}", + "\N{LOWER THREE EIGHTHS BLOCK}", + "\N{LOWER HALF BLOCK}", + "\N{LOWER FIVE EIGHTHS BLOCK}", + "\N{LOWER THREE QUARTERS BLOCK}", + "\N{LOWER SEVEN EIGHTHS BLOCK}", + "\N{FULL BLOCK}" ); + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say sparkLine(\@ARGV); + +sub sparkLine($list) +{ + my ($min, $max) = minmax $list->@*; + my $range = $max - $min+1; + + my @bucket = map { int( ($_-$min) / ($range/@Level) ) } $list->@*; + + my @histogram = map { $Level[$_] } @bucket; + + return join("", @histogram); +} + +sub runTest +{ + use Test2::V0; + + is( sparkLine([1,2,3,4,5,6,7,8,7,6,5,4,3,2,1]), "▁▂▃▄▅▆▇█▇▆▅▄▃▂▁", "Example 1"); + is( sparkLine([1.5,0.5,3.5,2.5,5.5,4.5,7.5,6.5]), "▂▁▄▃▆▅█▇", "Example 2"); + is( sparkLine([0,1,19,20]), "▁▁██", "Two levels"); + is( sparkLine([0,999,4000,4999,7000,7999]), "▁▁▅▅██", "Three levels"); + + done_testing; +} + -- cgit From 245f10960be2d521d2f2daa6a02fbe6c0c3fdf53 Mon Sep 17 00:00:00 2001 From: boblied Date: Wed, 1 Feb 2023 20:33:20 -0600 Subject: Week 179 Task 1 --- challenge-179/bob-lied/perl/ch-1.pl | 239 ++++++++++++++++++++++++++++++++++-- 1 file changed, 231 insertions(+), 8 deletions(-) diff --git a/challenge-179/bob-lied/perl/ch-1.pl b/challenge-179/bob-lied/perl/ch-1.pl index 2db9c74966..bc62051e23 100644 --- a/challenge-179/bob-lied/perl/ch-1.pl +++ b/challenge-179/bob-lied/perl/ch-1.pl @@ -15,15 +15,20 @@ use v5.36; -my @Ones = qw( zeroth first second third fourth - fifth sixth seventh eighth ninth - tenth eleventh twelfth thirteenth fourteenth - fifteenth sixteenth seventeenth eighteenth nineteenth ); +use builtin qw/ceil floor indexed/; +no warnings 'experimental'; -my %Extra = ( 1 => "first", 2 => "second", 3 => "third", 5 => "fifth" ); +my @Ones = qw( zero one two three four five six seven eight nine); +my @Oneth = qw( zeroth first second third fourth fifth sixth + seventh eighth ninth ); -my @Tens = qw( zero teen twenty thirty forty - fifty sixty seventy eighty ninety ); +my @Teen = qw(ten eleven twelve thirteen fourteen fifteen sixteen + seventeen eighteen nineteen); +my @Teenth = map { "${_}th" } @Teen; +$Teenth[2] = "twelfth"; + +my @Tens = qw( zero ten twenty thirty forty fifty sixty seventy eighty ninety ); +my @Tenthieth = map { (my $th = $_) =~ s/y\z/ie/; "${th}th" } @Tens; my @BigName = qw(none thousand million billion trillion quatrillion quintillion sextillion septillion octillion nonillion decillion ); @@ -35,11 +40,229 @@ my $DoTest = 0; GetOptions("test" => \$DoTest, "verbose" => \$Verbose); exit(!runTest()) if $DoTest; +say asOrdinalString($_) for @ARGV; + + +# Returns pairs of 3-digit values and group names, like [321,million][456,thousand] +sub groupThree($n) +{ + my @group; + my $numGrp = ceil(length($n) / 3); + for ( my $i = 0 ; $i < $numGrp ; $i++ ) + { + unshift @group, [ substr($n, -3*($i+1), 3), $BigName[$i] ]; + } + return \@group; +} + +sub asOrdinalString($n) +{ + my $str; + my $group = groupThree($n); + + # For each group of three, form an ordinal number for the least + # group and a cardinal number with its name for the higher groups. + my @parts = map { + my ($val, $grpName) = $_->@*; + $grpName eq 'none' + ? ordinal($val) + : (cardinal($val) . " $grpName") + } $group->@* ; + + # Handle things like 7_000_444 and 1000 -- don't keep things + # like "zero thousand" or "one thousand zeroth" + if ( @parts > 1 ) + { + @parts = grep !/zero/, @parts; + if ( ($n % 1000 ) == 0 ) + { + # If we have a round number, we've stripped away + # the 'zeroth' string at the end, so we have to + # correct it by adding 'th' back to the end. + $parts[-1] .= "th"; + } + } + + $str = join(' ', @parts); + return $str; +} + +# Create a string for a 3-digit number. +sub cardinal($n) +{ + return "zero" if $n == 0; + my $ones = $n % 10; + my $tens = int($n / 10 ) % 10; + my $hunds = int($n / 100 ) % 10; + + my $str; + if ( $ones != 0 ) + { + $str = ( $tens == 1 ? $Teen[$ones] : $Ones[$ones] ); + } + elsif ( $tens == 1 ) + { + $str = ( $Tens[1] ); + } + if ( $tens > 1 ) + { + $str = ( $ones == 0 ? $Tens[$tens] : "$Tens[$tens]-$str" ); + } + if ( $hunds != 0 ) + { + $str = ( $n %100 == 0 ? "$Ones[$hunds] hundred" : "$Ones[$hunds] hundred $str" ); + } + return $str; +} + +# Create an ordinal string for a three-digit number. +sub ordinal($n) +{ + return "zeroth" if $n == 0 ; + + my $ones = $n % 10; + my $tens = int($n / 10 ) % 10; + my $hunds = int($n / 100 ) % 10; + + my $str; + + if ( $ones != 0 ) + { + $str = ( $tens == 1 ? $Teenth[$ones] : $Oneth[$ones] ); + } + elsif ( $tens == 1 ) + { + $str = $Tenthieth[$tens]; + } + if ( $tens > 1 ) + { + $str = ( $ones == 0 ? $Tenthieth[$tens] : "$Tens[$tens]-$str" ); + } + if ( $hunds != 0 ) + { + $str = ( $n %100 == 0 ? "$Ones[$hunds] hundredth" : "$Ones[$hunds] hundred $str" ); + } + return $str; +} + sub runTest { use Test2::V0; - is(0, 1, "FAIL"); + is( groupThree(1), [ [ 1, "none"] ], "Grouping 1"); + is( groupThree(321), [ [321, "none"] ], "Grouping 321"); + is( groupThree(4321), [ [ 4, "thousand"],[321,'none'] ], "Grouping 4321"); + is( groupThree(7654321), [ [7,'million'],[654, "thousand"],[321,'none'] ], "Grouping 7654321"); + is( groupThree(1987654321),[ [ 1,'billion'], + [987,'million'], + [654, "thousand"], + [321,'none'] ], "Grouping 1987654321"); + is( groupThree(4001987654321),[ [ 4,'trillion'], + ['001','billion'], + [987,'million'], + [654, "thousand"], + [321,'none'] ], "Grouping 4001987654321"); + + + is( ordinal( 0), "zeroth", "ord 0"); + is( ordinal( 1), "first", "ord 1"); + is( ordinal( 2), "second", "ord 2"); + is( ordinal( 3), "third", "ord 3"); + is( ordinal( 4), "fourth", "ord 4"); + is( ordinal( 5), "fifth", "ord 5"); + is( ordinal(10), "tenth", "ord 10"); + is( ordinal(11), "eleventh", "ord 11"); + is( ordinal(12), "twelfth", "ord 12"); + is( ordinal(20), "twentieth", "ord 20"); + is( ordinal(30), "thirtieth", "ord 30"); + is( ordinal(40), "fortieth", "ord 40"); + is( ordinal(50), "fiftieth", "ord 50"); + is( ordinal(60), "sixtieth", "ord 60"); + is( ordinal(62), "sixty-second", "ord 62"); + is( ordinal(70), "seventieth", "ord 70"); + is( ordinal(80), "eightieth", "ord 80"); + is( ordinal(90), "ninetieth", "ord 90"); + is( ordinal(91), "ninety-first", "ord 91"); + is( ordinal(92), "ninety-second", "ord 92"); + is( ordinal(93), "ninety-third", "ord 93"); + is( ordinal(94), "ninety-fourth", "ord 94"); + is( ordinal(95), "ninety-fifth", "ord 95"); + is( ordinal(96), "ninety-sixth", "ord 96"); + is( ordinal(97), "ninety-seventh", "ord 97"); + is( ordinal(98), "ninety-eighth", "ord 98"); + is( ordinal(99), "ninety-ninth", "ord 99"); + is( ordinal(100), "one hundredth", "ord 100"); + is( ordinal(101), "one hundred first", "ord 101"); + is( ordinal(111), "one hundred eleventh", "ord 111"); + is( ordinal(233), "two hundred thirty-third", "ord 233"); + + is( cardinal( 0), "zero", "card 0"); + is( cardinal( 1), "one", "card 1"); + is( cardinal( 2), "two", "card 2"); + is( cardinal( 3), "three", "card 3"); + is( cardinal( 4), "four", "card 4"); + is( cardinal( 5), "five", "card 5"); + is( cardinal(10), "ten", "card 10"); + is( cardinal(11), "eleven", "card 11"); + is( cardinal(12), "twelve", "card 12"); + is( cardinal(20), "twenty", "card 20"); + is( cardinal(30), "thirty", "card 30"); + is( cardinal(40), "forty", "card 40"); + is( cardinal(50), "fifty", "card 50"); + is( cardinal(60), "sixty", "card 60"); + is( cardinal(62), "sixty-two", "card 62"); + is( cardinal(70), "seventy", "card 70"); + is( cardinal(80), "eighty", "card 80"); + is( cardinal(90), "ninety", "card 90"); + is( cardinal(91), "ninety-one", "card 91"); + is( cardinal(92), "ninety-two", "card 92"); + is( cardinal(93), "ninety-three", "card 93"); + is( cardinal(94), "ninety-four", "card 94"); + is( cardinal(95), "ninety-five", "card 95"); + is( cardinal(96), "ninety-six", "card 96"); + is( cardinal(97), "ninety-seven", "card 97"); + is( cardinal(98), "ninety-eight", "card 98"); + is( cardinal(99), "ninety-nine", "card 99"); + is( cardinal(100), "one hundred", "card 100"); + is( cardinal(101), "one hundred one", "card 101"); + is( cardinal(111), "one hundred eleven", "card 111"); + is( cardinal(233), "two hundred thirty-three", "card 233"); + + is( asOrdinalString( 0), "zeroth", "asOrdinalString 0"); + is( asOrdinalString( 1), "first", "asOrdinalString 1"); + is( asOrdinalString( 2), "second", "asOrdinalString 2"); + is( asOrdinalString( 3), "third", "asOrdinalString 3"); + is( asOrdinalString( 4), "fourth", "asOrdinalString 4"); + is( asOrdinalString( 5), "fifth", "asOrdinalString 5"); + is( asOrdinalString(11), "eleventh", "asOrdinalString 11"); + is( asOrdinalString(12), "twelfth", "asOrdinalString 12"); + is( asOrdinalString(20), "twentieth", "asOrdinalString 20"); + is( asOrdinalString(30), "thirtieth", "asOrdinalString 30"); + is( asOrdinalString(40), "fortieth", "asOrdinalString 40"); + is( asOrdinalString(50), "fiftieth", "asOrdinalString 50"); + is( asOrdinalString(60), "sixtieth", "asOrdinalString 60"); + is( asOrdinalString(62), "sixty-second", "asOrdinalString 62"); + is( asOrdinalString(70), "seventieth", "asOrdinalString 70"); + is( asOrdinalString(80), "eightieth", "asOrdinalString 80"); + is( asOrdinalString(90), "ninetieth", "asOrdinalString 90"); + is( asOrdinalString(91), "ninety-first", "asOrdinalString 91"); + is( asOrdinalString(92), "ninety-second", "asOrdinalString 92"); + is( asOrdinalString(93), "ninety-third", "asOrdinalString 93"); + is( asOrdinalString(94), "ninety-fourth", "asOrdinalString 94"); + is( asOrdinalString(95), "ninety-fifth", "asOrdinalString 95"); + is( asOrdinalString(96), "ninety-sixth", "asOrdinalString 96"); + is( asOrdinalString(97), "ninety-seventh", "asOrdinalString 97"); + is( asOrdinalString(98), "ninety-eighth", "asOrdinalString 98"); + is( asOrdinalString(99), "ninety-ninth", "asOrdinalString 99"); + is( asOrdinalString(100), "one hundredth", "asOrdinalString 100"); + is( asOrdinalString(101), "one hundred first", "asOrdinalString 101"); + is( asOrdinalString(111), "one hundred eleventh", "asOrdinalString 111"); + is( asOrdinalString(233), "two hundred thirty-third", "asOrdinalString 233"); + is( asOrdinalString(1002003), "one million two thousand third", "asOrdinalString 1002003"); + is( asOrdinalString(10000), "ten thousandth", "asordinalString 10000"); + is( asOrdinalString(10_164_502_713), + "ten billion one hundred sixty-four million five hundred two thousand seven hundred thirteenth", "asOrdinalString 1002003"); + done_testing; } -- cgit From 4e9b14fb025d547af2364516361f22261bc00cfc Mon Sep 17 00:00:00 2001 From: boblied Date: Mon, 6 Feb 2023 13:15:19 -0600 Subject: Update README for 203 --- challenge-203/bob-lied/README | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/challenge-203/bob-lied/README b/challenge-203/bob-lied/README index a2b67fd974..b6b1a39cca 100644 --- a/challenge-203/bob-lied/README +++ b/challenge-203/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 202 by Bob Lied +Solutions to weekly challenge 203 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-202/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-202/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-203/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-203/bob-lied -- cgit From 9594b3008c0937ffc2b435fe88ef6b2f09b48891 Mon Sep 17 00:00:00 2001 From: boblied Date: Mon, 6 Feb 2023 13:15:40 -0600 Subject: Week 203 Task 1 --- challenge-203/bob-lied/perl/ch-1.pl | 83 +++++++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 challenge-203/bob-lied/perl/ch-1.pl diff --git a/challenge-203/bob-lied/perl/ch-1.pl b/challenge-203/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..405b81677d --- /dev/null +++ b/challenge-203/bob-lied/perl/ch-1.pl @@ -0,0 +1,83 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge Week 203 Task 1 Special Quadruplets +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given an array of integers. +# Write a script to find out the total special quadruplets for the given array. +# Special Quadruplets are such that satisfies the following 2 rules. +# 1) nums[a] + nums[b] + nums[c] == nums[d] +# 2) a < b < c < d +# Example 1 Input: @nums = (1,2,3,6) Output: 1 +# Since the only special quadruplets found is +# $nums[0] + $nums[1] + $nums[2] == $nums[3]. +# Example 2 Input: @nums = (1,1,1,3,5) Output: 4 +# $nums[0] + $nums[1] + $nums[2] == $nums[3] +# $nums[0] + $nums[1] + $nums[3] == $nums[4] +# $nums[0] + $nums[2] + $nums[3] == $nums[4] +# $nums[1] + $nums[2] + $nums[3] == $nums[4] +# Example 3 Input: @nums = (3,3,6,4,5) Output: 0 +#============================================================================= + +use v5.36; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say quad(\@ARGV); + +sub quad($nums) +{ + my $howMany = 0; + my @quad; + my $end = $#{$nums}; + for ( my $a = 0 ; $a <= $end-3 ; $a ++ ) + { + for ( my $b = $a+1 ; $b <= $end-2; $b++ ) + { + for ( my $c = $b + 1 ; $c <= $end-1 ; $c++ ) + { + my $q = $nums->[$a] + $nums->[$b] + $nums->[$c]; + for ( my $d = $c + 1 ; $d <= $end ; $d++ ) + { + if ( $q == $nums->[$d] ) + { + $howMany++; + push @quad, [$a, $b, $c, $d] if $Verbose; + } + } + } + } + } + showQuad(\@quad, $nums) if $Verbose; + return $howMany; +} + +sub showQuad($quad, $nums) +{ + for my $q ( $quad->@* ) + { + print "nums[", join(", ", $q->@*), "]"; + print "\t"; + print join(", ", $nums->@[$q->@*]); + print "\n"; + } +} + +sub runTest +{ + use Test2::V0; + + is( quad([1,2,3,6 ]), 1, "Example 1"); + is( quad([1,1,1,3,5]), 4, "Example 2"); + is( quad([3,3,6,4,4]), 0, "Example 3"); + + done_testing; +} + -- cgit From e0cf132749fcc150dbe2d3f0696fa3571ae47d95 Mon Sep 17 00:00:00 2001 From: boblied Date: Mon, 6 Feb 2023 14:35:12 -0600 Subject: Week 203 Task 2 --- challenge-203/bob-lied/perl/ch-2.pl | 79 +++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 challenge-203/bob-lied/perl/ch-2.pl diff --git a/challenge-203/bob-lied/perl/ch-2.pl b/challenge-203/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..e301318162 --- /dev/null +++ b/challenge-203/bob-lied/perl/ch-2.pl @@ -0,0 +1,79 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge Week 203 Task 2 Copy Directory +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given path to two folders, $source and $target. +# Write a script that recursively copy the directory from $source to $target +# except any files. +# Example: Input: $source = '/a/b/c' and $target = '/x/y' +# Source directory structure: +# +# ├── a +# │ └── b +# │ └── c +# │ ├── 1 +# │ │ └── 1.txt +# │ ├── 2 +# │ │ └── 2.txt +# │ ├── 3 +# │ │ └── 3.txt +# │ ├── 4 +# │ └── 5 +# │ └── 5.txt +# +# Target directory structure: +# ├── x +# │ └── y +# +# Expected Result: +# +# ├── x +# │ └── y +# | ├── 1 +# │ ├── 2 +# │ ├── 3 +# │ ├── 4 +# │ └── 5 +# +# From a shell prompt using find and cpio; +# ( cd $srcdir && find . -type d -print | cpio -pdumv $targetP ; ) +# where $targetP is $target relative to $srcdir +#============================================================================= + +use v5.36; + +use File::Find; +use File::Path qw/make_path/; + +use Getopt::Long; +my $Verbose = 0; + +GetOptions("verbose" => \$Verbose); + +my ($srcdir, $target) = @ARGV; + +die "$srcdir is not a directory" unless -d $srcdir; +die "$target is not an existing directory" unless -d $target; + +copyDir($srcdir, $target); + +sub copyDir($srcdir, $target) +{ + # Populate the @dirtree list of directories to be created. + # This list will be very redundant. We really only need the + # deepest branches of the tree, because make_path will create + # all the # intermediate levels. + # + # File::Find::name is the path of a directory, including $srcdir + my @dirtree; + find( sub() { -d && push @dirtree, $File::Find::name; }, $srcdir); + + # Substitute target for source at the beginning of each directory. + # File::Path::make_path will create each directory, skipping over + # levels that already exist. + make_path( (map { s/^$srcdir/$target/; $_ } @dirtree ), + { verbose => $Verbose } ); +} -- cgit From 77997b6e85b2142b057108c0c2fd01dfb8aac90e Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Mon, 13 Feb 2023 10:29:32 +0100 Subject: Task 1 done --- challenge-204/luca-ferrari/raku/ch-1.p6 | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 challenge-204/luca-ferrari/raku/ch-1.p6 diff --git a/challenge-204/luca-ferrari/raku/ch-1.p6 b/challenge-204/luca-ferrari/raku/ch-1.p6 new file mode 100644 index 0000000000..cbcc3efbb6 --- /dev/null +++ b/challenge-204/luca-ferrari/raku/ch-1.p6 @@ -0,0 +1,25 @@ +#!raku + +# +# Perl Weekly Challenge 204 +# Task 1 +# +# See +# + +sub MAIN( *@list where { @list.grep( * ~~ Int ).elems == @list.elems } ) { + my $monotonic-type; + for 0 ^..^ @list.elems { + if ( ! $monotonic-type ) { + $monotonic-type = ( @list[ $_ ] > @list[ $_ - 1 ] ) ?? True !! False; + } + + # elements are the same + next if @list[ $_ ] == @list[ $_ - 1 ]; + + '0'.say and exit if ( ! $monotonic-type && @list[ $_ ] > @list[ $_ - 1 ] ); + '0'.say and exit if ( $monotonic-type && @list[ $_ ] < @list[ $_ - 1 ] ); + } + + '1'.say; +} -- cgit From 52cbb7bad49711e2900a2dbc2b2c014f7dc30276 Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Mon, 13 Feb 2023 10:45:02 +0100 Subject: Task 2 done --- challenge-204/luca-ferrari/raku/ch-2.p6 | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 challenge-204/luca-ferrari/raku/ch-2.p6 diff --git a/challenge-204/luca-ferrari/raku/ch-2.p6 b/challenge-204/luca-ferrari/raku/ch-2.p6 new file mode 100644 index 0000000000..652ef3e1ec --- /dev/null +++ b/challenge-204/luca-ferrari/raku/ch-2.p6 @@ -0,0 +1,32 @@ +#!raku + +# +# Perl Weekly Challenge 204 +# Task 2 +# +# See +# + +# raku raku/ch-2.p6 -r=3 -c=2 "1 2 3" "4 5 6" +# [[1 2] [3 4] [5 6]] + +sub MAIN( Int :$r, Int :$c, *@matrix ) { + my @M = @matrix.map: { $_.split( ' ' ) }; + + # if cannot reshape, exit + '0'.say and exit if ( $r * $c ) < ( @M.elems * @M[ 0 ].elems ); + + my @N; + my @new-row; + for @M -> $row { + + for 0 ..^ $row.elems { + @new-row.push: $row[ $_ ] if ( @new-row.elems < $c ); + @N.push: [ @new-row ] if ( @new-row.elems == $c ); + @new-row = () if ( @new-row.elems == $c ); + + } + } +v + @N.join( "\n" ).say; +} -- cgit From ec0c81db1376cdf10a67797c1cfc5b55b0d22fa0 Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Mon, 13 Feb 2023 10:51:42 +0100 Subject: Task 1 PLPerl --- challenge-204/luca-ferrari/postgresql/ch-1.plperl | 30 +++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 challenge-204/luca-ferrari/postgresql/ch-1.plperl diff --git a/challenge-204/luca-ferrari/postgresql/ch-1.plperl b/challenge-204/luca-ferrari/postgresql/ch-1.plperl new file mode 100644 index 0000000000..7fbb93bf4c --- /dev/null +++ b/challenge-204/luca-ferrari/postgresql/ch-1.plperl @@ -0,0 +1,30 @@ +-- +-- Perl Weekly Challenge 204 +-- Task 1 +-- See +-- + +CREATE SCHEMA IF NOT EXISTS pwc204; + +CREATE OR REPLACE FUNCTION +pwc204.task1_plperl( int[] ) +RETURNS int +AS $CODE$ + my ( $list ) = @_; + my $monotonic_type; + + for ( 1 .. scalar( $list->@* ) - 1 ) { + next if ( $list->[ $_ ] == $list->[ $_ - 1 ] ); + + if ( ! defined( $monotonic_type ) ) { + $monotonic_type = ( $list->[ $_ ] > $list->[ $_ - 1 ] ) ? 1 : 0; + } + + return 0 if ( $monotonic_type && $list->[ $_ ] < $list->[ $_ - 1 ] ); + return 0 if ( ! $monotonic_type && $list->[ $_ ] > $list->[ $_ - 1 ] ); + } + + return 1; + +$CODE$ +LANGUAGE plperl; -- cgit From bc4d1cf0df3a2c565ce5faf5c8c380f47e997ada Mon Sep 17 00:00:00 2001 From: Simon Green Date: Mon, 13 Feb 2023 20:52:00 +1100 Subject: Simon's solution to challenge 203 --- challenge-203/sgreen/README.md | 4 +--- challenge-203/sgreen/perl/ch-1.pl | 26 ++++++++++++++++++++++++++ challenge-203/sgreen/python/ch-1.py | 21 +++++++++++++++++++++ 3 files changed, 48 insertions(+), 3 deletions(-) create mode 100644 challenge-203/sgreen/perl/ch-1.pl create mode 100644 challenge-203/sgreen/python/ch-1.py diff --git a/challenge-203/sgreen/README.md b/challenge-203/sgreen/README.md index 642af7b377..fb74669ff4 100644 --- a/challenge-203/sgreen/README.md +++ b/challenge-203/sgreen/README.md @@ -1,3 +1 @@ -# The Weekly Challenge 202 - -Blog: [Weekly Challenge 202](https://dev.to/simongreennet/weekly-challenge-202-4dcm) +# The Weekly Challenge 203 diff --git a/challenge-203/sgreen/perl/ch-1.pl b/challenge-203/sgreen/perl/ch-1.pl new file mode 100644 index 0000000000..232eeecfb2 --- /dev/null +++ b/challenge-203/sgreen/perl/ch-1.pl @@ -0,0 +1,26 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature 'say'; +use experimental 'signatures'; + +use Algorithm::Combinatorics 'combinations'; + +sub main (@n) { + my $solutions = 0; + + # Work through all combinations of positions + my $iter = combinations( [ 0 .. $#n ], 4 ); + while ( my $x = $iter->next ) { + my ( $i, $j, $k, $l ) = sort { $a <=> $b } @$x; + if ( $n[$i] + $n[$j] + $n[$k] == $n[$l] ) { + $solutions++; + return; + } + } + + say $solutions; +} + +main(@ARGV); diff --git a/challenge-203/sgreen/python/ch-1.py b/challenge-203/sgreen/python/ch-1.py new file mode 100644 index 0000000000..cc1bc522e9 --- /dev/null +++ b/challenge-203/sgreen/python/ch-1.py @@ -0,0 +1,21 @@ +#!/usr/bin/env python3 + +from itertools import combinations +import sys + +def main(n): + solutions = 0 + + # Work through all combinations of positions + for x in combinations(range(len(n)), 4): + i, j, k, l = sorted(x) + if n[i] + n[j] + n[k] == n[l]: + solutions += 1 + + # No solution is found + print(solutions) + +if __name__ == '__main__': + # Turn the strings into integers + n = [int(i) for i in sys.argv[1:]] + main(n) -- cgit From 5972b734c116d76306bf1047883ff9ef99b3ef90 Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Mon, 13 Feb 2023 10:57:58 +0100 Subject: Task 2 plperl --- challenge-204/luca-ferrari/postgresql/ch-2.plperl | 39 +++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 challenge-204/luca-ferrari/postgresql/ch-2.plperl diff --git a/challenge-204/luca-ferrari/postgresql/ch-2.plperl b/challenge-204/luca-ferrari/postgresql/ch-2.plperl new file mode 100644 index 0000000000..fe64ecbca6 --- /dev/null +++ b/challenge-204/luca-ferrari/postgresql/ch-2.plperl @@ -0,0 +1,39 @@ +-- +-- Perl Weekly Challenge 204 +-- Task 2 +-- See +-- + +CREATE SCHEMA IF NOT EXISTS pwc204; + +/* +testdb=> select pwc204.task2_plperl( 3, 2, array[ array[ 1,2,3]::int[], array[3,4,5]::int[] ]::int[] ); + task2_plperl +--------------------- + {{1,2},{3,3},{4,5}} +(1 row) + +*/ +CREATE OR REPLACE FUNCTION +pwc204.task2_plperl( int, int, int[][] ) +RETURNS int[][] +AS $CODE$ + my ( $r, $c, $matrix ) = @_; + my @N; + my @new_row; + + return undef if ( ( $r * $c ) < $matrix->@* * $matrix->[0]->@* ); + + for my $row ( 0 .. scalar( $matrix->@* ) - 1 ) { + for my $col ( 0 .. scalar( $matrix->[ $row ]->@* ) - 1 ) { + push @new_row, $matrix->[ $row ]->[ $col ] if ( @new_row < $c ); + if ( @new_row == $c ) { + push @N, [ @new_row ]; + @new_row = (); + } + } + } + + return [ @N ]; +$CODE$ +LANGUAGE plperl; -- cgit From 30409b39a194d7dde19e2fa46f2f9cd3094928a9 Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Mon, 13 Feb 2023 11:02:35 +0100 Subject: Task1 PL/PgSQL done --- challenge-204/luca-ferrari/postgresql/ch-1.sql | 43 ++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 challenge-204/luca-ferrari/postgresql/ch-1.sql diff --git a/challenge-204/luca-ferrari/postgresql/ch-1.sql b/challenge-204/luca-ferrari/postgresql/ch-1.sql new file mode 100644 index 0000000000..98b6698450 --- /dev/null +++ b/challenge-204/luca-ferrari/postgresql/ch-1.sql @@ -0,0 +1,43 @@ +-- +-- Perl Weekly Challenge 204 +-- Task 1 +-- +-- See +-- + +CREATE SCHEMA IF NOT EXISTS pwc204; + +CREATE OR REPLACE FUNCTION +pwc204.task1_plpgsql( l int[] ) +RETURNS int +AS $CODE$ +DECLARE + monotonic_mode bool; + i int; +BEGIN + + FOR i IN 2 .. array_length( l, 1 ) LOOP + IF l[ i ] = l[ i - 1 ] THEN + CONTINUE; + END IF; + + IF monotonic_mode IS NULL THEN + IF l[ i ] > l[ i - 1 ] THEN + monotonic_mode := true; + ELSE + monotonic_mode := false; + END IF; + END IF; + + IF monotonic_mode AND l[ i ] < l[ i - 1 ] THEN + RETURN 0; + END IF; + IF NOT monotonic_mode AND l[ i ] > l[ i - 1 ] THEN + RETURN 0; + END IF; + END LOOP; + + RETURN 1; +END +$CODE$ +LANGUAGE plpgsql; -- cgit From d984472fb4dd7176806d3545ba710c765e2c134c Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Mon, 13 Feb 2023 11:25:38 +0100 Subject: Task 2 plpgsql --- challenge-204/luca-ferrari/postgresql/ch-2.sql | 37 ++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 challenge-204/luca-ferrari/postgresql/ch-2.sql diff --git a/challenge-204/luca-ferrari/postgresql/ch-2.sql b/challenge-204/luca-ferrari/postgresql/ch-2.sql new file mode 100644 index 0000000000..ec40b84823 --- /dev/null +++ b/challenge-204/luca-ferrari/postgresql/ch-2.sql @@ -0,0 +1,37 @@ +-- +-- Perl Weekly Challenge 204 +-- Task 2 +-- +-- See +-- + +CREATE SCHEMA IF NOT EXISTS pwc204; + +CREATE OR REPLACE FUNCTION +pwc204.task2_plpgsql( r int, c int, a int[][] ) +RETURNS SETOF int[] +AS $CODE$ +DECLARE + current_row int[]; + index_r int; + index_c int; +BEGIN + IF ( r * c ) < ( array_length( a, 1 ) * array_length( a, 2 ) ) THEN + RETURN; + END IF; + + FOR index_r IN 1 .. array_length( a, 1 ) LOOP + FOR index_c IN 1 .. array_length( a, 2 ) LOOP + current_row := current_row || a[ index_r ][ index_c ]; + IF array_length( current_row, 1 ) = c THEN + RETURN NEXT current_row; + current_row := array[]::int[]; + + END IF; + END LOOP; + END LOOP; + + RETURN; +END +$CODE$ +LANGUAGE plpgsql; -- cgit From 4560012437d1aa5816303b29b5fe3d9f5f936969 Mon Sep 17 00:00:00 2001 From: Lubos Kolouch Date: Mon, 13 Feb 2023 11:29:06 +0100 Subject: Challenge 204 Task1 LK Perl Python --- challenge-204/lubos-kolouch/perl/ch-1.pl | 38 ++++++++++++++++++++++++++++++ challenge-204/lubos-kolouch/python/ch-1.py | 32 +++++++++++++++++++++++++ 2 files changed, 70 insertions(+) create mode 100644 challenge-204/lubos-kolouch/perl/ch-1.pl create mode 100644 challenge-204/lubos-kolouch/python/ch-1.py diff --git a/challenge-204/lubos-kolouch/perl/ch-1.pl b/challenge-204/lubos-kolouch/perl/ch-1.pl new file mode 100644 index 0000000000..6a8f0f9b61 --- /dev/null +++ b/challenge-204/lubos-kolouch/perl/ch-1.pl @@ -0,0 +1,38 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +# function to check if an array is monotonic +sub is_monotonic { + my @nums = @_; + my $increasing = 1; + my $decreasing = 1; + + for (my $i = 0; $i < $#nums; $i++) { + if ($nums[$i] > $nums[$i + 1]) { + $increasing = 0; + } + if ($nums[$i] < $nums[$i + 1]) { + $decreasing = 0; + } + } + + return $increasing || $decreasing; +} + +# test cases +my @test_cases = ( + [1, 2, 3, 4, 5], + [5, 4, 3, 2, 1], + [1, 1, 1, 1, 1], + [1, 2, 3, 2, 1], + [5, 3, 2, 4, 3], +); + +foreach my $test_case (@test_cases) { + my $result = is_monotonic(@$test_case); + my $output = $result ? 1 : 0; + print "Array @$test_case is monotonic: $output\n"; +} + diff --git a/challenge-204/lubos-kolouch/python/ch-1.py b/challenge-204/lubos-kolouch/python/ch-1.py new file mode 100644 index 0000000000..e1d6f9a9a4 --- /dev/null +++ b/challenge-204/lubos-kolouch/python/ch-1.py @@ -0,0 +1,32 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- + +from typing import List + + +def is_monotonic(nums: List[int]) -> bool: + increasing = True + decreasing = True + + for i in range(len(nums) - 1): + if nums[i] > nums[i + 1]: + increasing = False + if nums[i] < nums[i + 1]: + decreasing = False + + return increasing or decreasing + + +# Test cases +test_cases = [ + [1, 2, 3, 4, 5], + [5, 4, 3, 2, 1], + [1, 1, 2, 2, 3], + [1, 2, 3, 2, 1], + [5, 3, 2, 4, 3], +] + +for test_case in test_cases: + result = is_monotonic(test_case) + output = 1 if result else 0 + print(f"Array {test_case} is monotonic: {output}") -- cgit From ce71c71ec00f5355aa481e5caee3f1e779b357cf Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 13 Feb 2023 10:34:00 +0000 Subject: Challenge 204 Solutions (Raku) --- challenge-204/mark-anderson/raku/ch-1.raku | 13 +++++++++++++ challenge-204/mark-anderson/raku/ch-2.raku | 13 +++++++++++++ 2 files changed, 26 insertions(+) create mode 100644 challenge-204/mark-anderson/raku/ch-1.raku create mode 100644 challenge-204/mark-anderson/raku/ch-2.raku diff --git a/challenge-204/mark-anderson/raku/ch-1.raku b/challenge-204/mark-anderson/raku/ch-1.raku new file mode 100644 index 0000000000..e7c4a2f3db --- /dev/null +++ b/challenge-204/mark-anderson/raku/ch-1.raku @@ -0,0 +1,13 @@ +#!/usr/bin/env raku +use Test; + +ok monotonic-array(1,2,2,3); +nok monotonic-array(1,3,2); +ok monotonic-array(6,5,5,4); + +sub monotonic-array(*@a) +{ + return 1 if [<=] @a; + return 1 if [>=] @a; + return 0 +} diff --git a/challenge-204/mark-anderson/raku/ch-2.raku b/challenge-204/mark-anderson/raku/ch-2.raku new file mode 100644 index 0000000000..da3853abe5 --- /dev/null +++ b/challenge-204/mark-anderson/raku/ch-2.raku @@ -0,0 +1,13 @@ +#!/usr/bin/env raku +use Test; + +is-deeply reshape-matrix(1, 4, [[1,2], [3,4]]), [[1,2,3,4],]; +is-deeply reshape-matrix(3, 2, [[1,2,3], [4,5,6]]), [[1,2],[3,4],[5,6]]; +nok reshape-matrix(3, 2, [[1,2]]); + +sub reshape-matrix($r, $c, @m) +{ + @m .= map(*.Slip); + return 0 if $r * $c !== @m; + @m.rotor($c).map(*.Array).Array +} -- cgit From 954b2ff314f57c9b76d07464589359ffec42f5fb Mon Sep 17 00:00:00 2001 From: Lubos Kolouch Date: Mon, 13 Feb 2023 11:36:49 +0100 Subject: Challenge 204 Task2 LK Perl Python --- challenge-204/lubos-kolouch/perl/ch-2.pl | 38 ++++++++++++++++++++++++++++++ challenge-204/lubos-kolouch/python/ch-2.py | 28 ++++++++++++++++++++++ 2 files changed, 66 insertions(+) create mode 100644 challenge-204/lubos-kolouch/perl/ch-2.pl create mode 100644 challenge-204/lubos-kolouch/python/ch-2.py diff --git a/challenge-204/lubos-kolouch/perl/ch-2.pl b/challenge-204/lubos-kolouch/perl/ch-2.pl new file mode 100644 index 0000000000..da5d85d681 --- /dev/null +++ b/challenge-204/lubos-kolouch/perl/ch-2.pl @@ -0,0 +1,38 @@ +use strict; +use warnings; + +sub reshape { + my ($matrix, $r, $c) = @_; + my $m = scalar @$matrix; + my $n = scalar @{$matrix->[0]}; + + if ($m * $n != $r * $c) { + return 0; + } + + my @result; + for my $i (0 .. $r-1) { + for my $j (0 .. $c-1) { + my $idx = $j + $i * $c; + my $x = int($idx / $n); + my $y = $idx % $n; + $result[$i][$j] = $matrix->[$x][$y]; + } + } + return \@result; +} + +my $matrix = [[1, 2], [3, 4]]; +my $r = 1; +my $c = 4; + +my $result = reshape($matrix, $r, $c); +if ($result) { + print "Reshaped matrix:\n"; + for my $row (@$result) { + print join(" ", @$row), "\n"; + } +} else { + print "Cannot reshape matrix\n"; +} + diff --git a/challenge-204/lubos-kolouch/python/ch-2.py b/challenge-204/lubos-kolouch/python/ch-2.py new file mode 100644 index 0000000000..4a49b7a544 --- /dev/null +++ b/challenge-204/lubos-kolouch/python/ch-2.py @@ -0,0 +1,28 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- + +import numpy as np +from typing import List, Union + + +def reshape(matrix: List[List[int]], r: int, + c: int) -> Union[int, List[List[int]]]: + m, n = np.shape(matrix) + if m * n != r * c: + return 0 + flat_matrix = np.array(matrix).flatten() + reshaped_matrix = np.reshape(flat_matrix, (r, c)) + return reshaped_matrix.tolist() + + +matrix = [[1, 2], [3, 4]] +r = 1 +c = 4 +result = reshape(matrix, r, c) + +if result == 0: + print("Cannot reshape matrix") +else: + print("Reshaped matrix:") + for row in result: + print(row) -- cgit From c16ee9b7cd3d443c54afe59b4665f6644c379567 Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Mon, 13 Feb 2023 11:59:50 +0100 Subject: Remove typo --- challenge-204/luca-ferrari/raku/ch-2.p6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-204/luca-ferrari/raku/ch-2.p6 b/challenge-204/luca-ferrari/raku/ch-2.p6 index 652ef3e1ec..e819c86fbb 100644 --- a/challenge-204/luca-ferrari/raku/ch-2.p6 +++ b/challenge-204/luca-ferrari/raku/ch-2.p6 @@ -27,6 +27,6 @@ sub MAIN( Int :$r, Int :$c, *@matrix ) { } } -v + @N.join( "\n" ).say; } -- cgit From 3138a686ce1d33a1b2147a893daed10e3377727e Mon Sep 17 00:00:00 2001 From: Luca Ferrari Date: Mon, 13 Feb 2023 12:05:50 +0100 Subject: Blog references --- challenge-204/luca-ferrari/blog-1.txt | 1 + challenge-204/luca-ferrari/blog-2.txt | 1 + challenge-204/luca-ferrari/blog-3.txt | 1 + challenge-204/luca-ferrari/blog-4.txt | 1 + challenge-204/luca-ferrari/blog-5.txt | 1 + challenge-204/luca-ferrari/blog-6.txt | 1 + 6 files changed, 6 insertions(+) create mode 100644 challenge-204/luca-ferrari/blog-1.txt create mode 100644 challenge-204/luca-ferrari/blog-2.txt create mode 100644 challenge-204/luca-ferrari/blog-3.txt create mode 100644 challenge-204/luca-ferrari/blog-4.txt create mode 100644 challenge-204/luca-ferrari/blog-5.txt create mode 100644 challenge-204/luca-ferrari/blog-6.txt diff --git a/challenge-204/luca-ferrari/blog-1.txt b/challenge-204/luca-ferrari/blog-1.txt new file mode 100644 index 0000000000..751ee80999 --- /dev/null +++ b/challenge-204/luca-ferrari/blog-1.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/02/13/PerlWeeklyChallenge204.html#task1 diff --git a/challenge-204/luca-ferrari/blog-2.txt b/challenge-204/luca-ferrari/blog-2.txt new file mode 100644 index 0000000000..369385b202 --- /dev/null +++ b/challenge-204/luca-ferrari/blog-2.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/02/13/PerlWeeklyChallenge204.html#task2 diff --git a/challenge-204/luca-ferrari/blog-3.txt b/challenge-204/luca-ferrari/blog-3.txt new file mode 100644 index 0000000000..68a83114ef --- /dev/null +++ b/challenge-204/luca-ferrari/blog-3.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/02/13/PerlWeeklyChallenge204.html#task1plperl diff --git a/challenge-204/luca-ferrari/blog-4.txt b/challenge-204/luca-ferrari/blog-4.txt new file mode 100644 index 0000000000..8289b48396 --- /dev/null +++ b/challenge-204/luca-ferrari/blog-4.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/02/13/PerlWeeklyChallenge204.html#task2plperl diff --git a/challenge-204/luca-ferrari/blog-5.txt b/challenge-204/luca-ferrari/blog-5.txt new file mode 100644 index 0000000000..a285e2a983 --- /dev/null +++ b/challenge-204/luca-ferrari/blog-5.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/02/13/PerlWeeklyChallenge204.html#task1plpgsql diff --git a/challenge-204/luca-ferrari/blog-6.txt b/challenge-204/luca-ferrari/blog-6.txt new file mode 100644 index 0000000000..a2e78b5d36 --- /dev/null +++ b/challenge-204/luca-ferrari/blog-6.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/02/13/PerlWeeklyChallenge204.html#task2plpgsql -- cgit From c3657efc72e3b8e4ac50cafbe6b6a391ebf96bed Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 13 Feb 2023 11:44:34 +0000 Subject: Challenge 204 Solutions (Raku) --- challenge-204/mark-anderson/raku/ch-2.raku | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/challenge-204/mark-anderson/raku/ch-2.raku b/challenge-204/mark-anderson/raku/ch-2.raku index da3853abe5..2591183a00 100644 --- a/challenge-204/mark-anderson/raku/ch-2.raku +++ b/challenge-204/mark-anderson/raku/ch-2.raku @@ -7,7 +7,6 @@ nok reshape-matrix(3, 2, [[1,2]]); sub reshape-matrix($r, $c, @m) { - @m .= map(*.Slip); - return 0 if $r * $c !== @m; - @m.rotor($c).map(*.Array).Array + return 0 unless $r * $c == @m * @m.head; + @m.map(*.Slip).rotor($c).map(*.Array).Array } -- cgit From f51b5c00f93bdde4240d55d8e237e3694f079e65 Mon Sep 17 00:00:00 2001 From: Andrew Shitov Date: Mon, 13 Feb 2023 15:25:26 +0100 Subject: Solutions Week 204 by ash and ChatGPT --- challenge-204/ash/blog-1.txt | 1 + challenge-204/ash/blog-2.txt | 1 + challenge-204/ash/raku/ch-1.raku | 23 +++++++++++++++ challenge-204/ash/raku/ch-2.raku | 48 +++++++++++++++++++++++++++++++ challenge-204/chatgpt/README | 7 +++++ challenge-204/chatgpt/blog-1.txt | 1 + challenge-204/chatgpt/blog-2.txt | 1 + challenge-204/chatgpt/raku/ch-1.raku | 33 +++++++++++++++++++++ challenge-204/chatgpt/raku/ch-2.raku | 56 ++++++++++++++++++++++++++++++++++++ 9 files changed, 171 insertions(+) create mode 100644 challenge-204/ash/blog-1.txt create mode 100644 challenge-204/ash/blog-2.txt create mode 100644 challenge-204/ash/raku/ch-1.raku create mode 100644 challenge-204/ash/raku/ch-2.raku create mode 100644 challenge-204/chatgpt/README create mode 100644 challenge-204/chatgpt/blog-1.txt create mode 100644 challenge-204/chatgpt/blog-2.txt create mode 100644 challenge-204/chatgpt/raku/ch-1.raku create mode 100644 challenge-204/chatgpt/raku/ch-2.raku diff --git a/challenge-204/ash/blog-1.txt b/challenge-204/ash/blog-1.txt new file mode 100644 index 0000000000..59e520d49a --- /dev/null +++ b/challenge-204/ash/blog-1.txt @@ -0,0 +1 @@ +https://andrewshitov.com/2023/02/13/dialogues-with-chatpgp-about-the-raku-programming-languages-solving-the-weekly-challange-204/ diff --git a/challenge-204/ash/blog-2.txt b/challenge-204/ash/blog-2.txt new file mode 100644 index 0000000000..8fabcdca67 --- /dev/null +++ b/challenge-204/ash/blog-2.txt @@ -0,0 +1 @@ +https://andrewshitov.com/2023/02/13/solving-task-2-of-the-weekly-challenge-204-with-the-help-of-chatgpt/ diff --git a/challenge-204/ash/raku/ch-1.raku b/challenge-204/ash/raku/ch-1.raku new file mode 100644 index 0000000000..ad2c0b4410 --- /dev/null +++ b/challenge-204/ash/raku/ch-1.raku @@ -0,0 +1,23 @@ +# A Raku solution to the Task 1 "Monotonic Array" of the Weekly Challenge 204 +# https://theweeklychallenge.org/blog/perl-weekly-challenge-204/#TASK1 +# Solved together with ChatGPT, the dialogue published at +# https://andrewshitov.com/2023/02/13/dialogues-with-chatpgp-about-the-raku-programming-languages-solving-the-weekly-challange-204/ + +# Test run: +# $ raku ch-1.raku +# 1 +# 0 +# 1 + +sub is-monotonic(@nums) { + [>=] @nums or [<=] @nums +} + +my @nums = (1, 2, 2, 3); +say +is-monotonic(@nums); + +@nums = (1, 3, 2); +say +is-monotonic(@nums); + +@nums = (6, 5, 5, 4); +say +is-monotonic(@nums); diff --git a/challenge-204/ash/raku/ch-2.raku b/challenge-204/ash/raku/ch-2.raku new file mode 100644 index 0000000000..e6a2b13241 --- /dev/null +++ b/challenge-204/ash/raku/ch-2.raku @@ -0,0 +1,48 @@ +# A Raku solution to the Task 2 "Reshape Matrix" of the Weekly Challenge 204 +# https://theweeklychallenge.org/blog/perl-weekly-challenge-204/#TASK2 +# Solved together with ChatGPT. The whole dialogue with the machine is published in my blog: +# https://andrewshitov.com/2023/02/13/solving-task-2-of-the-weekly-challenge-204-with-the-help-of-chatgpt/ + +# Test run: +# $ raku ch-2.raku +# [1 2 3 4] +# [[1 2] [3 4] [5 6]] +# [[1] [2]] +# 0 + +sub reshape-matrix (@matrix, $r, $c) { + my @flat = @matrix.map(*.flat).flat; + my $total_elements = @flat.elems; + return 0 if $total_elements != $r * $c; + + my @result; + for ^$r -> $i { + push @result, [@flat[$c * $i .. $c * $i + $c - 1]]; + } + + return @result.elems == 1 ?? @result[0] !! @result; +} + +my @matrix = [ [ 1, 2 ], [ 3, 4 ] ]; +my $r = 1; +my $c = 4; +my $result = reshape-matrix(@matrix, $r, $c); +say $result; + +@matrix = [ [ 1, 2, 3 ], [ 4, 5, 6 ] ]; +$r = 3; +$c = 2; +$result = reshape-matrix(@matrix, $r, $c); +say $result; + +@matrix = [ [ 1 ], [ 2 ] ]; +$r = 2; +$c = 1; +$result = reshape-matrix(@matrix, $r, $c); +say $result; + +@matrix = [ [ 1, 2, 3 ], [ 4, 5, 6 ] ]; +$r = 2; +$c = 4; +$result = reshape-matrix(@matrix, $r, $c); +say $result; diff --git a/challenge-204/chatgpt/README b/challenge-204/chatgpt/README new file mode 100644 index 0000000000..7735e06a24 --- /dev/null +++ b/challenge-204/chatgpt/README @@ -0,0 +1,7 @@ +Solutions generated by ChatGPT. + +The solutions are based on the description and the examples that the Weekly Challenge offers. It was sent to the chat as they are published on the website without any modifications. + +The solution located in this directory are the first versions that ChatGPT generated. The code is taken as soon as it compiles and gives correct results. Optimised versions with a more natural Raku syntax are placed at ../ash. All those were also done in a dialogue with the machine with some hints from a human. + +Submitted by Andrew Shitov (ash). diff --git a/challenge-204/chatgpt/blog-1.txt b/challenge-204/chatgpt/blog-1.txt new file mode 100644 index 0000000000..59e520d49a --- /dev/null +++ b/challenge-204/chatgpt/blog-1.txt @@ -0,0 +1 @@ +https://andrewshitov.com/2023/02/13/dialogues-with-chatpgp-about-the-raku-programming-languages-solving-the-weekly-challange-204/ diff --git a/challenge-204/chatgpt/blog-2.txt b/challenge-204/chatgpt/blog-2.txt new file mode 100644 index 0000000000..8fabcdca67 --- /dev/null +++ b/challenge-204/chatgpt/blog-2.txt @@ -0,0 +1 @@ +https://andrewshitov.com/2023/02/13/solving-task-2-of-the-weekly-challenge-204-with-the-help-of-chatgpt/ diff --git a/challenge-204/chatgpt/raku/ch-1.raku b/challenge-204/chatgpt/raku/ch-1.raku new file mode 100644 index 0000000000..cbc18bdd63 --- /dev/null +++ b/challenge-204/chatgpt/raku/ch-1.raku @@ -0,0 +1,33 @@ +# This program has been created by ChatGPT +# +# Test run: +# $ raku ch-1.raku +# 1 +# 0 +# 1 + +sub is_monotonic(@nums) { + my $increasing = True; + my $decreasing = True; + for (0 ..^ @nums.end) -> $i { + for ($i + 1 .. @nums.end) -> $j { + if (@nums[$i] > @nums[$j]) { + $increasing = False; + } + if (@nums[$i] < @nums[$j]) { + $decreasing = False; + } + } + } + return 1 if $increasing || $decreasing; + return 0; + } + +my @nums = (1, 2, 2, 3); +say is_monotonic(@nums); + +@nums = (1, 3, 2); +say is_monotonic(@nums); + +@nums = (6, 5, 5, 4); +say is_monotonic(@nums); diff --git a/challenge-204/chatgpt/raku/ch-2.raku b/challenge-204/chatgpt/raku/ch-2.raku new file mode 100644 index 0000000000..20375d1164 --- /dev/null +++ b/challenge-204/chatgpt/raku/ch-2.raku @@ -0,0 +1,56 @@ +# This program has been created by ChatGPT +# +# Test run: +# $ raku ch-2.raku +# [1 2 3 4] +# [[1 2] [3 4] [5 6]] +# [[1] [2]] +# +# Notice that if you change $r and $c to 3 and 2 in the last example, +# the program prints 0 as expected. + +sub reshape-matrix (@matrix, $r, $c) { + my $total_elements = 0; + for @matrix -> @row { + $total_elements += @row.elems; + } + if $total_elements != $r * $c { + return 0; + } + + my @result = []; + my $element_index = 0; + for (0 .. $r - 1) -> $i { + my @new_row = []; + for (0 .. $c - 1) -> $j { + @new_row.push(@matrix[$element_index div @matrix[0].elems][$element_index % @matrix[0].elems]); + $element_index++; + } + @result.push(@new_row); + } + + if @result.elems == 1 { + return @result[0]; + } + else { + return @result; + } +} + +my @matrix = [ [ 1, 2 ], [ 3, 4 ] ]; +my $r = 1; +my $c = 4; +my $result = reshape-matrix(@matrix, $r, $c); +say $result; + +@matrix = [ [ 1, 2, 3 ], [ 4, 5, 6 ] ]; +$r = 3; +$c = 2; +$result = reshape-matrix(@matrix, $r, $c); +say $result; + +@matrix = [ [ 1 ], [ 2 ] ]; +$r = 2; +$c = 1; +$result = reshape-matrix(@matrix, $r, $c); +say $result; -- cgit From f129cbf6732d8d404459006777cf213024a3fe21 Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Mon, 13 Feb 2023 11:11:16 -0600 Subject: Solve PWC204 --- challenge-204/wlmb/blog.txt | 2 ++ challenge-204/wlmb/perl/ch-1.pl | 25 +++++++++++++++++++++++++ challenge-204/wlmb/perl/ch-2.pl | 22 ++++++++++++++++++++++ 3 files changed, 49 insertions(+) create mode 100644 challenge-204/wlmb/blog.txt create mode 100755 challenge-204/wlmb/perl/ch-1.pl create mode 100755 challenge-204/wlmb/perl/ch-2.pl diff --git a/challenge-204/wlmb/blog.txt b/challenge-204/wlmb/blog.txt new file mode 100644 index 0000000000..da9fde3295 --- /dev/null +++ b/challenge-204/wlmb/blog.txt @@ -0,0 +1,2 @@ +https://wlmb.github.io/2023/02/13/PWC204/ + diff --git a/challenge-204/wlmb/perl/ch-1.pl b/challenge-204/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..66cc937e71 --- /dev/null +++ b/challenge-204/wlmb/perl/ch-1.pl @@ -0,0 +1,25 @@ +#!/usr/bin/env perl +# Perl weekly challenge 204 +# Task 1: Monotonic Array +# +# See https://wlmb.github.io/2023/02/13/PWC204/#task-1-monotonic-array +use v5.36; +die <<~"FIN" unless @ARGV; + Usage: $0 N1 [N2...] + to test if the sequence N1 N2... is monotonic + FIN +my @orig=@ARGV; +my $current=shift; +my ($increasing, $decreasing); +for(@ARGV){ + $_>$current and $increasing=1; + $_<$current and $decreasing=1; + last if $increasing and $decreasing; # shortcut if non monotonic + $current=$_; +} +my ($result, $reason)= + $increasing && $decreasing?(0, "Non-monotonic"): + $increasing ?(1, "Non-decreasing"): + $decreasing ?(1, "Non-increasing"): + (1, "Constant"); +say join " ", @orig, "->", $result, $reason; diff --git a/challenge-204/wlmb/perl/ch-2.pl b/challenge-204/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..af92096064 --- /dev/null +++ b/challenge-204/wlmb/perl/ch-2.pl @@ -0,0 +1,22 @@ +#!/usr/bin/env perl +# Perl weekly challenge 204 +# Task 2: Reshape Matrix +# +# See https://wlmb.github.io/2023/02/13/PWC204/#task-2-reshape-matrix +use v5.36; +use PDL; +die <<~"FIN" unless @ARGV==3; + Usage: $0 M r c + to convert matrix M (a string using PDL's notation) + to a matrix with r rows, c columns + FIN +my $M=pdl shift; +my ($rows, $cols)=@ARGV; +my $nelem=$M->nelem; # total number of elements +my $desired=$rows*$cols; +say("$M cannot be reshaped to $rows rows and $cols columns: 0"), exit + unless $desired==$nelem; +my $N=$M->copy; +$N->reshape($cols) if $rows==1; # 1D row vector +$N->reshape($cols, $rows) if $rows!=1; #2D matrix +say "$M as $rows x $cols matrix becomes $N" -- cgit From 69ea84efc8bf5c206240a823fa10950337d54499 Mon Sep 17 00:00:00 2001 From: Thomas Köhler Date: Mon, 13 Feb 2023 20:34:59 +0100 Subject: Add solution 204 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Thomas Köhler --- challenge-204/jeanluc2020/blog-1.txt | 1 + challenge-204/jeanluc2020/blog-2.txt | 1 + challenge-204/jeanluc2020/perl/ch-1.pl | 86 +++++++++++++++++++++ challenge-204/jeanluc2020/perl/ch-2.pl | 136 +++++++++++++++++++++++++++++++++ 4 files changed, 224 insertions(+) create mode 100644 challenge-204/jeanluc2020/blog-1.txt create mode 100644 challenge-204/jeanluc2020/blog-2.txt create mode 100755 challenge-204/jeanluc2020/perl/ch-1.pl create mode 100755 challenge-204/jeanluc2020/perl/ch-2.pl diff --git a/challenge-204/jeanluc2020/blog-1.txt b/challenge-204/jeanluc2020/blog-1.txt new file mode 100644 index 0000000000..ecda755aca --- /dev/null +++ b/challenge-204/jeanluc2020/blog-1.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-204-1.html diff --git a/challenge-204/jeanluc2020/blog-2.txt b/challenge-204/jeanluc2020/blog-2.txt new file mode 100644 index 0000000000..b687d7ff97 --- /dev/null +++ b/challenge-204/jeanluc2020/blog-2.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-204-2.html diff --git a/challenge-204/jeanluc2020/perl/ch-1.pl b/challenge-204/jeanluc2020/perl/ch-1.pl new file mode 100755 index 0000000000..c4db878e83 --- /dev/null +++ b/challenge-204/jeanluc2020/perl/ch-1.pl @@ -0,0 +1,86 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-204/#TASK1 +# Task 1: Monotonic Array +# +# You are given an array of integers. +# +# Write a script to find out if the given array is Monotonic. Print 1 if it is otherwise 0. +# +## An array is Monotonic if it is either monotone increasing or decreasing. +# +## Monotone increasing: for i <= j , nums[i] <= nums[j] +## Monotone decreasing: for i <= j , nums[i] >= nums[j] +# +# +## Example 1 +## +## Input: @nums = (1,2,2,3) +## Output: 1 +# +## Example 2 +## +## Input: @nums (1,3,2) +## Output: 0 +# +## Example 3 +## +## Input: @nums = (6,5,5,4) +## Output: 1 +# +############################################################ +## +## discussion +## +############################################################ +# +# While walking the array we have to check in each step if +# we're still monotone. In order to achieve this we need to +# know if we're monotone increasing or monotone decreasing +# so far (or still constant, in which case both are still +# possible). If we were increasing and switch to decreasing +# or vice versa the whole array is not monotone and we can +# return 0 right away. If we reach the end of the array +# without any such switch we are monotone and can return 1. + +use strict; +use warnings; + +my @examples = ( + [1, 2, 2, 3], + [1, 3, 2], + [6, 5, 5, 4] +); + +foreach my $nums (@examples) { + print "Input: (" . join(", ", @$nums) . ")\n"; + print "Output: " . is_monotone(@$nums) . "\n"; +} + +# given an array, return 1 if it is monotone and 0 otherwise +sub is_monotone { + # put the first element of the array into $last, the rest into @nums + my ($last, @nums) = @_; + my $direction = 0; # so far we're neither increasing nor decreasing + foreach my $elem (@nums) { + if($direction > 0) { # we're monotone increasing so far + if($elem < $last) { + # we're no longer monotone + return 0; + } + } elsif ($direction < 0) { # we're monotone decreasing so far + if($elem > $last) { + # we're no longer monotone + return 0; + } + } else { # still constant, we can still be increasing or decreasing + if($elem > $last) { + $direction = 1; # now we know we're increasing + } elsif ($elem < $last) { + $direction = -1; # now we know we're decreasing + } + } + # make sure we have $last set to the previous element in the next step + $last = $elem; + } + return 1; +} diff --git a/challenge-204/jeanluc2020/perl/ch-2.pl b/challenge-204/jeanluc2020/perl/ch-2.pl new file mode 100755 index 0000000000..a4f679bc6f --- /dev/null +++ b/challenge-204/jeanluc2020/perl/ch-2.pl @@ -0,0 +1,136 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-204/#TASK2 +# +# Task 2: Reshape Matrix +# +# You are given a matrix (m x n) and two integers (r) and (c). +# +# Write a script to reshape the given matrix in form (r x c) with the original +# value in the given matrix. If you can’t reshape print 0. +# +## Example 1 +## +## Input: [ 1 2 ] +## [ 3 4 ] +## +## $matrix = [ [ 1, 2 ], [ 3, 4 ] ] +## $r = 1 +## $c = 4 +## +## Output: [ 1 2 3 4 ] +# +## Example 2 +## +## Input: [ 1 2 3 ] +## [ 4 5 6 ] +## +## $matrix = [ [ 1, 2, 3 ] , [ 4, 5, 6 ] ] +## $r = 3 +## $c = 2 +## +## Output: [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ] +## +## [ 1 2 ] +## [ 3 4 ] +## [ 5 6 ] +# +## Example 3 +## +## Input: [ 1 2 ] +## +## $matrix = [ [ 1, 2 ] ] +## $r = 3 +## $c = 2 +## +## Output: 0 +# +############################################################ +## +## discussion +## +############################################################ +# +# So first we check our input to find m and n from our (m x n) matrix. +# If then m*n != $r * $c we can return 0 right away. +# Otherwise, flatten the matrix and select $r arrays of $c elements +# as the new matrix. +# +use strict; +use warnings; + +my @examples = ( + [ [ [ 1, 2 ], [ 3, 4 ] ], 1, 4 ], + [ [ [ 1, 2, 3 ], [ 4, 5, 6] ], 3, 2], + [ [ [ 1, 2 ] ], 3, 2] +); +foreach my $example (@examples) { + my ($matrix, $r, $c) = @$example; + print_reshaped_matrix($matrix, $r, $c); +} + +# given the matrix, $r and $c let's reshape the matrix +sub print_reshaped_matrix { + my ($matrix, $r, $c) = @_; + # print the input matrix first + print "Input:\n"; + print_matrix($matrix); + # fetch the individual arrays from the matrix and + # calculate m and n + my @arrays = @$matrix; + my $n = scalar(@arrays); + my $m = scalar(@{$arrays[0]}); + # sanity check to see whether this is actually a matrix + foreach my $array (@arrays) { + die "Not a matrix" if scalar(@$array) != $m; + } + # m*n != $r*$c => we can't create the output matrix, exit immediately + if ($r*$c != $m*$n) { + print "Output: 0\n"; + return; + } + # flatten the matrix + my @elements = flatten($matrix); + my @result = (); + # calculate the arrays for the target matrix + foreach my $index (0..$r-1) { + # calculate the current slice. It starts at $index * $c, + # while the end is one less than the beginning of the next + # slice (or the end of data) + my $start = $index * $c; + my $end = ($index+1) * $c - 1; + # get the slice and push it onto the result matrix + my @tmp = @elements[$start..$end]; + push @result, [ @tmp ]; + } + # print the output + print "Output:\n"; + print_matrix(\@result); +} + +# flatten a matrix into an array +sub flatten { + my $matrix = shift; + my @elements = (); + foreach my $array (@$matrix) { + push @elements, @$array; + } + return @elements; +} + +# print a given matrix +sub print_matrix { + my $matrix = shift; + my $first = 1; + print "[ " unless scalar(@$matrix) == 1; + foreach my $array (@$matrix) { + if($first) { + $first = 0; + } else { + print " , "; + } + print "[ " . join(", ", @$array) . " ]"; + } + print " ]" unless scalar(@$matrix) == 1; + print "\n"; +} + -- cgit From af7c882a4b596eb5cfad61f6195d76d1faca4cce Mon Sep 17 00:00:00 2001 From: Matthew Neleigh Date: Mon, 13 Feb 2023 16:16:07 -0500 Subject: new file: challenge-204/mattneleigh/perl/ch-1.pl new file: challenge-204/mattneleigh/perl/ch-2.pl --- challenge-204/mattneleigh/perl/ch-1.pl | 88 ++++++++++++++++++ challenge-204/mattneleigh/perl/ch-2.pl | 160 +++++++++++++++++++++++++++++++++ 2 files changed, 248 insertions(+) create mode 100755 challenge-204/mattneleigh/perl/ch-1.pl create mode 100755 challenge-204/mattneleigh/perl/ch-2.pl diff --git a/challenge-204/mattneleigh/perl/ch-1.pl b/challenge-204/mattneleigh/perl/ch-1.pl new file mode 100755 index 0000000000..058e9a7c6e --- /dev/null +++ b/challenge-204/mattneleigh/perl/ch-1.pl @@ -0,0 +1,88 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @arrays = ( + # Given cases + [ 1, 2, 2, 3 ], + [ 1, 3, 2 ], + [ 6, 5, 5, 4 ], + + # Additional test cases + [ 2, 2, 2, 4 ], + [ 2, 2, 2, 0 ], + [ 4, 2, 2, 2 ], + [ 0, 2, 2, 2 ] +); + +print("\n"); +foreach my $array (@arrays){ + printf( + "Input: \@nums = (%s)\nOutput: %d\n\n", + join(", ", @{$array}), + array_is_monotonic(@{$array}) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Determine whether an array of numbers is monotonic- that is to say: +# for every i <= j, array[i] <= array[j] (monotone increasing) +# - OR - +# for every i <= j, array[i] >= array[j] (monotone decreasing) +# Takes one argument: +# * The list to examine +# Returns: +# * 1 if the array is monotoni