Profile of /homes/dcw/public_html/PSD/article13/v9.pl

Filename	/homes/dcw/public_html/PSD/article13/v9.pl
Statements	Executed 10774263 statements in 5.85s

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	5.84s	5.84s	main::::findall main::findall
1	1	1	2.11ms	3.15ms	main::::BEGIN@31 main::BEGIN@31
1	1	1	1.27ms	4.43ms	main::::BEGIN@30 main::BEGIN@30
1	1	1	1.14ms	1.14ms	main::::BEGIN@29 main::BEGIN@29
1	1	1	234µs	254µs	main::::BEGIN@28 main::BEGIN@28
24	2	1	199µs	199µs	main::::CORE:say main::CORE:say (opcode)
280	4	1	60µs	60µs	main::::CORE:match main::CORE:match (opcode)
12	1	1	30µs	30µs	main::::suset main::suset
1	1	1	18µs	23µs	main::::show_seqs main::show_seqs
1	1	1	9µs	9µs	main::::BEGIN@27 main::BEGIN@27
1	1	1	4µs	4µs	UNIVERSAL::::VERSIONUNIVERSAL::VERSION (xsub)
3	3	1	1µs	1µs	Internals::::SvREADONLYInternals::SvREADONLY (xsub)
1	1	1	400ns	400ns	mro::::method_changed_in mro::method_changed_in (xsub)
0	0	0	0s	0s	main::::RUNTIME main::RUNTIME

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					# refactoring v9: merge outer for loop and lengthen() into findall 5.7s
20					# optimization v8: alter used set rather than rebuild it 5.8s
21					# optimization v7: seqs->sus (don't rebuild used set each time) 6.0s
22					# optimization v6: complete reimplementation, iterative version 7.9s
23					# ...
24					# optimization v1: baseline code before starting to optimize: 32.6s.
25					#
26
27	2	26µs	1	9µs	# spent 9µs within main::BEGIN@27 which was called: # once (9µs+0s) by main::NULL at line 27 use v5.10; # to get "say" # spent 9µs making 1 call to main::BEGIN@27
28	2	149µs	2	256µs	# spent 254µs (234+20) within main::BEGIN@28 which was called: # once (234µs+20µs) by main::NULL at line 28 use strict; # spent 254µs making 1 call to main::BEGIN@28 # spent 2µs making 1 call to strict::import
29	2	1.08ms	2	1.15ms	# spent 1.14ms (1.14+5µs) within main::BEGIN@29 which was called: # once (1.14ms+5µs) by main::NULL at line 29 use warnings; # spent 1.14ms making 1 call to main::BEGIN@29 # spent 3µs making 1 call to warnings::import
30	2	54µs	2	4.54ms	# spent 4.43ms (1.27+3.16) within main::BEGIN@30 which was called: # once (1.27ms+3.16ms) by main::NULL at line 30 use Function::Parameters; # spent 4.43ms making 1 call to main::BEGIN@30 # spent 107µs making 1 call to Function::Parameters::import
31	2	218µs	2	3.16ms	# spent 3.15ms (2.11+1.04) within main::BEGIN@31 which was called: # once (2.11ms+1.04ms) by main::NULL at line 31 use Data::Dumper; # spent 3.15ms making 1 call to main::BEGIN@31 # spent 12µs making 1 call to Exporter::import
32
33	1	500ns			my $debug = @ARGV>0;
34
35	1	3µs			my @words = qw(audino bagon baltoy banette bidoof braviary bronzor carracosta
36					charmeleon cresselia croagunk darmanitan deino emboar emolga
37					exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur
38					jellicent jumpluff kangaskhan kricketune landorus ledyba loudred
39					lumineon lunatone machamp magnezone mamoswine nosepass petilil
40					pidgeotto pikachu pinsir poliwrath poochyena porygon2 porygonz
41					registeel relicanth remoraid rufflet sableye scolipede scrafty
42					seaking sealeo silcoon simisear snivy snorlax spoink starly
43					tirtouga trapinch treecko tyrogue vigoroth vulpix wailord
44					wartortle whismur wingull yamask);
45					#@words = qw(hello ollie excellent thanks shelter runaround set to);
46
47	1	100ns			my %sw; # hash from letter L to list of word nos of words STARTING with L
48
49					my @stopword;# list of stop word nos (word nos of words with no words going
50					# "out" from them onto another word, ie. word numbers N where
51					# no other word starts with the last letter of word N)
52
53					my %ew; # hash from letter L to list of word nos of words ENDING with L
54
55					my @inword; # array from word no N to array of wordnos of words going "in"
56					# to word N, i.e. ending with the first letter of word N
57					# if there are no such words, then []
58
59					# build %sw
60	1	800ns			foreach my $wn (0..$#words)
61					{
62	70	6µs			my $word = $words[$wn];
63	70	51µs	70	16µs	$word =~ /^(.)/; # spent 16µs making 70 calls to main::CORE:match, avg 234ns/call
64	70	9µs			my $firstletter = $1;
65	70	11µs			$sw{$firstletter} //= [];
66	70	18µs			push @{$sw{$firstletter}}, $wn;
67					}
68					#die Dumper \%sw;
69
70					# build %ew
71	1	400ns			foreach my $wn (0..$#words)
72					{
73	70	7µs			my $word = $words[$wn];
74	70	55µs	70	16µs	$word =~ /(.)$/; # spent 16µs making 70 calls to main::CORE:match, avg 234ns/call
75	70	8µs			my $lastletter = $1;
76	70	11µs			$ew{$lastletter} //= [];
77	70	18µs			push @{$ew{$lastletter}}, $wn;
78					}
79					#die Dumper \%ew;
80
81					# build @stopword, using %sw
82	1	400ns			foreach my $wn (0..$#words)
83					{
84	70	5µs			my $word = $words[$wn];
85	70	46µs	70	14µs	$word =~ /(.)$/; # spent 14µs making 70 calls to main::CORE:match, avg 203ns/call
86	70	7µs			my $lastletter = $1;
87	70	10µs			my $aref = $sw{$lastletter} // [];
88	70	13µs			push @stopword, $wn if @$aref==0;
89					}
90					#die Dumper [ map { $words[$_] } @stopword ];
91
92					# build @inword, using %ew
93	1	200ns			foreach my $wn (0..$#words)
94					{
95	70	6µs			my $word = $words[$wn];
96	70	43µs	70	13µs	$word =~ /^(.)/; # spent 13µs making 70 calls to main::CORE:match, avg 186ns/call
97	70	7µs			my $firstletter = $1;
98	70	9µs			my $aref = $ew{$firstletter} // [];
99	70	14µs			$inword[$wn]= $aref;
100					}
101					#die Dumper \@inword;
102
103					# No longer need %sw or %ew.. only @inword and @stopword
104
105	1	5.52ms	1	5.84s	my @sus = findall(); # spent 5.84s making 1 call to main::findall
106
107					#show_seqs( @sus );
108
109					# show just one of the longest sequences
110	1	4µs	1	23µs	show_seqs( @sus[0..0] ); # spent 23µs making 1 call to main::show_seqs
111
112	1	100ns			exit 0;
113
- -
116					#
117					# my @suset = suset( $wno );
118					# Form a SUset in which all word nos are unused, except $wno.
119					#
120					# spent 30µs within main::suset which was called 12 times, avg 3µs/call: # 12 times (30µs+0s) by main::findall at line 156, avg 3µs/call fun suset( $wno )
121	36	3µs			{
122	12	11µs			my @suset = (0) x scalar(@words);
123	12	800ns			$suset[$wno] = 1;
124	12	19µs			return @suset;
125	1	51µs	1	4µs	} # spent 4µs making 1 call to Function::Parameters::_register_info
126
127
128					#
129					# show_seqs( @sus );
130					# Show the sequences (as words, not word nos)
131					#
132					# spent 23µs (18+5) within main::show_seqs which was called: # once (18µs+5µs) by main::RUNTIME at line 110 fun show_seqs( @sus )
133	1	400ns			{
134	1	2µs			foreach my $su (@sus)
135					{
136	1	500ns			my( $s, $u ) = @$su;
137	1	11µs			my $str = join( ',', map { $words[$_] } @$s );
138	1	8µs	1	5µs	say $str; # spent 5µs making 1 call to main::CORE:say
139					}
140	1	109µs	1	3µs	} # spent 3µs making 1 call to Function::Parameters::_register_info
141
142
143					#
144					# my @sus = findall();
145					# Find all sequences, starting with sequences of length 1 (stop words),
146					# then working back, i.e. prepending words onto the front of existing
147					# sequences. Delivers the list of all maximal-length sequences, each
148					# as a (sequence,usedset) pair.
149					#
150					# spent 5.84s (5.84+224µs) within main::findall which was called: # once (5.84s+224µs) by main::RUNTIME at line 105 fun findall( )
151	1	200ns			{
152	1	100ns			my @sus; # all SUs for sequences of length N,
153					# each entry is a [ seqarrayref, usedarrayref ] pair
154
155					# convert each stopword wordno into a SU pair, building a list
156	13	22µs	12	30µs	@sus = map { [ [ $_ ], [ suset($_) ] ] } @stopword; # spent 30µs making 12 calls to main::suset, avg 3µs/call
157
158	1	21µs			for( my $N=1 ; ; $N++)
159					{
160	23	16µs			my $nseq = @sus;
161	23	351µs	23	194µs	say "Have $nseq sequences of length $N"; # spent 194µs making 23 calls to main::CORE:say, avg 8µs/call
162					#show_seqs( @sus );
163
164					# Take @sus, a list of SUs of length N and ending in a
165					# stopword, and try to lengthen them all backwards, ie.
166					# prepend a word number to the start of each sequence.
167
168					# If this is possible, ie. if there is at least one extensible
169					# SU, then change @sus to be the new, longer SUlist (all of
170					# length N+1 now), and carry on looping. Else break out.
171
172	23	4µs			my @new; # new list of SUs
173
174	23	16µs			foreach my $su (@sus) # foreach current SU
175					{
176	1346584	335ms			my( $s, $used ) = @$su;
177	1346584	204ms			my $list = $inword[$s->[0]]; # word nos into s[0]
178	1346584	614ms			foreach my $wno (grep { ! $used->[$_] } @$list)
179					{
180					# make a single length N+1 sequence, cons(wno,oldseq)
181	1346572	444ms			my @oneseq = @$s;
182	1346572	344ms			unshift @oneseq, $wno;
183
184					# alter the used array, marking $wno used.
185	1346572	91.6ms			$used->[$wno] = 1;
186
187					# it's a new SU!
188	1346572	1.94s			push @new, [ \@oneseq, [ @$used ] ];
189					#say "debug: ", Dumper(\@oneseq) if $N==22;
190
191					# alter used back
192	1346572	230ms			$used->[$wno] = 0;
193					}
194					}
195	23	10µs			last unless @new;
196	22	1.64s			@sus = @new;
197					}
198	1	169µs			return @sus;
199	1	40µs	1	3µs	} # spent 3µs making 1 call to Function::Parameters::_register_info

					# spent 1µs within Internals::SvREADONLY which was called 3 times, avg 333ns/call: # once (600ns+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 214ns/call: # 70 times (16µs+0s) by main::RUNTIME at line 74, avg 234ns/call # 70 times (16µs+0s) by main::RUNTIME at line 63, avg 234ns/call # 70 times (14µs+0s) by main::RUNTIME at line 85, avg 203ns/call # 70 times (13µs+0s) by main::RUNTIME at line 96, avg 186ns/call sub main::CORE:match; # opcode
					# spent 199µs within main::CORE:say which was called 24 times, avg 8µs/call: # 23 times (194µs+0s) by main::findall at line 161, avg 8µs/call # once (5µs+0s) by main::show_seqs at line 138 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