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

Filename	/homes/dcw/public_html/PSD/article13/v6.pl
Statements	Executed 11369180 statements in 7.85s

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
23	1	1	7.85s	7.85s	main::::lengthen main::lengthen
1	1	1	2.10ms	3.14ms	main::::BEGIN@29 main::BEGIN@29
1	1	1	1.19ms	4.14ms	main::::BEGIN@28 main::BEGIN@28
1	1	1	1.07ms	1.08ms	main::::BEGIN@27 main::BEGIN@27
1	1	1	229µs	252µs	main::::BEGIN@26 main::BEGIN@26
24	2	1	206µs	206µs	main::::CORE:say main::CORE:say (opcode)
280	4	1	59µs	59µs	main::::CORE:match main::CORE:match (opcode)
1	1	1	55µs	60µ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	900ns	900ns	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 v6: complete reimplementation, iterative version 7.9s
20					# optimization v5: used word numbers not words, arrays not hashes 12.0s
21					# ...
22					# optimization v1: baseline code before starting to optimize: 32.6s.
23					#
24
25	2	27µ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	148µs	2	255µs	# spent 252µs (229+23) within main::BEGIN@26 which was called: # once (229µs+23µs) by main::NULL at line 26 use strict; # spent 252µs making 1 call to main::BEGIN@26 # spent 2µs making 1 call to strict::import
27	2	1.02ms	2	1.08ms	# spent 1.08ms (1.07+5µs) within main::BEGIN@27 which was called: # once (1.07ms+5µs) by main::NULL at line 27 use warnings; # spent 1.08ms making 1 call to main::BEGIN@27 # spent 3µs making 1 call to warnings::import
28	2	52µs	2	4.24ms	# spent 4.14ms (1.19+2.95) within main::BEGIN@28 which was called: # once (1.19ms+2.95ms) by main::NULL at line 28 use Function::Parameters; # spent 4.14ms making 1 call to main::BEGIN@28 # spent 103µs making 1 call to Function::Parameters::import
29	2	240µs	2	3.15ms	# spent 3.14ms (2.10+1.04) within main::BEGIN@29 which was called: # once (2.10ms+1.04ms) by main::NULL at line 29 use Data::Dumper; # spent 3.14ms making 1 call to main::BEGIN@29 # spent 13µ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	6µs			my $word = $words[$wn];
61	70	54µs	70	16µs	$word =~ /^(.)/; # spent 16µs making 70 calls to main::CORE:match, avg 233ns/call
62	70	7µs			my $firstletter = $1;
63	70	12µs			$sw{$firstletter} //= [];
64	70	16µs			push @{$sw{$firstletter}}, $wn;
65					}
66					#die Dumper \%sw;
67
68					# build %ew
69	1	500ns			foreach my $wn (0..$#words)
70					{
71	70	7µs			my $word = $words[$wn];
72	70	46µs	70	14µs	$word =~ /(.)$/; # spent 14µs making 70 calls to main::CORE:match, avg 206ns/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	6µs			my $word = $words[$wn];
83	70	49µs	70	14µs	$word =~ /(.)$/; # spent 14µs making 70 calls to main::CORE:match, avg 204ns/call
84	70	8µs			my $lastletter = $1;
85	70	9µs			my $aref = $sw{$lastletter} // [];
86	70	13µ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	46µs	70	14µs	$word =~ /^(.)/; # spent 14µs making 70 calls to main::CORE:match, avg 201ns/call
95	70	8µs			my $firstletter = $1;
96	70	9µs			my $aref = $ew{$firstletter} // [];
97	70	13µs			$inword[$wn]= $aref;
98					}
99					#die Dumper \@inword;
100
101					# No longer need %sw or %ew..
102
103	1	100ns			my @seqs; # all sequences of length N
104	1	100ns			my $N = 1; # length starts at 1 and is increased..
105
106					# convert each stopword wordno to a seq
107	1	2µs			@seqs = map { [ $_ ] } @stopword;
108
109	1	100ns			for(;;)
110					{
111	23	11µs			my $nseq = @seqs;
112	23	254µs	23	201µs	say "Have $nseq sequences of length $N"; # spent 201µs making 23 calls to main::CORE:say, avg 9µs/call
113					#show_seqs( @seqs );
114	23	52µs	23	7.85s	my $ok = lengthen( \@seqs, $N ); # spent 7.85s making 23 calls to main::lengthen, avg 341ms/call
115	23	6µs			last unless $ok;
116	22	11µs			$N++;
117					}
118
119					#show_seqs( @seqs );
120
121					# show just one of the longest sequences
122	1	2µs	1	60µs	show_seqs( @seqs[0..0] ); # spent 60µs making 1 call to main::show_seqs
123
124	1	100ns			exit 0;
125
126
127					#
128					# show_seqs( @seqs );
129					# Show the sequences (as words, not word nos)
130					#
131					# spent 60µs (55+5) within main::show_seqs which was called: # once (55µs+5µs) by main::RUNTIME at line 122 fun show_seqs( @seqs )
132	1	500ns			{
133	1	2µs			foreach my $s (@seqs)
134					{
135	1	50µs			my $str = join( ',', map { $words[$_] } @$s );
136	1	8µs	1	5µs	say $str; # spent 5µs making 1 call to main::CORE:say
137					}
138	1	91µs	1	4µs	} # spent 4µs making 1 call to Function::Parameters::_register_info
139
140
141					#
142					# my $ok = lengthen( $seqs, $N );
143					# Take $seqs, a reference of a list of sequences, where each sequence
144					# is of length N and ends in a stopword, and try to lengthen them all
145					# backwards, ie. prepending a word number to the start of each sequence.
146					# If this is possible, then @$seqs is altered to deliver the new, longer
147					# list of sequences (all of length N+1 now), and 1 is returned.
148					# Otherwise, if lengthening is not possible - if no sequence of length N
149					# can be extended by any unused word in a valid way, leave @$seq alone,
150					# and return 0.
151					#
152					# spent 7.85s within main::lengthen which was called 23 times, avg 341ms/call: # 23 times (7.85s+0s) by main::RUNTIME at line 114, avg 341ms/call fun lengthen( $seqs, $N )
153	69	29µs			{
154	23	4µs			my @new; # new sequences
155
156	23	115µs			foreach my $s (@$seqs) # foreach current sequence
157					{
158	1346584	3.79s			my %used = map { $_ => 1 } @$s;
159	1346584	115ms			my $firstwno = $s->[0];
160	1346584	105ms			my $list = $inword[$firstwno]; # list of word nos into s[0]
161	1346584	907ms			foreach my $wno (@$list)
162					{
163	1941404	170ms			next if $used{$wno}; # no cycles need apply
164
165					# make a single length N+1 sequence, cons(wno,oldseq)
166	1346572	1.13s			my @oneseq = @$s;
167	1346572	389ms			unshift @oneseq, $wno;
168
169					# it's a new sequence!
170	1346572	300ms			push @new, \@oneseq;
171					}
172					}
173					#say "debug: ", Dumper(\@new);
174	23	6µs			if( @new )
175					{
176	22	874ms			@$seqs = @new;
177	22	75.0ms			return 1;
178					}
179	1	3µs			return 0;
180	1	44µs	1	3µs	} # spent 3µs making 1 call to Function::Parameters::_register_info

					# spent 900ns within Internals::SvREADONLY which was called 3 times, avg 300ns/call: # once (500ns+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 59µs within main::CORE:match which was called 280 times, avg 211ns/call: # 70 times (16µs+0s) by main::RUNTIME at line 61, avg 233ns/call # 70 times (14µs+0s) by main::RUNTIME at line 72, avg 206ns/call # 70 times (14µs+0s) by main::RUNTIME at line 83, avg 204ns/call # 70 times (14µs+0s) by main::RUNTIME at line 94, avg 201ns/call sub main::CORE:match; # opcode
					# spent 206µs within main::CORE:say which was called 24 times, avg 9µs/call: # 23 times (201µs+0s) by main::RUNTIME at line 112, avg 9µs/call # once (5µs+0s) by main::show_seqs at line 136 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