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

Filename	/homes/dcw/public_html/PSD/article13/v11.pl
Statements	Executed 10774263 statements in 4.86s

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

					# spent 2µs within Internals::SvREADONLY which was called 3 times, avg 733ns/call: # once (1µs+0s) by constant::BEGIN@24 at line 33 of constant.pm # once (900ns+0s) by constant::import at line 164 of constant.pm # once (300ns+0s) by constant::BEGIN@24 at line 34 of constant.pm sub Internals::SvREADONLY; # xsub
					# spent 12µs within UNIVERSAL::VERSION which was called: # once (12µs+0s) by Function::Parameters::BEGIN@7 at line 24 of Scalar/Util.pm sub UNIVERSAL::VERSION; # xsub
					# spent 103µs within main::CORE:match which was called 280 times, avg 367ns/call: # 70 times (31µs+0s) by main::RUNTIME at line 75, avg 447ns/call # 70 times (25µs+0s) by main::RUNTIME at line 86, avg 363ns/call # 70 times (25µs+0s) by main::RUNTIME at line 64, avg 351ns/call # 70 times (21µs+0s) by main::RUNTIME at line 97, avg 306ns/call sub main::CORE:match; # opcode
					# spent 221µs within main::CORE:say which was called 24 times, avg 9µs/call: # 23 times (215µs+0s) by main::findall at line 174, avg 9µs/call # once (6µs+0s) by main::show_seqs at line 137 sub main::CORE:say; # opcode
					# spent 1µs within mro::method_changed_in which was called: # once (1µs+0s) by constant::import at line 198 of constant.pm sub mro::method_changed_in; # xsub