aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Köhler <jean-luc@picard.franken.de>2022-11-28 20:16:30 +0100
committerThomas Köhler <jean-luc@picard.franken.de>2022-11-28 20:16:30 +0100
commitd65084c940d7b0e1f89040fee98fa7b1682de1c9 (patch)
tree02ec37e078b78a73131325ee0fdd33c57a0e77f5
parented24be5652a8686c1fd5d68abed68895caf6300c (diff)
downloadperlweeklychallenge-club-d65084c940d7b0e1f89040fee98fa7b1682de1c9.tar.gz
perlweeklychallenge-club-d65084c940d7b0e1f89040fee98fa7b1682de1c9.tar.bz2
perlweeklychallenge-club-d65084c940d7b0e1f89040fee98fa7b1682de1c9.zip
Add solution for challenge 193.
Signed-off-by: Thomas Köhler <jean-luc@picard.franken.de>
-rw-r--r--challenge-193/jeanluc2020/README1
-rwxr-xr-xchallenge-193/jeanluc2020/perl/ch-1.pl42
-rwxr-xr-xchallenge-193/jeanluc2020/perl/ch-2.pl48
3 files changed, 91 insertions, 0 deletions
diff --git a/challenge-193/jeanluc2020/README b/challenge-193/jeanluc2020/README
new file mode 100644
index 0000000000..dc4fdaef43
--- /dev/null
+++ b/challenge-193/jeanluc2020/README
@@ -0,0 +1 @@
+Solution by Thomas Köhler
diff --git a/challenge-193/jeanluc2020/perl/ch-1.pl b/challenge-193/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..5e597c93ef
--- /dev/null
+++ b/challenge-193/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+# task1.pl
+
+use warnings;
+use strict;
+
+my $input = $ARGV[0];
+$input //= 2;
+
+my $LENGTH = 0;
+my $MAX_WIDTH = 80;
+
+print_binaries("", $input);
+# Add a newline at the end, but "delete" the ", " and the end of the last string
+print " \n" if $input; # No need to print "\n" if $input is 0
+
+# we recursively create all possible binary numbers. Once hitting a leaf, we
+# print the current number and return to the caller
+# This way, we go recursively to a depth that's one more than the length we
+# provide as input (remaining length of 0 is used to indicate we reached a leaf)
+sub print_binaries {
+ my $current_string = shift;
+ my $remaining_digits = shift;
+ unless ($remaining_digits) {
+ # $remaining_digits is 0, so we can print what we have
+ # in $current_string and return.
+ # In case we're longer than $MAX_WIDTH, we print a "\n"
+ # first and then reset $LENGTH
+ $LENGTH += length("$current_string, ");
+ if ($LENGTH > $MAX_WIDTH) {
+ print "\n";
+ $LENGTH = length("$current_string, ");
+ }
+ print "$current_string, ";
+ return;
+ }
+ # We still have some remaining digits to go, so
+ # recursively walk down for each possible digit
+ foreach my $digit ( 0..1 ) {
+ print_binaries("$current_string$digit", $remaining_digits-1);
+ }
+}
diff --git a/challenge-193/jeanluc2020/perl/ch-2.pl b/challenge-193/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..abfc52b42c
--- /dev/null
+++ b/challenge-193/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+# task2.pl
+#
+
+use warnings;
+use strict;
+use Data::Dumper;
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+
+my @s = ("adc", "wzy", "abc");
+find_odd(@s);
+@s = ("aaa", "bob", "ccc", "ddd");
+find_odd(@s);
+
+# Given an array of strings, let's find the odd one
+sub find_odd {
+ my @s = @_;
+ my $len = length($s[0]);
+ my $result;
+ foreach my $string (@s) {
+ # Just making sure all input strings share the same length
+ die "Not all strings are of the same length!\n" if length($string) != $len;
+ my @chars = split //,$string;
+ my @diffs = ();
+ # As long as we have at least two characters left, remove the first and
+ # calculate the difference of the second and the first
+ # Push the result onto another array
+ while(scalar(@chars) > 1) {
+ my $c = shift @chars;
+ # Yes, ord() is shifted by 97 as opposed to 0->a, ..., but since
+ # this affects both parts of the difference, that amounts to
+ # zero difference.
+ push @diffs, (ord($chars[0]) - ord($c));
+ }
+ # Build a hash key from the diffs and push the original string
+ # onto an array which is in the result hash for the calculated key
+ # This way the odd string will be the only string in its array,
+ # while the other strings share they key, filling up the corresponding
+ # array with multiple values
+ my $key = join(",", @diffs);
+ push @{$result->{$key}}, $string;
+ }
+ foreach my $k (keys %$result) {
+ # The array with only one element contains the odd string
+ print "Odd string $result->{$k}->[0]!\n" if scalar(@{$result->{$k}}) == 1;
+ }
+}