From ed225270218a907eaad6c42e75f1f027e311e74a Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Sun, 15 Oct 2023 23:25:28 -0600 Subject: Solve PWC239 --- challenge-239/wlmb/blog.txt | 1 + challenge-239/wlmb/perl/ch-1.pl | 14 ++++++++++++++ challenge-239/wlmb/perl/ch-2.pl | 16 ++++++++++++++++ 3 files changed, 31 insertions(+) create mode 100644 challenge-239/wlmb/blog.txt create mode 100755 challenge-239/wlmb/perl/ch-1.pl create mode 100755 challenge-239/wlmb/perl/ch-2.pl diff --git a/challenge-239/wlmb/blog.txt b/challenge-239/wlmb/blog.txt new file mode 100644 index 0000000000..d5783d4ef5 --- /dev/null +++ b/challenge-239/wlmb/blog.txt @@ -0,0 +1 @@ +https://wlmb.github.io/2023/10/15/PWC239/ diff --git a/challenge-239/wlmb/perl/ch-1.pl b/challenge-239/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..fb6b96ab7b --- /dev/null +++ b/challenge-239/wlmb/perl/ch-1.pl @@ -0,0 +1,14 @@ +#!/usr/bin/env perl +# Perl weekly challenge 239 +# Task 1: Same String +# +# See https://wlmb.github.io/2023/10/15/PWC239/#task-1-same-string +use v5.36; +die <<~"FIN" unless @ARGV==2; + Usage: $0 AR1 AR2 + to check if the space separated lists of strings ARn concatenate + to the same string. + FIN +my @ar1=split " ", shift; +my @ar2=split " ", shift; +say "(@ar1), (@ar2) -> ", (join "", @ar1) eq (join "",@ar2)?"True":"False" diff --git a/challenge-239/wlmb/perl/ch-2.pl b/challenge-239/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..998b4d1572 --- /dev/null +++ b/challenge-239/wlmb/perl/ch-2.pl @@ -0,0 +1,16 @@ +#!/usr/bin/env perl +# Perl weekly challenge 239 +# Task 2: Consistent Strings +# +# See https://wlmb.github.io/2023/10/15/PWC239/#task-2-consistent-strings +use v5.36; +use List::Util qw(all); +die <<~"FIN" unless @ARGV; + Usage: $0 A S1 [S2...] + Count how many of the strings Sn are consistent with the allowed characters in string A. + FIN +my $allowed=shift; +my %allowed; +map {$allowed{$_}++} split "", $allowed; +my @output = grep{all {$allowed{$_}} split ""} @ARGV; +say "Allowed: $allowed. Strings: @ARGV -> ",0+@output; -- cgit From d8484bbc3149fc39835d0186427404567d56e33e Mon Sep 17 00:00:00 2001 From: Matthias Muth Date: Mon, 16 Oct 2023 09:19:49 +0200 Subject: Challenge 239 Task 1 and 2 solutions in Perl by Matthias Muth --- challenge-239/matthias-muth/README.md | 157 +++++-------- challenge-239/matthias-muth/blog.txt | 1 + challenge-239/matthias-muth/perl/TestExtractor.pm | 258 +++++++++++++++++++++ challenge-239/matthias-muth/perl/ch-1.pl | 24 ++ challenge-239/matthias-muth/perl/ch-2.pl | 24 ++ challenge-239/matthias-muth/perl/challenge-239.txt | 69 ++++++ 6 files changed, 435 insertions(+), 98 deletions(-) create mode 100644 challenge-239/matthias-muth/blog.txt create mode 100644 challenge-239/matthias-muth/perl/TestExtractor.pm create mode 100755 challenge-239/matthias-muth/perl/ch-1.pl create mode 100755 challenge-239/matthias-muth/perl/ch-2.pl create mode 100644 challenge-239/matthias-muth/perl/challenge-239.txt diff --git a/challenge-239/matthias-muth/README.md b/challenge-239/matthias-muth/README.md index c9bb67da74..b8db841f68 100644 --- a/challenge-239/matthias-muth/README.md +++ b/challenge-239/matthias-muth/README.md @@ -1,124 +1,85 @@ -# Reduced Arrays, Reduced Numbers, Reduced Code +# Short Solutions for Short Strings -**Challenge 238 solutions in Perl by Matthias Muth** +**Challenge 239 solutions in Perl by Matthias Muth** -This week's challenges seem to be all about '*reducing*' things. +## Task 1: Same String -My solution for Task 1 uses the `reductions` function from the `List::Util` core module.
Actually this *reduces* the code to one single statement. - -And in Task 2 we have to *reduce* numbers to their -'[multiplicative digital root](https://en.wikipedia.org/wiki/Multiplicative_digital_root)' -before sorting them.
My solution then also *reduces* the runtime by caching those *reduced* numbers. - -So here is an *'unreduced'* description of my *'reduced*' solutions. :-) - -## Task 1: Running Sum - -> You are given an array of integers.
-> Write a script to return the running sum of the given array. The running sum can be calculated as $$sum[i] = num[0] + num[1] + …. + num[i]$$.
+> You are given two arrays of strings.
+> Write a script to find out if the word created by concatenating the array elements is the same.
>
> Example 1
-> Input: @int = (1, 2, 3, 4, 5)
-> Output: (1, 3, 6, 10, 15)
+> Input: @arr1 = ("ab", "c")
+> @arr2 = ("a", "bc")
+> Output: true
+> Using @arr1, word1 => "ab" . "c" => "abc"
+> Using @arr2, word2 => "a" . "bc" => "abc"
>
> Example 2
-> Input: @int = (1, 1, 1, 1, 1)
-> Output: (1, 2, 3, 4, 5)
+> Input: @arr1 = ("ab", "c")
+> @arr2 = ("ac", "b")
+> Output: false
+> Using @arr1, word1 => "ab" . "c" => "abc"
+> Using @arr2, word2 => "ac" . "b" => "acb"
>
> Example 3
-> Input: @int = (0, -1, 1, 2)
-> Output: (0, -1, 0, 2)
+> Input: @arr1 = ("ab", "cd", "e")
+> @arr2 = ("abcde")
+> Output: true
+> Using @arr1, word1 => "ab" . "cd" . "e" => "abcde"
+> Using @arr2, word2 => "abcde"
-A 'running sum' is a good example for what the `reduce`function and its close relative `reductions` can do.
+Now this is a really easy one. +All we have to do is to concatenate all elements of each array, and do a string comparison of the two resulting words: -From the `List::Util` [docs](https://perldoc.perl.org/List::Util#reduce): - ->```perl ->$result = reduce { BLOCK } @list ->``` ->Reduces `@list` by calling `BLOCK` in a scalar context multiple times, setting `$a` and `$b` each time. The first call will be with `$a` and `$b` set to the first two elements of the list, subsequent calls will be done by setting `$a` to the result of the previous call and `$b` to the next element in the list.
Returns the result of the last call to the `BLOCK`. [...] -> ->```perl ->@results = reductions { BLOCK } @list ->``` -> ->Similar to `reduce` except that it also returns the intermediate values along with the final result.
The returned list will begin with the initial value for `$a`, followed by each return value from the block in order. The final value of the result will be identical to what the `reduce` function would have returned given the same block and list. - -The `sum` function is nothing but a specialization of `reduce`, and it can be implemented like this: ```perl -sub sum( @list ) { - return reduce { $a + $b } @list; +sub same_string( $arr1, $arr2 ) { + return join( "", $arr1->@* ) eq join( "", $arr2->@* ); } ``` -So we can use `reduce` for summing up the list elements from the first to the last.
-And if we use `reductions` instead, we also get all the intermediate results, which are exactly the - -> $$ num[i] = num[0] + num[1] + …. + num[i]$$ - -that we need to return as the result: - -```perl -use List::Util qw( reductions ); -sub running_sum( @int ) { - return reductions { $a + $b } @int; -} +Happy to use the '[Postfix Dereference Syntax](https://perldoc.perl.org/perlref#Postfix-Dereference-Syntax)' +```perl + $array->@* ``` +to get all elements of the array. In my opinion is easier to write and easier to read than the 'cast'-like `@{$array}` or its short form @$array, which can only be used in simple cases. +Same as I use -This is almost *less* than a one-liner! :-) +```perl + $array->[1] + $array->[2][3] +``` +to access elements with references to arrays or multi-dimensional arrays, respectively.
But I digress. I should rather keep it 'short'. :-) -## Task 2: Persistence Sort +## Task 2: Consistent Strings -> You are given an array of positive integers.
-> Write a script to sort the given array in increasing order with respect to the count of steps required to obtain a single-digit number by multiplying its digits recursively for each array element. If any two numbers have the same count of steps, then print the smaller number first.
+> You are given an array of strings and allowed string having distinct characters.
+> A string is consistent if all characters in the string appear in the string allowed.
+> Write a script to return the number of consistent strings in the given array.
>
> Example 1
-> Input: @int = (15, 99, 1, 34)
-> Output: (1, 15, 34, 99)
-> 15 => 1 x 5 => 5 (1 step)
-> 99 => 9 x 9 => 81 => 8 x 1 => 8 (2 steps)
-> 1 => 0 step
-> 34 => 3 x 4 => 12 => 1 x 2 => 2 (2 steps)
+> Input: @str = ("ad", "bd", "aaab", "baa", "badab")
+> \$allowed = "ab"
+> Output: 2
+> Strings "aaab" and "baa" are consistent since they only contain characters 'a' and 'b'.
>
> Example 2
-> Input: @int = (50, 25, 33, 22)
-> Output: (22, 33, 50, 25)
-> 50 => 5 x 0 => 0 (1 step)
-> 25 => 2 x 5 => 10 => 1 x 0 => 0 (2 steps)
-> 33 => 3 x 3 => 6 (1 step)
-> 22 => 2 x 2 => 4 (1 step)
- -So we need the number of steps needed for reducing each number to its single digit '[multiplicative digital root](https://en.wikipedia.org/wiki/Multiplicative_digital_root)'. Let's create a function for computing that. It contains a counter and a loop that reduces the number as long the result has more than one digit. - -For doing the actual reduction, I use `split` to separate the digits of the number, and `product` from the `List::Util` core module to multiply them with each other. Perl makes it easy to change between strings and numbers without effort. - -```perl -use List::Util qw( product ); -sub steps_needed( $n ) { - my $n_steps = 0; - while ( $n > 9 ) { - ++$n_steps; - $n = product( split "", $n ); - } - return $n_steps; -} -``` - -Next, I use a hash for storing the number of steps for each number in the list.
-I use a hash, not an array, because we don't know how big the numbers in the original list can get.
-This hash will then be used in sorting the list. - -Perl's `sort` makes it easy to implement more complicated sorting criteria or combinations of criteria as in this case. The code block that is passed to sort compares the number of steps first, and next the numbers themselves in case that the former are equal. - -The result of the `sort` can directly be returned as the result. - +> Input: @str = ("a", "b", "c", "ab", "ac", "bc", "abc")
+> \$allowed = "abc"
+> Output: 7
+>
+> Example 3
+> Input: @str = ("cc", "acd", "b", "ba", "bac", "bad", "ac", "d")
+> \$allowed = "cad"
+> Output: 4
Strings "cc", "acd", "ac", and "d" are consistent.
+ +This one, too, is a very short one if we use the right tool for the right job.
+In this case, a regular expressions accepting only allowed characters can filter out the 'consistent' strings.
+We can use `grep` to iterate over the strings, and in scalar context it returns -- wait a second! -- the number of matches!
```perl -sub persistence_sort( @int ) { - my %steps = map { ( $_, steps_needed( $_ ) ) } @int; - return sort { $steps{$a} <=> $steps{$b} || $a <=> $b } @int; +sub consistent_strings( $str, $allowed ) { + return scalar grep /^[$allowed]*$/, $str->@*; } ``` +Done! :-) -Actually, I appreciate how much I learned about how functional programming concepts can *reduce* the code while doing these challenges in Perl! - -#### Thank you for the challenge! - +#### **Thank you for the challenge!** diff --git a/challenge-239/matthias-muth/blog.txt b/challenge-239/matthias-muth/blog.txt new file mode 100644 index 0000000000..7dcfd24b7c --- /dev/null +++ b/challenge-239/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-239/challenge-239/matthias-muth#readme diff --git a/challenge-239/matthias-muth/perl/TestExtractor.pm b/challenge-239/matthias-muth/perl/TestExtractor.pm new file mode 100644 index 0000000000..092e0539cc --- /dev/null +++ b/challenge-239/matthias-muth/perl/TestExtractor.pm @@ -0,0 +1,258 @@ +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# The Test Data Extraction Machine (tm). +# +# Perl solution by Matthias Muth. +# + +use strict; +use warnings; +use feature 'say'; +use feature 'signatures'; +no warnings 'experimental::signatures'; + +package TestExtractor; +use Exporter 'import'; +our @EXPORT = qw( run_tests $verbose %options vprint vsay pp np carp croak ); + +use Data::Dump qw( pp ); +use Data::Printer; +use Getopt::Long; +use Cwd qw( abs_path ); +use File::Basename; +use List::Util qw( any ); +use Carp; +use Test2::V0 qw( -no_srand ); +use Carp; +no warnings 'experimental::signatures'; + +our ( $verbose, %options ); +sub vprint { print @_ if $verbose }; +sub vsay { say @_ if $verbose }; + +sub run_tests() { + + $| = 1; + + GetOptions( + "v|verbose!" => \$verbose, + ) or do { say "usage!"; exit 2 }; + + my $dir = dirname abs_path $0; + my ( $challenge, $task ) = + abs_path( $0 ) =~ m{challenge-(\d+) .* (\d+)[^[/\\]*$}x; + unless ( $challenge && $task ) { + say STDERR "ERROR: ", + "Cannot determine challenge number or task number. Exiting."; + exit 1; + } + + my $local_tests; + ( undef, $local_tests ) = read_task( *::DATA ) + if fileno *::DATA; + + my ( $task_title, $task_description ) = + read_task( "$dir/challenge-${challenge}.txt", $task ); + # vsay $task_title; + + my @tests = ( + $local_tests ? extract_tests( $local_tests ) : (), + $task_description ? extract_tests( $task_description ) : (), + ); + # vsay pp( @tests ); + + ( my $sub_name = lc $task_title ) =~ s/\W+/_/g; + my $sub = \&{"::$sub_name"}; + + do { + my @input_params = + @{$_->{INPUT}} == 1 + ? ( ref $_->{INPUT}[0] eq 'ARRAY' + && ! grep( ref $_, @{$_->{INPUT}[0]} ) ) + ? @{$_->{INPUT}[0]} + : $_->{INPUT}[0] + : @{$_->{INPUT}}; + my $expected = $_->{OUTPUT}; + my $diag = + "$sub_name( " . pp( @input_params ) . " ) " + . ( ( @$expected == 1 && $expected->[0] =~ /^(?:(true)|false)/ ) + ? "is $expected->[0]" + : ( "== " . pp( @{$_->{OUTPUT}} ) ) ); + + my $name = "$_->{TEST}"; + $name .= ": $diag" + if $_->{TEST} =~ /^(Test|Example)(?:\s+\d+)?$/; + $diag = "test: $diag"; + + my @output = $sub->( @input_params ); + + if ( @$expected == 1 && $expected->[0] =~ /^(?:(true)|false)/ ) { + ok $1 ? $output[0] : ! $output[0], $name, $diag // (); + } + else { + is \@output, $expected, $name, $diag // (); + } + + # vsay ""; + + } for @tests; + + done_testing; +} + +sub read_task( $fd_or_filename, $wanted_task = undef ) { + + my $fd; + if ( ref \$fd_or_filename eq 'SCALAR' ) { + open $fd, "<", $fd_or_filename + or die "ERROR: cannot open '$fd_or_filename': $!\n"; + } + else { + # non-SCALARs, like __DATA__ GLOB. + $fd = $fd_or_filename; + } + + my ( $task, $task_title, $task_text ) = ( -1, undef ); + while ( <$fd> ) { + /^Task (\d+):\s*(.*?)\s*$/ and do { + $task = $1; + $task_title = $2 + if $wanted_task && $task == $wanted_task; + next; + }; + + next + if $wanted_task && $task != $wanted_task; + + $task_text .= $_; + } + + return $task_title, $task_text; +} + +sub extract_tests( $task_text ) { + # vsay "extract_tests( ", pp( $task_text ), " )"; + + # These regular expressions are used for extracting input or output + # test data. + my $var_name = qr/ [\@\$]\w+ /x; + my $literal = qr/ ".*?" | '.*?' | [+-]?\d+ | undef /x; + my $bracketed = qr/ \[ [^\[]*? \] /xs; + my $parenthesized = qr/ \( [^\[]*? \) /xs; + my $entry = qr/ $literal | $bracketed | $parenthesized /x; + my $list = qr/ $entry (?: \s*,\s* $entry )* \s*,? /xs; + + # The combination of what we expect as input or output data. + # Capture unparenthesized lists for special handling. + my $data_re = qr/ (? $literal ) + | (? \[ \s* (?:$list)? \s* \] ) + | (? \( \s* (?:$list)? \s* \) ) + | (? $list ) /x; + + my @tests; + while ( $task_text =~ + /^((?:Example|Test).*?)\s*:?\s*$ .*? + ^Input: \s* ( .*? ) \s* + ^Out?put: \s* ( .*? ) \s*? (?=(?: ^$ | ^\S | \Z )) + /xmsg ) + { + my ( $test, $input, $output) = ( $1, $2, $3 ); + # vsay pp $test, $input, $output; + + push @tests, { TEST => $test }; + + # Check whether the Input: part contains any variable sigils. + # If not, we try to convert ' = ...' + # into '$sequence_of_words = ...'. + # This is for specification like + # Input: Year = 2024, Month = 4, Weekday of month = 3, day of week = 2 + unless ( $input =~ /[\$\@]\w+/ ) { + $input =~ s{(\w+?(?: \w+?)*?)(\s*=)}{ + my ( $var_name, $equals ) = ( $1, $2 ); + '$' . lc ( $var_name =~ s/ /_/gr ) . $equals; + }eg; + # vsay "changed \$input to '$input'"; + } + + for ( $input, $output ) { + # To avoid misinterpretations of '@' or '$' when the data is + # 'eval'ed, we turn all double quotes into single quotes. + s/\"/'/g; + + # We convert 'barewords' into quoted strings. + # We search for these patterns, but we just skip them without + # changing them: + # * 'Input:', 'Output:' at the beginning of the string, + # * quoted strings, + # * variable names having a $ or @ sigil. + # After we are sure it's none of those, we also check unquoted + # 'barewords' (here: combinations of letters, digits or underscores, + # starting with a letter) and enclose them in single quotes. + my $bareword = qr/ \b (?!undef) [a-z_][a-z0-9_]* \b /ix; + while ( / ^Input: | ^Output: | '.*?' | [\$\@]$bareword + | ( $bareword ) /xg ) + { + if ( $1 ) { + my $p = pos(); + substr $_, $p - length( $1 ), length( $1 ), "'$1'"; + pos = $p + 2; + } + } + + # As all arrays will be stored as array references, we just + # convert parentheses (...) to angle brackets [...]. + # s/\(/\[/g; + # s/\)/\]/g; + + # Add missing commas between literals. + while ( s/($literal)\s+($literal)/$1, $2/ ) {} + } + + while ( $input =~ / ($var_name) \s* = \s* ($data_re) /xg ) { + push @{$tests[-1]{VARIABLE_NAMES}}, $1; + push @{$tests[-1]{INPUT}}, + eval( ( $+{no_paren} || $+{par_list} ) ? "[ $2 ]" : $2 ); + }; + + while ( $output =~ /^\s* ($data_re) $/xg ) { + local $_ = $1; + # vsay "\$_: <$_>"; + # Special case: (1,2),(3,4),(5,6) + # should become: [1,2],[3,4],[5,6] ] + if ( $+{no_paren} && /$parenthesized/ ) { + # vsay "found special case <$_>"; + s/\(/\[/g; + s/\)/\]/g; + } + push @{$tests[-1]{OUTPUT}}, + eval( $+{no_paren} ? "( $_ )" : $_ ); + }; + } + + unless ( @tests ) { + # Try an alternative description format: + # => + my $n_examples = 0; + while ( $task_text =~ /^( .*? ) \s* => \s* ( .* )$/xmg ) { + # vsay pp @{^CAPTURE}; + push @tests, { + TEST => "Example " . ++$n_examples, + INPUT => [ split " ", $1 ], + OUTPUT => [ $2 ], + VARIABLE_NAMES => [ '@input' ], + } + } + } + + # Use array refs for all OUTPUT lists if at least one of tests does. + if ( any { ref $_->{OUTPUT}[0] } @tests ) { + $_->{OUTPUT} = [ $_->{OUTPUT} ] + for grep { ! ref $_->{OUTPUT}[0] } @tests; + } + + return @tests; +} + +1; diff --git a/challenge-239/matthias-muth/perl/ch-1.pl b/challenge-239/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..0a1fbe1313 --- /dev/null +++ b/challenge-239/matthias-muth/perl/ch-1.pl @@ -0,0 +1,24 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 239 Task 1: Same String +# +# Perl solution by Matthias Muth. +# + +use v5.20; +use strict; +use warnings; +use feature 'signatures'; +no warnings 'experimental::signatures'; + +use lib '.'; +use TestExtractor; + +sub same_string( $arr1, $arr2 ) { + return join( "", $arr1->@* ) eq join( "", $arr2->@* ); +} + +run_tests; diff --git a/challenge-239/matthias-muth/perl/ch-2.pl b/challenge-239/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..c1e9532b01 --- /dev/null +++ b/challenge-239/matthias-muth/perl/ch-2.pl @@ -0,0 +1,24 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 239 Task 2: Consistent Strings +# +# Perl solution by Matthias Muth. +# + +use v5.20; +use strict; +use warnings; +use feature 'signatures'; +no warnings 'experimental::signatures'; + +use lib '.'; +use TestExtractor; + +sub consistent_strings( $str, $allowed ) { + return scalar grep /^[$allowed]*$/, $str->@*; +} + +run_tests; diff --git a/challenge-239/matthias-muth/perl/challenge-239.txt b/challenge-239/matthias-muth/perl/challenge-239.txt new file mode 100644 index 0000000000..d3a9d6143a --- /dev/null +++ b/challenge-239/matthias-muth/perl/challenge-239.txt @@ -0,0 +1,69 @@ +The Weekly Challenge - 239 +Monday, Oct 16, 2023 + + +Task 1: Same String +Submitted by: Mohammad S Anwar + +You are given two arrays of strings. +Write a script to find out if the word created by concatenating the array elements is the same. +Example 1 + +Input: @arr1 = ("ab", "c") + @arr2 = ("a", "bc") +Output: true + +Using @arr1, word1 => "ab" . "c" => "abc" +Using @arr2, word2 => "a" . "bc" => "abc" + +Example 2 + +Input: @arr1 = ("ab", "c") + @arr2 = ("ac", "b") +Output: false + +Using @arr1, word1 => "ab" . "c" => "abc" +Using @arr2, word2 => "ac" . "b" => "acb" + +Example 3 + +Input: @arr1 = ("ab", "cd", "e") + @arr2 = ("abcde") +Output: true + +Using @arr1, word1 => "ab" . "cd" . "e" => "abcde" +Using @arr2, word2 => "abcde" + + +Task 2: Consistent Strings +Submitted by: Mohammad S Anwar + +You are given an array of strings and allowed string having distinct characters. + +A string is consistent if all characters in the string appear in the string allowed. + +Write a script to return the number of consistent strings in the given array. +Example 1 + +Input: @str = ("ad", "bd", "aaab", "baa", "badab") + $allowed = "ab" +Output: 2 + +Strings "aaab" and "baa" are consistent since they only contain characters 'a' and 'b'. + +Example 2 + +Input: @str = ("a", "b", "c", "ab", "ac", "bc", "abc") + $allowed = "abc" +Output: 7 + +Example 3 + +Input: @str = ("cc", "acd", "b", "ba", "bac", "bad", "ac", "d") + $allowed = "cad" +Output: 4 + +Strings "cc", "acd", "ac", and "d" are consistent. + + +Last date to submit the solution 23:59 (UK Time) Sunday 22nd October 2023. -- cgit From 4ef6e55caf792eb3c3b5a7e5689fd472912cbdb7 Mon Sep 17 00:00:00 2001 From: rcmlz Date: Mon, 16 Oct 2023 10:25:45 +0200 Subject: Raku solution ch-239 --- challenge-239/rcmlz/raku/task-one.rakumod | 13 +++++++++++++ challenge-239/rcmlz/raku/task-two.rakumod | 15 +++++++++++++++ 2 files changed, 28 insertions(+) create mode 100644 challenge-239/rcmlz/raku/task-one.rakumod create mode 100644 challenge-239/rcmlz/raku/task-two.rakumod diff --git a/challenge-239/rcmlz/raku/task-one.rakumod b/challenge-239/rcmlz/raku/task-one.rakumod new file mode 100644 index 0000000000..d0dca8e548 --- /dev/null +++ b/challenge-239/rcmlz/raku/task-one.rakumod @@ -0,0 +1,13 @@ +unit module rcmlz::raku::task-one:ver<0.0.1>:auth:api<1>; + +# run in terminal: raku --optimize=3 -I challenge-nr239/rcmlz/raku/ -- test/challenge-nr239/raku/task-one.rakutest +# or raku --optimize=3 -I challenge-nr239 -- test/benchmark-scalabiity.raku --task=task-one --user=rcmlz --max-run-times=1,3,7 --max-problem=10 --v=True --test-before-benchmark=True --out-folder=/tmp nr239; cat /tmp/nr239_task-one.csv + +#|[ +You are given two arrays of strings. + +- Write a script to find out if the word created by concatenating the array elements is the same. +] +our sub solution(@input where @input.elems == 2) is export { + [eqv] @input.map: *.join; +} \ No newline at end of file diff --git a/challenge-239/rcmlz/raku/task-two.rakumod b/challenge-239/rcmlz/raku/task-two.rakumod new file mode 100644 index 0000000000..0e1c1fa26b --- /dev/null +++ b/challenge-239/rcmlz/raku/task-two.rakumod @@ -0,0 +1,15 @@ +unit module rcmlz::raku::task-two:ver<0.0.1>:auth:api<1>; + +# run in terminal: raku --optimize=3 -I challenge-nr239/rcmlz/raku/ -- test/challenge-nr239/raku/task-two.rakutest +# or raku --optimize=3 -I challenge-nr239 -- test/benchmark-scalabiity.raku --task=task-two --user=rcmlz --max-run-times=1,3,7 --max-problem=10 --v=True --test-before-benchmark=True --out-folder=/tmp nr239; cat /tmp/nr239_task-two.csv + +#|[ +You are given an array of strings and allowed string having distinct characters. +A string is consistent if all characters in the string appearing in the string are allowed. + +- Write a script to return the number of consistent strings in the given array. +] +our sub solution([$allowed, *@input]) is export { + my $allowed-chars = $allowed.comb.Set; + [+] @input.map: *.comb.Set ⊆ $allowed-chars; +} \ No newline at end of file -- cgit From 51249c55893b416ff0d1da89f10bb687983a9e4d Mon Sep 17 00:00:00 2001 From: Niels van Dijke Date: Mon, 16 Oct 2023 09:41:24 +0000 Subject: w239 - Task 1 & 2 --- challenge-239/perlboy1967/perl/ch1.pl | 33 +++++++++++++++++++++++++++++++ challenge-239/perlboy1967/perl/ch2.pl | 37 +++++++++++++++++++++++++++++++++++ 2 files changed, 70 insertions(+) create mode 100755 challenge-239/perlboy1967/perl/ch1.pl create mode 100755 challenge-239/perlboy1967/perl/ch2.pl diff --git a/challenge-239/perlboy1967/perl/ch1.pl b/challenge-239/perlboy1967/perl/ch1.pl new file mode 100755 index 0000000000..e9e0ed52fb --- /dev/null +++ b/challenge-239/perlboy1967/perl/ch1.pl @@ -0,0 +1,33 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 239 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-239 + +Author: Niels 'PerlBoy' van Dijke + +Task 1: Same String +Submitted by: Mohammad S Anwar + +You are given two arrays of strings. + +Write a script to find out if the word created by concatenating the array +elements is the same. + +=cut + +use v5.32; +use common::sense; + +use Test2::V0; + +sub sameString (\@\@) { + join('',@{$_[0]}) eq join('',@{$_[1]}) ? 1 : 0; +} + +is(sameString(@{[qw(ab c)]},@{[qw(a bc)]}),1); +is(sameString(@{[qw(ab c)]},@{[qw(ac b)]}),0); +is(sameString(@{[qw(ab cd e)]},@{[qw(abcde)]}),1); + +done_testing; diff --git a/challenge-239/perlboy1967/perl/ch2.pl b/challenge-239/perlboy1967/perl/ch2.pl new file mode 100755 index 0000000000..de5d428e08 --- /dev/null +++ b/challenge-239/perlboy1967/perl/ch2.pl @@ -0,0 +1,37 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 239 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-239 + +Author: Niels 'PerlBoy' van Dijke + +Task 2: Consistent Strings +Submitted by: Mohammad S Anwar + +You are given an array of strings and allowed string having distinct characters. + +|| A string is consistent if all characters in the string appear in the string allowed. + +Write a script to return the number of consistent strings in the given array. + +=cut + +use v5.32; +use common::sense; +use feature 'signatures'; + +use Test::More; + +sub consistentStrings ($allowed,@strings) { + my $re = "[^$allowed]"; + grep { length and !/$re/ } @strings; +} + +is(consistentStrings('ab',qw(ad bd aaab baa badab)),2); +is(consistentStrings('abc',qw(a b c ab ac bc abc)),7); +is(consistentStrings('cad',qw(cc acd b ba bac bad ac d)),4); +is(consistentStrings('a','a',''),1); + +done_testing; -- cgit From e8af5b3014aa362de676c5953511c6f252714083 Mon Sep 17 00:00:00 2001 From: "E. Choroba" Date: Mon, 16 Oct 2023 11:42:47 +0200 Subject: Add solutions to 239: Same String & Consistent Strings by E. Choroba --- challenge-239/e-choroba/perl/ch-1.pl | 14 ++++++++++++++ challenge-239/e-choroba/perl/ch-2.pl | 24 ++++++++++++++++++++++++ 2 files changed, 38 insertions(+) create mode 100755 challenge-239/e-choroba/perl/ch-1.pl create mode 100755 challenge-239/e-choroba/perl/ch-2.pl diff --git a/challenge-239/e-choroba/perl/ch-1.pl b/challenge-239/e-choroba/perl/ch-1.pl new file mode 100755 index 0000000000..f47e741240 --- /dev/null +++ b/challenge-239/e-choroba/perl/ch-1.pl @@ -0,0 +1,14 @@ +#!/usr/bin/perl +use warnings; +use strict; +use experimental qw( signatures ); + +sub same_string($arr1, $arr2) { + join("", @$arr1) eq join("", @$arr2) ? 'true' : 'false' +} + +use Test::More tests => 3; + +is same_string(["ab", "c"], ["a", "bc"]), 'true', 'Example 1'; +is same_string(["ab", "c"], ["ac", "b"]), 'false', 'Example 2'; +is same_string(["ab", "cd", "e"], ["abcde"]), 'true', 'Example 3'; diff --git a/challenge-239/e-choroba/perl/ch-2.pl b/challenge-239/e-choroba/perl/ch-2.pl new file mode 100755 index 0000000000..59abbd4ce6 --- /dev/null +++ b/challenge-239/e-choroba/perl/ch-2.pl @@ -0,0 +1,24 @@ +#!/usr/bin/perl +use warnings; +use strict; +use experimental qw( signatures ); + +sub consistent_strings($str, $allowed) { + my $regex = qr/^[\Q$allowed\E]*$/; + return scalar grep /$regex/, @$str +} + +use Test::More tests => 3 + 2; + +is consistent_strings(["ad", "bd", "aaab", "baa", "badab"], "ab"), + 2, 'Example 1'; +is consistent_strings(["a", "b", "c", "ab", "ac", "bc", "abc"], "abc"), + 7, 'Example 2'; +is consistent_strings(["cc", "acd", "b", "ba", "bac", "bad", "ac", "d"], "cad"), + 4, 'Example 3'; + +is consistent_strings(["", ""], 'xyz'), + 2, 'Empty strings'; + +is consistent_strings(['[[', ']]', '$$', '^^', '\\\\'], '\\[]^$'), + 5, 'Special characters'; -- cgit From f96a2022413ad523fd2457cd419e7a3498c4f5f5 Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 16 Oct 2023 11:06:49 +0000 Subject: Challenge 239 Solutions (Raku) --- challenge-239/mark-anderson/raku/ch-1.raku | 11 +++++++++ challenge-239/mark-anderson/raku/ch-2.raku | 39 ++++++++++++++++++++++++++++++ 2 files changed, 50 insertions(+) create mode 100644 challenge-239/mark-anderson/raku/ch-1.raku create mode 100644 challenge-239/mark-anderson/raku/ch-2.raku diff --git a/challenge-239/mark-anderson/raku/ch-1.raku b/challenge-239/mark-anderson/raku/ch-1.raku new file mode 100644 index 0000000000..4763f75e9f --- /dev/null +++ b/challenge-239/mark-anderson/raku/ch-1.raku @@ -0,0 +1,11 @@ +#!/usr/bin/env raku +use Test; + +ok same-string(, ); +nok same-string(, ); +ok same-string(, []); + +sub same-string(@a, @b) +{ + [eq] ([~] @a), ([~] @b) +} diff --git a/challenge-239/mark-anderson/raku/ch-2.raku b/challenge-239/mark-anderson/raku/ch-2.raku new file mode 100644 index 0000000000..6a6935e85f --- /dev/null +++ b/challenge-239/mark-anderson/raku/ch-2.raku @@ -0,0 +1,39 @@ +#!/usr/bin/env raku +use Test; +use Benchy; + +is consistant-strings(, 'ab'), 2; +is consistant-strings(, 'ab'), 3; +is consistant-strings(, 'cad'), 4; +benchmark(); + +sub consistant-strings(@a, $allowed) +{ + @a.grep({ .comb (<=) $allowed.comb }).elems +} + +sub consistant-strings-slow(@a, $allowed) +{ + @a.match(/ <|w> <{"<[$allowed]>"}>+ <|w> /, :global).elems +} + +sub benchmark +{ + b 10, + { + consistant-strings-slow(, 'ab'); + consistant-strings-slow(, 'ab'); + consistant-strings-slow(, 'cad') + }, + + { + consistant-strings(, 'ab'); + consistant-strings(, 'ab'); + consistant-strings(, 'cad') + } + + # Bare: 0.000040891s + # Old: 11.435895767s + # New: 0.019084392s + # NEW version is 599.23x faster +} -- cgit From ab1293cfcddc7cf4d2c7ab6b2a46e96f356c0936 Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 16 Oct 2023 11:19:23 +0000 Subject: Challenge 239 Solutions (Raku) --- challenge-239/mark-anderson/raku/ch-2.raku | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/challenge-239/mark-anderson/raku/ch-2.raku b/challenge-239/mark-anderson/raku/ch-2.raku index 6a6935e85f..f6c46defd7 100644 --- a/challenge-239/mark-anderson/raku/ch-2.raku +++ b/challenge-239/mark-anderson/raku/ch-2.raku @@ -2,17 +2,17 @@ use Test; use Benchy; -is consistant-strings(, 'ab'), 2; -is consistant-strings(, 'ab'), 3; -is consistant-strings(, 'cad'), 4; +is consistent-strings(, 'ab'), 2; +is consistent-strings(, 'abc'), 7; +is consistent-strings(, 'cad'), 4; benchmark(); -sub consistant-strings(@a, $allowed) +sub consistent-strings(@a, $allowed) { @a.grep({ .comb (<=) $allowed.comb }).elems } -sub consistant-strings-slow(@a, $allowed) +sub consistent-strings-slow(@a, $allowed) { @a.match(/ <|w> <{"<[$allowed]>"}>+ <|w> /, :global).elems } @@ -21,15 +21,15 @@ sub benchmark { b 10, { - consistant-strings-slow(, 'ab'); - consistant-strings-slow(, 'ab'); - consistant-strings-slow(, 'cad') + consistent-strings-slow(, 'ab'); + consistent-strings-slow(, 'abc'); + consistent-strings-slow(, 'cad') }, { - consistant-strings(, 'ab'); - consistant-strings(, 'ab'); - consistant-strings(, 'cad') + consistent-strings(, 'ab'); + consistent-strings(, 'abc'); + consistent-strings(, 'cad') } # Bare: 0.000040891s -- cgit From 377a9374457f07407cd6182eed5217b722433a2b Mon Sep 17 00:00:00 2001 From: Michael Firkins Date: Mon, 16 Oct 2023 23:11:10 +1100 Subject: pwc239 solution in python --- challenge-239/pokgopun/python/ch-1.py | 53 +++++++++++++++++++++++++++ challenge-239/pokgopun/python/ch-2.py | 67 +++++++++++++++++++++++++++++++++++ 2 files changed, 120 insertions(+) create mode 100644 challenge-239/pokgopun/python/ch-1.py create mode 100644 challenge-239/pokgopun/python/ch-2.py diff --git a/challenge-239/pokgopun/python/ch-1.py b/challenge-239/pokgopun/python/ch-1.py new file mode 100644 index 0000000000..e53abaf059 --- /dev/null +++ b/challenge-239/pokgopun/python/ch-1.py @@ -0,0 +1,53 @@ +### https://theweeklychallenge.org/blog/perl-weekly-challenge-239/ +""" + +Task 1: Same String + +Submitted by: [54]Mohammad S Anwar + __________________________________________________________________ + + You are given two arrays of strings. + + Write a script to find out if the word created by concatenating the + array elements is the same. + +Example 1 + +Input: @arr1 = ("ab", "c") + @arr2 = ("a", "bc") +Output: true + +Using @arr1, word1 => "ab" . "c" => "abc" +Using @arr2, word2 => "a" . "bc" => "abc" + +Example 2 + +Input: @arr1 = ("ab", "c") + @arr2 = ("ac", "b") +Output: false + +Using @arr1, word1 => "ab" . "c" => "abc" +Using @arr2, word2 => "ac" . "b" => "acb" + +Example 3 + +Input: @arr1 = ("ab", "cd", "e") + @arr2 = ("abcde") +Output: true + +Using @arr1, word1 => "ab" . "cd" . "e" => "abcde" +Using @arr2, word2 => "abcde" + +Task 2: Consistent Strings +""" +### solution by pokgopun@gmail.com + +def sameString(tot): + return "".join(tot[0])=="".join(tot[1]) + +for inpt, otpt in { + (("ab", "c"),("a", "bc")): True, + (("ab", "c"),("ac", "b")): False, + (("ab", "cd", "e"),("abcde")): True, + }.items(): + print(sameString(inpt)==otpt) diff --git a/challenge-239/pokgopun/python/ch-2.py b/challenge-239/pokgopun/python/ch-2.py new file mode 100644 index 0000000000..236b72dc5e --- /dev/null +++ b/challenge-239/pokgopun/python/ch-2.py @@ -0,0 +1,67 @@ +### https://theweeklychallenge.org/blog/perl-weekly-challenge-239/ +""" + +Task 2: Consistent Strings + +Submitted by: [55]Mohammad S Anwar + __________________________________________________________________ + + You are given an array of strings and allowed string having distinct + characters. + + A string is consistent if all characters in the string appear in the + string allowed. + + Write a script to return the number of consistent strings in the given + array. + +Example 1 + +Input: @str = ("ad", "bd", "aaab", "baa", "badab") + $allowed = "ab" +Output: 2 + +Strings "aaab" and "baa" are consistent since they only contain characters 'a' a +nd 'b'. + +Example 2 + +Input: @str = ("a", "b", "c", "ab", "ac", "bc", "abc") + $allowed = "abc" +Output: 7 + +Example 3 + +Input: @str = ("cc", "acd", "b", "ba", "bac", "bad", "ac", "d") + $allowed = "cad" +Output: 4 + +Strings "cc", "acd", "ac", and "d" are consistent. + __________________________________________________________________ + + Last date to submit the solution 23:59 (UK Time) Sunday 22nd October + 2023. + __________________________________________________________________ + +SO WHAT DO YOU THINK ? +""" +### solution by pokgopun@gmail.com + +def cnsstntStrings(tup, allowed): + allowedChrs = set(bytes(allowed,"ascii")) + return len( + tuple( + filter( + lambda x: set(bytes(x,"ascii")).issubset(allowedChrs), + tup + ) + ) + ) + +for (inpt1, inpt2), otpt in { + (("ad", "bd", "aaab", "baa", "badab"), "ab"): 2, + (("a", "b", "c", "ab", "ac", "bc", "abc"), "abc"): 7, + (("cc", "acd", "b", "ba", "bac", "bad", "ac", "d"), "cad"): 4, + }.items(): + print(cnsstntStrings(inpt1,inpt2)==otpt) + -- cgit From 6f4d59c2ab3596d2ac131101f43120792fc040c4 Mon Sep 17 00:00:00 2001 From: Michael Firkins Date: Tue, 17 Oct 2023 00:09:05 +1100 Subject: pwc239 solution in go --- challenge-239/pokgopun/go/ch-1.go | 67 +++++++++++++++++++++++++++++++++ challenge-239/pokgopun/go/ch-2.go | 78 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 145 insertions(+) create mode 100644 challenge-239/pokgopun/go/ch-1.go create mode 100644 challenge-239/pokgopun/go/ch-2.go diff --git a/challenge-239/pokgopun/go/ch-1.go b/challenge-239/pokgopun/go/ch-1.go new file mode 100644 index 0000000000..59c03d9403 --- /dev/null +++ b/challenge-239/pokgopun/go/ch-1.go @@ -0,0 +1,67 @@ +//# https://theweeklychallenge.org/blog/perl-weekly-challenge-239/ +/*# + +Task 1: Same String + +Submitted by: [54]Mohammad S Anwar + __________________________________________________________________ + + You are given two arrays of strings. + + Write a script to find out if the word created by concatenating the + array elements is the same. + +Example 1 + +Input: @arr1 = ("ab", "c") + @arr2 = ("a", "bc") +Output: true + +Using @arr1, word1 => "ab" . "c" => "abc" +Using @arr2, word2 => "a" . "bc" => "abc" + +Example 2 + +Input: @arr1 = ("ab", "c") + @arr2 = ("ac", "b") +Output: false + +Using @arr1, word1 => "ab" . "c" => "abc" +Using @arr2, word2 => "ac" . "b" => "acb" + +Example 3 + +Input: @arr1 = ("ab", "cd", "e") + @arr2 = ("abcde") +Output: true + +Using @arr1, word1 => "ab" . "cd" . "e" => "abcde" +Using @arr2, word2 => "abcde" + +Task 2: Consistent Strings +#*/ +//# solution by pokgopun@gmail.com + +package main + +import ( + "fmt" + "strings" +) + +func main() { + for _, data := range []struct { + s1, s2 []string + res bool + }{ + {[]string{"ab", "c"}, []string{"a", "bc"}, true}, + {[]string{"ab", "c"}, []string{"ac", "b"}, false}, + {[]string{"ab", "cd", "e"}, []string{"abcde"}, true}, + } { + fmt.Println(sameStrings(data.s1, data.s2) == data.res) + } +} + +func sameStrings(s1, s2 []string) bool { + return strings.Join(s1, "") == strings.Join(s2, "") +} diff --git a/challenge-239/pokgopun/go/ch-2.go b/challenge-239/pokgopun/go/ch-2.go new file mode 100644 index 0000000000..de43f9cd2d --- /dev/null +++ b/challenge-239/pokgopun/go/ch-2.go @@ -0,0 +1,78 @@ +//# https://theweeklychallenge.org/blog/perl-weekly-challenge-239/ +/*# + +Task 2: Consistent Strings + +Submitted by: [55]Mohammad S Anwar + __________________________________________________________________ + + You are given an array of strings and allowed string having distinct + characters. + + A string is consistent if all characters in the string appear in the + string allowed. + + Write a script to return the number of consistent strings in the given + array. + +Example 1 + +Input: @str = ("ad", "bd", "aaab", "baa", "badab") + $allowed = "ab" +Output: 2 + +Strings "aaab" and "baa" are consistent since they only contain characters 'a' a +nd 'b'. + +Example 2 + +Input: @str = ("a", "b", "c", "ab", "ac", "bc", "abc") + $allowed = "abc" +Output: 7 + +Example 3 + +Input: @str = ("cc", "acd", "b", "ba", "bac", "bad", "ac", "d") + $allowed = "cad" +Output: 4 + +Strings "cc", "acd", "ac", and "d" are consistent. + __________________________________________________________________ + + Last date to submit the solution 23:59 (UK Time) Sunday 22nd October + 2023. + __________________________________________________________________ + +SO WHAT DO YOU THINK ? +#*/ +//# solution by pokgopun@gmail.com + +package main + +import ( + "fmt" + "strings" +) + +func main() { + for _, data := range []struct { + strings []string + allowed string + count int + }{ + {[]string{"ad", "bd", "aaab", "baa", "badab"}, "ab", 2}, + {[]string{"a", "b", "c", "ab", "ac", "bc", "abc"}, "abc", 7}, + {[]string{"cc", "acd", "b", "ba", "bac", "bad", "ac", "d"}, "cad", 4}, + } { + fmt.Println(cStrings(data.strings, data.allowed) == data.count) + } +} + +func cStrings(s []string, a string) (c int) { + for _, v := range s { + if strings.Trim(v, a) == "" { + c++ + } + } + return c +} -- cgit From c90abf9d507ce67957260868820a314d4b0a9a1e Mon Sep 17 00:00:00 2001 From: "Jaldhar H. Vyas" Date: Mon, 16 Oct 2023 10:22:22 -0400 Subject: Challenge 239 by Jaldhar H. Vyas. --- challenge-239/jaldhar-h-vyas/blog.txt | 1 + challenge-239/jaldhar-h-vyas/perl/ch-1.pl | 8 ++++++++ challenge-239/jaldhar-h-vyas/perl/ch-2.sh | 3 +++ challenge-239/jaldhar-h-vyas/raku/ch-1.sh | 3 +++ challenge-239/jaldhar-h-vyas/raku/ch-2.raku | 9 +++++++++ 5 files changed, 24 insertions(+) create mode 100644 challenge-239/jaldhar-h-vyas/blog.txt create mode 100755 challenge-239/jaldhar-h-vyas/perl/ch-1.pl create mode 100755 challenge-239/jaldhar-h-vyas/perl/ch-2.sh create mode 100755 challenge-239/jaldhar-h-vyas/raku/ch-1.sh create mode 100755 challenge-239/jaldhar-h-vyas/raku/ch-2.raku diff --git a/challenge-239/jaldhar-h-vyas/blog.txt b/challenge-239/jaldhar-h-vyas/blog.txt new file mode 100644 index 0000000000..2110292718 --- /dev/null +++ b/challenge-239/jaldhar-h-vyas/blog.txt @@ -0,0 +1 @@ +https://www.braincells.com/perl/2023/10/perl_weekly_challenge_week_239.html diff --git a/challenge-239/jaldhar-h-vyas/perl/ch-1.pl b/challenge-239/jaldhar-h-vyas/perl/ch-1.pl new file mode 100755 index 0000000000..fabe925811 --- /dev/null +++ b/challenge-239/jaldhar-h-vyas/perl/ch-1.pl @@ -0,0 +1,8 @@ +#!/usr/bin/perl +use 5.030; +use warnings; + +my @arr1 = split q{, }, $ARGV[0]; +my @arr2 = split q{, }, $ARGV[1]; + +say 0+((join q{}, @arr1) eq (join q{}, @arr2)) ? 'true' : 'false'; \ No newline at end of file diff --git a/challenge-239/jaldhar-h-vyas/perl/ch-2.sh b/challenge-239/jaldhar-h-vyas/perl/ch-2.sh new file mode 100755 index 0000000000..a821ee7abb --- /dev/null +++ b/challenge-239/jaldhar-h-vyas/perl/ch-2.sh @@ -0,0 +1,3 @@ +#!/bin/sh + +perl -E 'say scalar grep {/^["$ARGV[0]"]+$/} splice @ARGV,1' "$@" diff --git a/challenge-239/jaldhar-h-vyas/raku/ch-1.sh b/challenge-239/jaldhar-h-vyas/raku/ch-1.sh new file mode 100755 index 0000000000..213f3722d9 --- /dev/null +++ b/challenge-239/jaldhar-h-vyas/raku/ch-1.sh @@ -0,0 +1,3 @@ +#!/bin/sh + +raku -e 'say @*ARGS[0].split(q{, }).join eq @*ARGS[1].split(q{, }).join' "$@" \ No newline at end of file diff --git a/challenge-239/jaldhar-h-vyas/raku/ch-2.raku b/challenge-239/jaldhar-h-vyas/raku/ch-2.raku new file mode 100755 index 0000000000..18b3ffe13b --- /dev/null +++ b/challenge-239/jaldhar-h-vyas/raku/ch-2.raku @@ -0,0 +1,9 @@ +#!/usr/bin/raku + +sub MAIN( + $allowed, + *@str +) { + my $class = "<[$allowed]>"; + @str.grep({ /^ <$class>+ $/ }).elems.say; +} \ No newline at end of file -- cgit From 050b631db9b8203505160d29e567af212482faa9 Mon Sep 17 00:00:00 2001 From: Kjetil Skotheim Date: Mon, 16 Oct 2023 16:27:24 +0200 Subject: challenge-239-kjetillll --- challenge-239/kjetillll/perl/ch-1.pl | 42 ++++++++++++++++++++++++++++++++++++ challenge-239/kjetillll/perl/ch-2.pl | 40 ++++++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+) create mode 100644 challenge-239/kjetillll/perl/ch-1.pl create mode 100644 challenge-239/kjetillll/perl/ch-2.pl diff --git a/challenge-239/kjetillll/perl/ch-1.pl b/challenge-239/kjetillll/perl/ch-1.pl new file mode 100644 index 0000000000..57b10e97e8 --- /dev/null +++ b/challenge-239/kjetillll/perl/ch-1.pl @@ -0,0 +1,42 @@ +#!/usr/bin/perl +#command line example: perl ch-1.pl "a bc d efg" "ab cde f g" + +use strict; use warnings; use v5.10; + +sub same_string { + my($array1, $array2) = @_; + "@$array1" =~ s/\s//gr eq + "@$array2" =~ s/\s//gr +} + +@ARGV ? run_args(@ARGV) + : run_tests(); + +sub run_args { + say same_string( map [split/\s+/], @_[0,1] ); +} + +sub run_tests { + for my $test ( + { arr1 => ["ab", "c"], + arr2 => ["a", "bc"], + output => 1 + }, + { arr1 => ["ab", "c"], + arr2 => ["ac", "b"], + output => 0 + }, + { arr1 => ["ab", "cd", "e"], + arr2 => ["abcde"], + output => 1 + } + ){ + my $got = same_string( $$test{arr1}, $$test{arr2} ); + say $$test{output} == $got ? 'ok' : '***NOT OK', + " arr1: @{$$test{arr1}}", + " arr2: @{$$test{arr2}}", + " output: $$test{output}", + " got: $got"; + } +} + diff --git a/challenge-239/kjetillll/perl/ch-2.pl b/challenge-239/kjetillll/perl/ch-2.pl new file mode 100644 index 0000000000..3a7fdbccba --- /dev/null +++ b/challenge-239/kjetillll/perl/ch-2.pl @@ -0,0 +1,40 @@ +#!/usr/bin/perl +#command line example: perl ch-2.pl cc acd b ba bac bad ac d cad + +use strict; use warnings; use v5.10; + +sub count_consistent { + -1 + grep /^[$_[-1]]+$/, @_ +} + +@ARGV ? run_args(@ARGV) + : run_tests(); + +sub run_args { + say count_consistent(@_); +} + +sub run_tests { + for my $test ( + { str => ["ad", "bd", "aaab", "baa", "badab"], + allowed => "ab", + output => 2 + }, + { str => ["a", "b", "c", "ab", "ac", "bc", "abc"], + allowed => "abc", + output => 7 + }, + { str => ["cc", "acd", "b", "ba", "bac", "bad", "ac", "d"], + allowed => "cad", + output => 4 + } + ){ + my $got = count_consistent( @{$$test{str}}, $$test{allowed} ); + say $$test{output} == $got ? 'ok' : '***NOT OK', + " str: @{$$test{str}}", + " allowed: $$test{allowed}", + " output: $$test{output}", + " got: $got"; + } +} + -- cgit From b0cce5a148155c830b1e6b720c3ba5c780e7d63a Mon Sep 17 00:00:00 2001 From: David Ferrone Date: Mon, 16 Oct 2023 10:42:13 -0400 Subject: Week 239 --- challenge-239/zapwai/perl/ch-1.pl | 15 +++++++++++++++ challenge-239/zapwai/perl/ch-2.pl | 24 ++++++++++++++++++++++++ 2 files changed, 39 insertions(+) create mode 100644 challenge-239/zapwai/perl/ch-1.pl create mode 100644 challenge-239/zapwai/perl/ch-2.pl diff --git a/challenge-239/zapwai/perl/ch-1.pl b/challenge-239/zapwai/perl/ch-1.pl new file mode 100644 index 0000000000..6403aa7745 --- /dev/null +++ b/challenge-239/zapwai/perl/ch-1.pl @@ -0,0 +1,15 @@ +use v5.30; +my @arr1 = ("ab","c"); +my @arr2 = ("a","bc"); +say "Input:\t \@arr1 = (". join(", ", @arr1) . ")"; +say "\t \@arr2 = (" . join(", ", @arr2) . ")"; +my $veracity = (paste(@arr1) eq paste(@arr2)) ? "True" : "False"; +say "Output: " . $veracity; +sub paste { + my @a = @_; + my $word; + for (0 .. $#a) { + $word .= $a[$_]; + } + $word +} diff --git a/challenge-239/zapwai/perl/ch-2.pl b/challenge-239/zapwai/perl/ch-2.pl new file mode 100644 index 0000000000..18e7949b52 --- /dev/null +++ b/challenge-239/zapwai/perl/ch-2.pl @@ -0,0 +1,24 @@ +use v5.30; +my @str = ("ad", "bd", "aaab", "baa", "badab"); +my $allowed = "ab"; +# @str = ("a", "b", "c", "ab", "ac", "bc", "abc"); +# my $allowed = "abc"; +# @str = ("cc", "acd", "b", "ba", "bac", "bad", "ac", "d"); +# my $allowed = "cad"; +my $count = 0; +my @good = split "", $allowed; +foreach my $word (@str) { + my @let = split "", $word; + my $cnt = 0; + letter: foreach my $l (@let) { + foreach my $g (@good) { + if ($l eq $g) { + $cnt++; + next letter; + } + } + } + $count++ if ($cnt == $#let + 1); +} +say "Input: \@str = (" . join(",",@str).")\n\t\$allowed = $allowed"; +say "Output: $count"; -- cgit From c62e4170753244752d286cd252268d64c3fde1a4 Mon Sep 17 00:00:00 2001 From: Dave Jacoby Date: Mon, 16 Oct 2023 13:21:23 -0400 Subject: DAJ 239 --- challenge-239/dave-jacoby/perl/ch-1.pl | 28 +++++++++++++++++++ challenge-239/dave-jacoby/perl/ch-2.pl | 49 ++++++++++++++++++++++++++++++++++ 2 files changed, 77 insertions(+) create mode 100644 challenge-239/dave-jacoby/perl/ch-1.pl create mode 100644 challenge-239/dave-jacoby/perl/ch-2.pl diff --git a/challenge-239/dave-jacoby/perl/ch-1.pl b/challenge-239/dave-jacoby/perl/ch-1.pl new file mode 100644 index 0000000000..7dd89072c2 --- /dev/null +++ b/challenge-239/dave-jacoby/perl/ch-1.pl @@ -0,0 +1,28 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use experimental qw{ say postderef signatures state }; + +my @examples = ( + + [ [ "ab", "c" ], [ "a", "bc" ] ], + [ [ "ab", "c" ], [ "ac", "b" ] ], + [ [ "ab", "cd", "e" ], ["abcde"] ], +); + +for my $e (@examples) { + my $output = same_string( $e->@* ); + my $arr1 = join ', ', map { qq{"$_"} } $e->[0]->@*; + my $arr2 = join ', ', map { qq{"$_"} } $e->[1]->@*; + say <<~"END"; + Input: \@arr1 = ($arr1) + \@arr2 = ($arr2) + Output: $output + END +} + +sub same_string ( @array ) { + my ( $s1, $s2 ) = map { join '', $_->@* } @array; + return $s1 eq $s2 ? 'true' : 'false'; +} diff --git a/challenge-239/dave-jacoby/perl/ch-2.pl b/challenge-239/dave-jacoby/perl/ch-2.pl new file mode 100644 index 0000000000..c9d40dd66b --- /dev/null +++ b/challenge-239/dave-jacoby/perl/ch-2.pl @@ -0,0 +1,49 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use experimental qw{ say postderef signatures state }; + +use List::Util qw{ uniq }; + +my @examples = ( + + { + str => [ "ad", "bd", "aaab", "baa", "badab" ], + allowed => "ab" + }, + { + str => [ "a", "b", "c", "ab", "ac", "bc", "abc" ], + allowed => "abc" + }, + { + str => [ "cc", "acd", "b", "ba", "bac", "bad", "ac", "d" ], + allowed => "cad" + }, +); + +for my $e (@examples) { + my $output = consistent_strings($e); + my $str = join ', ', map { qq{"$_"} } $e->{str}->@*; +my $allowed = $e->{allowed}; + say <<~"END"; + Input: \@str = ($str) + \$allowed = "$allowed" + Output: $output + END +} + +sub consistent_strings ($input) { + my @allowed = split //, $input->{allowed}; + my %allowed = map { $_ => 1 } @allowed; + my $n = 0; +OUTER: for my $str ( $input->{str}->@* ) { + my @chars = uniq sort split //, $str; + for my $c (@chars) { + next OUTER if !$allowed{$c}; + } + $n++; + } + return $n; +} + -- cgit From d0fb609a80c9cee62d5269f41388d92ea8f19f15 Mon Sep 17 00:00:00 2001 From: pme Date: Mon, 16 Oct 2023 21:00:56 +0200 Subject: challenge-239 --- challenge-239/peter-meszaros/perl/ch-1.pl | 62 +++++++++++++++++++++++++++ challenge-239/peter-meszaros/perl/ch-2.pl | 69 +++++++++++++++++++++++++++++++ 2 files changed, 131 insertions(+) create mode 100755 challenge-239/peter-meszaros/perl/ch-1.pl create mode 100755 challenge-239/peter-meszaros/perl/ch-2.pl diff --git a/challenge-239/peter-meszaros/perl/ch-1.pl b/challenge-239/peter-meszaros/perl/ch-1.pl new file mode 100755 index 0000000000..7985f31740 --- /dev/null +++ b/challenge-239/peter-meszaros/perl/ch-1.pl @@ -0,0 +1,62 @@ +#!/usr/bin/env perl +# +# You are given two arrays of strings. +# +# Write a script to find out if the word created by concatenating the array +# elements is the same. +# Example 1 +# +# Input: @arr1 = ("ab", "c") +# @arr2 = ("a", "bc") +# Output: true +# +# Using @arr1, word1 => "ab" . "c" => "abc" +# Using @arr2, word2 => "a" . "bc" => "abc" +# +# Example 2 +# +# Input: @arr1 = ("ab", "c") +# @arr2 = ("ac", "b") +# Output: false +# +# Using @arr1, word1 => "ab" . "c" => "abc" +# Using @arr2, word2 => "ac" . "b" => "acb" +# +# Example 3 +# +# Input: @arr1 = ("ab", "cd", "e") +# @arr2 = ("abcde") +# Output: true +# +# Using @arr1, word1 => "ab" . "cd" . "e" => "abcde" +# Using @arr2, word2 => "abcde" +# + +use strict; +use warnings; +use Test::More; +use Data::Dumper; + +my $cases = [ + [["ab", "c"], ["a", "bc"]], + [["ab", "c"], ["ac", "b"]], + [["ab", "cd", "e"], ["abcde"]], +]; + +sub same_string +{ + my ($arr1, $arr2) = $_[0]->@*; + + my $w1 = join('', @$arr1); + my $w2 = join('', @$arr2); + return $w1 eq $w2 ? 1 : 0; +} + +is(same_string($cases->[0]), 1, '[["ab", "c"], ["a", "bc"]]'); +is(same_string($cases->[1]), 0, '[["ab", "c"], ["ac", "b"]]'); +is(same_string($cases->[2]), 1, '[["ab", "cd", "e"], ["abcde"]]'); +done_testing(); + +exit 0; + + diff --git a/challenge-239/peter-meszaros/perl/ch-2.pl b/challenge-239/peter-meszaros/perl/ch-2.pl new file mode 100755 index 0000000000..0e2b1c54c7 --- /dev/null +++ b/challenge-239/peter-meszaros/perl/ch-2.pl @@ -0,0 +1,69 @@ +#!/usr/bin/env perl +# +# You are given an array of strings and allowed string having distinct +# characters. +# +# A string is consistent if all characters in the string appear in the +# string allowed. +# +# +# Write a script to return the number of consistent strings in the given array. +# Example 1 +# +# Input: @str = ("ad", "bd", "aaab", "baa", "badab") +# $allowed = "ab" +# Output: 2 +# +# Strings "aaab" and "baa" are consistent since they only contain characters +# 'a' and 'b'. +# +# Example 2 +# +# Input: @str = ("a", "b", "c", "ab", "ac", "bc", "abc") +# $allowed = "abc" +# Output: 7 +# +# Example 3 +# +# Input: @str = ("cc", "acd", "b", "ba", "bac", "bad", "ac", "d") +# $allowed = "cad" +# Output: 4 +# +# Strings "cc", "acd", "ac", and "d" are consistent. +# + +use strict; +use warnings; +use Test::More; +use Data::Dumper; + +my $cases = [ + [["ad", "bd", "aaab", "baa", "badab"], "ab"], + [["a", "b", "c", "ab", "ac", "bc", "abc"], "abc"], + [["cc", "acd", "b", "ba", "bac", "bad", "ac", "d"], "cad"], +]; + +sub consistent_strings +{ + my ($strs, $allowed) = $_[0]->@*; + + my %allowed = map { $_ => 1} split('', $allowed); + + my $cnt = 0; + WORD: for my $w (@$strs) { + my @w = split('', $w); + for my $c (@w) { + next WORD unless exists $allowed{$c}; + } + ++$cnt; + } + + return $cnt; +} + +is(consistent_strings($cases->[0]), 2, '[["ad", "bd", "aaab", "baa", "badab"], "ab"]'); +is(consistent_strings($cases->[1]), 7, '[["a", "b", "c", "ab", "ac", "bc", "abc"], "abc"]'); +is(consistent_strings($cases->[2]), 4, '[["cc", "acd", "b", "ba", "bac", "bad", "ac", "d"], "cad"]'); +done_testing(); + +exit 0; -- cgit From 1fd35b642bbc84be7293410b951273b54ae74cef Mon Sep 17 00:00:00 2001 From: Thomas Köhler Date: Mon, 16 Oct 2023 23:06:53 +0200 Subject: Add solution 239 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Thomas Köhler --- challenge-239/jeanluc2020/blog-1.txt | 1 + challenge-239/jeanluc2020/blog-2.txt | 1 + challenge-239/jeanluc2020/perl/ch-1.pl | 63 +++++++++++++++++++++++++++ challenge-239/jeanluc2020/perl/ch-2.pl | 74 ++++++++++++++++++++++++++++++++ challenge-239/jeanluc2020/python/ch-1.py | 61 ++++++++++++++++++++++++++ challenge-239/jeanluc2020/python/ch-2.py | 70 ++++++++++++++++++++++++++++++ 6 files changed, 270 insertions(+) create mode 100644 challenge-239/jeanluc2020/blog-1.txt create mode 100644 challenge-239/jeanluc2020/blog-2.txt create mode 100755 challenge-239/jeanluc2020/perl/ch-1.pl create mode 100755 challenge-239/jeanluc2020/perl/ch-2.pl create mode 100755 challenge-239/jeanluc2020/python/ch-1.py create mode 100755 challenge-239/jeanluc2020/python/ch-2.py diff --git a/challenge-239/jeanluc2020/blog-1.txt b/challenge-239/jeanluc2020/blog-1.txt new file mode 100644 index 0000000000..8dafa8df91 --- /dev/null +++ b/challenge-239/jeanluc2020/blog-1.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-239-1.html diff --git a/challenge-239/jeanluc2020/blog-2.txt b/challenge-239/jeanluc2020/blog-2.txt new file mode 100644 index 0000000000..81d70bbdcf --- /dev/null +++ b/challenge-239/jeanluc2020/blog-2.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-239-2.html diff --git a/challenge-239/jeanluc2020/perl/ch-1.pl b/challenge-239/jeanluc2020/perl/ch-1.pl new file mode 100755 index 0000000000..b6b1e9cf03 --- /dev/null +++ b/challenge-239/jeanluc2020/perl/ch-1.pl @@ -0,0 +1,63 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-239/#TASK1 +# +# Task 1: Same String +# =================== +# +# You are given two arrays of strings. +# +# Write a script to find out if the word created by concatenating the array +# elements is the same. +# +## Example 1 +## +## Input: @arr1 = ("ab", "c") +## @arr2 = ("a", "bc") +## Output: true +## +## Using @arr1, word1 => "ab" . "c" => "abc" +## Using @arr2, word2 => "a" . "bc" => "abc" +# +## Example 2 +## +## Input: @arr1 = ("ab", "c") +## @arr2 = ("ac", "b") +## Output: false +## +## Using @arr1, word1 => "ab" . "c" => "abc" +## Using @arr2, word2 => "ac" . "b" => "acb" +# +## Example 3 +## +## Input: @arr1 = ("ab", "cd", "e") +## @arr2 = ("abcde") +## Output: true +## +## Using @arr1, word1 => "ab" . "cd" . "e" => "abcde" +## Using @arr2, word2 => "abcde" +# +############################################################ +## +## discussion +## +############################################################ +# +# This one is simple, just compare the strings after putting them +# together from the arrays' content. +# +use strict; +use warnings; + +same_string( [ "ab", "c" ], ["a", "bc"]); +same_string( [ "ab", "c" ], ["ac", "b"]); +same_string( [ "ab", "cd", "e" ], [ "abcde" ]); + +sub same_string { + my ($arr1, $arr2) = @_; + print "Input: (\"" . join("\", \"", @$arr1) . "\"), (\"" . join("\", \"", @$arr2) . "\")\n"; + if( join("", @$arr1) eq join("", @$arr2) ) { + print "Output: true\n"; + } else { + print "Output: false\n"; + } +} diff --git a/challenge-239/jeanluc2020/perl/ch-2.pl b/challenge-239/jeanluc2020/perl/ch-2.pl new file mode 100755 index 0000000000..b39b0e5cd0 --- /dev/null +++ b/challenge-239/jeanluc2020/perl/ch-2.pl @@ -0,0 +1,74 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-239/#TASK2 +# +# Task 2: Consistent Strings +# ========================== +# +# You are given an array of strings and allowed string having distinct +# characters. +# +## A string is consistent if all characters in the string appear in the string +## allowed. +# +# Write a script to return the number of consistent strings in the given array. +# +## Example 1 +## +## Input: @str = ("ad", "bd", "aaab", "baa", "badab") +## $allowed = "ab" +## Output: 2 +## +## Strings "aaab" and "baa" are consistent since they only contain characters 'a' and 'b'. +# +## Example 2 +## +## Input: @str = ("a", "b", "c", "ab", "ac", "bc", "abc") +## $allowed = "abc" +## Output: 7 +# +## Example 3 +## +## Input: @str = ("cc", "acd", "b", "ba", "bac", "bad", "ac", "d") +## $allowed = "cad" +## Output: 4 +## +## Strings "cc", "acd", "ac", and "d" are consistent. +# +############################################################ +## +## discussion +## +############################################################ +# +# Create a hash table that uses the characters of $allowed as +# the keys. Then for each string in the array, check all the +# characters. If one of those isn't in the hash table, the +# string is not consistent, so we don't count the string. +# Otherwise, count the string as consistent. +# +use strict; +use warnings; + +consistent_strings( ["ad", "bd", "aaab", "baa", "badab"], "ab"); +consistent_strings( ["a", "b", "c", "ab", "ac", "bc", "abc"], "abc"); +consistent_strings( ["cc", "acd", "b", "ba", "bac", "bad", "ac", "d"], "cad"); + +sub consistent_strings { + my ($str, $allowed) = @_; + print "Input: \@str = (\"" . join("\", \"", @$str) . "\"), \$allowed = \"$allowed\"\n"; + my %allowed_chars = map { $_ => 1, } split //, $allowed; + my $count = 0; + foreach my $string (@$str) { + my @chars = split //, $string; + my $consistent = 1; + foreach my $char (@chars) { + unless($allowed_chars{$char}) { + $consistent = 0; + last; + } + } + $count++ if $consistent; + } + print "Output: $count\n"; +} + diff --git a/challenge-239/jeanluc2020/python/ch-1.py b/challenge-239/jeanluc2020/python/ch-1.py new file mode 100755 index 0000000000..0c520dd59d --- /dev/null +++ b/challenge-239/jeanluc2020/python/ch-1.py @@ -0,0 +1,61 @@ +#!/usr/bin/python3 +# https://theweeklychallenge.org/blog/perl-weekly-challenge-239/#TASK1 +# +# Task 1: Same String +# =================== +# +# You are given two arrays of strings. +# +# Write a script to find out if the word created by concatenating the array +# elements is the same. +# +## Example 1 +## +## Input: @arr1 = ("ab", "c") +## @arr2 = ("a", "bc") +## Output: true +## +## Using @arr1, word1 => "ab" . "c" => "abc" +## Using @arr2, word2 => "a" . "bc" => "abc" +# +## Example 2 +## +## Input: @arr1 = ("ab", "c") +## @arr2 = ("ac", "b") +## Output: false +## +## Using @arr1, word1 => "ab" . "c" => "abc" +## Using @arr2, word2 => "ac" . "b" => "acb" +# +## Example 3 +## +## Input: @arr1 = ("ab", "cd", "e") +## @arr2 = ("abcde") +## Output: true +## +## Using @arr1, word1 => "ab" . "cd" . "e" => "abcde" +## Using @arr2, word2 => "abcde" +# +############################################################ +## +## discussion +## +############################################################ +# +# This one is simple, just compare the strings after putting them +# together from the arrays' content. +# + + +def same_string(arr1: list, arr2: list): + print("Input: (\"", "\", \"".join(arr1), "\"), (\"", "\", \"".join(arr2), "\")", sep='') + if "".join(arr1) == "".join(arr2): + print("Output: true") + else: + print("Output: false") + + +same_string( [ "ab", "c" ], ["a", "bc"]) +same_string( [ "ab", "c" ], ["ac", "b"]) +same_string( [ "ab", "cd", "e" ], [ "abcde" ]) + diff --git a/challenge-239/jeanluc2020/python/ch-2.py b/challenge-239/jeanluc2020/python/ch-2.py new file mode 100755 index 0000000000..651842ae7d --- /dev/null +++ b/challenge-239/jeanluc2020/python/ch-2.py @@ -0,0 +1,70 @@ +#!/usr/bin/python3 +# https://theweeklychallenge.org/blog/perl-weekly-challenge-239/#TASK2 +# +# Task 2: Consistent Strings +# ========================== +# +# You are given an array of strings and allowed string having distinct +# characters. +# +## A string is consistent if all characters in the string appear in the string +## allowed. +# +# Write a script to return the number of consistent strings in the given array. +# +## Example 1 +## +## Input: @str = ("ad", "bd", "aaab", "baa", "badab") +## $allowed = "ab" +## Output: 2 +## +## Strings "aaab" and "baa" are consistent since they only