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

Filename	/homes/dcw/public_html/PSD/article13/v7.pl
Statements	Executed 12121005 statements in 5.97s

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
23	1	1	5.97s	5.97s	main::::lengthen main::lengthen
1	1	1	2.81ms	4.19ms	main::::BEGIN@29 main::BEGIN@29
1	1	1	1.59ms	5.48ms	main::::BEGIN@28 main::BEGIN@28
1	1	1	1.31ms	1.32ms	main::::BEGIN@27 main::BEGIN@27
1	1	1	274µs	302µs	main::::BEGIN@26 main::BEGIN@26
24	2	1	212µs	212µs	main::::CORE:say main::CORE:say (opcode)
280	4	1	92µs	92µs	main::::CORE:match main::CORE:match (opcode)
12	1	1	41µs	41µs	main::::suset main::suset
1	1	1	18µs	23µs	main::::show_seqs main::show_seqs
1	1	1	10µs	10µs	main::::BEGIN@25 main::BEGIN@25
1	1	1	5µs	5µs	UNIVERSAL::::VERSIONUNIVERSAL::VERSION (xsub)
3	3	1	1µs	1µs	Internals::::SvREADONLYInternals::SvREADONLY (xsub)
1	1	1	500ns	500ns	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 v7: seqs->sus (don't rebuild used set each time) 6.0s
20					# optimization v6: complete reimplementation, iterative version 7.9s
21					# ...
22					# optimization v1: baseline code before starting to optimize: 32.6s.
23					#
24
25	2	28µs	1	10µs	# spent 10µs within main::BEGIN@25 which was called: # once (10µs+0s) by main::NULL at line 25 use v5.10; # to get "say" # spent 10µs making 1 call to main::BEGIN@25
26	2	175µs	2	304µs	# spent 302µs (274+27) within main::BEGIN@26 which was called: # once (274µs+27µs) by main::NULL at line 26 use strict; # spent 302µs making 1 call to main::BEGIN@26 # spent 2µs making 1 call to strict::import
27	2	1.25ms	2	1.32ms	# spent 1.32ms (1.31+6µs) within main::BEGIN@27 which was called: # once (1.31ms+6µs) by main::NULL at line 27 use warnings; # spent 1.32ms making 1 call to main::BEGIN@27 # spent 4µs making 1 call to warnings::import
28	2	64µs	2	5.62ms	# spent 5.48ms (1.59+3.89) within main::BEGIN@28 which was called: # once (1.59ms+3.89ms) by main::NULL at line 28 use Function::Parameters; # spent 5.48ms making 1 call to main::BEGIN@28 # spent 141µs making 1 call to Function::Parameters::import
29	2	384µs	2	4.21ms	# spent 4.19ms (2.81+1.38) within main::BEGIN@29 which was called: # once (2.81ms+1.38ms) by main::NULL at line 29 use Data::Dumper; # spent 4.19ms making 1 call to main::BEGIN@29 # spent 16µs making 1 call to Exporter::import
30
31	1	1µs			my $debug = @ARGV>0;
32
33	1	6µ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	200ns			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	2µs			foreach my $wn (0..$#words)
59					{
60	70	9µs			my $word = $words[$wn];
61	70	63µs	70	17µs	$word =~ /^(.)/; # spent 17µs making 70 calls to main::CORE:match, avg 243ns/call
62	70	11µs			my $firstletter = $1;
63	70	16µs			$sw{$firstletter} //= [];
64	70	22µs			push @{$sw{$firstletter}}, $wn;
65					}
66					#die Dumper \%sw;
67
68					# build %ew
69	1	700ns			foreach my $wn (0..$#words)
70					{
71	70	11µs			my $word = $words[$wn];
72	70	80µs	70	27µs	$word =~ /(.)$/; # spent 27µs making 70 calls to main::CORE:match, avg 389ns/call
73	70	13µs			my $lastletter = $1;
74	70	17µs			$ew{$lastletter} //= [];
75	70	30µs			push @{$ew{$lastletter}}, $wn;
76					}
77					#die Dumper \%ew;
78
79					# build @stopword, using %sw
80	1	1µs			foreach my $wn (0..$#words)
81					{
82	70	12µs			my $word = $words[$wn];
83	70	83µs	70	28µs	$word =~ /(.)$/; # spent 28µs making 70 calls to main::CORE:match, avg 396ns/call
84	70	13µs			my $lastletter = $1;
85	70	16µs			my $aref = $sw{$lastletter} // [];
86	70	31µs			push @stopword, $wn if @$aref==0;
87					}
88					#die Dumper [ map { $words[$_] } @stopword ];
89
90					# build @inword, using %ew
91	1	900ns			foreach my $wn (0..$#words)
92					{
93	70	9µs			my $word = $words[$wn];
94	70	66µs	70	20µs	$word =~ /^(.)/; # spent 20µs making 70 calls to main::CORE:match, avg 284ns/call
95	70	11µs			my $firstletter = $1;
96	70	16µs			my $aref = $ew{$firstletter} // [];
97	70	21µs			$inword[$wn]= $aref;
98					}
99					#die Dumper \@inword;
100
101					# No longer need %sw or %ew..
102
103	1	200ns			my $N = 1; # length starts at 1 and is increased..
104
105	1	100ns			my @sus; # all SUs for sequences of length N,
106					# each entry is a [ seqarrayref, usedarrayref ] pair
107
108					# convert each stopword wordno into a SU pair, building a list of them all
109	13	30µs	12	41µs	@sus = map { [ [ $_ ], [ suset($_) ] ] } @stopword; # spent 41µs making 12 calls to main::suset, avg 3µs/call
110
111	1	100ns			for(;;)
112					{
113	23	13µs			my $nseq = @sus;
114	23	267µs	23	206µs	say "Have $nseq sequences of length $N"; # spent 206µs making 23 calls to main::CORE:say, avg 9µs/call
115					#show_seqs( @sus );
116	23	53µs	23	5.97s	my $ok = lengthen( \@sus, $N ); # spent 5.97s making 23 calls to main::lengthen, avg 259ms/call
117	23	7µs			last unless $ok;
118	22	12µs			$N++;
119					}
120
121					#show_seqs( @sus );
122
123					# show just one of the longest sequences
124	1	3µs	1	23µs	show_seqs( @sus[0..0] ); # spent 23µs making 1 call to main::show_seqs
125
126	1	0s			exit 0;
127
128
129					#
130					# my @suset = suset( $wno );
131					# Form a SUset in which all word nos are unused, except $wno.
132					#
133					# spent 41µs within main::suset which was called 12 times, avg 3µs/call: # 12 times (41µs+0s) by main::RUNTIME at line 109, avg 3µs/call fun suset( $wno )
134	36	4µs			{
135	12	12µs			my @suset = (0) x scalar(@words);
136	12	1µs			$suset[$wno] = 1;
137	12	28µs			return @suset;
138	1	93µs	1	7µs	} # spent 7µs making 1 call to Function::Parameters::_register_info
139
140
141					#
142					# show_seqs( @sus );
143					# Show the sequences (as words, not word nos)
144					#
145					# spent 23µs (18+5) within main::show_seqs which was called: # once (18µs+5µs) by main::RUNTIME at line 124 fun show_seqs( @sus )
146	1	500ns			{
147	1	2µs			foreach my $su (@sus)
148					{
149	1	400ns			my( $s, $u ) = @$su;
150	1	11µs			my $str = join( ',', map { $words[$_] } @$s );
151	1	9µs	1	5µs	say $str; # spent 5µs making 1 call to main::CORE:say
152					}
153	1	210µs	1	6µs	} # spent 6µs making 1 call to Function::Parameters::_register_info
154
155
156					#
157					# my $ok = lengthen( $sus, $N );
158					# Take $sus, a reference of a list of SUs, where each SU is a
159					# [ sequence, usedset ] pair, and each sequence is of length N and
160					# ends in a stopword, and try to lengthen them all backwards, ie.
161					# prepending a word number to the start of each sequence.
162					# If this is possible, then @$sus is altered to deliver the new, longer
163					# SUlist (all of length N+1 now), and 1 is returned. Otherwise, if
164					# lengthening is not possible, leave @$sus alone, and return 0.
165					#
166					# spent 5.97s within main::lengthen which was called 23 times, avg 259ms/call: # 23 times (5.97s+0s) by main::RUNTIME at line 116, avg 259ms/call fun lengthen( $sus, $N )
167	69	31µs			{
168	23	4µs			my @new; # new list of SUs
169
170	23	117µs			foreach my $su (@$sus) # foreach current SU
171					{
172	1346584	321ms			my( $s, $used ) = @$su;
173	1346584	209ms			my $firstwno = $s->[0];
174	1346584	109ms			my $list = $inword[$firstwno]; # list of word nos into s[0]
175
176	1346584	563ms			foreach my $wno (grep { ! $used->[$_] } @$list)
177					{
178					# make a single length N+1 sequence, cons(wno,oldseq)
179	1346572	453ms			my @oneseq = @$s;
180	1346572	354ms			unshift @oneseq, $wno;
181
182					# make an altered used array, with one more used.
183	1346572	1.64s			my @newu = @$used;
184	1346572	88.4ms			$newu[$wno] = 1;
185
186					# it's a new SU!
187	1346572	537ms			push @new, [ \@oneseq, \@newu ];
188					#say "debug: ", Dumper(\@oneseq) if $N==22;
189					}
190					}
191	23	8µs			if( @new )
192					{
193	22	1.53s			@$sus = @new;
194	22	167ms			return 1;
195					}
196	1	3µs			return 0;
197	1	83µs	1	5µs	} # spent 5µs making 1 call to Function::Parameters::_register_info

					# spent 1µs within Internals::SvREADONLY which was called 3 times, avg 467ns/call: # once (900ns+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 5µs within UNIVERSAL::VERSION which was called: # once (5µs+0s) by Function::Parameters::BEGIN@7 at line 24 of Scalar/Util.pm sub UNIVERSAL::VERSION; # xsub
					# spent 92µs within main::CORE:match which was called 280 times, avg 328ns/call: # 70 times (28µs+0s) by main::RUNTIME at line 83, avg 396ns/call # 70 times (27µs+0s) by main::RUNTIME at line 72, avg 389ns/call # 70 times (20µs+0s) by main::RUNTIME at line 94, avg 284ns/call # 70 times (17µs+0s) by main::RUNTIME at line 61, avg 243ns/call sub main::CORE:match; # opcode
					# spent 212µs within main::CORE:say which was called 24 times, avg 9µs/call: # 23 times (206µs+0s) by main::RUNTIME at line 114, avg 9µs/call # once (5µs+0s) by main::show_seqs at line 151 sub main::CORE:say; # opcode
					# spent 500ns within mro::method_changed_in which was called: # once (500ns+0s) by constant::import at line 198 of constant.pm sub mro::method_changed_in; # xsub