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

Filename	/homes/dcw/public_html/PSD/article13/v8.pl
Statements	Executed 12121005 statements in 5.77s

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

					# spent 800ns within Internals::SvREADONLY which was called 3 times, avg 267ns/call: # once (400ns+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 42µs within main::CORE:match which was called 280 times, avg 151ns/call: # 70 times (13µs+0s) by main::RUNTIME at line 72, avg 189ns/call # 70 times (12µs+0s) by main::RUNTIME at line 83, avg 174ns/call # 70 times (9µs+0s) by main::RUNTIME at line 61, avg 127ns/call # 70 times (8µs+0s) by main::RUNTIME at line 94, avg 114ns/call sub main::CORE:match; # opcode
					# spent 213µs within main::CORE:say which was called 24 times, avg 9µs/call: # 23 times (208µs+0s) by main::RUNTIME at line 113, avg 9µs/call # once (5µs+0s) by main::show_seqs at line 150 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