diff options
| -rw-r--r-- | challenge-216/peter-campbell-smith/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-216/peter-campbell-smith/perl/ch-1.pl | 55 | ||||
| -rwxr-xr-x | challenge-216/peter-campbell-smith/perl/ch-2.pl | 103 |
3 files changed, 159 insertions, 0 deletions
diff --git a/challenge-216/peter-campbell-smith/blog.txt b/challenge-216/peter-campbell-smith/blog.txt new file mode 100644 index 0000000000..776d8018e1 --- /dev/null +++ b/challenge-216/peter-campbell-smith/blog.txt @@ -0,0 +1 @@ +http://ccgi.campbellsmiths.force9.co.uk/challenge/216 diff --git a/challenge-216/peter-campbell-smith/perl/ch-1.pl b/challenge-216/peter-campbell-smith/perl/ch-1.pl new file mode 100755 index 0000000000..4e6ac75dbc --- /dev/null +++ b/challenge-216/peter-campbell-smith/perl/ch-1.pl @@ -0,0 +1,55 @@ +#!/usr/bin/perl + +use v5.16; # The Weekly Challenge - 2023-05-08 +use utf8; # Week 216 task 1 - Registration number +use strict; # Peter Campbell Smith +use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +use List::Uniq 'uniq'; + +registration_number(['job', 'james', 'bjorg'], '007 JB'); +registration_number(['crack', 'road', 'rac'], 'C7 RA2'); +registration_number(['superlative', 'reply', 'parallel', 'ppeerrll', + 'pert', 'earl'], 'PERL 216'); +registration_number(['none', 'of', 'these', 'should', 'work'], '12345'); + +sub registration_number { + + my (@words, $reg_no, $sorted_reg_no, $word, $sorted_word, $rubric); + + # initialise + @words = @{$_[0]}; + $reg_no = $_[1]; + + # sort, eliminate non-letters, make unique and lower case $reg_no + $reg_no =~ s|[^a-z]||ig; + $sorted_reg_no = sort_word($reg_no); + $rubric = ''; + + # nothing will match if $sorted_reg_no is empty (eg $reg_no == '12345') + if ($sorted_reg_no) { + + # loop over words + for $word (@words) { + $sorted_word = sort_word($word); + + # remove from $sorted_word any letter not in reg_no + $sorted_word =~ s|[^$sorted_reg_no]||gi; + + # and we have a result if $sorted_word and $sorted_reg_no are the same + $rubric .= qq['$word', ] + if ($sorted_word eq $sorted_reg_no); + } + } + + say qq[\nInput: \@words = ('] . join(q[', '], @words) . qq['), \$reg = '$_[1]']; + say qq[Output: (] . substr($rubric, 0, -2) . q[)]; +} + +sub sort_word { + + # returns unique letters in word, sorted and lower-cased + + return join('', sort(uniq(split('', lc($_[0]))))); +} + diff --git a/challenge-216/peter-campbell-smith/perl/ch-2.pl b/challenge-216/peter-campbell-smith/perl/ch-2.pl new file mode 100755 index 0000000000..765a0e1070 --- /dev/null +++ b/challenge-216/peter-campbell-smith/perl/ch-2.pl @@ -0,0 +1,103 @@ +#!/usr/bin/perl + +use v5.16; # The Weekly Challenge - 2023-05-08 +use utf8; # Week 216 task 2 - Word stickers +use strict; # Peter Campbell Smith +use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +word_stickers(['perl','raku','python'], 'peon'); +word_stickers(['love','hate','angry'], 'goat'); +word_stickers(['come','nation','delta'], 'accommodation'); +word_stickers(['nail', 'sited', 'belt', 'marsh'], 'antidisestablishmentarianism'); + +sub word_stickers { + + my ($best, $count, $how_many, $most, $need_to_match, $occurs, $occurs_in, $rubric, $s, + $s1, $stars, $ties, $times, $times_all, $times_here, $to_match, $word, $x, $x1, $z, %in_sticker, %in_word, %needed, %used, @stickers); + + # initialise + @stickers = @{$_[0]}; + $word = $_[1]; + $rubric = ''; + say qq[\nInput: \@stickers = ('] . join(qq[', '], @stickers) . + qq['), \$word = '$word']; + + # create $in_word{$x} as quantity of $x in $word + while ($word =~ m|([a-z])|g) { + $in_word{$1} ++; + } + + # create $in_sticker{$x}{$s} as quantity of $x in $stickers[$s] + for ($s = 0; $s < scalar @stickers; $s ++) { + while ($stickers[$s] =~ m|([a-z])|g) { + $in_sticker{$1}{$s} ++; + } + } + + # loop over letters in $word + for $x (sort keys %in_word) { + next unless $in_word{$x} > 0; + + # check for $x n times in stickers and >=n times in word + for $x (keys %in_word) { + $most = 0; + + # find sticker with most $x - this may not be the best + $times_all = 0; + for ($s = 0; $s < scalar @stickers; $s ++) { + $times_here = ($in_sticker{$x}{$s} or 0); + $times_all += $times_here; + if ($times_here > $most) { + $most = $times_here; + $best = $s; + } + } + + # check for impossibility (letter from word not in any sticker) + if ($most == 0) { + say qq[Output: 0 - '$x' not in any sticker]; + return; + } + + # if $x occurs more times in word than in stickers, + # need to add duplicate stickers + $need_to_match = $in_word{$x}; + $z = 0; + while ($need_to_match > $times_all) { + $s1 = scalar @stickers; + $stickers[$s1] = $stickers[$best] . '*'; + for $x1 (keys %in_word) { + $in_sticker{$x1}{$s1} = $in_sticker{$x1}{$best}; + } + $need_to_match -= $in_sticker{$x}{$best}; + } + + # now we have enough stickers + $need_to_match = $in_word{$x}; + for ($s = 0; $s < scalar @stickers; $s ++) { + next unless ($in_sticker{$x}{$s} or 0); + $to_match = $need_to_match > $in_sticker{$x}{$s} ? + $in_sticker{$x}{$s} : $need_to_match; + $need_to_match -= $to_match; + $used{$s} .= $x x $to_match; + $in_sticker{$x}{$s} = 0; + $in_word{$x} = 0; + $needed{$s} = 1; + last if $need_to_match <= 0; + } + $in_word{$x} = 0; + } + } + + # format output + $count = 0; + for $s (keys %needed) { + $count ++; + } + say qq[Output: $count]; + for $s (sort keys %used) { + say qq[ '$used{$s}' from '$stickers[$s]']; + $stars ++ if $stickers[$s] =~ m|\*|; + } + say qq[ * indicates duplicated sticker] if $stars; +} |