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

Filename	/homes/dcw/public_html/PSD/article13/v10.pl
Statements	Executed 10774263 statements in 4.87s

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	4.87s	4.87s	main::::findall main::findall
1	1	1	2.10ms	3.15ms	main::::BEGIN@32 main::BEGIN@32
1	1	1	1.23ms	4.40ms	main::::BEGIN@31 main::BEGIN@31
1	1	1	1.11ms	1.11ms	main::::BEGIN@30 main::BEGIN@30
1	1	1	233µs	253µs	main::::BEGIN@29 main::BEGIN@29
24	2	1	208µs	208µs	main::::CORE:say main::CORE:say (opcode)
280	4	1	37µs	37µs	main::::CORE:match main::CORE:match (opcode)
12	1	1	29µs	29µs	main::::suset main::suset
1	1	1	14µs	19µs	main::::show_seqs main::show_seqs
1	1	1	9µs	9µs	main::::BEGIN@28 main::BEGIN@28
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					# optimization v10: more efficient reuse of arrays in new findall() 5.0s
20					# refactoring v9: merge outer for loop and lengthen() into findall 5.8s
21					# optimization v8: alter used set rather than rebuild it 5.8s
22					# optimization v7: seqs->sus (don't rebuild used set each time) 6.0s
23					# optimization v6: complete reimplementation, iterative version 7.9s
24					# ...
25					# optimization v1: baseline code before starting to optimize: 32.6s.
26					#
27
28	2	28µs	1	9µs	# spent 9µs within main::BEGIN@28 which was called: # once (9µs+0s) by main::NULL at line 28 use v5.10; # to get "say" # spent 9µs making 1 call to main::BEGIN@28
29	2	148µs	2	255µs	# spent 253µs (233+20) within main::BEGIN@29 which was called: # once (233µs+20µs) by main::NULL at line 29 use strict; # spent 253µs making 1 call to main::BEGIN@29 # spent 2µs making 1 call to strict::import
30	2	1.05ms	2	1.12ms	# spent 1.11ms (1.11+5µs) within main::BEGIN@30 which was called: # once (1.11ms+5µs) by main::NULL at line 30 use warnings; # spent 1.11ms making 1 call to main::BEGIN@30 # spent 4µs making 1 call to warnings::import
31	2	54µs	2	4.51ms	# spent 4.40ms (1.23+3.17) within main::BEGIN@31 which was called: # once (1.23ms+3.17ms) by main::NULL at line 31 use Function::Parameters; # spent 4.40ms making 1 call to main::BEGIN@31 # spent 107µs making 1 call to Function::Parameters::import
32	2	218µs	2	3.16ms	# spent 3.15ms (2.10+1.05) within main::BEGIN@32 which was called: # once (2.10ms+1.05ms) by main::NULL at line 32 use Data::Dumper; # spent 3.15ms making 1 call to main::BEGIN@32 # spent 12µs making 1 call to Exporter::import
33
34	1	500ns			my $debug = @ARGV>0;
35
36	1	3µ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	100ns			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	800ns			foreach my $wn (0..$#words)
62					{
63	70	7µs			my $word = $words[$wn];
64	70	43µs	70	9µs	$word =~ /^(.)/; # spent 9µs making 70 calls to main::CORE:match, avg 123ns/call
65	70	8µs			my $firstletter = $1;
66	70	12µs			$sw{$firstletter} //= [];
67	70	17µs			push @{$sw{$firstletter}}, $wn;
68					}
69					#die Dumper \%sw;
70
71					# build %ew
72	1	400ns			foreach my $wn (0..$#words)
73					{
74	70	7µs			my $word = $words[$wn];
75	70	42µs	70	10µs	$word =~ /(.)$/; # spent 10µs making 70 calls to main::CORE:match, avg 144ns/call
76	70	7µs			my $lastletter = $1;
77	70	11µs			$ew{$lastletter} //= [];
78	70	16µs			push @{$ew{$lastletter}}, $wn;
79					}
80					#die Dumper \%ew;
81
82					# build @stopword, using %sw
83	1	400ns			foreach my $wn (0..$#words)
84					{
85	70	6µs			my $word = $words[$wn];
86	70	40µs	70	10µs	$word =~ /(.)$/; # spent 10µs making 70 calls to main::CORE:match, avg 146ns/call
87	70	7µs			my $lastletter = $1;
88	70	9µs			my $aref = $sw{$lastletter} // [];
89	70	12µs			push @stopword, $wn if @$aref==0;
90					}
91					#die Dumper [ map { $words[$_] } @stopword ];
92
93					# build @inword, using %ew
94	1	200ns			foreach my $wn (0..$#words)
95					{
96	70	6µs			my $word = $words[$wn];
97	70	39µs	70	8µs	$word =~ /^(.)/; # spent 8µs making 70 calls to main::CORE:match, avg 111ns/call
98	70	7µs			my $firstletter = $1;
99	70	9µs			my $aref = $ew{$firstletter} // [];
100	70	12µs			$inword[$wn]= $aref;
101					}
102					#die Dumper \@inword;
103
104					# No longer need %sw or %ew.. only @inword and @stopword
105
106	1	7µs	1	4.87s	my @sus = findall(); # spent 4.87s making 1 call to main::findall
107
108					#show_seqs( @sus );
109
110					# show just one of the longest sequences
111	1	3µs	1	19µs	show_seqs( @sus[0..0] ); # spent 19µs making 1 call to main::show_seqs
112
113	1	100ns			exit 0;
114
- -
117					#
118					# my @suset = suset( $wno );
119					# Form a SUset in which all word nos are unused, except $wno.
120					#
121					# spent 29µs within main::suset which was called 12 times, avg 2µs/call: # 12 times (29µs+0s) by main::findall at line 157, avg 2µs/call fun suset( $wno )
122	36	2µs			{
123	12	8µs			my @suset = (0) x scalar(@words);
124	12	700ns			$suset[$wno] = 1;
125	12	20µs			return @suset;
126	1	46µs	1	4µs	} # spent 4µs making 1 call to Function::Parameters::_register_info
127
128
129					#
130					# show_seqs( @sus );
131					# Show the sequences (as words, not word nos)
132					#
133					# spent 19µs (14+4) within main::show_seqs which was called: # once (14µs+4µs) by main::RUNTIME at line 111 fun show_seqs( @sus )
134	1	500ns			{
135	1	2µs			foreach my $su (@sus)
136					{
137	1	300ns			my( $s, $u ) = @$su;
138	1	9µs			my $str = join( ',', map { $words[$_] } @$s );
139	1	6µs	1	4µs	say $str; # spent 4µs making 1 call to main::CORE:say
140					}
141	1	108µs	1	3µs	} # spent 3µs making 1 call to Function::Parameters::_register_info
142
143
144					#
145					# my @sus = findall();
146					# Find all sequences, starting with sequences of length 1 (stop words),
147					# then working back, i.e. prepending words onto the front of existing
148					# sequences. Delivers the list of all maximal-length sequences, each
149					# as a (sequence,usedset) pair.
150					#
151					# spent 4.87s (4.87+233µs) within main::findall which was called: # once (4.87s+233µs) by main::RUNTIME at line 106 fun findall( )
152	1	200ns			{
153	1	100ns			my $sus; # all SUs for sequences of length N,
154					# each entry is a [ seqarrayref, usedarrayref ] pair
155
156					# convert each stopword wordno into a SU pair, building a list
157	13	21µs	12	29µs	$sus = [ map { [ [ $_ ], [ suset($_) ] ] } @stopword ]; # spent 29µs making 12 calls to main::suset, avg 2µs/call
158
159	1	18µs			for( my $N=1 ; ; $N++)
160					{
161	23	12µs			my $nseq = @$sus;
162	23	327µs	23	204µs	say "Have $nseq sequences of length $N"; # spent 204µs making 23 calls to main::CORE:say, avg 9µs/call
163					#show_seqs( @$sus );
164
165					# Take @$sus, a list of SUs of length N and ending in a
166					# stopword, and try to lengthen them all backwards, ie.
167					# prepend a word number to the start of each sequence.
168
169					# If this is possible, ie. if there is at least one extensible
170					# SU, then change $sus to be the new, longer SUlist (all of
171					# length N+1 now), and carry on looping. Else break out.
172
173	23	13µs			my $new = []; # new list of SUs
174
175	23	43µs			foreach my $su (@$sus) # foreach current SU
176					{
177	1346584	279ms			my( $s, $used ) = @$su;
178	1346584	175ms			my $list = $inword[$s->[0]]; # list of word nos into s[0]
179	1346584	661ms			foreach my $wno (grep { ! $used->[$_] } @$list)
180					{
181					# make a single length N+1 sequence, cons(wno,oldseq)
182	1346572	367ms			my @oneseq = @$s;
183	1346572	313ms			unshift @oneseq, $wno;
184
185					# alter the used array, marking $wno used.
186	1346572	89.5ms			$used->[$wno] = 1;
187
188					# it's a new SU!
189	1346572	1.56s			push @$new, [ \@oneseq, [ @$used ] ];
190					#say "debug: ", Dumper(\@oneseq) if $N==22;
191
192					# alter used back
193	1346572	230ms			$used->[$wno] = 0;
194					}
195					}
196	23	6µs			last unless @$new;
197	22	1.18s			$sus = $new;
198					}
199	1	1.40ms			return @$sus;
200	1	41µ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 (500ns+0s) by constant::BEGIN@24 at line 33 of constant.pm # once (400ns+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 37µs within main::CORE:match which was called 280 times, avg 131ns/call: # 70 times (10µs+0s) by main::RUNTIME at line 86, avg 146ns/call # 70 times (10µs+0s) by main::RUNTIME at line 75, avg 144ns/call # 70 times (9µs+0s) by main::RUNTIME at line 64, avg 123ns/call # 70 times (8µs+0s) by main::RUNTIME at line 97, avg 111ns/call sub main::CORE:match; # opcode
					# spent 208µs within main::CORE:say which was called 24 times, avg 9µs/call: # 23 times (204µs+0s) by main::findall at line 162, avg 9µs/call # once (4µ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