Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
53 changes: 53 additions & 0 deletions exercises/allergies/.meta/exercise-data.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
exercise: Allergies
plan: 50
subs: allergic_to list_allergies
tests: |-
for my $case (@test_cases) {
if ( $case->{property} eq 'allergicTo' ) {
is allergic_to( $case->{input} ), $case->{expected} ? T : DF,
$case->{description};
}
elsif ( $case->{property} eq 'list' ) {
is
list_allergies( $case->{input}{score} ),
bag {
item $_ for @{ $case->{expected} };
end;
},
$case->{description};
}
}

example: |-
use constant ALLERGENS => {
eggs => 1,
peanuts => 2,
shellfish => 4,
strawberries => 8,
tomatoes => 16,
chocolate => 32,
pollen => 64,
cats => 128,
};

sub allergic_to {
my ($input) = @_;
ALLERGENS->{ $input->{item} } & $input->{score};
}

sub list_allergies {
my ($score) = @_;
return [ grep { allergic_to { item => $_, score => $score } }
keys %{ +ALLERGENS } ];
}

stub: |-
sub allergic_to {
my ($input) = @_;
return undef;
}

sub list_allergies {
my ($score) = @_;
return undef;
}
45 changes: 22 additions & 23 deletions exercises/allergies/.meta/solutions/Allergies.pm
Original file line number Diff line number Diff line change
@@ -1,32 +1,31 @@
package Allergies;

use strict;
use warnings;

use List::Util 'first';

my @allergens
= qw(eggs peanuts shellfish strawberries tomatoes chocolate pollen cats);

sub new {
my ( $class, $score ) = @_;
my $self = bless {} => $class;
$self->{score} = reverse sprintf "%08b", $score;

return $self;
}
use Exporter qw<import>;
our @EXPORT_OK = qw<allergic_to list_allergies>;

use constant ALLERGENS => {
eggs => 1,
peanuts => 2,
shellfish => 4,
strawberries => 8,
tomatoes => 16,
chocolate => 32,
pollen => 64,
cats => 128,
};

sub allergic_to {
my ( $self, $allergen ) = @_;

my $index = first { $allergens[$_] eq $allergen } 0 .. $#allergens;

return substr $self->{score}, $index, 1;
my ($input) = @_;
ALLERGENS->{ $input->{item} } & $input->{score};
}

sub list {
[ grep { $_[0]->allergic_to($_) } @allergens ]
sub list_allergies {
my ($score) = @_;
return [
grep { allergic_to { item => $_, score => $score } }
keys %{ +ALLERGENS }
];
}

__PACKAGE__;

1;
17 changes: 17 additions & 0 deletions exercises/allergies/Allergies.pm
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
package Allergies;
use strict;
use warnings;
use Exporter qw<import>;
our @EXPORT_OK = qw<allergic_to list_allergies>;

sub allergic_to {
my ($input) = @_;
return undef;
}

sub list_allergies {
my ($score) = @_;
return undef;
}

1;
Loading