aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Köhler <jean-luc@picard.franken.de>2025-08-30 16:38:38 +0200
committerThomas Köhler <jean-luc@picard.franken.de>2025-08-30 16:38:38 +0200
commitde1df237e64f64088ae45ac54353451a0ca093a2 (patch)
tree433cfcf4955eefd9421f1187deaccbaf4d91558a
parentabe00897569078e604adaecef75941fa70176dd1 (diff)
downloadperlweeklychallenge-club-de1df237e64f64088ae45ac54353451a0ca093a2.tar.gz
perlweeklychallenge-club-de1df237e64f64088ae45ac54353451a0ca093a2.tar.bz2
perlweeklychallenge-club-de1df237e64f64088ae45ac54353451a0ca093a2.zip
Add solution 336.
Signed-off-by: Thomas Köhler <jean-luc@picard.franken.de>
-rw-r--r--challenge-336/jeanluc2020/blog-1.txt1
-rw-r--r--challenge-336/jeanluc2020/blog-2.txt1
-rwxr-xr-xchallenge-336/jeanluc2020/perl/ch-1.pl100
-rwxr-xr-xchallenge-336/jeanluc2020/perl/ch-2.pl130
4 files changed, 232 insertions, 0 deletions
diff --git a/challenge-336/jeanluc2020/blog-1.txt b/challenge-336/jeanluc2020/blog-1.txt
new file mode 100644
index 0000000000..f07491e7e0
--- /dev/null
+++ b/challenge-336/jeanluc2020/blog-1.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-336-1.html
diff --git a/challenge-336/jeanluc2020/blog-2.txt b/challenge-336/jeanluc2020/blog-2.txt
new file mode 100644
index 0000000000..70dfb46300
--- /dev/null
+++ b/challenge-336/jeanluc2020/blog-2.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-336-2.html
diff --git a/challenge-336/jeanluc2020/perl/ch-1.pl b/challenge-336/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..4b275b82d7
--- /dev/null
+++ b/challenge-336/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,100 @@
+#!/usr/bin/env perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-336/#TASK1
+#
+# Task 1: Equal Group
+# ===================
+#
+# You are given an array of integers.
+#
+# Write a script to return true if the given array can be divided into one or
+# more groups: each group must be of the same size as the others, with at least
+# two members, and with all members having the same value.
+#
+## Example 1
+##
+## Input: @ints = (1,1,2,2,2,2)
+## Output: true
+##
+## Groups: (1,1), (2,2), (2,2)
+#
+#
+## Example 2
+##
+## Input: @ints = (1,1,1,2,2,2,3,3)
+## Output: false
+##
+## Groups: (1,1,1), (2,2,2), (3,3)
+#
+#
+## Example 3
+##
+## Input: @ints = (5,5,5,5,5,5,7,7,7,7,7,7)
+## Output: true
+##
+## Groups: (5,5,5,5,5,5), (7,7,7,7,7,7)
+#
+#
+## Example 4
+##
+## Input: @ints = (1,2,3,4)
+## Output: false
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# You can create matching groups if all the numbers of integers of the same
+# value are divisible by a common prime. So we check if we find a common prime
+# factor: for each prime, check if it is a divisor of the number and count that,
+# and if a prime happens to appear as often as there are distinct numbers in
+# the input array, we can return "true". If in the end, this wasn't the case
+# for any prime from our list, we return "false".
+
+use v5.36;
+use List::Util qw(max);
+
+equal_group(1,1,2,2,2,2);
+equal_group(1,1,1,2,2,2,3,3);
+equal_group(5,5,5,5,5,5,7,7,7,7,7,7);
+equal_group(1,2,3,4);
+
+sub equal_group( @ints ) {
+ say "Input: (" . join(", ", @ints) . ")";
+ my $numbers;
+ foreach my $i (@ints) {
+ $numbers->{$i}++;
+ }
+ my $biggest = max( map { $numbers->{$_} } keys %$numbers );
+ my @primes;
+ foreach my $n (2..$biggest) {
+ push @primes, $n if is_prime($n);
+ }
+ my $primes_found;
+ foreach my $n (keys %$numbers) {
+ foreach my $prime (@primes) {
+ $primes_found->{$prime}++ unless $numbers->{$n} % $prime;
+ }
+ }
+ foreach my $f (keys %$primes_found) {
+ return say "true" if $primes_found->{$f} == scalar(keys %$numbers);
+ }
+ return say "false";
+}
+
+
+### From the solution of the weekly challenge 223:
+sub is_prime {
+ my $num = shift;
+ return 0 if $num == 1;
+ my $divider = 2;
+ while($divider <= sqrt($num)) {
+ if(int($num/$divider) == $num/$divider) {
+ return 0;
+ }
+ $divider++;
+ }
+ return 1;
+}
+
diff --git a/challenge-336/jeanluc2020/perl/ch-2.pl b/challenge-336/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..cbb5ec72d7
--- /dev/null
+++ b/challenge-336/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,130 @@
+#!/usr/bin/env perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-336/#TASK2
+#
+# Task 2: Final Score
+# ===================
+#
+# You are given an array of scores by a team.
+#
+# Write a script to find the total score of the given team. The score can be
+# any integer, +, C or D. The + adds the sum of previous two scores. The score
+# C invalidates the previous score. The score D will double the previous score.
+#
+## Example 1
+##
+## Input: @scores = ("5","2","C","D","+")
+## Output: 30
+##
+## Round 1: 5
+## Round 2: 5 + 2
+## Round 3: 5 (invalidate the previous score 2)
+## Round 4: 5 + 10 (double the previous score 5)
+## Round 5: 5 + 10 + 15 (sum of previous two scores)
+##
+## Total Scores: 30
+#
+#
+## Example 2
+##
+## Input: @scores = ("5","-2","4","C","D","9","+","+")
+## Output: 27
+##
+## Round 1: 5
+## Round 2: 5 + (-2)
+## Round 3: 5 + (-2) + 4
+## Round 4: 5 + (-2) (invalidate the previous score 4)
+## Round 5: 5 + (-2) + (-4) (double the previous score -2)
+## Round 6: 5 + (-2) + (-4) + 9
+## Round 7: 5 + (-2) + (-4) + 9 + 5 (sum of previous two scores)
+## Round 8: 5 + (-2) + (-4) + 9 + 5 + 14 (sum of previous two scores)
+##
+## Total Scores: 27
+#
+#
+## Example 3
+##
+## Input: @scores = ("7","D","D","C","+","3")
+## Output: 45
+##
+## Round 1: 7
+## Round 2: 7 + 14 (double the previous score 7)
+## Round 3: 7 + 14 + 28 (double the previous score 14)
+## Round 4: 7 + 14 (invalidate the previous score 28)
+## Round 5: 7 + 14 + 21 (sum of previous two scores)
+## Round 6: 7 + 14 + 21 + 3
+##
+## Total Scores: 45
+#
+#
+## Example 4
+##
+## Input: @scores = ("-5","-10","+","D","C","+")
+## Output: -55
+##
+## Round 1: (-5)
+## Round 2: (-5) + (-10)
+## Round 3: (-5) + (-10) + (-15) (sum of previous two scores)
+## Round 4: (-5) + (-10) + (-15) + (-30) (double the previous score -15)
+## Round 5: (-5) + (-10) + (-15) (invalidate the previous score -30)
+## Round 6: (-5) + (-10) + (-15) + (-25) (sum of previous two scores)
+##
+## Total Scores: -55
+#
+#
+## Example 5
+##
+## Input: @scores = ("3","6","+","D","C","8","+","D","-2","C","+")
+## Output: 128
+##
+## Round 1: 3
+## Round 2: 3 + 6
+## Round 3: 3 + 6 + 9 (sum of previous two scores)
+## Round 4: 3 + 6 + 9 + 18 (double the previous score 9)
+## Round 5: 3 + 6 + 9 (invalidate the previous score 18)
+## Round 6: 3 + 6 + 9 + 8
+## Round 7: 3 + 6 + 9 + 8 + 17 (sum of previous two scores)
+## Round 8: 3 + 6 + 9 + 8 + 17 + 34 (double the previous score 17)
+## Round 9: 3 + 6 + 9 + 8 + 17 + 34 + (-2)
+## Round 10: 3 + 6 + 9 + 8 + 17 + 34 (invalidate the previous score -2)
+## Round 11: 3 + 6 + 9 + 8 + 17 + 34 + 51 (sum of previous two scores)
+##
+## Total Scores: 128
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# For each element in the scores, we add or remove an element from
+# a stack: either push the double of the last element on the stack
+# in case of "D", or the sum of the last two elements on the stack
+# in case of "+", or remove the last element of the stack for a "C",
+# or push the element otherwise (as then it's a number). In the end,
+# we just return the sum of all elements on the stack.
+
+use v5.36;
+use List::Util qw(sum);
+
+final_score("5","2","C","D","+");
+final_score("5","-2","4","C","D","9","+","+");
+final_score("7","D","D","C","+","3");
+final_score("-5","-10","+","D","C","+");
+final_score("3","6","+","D","C","8","+","D","-2","C","+");
+
+sub final_score(@scores) {
+ say "Input: (\"" . join("\", \"", @scores) . "\")";
+ my @stack = ();
+ foreach my $s (@scores) {
+ if($s eq "D") {
+ push @stack, 2 * $stack[-1];
+ } elsif ($s eq "C") {
+ pop @stack;
+ } elsif ($s eq "+") {
+ push @stack, $stack[-1] + $stack[-2];
+ } else {
+ push @stack, $s;
+ }
+ }
+ say "Output: " . sum(@stack);
+}