Filename | /homes/dcw/src/perl/weeklychallenge/perlweeklychallenge-club/challenge-025/duncan-c-white/perl5/v3.pl |
Statements | Executed 55702783 statements in 21.1s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
5016078 | 2 | 1 | 20.2s | 21.1s | findseq (recurses: max depth 22, inclusive time 289s) | main::
5016148 | 2 | 1 | 893ms | 893ms | CORE:match (opcode) | main::
1 | 1 | 1 | 1.20ms | 4.14ms | BEGIN@23 | main::
1 | 1 | 1 | 1.13ms | 1.14ms | BEGIN@22 | main::
1 | 1 | 1 | 260µs | 285µs | BEGIN@21 | main::
1 | 1 | 1 | 14µs | 14µs | CORE:print (opcode) | main::
1 | 1 | 1 | 14µs | 14µs | BEGIN@20 | main::
1 | 1 | 1 | 4µs | 4µs | VERSION (xsub) | UNIVERSAL::
0 | 0 | 0 | 0s | 0s | RUNTIME | main::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | #!/usr/bin/perl | ||||
2 | # | ||||
3 | # Challenge 1: "Generate a longest sequence of the following "English Pokemon" | ||||
4 | # names where each name starts with the last letter of the previous name: | ||||
5 | # | ||||
6 | # audino bagon baltoy banette bidoof braviary bronzor carracosta | ||||
7 | # charmeleon cresselia croagunk darmanitan deino emboar emolga | ||||
8 | # exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur | ||||
9 | # jellicent jumpluff kangaskhan kricketune landorus ledyba loudred | ||||
10 | # lumineon lunatone machamp magnezone mamoswine nosepass petilil | ||||
11 | # pidgeotto pikachu pinsir poliwrath poochyena porygon2 porygonz | ||||
12 | # registeel relicanth remoraid rufflet sableye scolipede scrafty | ||||
13 | # seaking sealeo silcoon simisear snivy snorlax spoink starly | ||||
14 | # tirtouga trapinch treecko tyrogue vigoroth vulpix wailord | ||||
15 | # wartortle whismur wingull yamask" | ||||
16 | # | ||||
17 | # My notes: Clearly defined, nice, potentially tricky, let's do it. | ||||
18 | # | ||||
19 | |||||
20 | 2 | 32µs | 1 | 14µs | # spent 14µs within main::BEGIN@20 which was called:
# once (14µs+0s) by main::NULL at line 20 # spent 14µs making 1 call to main::BEGIN@20 |
21 | 2 | 171µs | 2 | 287µs | # spent 285µs (260+25) within main::BEGIN@21 which was called:
# once (260µs+25µs) by main::NULL at line 21 # spent 285µs making 1 call to main::BEGIN@21
# spent 2µs making 1 call to strict::import |
22 | 2 | 1.08ms | 2 | 1.14ms | # spent 1.14ms (1.13+6µs) within main::BEGIN@22 which was called:
# once (1.13ms+6µs) by main::NULL at line 22 # spent 1.14ms making 1 call to main::BEGIN@22
# spent 4µs making 1 call to warnings::import |
23 | 2 | 195µs | 2 | 4.24ms | # spent 4.14ms (1.20+2.94) within main::BEGIN@23 which was called:
# once (1.20ms+2.94ms) by main::NULL at line 23 # spent 4.14ms making 1 call to main::BEGIN@23
# spent 101µs making 1 call to Function::Parameters::import |
24 | #use Data::Dumper; | ||||
25 | |||||
26 | 1 | 500ns | my $debug = @ARGV>0; | ||
27 | |||||
28 | 1 | 3µs | my @words = qw(audino bagon baltoy banette bidoof braviary bronzor carracosta | ||
29 | charmeleon cresselia croagunk darmanitan deino emboar emolga | ||||
30 | exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur | ||||
31 | jellicent jumpluff kangaskhan kricketune landorus ledyba loudred | ||||
32 | lumineon lunatone machamp magnezone mamoswine nosepass petilil | ||||
33 | pidgeotto pikachu pinsir poliwrath poochyena porygon2 porygonz | ||||
34 | registeel relicanth remoraid rufflet sableye scolipede scrafty | ||||
35 | seaking sealeo silcoon simisear snivy snorlax spoink starly | ||||
36 | tirtouga trapinch treecko tyrogue vigoroth vulpix wailord | ||||
37 | wartortle whismur wingull yamask); | ||||
38 | #@words = qw(hello ollie excellent thanks shelter runaround set to); | ||||
39 | |||||
40 | 1 | 100ns | my %sw; # hash from letter to list of words starting with that letter. | ||
41 | |||||
42 | 1 | 400ns | foreach my $word (@words) | ||
43 | { | ||||
44 | 70 | 46µs | 70 | 9µs | $word =~ /^(.)/; # spent 9µs making 70 calls to main::CORE:match, avg 134ns/call |
45 | 70 | 7µs | my $letter = $1; | ||
46 | 70 | 10µs | $sw{$letter} //= []; | ||
47 | 70 | 15µs | push @{$sw{$letter}}, $word; | ||
48 | } | ||||
49 | |||||
50 | #die Dumper \%sw; | ||||
51 | |||||
52 | 1 | 100ns | my @longseq = (); # longest sequence found so far.. | ||
53 | |||||
54 | # ok, start searching.. | ||||
55 | 1 | 200ns | foreach my $sw (@words) | ||
56 | { | ||||
57 | 70 | 104µs | 70 | 21.1s | findseq( $sw, {}, () ); # spent 21.1s making 70 calls to main::findseq, avg 301ms/call |
58 | } | ||||
59 | |||||
60 | 1 | 100ns | my $longest = @longseq; | ||
61 | |||||
62 | 1 | 21µs | 1 | 14µs | print "\nlongest sequence is length $longest: @longseq\n"; # spent 14µs making 1 call to main::CORE:print |
63 | 1 | 100ns | exit 0; | ||
64 | |||||
65 | |||||
66 | # | ||||
67 | # findseq( $currw, $used, @seq ); | ||||
68 | # Find all sequences of words from $currw onwards, | ||||
69 | # given that we've already visited words in @seq, | ||||
70 | # (the same info, as a set, is in %$used) | ||||
71 | # and update the global @longseq if any sequences | ||||
72 | # we find are longer than that. | ||||
73 | # | ||||
74 | fun findseq( $currw, $used, @seq ) | ||||
75 | 10032156 | 2.81s | { | ||
76 | 5016078 | 427ms | push @seq, $currw; # extend @seq sequence | ||
77 | |||||
78 | 5016078 | 649ms | $used->{$currw}++; | ||
79 | |||||
80 | 5016078 | 6.32s | 5016078 | 893ms | $currw =~ /(.)$/; # find the last letter of currw # spent 893ms making 5016078 calls to main::CORE:match, avg 178ns/call |
81 | 5016078 | 567ms | my $lastletter = $1; | ||
82 | |||||
83 | 5016078 | 601ms | my $nextw = $sw{$lastletter}; # words starting with lastletter | ||
84 | 5016078 | 737ms | if( defined $nextw ) # continue searching | ||
85 | { | ||||
86 | foreach my $nextword (@$nextw) | ||||
87 | { | ||||
88 | findseq( $nextword, $used, @seq ) | ||||
89 | 7864514 | 2.84s | 5016008 | 0s | unless $used->{$nextword}; # spent 289s making 5016008 calls to main::findseq, avg 58µs/call, recursion: max depth 22, sum of overlapping time 289s |
90 | } | ||||
91 | } else # @seq is finished | ||||
92 | { | ||||
93 | #print "found sequence @seq\n"; | ||||
94 | 1346584 | 118ms | my $len = @seq; | ||
95 | 1346584 | 140ms | if( $len > @longseq ) | ||
96 | { | ||||
97 | 16 | 700ns | print "seq len $len, @seq\n" if $debug; | ||
98 | 16 | 14µs | @longseq = @seq; | ||
99 | } | ||||
100 | } | ||||
101 | 5016078 | 5.85s | delete $used->{$currw}; | ||
102 | 1 | 36µs | 1 | 4µs | } # spent 4µs making 1 call to Function::Parameters::_register_info |
# spent 4µs within UNIVERSAL::VERSION which was called:
# once (4µs+0s) by Function::Parameters::BEGIN@7 at line 24 of Scalar/Util.pm | |||||
sub main::CORE:match; # opcode | |||||
# spent 14µs within main::CORE:print which was called:
# once (14µs+0s) by main::RUNTIME at line 62 |