Profile of /homes/dcw/src/perl/weeklychallenge/perlweeklychallenge-club/challenge-025/duncan-c-white/perl5/v5.pl

Filename	/homes/dcw/src/perl/weeklychallenge/perlweeklychallenge-club/challenge-025/duncan-c-white/perl5/v5.pl
Statements	Executed 42822429 statements in 12.2s

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
5016078	2	1	12.2s	12.2s	main::::findseq main::findseq (recurses: max depth 22, inclusive time 165s)
1	1	1	1.38ms	4.85ms	main::::BEGIN@33 main::BEGIN@33
1	1	1	1.27ms	1.28ms	main::::BEGIN@32 main::BEGIN@32
1	1	1	277µs	303µs	main::::BEGIN@31 main::BEGIN@31
140	2	1	31µs	31µs	main::::CORE:match main::CORE:match (opcode)
1	1	1	18µs	18µs	main::::CORE:print main::CORE:print (opcode)
1	1	1	13µs	13µs	main::::BEGIN@30 main::BEGIN@30
1	1	1	4µs	4µs	UNIVERSAL::::VERSIONUNIVERSAL::VERSION (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 v5: major data structure changes: used word numbers not
20					# words in several places, used arrays not hashes 12.0s
21					# optimization v4: instead of extracting the last letter of each word,
22					# precalculate %lw: word->last letter of word 14.8s
23					# optimization v3: instead of cloning the used set to modify it,
24					# modify it, pass it, and then change it back 21.1s
25					# optimization v2: instead of recalculating the "used set" each time,
26					# pass it around, modifying it as we go 28.8s
27					# optimization v1: baseline code before starting to optimize: 32.6s.
28					#
29
30	2	34µs	1	13µs	# spent 13µs within main::BEGIN@30 which was called: # once (13µs+0s) by main::NULL at line 30 use v5.10; # to get "say" # spent 13µs making 1 call to main::BEGIN@30
31	2	184µs	2	306µs	# spent 303µs (277+26) within main::BEGIN@31 which was called: # once (277µs+26µs) by main::NULL at line 31 use strict; # spent 303µs making 1 call to main::BEGIN@31 # spent 2µs making 1 call to strict::import
32	2	1.20ms	2	1.28ms	# spent 1.28ms (1.27+6µs) within main::BEGIN@32 which was called: # once (1.27ms+6µs) by main::NULL at line 32 use warnings; # spent 1.28ms making 1 call to main::BEGIN@32 # spent 4µs making 1 call to warnings::import
33	2	271µs	2	4.97ms	# spent 4.85ms (1.38+3.47) within main::BEGIN@33 which was called: # once (1.38ms+3.47ms) by main::NULL at line 33 use Function::Parameters; # spent 4.85ms making 1 call to main::BEGIN@33 # spent 126µs making 1 call to Function::Parameters::import
34					#use Data::Dumper;
35
36	1	600ns			my $debug = @ARGV>0;
37
38	1	3µs			my @words = qw(audino bagon baltoy banette bidoof braviary bronzor carracosta
39					charmeleon cresselia croagunk darmanitan deino emboar emolga
40					exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur
41					jellicent jumpluff kangaskhan kricketune landorus ledyba loudred
42					lumineon lunatone machamp magnezone mamoswine nosepass petilil
43					pidgeotto pikachu pinsir poliwrath poochyena porygon2 porygonz
44					registeel relicanth remoraid rufflet sableye scolipede scrafty
45					seaking sealeo silcoon simisear snivy snorlax spoink starly
46					tirtouga trapinch treecko tyrogue vigoroth vulpix wailord
47					wartortle whismur wingull yamask);
48					#@words = qw(hello ollie excellent thanks shelter runaround set to);
49
50	1	100ns			my %sw; # hash from letter to list of word nos starting with that letter.
51
52					my %snew;# hash from letter to whether or not there ARE any words starting
53					# with that latter; 0 for no, 1 for yes.
54
55					my @lw; # mapping from word no to last letter of word.
56
57	1	900ns			foreach my $letter ('a'..'z')
58					{
59	26	8µs			$snew{$letter} = 0;
60					}
61
62	1	800ns			foreach my $wordno (0..$#words)
63					{
64	70	8µs			my $word = $words[$wordno];
65	70	52µs	70	16µs	$word =~ /^(.)/; # spent 16µs making 70 calls to main::CORE:match, avg 230ns/call
66	70	9µs			my $letter = $1;
67	70	12µs			$sw{$letter} //= [];
68	70	12µs			push @{$sw{$letter}}, $wordno;
69	70	7µs			$snew{$letter} = 1;
70
71	70	46µs	70	15µs	$word =~ /(.)$/; # spent 15µs making 70 calls to main::CORE:match, avg 209ns/call
72	70	23µs			$lw[$wordno] = $1;
73					}
74
75					#die Dumper \%sw;
76					#die Dumper \%snew;
77					#die Dumper \@lw;
78
79	1	200ns			my @longseq = (); # longest sequence found so far..
80
81					# search for sequences starting with each word in turn..
82	1	600ns			foreach my $sw (0..$#words)
83					{
84	70	172µs	70	12.2s	findseq( $sw, [ (0) x scalar(@words)], () ); # spent 12.2s making 70 calls to main::findseq, avg 175ms/call
85					}
86
87	1	200ns			my $longest = @longseq;
88	1	5µs			@longseq = map { $words[$_] } @longseq;
89
90	1	26µs	1	18µs	print "\nlongest sequence is length $longest: @longseq\n"; # spent 18µs making 1 call to main::CORE:print
91	1	0s			exit 0;
92
93
94					#
95					# findseq( $currwno, $used, @seq );
96					# Find all sequences of words from $currwno onwards,
97					# given that we've already visited wordnos in @seq,
98					# (the same info, as a set of word nos, is in @$used)
99					# and update the global @longseq if any sequences
100					# we find are longer than that.
101					#
102					# spent 12.2s (12.2+-0ns) within main::findseq which was called 5016078 times, avg 2µs/call: # 5016008 times (12.2s+-12.2s) by main::findseq at line 112, avg 0s/call # 70 times (213µs+12.2s) by main::RUNTIME at line 84, avg 175ms/call fun findseq( $currwno, $used, @seq )
103	10032156	1.45s			{
104	5016078	297ms			push @seq, $currwno; # extend @seq sequence
105	5016078	315ms			$used->[$currwno]=1; # update $used set
106	5016078	408ms			my $lastletter = $lw[$currwno]; # last letter of currw
107
108	5016078	1.59s			if( $snew{$lastletter} ) # any words starting with letter?
109					{
110					foreach my $nextwordno (grep { ! $used->[$_] } @{$sw{$lastletter}})
111					{
112	5016008	2.03s	5016008	0s	findseq( $nextwordno, $used, @seq ); # spent 165s making 5016008 calls to main::findseq, avg 33µs/call, recursion: max depth 22, sum of overlapping time 165s
113					}
114					} else # @seq is finished
115					{
116					#print "found sequence @seq\n";
117	1346584	104ms			my $len = @seq;
118	1346584	105ms			if( $len > @longseq )
119					{
120	16	1µs			print "longest seq so far (len $len): @seq\n" if $debug;
121	16	7µs			@longseq = @seq;
122					}
123					}
124	5016078	5.95s			$used->[$currwno]=0;
125	1	47µs	1	5µs	} # spent 5µs making 1 call to Function::Parameters::_register_info

					# 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 31µs within main::CORE:match which was called 140 times, avg 219ns/call: # 70 times (16µs+0s) by main::RUNTIME at line 65, avg 230ns/call # 70 times (15µs+0s) by main::RUNTIME at line 71, avg 209ns/call sub main::CORE:match; # opcode
					# spent 18µs within main::CORE:print which was called: # once (18µs+0s) by main::RUNTIME at line 90 sub main::CORE:print; # opcode