Perl Weekly Challenge 025

ch-1.pl

use strict;
use warnings;
##
# Generate a longest sequence of "English Pokemon" names.
##
use Graph;

sub build_pokegraph{ 
    my @pokemon;
    my %first_letter_name; 
    my $graph = new Graph(); 
    while(my $pokemon = <DATA>){
        $pokemon = lc($pokemon);
        chomp($pokemon);
        my $first_letter = substr($pokemon, 0, 1);      
        if($first_letter_name{$first_letter}){
            push @{$first_letter_name{$first_letter}}, $pokemon; 
        }
        else{
            $first_letter_name{$first_letter} = [$pokemon]; 
        }  
        push @pokemon, $pokemon;   
    }
    for my $pokemon (@pokemon){
        $graph->add_vertex($pokemon) if !$graph->has_vertex($pokemon);
        my $child_nodes = $first_letter_name{substr($pokemon, -1)};
        for my $n (@{$child_nodes}){
            $graph->add_vertex($n) if !$graph->has_vertex($n);
            $graph->add_weighted_edge($pokemon, $n, (-1 * length($n))) if !$graph->has_edge($pokemon, $n);   
            $graph->delete_edge($pokemon, $n) if $graph->has_a_cycle(); 
        }  
    }   
    return (\@pokemon, $graph);
}

MAIN:{
    my ($pokemon, $graph) = build_pokegraph(); 
    my $apsp = $graph->APSP_Floyd_Warshall();
    my $max_path;  
    my $max_path_length = -1;  
    for my $p0 (@{$pokemon}){
        for my $p1 (@{$pokemon}){
            my @vertices = $apsp->path_vertices($p0, $p1);
            my $l = join("", @vertices);
            if(length($l) > $max_path_length){  
                $max_path_length = length($l); 
                $max_path = join("-", @vertices); 
            } 
        }  
    }
    print "$max_path $max_path_length\n"; 
}

__DATA__
audino
bagon
baltoy
banette
bidoof
braviary
bronzor
carracosta
charmeleon
cresselia
croagunk
darmanitan
deino
emboar
emolga
exeggcute
gabite
girafarig
gulpin
haxorus
heatmor
heatran
ivysaur
jellicent
jumpluff
kangaskhan
kricketune
landorus
ledyba
loudred
lumineon
lunatone
machamp
magnezone
mamoswine
nosepass
petilil
pidgeotto
pikachu
pinsir
poliwrath
poochyena
porygon2
porygonz
registeel
relicanth
remoraid
rufflet
sableye
scolipede
scrafty
seaking
sealeo
silcoon
simisear
snivy
snorlax
spoink
starly
tirtouga
trapinch
treecko
tyrogue
vigoroth
vulpix
wailord
wartortle
whismur
wingull
yamask

ch-2.pl

use strict;
use warnings;
##
# Create script to implement Chaocipher.
##
use Deck;

sub split_deck{
    my($deck) = @_;
    my(@red, @black);
    my $card = $deck->deal_one();
    while($card){
        if($card->{suit}){
            push @black, $card;
        } 
        else{
            push @red, $card; 
        } 
        $card = $deck->deal_one();
    }
    return(new Deck(\@red), new Deck(\@black)); 
}

sub encrypt_letter{
    my($letter, $left, $right) = @_;  
    my $index = 0; 
    my $plaintext_index; 
    my $card = $right->deal_one();
    while($card){
        if($card->{letter} eq $letter){      
            $plaintext_index = $index;  
            last; 
        }
        $card = $right->deal_one();
        $index++; 
    }  
    my $cyphertext = $left->card_at($plaintext_index)->{letter}; 
    $left->left_permute(); 
    $right->right_permute();
    return $cyphertext;  
}

sub decrypt_letter{
    my($letter, $left, $right) = @_;  
    my $index = 0; 
    my $plaintext_index; 
    my $card = $left->deal_one();
    while($card){
        if($card->{letter} eq $letter){      
            $plaintext_index = $index;  
            last; 
        }
        $card = $left->deal_one();
        $index++; 
    }  
    my $plaintext = $right->card_at($plaintext_index)->{letter}; 
    $left->left_permute(); 
    $right->right_permute(); 
    return $plaintext; 
}


MAIN:{
    my $message = <DATA>; 
    chomp($message); 
    my $deck = new Deck();
    $deck->shuffle(); 
    my ($left, $right) = split_deck($deck); 
    my @letters = split(//, $message);
    my @cyphertext;
    for my $c (@letters){ 
        push @cyphertext, encrypt_letter($c, $left, $right);
    } 
    print join("", @cyphertext) . "\n"; 
    my @plaintext;
    for my $c (@cyphertext){ 
        push @plaintext, decrypt_letter($c, $left, $right);
    } 
    print join("", @plaintext) . "\n"; 
}

__DATA__
ATTACKATDAWN

CypherCard.pm

package CypherCard;

use boolean;

sub new{
    my ($pkg, $attr) = @_;
    my $self = {}; 
    if(defined($attr->{suit}) && defined($attr->{rank}) && defined($attr->{letter})){   
        $self = $attr;
    }   
    bless($self, $pkg);
    return $self;    
}  

true;  

Deck.pm

package Deck;

use boolean;

use CypherCard;  
use Suit qw/DIAMOND HEART SPADE CLUB/;
use Rank qw/A TWO THREE FOUR FIVE SIX SEVEN EIGHT NINE TEN J Q K/;

use constant ZENITH => 0; 
use constant NADIR => 13; 

our $index = 0;

sub new{
    my ($pkg, $pile) = @_;
    my $self = $pile || create(); 
    bless($self, $pkg);
    $index = 0; 
    return $self;    
} 

##
# Fisher-Yates shuffle
##
sub shuffle{
    my ($self) = @_;
    my $i = @{$self};
    while(--$i){
        my $j = int(rand($i + 1));
        @{$self}[$i, $j] = @{$self}[$j, $i];
    }
    $index = 0; 
}

sub print{
    my ($self) = @_;
    for my $card (@{$self}){
        print $card->{suit}." ".$card->{rank}."\n";  
    }   
}

sub deal_one{
    my ($self) = @_;
    return $self->[$index++];
} 

sub card_at{
    my ($self, $i) = @_;
    return $self->[$i];
} 

sub left_permute{
    my($self, $i) = @_;
    my $permutated = []; 
    for(my $j = ($i - 1); $j >= 0; $j--){
        push @{$permutated}, $self->card_at($j); 
    }    
    for(my $j = 51; $j > $i; $j--){
        push @{$permutated}, $self->card_at($j); 
    }    
    unshift @{$permutated}, $self->card_at($i);  
    my $zenith_plus_1 = $permutated->[ZENITH + 1]; 
    splice @{$permutated}, ZENITH + 1, 1;
    splice @{$permutated}, NADIR, 0, $zenith_plus_1;
    $self = new Deck($permutated); 
} 

sub right_permute{
    my($self, $i) = @_;
    my $permutated = []; 
    for(my $j = ($i - 1); $j >= 0; $j--){
        push @{$permutated}, $self->card_at($j); 
    }    
    for(my $j = 51; $j > $i; $j--){
        push @{$permutated}, $self->card_at($j); 
    }    
    unshift @{$permutated}, $self->card_at($i);  
    my $bottom = $permutated->[ZENITH]; 
    splice @{$permutated}, ZENITH, 1;
    push @{$permutated}, $bottom;
    my $zenith_plus_2 = $permutated->[ZENITH + 2]; 
    splice @{$permutated}, ZENITH + 2, 1;
    splice @{$permutated}, NADIR, 0, $zenith_plus_2;
    $self = new Deck($permutated); 
} 

sub create{
    my @deck=();  
    while(<DATA>){
        chomp;
        push(@deck, new CypherCard(eval($_)));
    }    
    return \@deck;  
}

true;  

__DATA__
{suit => DIAMOND, rank => A, letter => q/N/}
{suit => DIAMOND, rank => TWO, letter => q/O/} 
{suit => DIAMOND, rank => THREE, letter => q/P/} 
{suit => DIAMOND, rank => FOUR, letter => q/Q/} 
{suit => DIAMOND, rank => FIVE, letter => q/R/} 
{suit => DIAMOND, rank => SIX, letter => q/S/} 
{suit => DIAMOND, rank => SEVEN, letter => q/T/} 
{suit => DIAMOND, rank => EIGHT, letter => q/U/} 
{suit => DIAMOND, rank => NINE, letter => q/V/} 
{suit => DIAMOND, rank => TEN, letter => q/W/} 
{suit => DIAMOND, rank => J, letter => q/X/} 
{suit => DIAMOND, rank => Q, letter => q/Y/} 
{suit => DIAMOND, rank => K, letter => q/Z/} 
{suit => HEART, rank => A, letter => q/A/}
{suit => HEART, rank => TWO, letter => q/B/} 
{suit => HEART, rank => THREE, letter => q/C/} 
{suit => HEART, rank => FOUR, letter => q/D/} 
{suit => HEART, rank => FIVE, letter => q/E/} 
{suit => HEART, rank => SIX, letter => q/F/} 
{suit => HEART, rank => SEVEN, letter => q/G/} 
{suit => HEART, rank => EIGHT, letter => q/H/} 
{suit => HEART, rank => NINE, letter => q/I/} 
{suit => HEART, rank => TEN, letter => q/J/} 
{suit => HEART, rank => J, letter => q/K/} 
{suit => HEART, rank => Q, letter => q/L/} 
{suit => HEART, rank => K, letter => q/M/} 
{suit => SPADE, rank => A, letter => q/A/}
{suit => SPADE, rank => TWO, letter => q/B/} 
{suit => SPADE, rank => THREE, letter => q/C/} 
{suit => SPADE, rank => FOUR, letter => q/D/} 
{suit => SPADE, rank => FIVE, letter => q/E/} 
{suit => SPADE, rank => SIX, letter => q/F/} 
{suit => SPADE, rank => SEVEN, letter => q/G/} 
{suit => SPADE, rank => EIGHT, letter => q/H/} 
{suit => SPADE, rank => NINE, letter => q/I/} 
{suit => SPADE, rank => TEN, letter => q/J/} 
{suit => SPADE, rank => J, letter => q/K/} 
{suit => SPADE, rank => Q, letter => q/L/} 
{suit => SPADE, rank => K, letter => q/M/} 
{suit => CLUB, rank => A, letter => q/N/}
{suit => CLUB, rank => TWO, letter => q/O/} 
{suit => CLUB, rank => THREE, letter => q/P/} 
{suit => CLUB, rank => FOUR, letter => q/Q/} 
{suit => CLUB, rank => FIVE, letter => q/R/} 
{suit => CLUB, rank => SIX, letter => q/S/} 
{suit => CLUB, rank => SEVEN, letter => q/T/} 
{suit => CLUB, rank => EIGHT, letter => q/U/} 
{suit => CLUB, rank => NINE, letter => q/V/} 
{suit => CLUB, rank => TEN, letter => q/W/} 
{suit => CLUB, rank => J, letter => q/X/} 
{suit => CLUB, rank => Q, letter => q/Y/} 
{suit => CLUB, rank => K, letter => q/Z/}

Rank.pm

package Rank;
use boolean;  
use Class::Enum qw/A TWO THREE FOUR FIVE SIX SEVEN EIGHT NINE TEN J Q K/;
true; 

Suit.pm

package Suit;
use boolean; 
use Class::Enum(
    DIAMOND => {ordinal => 0},
    HEART => {ordinal => 0},
    SPADE => {ordinal => 1},
    CLUB => {ordinal => 1}, 
);
true;