aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Köhler <jean-luc@picard.franken.de>2025-10-20 22:18:52 +0200
committerThomas Köhler <jean-luc@picard.franken.de>2025-10-20 22:18:52 +0200
commitc2d200dc1178bfe0027e3afcec65d6209c65eaf0 (patch)
tree397ddd9fa8460b3bd55a468753b1bd82464928ba
parent4ddca8aa5ba1d40a9764f3a0c764e8ab38f3638f (diff)
downloadperlweeklychallenge-club-c2d200dc1178bfe0027e3afcec65d6209c65eaf0.tar.gz
perlweeklychallenge-club-c2d200dc1178bfe0027e3afcec65d6209c65eaf0.tar.bz2
perlweeklychallenge-club-c2d200dc1178bfe0027e3afcec65d6209c65eaf0.zip
Add solution 344.
Signed-off-by: Thomas Köhler <jean-luc@picard.franken.de>
-rw-r--r--challenge-344/jeanluc2020/blog-1.txt1
-rw-r--r--challenge-344/jeanluc2020/blog-2.txt1
-rwxr-xr-xchallenge-344/jeanluc2020/perl/ch-1.pl84
-rwxr-xr-xchallenge-344/jeanluc2020/perl/ch-2.pl97
4 files changed, 183 insertions, 0 deletions
diff --git a/challenge-344/jeanluc2020/blog-1.txt b/challenge-344/jeanluc2020/blog-1.txt
new file mode 100644
index 0000000000..e74423a11c
--- /dev/null
+++ b/challenge-344/jeanluc2020/blog-1.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-344-1.html
diff --git a/challenge-344/jeanluc2020/blog-2.txt b/challenge-344/jeanluc2020/blog-2.txt
new file mode 100644
index 0000000000..4bccdf926c
--- /dev/null
+++ b/challenge-344/jeanluc2020/blog-2.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-344-2.html
diff --git a/challenge-344/jeanluc2020/perl/ch-1.pl b/challenge-344/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..9221ed813e
--- /dev/null
+++ b/challenge-344/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,84 @@
+#!/usr/bin/env perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-344/#TASK1
+#
+# Task 1: Array Form Compute
+# ==========================
+#
+# You are given an array of integers, @ints and an integer, $x.
+#
+# Write a script to add $x to the integer in the array-form.
+#
+### The array form of an integer is a digit-by-digit representation stored as
+### an array, where the most significant digit is at the 0th index.
+#
+## Example 1
+##
+## Input: @ints = (1, 2, 3, 4), $x = 12
+## Output: (1, 2, 4, 6)
+#
+#
+## Example 2
+##
+## Input: @ints = (2, 7, 4), $x = 181
+## Output: (4, 5, 5)
+#
+#
+## Example 3
+##
+## Input: @ints = (9, 9, 9), $x = 1
+## Output: (1, 0, 0, 0)
+#
+#
+## Example 4
+##
+## Input: @ints = (1, 0, 0, 0, 0), $x = 9999
+## Output: (1, 9, 9, 9, 9)
+#
+#
+## Example 5
+##
+## Input: @ints = (0), $x = 1000
+## Output: (1, 0, 0, 0)
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# We need to add from the end of the array, so we just reverse
+# the array and the array we get out of splitting $x into digits.
+# Then we add the current digits from both reverse arrays, plus any
+# carry over that we get from the previous digits. We keep the last
+# digit for our result array, and if there is a second digit, we keep
+# it as our new carry over. In the end, if there is a carry over, but
+# no more digits, we need to add this carry over to the result.
+
+use v5.36;
+
+array_form_compute([1, 2, 3, 4], 12);
+array_form_compute([2, 7, 4], 181);
+array_form_compute([9, 9, 9], 1);
+array_form_compute([1, 0, 0, 0, 0], 9999);
+array_form_compute([0], 1000);
+
+sub array_form_compute($ints, $x) {
+ say "Input: (" . join(", ", @$ints) . "), $x";
+ my @rev_ints = reverse @$ints;
+ my @rev_x = reverse split //, $x;
+ my $carry = 0;
+ my @result = ();
+ while(@rev_ints or @rev_x) {
+ my $tmp = $carry;
+ $tmp += shift @rev_ints if @rev_ints;
+ $tmp += shift @rev_x if @rev_x;
+ if($tmp > 9) {
+ $carry = int($tmp / 10);
+ } else {
+ $carry = 0;
+ }
+ unshift @result, $tmp % 10;
+ }
+ unshift @result, $carry if $carry;
+ say "Output: (" . join(", ", @result) . ")";
+}
diff --git a/challenge-344/jeanluc2020/perl/ch-2.pl b/challenge-344/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..2b3c2ad095
--- /dev/null
+++ b/challenge-344/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,97 @@
+#!/usr/bin/env perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-344/#TASK2
+#
+# Task 2: Array Formation
+# =======================
+#
+# You are given two list: @source and @target.
+#
+# Write a script to see if you can build the exact @target by putting these
+# smaller lists from @source together in some order. You cannot break apart or
+# change the order inside any of the smaller lists in @source.
+#
+## Example 1
+##
+## Input: @source = ([2,3], [1], [4])
+## @target = (1, 2, 3, 4)
+## Output: true
+##
+## Use in the order: [1], [2,3], [4]
+#
+#
+## Example 2
+##
+## Input: @source = ([1,3], [2,4])
+## @target = (1, 2, 3, 4)
+## Output: false
+#
+#
+## Example 3
+##
+## Input: @source = ([9,1], [5,8], [2])
+## @target = (5, 8, 2, 9, 1)
+## Output: true
+##
+## Use in the order: [5,8], [2], [9,1]
+#
+#
+## Example 4
+##
+## Input: @source = ([1], [3])
+## @target = (1, 2, 3)
+## Output: false
+##
+## Missing number: 2
+#
+#
+## Example 5
+##
+## Input: @source = ([7,4,6])
+## @target = (7, 4, 6)
+## Output: true
+##
+## Use in the order: [7, 4, 6]
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# We check all possible permutations of the source arrays. If
+# any permutation has all numbers in the same order than the
+# target array, we can return true since we found a solution.
+# Otherwise, we return false.
+
+use v5.36;
+use Algorithm::Permute;
+
+array_formation([[2,3], [1], [4]], [1, 2, 3, 4]);
+array_formation([[1,3], [2,4]], [1, 2, 3, 4]);
+array_formation([[9,1], [5,8], [2]], [5, 8, 2, 9, 1]);
+array_formation([[1], [3]], [1, 2, 3]);
+array_formation([[7,4,6]], [7, 4, 6]);
+
+sub array_formation($source, $target) {
+ say "Input: (" . join(", ", map { "[" . join(", ", @$_) . "]" } @$source)
+ . "), (" . join(", ", @$target) . ")";
+ my $p_iterator = Algorithm::Permute->new ( $source );
+ while(my @perm = $p_iterator->next) {
+ my @tmp = ();
+ foreach my $list (@perm) {
+ push @tmp, @$list;
+ }
+ if(equals(\@tmp, $target)) {
+ return say "Output: true";
+ }
+ }
+ say "Output: false";
+}
+
+sub equals($left, $right) {
+ return 0 unless scalar(@$left) == scalar(@$right);
+ foreach my $i (0..scalar(@$left)-1) {
+ return 0 if $left->[$i] != $right->[$i];
+ }
+ return 1;
+}