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

Filename	/homes/dcw/src/perl/weeklychallenge/perlweeklychallenge-club/challenge-025/duncan-c-white/perl5/v4.pl
Statements	Executed 50686845 statements in 14.7s

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
5016078	2	1	14.7s	14.7s	main::::findseq main::findseq (recurses: max depth 22, inclusive time 200s)
1	1	1	1.28ms	4.44ms	main::::BEGIN@31 main::BEGIN@31
1	1	1	1.18ms	1.18ms	main::::BEGIN@30 main::BEGIN@30
1	1	1	263µs	289µs	main::::BEGIN@29 main::BEGIN@29
140	2	1	26µs	26µs	main::::CORE:match main::CORE:match (opcode)
1	1	1	16µs	16µs	main::::CORE:print main::CORE:print (opcode)
1	1	1	11µs	11µs	main::::BEGIN@28 main::BEGIN@28
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 v4: instead of extracting the last letter of each word,
20					# precalculate %lw: word->last letter of word 14.8s
21					# optimization v3: instead of cloning the used set to modify it,
22					# modify it, pass it, and then change it back 21.1s
23					# optimization v2: instead of recalculating the "used set" each time,
24					# pass it around, modifying it as we go 28.8s
25					# optimization v1: baseline code before starting to optimize: 32.6s.
26					#
27
28	2	31µs	1	11µs	# spent 11µs within main::BEGIN@28 which was called: # once (11µs+0s) by main::NULL at line 28 use v5.10; # to get "say" # spent 11µs making 1 call to main::BEGIN@28
29	2	173µs	2	292µs	# spent 289µs (263+26) within main::BEGIN@29 which was called: # once (263µs+26µs) by main::NULL at line 29 use strict; # spent 289µs making 1 call to main::BEGIN@29 # spent 2µs making 1 call to strict::import
30	2	1.12ms	2	1.19ms	# spent 1.18ms (1.18+6µs) within main::BEGIN@30 which was called: # once (1.18ms+6µs) by main::NULL at line 30 use warnings; # spent 1.18ms making 1 call to main::BEGIN@30 # spent 4µs making 1 call to warnings::import
31	2	214µs	2	4.55ms	# spent 4.44ms (1.28+3.17) within main::BEGIN@31 which was called: # once (1.28ms+3.17ms) by main::NULL at line 31 use Function::Parameters; # spent 4.44ms making 1 call to main::BEGIN@31 # spent 110µs making 1 call to Function::Parameters::import
32					#use Data::Dumper;
33
34	1	600ns			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 to list of words starting with that letter.
49
50					my %lw; # mapping from word to last letter of word (precompute it:-))
51
52	1	300ns			foreach my $word (@words)
53					{
54	70	47µs	70	13µs	$word =~ /^(.)/; # spent 13µs making 70 calls to main::CORE:match, avg 186ns/call
55	70	8µs			my $letter = $1;
56	70	31µs			$sw{$letter} //= [];
57	70	13µs			push @{$sw{$letter}}, $word;
58
59	70	47µs	70	13µs	$word =~ /(.)$/; # spent 13µs making 70 calls to main::CORE:match, avg 181ns/call
60	70	31µs			$lw{$word} = $1;
61					}
62
63					#die Dumper \%sw;
64					#die Dumper \%lw;
65
66	1	200ns			my @longseq = (); # longest sequence found so far..
67
68					# search for sequences starting with each word in turn..
69	1	200ns			foreach my $sw (@words)
70					{
71	70	125µs	70	14.7s	findseq( $sw, {}, () ); # spent 14.7s making 70 calls to main::findseq, avg 210ms/call
72					}
73
74	1	200ns			my $longest = @longseq;
75
76	1	23µs	1	16µs	print "\nlongest sequence is length $longest: @longseq\n"; # spent 16µs making 1 call to main::CORE:print
77	1	100ns			exit 0;
78
79
80					#
81					# findseq( $currw, $used, @seq );
82					# Find all sequences of words from $currw onwards,
83					# given that we've already visited words in @seq,
84					# (the same info, as a set, is in %$used)
85					# and update the global @longseq if any sequences
86					# we find are longer than that.
87					#
88					# spent 14.7s within main::findseq which was called 5016078 times, avg 3µs/call: # 5016008 times (14.7s+-14.7s) by main::findseq at line 102, avg 0s/call # 70 times (236µs+14.7s) by main::RUNTIME at line 71, avg 210ms/call fun findseq( $currw, $used, @seq )
89	10032156	2.80s			{
90	5016078	440ms			push @seq, $currw; # extend @seq sequence
91
92	5016078	534ms			$used->{$currw}++; # update $used set
93
94	5016078	601ms			my $lastletter = $lw{$currw}; # find the last letter of currw
95
96	5016078	486ms			my $nextw = $sw{$lastletter}; # all words starting with lastletter
97	5016078	698ms			if( defined $nextw ) # if there are any, try each word
98					{
99					foreach my $nextword (@$nextw)
100					{
101					findseq( $nextword, $used, @seq )
102	7864514	2.64s	5016008	0s	unless $used->{$nextword}; # spent 200s making 5016008 calls to main::findseq, avg 40µs/call, recursion: max depth 22, sum of overlapping time 200s
103					}
104					} else # @seq is finished
105					{
106					#print "found sequence @seq\n";
107	1346584	99.6ms			my $len = @seq;
108	1346584	105ms			if( $len > @longseq )
109					{
110	16	800ns			print "longest seq so far (len $len): @seq\n" if $debug;
111	16	15µs			@longseq = @seq;
112					}
113					}
114	5016078	6.29s			delete $used->{$currw};
115	1	39µs	1	4µs	} # spent 4µ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 26µs within main::CORE:match which was called 140 times, avg 184ns/call: # 70 times (13µs+0s) by main::RUNTIME at line 54, avg 186ns/call # 70 times (13µs+0s) by main::RUNTIME at line 59, avg 181ns/call sub main::CORE:match; # opcode
					# spent 16µs within main::CORE:print which was called: # once (16µs+0s) by main::RUNTIME at line 76 sub main::CORE:print; # opcode