← Index
NYTProf Performance Profile   « line view »
For v12.pl
  Run on Mon Mar 16 16:15:03 2020
Reported on Mon Mar 16 16:15:16 2020

Filename/homes/dcw/public_html/PSD/article13/v12.pl
StatementsExecuted 9427692 statements in 4.61s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1114.60s4.60smain::::findall main::findall
1112.26ms3.39msmain::::BEGIN@33 main::BEGIN@33
1111.29ms4.50msmain::::BEGIN@32 main::BEGIN@32
1111.18ms1.18msmain::::BEGIN@31 main::BEGIN@31
111242µs267µsmain::::BEGIN@30 main::BEGIN@30
2421216µs216µsmain::::CORE:say main::CORE:say (opcode)
2804160µs60µsmain::::CORE:match main::CORE:match (opcode)
121134µs34µsmain::::suset main::suset
11121µs27µsmain::::show_seqs main::show_seqs
1118µs8µsmain::::BEGIN@29 main::BEGIN@29
1114µs4µsUNIVERSAL::::VERSIONUNIVERSAL::VERSION (xsub)
331900ns900nsInternals::::SvREADONLYInternals::SvREADONLY (xsub)
111400ns400nsmro::::method_changed_in mro::method_changed_in (xsub)
0000s0smain::::RUNTIME main::RUNTIME
0000s0smain::::show_sus main::show_sus
Call graph for these subroutines as a Graphviz dot language file.
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# optimization v12: turn SU pair into SLU triple, changing list to str ???s
20# refactoring v11: confine knowledge of SUs inside findall() 4.9s
21# optimization v10: more efficient reuse of arrays in new findall() 4.9s
22# refactoring v9: merge outer for loop and lengthen() into findall 5.7s
23# optimization v8: alter used set rather than rebuild it 5.8s
24# optimization v7: seqs->sus (don't rebuild used set each time) 6.0s
25# optimization v6: complete reimplementation, iterative version 7.9s
26# ...
27# optimization v1: baseline code before starting to optimize: 32.6s.
28
29224µs18µs
# spent 8µs within main::BEGIN@29 which was called: # once (8µs+0s) by main::NULL at line 29
use v5.10; # to get "say"
# spent 8µs making 1 call to main::BEGIN@29
302155µs2269µs
# spent 267µs (242+25) within main::BEGIN@30 which was called: # once (242µs+25µs) by main::NULL at line 30
use strict;
# spent 267µs making 1 call to main::BEGIN@30 # spent 2µs making 1 call to strict::import
3121.12ms21.19ms
# spent 1.18ms (1.18+6µs) within main::BEGIN@31 which was called: # once (1.18ms+6µs) by main::NULL at line 31
use warnings;
# spent 1.18ms making 1 call to main::BEGIN@31 # spent 4µs making 1 call to warnings::import
32256µs24.61ms
# spent 4.50ms (1.29+3.21) within main::BEGIN@32 which was called: # once (1.29ms+3.21ms) by main::NULL at line 32
use Function::Parameters;
# spent 4.50ms making 1 call to main::BEGIN@32 # spent 113µs making 1 call to Function::Parameters::import
332241µs23.40ms
# spent 3.39ms (2.26+1.12) within main::BEGIN@33 which was called: # once (2.26ms+1.12ms) by main::NULL at line 33
use Data::Dumper;
# spent 3.39ms making 1 call to main::BEGIN@33 # spent 14µs making 1 call to Exporter::import
34
351600nsmy $debug = @ARGV>0;
36
3713µsmy @words = qw(audino bagon baltoy banette bidoof braviary bronzor carracosta
38 charmeleon cresselia croagunk darmanitan deino emboar emolga
39 exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur
40 jellicent jumpluff kangaskhan kricketune landorus ledyba loudred
41 lumineon lunatone machamp magnezone mamoswine nosepass petilil
42 pidgeotto pikachu pinsir poliwrath poochyena porygon2 porygonz
43 registeel relicanth remoraid rufflet sableye scolipede scrafty
44 seaking sealeo silcoon simisear snivy snorlax spoink starly
45 tirtouga trapinch treecko tyrogue vigoroth vulpix wailord
46 wartortle whismur wingull yamask);
47#@words = qw(hello ollie excellent thanks shelter runaround set to);
48
491100nsmy %sw; # hash from letter L to list of word nos of words STARTING with L
50
51my @stopword;# list of stop word nos (word nos of words with no words going
52 # "out" from them onto another word, ie. word numbers N where
53 # no other word starts with the last letter of word N)
54
55my %ew; # hash from letter L to list of word nos of words ENDING with L
56
57my @inword; # array from word no N to array of wordnos of words going "in"
58 # to word N, i.e. ending with the first letter of word N
59 # if there are no such words, then []
60
61# build %sw
621800nsforeach my $wn (0..$#words)
63{
64707µs my $word = $words[$wn];
657049µs7015µs $word =~ /^(.)/;
# spent 15µs making 70 calls to main::CORE:match, avg 210ns/call
66708µs my $firstletter = $1;
677013µs $sw{$firstletter} //= [];
687018µs push @{$sw{$firstletter}}, $wn;
69}
70#die Dumper \%sw;
71
72# build %ew
731400nsforeach my $wn (0..$#words)
74{
75707µs my $word = $words[$wn];
767047µs7016µs $word =~ /(.)$/;
# spent 16µs making 70 calls to main::CORE:match, avg 221ns/call
77707µs my $lastletter = $1;
787011µs $ew{$lastletter} //= [];
797017µs push @{$ew{$lastletter}}, $wn;
80}
81#die Dumper \%ew;
82
83# build @stopword, using %sw
841400nsforeach my $wn (0..$#words)
85{
86706µs my $word = $words[$wn];
877045µs7014µs $word =~ /(.)$/;
# spent 14µs making 70 calls to main::CORE:match, avg 203ns/call
88707µs my $lastletter = $1;
897011µs my $aref = $sw{$lastletter} // [];
907013µs push @stopword, $wn if @$aref==0;
91}
92#die Dumper [ map { $words[$_] } @stopword ];
93
94# build @inword, using %ew
951300nsforeach my $wn (0..$#words)
96{
97706µs my $word = $words[$wn];
987048µs7016µs $word =~ /^(.)/;
# spent 16µs making 70 calls to main::CORE:match, avg 226ns/call
99707µs my $firstletter = $1;
1007012µs my $aref = $ew{$firstletter} // [];
1017014µs $inword[$wn]= $aref;
102}
103#die Dumper \@inword;
104
105# No longer need %sw or %ew.. only @inword and @stopword
106
1071294µs14.60smy @seqs = findall();
# spent 4.60s making 1 call to main::findall
108
1091300nsshow_seqs( @seqs ) if $debug;
110
111# show just one of the longest sequences
11214µs127µsshow_seqs( @seqs[0..0] );
# spent 27µs making 1 call to main::show_seqs
113
1141100nsexit 0;
115
116
117#
118# my @suset = suset( $wno );
119# Form a SUset in which all word nos are unused, except $wno.
120#
121
# spent 34µs within main::suset which was called 12 times, avg 3µs/call: # 12 times (34µs+0s) by main::findall at line 172, avg 3µs/call
fun suset( $wno )
122363µs{
123129µs my @suset = (0) x scalar(@words);
124121µs $suset[$wno] = 1;
1251224µs return @suset;
126156µs14µs}
# spent 4µs making 1 call to Function::Parameters::_register_info
127
128
129#
130# show_seqs( @seqs );
131# Show the sequences (as words, not word nos)
132#
133
# spent 27µs (21+6) within main::show_seqs which was called: # once (21µs+6µs) by main::RUNTIME at line 112
fun show_seqs( @seqs )
1341400ns{
13512µs foreach my $s (@seqs)
136 {
13714µs my @wn = split(/-/, $s);
13819µs my $str = join( ',', map { $words[$_] } @wn );
139110µs16µs say $str;
# spent 6µs making 1 call to main::CORE:say
140 }
141156µs14µs}
# spent 4µs making 1 call to Function::Parameters::_register_info
142
143
144#
145# show_sus( @sus );
146# Show the sequences (as words, not word nos) contained in SUlist @sus
147#
148fun show_sus( @sus )
149{
150 foreach my $su (@sus)
151 {
152 my( $s, $u ) = @$su;
153 my @wn = split(/-/, $s);
154 my $str = join( ',', map { $words[$_] } @wn );
155 say $str;
156 }
1571123µs14µs}
# spent 4µs making 1 call to Function::Parameters::_register_info
158
159
160#
161# my @seqs = findall();
162# Find all sequences, starting with sequences of length 1 (stop words),
163# then working back, i.e. prepending words onto the front of existing
164# sequences. Delivers the list of all maximal-length sequences.
165#
166
# spent 4.60s (4.60+243µs) within main::findall which was called: # once (4.60s+243µs) by main::RUNTIME at line 107
fun findall( )
1671200ns{
16810s my $sus; # all SUs for sequences of length N, each entry is
169 # a [ $wd, sequence, usedarrayref ] triple
170
171 # convert each stopword wordno into a SU triple, building a list
1721321µs1234µs $sus = [ map { [ $_, $_, [ suset($_) ] ] } @stopword ];
# spent 34µs making 12 calls to main::suset, avg 3µs/call
173
174120µs for( my $N=1 ; ; $N++)
175 {
1762313µs my $nseq = @$sus;
17723330µs23209µs say "Have $nseq sequences of length $N";
# spent 209µs making 23 calls to main::CORE:say, avg 9µs/call
178 #show_seqs( @$sus );
179
180 # Take @$sus, a list of SUs of length N and ending in a
181 # stopword, and try to lengthen them all backwards, ie.
182 # prepend a word number to the start of each sequence.
183
184 # If this is possible, ie. if there is at least one extensible
185 # SU, then change $sus to be the new, longer SUlist (all of
186 # length N+1 now), and carry on looping. Else break out.
187
1882315µs my $new = []; # new list of SUs
189
1902334µs foreach my $su (@$sus) # foreach current SU
191 {
1921346584333ms my( $sw, $s, $used ) = @$su;
193134658493.0ms my $list = $inword[$sw]; # list of word nos into sw
1941346584656ms foreach my $wno (grep { ! $used->[$_] } @$list)
195 {
196 # make a single length N+1 sequence with wno in front of s
1971346572313ms my $oneseq = "$wno-$s";
198
199 # alter the used array, marking $wno used.
200134657290.9ms $used->[$wno] = 1;
201
202 # it's a new SU!
20313465721.75s push @$new, [ $wno, $oneseq, [ @$used ] ];
204 #say "debug: ", Dumper(\@oneseq) if $N==22;
205
206 # alter used back
2071346572260ms $used->[$wno] = 0;
208 }
209 }
210236µs last unless @$new;
211221.11s $sus = $new;
212 }
213
214 # now extract and return all the maximal length sequences
21512.13ms return map { $_->[1] } @$sus;
216147µs13µs}
# spent 3µs making 1 call to Function::Parameters::_register_info
 
# spent 900ns within Internals::SvREADONLY which was called 3 times, avg 300ns/call: # once (500ns+0s) by constant::BEGIN@24 at line 33 of constant.pm # once (300ns+0s) by constant::import at line 164 of constant.pm # once (100ns+0s) by constant::BEGIN@24 at line 34 of constant.pm
sub Internals::SvREADONLY; # xsub
# 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 UNIVERSAL::VERSION; # xsub
# spent 60µs within main::CORE:match which was called 280 times, avg 215ns/call: # 70 times (16µs+0s) by main::RUNTIME at line 98, avg 226ns/call # 70 times (16µs+0s) by main::RUNTIME at line 76, avg 221ns/call # 70 times (15µs+0s) by main::RUNTIME at line 65, avg 210ns/call # 70 times (14µs+0s) by main::RUNTIME at line 87, avg 203ns/call
sub main::CORE:match; # opcode
# spent 216µs within main::CORE:say which was called 24 times, avg 9µs/call: # 23 times (209µs+0s) by main::findall at line 177, avg 9µs/call # once (6µs+0s) by main::show_seqs at line 139
sub main::CORE:say; # opcode
# spent 400ns within mro::method_changed_in which was called: # once (400ns+0s) by constant::import at line 198 of constant.pm
sub mro::method_changed_in; # xsub
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.