diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2025-08-30 18:18:37 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2025-08-30 18:18:37 +0100 |
| commit | 0b3f96a1df9bd948d1a41d4708dfa64ced0d3fa3 (patch) | |
| tree | 8a8ef410320005ed3742788187f5de02c37ded90 | |
| parent | e541dcf80c6fd9854e79a53024ed4022d08951d1 (diff) | |
| parent | de1df237e64f64088ae45ac54353451a0ca093a2 (diff) | |
| download | perlweeklychallenge-club-0b3f96a1df9bd948d1a41d4708dfa64ced0d3fa3.tar.gz perlweeklychallenge-club-0b3f96a1df9bd948d1a41d4708dfa64ced0d3fa3.tar.bz2 perlweeklychallenge-club-0b3f96a1df9bd948d1a41d4708dfa64ced0d3fa3.zip | |
Merge pull request #12594 from jeanluc2020/jeanluc2020-336
Add solution 336.
| -rw-r--r-- | challenge-336/jeanluc2020/blog-1.txt | 1 | ||||
| -rw-r--r-- | challenge-336/jeanluc2020/blog-2.txt | 1 | ||||
| -rwxr-xr-x | challenge-336/jeanluc2020/perl/ch-1.pl | 100 | ||||
| -rwxr-xr-x | challenge-336/jeanluc2020/perl/ch-2.pl | 130 |
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); +} |
