aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStephen Lynn <bizlsg@localhost.localdomain>2023-05-01 17:35:35 +0800
committerStephen Lynn <bizlsg@localhost.localdomain>2023-05-01 17:35:35 +0800
commit0371e1546e272ffdf9c4db83ab2fe8bdf1d39943 (patch)
tree728ead6f36d7681e59ca1e7d4974ff6cba047ec9
parentcd1cf9c3a97571dca788b4e1a0c5ce74c05927ef (diff)
downloadperlweeklychallenge-club-0371e1546e272ffdf9c4db83ab2fe8bdf1d39943.tar.gz
perlweeklychallenge-club-0371e1546e272ffdf9c4db83ab2fe8bdf1d39943.tar.bz2
perlweeklychallenge-club-0371e1546e272ffdf9c4db83ab2fe8bdf1d39943.zip
challenge 215
-rwxr-xr-xchallenge-215/steve-g-lynn/perl/ch-1.pl31
-rwxr-xr-xchallenge-215/steve-g-lynn/perl/ch-2.pl46
2 files changed, 77 insertions, 0 deletions
diff --git a/challenge-215/steve-g-lynn/perl/ch-1.pl b/challenge-215/steve-g-lynn/perl/ch-1.pl
new file mode 100755
index 0000000000..3a8107d6d1
--- /dev/null
+++ b/challenge-215/steve-g-lynn/perl/ch-1.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/env -S perl -wl
+
+#-- this script conforms to perl 4 syntax as specified
+#-- in the 1st edition of Programming perl (pink camel)
+#
+
+local *odd_one_out = sub {
+ local (@words)=@_;
+
+ local *is_sorted = sub { #not idiomatic but I prefer readable
+ local ($string)=@_;
+ local $chk=join('',sort {$a cmp $b} split(//,$string));
+ return ($string eq $chk);
+ };
+
+ local ($ctr, $word, @retval); $ctr=0;
+ for $word (@words) {
+ if (&is_sorted($word)) {
+ push @retval, $word;
+ }
+ else {
+ $ctr++;
+ }
+ }
+ print $ctr;
+ return @retval;
+};
+
+print &odd_one_out('abc','xyz','tsu');
+print &odd_one_out('rat','cab','dad');
+print &odd_one_out('x','y','z');
diff --git a/challenge-215/steve-g-lynn/perl/ch-2.pl b/challenge-215/steve-g-lynn/perl/ch-2.pl
new file mode 100755
index 0000000000..d3961b9789
--- /dev/null
+++ b/challenge-215/steve-g-lynn/perl/ch-2.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env -S perl -wl
+
+#this script conforms to perl 4 syntax
+#as specified in Programming perl 1st edition (the pink camel)
+
+local *number_placement=sub {
+ local ($count, @numbers)=@_;
+
+ #-- helper sub-subs
+ local *is_conformant = sub { #-- all inputs 0 or 1 ?
+ local (@numbers) = @_;
+ local $number;
+
+ for $number (@numbers) {
+ ($number =~ /^0$/ || $number =~ /^1$/) || die "Non-conformant input";
+ }
+ };
+
+ local *has_1_neighbor = sub {
+ local ($indx)=@_;
+
+ ( ($indx > 0) && ($numbers[$indx-1] =~ /^1$/) )
+ ||
+ ( ($indx < @numbers-1) && ($numbers[$indx+1] =~ /^1$/ ));
+ };
+
+ #-- back to the main part of the subroutine
+ &is_conformant( @numbers );
+
+ local ($indx,$ctr);
+ $ctr=0;
+
+ for $indx (0 .. @numbers-1) {
+ ( ($numbers[$indx] =~ /^0$/) && (!(&has_1_neighbor($indx))) )
+ && ($ctr++);
+
+ last if ($ctr >= $count);
+ }
+
+ ($ctr >= $count) ? 1 : 0;
+};
+
+print &number_placement(1,1,0,0,0,1);
+print &number_placement(2,1,0,0,0,1);
+print &number_placement(3,1,0,0,0,0,0,0,0,1);
+