1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
#!/usr/bin/perl
#
# Challenge 1: "Generate a longest sequence of the following "English Pokemon"
# names where each name starts with the last letter of the previous name:
#
# 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"
#
# My notes: Clearly defined, nice, potentially tricky, let's do it.
#
# optimization v3: instead of cloning the used set to modify it,
# modify it, pass it, and then change it back 21.1s
# optimization v2: instead of recalculating the "used set" each time,
# pass it around, modifying it as we go 28.8s
# optimization v1: baseline code before starting to optimize: 32.6s.
#
use v5.10; # to get "say"
use strict;
use warnings;
use Function::Parameters;
#use Data::Dumper;
my $debug = @ARGV>0;
my @words = qw(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);
#@words = qw(hello ollie excellent thanks shelter runaround set to);
my %sw; # hash from letter to list of words starting with that letter.
foreach my $word (@words)
{
$word =~ /^(.)/;
my $letter = $1;
$sw{$letter} //= [];
push @{$sw{$letter}}, $word;
}
#die Dumper \%sw;
my @longseq = (); # longest sequence found so far..
# search for sequences starting with each word in turn..
foreach my $sw (@words)
{
findseq( $sw, {}, () );
}
my $longest = @longseq;
print "\nlongest sequence is length $longest: @longseq\n";
exit 0;
#
# findseq( $currw, $used, @seq );
# Find all sequences of words from $currw onwards,
# given that we've already visited words in @seq,
# (the same info, as a set, is in %$used)
# and update the global @longseq if any sequences
# we find are longer than that.
#
fun findseq( $currw, $used, @seq )
{
push @seq, $currw; # extend @seq sequence
$used->{$currw}++; # update $used set
$currw =~ /(.)$/; # find the last letter of currw
my $lastletter = $1;
my $nextw = $sw{$lastletter}; # all words starting with lastletter
if( defined $nextw ) # if there are any, try each word
{
foreach my $nextword (@$nextw)
{
findseq( $nextword, $used, @seq )
unless $used->{$nextword};
}
} else # @seq is finished
{
#print "found sequence @seq\n";
my $len = @seq;
if( $len > @longseq )
{
print "longest seq so far (len $len): @seq\n" if $debug;
@longseq = @seq;
}
}
delete $used->{$currw};
}
|
