# NoCOUG Contest: a Gentler, Saner Solution

Posted in: Technical Track

Last time, I produced my traditional golfed solution for the annual NoCOUG contest. As I mentioned at the end, the actual challenge calls for a more generic solution than originally described in the magazine. Because there is no glory in half-solving a problem, I had to come back to it. And because the Great Karmic Balance could probably use it, I thought I could take advantage of the broader scope to produce a solution more geared toward elegance and modernism.

And if you tl;dred the NoCOUG magazine, here’s the skinny on the puzzle at hand: There’s a party being planned, and the planner tries to figure out the smallest set of people to invite, knowing that if certain people show up at the event, others will automatically follow. There are only positive dependencies (no-one is going to snob the event if another person attends), and some of the dependencies involve many people (e.g., Albus will only attend if both Carlotta and Falco are there). And that’s pretty much it. Oh, and everybody’s a wizard, because everything’s better with men in dresses and silly hat.

## Sketching out what we want

As we are striving for something saner and easier to maintain, for this round we’ll steer away from a script and rather implement the solver as a PartyResolver object. The object will take only one input, the list of dependencies. Which will take the form of:

[perl]\$dependencies = [
# will come # if are present
[ qw/ Albus Daisy / ] => [ qw/ Carlotta Falco / ],
‘Falco’ => [ qw/ Albus Carlotta / ],
Elfrida => ‘Falco’,
];
[/perl]

Basically, a list of A will come if B attend, where A and B can be either a single person or a bunch of them.

## Picking up the right tools

Picking up the right tools often makes the difference between minimal pain and no pain at all. In the golfed solution, I used arrays to represent the different groups, and bit-masks to capture who’s coming to the party and who’s not. Clever, but we can make this less obscure by using Set::Object, which does exactly what we want: represent a set of things with all the utility methods to insert new elements, test for inclusion, etc. And, pleasantly enough, according to the benchmarks given in the module’s documentation, we’ll get all that along with very respectable performance.

Likewise, where I was going full brute-force on the possible combinations of guests in the previous solution, we’ll use Algorithm::Combinatorics. It abstracts all that hard mathematical stuff, so we don’t have to worry about it.

With that, we should be good. Time to roll up our sleeves and start coding.

## The PartyResolver class

First things first: we declare our package and import our tools:

[perl]package PartyResolver;

use 5.10.0;

use strict;
use warnings;

use Moose;
use Method::Signatures;

use Set::Object;
use Algorithm::Combinatorics qw/ subsets /;

use List::MoreUtils qw/ uniq first_index /;
use List::Util qw/ min /;
[/perl]

Now, I don’t know about you, but I never, ever remember what is in List::Util and what is in List::MoreUtils. For my next project, I think I’ll start using List::AllUtils and be done with it (or, even better, write a patch such that `List::MoreUtils` is smart enough to pass through the functions that are coming from `List::Util`).

Anyway, the next step is to define the class’s attributes. As mentioned, we want the list of dependencies:

[perl]has dependencies => (
traits => [qw/ Array /],
is => ‘ro’,
required => 1,
isa => ‘ArrayRef[Str|ArrayRef]’,
handles => { all_deps => ‘elements’, },
);

[/perl]

We’ll also need the complete list of guests, for which we can be cute and interpolate from the dependencies:

[perl]sub flatten (\$) { ref \$_[0] ? @{\$_[0]} : \$_[0] }

has guests => (
is => ‘ro’,
lazy => 1,
isa => ‘Set::Object’,
default => method {
return Set::Object->new( map { flatten \$_ } \$self->all_deps );
},
handles => {
‘nbr_guests’ => ‘size’,
‘all_guests’ => ‘members’,
},
);

[/perl]

Attribute-wise, that’s it. Now, for the methods, let’s implement the main one, `seeders_to_invite()`, which will try bigger and bigger seeder groups until it gets solutions that results in everybody ending up at the party:

[perl]method seeders_to_invite {
for my \$group_size ( 1 .. \$self->nbr_guests ) {
my @solutions =
grep { \$self->makes_full_house(\$_) }
map { Set::Object->new(@\$_) }
subsets( [ \$self->all_guests ], \$group_size );

return @solutions if @solutions;
}
}
[/perl]

And finally, we need `makes_full_house()`, a test method that takes in a seeder group of guests, and figures out if it’ll result in a full house:

[perl]method makes_full_house(\$group) {
# we want a copy, not the original
\$group = Set::Object->new( \$group->members );

my \$last_size = 0;
my @deps = \$self->all_deps;

while (1) {
# everybody’s in, success!
return 1 if \$group->size == \$self->nbr_guests;

for ( 0 .. \$#deps / 2 ) {
my @who = flatten \$deps[ 2 * \$_ ];
my @deps = flatten \$deps[ 2 * \$_ + 1];

\$group->insert(@who) if \$group->contains(@deps);
}

# the group has reached its stable state
return 0 if \$last_size == \$group->size;

\$last_size = \$group->size;
}
}
[/perl]

And that’s it. We’re one

[perl]__PACKAGE__->meta->make_immutable;
1;

[/perl]

away of being done.

## Put that horse to work

Now that we have our little `PartyResolver` class implemented, solving all scenarios only becomes a question of turning the handle:

[perl]my @datasets = ( [
[qw/ Burdock Carlotta/] => ‘Albus’,
[qw/Albus Daisy/] => ‘Carlotta’,
[qw/Albus Burdock Carlotta/] => ‘Elfrida’,
[qw/Carlotta Daisy/] => ‘Falco’,
[qw/Burdock Elfrida Falco/] => [qw/ Carlotta Daisy/],
‘Daisy’ => [qw/ Albus Burdock /],
],
[ ‘Carlotta’ => [qw/ Albus Burdock /],
Falco => [qw/ Daisy Elfrida /],
],
[ ‘Carlotta’ => [qw/ Albus Burdock /],
Falco => [qw/ Daisy Elfrida /],
[qw/ Carlotta Falco/] => [qw/ Albus Burdock Daisy Elfrida /],
],
[ Burdock => ‘Albus’,
Carlotta => ‘Burdock’,
Carlotta => ‘Albus’,
Elfrida => ‘Daisy’,
Falco => ‘Elfrida’,
Falco => ‘Daisy’,
],
[ Burdock => ‘Albus’,
Carlotta => ‘Burdock’,
Carlotta => ‘Albus’,
Elfrida => ‘Carlotta’,
Falco => ‘Elfrida’,
Falco => ‘Daisy’,
[qw/ Carlotta Falco /] => [qw/ Albus Burdock Daisy Elfrida /],
],
[ Burdock => ‘Albus’,
Carlotta => ‘Burdock’,
Carlotta => ‘Albus’,
Elfrida => ‘Daisy’,
Falco => ‘Elfrida’,
Falco => ‘Daisy’,
Carlotta => ‘Burdock’,
Albus => ‘Carlotta’,
Albus => ‘Burdock’,
Falco => ‘Elfrida’,
Daisy => ‘Falco’,
Daisy => ‘Elfrida’,
],
[ Albus => [qw/ Burdock Carlotta Daisy /],
Albus => [qw/ Carlotta Daisy Elfrida /],
Albus => [qw/ Daisy Elfrida Falco /],
],
[ [qw/ Burdock Carlotta Daisy Elfrida Falco /] => ‘Albus’,
Albus => [qw/ Burdock Carlotta Daisy Elfrida Falco /],
],
);

for (@datasets) {
state \$dataset_nbr = 1;

say "\nProblem ", \$dataset_nbr++;

say join " ", sort \$_->members
for PartyResolver->new( dependencies => \$_ )->seeders_to_invite;

say ‘*’ x 60;
}

[/perl]

Which, indeed, returns the values we want:

[bash]\$ perl party_solver.pl

Problem 1
Falco
Carlotta
Elfrida
Albus
************************************************************

Problem 2
Albus Burdock Daisy Elfrida
************************************************************

Problem 3
Albus Burdock Daisy Elfrida
************************************************************

Problem 4
Albus Daisy
************************************************************

Problem 5
Albus Daisy
************************************************************

Problem 6
Burdock Falco
Burdock Daisy
Burdock Elfrida
Carlotta Falco
Albus Falco
Carlotta Daisy
Albus Daisy
Carlotta Elfrida
Albus Elfrida
************************************************************

Problem 7
Burdock Carlotta Daisy Elfrida Falco
************************************************************

Problem 8
Albus
************************************************************
[/bash]

Ta-dah!

The complete program is also here, if you want to play with it.

## Author

Want to talk with an expert? Schedule a call with our team to get the conversation started.