diff options
52 files changed, 3966 insertions, 2622 deletions
diff --git a/challenge-216/feng-chang/raku/ch-1.raku b/challenge-216/feng-chang/raku/ch-1.raku new file mode 100755 index 0000000000..c72f5c47a9 --- /dev/null +++ b/challenge-216/feng-chang/raku/ch-1.raku @@ -0,0 +1,6 @@ +#!/bin/env raku + +unit sub MAIN(*@words); + +my $regs = @words.pop.lc.comb.grep(/<[a..z]>/).Set; +put @words.grep({ .comb.Set (>=) $regs }).map({ "'$_'" }).join(', '); diff --git a/challenge-216/feng-chang/raku/ch-2.raku b/challenge-216/feng-chang/raku/ch-2.raku new file mode 100755 index 0000000000..1c7bc23331 --- /dev/null +++ b/challenge-216/feng-chang/raku/ch-2.raku @@ -0,0 +1,33 @@ +#!/bin/env raku + +unit sub MAIN(*@stickers); + +my %word-bag = @stickers.pop.comb.Bag; +my %bags = @stickers.map({ $_ => .comb.Bag }); + +if %word-bag.Set (-) ([(|)] %bags.values».Set) { + put 0; + exit; +} + +my @A = [%word-bag, @stickers.grep({ %bags{$_} (&) %word-bag }), []],; + +loop { + my @A_; + + for @A -> (%word-bag, @stickers, @history) { + for @stickers -> $s { + my %word-bag_ = %word-bag (-) %bags{$s}; + my @history_ = |@history, $s; + + if +%word-bag_ == 0 { + put +@history_; + exit 0; + } else { + @A_.push([%word-bag_, @stickers.grep({ %bags{$_} (&) %word-bag_ }), @history_]); + } + } + } + + @A = @A_; +} diff --git a/challenge-216/feng-chang/raku/test.raku b/challenge-216/feng-chang/raku/test.raku new file mode 100755 index 0000000000..af91516af2 --- /dev/null +++ b/challenge-216/feng-chang/raku/test.raku @@ -0,0 +1,32 @@ +#!/bin/env raku + +# The Weekly Challenge 216 +use Test; + +sub pwc-test(Str:D $script, *@input) { + my ($expect, $assertion) = @input.splice(*-2, 2); + my $p = run $script, |@input, :out; + is $p.out.slurp(:close).chomp, $expect, $assertion; +} + +# Task 1, Registration Number +pwc-test './ch-1.raku', + |<abc abcd bcd>, 'AB1 2CD', + "'abcd'", + "Registration Number: @words = ('abc', 'abcd', 'bcd'), \$reg = 'AB1 2CD' => 'abcd'"; +pwc-test './ch-1.raku', + |<job james bjorg>, '007 JB', + "'job', 'bjorg'", + "Registration Number: @words = ('job', 'james', 'bjorg'), \$reg = '007 JB' => 'job', 'bjorg'"; +pwc-test './ch-1.raku', + |<crack road rac>, 'C7 RA2', + "'crack', 'rac'", + "Registration Number: @words = ('crack', 'road', 'rac'), \$reg = 'C7 RA2' => 'crack', 'rac'"; + +# Task 2, Word Stickers +pwc-test './ch-2.raku', |<perl raku python>, 'peon', 2, 'Word Stickers: @stickers = ("perl","raku","python"), $word = "peon" => 2'; +pwc-test './ch-2.raku', |<love hate angry>, 'goat', 3, 'Word Stickers: @stickers = ("love","hate","angry"), $word = "goat" => 3'; +pwc-test './ch-2.raku', |<come nation delta>, 'accommodation', 4, 'Word Stickers: @stickers = ("come","nation","delta"), $word = "accommodation" => 4'; +pwc-test './ch-2.raku', |<come country delta>, 'accommodation', 0, 'Word Stickers: @stickers = ("come","country","delta"), $word = "accommodation" => 0'; + +done-testing; diff --git a/challenge-216/james-smith/README.md b/challenge-216/james-smith/README.md index 12dc6c8035..d686150756 100644 --- a/challenge-216/james-smith/README.md +++ b/challenge-216/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 214](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-214/james-smith) | -[Next 216 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-216/james-smith) +[< Previous 215](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-215/james-smith) | +[Next 217 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-217/james-smith) -# The Weekly Challenge 215 +# The Weekly Challenge 6^3 You can find more information about this weeks, and previous weeks challenges at: @@ -13,84 +13,108 @@ submit solutions in whichever language you feel comfortable with. You can find the solutions here on github at: -https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-215/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-216/james-smith -# TASK #1: Odd one Out +# TASK #1: Registration Number -***You are given a list of words (alphabetic characters only) of same size. Write a script to remove all words not sorted alphabetically and print the number of words in the list that are not alphabetically sorted.*** +***You are given a list of words and a random registration number. Write a script to find all the words in the given list that has every letter in the given registration number.*** ## Solution -To solve this problem we loop though each string to make sure the letters in alphabetical order. - -We note that if the words are 1 character long then they will be default in alphabetical order so we return 0. - -Looping through the letters - we just see if one is greater than or equal to the previous one - if it isn't we update the counter and move on to the next word. - -Note we use a ternary to replace this `if`/`else` for compactness. - -```perl -sub non_alpha { - return 0 if length $_[0] <2; - my($c,$f)=0; - for(@_) { - $f=''; - $f gt $_ ? ($c++,last) : ($f=$_) for split //; - } - $c -} -``` - -We can compact this by converting the inner `for` into a `map` - note the `last` was on the inner loop - and is the same as a `next` on the outer loop... So here we have to now use `next` not `laat` - ```perl -sub non_alpha_compact { - return 0 if length $_[0] <2; - my($c,$f)=0; - $f='', map { $f gt $_ ? ($c++,next) : ($f=$_) } split // for @_; - $c +sub reg_number { + my (%l,%x) = map { /[a-z]/ ? ($_=>1) : () } + split //, + lc + shift; + grep { + %x=%l; + delete $x{$_} for split//; + !%x + } @_ } ``` -# TASK #2: Number Placement +Firstly we get a list of the lower-cased letters in the number plate. Then for each word in turn we: + * copy this hash into a temporary hash; + * remove any letters from hash which rea in the word; + * Check to see if the hash is now empty - if it is we include the word. -***You are given a list of numbers having just 0 and 1. You are also given placement count (>=1). Write a script to find out if it is possible to replace 0 with 1 in the given list. The only condition is that you can only replace when there is no 1 on either side. Print 1 if it is possible otherwise 0.*** +# TASK #2: Word Stickers -*Question - there are two intepretations o the question - whether the placements are done simultaneously or one after the other* - -*In the former case any run of 3+ zeros can have `n-2` updates, but if it is the former it `(n-1)/2` +***You are given a list of word stickers and a target word. Write a script to find out how many word stickers is needed to make up the given target word.*** ## Solution -Both solutions are the same except for the calculation at the heart to compute the count. - -We loop through the numbers if we see a 1 we check to see how many previous 0's we've had and compute the number of insertions. If it is 0 we increment the count of 0's in a row. Note to make sure we include any last sequence of 0's we add a 1 on to the end of the list we are search. +Interestingly this task uses the trick - copy hash and delete elements - within it's core. + +We note we: + * are looking for fewest stickers so: + * this suggests a depth first solution; + * once we have found a solution it is by definition the best one; + * queue solutions work well in these cases; + * use a count based solution + * we count every letter in the target word; + * check that all of these are available on the sticker: + * if not we return a "0" value + * initialise the queue with an element: + * where we have not used any stickers; + * the last sticker we have "chosen" is the first one; + * the counts are the inital counts we calculated above + * for every element of the queue: + * we loop through the stickers; + * for each sticker we loop through the letters; + * and if we need that letter we make a note we have removed a letter and reduce the count of that letter by one (if the count goes to zero we remove it); + * if the counts array is empty we return the size + * if we have removed a letter we push the new values back on to the queue; + * **Note** when looping through the stickers we start with the last one we used and loop to the end. This avoids duplicates and greatly reduces the search space. + * we loop till the queue is empty - actually we don't because we will exit the loop with the count array check above before we exhaust the queue. + +Here is the code that the describes.... ```perl -sub insert_zero { - my($s,$c) = (0,shift); - $_ ? ( $c-= $s>2 && int(($s-1)/2), $s=0 ) : $s++ for @_,1; - $c>0?0:1; -} - -sub insert_zero_simultaneous { - my($s,$c) = (0,shift); - $_ ? ( $c-= $s>2 && $s-2, $s=0 ) : $s++ for @_,1; - $c>0?0:1 +sub word_stickers { + my( %f, %s, $n, $l, $x ); + $f{$_}++ for split //, shift; + my @q = [ 1, 0, my %t = %f ]; + map { delete $t{$_} } split // for @_; + return 0 if keys %t; + while( ( $n, $l, %f ) = @{ shift @q } ) { + push @q, map { + $x = 0, %t = %f; + exists $t{$_} && ( $x=1, --$t{$_} || delete $t{$_} ) + for split//, $_[$_]; + !%t ? return $n : $x ? [ $n+1, $_, %t ] : () + } $l..$#_; + } } ``` -We can get some performance improvements by short cutting the loop, by checking the value of $c at each stage rather than just at the end. This is most important if the number of inserts is relatively low in comparison to the size of the list. +And to know what bit does what - here it is with comments: ```perl -sub insert_zero_shortcut { - my($s,$c) = (0,shift); - $_ ? ( $c-= $s>2 && int(($s-1)/2), $s=0, $c>0 || return 1 ) : $s++ for @_,1; - 0; -} - -sub insert_zero_simultaneous_shortcut { - my($s,$c) = (0,shift); - $_ ? ( $c-= $s>2 && $s-2, $s=0, $c>0 || return 1 ) : $s++ for @_,1; - 0; +sub word_stickers { + my( %f, %s, $n, $l, $x ); + $f{$_}++ for split //, shift; # count for letters + my %t = %f; # Check all letters on stickers + # Initialise queue - no stickers, initial freq. + my @q = [ 1, 0, my %t = %f ]; # Check can solve? + map { delete $t{$_} } split // for @_; + return 0 if keys %t; # if not return 0 + my @q = [ 1, 0, %f ]; # [ $no+1, $last, %freqs ] + while( ($n,$l,%f) = @{ shift @q } ) { + push @q, map { + # Make copy of frequencies, set flag ($x) + # true once we use a letter on sticker, + # remove letters we have used up + $x = 0, %t = %f; + exists $t{$_} && ( $x=1, --$t{$_} || delete $t{$_} ) + for split//, $_[$_]; + # If none left return $n OR push entry onto + # queue, increasing count and setting new last + !%t ? return $n : $x ? [ $n+1, $_, %t ] : () + # Loop from last used to remove duplicates + } $l..$#_; + } } +``` diff --git a/challenge-216/james-smith/blog.txt b/challenge-216/james-smith/blog.txt new file mode 100644 index 0000000000..98f2ed1be4 --- /dev/null +++ b/challenge-216/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-216/james-smith/blog.txt diff --git a/challenge-216/james-smith/perl/ch-1.pl b/challenge-216/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..ecaaa24257 --- /dev/null +++ b/challenge-216/james-smith/perl/ch-1.pl @@ -0,0 +1,29 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese); + +my @TESTS = ( + [ ['AB1 2CD', qw(abc abcd bcd )], 'abcd' ], + [ ['007 JB', qw(job james bjorg)], 'job bjorg' ], + [ ['C7 RA2', qw(crack road rac )], 'crack rac' ], +); + +sub reg_number { + my (%l,%x) = map { /[a-z]/ ? ($_=>1) : () } + split //, + lc + shift; + grep { + %x=%l; + delete $x{$_} for split//; + !%x; + } @_ +} + +is( "@{[ reg_number( @{$_->[0]} ) ]}", $_->[1] ) for @TESTS; + +done_testing(); diff --git a/challenge-216/james-smith/perl/ch-2.pl b/challenge-216/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..62fa4d7a69 --- /dev/null +++ b/challenge-216/james-smith/perl/ch-2.pl @@ -0,0 +1,58 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese); + +my @TESTS = ( + [ [qw(peon perl raku python)], 2 ], + [ [qw(goat love hate angry )], 3 ], + [ [qw(accommodation come nation delta )], 4 ], + [ [qw(accommodation come country delta )], 0 ], +); + +sub word_stickers { + my( %f, %s, $k, $n, $l, $x ); + $f{$_}++ for split //, shift; + my @q = [ 1, 0, my %t = %f ]; + map { delete $t{$_} } split // for @_; + return 0 if keys %t; + while( ( $n, $l, %f ) = @{ shift @q } ) { + push @q, map { + $x = 0, %t = %f; + exists $t{$_} && ( $x=1, --$t{$_} || delete $t{$_} ) + for split//, $_[$_]; + !%t ? return $n : $x ? [ $n+1, $_, %t ] : () + } $l..$#_; + } +} + +is( word_stickers( @{$_->[0]} ) , $_->[1] ) for @TESTS2; +done_testing(); + +sub word_stickers_with_comments { + my( %f, %s, $k, $n, $l, $x ); + $f{$_}++ for split //, shift; # count for letters + my %t = %f; # Check all letters on stickers + # Initialise queue - no stickers, initial freq. + my @q = [ 1, 0, my %t = %f ]; # Check can solve? + map { delete $t{$_} } split // for @_; + return 0 if keys %t; # if not return 0 + my @q = [ 1, 0, %f ]; # [ $no+1, $last, %freqs ] + while( ($n,$l,%f) = @{ shift @q } ) { + push @q, map { + # Make copy of frequencies, set flag ($x) + # true once we use a letter on sticker, + # remove letters we have used up + $x = 0, %t = %f; + exists $t{$_} && ( $x=1, --$t{$_} || delete $t{$_} ) + for split//, $_[$_]; + # If none left return $n OR push entry onto + # queue, increasing count and setting new last + !%t ? return $n : $x ? [ $n+1, $_, %t ] : () + # Loop from last used to remove duplicates + } $l..$#_; + } +} diff --git a/challenge-216/lubos-kolouch/perl/ch-1.pl b/challenge-216/lubos-kolouch/perl/ch-1.pl new file mode 100644 index 0000000000..c0b3f01798 --- /dev/null +++ b/challenge-216/lubos-kolouch/perl/ch-1.pl @@ -0,0 +1,31 @@ +#!/usr/bin/perl +use strict; +use warnings; + +sub matching_words { + my ($words, $reg) = @_; + $reg = uc($reg); + my %letters; + for my $letter (grep {/[A-Z]/} split //, $reg) { + $letters{$letter} = 1; + } + my @matches; + for my $word (@$words) { + my $upper_word = uc($word); + my $matched = 1; + for my $letter (keys %letters) { + unless (index($upper_word, $letter) != -1) { + $matched = 0; + last; + } + } + push @matches, $word if $matched; + } + return \@matches; +} + +my @words = ('job', 'james', 'bjorg'); +my $reg = '007 JB'; +my $matches = matching_words(\@words, $reg); +print "(", join(", ", map { "'$_'" } @$matches), ")\n"; + diff --git a/challenge-216/lubos-kolouch/perl/ch-2.pl b/challenge-216/lubos-kolouch/perl/ch-2.pl new file mode 100644 index 0000000000..f439b78eed --- /dev/null +++ b/challenge-216/lubos-kolouch/perl/ch-2.pl @@ -0,0 +1,63 @@ +use strict; +use warnings; +use List::Util qw(min); +use List::MoreUtils qw(any); + +sub min_stickers_needed { + my ( $stickers, $target ) = @_; + my %target_counts; + $target_counts{$_}++ for split //, $target; + my @stickers_counts = map { my %cnt; $cnt{$_}++ for split //, $_; \%cnt } @$stickers; + + # Filter out stickers that don't have any characters in common with the target word + my @filtered_stickers_counts = grep { + my $sticker = $_; + any { exists $sticker->{$_} } keys %target_counts + } @stickers_counts; + + return min_stickers_helper( \@filtered_stickers_counts, \%target_counts, 0 ); +} + +sub min_stickers_helper { + my ( $stickers_counts, $target_counts, $used_stickers ) = @_; + + return $used_stickers unless keys %$target_counts; + + my $min_stickers = 'inf'; + for my $sticker_counts (@$stickers_counts) { + + # Try to fulfill the remaining character requirements of the target word + my %new_target_counts = %$target_counts; + my $used_current_sticker = 0; + for my $char ( keys %$sticker_counts ) { + if ( $new_target_counts{$char} ) { + $new_target_counts{$char} -= $sticker_counts->{$char}; + delete $new_target_counts{$char} if $new_target_counts{$char} <= 0; + $used_current_sticker = 1; + } + } + + if ($used_current_sticker) { + $min_stickers = min( $min_stickers, + min_stickers_helper( $stickers_counts, \%new_target_counts, $used_stickers + 1 ) ); + } + } + + return $min_stickers == 'inf' ? -1 : $min_stickers; +} + +my $stickers = [ 'perl', 'raku', 'python' ]; +my $word = 'peon'; +print min_stickers_needed( $stickers, $word ), "\n"; # Output: 2 + +$stickers = [ 'love', 'hate', 'angry' ]; +$word = 'goat'; +print min_stickers_needed( $stickers, $word ), "\n"; # Output: 3 + +$stickers = [ 'come', 'nation', 'delta' ]; +$word = 'accommodation'; +print min_stickers_needed( $stickers, $word ), "\n"; # Output: 4 + +$stickers = [ 'come', 'country', 'delta' ]; +$word = 'accommodation'; +print min_stickers_needed( $stickers, $word ), "\n"; # Output: -1 diff --git a/challenge-216/lubos-kolouch/python/ch-1.py b/challenge-216/lubos-kolouch/python/ch-1.py new file mode 100644 index 0000000000..c52a4df31f --- /dev/null +++ b/challenge-216/lubos-kolouch/python/ch-1.py @@ -0,0 +1,22 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- + +from typing import List + + +def matching_words(words: List[str], reg: str) -> List[str]: + reg = reg.upper() + letters = set(letter for letter in reg if letter.isalpha()) + matches = [] + for word in words: + upper_word = word.upper() + matched = all(letter in upper_word for letter in letters) + if matched: + matches.append(word) + return matches + + +words = ['job', 'james', 'bjorg'] +reg = '007 JB' +matches_list = matching_words(words, reg) +print("(", ", ".join(f"'{match}'" for match in matches_list), ")") diff --git a/challenge-216/lubos-kolouch/python/ch-2.py b/challenge-216/lubos-kolouch/python/ch-2.py new file mode 100644 index 0000000000..9cb331adf1 --- /dev/null +++ b/challenge-216/lubos-kolouch/python/ch-2.py @@ -0,0 +1,60 @@ +from collections import Counter +import sys + + +def min_stickers_needed(stickers, target): + target_counts = Counter(target) + stickers_counts = [Counter(sticker) for sticker in stickers] + + # Filter out stickers that don't have any characters in common with the target word + filtered_stickers_counts = [ + sticker + for sticker in stickers_counts + if any(sticker[char] > 0 for char in target_counts) + ] + + return min_stickers_helper(filtered_stickers_counts, target_counts, 0) + + +def min_stickers_helper(stickers_counts, target_counts, used_stickers): + if not target_counts: + return used_stickers + + min_stickers = sys.maxsize + for sticker_counts in stickers_counts: + # Try to fulfill the remaining character requirements of the target word + new_target_counts = target_counts.copy() + used_current_sticker = False + for char, count in sticker_counts.items(): + if new_target_counts[char] > 0: + new_target_counts[char] -= count + if new_target_counts[char] <= 0: + del new_target_counts[char] + used_current_sticker = True + + if used_current_sticker: + min_stickers = min( + min_stickers, + min_stickers_helper( + stickers_counts, new_target_counts, used_stickers + 1 + ), + ) + + return min_stickers if min_stickers != sys.maxsize else 0 + + +stickers = ["perl", "raku", "python"] +word = "peon" +print(min_stickers_needed(stickers, word)) # Output: 2 + +stickers = ["love", "hate", "angry"] +word = "goat" +print(min_stickers_needed(stickers, word)) # Output: 3 + +stickers = ["come", "nation", "delta"] +word = "accommodation" +print(min_stickers_needed(stickers, word)) # Output: 4 + +stickers = ["come", "country", "delta"] +word = "accommodation" +print(min_stickers_needed(stickers, word)) # Output: -1 diff --git a/challenge-216/luca-ferrari/blog-1.txt b/challenge-216/luca-ferrari/blog-1.txt new file mode 100644 index 0000000000..bc60db2e40 --- /dev/null +++ b/challenge-216/luca-ferrari/blog-1.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task1 diff --git a/challenge-216/luca-ferrari/blog-2.txt b/challenge-216/luca-ferrari/blog-2.txt new file mode 100644 index 0000000000..a17a747527 --- /dev/null +++ b/challenge-216/luca-ferrari/blog-2.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task2 diff --git a/challenge-216/luca-ferrari/blog-3.txt b/challenge-216/luca-ferrari/blog-3.txt new file mode 100644 index 0000000000..e26b6dc467 --- /dev/null +++ b/challenge-216/luca-ferrari/blog-3.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task1plperl diff --git a/challenge-216/luca-ferrari/blog-4.txt b/challenge-216/luca-ferrari/blog-4.txt new file mode 100644 index 0000000000..8d03a8fda7 --- /dev/null +++ b/challenge-216/luca-ferrari/blog-4.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task2plperl diff --git a/challenge-216/luca-ferrari/blog-5.txt b/challenge-216/luca-ferrari/blog-5.txt new file mode 100644 index 0000000000..2aeb4b3370 --- /dev/null +++ b/challenge-216/luca-ferrari/blog-5.txt @@ -0,0 +1 @@ +https://fluca1978.github.io/2023/05/08/PerlWeeklyChallenge216.html#task1plpgsql diff --git a/challenge-216/luca-ferrari/blog-6.txt b/challenge-2 |