Profile of NewIncNPlyPicker.pm

Filename	/homes/dcw/src/perl/coloroids_solver/NewIncNPlyPicker.pm
Statements	Executed 94925 statements in 5.26s

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
56	1	1	348ms	348ms	main::::incnply_makenm1plymain::incnply_makenm1ply
56	1	1	102ms	57.0s	main::::list_all_nplymain::list_all_nply
1179	3	1	80.9ms	56.9s	main::::fulllist_all_nplymain::fulllist_all_nply (recurses: max depth 2, inclusive time 297ms)
240	12	3	8.33ms	8.33ms	main::::CORE:printmain::CORE:print (opcode)
56	1	1	4.68ms	57.1s	main::::incnply_pick_bestmain::incnply_pick_best
1231	3	1	2.21ms	2.21ms	main::::CORE:sortmain::CORE:sort (opcode)
1	1	1	15µs	15µs	main::::BEGIN@13.5main::BEGIN@13.5
1	1	1	7µs	126µs	main::::BEGIN@14main::BEGIN@14
1	1	1	5µs	19µs	main::::BEGIN@19main::BEGIN@19
1	1	1	5µs	21µs	main::::BEGIN@15main::BEGIN@15
1	1	1	5µs	30µs	main::::BEGIN@13.6main::BEGIN@13.6
1	1	1	5µs	40µs	main::::BEGIN@17main::BEGIN@17
1	1	1	4µs	20µs	main::::BEGIN@18main::BEGIN@18
1	1	1	4µs	13µs	main::::BEGIN@22main::BEGIN@22
1	1	1	3µs	3µs	main::::BEGIN@20main::BEGIN@20
1	1	1	2µs	2µs	main::::set_nplymain::set_nply
0	0	0	0s	0s	main::::RUNTIMEmain::RUNTIME

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					#
2					# Incremental NPly Picker module using the NewBoard:
3					# 4th cut at solving coloroid:
4					# pick the best of all the N-ply deep move sequences,
5					# without recalculating them all every move. do a complete
6					# N-ply search for the first move, then whenever we make a
7					# move, discard all the nply movesequences that don't start
8					# with that colour, and build a new n-1ply hash without the
9					# leading colour (the one we played), and then extend that to
10					# no more than N-ply by (usually) a load of 1-ply searches.
11					#
12
13	4	52µs	3	71µs	# spent 15µs within main::BEGIN@13.5 which was called: # once (15µs+0s) by main::BEGIN@13 at line 13 # spent 30µs (5+25) within main::BEGIN@13.6 which was called: # once (5µs+25µs) by main::BEGIN@13 at line 13 use v5.12; # spent 30µs making 1 call to main::BEGIN@13.6 # spent 25µs making 1 call to feature::import # spent 15µs making 1 call to main::BEGIN@13.5
14	2	22µs	2	245µs	# spent 126µs (7+119) within main::BEGIN@14 which was called: # once (7µs+119µs) by main::BEGIN@13 at line 14 use Function::Parameters; # spent 126µs making 1 call to main::BEGIN@14 # spent 119µs making 1 call to Function::Parameters::import
15	2	20µs	2	38µs	# spent 21µs (5+16) within main::BEGIN@15 which was called: # once (5µs+16µs) by main::BEGIN@13 at line 15 use Data::Dumper; # spent 21µs making 1 call to main::BEGIN@15 # spent 16µs making 1 call to Exporter::import
16
17	2	19µs	2	74µs	# spent 40µs (5+35) within main::BEGIN@17 which was called: # once (5µs+35µs) by main::BEGIN@13 at line 17 use lib qw(/homes/dcw/lib/perl5/DCW); # spent 40µs making 1 call to main::BEGIN@17 # spent 35µs making 1 call to lib::import
18	2	18µs	2	36µs	# spent 20µs (4+16) within main::BEGIN@18 which was called: # once (4µs+16µs) by main::BEGIN@13 at line 18 use Tuple qw(tuple); # spent 20µs making 1 call to main::BEGIN@18 # spent 16µs making 1 call to Exporter::import
19	2	16µs	2	33µs	# spent 19µs (5+14) within main::BEGIN@19 which was called: # once (5µs+14µs) by main::BEGIN@13 at line 19 use List qw(list); # spent 19µs making 1 call to main::BEGIN@19 # spent 14µs making 1 call to Exporter::import
20	2	14µs	1	3µs	# spent 3µs within main::BEGIN@20 which was called: # once (3µs+0s) by main::BEGIN@13 at line 20 use Sorthash; # spent 3µs making 1 call to main::BEGIN@20
21
22	2	898µs	2	22µs	# spent 13µs (4+9) within main::BEGIN@22 which was called: # once (4µs+9µs) by main::BEGIN@13 at line 22 use NewBoard; # spent 13µs making 1 call to main::BEGIN@22 # spent 9µs making 1 call to Exporter::import
23
24
25	1	8µs			my $nply = 1; # number of ply to search
26	1	200ns			my $verbose = 0; # values 0: pretty silent about n-ply
27					# 1: show basic debugging info
28					# 2: all the trimmings eg every board
29
30
31					#
32					# set_nply( $n );
33					# Set our nply variable to n.
34					# Print message.
35					#
36					# spent 2µs within main::set_nply which was called: # once (2µs+0s) by main::RUNTIME at line 42 of testnewboardincnply fun set_nply( $n )
37	2	3µs			{
38					$nply = $n;
39					#print "set nply to $n\n";
40					}
41
42
43	1	100ns			my %nply; # n-ply tree: movesequence->tuple(regionsize, board)
44	1	0s			my %nm1ply; # n-1 ply tree passed between moves
45	1	0s			my $bestn; # the best region size seen so far
46	1	0s			my $moveno; # the current move number
47	1	0s			my $boardsize; # the no of cells on the whole board (doesn't change)
48
49
50					#
51					# fulllist_all_nply( $board, $n, $prefix );
52					# generate all up to $n-ply (n>0) move sequences (each leading
53					# to a modified board) generated from $board by valid moves
54					# ($board was achieved by the move sequence $prefix).
55					# Update globals $bestn (the best region score) and
56					# %nply (a hash of movesequence -> (goodness,board)
57					# results) for all move sequences of depth $n>=1.
58					# note that if there's only one adjacent colour, we stop
59					# recursing cos however good later moves are, we still
60					# have no choice what first move to make!
61					#
62					# spent 56.9s (80.9ms+56.9) within main::fulllist_all_nply which was called 1179 times, avg 48.3ms/call: # 1171 times (80.1ms+56.7s) by main::list_all_nply at line 174, avg 48.5ms/call # 7 times (645µs+-645µs) by main::fulllist_all_nply at line 114, avg 0s/call # once (122µs+185ms) by main::list_all_nply at line 147 fun fulllist_all_nply( $board, $n, $prefix )
63	10599	12.4ms			{
64					die "list_all_nply: $n < 1\n" if $n < 1;
65			1179	3.06ms	my $currcolour = $board->cell( 0, 0 ); # current region colour # spent 3.06ms making 1179 calls to NewBoard::cell, avg 3µs/call
66					print "list_all_nply(n=$n, prefix=$prefix): currcolour=$currcolour, board=\n$board\n" if $verbose>0;
67					# find the existing region info
68			1179	1.50ms	my( $nregion, $adjcolbag ) = $board->region; # spent 1.50ms making 1179 calls to NewBoard::region, avg 1µs/call
69					# if there's only one, return.
70					my $nadjcolours = keys %$adjcolbag;
71	60	5.24ms			if( $nadjcolours == 1 )
72					{
73					my( $col, $value ) = each %$adjcolbag;
74					my $newprefix = "$prefix$col";
75					# copy board and modify that.
76			6	5.18ms	my $copy = $board->clone; # spent 5.18ms making 6 calls to Clone::clone, avg 863µs/call
77			6	40.8ms	$copy->changeregioncolour( $col ); # spent 40.8ms making 6 calls to NewBoard::changeregioncolour, avg 6.80ms/call
78			6	21.4ms	$copy->extendregion; # spent 21.4ms making 6 calls to NewBoard::extendregion, avg 3.57ms/call
79			6	8µs	my( $newn, $adjcolbag ) = $copy->region; # spent 8µs making 6 calls to NewBoard::region, avg 1µs/call
80			6	24µs	$nply{$newprefix} = tuple( $newn, $copy ); # spent 24µs making 6 calls to Tuple::tuple, avg 4µs/call
81					$bestn = $newn if $newn > $bestn;
82					#print $verbose ?
83					# "list_all_nply(n=$n, prefix=$prefix)" :
84					# "(prefix $prefix)";
85					#print ": single adj col $col, freq $value, result $newprefix = $newn\n";
86					print "list_all_nply(n=$n, prefix=$prefix): single adj col $col, freq $value, result $newprefix = $newn\n" if $verbose;
87					return;
88					}
89					print "list_all_nply(n=$n, prefix=$prefix): adjcolbag = $adjcolbag\n" if $verbose>0;
90			1173	2.03ms	foreach my $col (sort keys %$adjcolbag) # spent 2.03ms making 1173 calls to main::CORE:sort, avg 2µs/call
91					{
92	55220	4.76s			print "list_all_nply(n=$n, prefix=$prefix): trying colour $col" if $verbose>0;
93					print " with board=\n$board" if $verbose > 1;
94					print "\n" if $verbose > 0;
95					# copy board and modify that.
96			5522	4.72s	my $copy = $board->clone; # spent 4.72s making 5522 calls to Clone::clone, avg 855µs/call
97			5522	27.2s	$copy->changeregioncolour( $col ); # spent 27.2s making 5522 calls to NewBoard::changeregioncolour, avg 4.93ms/call
98			5522	24.8s	$copy->extendregion; # spent 24.8s making 5522 calls to NewBoard::extendregion, avg 4.50ms/call
99					my $newprefix = "$prefix$col";
100					print "list_all_nply(n=$n, prefix=$prefix): set newprefix = $newprefix, board=\n$copy\n" if $verbose>1;
101			5522	8.18ms	my $solved = $copy->solved; # spent 8.18ms making 5522 calls to NewBoard::solved, avg 1µs/call
102	22088	18.1ms			if( $n == 1 \|\| $solved )
103					{
104			5515	6.60ms	my( $nregion, $adjcolbag ) = $copy->region; # spent 6.60ms making 5515 calls to NewBoard::region, avg 1µs/call
105			5515	21.8ms	$nply{$newprefix} = tuple( $nregion, $copy ); # spent 21.8ms making 5515 calls to Tuple::tuple, avg 4µs/call
106					$bestn = $nregion if $nregion > $bestn;
107					#print "list_all_nply(n=$n, prefix=$prefix): " if $verbose;
108					#print "result $newprefix = $nregion, bestn = $bestn\n";
109					print "list_all_nply(n=$n, prefix=$prefix): result $newprefix = $nregion, bestn = $bestn\n" if $verbose;
110					} else
111					{
112					my $nm1 = $n-1;
113					print "list_all_nply(n=$n, prefix=$prefix): recursing to list_all_nply($nm1, $newprefix )\n" if $verbose>1;
114			7	0s	fulllist_all_nply( $copy, $nm1, $newprefix ); # spent 297ms making 7 calls to main::fulllist_all_nply, avg 42.5ms/call, recursion: max depth 2, sum of overlapping time 297ms
115					print "list_all_nply(n=$n, prefix=$prefix): returning from recursion ".
116					"to list_all_nply($nm1, $newprefix )\n" if $verbose>1;
117					}
118					}
119					}
120
121
122					#
123					# list_all_nply( $board, $n );
124					# incremental nply driver:
125					# generate (or extend) all n-ply move sequences and evaluate
126					# how good they are. Updates globals $bestn (the best region
127					# score of all the n-ply movesequences) and %nply (a hash of
128					# movesequence -> (goodness,board) results).
129					#
130					# on the first move, use fulllist_all_nply() to generate
131					# the full $n-ply search tree and bestn.
132					# after each move (first or nth), the postmove callback
133					# generates %nm1ply from %nply (containing only moveseqs
134					# that are still possible after the first move played,
135					# and removes the first move from all possible moveseqs).
136					# on subsequent moves, we extend those n-1 ply move sequences
137					# stored in %nm1ply to be new n ply move sequences in %nply
138					# (usually we only need to extend by 1-ply) and recalculate
139					# $bestno as we go.
140					#
141					# spent 57.0s (102ms+56.9) within main::list_all_nply which was called 56 times, avg 1.02s/call: # 56 times (102ms+56.9s) by main::incnply_pick_best at line 196, avg 1.02s/call fun list_all_nply( $board, $n, $prefix )
142	440	96.6ms			{
143					die "list_all_nply: $n < 1\n" if $n < 1;
144					%nply = ();
145	2	4µs			if( $moveno == 1 )
146					{
147			1	185ms	fulllist_all_nply( $board, $n, "" ); # spent 185ms making 1 call to main::fulllist_all_nply
148					return;
149					}
150					# subsequent move: unless we've already reached the solution?
151			6	36µs	print "debug: move $moveno, bestn=$bestn, boardsize=$boardsize\n" if $moveno > 50; # spent 36µs making 6 calls to main::CORE:print, avg 6µs/call
152	14	109µs			if( $bestn == $boardsize )
153					{
154			2	13µs	print "debug: move $moveno, bestn==boardsize case\n"; # spent 13µs making 2 calls to main::CORE:print, avg 6µs/call
155					# extract all move seqs from nm1ply that are solutions
156					my @x = grep { $nm1ply{$_}->[0] == $boardsize } keys %nm1ply;
157			2	9µs	print "debug: x=\n"; # spent 9µs making 2 calls to main::CORE:print, avg 4µs/call
158			4	163µs	print Dumper \@x; # spent 127µs making 2 calls to Data::Dumper::Dumper, avg 63µs/call # spent 36µs making 2 calls to main::CORE:print, avg 18µs/call
159					%nply = map { $_ => $nm1ply{$_} }
160			2	4µs	sort { length($a) <=> length($b) \|\| $a cmp $b } # spent 4µs making 2 calls to main::CORE:sort, avg 2µs/call
161					@x;
162					%nm1ply = (); # no longer needed
163					#print "debug: nply=\n";
164					#print Dumper \%nply;
165					return;
166					}
167					# extend each n-1 ply result to n ply via lots of 1-ply searches..
168	5855	4.37ms			while( my( $moveseq, $value ) = each %nm1ply )
169					{
170			1171	2.74ms	my( $regionsize, $afterboard ) = $value->detuple; # spent 2.74ms making 1171 calls to Tuple::detuple, avg 2µs/call
171					my $smalln = length($moveseq);
172					my $diff = $n-$smalln;
173					die "logic error: smalln=$smalln, n=$n, diff=$diff, moveseq=$moveseq, move=$moveno\n" unless $diff == 1;
174			1171	56.8s	fulllist_all_nply( $afterboard, 1, $moveseq ); # spent 56.8s making 1171 calls to main::fulllist_all_nply, avg 48.5ms/call
175					}
176					%nm1ply = (); # no longer needed, will be rebuilt by postmove
177	1	0s			}
178
179
180					#
181					# my @playcolour = incnply_pick_best( $movenumber, $adjcolbag, $board );
182					# my $playcolour = incnply_pick_best( $movenumber, $adjcolbag, $board );
183					# Calculate (or refresh) %nply, a mapping from movesequence to
184					# (region size, board) tuples, then pick the best colour or colours
185					# to play next. return EITHER an array of one or more "best" colours
186					# to play, or (in a scalar context) one of those best moves.
187					#
188					# spent 57.1s (4.68ms+57.0) within main::incnply_pick_best which was called 56 times, avg 1.02s/call: # 56 times (4.68ms+57.0s) by main::solve_game at line 35 of NewSolveGame.pm, avg 1.02s/call fun incnply_pick_best( $movenumber, $adjcolbag, $board )
189	448	6.00ms			{
190	2	1µs			if( $movenumber == 1 )
191					{
192			1	1µs	$boardsize = $board->boardsize; # spent 1µs making 1 call to NewBoard::boardsize
193					$bestn = -1; # initial bestn is bad
194					}
195					$moveno = $movenumber;
196			56	57.0s	list_all_nply( $board, $nply ); # spent 57.0s making 56 calls to main::list_all_nply, avg 1.02s/call
197
198					my @bestcolours =
199					map { substr($_,0,1) }
200					sort { length($a) <=> length($b) \|\| $a cmp $b }
201			56	178µs	grep { $nply{$_}->[0] == $bestn } keys %nply; # spent 178µs making 56 calls to main::CORE:sort, avg 3µs/call
202					#print Dumper \@bestcolours;
203					if( wantarray )
204					{
205					my %seen;
206					# find distinct colours in original order
207					my @colours = grep { ! $seen{$_}++ } @bestcolours;
208					print " bestcolours = @colours, bestn = $bestn\n";
209					return @colours;
210					}
211
212					# return one of them
213			56	999µs	print " bestcolours = @bestcolours, bestn = $bestn\n"; # spent 999µs making 56 calls to main::CORE:print, avg 18µs/call
214					return $bestcolours[0];
215					}
216
217
218					#
219					# incnply_makenm1ply( $board, $playedcolour );
220					# Post move callback: the board is now $board,
221					# after $playedcolour has been played.
222					# here, we build a new n-1 ply hash (called %nm1ply)
223					# which only contains the possible n-1 ply movesequences
224					# (and their associated data, unaltered).
225					# Specifically, these are all which start with
226					# the $playedcolour, but with that $playedcolour
227					# (the first move in the moveseq) removed.
228					#
229					sub incnply_makenm1ply ($$)
230					# spent 348ms within main::incnply_makenm1ply which was called 56 times, avg 6.22ms/call: # 56 times (348ms+0s) by main::solve_game at line 39 of NewSolveGame.pm, avg 6.22ms/call {
231	168	349ms			my( $board, $playedcolour ) = @_;
232					%nm1ply = map { substr($_,1) => $nply{$_} }
233					grep { substr($_,0,1) eq $playedcolour }
234					keys %nply;
235					%nply = (); # no longer needed
236					}
237
238
239	1	4µs			1;

					# spent 8.33ms within main::CORE:print which was called 240 times, avg 35µs/call: # 56 times (6.46ms+0s) by main::solve_game at line 32 of NewSolveGame.pm, avg 115µs/call # 56 times (999µs+0s) by main::incnply_pick_best at line 213, avg 18µs/call # 56 times (389µs+0s) by main::solve_game at line 33 of NewSolveGame.pm, avg 7µs/call # 56 times (258µs+0s) by main::solve_game at line 36 of NewSolveGame.pm, avg 5µs/call # 6 times (36µs+0s) by main::list_all_nply at line 151, avg 6µs/call # 2 times (36µs+0s) by main::list_all_nply at line 158, avg 18µs/call # 2 times (13µs+0s) by main::list_all_nply at line 154, avg 6µs/call # 2 times (9µs+0s) by main::list_all_nply at line 157, avg 4µs/call # once (102µs+0s) by main::solve_game at line 43 of NewSolveGame.pm # once (19µs+0s) by main::RUNTIME at line 16 of testnewboardincnply # once (6µs+0s) by main::RUNTIME at line 46 of testnewboardincnply # once (5µs+0s) by main::solve_game at line 44 of NewSolveGame.pm sub main::CORE:print; # opcode
					# spent 2.21ms within main::CORE:sort which was called 1231 times, avg 2µs/call: # 1173 times (2.03ms+0s) by main::fulllist_all_nply at line 90, avg 2µs/call # 56 times (178µs+0s) by main::incnply_pick_best at line 201, avg 3µs/call # 2 times (4µs+0s) by main::list_all_nply at line 160, avg 2µs/call sub main::CORE:sort; # opcode