aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-333/bob-lied/README.md6
-rw-r--r--challenge-333/bob-lied/ch-1.pl61
-rw-r--r--challenge-333/bob-lied/ch-2.pl120
3 files changed, 184 insertions, 3 deletions
diff --git a/challenge-333/bob-lied/README.md b/challenge-333/bob-lied/README.md
index 638a1c686d..111cb8efef 100644
--- a/challenge-333/bob-lied/README.md
+++ b/challenge-333/bob-lied/README.md
@@ -1,5 +1,5 @@
-# Solutions to weekly challenge 332 by Bob Lied
+# Solutions to weekly challenge 333 by Bob Lied
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-332/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-332/bob-lied)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-333/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-333/bob-lied)
[Blog](https://dev.to/boblied/pwc-331-332-odd-last-date-letters-binary-word-list-buddy-ib6)
diff --git a/challenge-333/bob-lied/ch-1.pl b/challenge-333/bob-lied/ch-1.pl
new file mode 100644
index 0000000000..b049e22a70
--- /dev/null
+++ b/challenge-333/bob-lied/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 333 Task 1 Straight Line
+#=============================================================================
+# You are given a list of co-ordinates. Write a script to find out if the
+# given points make a straight line.
+# Example 1 Input: @list = ([2, 1], [2, 3], [2, 5])
+# Output: true
+# Example 2 Input: @list = ([1, 4], [3, 4], [10, 4])
+# Output: true
+# Example 3 Input: @list = ([0, 0], [1, 1], [2, 3])
+# Output: false
+# Example 4 Input: @list = ([1, 1], [1, 1], [1, 1])
+# Output: true
+# Example 5 Input: @list = ([1000000, 1000000], [2000000, 2000000], [3000000, 3000000])
+# Output: true
+#=============================================================================
+
+use v5.42;
+
+
+use Getopt::Long;
+my $DoTest = false;
+
+GetOptions("test" => \$DoTest);
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+
+# Use as ch-1.pl 1,1 2,2 3,3
+
+my @point = map { [split ',', $_] } @ARGV;
+die "Need three points" unless @point == 3;
+
+say isLine(@point) ? "true" : "false";
+
+#=============================================================================
+## https://math.stackexchange.com/questions/701862/how-to-find-if-the-points-fall-in-a-straight-line-or-not
+sub isLine(@point)
+{
+ my @x = map { $_->[0] } @point;
+ my @y = map { $_->[1] } @point;
+
+ return ($y[1] - $y[0]) * ( $x[2] - $x[0] ) == ( $y[2] - $y[0] ) * ( $x[1] - $x[0] )
+}
+
+sub runTest
+{
+ use Test2::V0;
+
+ is( isLine( [2,1],[2,3],[ 2,5] ), true, "Example 1");
+ is( isLine( [1,4],[3,4],[10,4] ), true, "Example 2");
+ is( isLine( [0,0],[1,1],[ 2,3] ), false, "Example 3");
+ is( isLine( [1,1],[1,1],[ 1,1] ), true, "Example 4");
+ is( isLine( [1000000, 1000000], [2000000, 2000000], [3000000, 3000000] ), true, "Example 5");
+
+ done_testing;
+}
diff --git a/challenge-333/bob-lied/ch-2.pl b/challenge-333/bob-lied/ch-2.pl
new file mode 100644
index 0000000000..d05efc9a27
--- /dev/null
+++ b/challenge-333/bob-lied/ch-2.pl
@@ -0,0 +1,120 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 333 Task 2 Duplicate Zeroes
+#=============================================================================
+# You are given an array of integers. Write a script to duplicate each
+# occurrence of zero, shifting the remaining elements to the right.
+# The elements beyond the length of the original array are not written.
+# Example 1 Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
+# Output: (1, 0, 0, 2, 3, 0, 0, 4)
+# Each zero is duplicated.
+# Elements beyond the original length (like 5 and last 0) are discarded.
+# Example 2 Input: @ints = (1, 2, 3)
+# Output: (1, 2, 3)
+# No zeros exist, so the array remains unchanged.
+# Example 3 Input: @ints = (1, 2, 3, 0)
+# Output: (1, 2, 3, 0)
+# Example 4 Input: @ints = (0, 0, 1, 2)
+# Output: (0, 0, 0, 0)
+# Example 5 Input: @ints = (1, 2, 0, 3, 4)
+# Output: (1, 2, 0, 0, 3)
+#=============================================================================
+
+use v5.42;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+ use Log::Log4perl qw(:easy);
+ Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+ layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+ $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say '(', join(", ", dupSplice(@ARGV)->@*), ')';
+# say '(', join(", ", dupCut(@ARGV)->@*), ')';
+#say '(', join(", ", duplicateZero(@ARGV)->@*), ')';
+
+#=============================================================================
+sub duplicateZero(@int)
+{
+ my @out;
+ my $length = @int;
+ while ( defined(my $n = shift @int) && @out < $length)
+ {
+ push @out, $n;
+ push @out, 0 if $n == 0 && @out < $length;
+ }
+ return \@out;
+}
+
+sub dupCut(@int)
+{
+ my @out = map { $_ == 0 ? (0,0) : ($_) } @int;
+ splice(@out, scalar(@int) );
+ return \@out;
+}
+
+sub dupSplice(@int)
+{
+ my $length = @int;
+ for ( reverse 0 .. $#int )
+ {
+ splice(@int, $_, 1, 0,0) if $int[$_] == 0;
+ }
+ splice(@int, $length);
+ return \@int;
+}
+
+sub runTest
+{
+ use Test2::V0;
+
+ is( duplicateZero( 1,0,2,3,0,4,5,0), [1,0,0,2,3,0,0,4], "Example 1");
+ is( duplicateZero( 1,2,3 ), [1,2,3 ], "Example 2");
+ is( duplicateZero( 1,2,3,0 ), [1,2,3,0 ], "Example 3");
+ is( duplicateZero( 0,0,1,2 ), [0,0,0,0 ], "Example 4");
+ is( duplicateZero( 1,2,0,3,4 ), [1,2,0,0,3 ], "Example 5");
+
+ is( dupCut( 1,0,2,3,0,4,5,0), [1,0,0,2,3,0,0,4], "Example 1 cut");
+ is( dupCut( 1,2,3 ), [1,2,3 ], "Example 2 cut");
+ is( dupCut( 1,2,3,0 ), [1,2,3,0 ], "Example 3 cut");
+ is( dupCut( 0,0,1,2 ), [0,0,0,0 ], "Example 4 cut");
+ is( dupCut( 1,2,0,3,4 ), [1,2,0,0,3 ], "Example 5 cut");
+
+ is( dupSplice( 1,0,2,3,0,4,5,0), [1,0,0,2,3,0,0,4], "Example 1 splice");
+ is( dupSplice( 1,2,3 ), [1,2,3 ], "Example 2 splice");
+ is( dupSplice( 1,2,3,0 ), [1,2,3,0 ], "Example 3 splice");
+ is( dupSplice( 0,0,1,2 ), [0,0,0,0 ], "Example 4 splice");
+ is( dupSplice( 1,2,0,3,4 ), [1,2,0,0,3 ], "Example 5 splice");
+
+ done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+ use Benchmark qw/cmpthese/;
+
+ my @int = map { int(rand(20)) + 1 } 1 .. 100;
+ $int[$_] = 0 for map { int(rand(100)) } 1..10;
+ # my @int = (0) x 100;
+
+ cmpthese($repeat, {
+ copy => sub { duplicateZero(@int) },
+ cut => sub { dupCut(@int) },
+ splice => sub { dupSplice(@int) },
+ });
+}
generated by cgit (git 2.34.1) at 2026-04-12 23:47:45 +0000