This is my response to The Weekly Challenge #247.
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
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
It is possible to assign the persons in example 1 so that we fail to separate the families. E.g.
Mr. Conway -> Mr. Anwar
Mr. Anwar -> Mr. Cross
Mr. Cross -> Mr. Conway
Mr. Wall -> Mrs. Wall
Mrs. Wall -> Mr. Wall
We can avoid this by choosing from the families with two members first, before the one member families.
File: secret-santa
unit sub MAIN (Int $example where $example == 1|2, :v(:$verbose)); # [0]
my @names = $example == 1 # [1]
?? ('Mr. Wall',
'Mrs. Wall',
'Mr. Anwar',
'Mrs. Anwar',
'Mr. Conway',
'Mr. Cross',
)
!! ('Mr. Wall', # [2]
'Mrs. Wall',
'Mr. Anwar',
);
sub family ($name) # [3]
{
my ($title, $family) = $name.words; # [3a]
return $family; # [3b]
}
my %count; # [4]
@names.map({%count{family($_)}++}); # [4a]
say ":Count: { %count.raku }" if $verbose; # [4v]
my @sorted = # [5]
@names.sort({ %count{family($^b)} <=> %count{family($^a)} || Bool.pick });
say ":Sorted: { @sorted.raku }" if $verbose; # [5v]
my $first = @sorted.shift; # [6]
my $from = $first; # [7]
while (@sorted) # [8]
{
my $to = @sorted.shift; # [9]
if (@sorted.elems && family($from) eq family($to)) # [10]
{
my $next = @sorted.shift; # [10a]
@sorted.unshift: $to; # [10b]
$to = $next; # [10c]
}
say "$from -> $to"; # [11]
$from = $to; # [12]
}
say "$from -> $first"; # [13]
[0] Specify which example to use, 1 or 2, on the command line.
[1] Example 1.
[2] Example 2.
[3] Procedure giving us the family name of the input (full
name), using words to split the title from the family name (on
the space).
See docs.raku.org/routine/words for more information about words.
[4] Get the frequency of each family; how many members they have. Just 1 or 2 in our case (the examples).
[4v] The result for example 1 looks like this:
:Count: {:Anwar(2), :Conway(1), :Cross(1), :Wall(2)}
It is a hash, so the order will differ when run several times.
[5] Get a list of the families, sorted on frequence; the most
frequent first. If several families have the same frequency, which they have,
sort them randomly (by Bool.pick, which gives 0 or 1 in numeric
context).
See docs.raku.org/routine/pick for more information about pick.
[5v] The result for example 1 looks like this:
:Sorted: ["Mrs. Anwar", "Mr. Anwar", "Mrs. Wall", "Mr. Wall", "Mr. Cross",
"Mr. Conway"]
The order will differ when run several times. But the first four will always come before the last two.
[6] Get the first person.
[7] Save that person, as we need to make a loop back here from the very last one - when we get to the end.
[8] As long as we have more persons.
[9] Get the next one.
[10] Are the two persons from the same family? If so, get the next person (as there are max two persons from each family) [10a], Push the previous (the second) person back to the list, at the front [10b] and use the new person instead [10c].
Yes, you may have deduced that the program will only work if we have 1 or 2 members per family. This is the case in the examples, so we can probably get away with it. (The program does not support anything except the examples, so you cannot trick it.)
[11] Print the combination.
[12] prepare for the next iteration, where the recipient in this iterations will be the giver.
[13] The last gift goes from the last person in the list to the first one.
Running it, with the number representing the example number:
$ ./secret-santa 1
Mrs. Wall -> Mrs. Anwar
Mrs. Anwar -> Mr. Wall
Mr. Wall -> Mr. Anwar
Mr. Anwar -> Mr. Conway
Mr. Conway -> Mr. Cross
Mr. Cross -> Mrs. Wall
$ ./secret-santa 2
Mrs. Wall -> Mr. Anwar
Mr. Anwar -> Mr. Wall
Mr. Wall -> Mrs. Wall
Looking good.
With verbose mode:
$ ./secret-santa -v 1
:Count: {:Anwar(2), :Conway(1), :Cross(1), :Wall(2)}
:Sorted: ["Mr. Anwar", "Mrs. Anwar", "Mrs. Wall", "Mr. Wall", "Mr. Cross",
"Mr. Conway"]
Mr. Anwar -> Mrs. Wall
Mrs. Wall -> Mrs. Anwar
Mrs. Anwar -> Mr. Wall
Mr. Wall -> Mr. Cross
Mr. Cross -> Mr. Conway
Mr. Conway -> Mr. Anwar
$ ./secret-santa -v 2
:Count: {:Anwar(1), :Wall(2)}
:Sorted: ["Mr. Wall", "Mrs. Wall", "Mr. Anwar"]
Mr. Wall -> Mr. Anwar
Mr. Anwar -> Mrs. Wall
Mrs. Wall -> Mr. Wall
You may have noticed that the program generates a directed circular graph. That is perfectly ok.
Let us address the two person family limit. First, we rewrite the program to support the names on the command line:
File: secret-dynamic-santa (partial)
#! /usr/bin/env raku
multi MAIN (Int $example where $example == 1|2, :v(:$verbose)) # [1]
{
my @names = $example == 1
?? ('Mr. Wall',
'Mrs. Wall',
'Mr. Anwar',
'Mrs. Anwar',
'Mr. Conway',
'Mr. Cross',
)
!! ('Mr. Wall',
'Mrs. Wall',
'Mr. Anwar',
);
MAIN(@names, :$verbose); # [1a]
}
multi MAIN (*@names, :v(:$verbose)) # [2}
{
my %count;
... # [3]
say "$from -> $first";
}
sub family ($name)
{
my ($title, $family) = $name.words;
return $family;
}
[1] Multiple dispatch with mutli. This
is the first one, used if we specify the number 1 or 2 only (and possibly
verbose mode). It calls the the second one [1a].
See docs.raku.org/syntax/multi for more information about multi.
[2] The second one, doing the actual work.
[3] Insert the relevant code from «secret-santa» here.
It works with the two examples, as well as an arbitrary list of persons:
$ ./secret-dynamic-santa 1
Mr. Wall -> Mrs. Anwar
Mrs. Anwar -> Mrs. Wall
Mrs. Wall -> Mr. Anwar
Mr. Anwar -> Mr. Cross
Mr. Cross -> Mr. Conway
Mr. Conway -> Mr. Wall
$ ./secret-dynamic-santa 2
Mrs. Wall -> Mr. Anwar
Mr. Anwar -> Mr. Wall
Mr. Wall -> Mrs. Wall
$ ./secret-dynamic-santa "Kit Walker" "Sala Palmer"
Kit Walker -> Sala Palmer
Sala Palmer -> Kit Walker
But this does not give us a correct non mixed-family answer, as it should:
$ ./secret-dynamic-santa -v "Tim Larkin" "Ed Larkin" "Mary Larkin" \
"Kit Brewer" "Lisa Brewer" "Phil Jones"
:Count: {:Brewer(2), :Jones(1), :Larkin(3)}
:Sorted: ["Ed Larkin", "Mary Larkin", "Tim Larkin", "Kit Brewer",
"Lisa Brewer", "Phil Jones"]
Ed Larkin -> Tim Larkin
Tim Larkin -> Kit Brewer
Kit Brewer -> Mary Larkin
Mary Larkin -> Lisa Brewer
Lisa Brewer -> Phil Jones
Phil Jones -> Ed Larkin
The program swapped the second and third names in the «Sorted» list, but that did not help.
We can fix that:
File: secret-pop-santa
#! /usr/bin/env raku
multi MAIN (Int $example where $example == 1|2, :v(:$verbose))
{
my @names = $example == 1
?? ('Mr. Wall',
'Mrs. Wall',
'Mr. Anwar',
'Mrs. Anwar',
'Mr. Conway',
'Mr. Cross',
)
!! ('Mr. Wall',
'Mrs. Wall',
'Mr. Anwar',
);
MAIN(@names, :$verbose);
}
multi MAIN (*@names, :v(:$verbose))
{
my %count;
@names.map({%count{family($_)}++});
say ":Count: { %count.raku }" if $verbose;
my @sorted =
@names.sort({ %count{family($^b)} <=> %count{family($^a)} || Bool.pick });
say ":Sorted: { @sorted.raku }" if $verbose;
my $first = @sorted.shift;
my $from = $first;
while (@sorted)
{
my $to = @sorted.shift;
if (@sorted.elems && family($from) eq family($to))
{
my $next = @sorted.pop; # [1]
@sorted.unshift: $to;
$to = $next;
}
say "$from -> $to";
$from = $to;
}
say "$from -> $first";
}
sub family ($name)
{
my ($title, $family) = $name.words;
return $family;
}
[1] Take from the end (with pop) instead of from the front
(with shift).
See docs.raku.org/routine/pop for more information about pop.
This seems to work:
$ ./secret-pop-santa -v 1
:Count: {:Anwar(2), :Conway(1), :Cross(1), :Wall(2)}
:Sorted: ["Mr. Anwar", "Mrs. Anwar", "Mr. Wall", "Mrs. Wall", "Mr. Cross",
"Mr. Conway"]
Mr. Anwar -> Mr. Conway
Mr. Conway -> Mrs. Anwar
Mrs. Anwar -> Mr. Wall
Mr. Wall -> Mr. Cross
Mr. Cross -> Mrs. Wall
Mrs. Wall -> Mr. Anwar
$ ./secret-pop-santa -v 2
:Count: {:Anwar(1), :Wall(2)}
:Sorted: ["Mrs. Wall", "Mr. Wall", "Mr. Anwar"]
Mrs. Wall -> Mr. Anwar
Mr. Anwar -> Mr. Wall
Mr. Wall -> Mrs. Wall
$ ./secret-pop-santa -v "Kit Walker" "Sala Palmer"
:Count: {:Palmer(1), :Walker(1)}
:Sorted: ["Sala Palmer", "Kit Walker"]
Sala Palmer -> Kit Walker
Kit Walker -> Sala Palmer
$ ./secret-pop-santa -v "Tim Larkin" "Ed Larkin" "Mary Larkin" "Kit Brewer"
"Lisa Brewer" "Phil Jones"
:Count: {:Brewer(2), :Jones(1), :Larkin(3)}
:Sorted: ["Tim Larkin", "Ed Larkin", "Mary Larkin", "Lisa Brewer",
"Kit Brewer", "Phil Jones"]
Tim Larkin -> Phil Jones
Phil Jones -> Ed Larkin
Ed Larkin -> Kit Brewer
Kit Brewer -> Mary Larkin
Mary Larkin -> Lisa Brewer
Lisa Brewer -> Tim Larkin
It may be possible to construct examples that does not work out (as we use the one-person family pretty quickly). Feel free to try.
'a'..'z'.
Input: $s = 'abcdbca'
Output: 'bc'
'bc' appears twice in `$s`
Input: $s = 'cdeabeabfcdfabgcd'
Output: 'ab'
'ab' and 'cd' both appear three times in $s and 'ab' is lexicographically
smaller than 'cd'.
This program does not work if we have overlapping substrings; i.e.
repeated adjacent characters (as n e.g. the c in abcccab).
More about that later...
#! /usr/bin/env raku
unit sub MAIN (Str $s where $s ~~ /^<[a..z]>+$/, :v(:$verbose)); # [1]
my $letter-pairs := gather # [2]
{
my @s = $s.comb; # [3]
my $first = @s.shift; # [4]
while @s.elems # [5]
{
my $second = @s.shift; # [5a]
take $first ~ $second; # [5b]
$first = $second; # [5c]
}
}
my $bag = $letter-pairs.Bag; # [6]
my $max = $bag.values.max; # [7]
my @all = $bag.grep( *.value == $max ).map( *.key ); # [8]
say ": Bag: { $bag.raku }" if $verbose;
say ": Matches: { @all.join(", ") } (with occurence $max)" if $verbose;
say @all.sort.head; # [9]
[1] Ensure that the string has lowercase letters only.
[2] gather/take is ideal
to set up a stream of two-character strings.
See my Raku Gather, I Take article or docs.raku.org/syntax/gather take for more information about gather/take.
[3] Split the string into individual characters with
comb.
See docs.raku.org/routine/comb for more information about comb.
[4] Get the first character.
[5] As long as there are more characters to go, get the next one [5a], return
the two characters as a single string (with take) [5b], and move
the second one up to first place [5c], ready for the next iteration.
[6] Get all the pairs, and turn them into a Bag,
a hash like structure where the original strings are the keys, and the frequency
are the values.
See docs.raku.org/type/Bag for more information about the Bag type.
[7] Get the frequencies (the values), then the largest with
max.
See docs.raku.org/routine/max for more information about max.
[8] Get all the pairs with the highest frequency, this is one or more.
The grep part gives us a Bag with them, and the
map gives us the keys (the original strings) instead. Thus
we have a list of strings (one or more) that has the highest frequency.
[9] Sort the list, and print the first one (with
head).
See docs.raku.org/routine/head for more information about head.
The last line could have been written as @all.sort.shift.say
instead.
Running it:
$ ./mflp abcdbca
bc
$ ./mflp cdeabeabfcdfabgcd
ab
Looking good.
With verbose mode:
$ ./mflp -v abcdbca
: Bag: ("ca"=>1,"db"=>1,"ab"=>1,"cd"=>1,"bc"=>2).Bag
: Matches: bc (with occurence 2)
bc
$ ./mflp -v cdeabeabfcdfabgcd
: Bag: ("be"=>1,"fa"=>1,"ab"=>3,"gc"=>1,"bg"=>1,"df"=>1,"de"=>1,"bf"=>1,"ea"=>2,"fc"=>1,"cd"=>3).Bag
: Matches: ab, cd (with occurence 3)
ab
Repeated characters cause havoc:
$ ./mflp -v aaa
: Bag: ("aa"=>2).Bag
: Matches: aa (with occurence 2)
aa
$ ./mflp -v aaaaa
: Bag: ("aa"=>4).Bag
: Matches: aa (with occurence 4)
aa
We got the right answer, as that is the only letter pair. But we can easily generate a string that gives us the wrong result:
$ ./mflp -v "aaaxyccxybb"
: Bag: ("yc"=>1,"ax"=>1,"yb"=>1,"bb"=>1,"aa"=>2,"cx"=>1,"cc"=>1,"xy"=>2).Bag
: Matches: aa, xy (with occurence 2)
aa
We should have gotten «xy»..
This is not that hard du fix:
File: mflp-repeated
#! /usr/bin/env raku
unit sub MAIN (Str $s where $s ~~ /^<[a..z]>+$/, :v(:$verbose));
my $letter-pairs := gather
{
my @s = $s.comb;
my $first = @s.shift;
my $taken = False; # [1]
while @s.elems
{
my $second = @s.shift;
my $pair = $first ~ $second; # [2]
if $first eq $second # [3]
{
$taken ?? ( $taken = False ) !! ( $taken = True; take $pair ); # [4]
}
else # [5]
{
$taken = False; # [5a]
take $pair; # [5b]
}
$first = $second;
}
}
my $bag = $letter-pairs.Bag;
my $max = $bag.values.max;
my @all = $bag.grep( *.value == $max ).map( *.key );
say ": Bag: { $bag.raku }" if $verbose;
say ": Matches: { @all.join(", ") } (with occurence $max)" if $verbose;
say @all.sort.head;
[1] Have we already taken a string with the same characters? (Initially: no.)
[2] As we refer to it several times below.
[3] Are the two character equal?
[4] If the flag [1] is set, clear it, and do not return the value. If not, set the flag, and return the value.
[5] Not equal? Clear the flag [1] and return the value.
Running it gives the correct result:
$ ./mflp-repeated -v bbaaaabb
: Bag: ("ab"=>1,"ba"=>1,"aa"=>2,"bb"=>2).Bag
: Matches: aa, bb (with occurence 2)
aa
And that's it.