From 8c763f1bd7e9fb4c7ba1a80dc339ffbd9a23b333 Mon Sep 17 00:00:00 2001 From: Adam Russell Date: Sun, 3 Dec 2023 20:44:39 -0500 Subject: removed old .gitignore files --- challenge-243/adam-russell/.gitignore | 3 --- challenge-244/adam-russell/.gitignore | 3 --- 2 files changed, 6 deletions(-) delete mode 100644 challenge-243/adam-russell/.gitignore delete mode 100644 challenge-244/adam-russell/.gitignore diff --git a/challenge-243/adam-russell/.gitignore b/challenge-243/adam-russell/.gitignore deleted file mode 100644 index d4e9a94d5e..0000000000 --- a/challenge-243/adam-russell/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -*.bbprojectd -.RData -.Rhistory diff --git a/challenge-244/adam-russell/.gitignore b/challenge-244/adam-russell/.gitignore deleted file mode 100644 index d4e9a94d5e..0000000000 --- a/challenge-244/adam-russell/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -*.bbprojectd -.RData -.Rhistory -- cgit From b83ae6bf5ef619abe85510b5810b8b7e84a5224f Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Tue, 5 Dec 2023 16:30:41 -0600 Subject: Make random number picks unique --- challenge-246/bob-lied/perl/ch-1.pl | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/challenge-246/bob-lied/perl/ch-1.pl b/challenge-246/bob-lied/perl/ch-1.pl index 394f4db426..07c2d59d52 100644 --- a/challenge-246/bob-lied/perl/ch-1.pl +++ b/challenge-246/bob-lied/perl/ch-1.pl @@ -10,4 +10,12 @@ #============================================================================= use feature qw/say/; -say for sort { $a <=> $b} map { int(rand(49)) + 1 } 1..6; + +# Choose six numbers without repeats +my %seen; +while ( scalar(%seen) < 6 ) +{ + $seen{ int(rand(49)) + 1 } = 1; +} + +say for sort { $a <=> $b } keys %seen; -- cgit From 8c83d2379bec6a8df0291d5d2831ebbfe3051e41 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Tue, 5 Dec 2023 16:45:33 -0600 Subject: Correct size of hash --- challenge-246/bob-lied/perl/ch-1.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-246/bob-lied/perl/ch-1.pl b/challenge-246/bob-lied/perl/ch-1.pl index 07c2d59d52..56b1ae4e26 100644 --- a/challenge-246/bob-lied/perl/ch-1.pl +++ b/challenge-246/bob-lied/perl/ch-1.pl @@ -13,7 +13,7 @@ use feature qw/say/; # Choose six numbers without repeats my %seen; -while ( scalar(%seen) < 6 ) +while ( scalar(keys %seen) < 6 ) { $seen{ int(rand(49)) + 1 } = 1; } -- cgit From 86b40a444f6ad097e863471eb41738fdc304e255 Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 11 Dec 2023 05:32:00 +0000 Subject: Challenge 247 Solutions (Raku) --- challenge-247/mark-anderson/raku/ch-1.raku | 36 ++++++++++++++++++++++++++++++ challenge-247/mark-anderson/raku/ch-2.raku | 10 +++++++++ 2 files changed, 46 insertions(+) create mode 100644 challenge-247/mark-anderson/raku/ch-1.raku create mode 100644 challenge-247/mark-anderson/raku/ch-2.raku diff --git a/challenge-247/mark-anderson/raku/ch-1.raku b/challenge-247/mark-anderson/raku/ch-1.raku new file mode 100644 index 0000000000..92ae775140 --- /dev/null +++ b/challenge-247/mark-anderson/raku/ch-1.raku @@ -0,0 +1,36 @@ +#!/usr/bin/env raku +use Test; + +is-deeply secret-santa(["Mr. Wall", "Mrs. Wall", "Mr. Anwar", + "Mrs. Anwar", "Mr. Conway", "Mr. Cross"]), + { + "Mrs. Anwar" => "Mr. Conway", + "Mr. Conway" => "Mr. Cross", + "Mr. Cross" => "Mrs. Wall", + "Mrs. Wall" => "Mr. Anwar", + "Mr. Anwar" => "Mr. Wall", + "Mr. Wall" => "Mrs. Anwar" + } + +is-deeply secret-santa(["Mr. Wall", "Mrs. Wall", "Mr. Anwar"]), + { + "Mr. Anwar" => "Mrs. Wall", + "Mr. Wall" => "Mr. Anwar", + "Mrs. Wall" => "Mr. Wall" + } + +sub secret-santa(@names) +{ + my %surname = @names.classify({ .words[1] }); + + my @r = gather given %surname.values.sort.Array + { + while .elems + { + take .head.pop; + .head ?? $_ .= rotate !! .splice(0,1) + } + } + + @r.push(@r.head).rotor(2 => -1).map({ .pairup.head }).Hash +} diff --git a/challenge-247/mark-anderson/raku/ch-2.raku b/challenge-247/mark-anderson/raku/ch-2.raku new file mode 100644 index 0000000000..532186b18e --- /dev/null +++ b/challenge-247/mark-anderson/raku/ch-2.raku @@ -0,0 +1,10 @@ +#!/usr/bin/env raku +use Test; + +is most-freq-pair("abcdbca"), "bc"; +is most-freq-pair("cdeabeabfcdfabgcd"), "ab"; + +sub most-freq-pair($str) +{ + ($str ~~ m:ov/../)>>.Str.Bag.maxpairs.sort.head.key +} -- cgit From e32e843f21a9d6995c974980cc36a180ab1ddd32 Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 11 Dec 2023 05:42:53 +0000 Subject: Challenge 247 Solutions (Raku) --- challenge-247/mark-anderson/raku/ch-1.raku | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-247/mark-anderson/raku/ch-1.raku b/challenge-247/mark-anderson/raku/ch-1.raku index 92ae775140..a3ae0d336a 100644 --- a/challenge-247/mark-anderson/raku/ch-1.raku +++ b/challenge-247/mark-anderson/raku/ch-1.raku @@ -28,7 +28,7 @@ sub secret-santa(@names) while .elems { take .head.pop; - .head ?? $_ .= rotate !! .splice(0,1) + .head ?? $_ .= rotate !! .shift } } -- cgit From c206e58869e6eca3d969e6af32074facce5a5d4e Mon Sep 17 00:00:00 2001 From: Thomas Köhler Date: Mon, 11 Dec 2023 10:18:13 +0100 Subject: Add solution 247 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Thomas Köhler --- challenge-247/jeanluc2020/blog-1.txt | 1 + challenge-247/jeanluc2020/blog-2.txt | 1 + challenge-247/jeanluc2020/perl/ch-1.pl | 109 +++++++++++++++++++++++++++++++++ challenge-247/jeanluc2020/perl/ch-2.pl | 55 +++++++++++++++++ 4 files changed, 166 insertions(+) create mode 100644 challenge-247/jeanluc2020/blog-1.txt create mode 100644 challenge-247/jeanluc2020/blog-2.txt create mode 100755 challenge-247/jeanluc2020/perl/ch-1.pl create mode 100755 challenge-247/jeanluc2020/perl/ch-2.pl diff --git a/challenge-247/jeanluc2020/blog-1.txt b/challenge-247/jeanluc2020/blog-1.txt new file mode 100644 index 0000000000..a1594d1d94 --- /dev/null +++ b/challenge-247/jeanluc2020/blog-1.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-247-1.html diff --git a/challenge-247/jeanluc2020/blog-2.txt b/challenge-247/jeanluc2020/blog-2.txt new file mode 100644 index 0000000000..dcd5376ede --- /dev/null +++ b/challenge-247/jeanluc2020/blog-2.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-247-2.html diff --git a/challenge-247/jeanluc2020/perl/ch-1.pl b/challenge-247/jeanluc2020/perl/ch-1.pl new file mode 100755 index 0000000000..28a758d523 --- /dev/null +++ b/challenge-247/jeanluc2020/perl/ch-1.pl @@ -0,0 +1,109 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-247/#TASK1 +# +# Task 1: Secret Santa +# ==================== +# +# Task 1: Secret Santa +# Submitted by: Andreas Voegele +# +# Secret Santa is a Christmas tradition in which members of a group are +# randomly assigned a person to whom they give a gift. +# +# You are given a list of names. Write a script that tries to team persons from +# different families. +# +## Example 1 +## +## The givers are randomly chosen but don't share family names with the receivers. +## +## Input: @names = ('Mr. Wall', +## 'Mrs. Wall', +## 'Mr. Anwar', +## 'Mrs. Anwar', +## 'Mr. Conway', +## 'Mr. Cross', +## ); +## +## Output: +## +## Mr. Conway -> Mr. Wall +## Mr. Anwar -> Mrs. Wall +## Mrs. Wall -> Mr. Anwar +## Mr. Cross -> Mrs. Anwar +## Mr. Wall -> Mr. Conway +## Mrs. Anwar -> Mr. Cross +# +## Example 2 +## +## One gift is given to a family member. +## +## Input: @names = ('Mr. Wall', +## 'Mrs. Wall', +## 'Mr. Anwar', +## ); +## +## Output: +## +## Mr. Anwar -> Mr. Wall +## Mr. Wall -> Mrs. Wall +## Mrs. Wall -> Mr. Anwar +# +############################################################ +## +## discussion +## +############################################################ +# +# We create all possible permutations for the input. Then we +# eliminate all of those that have two people of the same family +# next to each other. Then we select one of the remaining +# permutations randomly. + +use strict; +use warnings; +use Data::Dumper; +use Algorithm::Permute; + +secret_santa('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', 'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross'); +secret_santa('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar'); + +sub secret_santa { + my @names = @_; + my @permutations = (); + my $p_iterator = Algorithm::Permute->new ( \@names ); + my @current_permutation; + while (my @perm = $p_iterator->next) { + @current_permutation = @perm; + if(valid(@perm)) { + push @permutations, [@perm]; + } + } + print Dumper \@permutations; + unless(@permutations) { + push @permutations, [ @current_permutation ]; + } + my $which = int(rand(scalar(@permutations))); + my $permutation = $permutations[$which]; + my $last = shift @$permutation; + push @$permutation, $last; + foreach my $who (@$permutation) { + print "$last -> $who\n"; + $last = $who; + } +} + +sub valid { + my @perm = @_; + my $last = shift @perm; + push @perm, $last; + foreach my $name (@perm) { + my $family_last = $last; + $family_last =~ s/.* //; + my $family_this = $name; + $family_this =~ s/.* //; + return 0 if $family_last eq $family_this; + $last = $name; + } + return 1; +} diff --git a/challenge-247/jeanluc2020/perl/ch-2.pl b/challenge-247/jeanluc2020/perl/ch-2.pl new file mode 100755 index 0000000000..e697827a3c --- /dev/null +++ b/challenge-247/jeanluc2020/perl/ch-2.pl @@ -0,0 +1,55 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-247/#TASK2 +# +# Task 2: Most Frequent Letter Pair +# ================================= +# +# You are given a string S of lower case letters 'a'..'z'. +# +# Write a script that finds the pair of consecutive letters in S that appears +# most frequently. If there is more than one such pair, chose the one that is +# the lexicographically first. +# +## Example 1 +## +## Input: $s = 'abcdbca' +## Output: 'bc' +## +## 'bc' appears twice in `$s` +# +## Example 2 +## +## Input: $s = 'cdeabeabfcdfabgcd' +## Output: 'ab' +## +## 'ab' and 'cd' both appear three times in $s and 'ab' is lexicographically +## smaller than 'cd'. +# +############################################################ +## +## discussion +## +############################################################ +# +# Create a map with all substrings as keys and their frequency as value, +# then sort by frequency descending and then by key ascending and return +# the first element of the sorted list + +use strict; +use warnings; + +most_frequent_letter_pair('abcdbca'); +most_frequent_letter_pair('cdeabeabfcdfabgcd'); + +sub most_frequent_letter_pair { + my $s = shift; + print "Input: $s\n"; + my @letters = split //, $s; + my $map = {}; + foreach my $i (0..$#letters-1) { + my $new = $letters[$i] . $letters[$i+1]; + $map->{$new}++; + } + my @sorted = sort { $map->{$b} <=> $map->{$a} || $a cmp $b } keys %$map; + print "Output: $sorted[0]\n"; +} -- cgit From 56ed453655d987a9506a5f559e604bd211e79edf Mon Sep 17 00:00:00 2001 From: Roger Bell_West Date: Mon, 11 Dec 2023 10:21:42 +0000 Subject: RogerBW blog post for challenge no. 246 --- challenge-246/roger-bell-west/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-246/roger-bell-west/blog.txt diff --git a/challenge-246/roger-bell-west/blog.txt b/challenge-246/roger-bell-west/blog.txt new file mode 100644 index 0000000000..0f5c0a56cb --- /dev/null +++ b/challenge-246/roger-bell-west/blog.txt @@ -0,0 +1 @@ +https://blog.firedrake.org/archive/2023/12/The_Weekly_Challenge_246__Linear_49.html -- cgit From f52eeb84259418b208d965ac7f97819de86bd8de Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Mon, 11 Dec 2023 08:50:57 -0600 Subject: PWC 24 task 1 done --- challenge-247/bob-lied/README | 6 +- challenge-247/bob-lied/perl/ch-1.pl | 111 ++++++++++++++++++++++++++++++++++++ 2 files changed, 114 insertions(+), 3 deletions(-) create mode 100644 challenge-247/bob-lied/perl/ch-1.pl diff --git a/challenge-247/bob-lied/README b/challenge-247/bob-lied/README index 2c14618b4f..ddf6e99243 100644 --- a/challenge-247/bob-lied/README +++ b/challenge-247/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 246 by Bob Lied +Solutions to weekly challenge 247 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-246/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-246/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-247/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-247/bob-lied diff --git a/challenge-247/bob-lied/perl/ch-1.pl b/challenge-247/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..e201bff1d6 --- /dev/null +++ b/challenge-247/bob-lied/perl/ch-1.pl @@ -0,0 +1,111 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# part1.pl Perl Weekly Challenge 247 Task 1 Secret Santa +#============================================================================= +# Secret Santa is a Christmas tradition in which members of a group are +# randomly assigned a person to whom they give a gift. +# You are given a list of names. Write a script that tries to team persons +# from different families. The givers are randomly chosen but don't share +# family names with the receivers. +# Example 1 Input: @names = ( +# 'Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', 'Mrs. Anwar', +# 'Mr. Conway', 'Mr. Cross',); +# Output: Mr. Conway -> Mr. Wall +# Mr. Anwar -> Mrs. Wall +# Mrs. Wall -> Mr. Anwar +# Mr. Cross -> Mrs. Anwar +# Mr. Wall -> Mr. Conway +# Mrs. Anwar -> Mr. Cross +# Example 2 One gift is given to a family member. +# Input: @names = ('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar',); +# Output: Mr. Anwar -> Mr. Wall +# Mr. Wall -> Mrs. Wall +# Mrs. Wall -> Mr. Anwar +#============================================================================= + +use v5.38; +use builtin qw/true false/; no warnings "experimental::builtin"; + +use List::Util qw/all sample/; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +my $picks = secretSanta(@ARGV); +say "$_ -> $picks->{$_}" for + sort { surname($a) cmp surname($b) || $a cmp $b } keys %$picks; + +sub secretSanta(@names) +{ + return {} if ( @names < 2 ); + my %picks; +PICKEM: + my %available = map { $_ => true } @names; + for my $name (@names) + { + my @choices = grep { surname($_) ne surname($name) } keys %available; + if ( @choices == 0 ) + { + # Must pick within family, but not self + @choices = grep { $_ ne $name } keys %available; + + # If we got down to one person picking themselves, try again + if ( @choices == 0 ) + { + warn "Self-pick detected, retry"; + %picks = (); + goto PICKEM; + } + } + + my $recipient = sample 1, @choices; + delete $available{$recipient}; + + $picks{$name} = $recipient; + } + return \%picks +} + +sub surname($name) { (split(" ", $name))[-1]; } + +sub runTest +{ + use Test2::V0; + + my @names; my $picks; + @names = ( 'Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', 'Mrs. Anwar', + 'Mr. Conway', 'Mr. Cross',); + my $expect = { + 'Mr. Anwar' => 'Mrs. Wall' , + 'Mr. Conway' => 'Mr. Wall' , + 'Mr. Cross' => 'Mrs. Anwar', + 'Mr. Wall' => 'Mr. Conway', + 'Mrs. Anwar' => 'Mr. Cross' , + 'Mrs. Wall' => 'Mr. Anwar' , + }; + $picks = secretSanta(@names); + + is( scalar(keys %$picks), scalar(@names), "Enough picks"); + ok( (all { exists $picks->{$_} } @names), "All givers have a recipient"); + is( [sort @names], [sort values %$picks], "Every one gets a gift"); + ok( (all { $_ ne $picks->{$_} } @names), "No one picks themselves"); + ok( (all { surname($_) ne surname($picks->{$_}) } @names ), "All picks outside family"); + + @names = ( 'Mr. Wall', 'Mrs. Wall', 'Mr. Anwar' ); + $picks = secretSanta(@names); + + is( scalar(keys %$picks), scalar(@names), "Enough picks"); + ok( (all { exists $picks->{$_} } @names), "All givers have a recipient"); + is( [sort @names], [sort values %$picks], "Every one gets a gift"); + ok( (all { $_ ne $picks->{$_} } @names), "No one picks themselves"); + is( surname($picks->{'Mr. Anwar'}), 'Wall', "Anwar picks a Wall"); + + done_testing; +} -- cgit From cf780136eaea2075524c500d5989bcf5403d8c9b Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Mon, 11 Dec 2023 08:58:41 -0600 Subject: PWC 247 Task 2 complete --- challenge-247/bob-lied/perl/ch-2.pl | 44 +++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 challenge-247/bob-lied/perl/ch-2.pl diff --git a/challenge-247/bob-lied/perl/ch-2.pl b/challenge-247/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..07735608c3 --- /dev/null +++ b/challenge-247/bob-lied/perl/ch-2.pl @@ -0,0 +1,44 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge 247 Task 2 Most Frequent Letter Pair +#============================================================================= +# You are given a string S of lower case letters 'a'..'z'. +# Write a script that finds the pair of consecutive letters in S that +# appears most frequently. If there is more than one such pair, choose +# the one that is the lexicographically first. +# Example 1 Input: $s = 'abcdbca' +# Output: 'bc' ('bc' appears twice in `$s`) +# Example 2 Input: $s = 'cdeabeabfcdfabgcd' +# Output: 'ab' +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= + +use v5.38; + +use builtin qw/true false/; no warnings "experimental::builtin"; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +sub mflp($s) +{ + my %freq; + $freq{$_}++ for map { substr($s, $_, 2) } 0 .. (length($s)-2); + return (sort { $freq{$b} <=> $freq{$a} || $a cmp $b } keys %freq)[0]; +} + +sub runTest +{ + use Test2::V0; + + is( mflp("abcdbca"), 'bc', "Example 1"); + is( mflp("cdeabeabfcdfabgcd"), 'ab', "Example 2"); + + done_testing; +} -- cgit From 321ee201cc101575264dd4ac8a8cd70bd96e31a6 Mon Sep 17 00:00:00 2001 From: Niels van Dijke Date: Mon, 11 Dec 2023 15:17:39 +0000 Subject: w247 - Task 1 & 2 --- challenge-247/perlboy1967/perl/ch1.pl | 82 +++++++++++++++++++++++++++++++++++ challenge-247/perlboy1967/perl/ch2.pl | 49 +++++++++++++++++++++ 2 files changed, 131 insertions(+) create mode 100755 challenge-247/perlboy1967/perl/ch1.pl create mode 100755 challenge-247/perlboy1967/perl/ch2.pl diff --git a/challenge-247/perlboy1967/perl/ch1.pl b/challenge-247/perlboy1967/perl/ch1.pl new file mode 100755 index 0000000000..d41ed73cd6 --- /dev/null +++ b/challenge-247/perlboy1967/perl/ch1.pl @@ -0,0 +1,82 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 247 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-247 + +Author: Niels 'PerlBoy' van Dijke + +Task 1: Secret Santa +Submitted by: Andreas Voegele + +Secret Santa is a Christmas tradition in which members of a group are randomly +assigned a person to whom they give a gift. + +You are given a list of names. Write a script that tries to team persons from +different families. + +=cut + +use v5.32; +use common::sense; +use feature qw(signatures); + +use Test2::V0 -srand => 247; + +use List::Util qw(shuffle); + +sub nameSort { + my @a = split(/\s+/,$a); + my @b = split(/\s+/,$b); + return $a[1] cmp $b[1] || $a[0] cmp $b[0]; +} + +sub secretSanta(@names1) { + my @names2 = shuffle @names1; + my @assignments; + + while (my $name1 = shift(@names1)) { + my ($lastname1) = $name1 =~ m#(\S+)$#; + if ($#names2 > 1) { + while ($names2[0] =~ m#(\S+)$# and $lastname1 eq $1) { + push(@names2,shift @names2); + } + } + push(@assignments,sprintf("%s -> %s",$name1,shift @names2)); + } + + [sort nameSort @assignments]; +} + +is(secretSanta( + 'Mr. Wall', + 'Mrs. Wall', + 'Mr. Anwar', + 'Mrs. Anwar', + 'Mr. Conway', + 'Mr. Cross', + ), + [ + 'Mr. Anwar -> Mr. Cross', + 'Mrs. Anwar -> Mrs. Wall', + 'Mr. Conway -> Mr. Wall', + 'Mr. Cross -> Mrs. Anwar', + 'Mr. Wall -> Mr. Conway', + 'Mrs. Wall -> Mr. Anwar', + ] +); + +is(secretSanta( + 'Mr. Wall', + 'Mrs. Wall', + 'Mr. Anwar', + ), + [ + 'Mr. Anwar -> Mrs. Wall', + 'Mr. Wall -> Mr. Anwar', + 'Mrs. Wall -> Mr. Wall', + ] +); + +done_testing; diff --git a/challenge-247/perlboy1967/perl/ch2.pl b/challenge-247/perlboy1967/perl/ch2.pl new file mode 100755 index 0000000000..62f9106db7 --- /dev/null +++ b/challenge-247/perlboy1967/perl/ch2.pl @@ -0,0 +1,49 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 247 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-247 + +Author: Niels 'PerlBoy' van Dijke + +Task 2: Most Frequent Letter Pair +Submitted by: Jorg Sommrey + +You are given a string S of lower case letters 'a'..'z'. + +Write a script that finds the pair of consecutive letters in S that appears most frequently. +If there is more than one such pair, chose the one that is the lexicographically first. + +=cut + +use v5.32; +use common::sense; +use feature qw(signatures); + +use Test2::V0; + +use List::Util qw(uniq max); +use Algorithm::Combinatorics qw(variations); + +sub mostFrequentLetterPair($string) { + my @chars = uniq sort split //, $string; + my $l = length $string; + + my %count; + + for my $p (variations(\@chars,2)) { + next if $$p[0] eq $$p[1]; + my $c2 = $$p[0].$$p[1]; + $count{$c2} = ($l - length ($string =~ s/$c2//gr))/2; + } + + my $m = max(values %count); + + return (sort grep { $count{$_} == $m } keys %count)[0]; +} + +is(mostFrequentLetterPair('abcdbca'),'bc'); +is(mostFrequentLetterPair('cdeabeabfcdfabgcd'),'ab'); + +done_testing; -- cgit From 6b06b651e965daa48ef377714890218037768e68 Mon Sep 17 00:00:00 2001 From: Peter Campbell Smith Date: Mon, 11 Dec 2023 16:39:15 +0000 Subject: Week 247 - Christmas is coming! --- challenge-247/peter-campbell-smith/blog.txt | 1 + challenge-247/peter-campbell-smith/perl/ch-1.pl | 55 +++++++++++++++++++++++++ challenge-247/peter-campbell-smith/perl/ch-2.pl | 37 +++++++++++++++++ 3 files changed, 93 insertions(+) create mode 100644 challenge-247/peter-campbell-smith/blog.txt create mode 100755 challenge-247/peter-campbell-smith/perl/ch-1.pl create mode 100755 challenge-247/peter-campbell-smith/perl/ch-2.pl diff --git a/challenge-247/peter-campbell-smith/blog.txt b/challenge-247/peter-campbell-smith/blog.txt new file mode 100644 index 0000000000..0734455d93 --- /dev/null +++ b/challenge-247/peter-campbell-smith/blog.txt @@ -0,0 +1 @@ +http://ccgi.campbellsmiths.force9.co.uk/challenge/247 diff --git a/challenge-247/peter-campbell-smith/perl/ch-1.pl b/challenge-247/peter-campbell-smith/perl/ch-1.pl new file mode 100755 index 0000000000..9c6725c2db --- /dev/null +++ b/challenge-247/peter-campbell-smith/perl/ch-1.pl @@ -0,0 +1,55 @@ +#!/usr/bin/perl + +use v5.26; # The Weekly Challenge - 2023-12-11 +use utf8; # Week 247 task 1 - Secret santa +use strict; # Peter Campbell Smith +use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +secret_santa('Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', + 'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross', + 'Miss Anwar', 'Dr Anwar', 'Lord Anwar'); + +secret_santa('Rudolph Reindeer', 'Dasher Reindeer', 'Dancer Reindeer', + 'Prancer Reindeer', 'Vixen Reindeer','Comet Reindeer', + 'Cupid Reindeer', 'Donner Reindeer', 'Blitzen Reindeer', + 'Santa Claus', 'Mrs Claus', 'Subordinate Claus'); + +sub secret_santa { + + my (%people, %recipient, $d, $r, $result, $list, $j); + + # initialise + $people{$_} = int(rand(899) + 101) for (@_); + $list = ' '; + + # find someone with a different surname + D: for $d (sort {$people{$a} <=> $people{$b}} keys %people) { + $list .= $d . ($j ++ % 3 == 2 ? qq[,\n ] : ', '); + for $r (sort {$people{$b} <=> $people{$a}} keys %people) { + next if ($d eq $r or $people{$r} == 0); + if (surname($d) ne surname($r)) { + $result .= qq[ $d -> $r\n]; + $people{$r} = 0; + next D; + } + } + + # no luck, so try for wih the same one + for $r (sort {$people{$a} <=> $people{$b}} keys %people) { + next if ($d eq $r or $people{$r} == 0); + $result .= qq[ $d -> $r\n]; + $people{$r} = 0; + next D; + } + } + + # show results + $list =~ s|,[\n ]+$||; + say qq[\nInput:\n$list]; + say qq[Output:\n] . substr($result, 0, -1); +} + +sub surname { + $_[0] =~ m|([-a-zA-Z']*)$|; + return $1; +} \ No newline at end of file diff --git a/challenge-247/peter-campbell-smith/perl/ch-2.pl b/challenge-247/peter-campbell-smith/perl/ch-2.pl new file mode 100755 index 0000000000..3c61498857 --- /dev/null +++ b/challenge-247/peter-campbell-smith/perl/ch-2.pl @@ -0,0 +1,37 @@ +#!/usr/bin/perl + +use v5.26; # The Weekly Challenge - 2023-12-11 +use utf8; # Week 247 task 2 - Most frequent letter pair +use strict; # Peter Campbell Smith +use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +most_frequent('cdeabeabfcdfabgcd'); +most_frequent('abcdefghijklmnopqrstuvwxyz'); +most_frequent('nowisthetimeforallgoodmentocometotheaidoftheparty'); +most_frequent('zyxwvutsrqponmlkjihgfedcba'); +most_frequent('ghghijijij'); + +sub most_frequent { + + my ($x, $string, $pair, $count, $best, $most); + + # initialise + $string = $_[0]; + $best = ''; + $most = 0; + + # loop over ab, bc, cd ... + for $x ('a' .. 'y') { + $pair = $x . chr(ord($x) + 1); + + # count matches in string + $count = () = $string =~ m|$pair|g; + if ($count > $most) { + $best = $pair; + $most = $count; + } + } + + # output results + say qq[\nInput: \$s = '$string'\nOutput: ] . ($most ? qq['$best' x $most] : 'none'); +} -- cgit From 18ccf43b3283e1e5057bcae693801b906a520fb7 Mon Sep 17 00:00:00 2001 From: pme Date: Mon, 11 Dec 2023 18:57:02 +0100 Subject: challenge-247 --- challenge-247/peter-meszaros/perl/ch-1.pl | 122 ++++++++++++++++++++++++++++++ challenge-247/peter-meszaros/perl/ch-2.pl | 55 ++++++++++++++ 2 files changed, 177 insertions(+) create mode 100755 challenge-247/peter-meszaros/perl/ch-1.pl create mode 100755 challenge-247/peter-meszaros/perl/ch-2.pl diff --git a/challenge-247/peter-meszaros/perl/ch-1.pl b/challenge-247/peter-meszaros/perl/ch-1.pl new file mode 100755 index 0000000000..9527af57a6 --- /dev/null +++ b/challenge-247/peter-meszaros/perl/ch-1.pl @@ -0,0 +1,122 @@ +#!/usr/bin/env perl +# +# Secret Santa is a Christmas tradition in which members of a group are +# randomly assigned a person to whom they give a gift. +# +# You are given a list of names. Write a script that tries to team persons from +# different families. +# Example 1 +# +# The givers are randomly chosen but don't share family names with the +# receivers. +# +# Input: @names = ('Mr. Wall', +# 'Mrs. Wall', +# 'Mr. Anwar', +# 'Mrs. Anwar', +# 'Mr. Conway', +# 'Mr. Cross', +# ); +# +# Output: +# +# Mr. Conway -> Mr. Wall +# Mr. Anwar -> Mrs. Wall +# Mrs. Wall -> Mr. Anwar +# Mr. Cross -> Mrs. Anwar +# Mr. Wall -> Mr. Conway +# Mrs. Anwar -> Mr. Cross +# +# Example 2 +# +# One gift is given to a family member. +# +# Input: @names = ('Mr. Wall', +# 'Mrs. Wall', +# 'Mr. Anwar', +# ); +# +# Output: +# +# Mr. Anwar -> Mr. Wall +# Mr. Wall -> Mrs. Wall +# Mrs. Wall -> Mr. Anwar + + +use strict; +use warnings; +use Test::More; +use Data::Dumper; +use Algorithm::Combinatorics qw/combinations/; + +my $cases = [ + ['Mr. Wall', + 'Mrs. Wall', + 'Mr. Anwar', + 'Mrs. Anwar', + 'Mr. Conway', + 'Mr. Cross', + ], + ['Mr. Wall', + 'Mrs. Wall', + 'Mr. Anwar', + ], +]; + +sub secret_santa +{ + my $names = shift; + + # generate all possible actions + my @actions; + for my $p1 (@$names) { + my ($t1, $n1) = split(' ', $p1); + for my $p2 (@$names) { + next if $p1 eq $p2; + my ($t2, $n2) = split(' ', $p2); + next if $n1 eq $n2; + push @actions, [$p1, $p2]; + } + } + + # generate all possible actions sets + my $ret = 0; + my $iter = combinations(\@actions, scalar @$names); + while (my $c = $iter->next) { + my %stat = map { $_ => []} @$names; + + # collect statistics on actions + for my $action (@$c) { + my ($n0, $n1) = @$action; + $stat{$n0}->[0]++; + $stat{$n1}->[1]++; + } + + # evaluate statistics + my $ok = 1; + for my $k (keys %stat) { + my ($v1, $v2) = $stat{$k}->@*; + if (!defined $v1 or $v1 != 1 or !defined $v2 or $v2 != 1) { + $ok = 0; + last; + } + } + # print the winner + if ($ok) { + for my $action (@$c) { + my ($n0, $n1) = @$action; + print "$n0 -> $n1\n"; + } + $ret = 1; + last; + } + } + + return $ret; +} + +is(secret_santa($cases->[0]), 1, 'big set'); +is(secret_santa($cases->[1]), 0, 'small set'); +done_testing(); + +exit 0; diff --git a/challenge-247/peter-meszaros/perl/ch-2.pl b/challenge-247/peter-meszaros/perl/ch-2.pl new file mode 100755 index 0000000000..1fc9363f1c --- /dev/null +++ b/challenge-247/peter-meszaros/perl/ch-2.pl @@ -0,0 +1,55 @@ +#!/usr/bin/env perl +# +# You are given a string S of lower case letters 'a'..'z'. +# +# Write a script that finds the pair of consecutive letters in S that appears +# most frequently. If there is more than one such pair, chose the one that is the +# lexicographically first. +# Example 1 +# +# Input: $s = 'abcdbca' +# Output: 'bc' +# +# 'bc' appears twice in `$s` +# +# Example 2 +# +# Input: $s = 'cdeabeabfcdfabgcd' +# Output: 'ab' +# +# 'ab' and 'cd' both appear three times in $s and 'ab' is lexicographically +# smaller than 'cd'. +# + +use strict; +use warnings; +use Test::More; +use Data::Dumper; + +my $cases = [ + 'abcdbca', + 'cdeabeabfcdfabgcd', +]; + +sub most_frequent_pair +{ + my $s = shift; + + my @s = split('', $s); + my %h; + for my $l (0..($#s-1)) { + $h{$s[$l].$s[$l+1]}++; + } + return (sort {$h{$b} == $h{$a} ? + $a cmp $b : + $h{$b} <=> $h{$a} + } keys %h)[0]; +} + +is(most_frequent_pair($cases->[0]), 'bc', 'abcdbca'); +is(most_frequent_pair($cases->[1]), 'ab', 'cdeabeabfcdfabgcd'); +done_testing(); + +exit 0; + + -- cgit From e02f9a7b14d59e6c4be8d0f2dbd0fae021111654 Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 11 Dec 2023 20:56:13 +0000 Subject: Challenge 247 Solutions (Raku) --- challenge-247/mark-anderson/raku/ch-1.raku | 23 +++++++++++++++++++++++ challenge-247/mark-anderson/raku/ch-2.raku | 18 +++++++++++++++++- 2 files changed, 40 insertions(+), 1 deletion(-) diff --git a/challenge-247/mark-anderson/raku/ch-1.raku b/challenge-247/mark-anderson/raku/ch-1.raku index a3ae0d336a..723065ba5a 100644 --- a/challenge-247/mark-anderson/raku/ch-1.raku +++ b/challenge-247/mark-anderson/raku/ch-1.raku @@ -19,6 +19,29 @@ is-deeply secret-santa(["Mr. Wall", "Mrs. Wall", "Mr. Anwar"]), "Mrs. Wall" => "Mr. Wall" } +# Example from Peter Campbell Smith +is-deeply secret-santa(["Rudolph Reindeer", "Dasher Reindeer", + "Dancer Reindeer", "Prancer Reindeer", + "Vixen Reindeer", "Comet Reindeer", + "Cupid Reindeer", "Donner Reindeer", + "Blitzen Reindeer", "Santa Claus", + "Mrs Claus", "Subordinate Claus"]), + + { + "Donner Reindeer" => "Mrs Claus", + "Blitzen Reindeer" => "Subordinate Claus", + "Cupid Reindeer" => "Santa Claus", + "Dancer Reindeer" => "Dasher Reindeer", + "Comet Reindeer" => "Vixen Reindeer", + "Dasher Reindeer" => "Rudolph Reindeer", + "Vixen Reindeer" => "Prancer Reindeer", + "Rudolph Reindeer" => "Blitzen Reindeer", + "Prancer Reindeer" => "Dancer Reindeer", + "Santa Claus" => "Comet Reindeer", + "Subordinate Claus" => "Donner Reindeer", + "Mrs Claus" => "Cupid Reindeer", + } + sub secret-santa(@names) { my %surname = @names.classify({ .words[1] }); diff --git a/challenge-247/mark-anderson/raku/ch-2.raku b/challenge-247/mark-anderson/raku/ch-2.raku index 532186b18e..82ab53feb8 100644 --- a/challenge-247/mark-anderson/raku/ch-2.raku +++ b/challenge-247/mark-anderson/raku/ch-2.raku @@ -4,7 +4,23 @@ use Test; is most-freq-pair("abcdbca"), "bc"; is most-freq-pair("cdeabeabfcdfabgcd"), "ab"; -sub most-freq-pair($str) +say most-freq-pair([~] ("a".."z").roll(100_000)); + +multi most-freq-pair($str where .chars < 100_000) { ($str ~~ m:ov/../)>>.Str.Bag.maxpairs.sort.head.key } + +multi most-freq-pair($str) +{ + my $len = ($str.chars / $*KERNEL.cpu-cores).ceiling; + + my @promises = (^$*KERNEL.cpu-cores).map( + { + start { ($str.substr(($len * $_), $len+1) ~~ m:ov/../)>>.Str.Bag } + }); + + await @promises; + + ([(+)] @promises>>.result).maxpairs.sort.head.key +} -- cgit From 42019e9f67123f9aade27603bda5ae1454dc23be Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 11 Dec 2023 21:00:38 +0000 Subject: Challenge 247 Solutions (Raku) --- challenge-247/mark-anderson/raku/ch-1.raku | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-247/mark-anderson/raku/ch-1.raku b/challenge-247/mark-anderson/raku/ch-1.raku index 723065ba5a..9ed0228dbd 100644 --- a/challenge-247/mark-anderson/raku/ch-1.raku +++ b/challenge-247/mark-anderson/raku/ch-1.raku @@ -23,7 +23,7 @@ is-deeply secret-santa(["Mr. Wall", "Mrs. Wall", "Mr. Anwar"]), is-deeply secret-santa(["Rudolph Reindeer", "Dasher Reindeer", "Dancer Reindeer", "Prancer Reindeer", "Vixen Reindeer", "Comet Reindeer", - "Cupid Reindeer", "Donner Reindeer", + "Cupid Reindeer", "Donner Reindeer", "Blitzen Reindeer", "Santa Claus", "Mrs Claus", "Subordinate Claus"]), -- cgit From 89ad3788c843e54cf9fa097a7e1010219b889cc9 Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 11 Dec 2023 21:07:52 +0000 Subject: Challenge 247 Solutions (Raku) --- challenge-247/mark-anderson/raku/ch-1.raku | 1 - 1 file changed, 1 deletion(-) diff --git a/challenge-247/mark-anderson/raku/ch-1.raku b/challenge-247/mark-anderson/raku/ch-1.raku index 9ed0228dbd..fe6c4163c4 100644 --- a/challenge-247/mark-anderson/raku/ch-1.raku +++ b/challenge-247/mark-anderson/raku/ch-1.raku @@ -26,7 +26,6 @@ is-deeply secret-santa(["Rudolph Reindeer", "Dasher Reindeer", "Cupid Reindeer", "Donner Reindeer", "Blitzen Reindeer", "Santa Claus", "Mrs Claus", "Subordinate Claus"]), - { "Donner Reindeer" => "Mrs Claus", "Blitzen Reindeer" => "Subordinate Claus", -- cgit From 908aa39a6d95d19cbe8f59dc56918676ccca5976 Mon Sep 17 00:00:00 2001 From: Dave Jacoby Date: Mon, 11 Dec 2023 16:08:54 -0500 Subject: solved 247 --- challenge-247/dave-jacoby/blog.txt | 1 + challenge-247/dave-jacoby/perl/ch-1.pl | 62 ++++++++++++++++++++++++++++++++++ challenge-247/dave-jacoby/perl/ch-2.pl | 32 ++++++++++++++++++ 3 files changed, 95 insertions(+) create mode 100644 challenge-247/dave-jacoby/blog.txt create mode 100644 challenge-247/dave-jacoby/perl/ch-1.pl create mode 100644 challenge-247/dave-jacoby/perl/ch-2.pl diff --git a/challenge-247/dave-jacoby/blog.txt b/challenge-247/dave-jacoby/blog.txt new file mode 100644 index 0000000000..6bd07983bc --- /dev/null +++ b/challenge-247/dave-jacoby/blog.txt @@ -0,0 +1 @@ +https://jacoby.github.io/2023/12/11/partidges-and-pair-trees-weekly-challenge-247.html diff --git a/challenge-247/dave-jacoby/perl/ch-1.pl b/challenge-247/dave-jacoby/perl/ch-1.pl new file mode 100644 index 0000000000..d96619aa19 --- /dev/null +++ b/challenge-247/dave-jacoby/perl/ch-1.pl @@ -0,0 +1,62 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use experimental qw{ say postderef signatures state }; + +my @examples = ( + + [ + 'Mr. Wall', + 'Mrs. Wall', + 'Mr. Anwar', + 'Mrs. Anwar', + 'Mr. Conway', + 'Mr. Cross', + ], + + [ 'Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', ], +); + +for my $example (@examples) { + my %output = secret_santa( $example->@* ); + my $input = join ",\n\t", + map { qq{"$_"} } # quote surname + map { $_->[0] } # remove surname element + sort { $a->[1] cmp $b->[1] } # sort on surname + map { [ $_, ( reverse split /\s/, $_ )[0] ] } # start schartzian transform on surname + sort { $a cmp $b } $example->@*; # sort alphabetically for consistency + my $output = join "\n\t", + map { qq{$_ -> $output{$_}} } # combine santa and giftee + map { $_->[0] } # remove surname element + sort { $a->[1] cmp $b->[1] } # sort on surname + map { [ $_, ( reverse split /\s/, $_ )[0] ] } # start schartzian transform on surname + sort { $a cmp $b } keys %output; # sort alphabetically for consistency + + say <<~"END"; + Input: \$input = ( + $input + ); + Output: + $output + END + +} + +# 1) everybody gets matched +# 2) nobody gets matched to themself +sub secret_santa (@input) { + my %done; + + for my $name (@input) { + my %chosen = reverse %done; + my @others = + sort { rand 10 <=> rand 10 } + grep { $_ ne $name } @input; + for my $giftee (@others) { + next if $chosen{$giftee}; + $done{$name} = $giftee; + } + } + return %done; +} diff --git a/challenge-247/dave-jacoby/perl/ch-2.pl b/challenge-247/dave-jacoby/perl/ch-2.pl new file mode 100644 index 0000000000..cdc7dabc15 --- /dev/null +++ b/challenge-247/dave-jacoby/perl/ch-2.pl @@ -0,0 +1,32 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use experimental qw{ say postderef signatures state }; + +my @examples = ( + + 'abcdbca', + 'cdeabeabfcdfabgcd', +); + +for my $e (@examples) { + my $output = most_frequent_letter_pair($e); + + say <<~"END"; + Input: \$input = '$e' + Output: '$output' + END +} + +sub most_frequent_letter_pair ($string) { + my %data; + for my $i ( 0 .. -2 + length $string ) { + my $sub = substr $string, $i, 2; + $data{$sub}++; + } + # ($scalar) = @list will assign the first element in the list to $scalar + my ($first) = sort { $data{$b} <=> $data{$a} } # second sort on value + sort keys %data; # first sort on lexographic value + return $first; +} -- cgit From 80ae4abbbd0c764ed3452bcb9261a37d76faf7b5 Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 11 Dec 2023 21:20:42 +0000 Subject: Challenge 247 Solutions (Raku) --- challenge-247/mark-anderson/raku/ch-1.raku | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/challenge-247/mark-anderson/raku/ch-1.raku b/challenge-247/mark-anderson/raku/ch-1.raku index fe6c4163c4..3e3e059503 100644 --- a/challenge-247/mark-anderson/raku/ch-1.raku +++ b/challenge-247/mark-anderson/raku/ch-1.raku @@ -25,9 +25,9 @@ is-deeply secret-santa(["Rudolph Reindeer", "Dasher Reindeer", "Vixen Reindeer", "Comet Reindeer", "Cupid Reindeer", "Donner Reindeer", "Blitzen Reindeer", "Santa Claus", - "Mrs Claus", "Subordinate Claus"]), + "Mrs. Claus", "Subordinate Claus"]), { - "Donner Reindeer" => "Mrs Claus", + "Donner Reindeer" => "Mrs. Claus", "Blitzen Reindeer" => "Subordinate Claus", "Cupid Reindeer" => "Santa Claus", "Dancer Reindeer" => "Dasher Reindeer", @@ -38,7 +38,7 @@ is-deeply secret-santa(["Rudolph Reindeer", "Dasher Reindeer", "Prancer Reindeer" => "Dancer Reindeer", "Santa Claus" => "Comet Reindeer", "Subordinate Claus" => "Donner Reindeer", - "Mrs Claus" => "Cupid Reindeer", + "Mrs. Claus" => "Cupid Reindeer", } sub secret-santa(@names) -- cgit From 7e80ee4cbca65a5ae322ab03d1f512201f5d029f Mon Sep 17 00:00:00 2001 From: David Ferrone Date: Mon, 11 Dec 2023 16:58:39 -0500 Subject: Week 247 --- challenge-247/zapwai/perl/ch-1.pl | 80 +++++++++++++++++++++++++++++++++++++++ challenge-247/zapwai/perl/ch-2.pl | 24 ++++++++++++ 2 files changed, 104 insertions(+) create mode 100644 challenge-247/zapwai/perl/ch-1.pl create mode 100644 challenge-247/zapwai/perl/ch-2.pl diff --git a/challenge-247/zapwai/perl/ch-1.pl b/challenge-247/zapwai/perl/ch-1.pl new file mode 100644 index 0000000000..40a1ce096e --- /dev/null +++ b/challenge-247/zapwai/perl/ch-1.pl @@ -0,0 +1,80 @@ +use v5.30; +use Algorithm::Permute; +my @names = ('Mr. Wall', + 'Mrs. Wall', + 'Mr. Anwar', + 'Mrs. Anwar', + 'Mr. Conway', + 'Mr. Cross', + ); +#@names = ('Mr. Wall', 'Mrs. Wall', 'Mr. Cringle'); + +say "Input: \@names = (". join(", ", @names) . ")"; +say "Output: "; +my @seq; +my @tried; +my $endflag = 1; +my $N = factorial(scalar @names); +my $index = int rand $N; +my @P; +load_perms(); + +do { + @seq = random_pls($index); + if (check(@seq)) { + $endflag = 0; + } else { + $endflag++; + push @tried, $index; + my $test_string = join(" ", @tried); + my $flag = 0; + my $x; + do { + $x = int rand $N; + unless ( $test_string =~ m/$x/ ) { + $flag = 1; + } + } until ($flag); + $index = $x; + } +} until ( ($endflag == 0) or ($endflag == $N) ); + +foreach my $i (0 .. $#seq - 1) { + print $names[$seq[$i]] . " --> "; +} +print $names[$seq[$#seq]]."\n"; + + +sub load_perms { + my $p = Algorithm::Permute->new([0 .. $#names]); + while (my @perm = $p->next) { + push @P, \@perm; + } +} + +sub random_pls { + my $index = shift; + return @{$P[$index]}; +} + +sub factorial { + my ($n) = @_; + return 1 if $n == 0; + return factorial($n-1) * $n; +} + +sub check { + my @seq = @_; + my @surname; + foreach my $name (@names) { + my @chunk = split(" ", $name); + push @surname, $chunk[1]; + } + for my $i (0 .. $#seq - 1) { + if ($surname[$seq[$i]] eq $surname[$seq[$i + 1]]) { + return 0; + } + } + return 0 if ($surname[$seq[0]] eq $surname[$seq[$#seq]]); + return 1; +} diff --git a/challenge-247/zapwai/perl/ch-2.pl b/challenge-247/zapwai/perl/ch-2.pl new file mode 100644 index 0000000000..ff5f27ef6a --- /dev/null +++ b/challenge-247/zapwai/perl/ch-2.pl @@ -0,0 +1,24 @@ +use v5.30; +my $s = "abcdbca"; +my $s = "cdeabeabfcdfabgcd"; +my %h; +my @pairs; +my $max = 0; +foreach my $i (0 .. (length $s) - 2) { + my $nom = substr $s, $i, 2; + $h{$nom}++; +} +foreach my $key (keys %h) { + if ($max < $h{$key}) { + $max = $h{$key}; + } +} +foreach my $key (keys %h) { + push @pairs, $key if ($max == $h{$key}); +} +my $ans = $pairs[0]; +foreach my $pair ( @pairs ) { + $ans = $pair if ($pair le $ans); +} +say "Input: \$s = $s"; +say "Output: $ans"; -- cgit From 190283aa37525a7bc2797f6dbf4db84efb46b2c5 Mon Sep 17 00:00:00 2001 From: Luis Mochan Date: Mon, 11 Dec 2023 21:51:21 -0600 Subject: Solve PWC247 --- challenge-247/wlmb/blog.txt | 1 + challenge-247/wlmb/perl/ch-1.pl | 26 ++++++++++++++++++++++++++ challenge-247/wlmb/perl/ch-2.pl | 19 +++++++++++++++++++ 3 files changed, 46 insertions(+) create mode 100644 challenge-247/wlmb/blog.txt create mode 100755 challenge-247/wlmb/perl/ch-1.pl create mode 100755 challenge-247/wlmb/perl/ch-2.pl diff --git a/challenge-247/wlmb/blog.txt b/challenge-247/wlmb/blog.txt new file mode 100644 index 0000000000..fb01e3096f --- /dev/null +++ b/challenge-247/wlmb/blog.txt @@ -0,0 +1 @@ +https://wlmb.github.io/2023/12/11/PWC247/ diff --git a/challenge-247/wlmb/perl/ch-1.pl b/challenge-247/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..5f20b58274 --- /dev/null +++ b/challenge-247/wlmb/perl/ch-1.pl @@ -0,0 +1,26 @@ +#!/usr/bin/env perl +# Perl weekly challenge 247 +# Task 1: Secret Santa +# +# See https://wlmb.github.io/2023/12/11/PWC247/#task-1-secret-santa +use v5.36; +use experimental qw(postderef); +my %last_name; +my %person; +# Input from STDIN, one name per line +while(<>){ + chomp; + my (undef,$last)=split " "; + $last_name{$_}=$last; + push $person{$last}->@*, $_; +} +my @families=sort {$person{$b}->@*<=>$person{$a}->@*} keys %person; +my $first_giver; +while(@families){ + my $family_giver=shift @families; + my $giver=shift $person{$family_giver}->@*; + $first_giver//=$giver; + push @families, $family_giver if $person{$family_giver}->@*; + my $receiver=$families[0]?$person{$families[0]}[0]:$first_giver; + say "$giver -> $receiver"; +} diff --git a/challenge-247/wlmb/perl/ch-2.pl b/challenge-247/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..1bb4c00ce0 --- /dev/null +++ b/challenge-247/wlmb/perl/ch-2.pl @@ -0,0 +1,19 @@ +#!/usr/bin/env perl +# Perl weekly challenge 247 +# Task 2: Most Frequent Letter Pair +# +# See https://wlmb.github.io/2023/12/11/PWC247/#task-2-most-frequent-letter-pair +use v5.36; +die <<~"FIN" unless @ARGV; + Usage: $0 S1 [S2...] + to find the most frequent pair of consecutive letters + from each of the strings S1, S2... + FIN +for(@ARGV){ + my @letters=split ""; + my $first=shift @letters; + my %count; + $count{$_}++ for map{my $previous=$first; $first=$_; "$previous$first"}@letters; + my @sorted =sort{$count{$b}<=>$count{$a}||$a cmp $b} keys %count; + say "$_ -> $sorted[0]" +} -- cgit From 3839b4b035697af7edd9ac1ad6c720ab6cd003e0 Mon Sep 17 00:00:00 2001 From: Roger Bell_West Date: Tue, 12 Dec 2023 09:39:32 +0000 Subject: RogerBW solutions for challenge no. 247 --- challenge-247/roger-bell-west/javascript/ch-1.js | 52 +++++ challenge-247/roger-bell-west/javascript/ch-2.js | 32 +++ challenge-247/roger-bell-west/kotlin/ch-1.kt | 50 +++++ challenge-247/roger-bell-west/kotlin/ch-2.kt | 31 +++ challenge-247/roger-bell-west/lua/ch-1.lua | 69 ++++++ challenge-247/roger-bell-west/lua/ch-2.lua | 40 ++++ challenge-247/roger-bell-west/perl/ch-1.pl | 45 ++++ challenge-247/roger-bell-west/perl/ch-2.pl | 23 ++ challenge-247/roger-bell-west/postscript/ch-1.ps | 192 ++++++++++++++++ challenge-247/roger-bell-west/postscript/ch-2.ps | 272 +++++++++++++++++++++++ challenge-247/roger-bell-west/python/ch-1.py | 40 ++++ challenge-247/roger-bell-west/python/ch-2.py | 25 +++ challenge-247/roger-bell-west/raku/ch-1.p6 | 43 ++++ challenge-247/roger-bell-west/raku/ch-2.p6 | 19 ++ challenge-247/roger-bell-west/ruby/ch-1.rb | 52 +++++ challenge-247/roger-bell-west/ruby/ch-2.rb | 31 +++ challenge-247/roger-bell-west/rust/ch-1.rs | 61 +++++ challenge-247/roger-bell-west/rust/ch-2.rs | 30 +++ challenge-247/roger-bell-west/scala/ch-1.scala | 51 +++++ challenge-247/roger-bell-west/scala/ch-2.scala | 33 +++ challenge-247/roger-bell-west/tests.yaml | 22 ++ 21 files changed, 1213 insertions(+) create mode 100755 challenge-247/roger-bell-west/javascript/ch-1.js create mode 100755 challenge-247/roger-bell-west/javascript/ch-2.js create mode 100644 challenge-247/roger-bell-west/kotlin/ch-1.kt create mode 100644 challenge-247/roger-bell-west/kotlin/ch-2.kt create mode 100755 challenge-247/roger-bell-west/lua/ch-1.lua create mode 100755 challenge-247/roger-bell-west/lua/ch-2.lua create mode 100755 challenge-247/roger-bell-west/perl/ch-1.pl create mode 100755 challenge-247/roger-bell-west/perl/ch-2.pl create mode 100644 challenge-247/roger-bell-west/postscript/ch-1.ps create mode 100644 challenge-247/roger-bell-west/postscript/ch-2.ps create mode 100755 challenge-247/roger-bell-west/python/ch-1.py create mode 100755 challenge-247/roger-bell-west/python/ch-2.py create mode 100755 challenge-247/roger-bell-west/raku/ch-1.p6 create mode 100755 challenge-247/roger-bell-west/raku/ch-2.p6 create mode 100755 challenge-247/roger-bell-west/ruby/ch-1.rb create mode 100755 challenge-247/roger-bell-west/ruby/ch-2.rb create mode 100755 challenge-247/roger-bell-west/rust/ch-1.rs create mode 100755 challenge-247/roger-bell-west/rust/ch-2.rs create mode 100644 challenge-247/roger-bell-west/scala/ch-1.scala create mode 100644 challenge-247/roger-bell-west/scala/ch-2.scala create mode 100644 challenge-247/roger-bell-west/tests.yaml diff --git a/challenge-247/roger-bell-west/javascript/ch-1.js b/challenge-247/roger-bell-west/javascript/ch-1.js new file mode 100755 index 0000000000..e63be00da6 --- /dev/null +++ b/challenge-247/roger-bell-west/javascript/ch-1.js @@ -0,0 +1,52 @@ +#! /usr/bin/node + +"use strict" + +function secretsanta(name) { + let family = []; + for (let n of name) { + let surname = n.split(" "); + family.push(surname[surname.length - 1]); + } + let receivers = new Set(Array(name.length).fill().map((element, index) => index)); + let gifting = []; + for (let giver = 0; giver < name.length; giver++) { + let done = false; + let r = 0; + for (let recipient of receivers) { + if (family[giver] != family[recipient]) { + r = recipient; + done = true; + break; + } + } + if (!done) { + for (let recipient of receivers) { + if (recipient != giver) { + r = recipient; + break; + } + } + } + receivers.delete(r) + gifting.push([name[giver], name[r]]); + } + for (let p of gifting) { + console.log("%s -> %s", p[0], p[1]); + } + console.log(""); + return true; +} + +if (secretsanta(['Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', 'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross'])) { + process.stdout.write("Pass"); +} else { + process.stdout.write("FAIL"); +} +process.stdout.write(" "); +if (secretsanta(['Mr. Wall', 'Mrs. Wall', 'Mr. Anwar'])) { + process.stdout.write("Pass"); +} else { + process.stdout.write("FAIL"); +} +process.stdout.write("\n"); diff --git a/challenge-247/roger-bell-west/javascript/ch-2.js b/challenge-247/roger-bell-west/javascript/ch-2.js new file mode 100755 index 0000000000..6ba8875493 --- /dev/null +++ b/challenge-247/roger-bell-west/javascript/ch-2.js @@ -0,0 +1,32 @@ +#! /usr/bin/node + +"use strict" + +function mostfrequentletterpair(s) { + let f = new Map; + for (let i = 0; i < s.length - 1; i++) { + let pair = s.substring(i, i + 2); + if (f.has(pair)) { + f.set(pair,f.get(pair)+1); + } else { + f.set(pair,1); + } + } + const m = Math.max(...f.values()); + let l = Array.from(f.keys()).filter(i => f.get(i) == m); + l.sort(); + return l[0]; +} + +if (mostfrequentletterpair('abcdbca') == 'bc') { + process.stdout.write("Pass"); +} else { + process.stdout.write("FAIL"); +} +process.stdout.write(" "); +if (mostfrequentletterpair('cdeabeabfcdfabgcd') == 'ab') { + process.stdout.write("Pass"); +} else { + process.stdout.write("FAIL"); +} +process.stdout.write("\n"); diff --git a/challenge-247/roger-bell-west/kotlin/ch-1.kt b/challenge-247/roger-bell-west/kotlin/ch-1.kt new file mode 100644 index 0000000000..9aab0e29d7 --- /dev/null +++ b/challenge-247/roger-bell-west/kotlin/ch-1.kt @@ -0,0 +1,50 @@ +fun secretsanta(name: List): Boolean { + val family: List = name.map{n -> n.split(" ").last()}.toList() + var receivers = generateSequence(0) { it + 1 }.take(name.size).toMutableSet() + var gifting = ArrayList>() + for (giver in 0 .. name.size - 1) { + var done = false + var r = 0 + for (recipient in receivers) { + if (family[giver] != family[recipient]) { + r = recipient + done = true + break + } + } + if (!done) { + for (recipient in receivers) { + if (giver != recipient) { + r = recipient + break + } + } + } + receivers.remove(r) + gifting.add(listOf(name[giver], name[r])) + } + for (p in gifting) { + print(p[0]) + print(" -> ") + println(p[1]) + } + println("") + return true; +} + +fun main() { + + if (secretsanta(listOf("Mr. Wall", "Mrs. Wall", "Mr. Anwar", "Mrs. Anwar", "Mr. Conway", "Mr. Cross"))) { + print("Pass") + } else { + print("Fail") + } + print(" ") + if (secretsanta(listOf("Mr. Wall", "Mrs. Wall", "Mr. Anwar"))) { + print("Pass") + } else { + print("Fail") + } + println("") + +} diff --git a/challenge-247/roger-bell-west/kotlin/ch-2.kt b/challenge-247/roger-bell-west/kotlin/ch-2.kt new file mode 100644 index 0000000000..6ada6d0aa3 --- /dev/null +++ b/challenge-247/roger-bell-west/kotlin/ch-2.kt @@ -0,0 +1,31 @@ + fun mostfrequentletterpair(s: String): String { + var f = mutableMapOf() + for ( i in 0 .. s.length - 2 ) { + val ss = s.substring(i,i + 2) + var nv = 1 + if (f.containsKey(ss)) { + nv = 1 + f.getValue(ss) + } + f[ss] = nv + } + val m = f.values.maxOrNull()!! + val l = f.keys.filter{i -> f[i] == m}.toList().sorted() + return l[0] + } + +fun main() { + + if (mostfrequentletterpair("abcdbca") == "bc") { + print("Pass") + } else { + print("Fail") + } + print(" ") + if (mostfrequentletterpair("cdeabeabfcdfabgcd") == "ab") { + print("Pass") + } else { + print("Fail") + } + println("") + +} diff --git a/challenge-247/roger-bell-west/lua/ch-1.lua b/challenge-247/roger-bell-west/lua/ch-1.lua new file mode 100755 index 0000000000..9b1bf20f97 --- /dev/null +++ b/challenge-247/roger-bell-west/lua/ch-1.lua @@ -0,0 +1,69 @@ +#! /usr/bin/lua + +-- bart at https://stackoverflow.com/questions/1426954/split-string-in-lua +function split(inputstr, sep) + sep=sep or '%s' + local t={} + for field,s in string.gmatch(inputstr, "([^"..sep.."]*)("..sep.."?)") do + table.insert(t,field) + if s=="" then + return t + end + end +end + +function secretsanta(name) + local family = {} + for _, n in ipairs(name) do + local surname = split(n, " ") + table.insert(family, surname[#surname]) + end + local receivers = {} + for n = 1, #name do + receivers[n] = true + end + local gifting = {} + for giver = 1, #name do + local done = false + local r = 0 + for recipient, _ in pairs(receivers) do + if family[giver] ~= family[recipient] then + r = recipient + done = true + break + end + end + if not done then + for recipient, _ in pairs(receivers) do + if giver ~= recipient then + r = recipient + break + end + end + end + receivers[r] = nil + table.insert(gifting, {name[giver], name[r]}) + end + for _, p in ipairs(gifting) do + io.write(p[1]) + io.write(" -> ") + print(p[2]) + end + print("") + return true +end + +if secretsanta({"Mr. Wall", "Mrs. Wall", "Mr. Anwar", "Mrs. Anwar", "Mr. Conway", "Mr. Cross"}) then + io.write("Pass") +else + io.write("FAIL") +end +io.write(" ") + +if secretsanta({"Mr. Wall", "Mrs. Wall", "Mr. Anwar"}) then + io.write("Pass") +else + io.write("FAIL") +end +print("") + diff --git a/challenge-247/roger-bell-west/lua/ch-2.lua b/challenge-247/roger-bell-west/lua/ch-2.lua new file mode 100755 index 0000000000..e3bccde3d7 --- /dev/null +++ b/challenge-247/roger-bell-west/lua/ch-2.lua @@ -0,0 +1,40 @@ +#! /usr/bin/lua + +function mostfrequentletterpair(s) + local f = {} + local m = 0 + for i = 0,string.len(s) - 1 do + pair = string.sub(s, i, i + 1) + if f[pair] == nil then + f[pair] = 1 + else + f[pair] = f[pair] + 1 + if f[pair] > m then + m = f[pair] + end + end + end + local l = {} + for k, v in pairs(f) do + if v == m then + table.insert(l, k) + end + end + table.sort(l) + return l[1] +end + +if mostfrequentletterpair("abcdbca") == "bc" then + io.write("Pass") +else + io.write("FAIL") +end +io.write(" ") + +if mostfrequentletterpair("cdeabeabfcdfabgcd") == "ab" then + io.write("Pass") +else + io.write("FAIL") +end +print("") + diff --git a/challenge-247/roger-bell-west/perl/ch-1.pl b/challenge-247/roger-bell-west/perl/ch-1.pl new file mode 100755 index 0000000000..79bec4edbe --- /dev/null +++ b/challenge-247/roger-bell-west/perl/ch-1.pl @@ -0,0 +1,45 @@ +#! /usr/bin/perl + +use strict; +use warnings; +use experimental 'signatures'; + +use Test::More tests => 2; + +is(secretsanta(['Mr. Wall', 'Mrs. Wall', 'Mr. Anwar', 'Mrs. Anwar', 'Mr. Conway', 'Mr. Cross']), 1, 'example 1'); +is(secretsanta(['Mr. Wall', 'Mrs. Wall', 'Mr. Anwar']), 1, 'example 2'); + +sub secretsanta($name) { + my @family; + foreach my $n (@{$name}) { + push @family, (split(' ', $n))[-1]; + } + my %receivers = map {$_ => 1} (0 .. $#{$name}); + my @gifting; + foreach my $giver (0 .. $#{$name}) { + my $done = 0; + my $r = 0; + foreach my $recipient (keys %receivers) { + if ($family[$giver] ne $family[$recipient]) { + $r = $recipient; + $done = 1; + last; + } + } + if (!$done) { + foreach my $recipient (keys %receivers) { + if ($recipient != $giver) { + $r = $recipient; + last; + } + } + } + delete $receivers{$r}; + push @gifting, [$name->[$giver], $name->[$r]]; + } + foreach my $p (@gifting) { + print("$p->[0] -> $p->[1]\n"); + } + print "\n"; + return 1; +} diff --git a/challenge-247/roger-bell-west/perl/ch-2.pl b/challenge-247/roger-bell-west/perl/ch-2.pl new file mode 100755 index 0000000000..cb015363d1 --- /dev/null +++ b/challenge-247/roger-bell-west/perl/ch-2.pl @@ -0,0 +1,23 @@ +#! /usr/bin/perl + +use strict; +use warnings; +use experimental 'signatures'; + +use Test::More tests => 2; + +is(mostfrequentletterpair('abcdbca'), 'bc', 'example 1'); +is(mostfrequentletterpair('cdeabeabfcdfabgcd'), 'ab', 'example 2'); + +use List::Util qw(max); + +sub mostfrequentletterpair($s) { + my %f; + foreach my $i (0 .. length($s) - 2) { + my $pair = substr($s, $i, 2); + $f{$pair}++; + } + my $m = max(values %f); + my @l = sort {$a cmp $b} grep {$f{$_} == $m} keys %f; + return $l[0]; +} diff --git a/challenge-247/roger-bell-west/postscript/ch-1.ps b/challenge-247/roger-bell-west/postscript/ch-1.ps new file mode 100644 index 0000000000..a10b6de394 --- /dev/null +++ b/challenge-247/roger-bell-west/postscript/ch-1.ps @@ -0,0 +1,192 @@ +%!PS + +% begin included library code +% see https://codeberg.org/Firedrake/postscript-libraries/ +/test.start { + print (:) print + /test.pass 0 def + /test.count 0 def +} bind def + +/strsplit % (ajbjc) (j) -> [ (a) (b) (c) ] +{ + 1 dict begin + /sep exch def + [ exch + { + dup length 0 eq { + pop + exit + } { + sep search { + exch pop + dup length 0 eq { + pop + } { + exch + } ifelse + } { + () + } ifelse + } ifelse + } loop + ] + end +} bind def + +/deepeq { + 2 dict begin + /a exch def + /b exch def + a type b type eq { + a type /dicttype eq { + a length b length eq { + << + a { + pop + true + } forall + b { + pop + true + } forall + >> + true exch + { + pop + dup a exch known { + dup b exch known { + dup a exch get exch b exch get deepeq not { + pop false + } if + } { + false + } ifelse + } { + false + } ifelse + } forall + } { + false + } ifelse + } { + a type dup /arraytype eq exch /stringtype eq or { + a length b length eq { + true + 0 1 a length 1 sub { + dup a exch get exch b exch get deepeq not { + pop false + exit + } if + } for + } { + false + } ifelse + } { + a b eq + } ifelse + } ifelse + } { + false + } ifelse + end +} bind def + +/apush.right { % [a b] c -> [a b c] + exch + [ exch aload length 2 add -1 roll ] +} bind def + +/test { + /test.count test.count 1 add def + { + /test.pass test.pass 1 add def + } { + ( ) print + test.count (....) cvs print + (-fail) print + } ifelse +} bind def + +/keys { % dict -> array of dict keys + [ exch + { + pop + } forall + ] +} bind def + +/test.end { + ( ) print + test.count 0 gt { + (Passed ) print + test.pass (...) cvs print + (/) print + test.count (...) cvs print + ( \() print + test.pass 100 mul test.count idiv (...) cvs print + (%\)) print + (\r\n) print + } if +} bind def + +/toset { % array -> dict of (value, true) + << exch + { + true + } forall + >> +} bind def + + +% end included library code + +/secretsanta { + 0 dict begin + /name exch def + /family [ + name { + ( ) strsplit 1 get + } forall + ] def + /receivers [ 0 1 name length 1 sub { } for ] toset def + /gifting 0