File Coverage

blib/lib/AI/Pathfinding/OptimizeMultiple/App/CmdLine.pm
Criterion Covered Total %
statement 24 207 11.5
branch 0 38 0.0
condition n/a
subroutine 8 46 17.3
pod 3 3 100.0
total 35 294 11.9


line stmt bran cond sub pod time code
1             package AI::Pathfinding::OptimizeMultiple::App::CmdLine;
2             $AI::Pathfinding::OptimizeMultiple::App::CmdLine::VERSION = '0.0.15';
3 1     1   14132 use strict;
  1         3  
  1         27  
4 1     1   5 use warnings;
  1         2  
  1         25  
5              
6 1     1   325 use MooX qw/late/;
  1         9491  
  1         5  
7              
8 1     1   28999 use Getopt::Long qw(GetOptionsFromArray);
  1         7979  
  1         5  
9 1     1   626 use IO::File;
  1         6366  
  1         118  
10              
11 1     1   444 use AI::Pathfinding::OptimizeMultiple;
  1         4  
  1         37  
12 1     1   437 use AI::Pathfinding::OptimizeMultiple::PostProcessor;
  1         3  
  1         28  
13              
14             # TODO : restore later.
15             # use MyInput;
16              
17 1     1   7 use Carp ();
  1         2  
  1         1912  
18              
19             has argv => (isa => 'ArrayRef[Str]', is => 'ro', required => 1,);
20             has _arbitrator => (is => 'rw');
21             has _add_horne_prune => (isa => 'Bool', is => 'rw');
22             has _chosen_scans => (isa => 'ArrayRef', is => 'rw');
23             has _should_exit_immediately => (isa => 'Bool', is => 'rw', default => sub { 0; },);
24             has input_obj_class => (isa => 'Str', is => 'rw');
25             has _input_obj => (is => 'rw');
26             has _is_flares => (is => 'rw', isa => 'Bool', default => sub { 0; },);
27             has _num_boards => (isa => 'Int', is => 'rw');
28             has _offset_quotas => (isa => 'Int', is => 'rw');
29             has _optimize_for => (isa => 'Str', is => 'rw');
30             has _output_filename => (isa => 'Str', is => 'rw');
31             has _post_processor => (isa => 'Maybe[AI::Pathfinding::OptimizeMultiple::PostProcessor]', is => 'rw');
32             has _quotas_are_cb => (isa => 'Bool', is => 'rw');
33             has _quotas_expr => (isa => 'Maybe[Str]', is => 'rw');
34             has _should_rle_be_done => (isa => 'Bool', is => 'rw');
35             has _should_trace_be_done => (isa => 'Bool', is => 'rw');
36             has _simulate_to => (isa => 'Maybe[Str]', is => 'rw');
37             has _start_board => (isa => 'Int', is => 'rw');
38             has _stats_factors => (isa => 'HashRef', is => 'rw', default => sub { return +{}; },);
39              
40             my $_component_re = qr/[A-Za-z][A-Za-z0-9_]*/;
41             my $_module_re = qr/$_component_re(?:::$_component_re)*/;
42              
43             sub BUILD
44             {
45 0     0 1   my $self = shift;
46              
47             # Command line parameters
48 0           my $_start_board = 1;
49 0           my $num_boards = 32000;
50 0           my $output_filename = "-";
51 0           my $should_trace_be_done = 0;
52 0           my $should_rle_be_done = 1;
53 0           my $_quotas_expr = undef;
54 0           my $quotas_are_cb = 0;
55 0           my $optimize_for = "speed";
56 0           my $offset_quotas = 0;
57 0           my $simulate_to = undef;
58 0           my $_add_horne_prune = 0;
59 0           my $input_obj_class = 'AI::Pathfinding::OptimizeMultiple::DataInputObj';
60 0           my %stats_factors;
61              
62 0           my $help = 0;
63 0           my $man = 0;
64 0 0         GetOptionsFromArray(
65             $self->argv(),
66             'help|h' => \$help,
67             man => \$man,
68             "o|output=s" => \$output_filename,
69             "num-boards=i" => \$num_boards,
70             "trace" => \$should_trace_be_done,
71             "rle!" => \$should_rle_be_done,
72             "start-board=i" => \$_start_board,
73             "quotas-expr=s" => \$_quotas_expr,
74             "quotas-are-cb" => \$quotas_are_cb,
75             "offset-quotas" => \$offset_quotas,
76             "opt-for=s" => \$optimize_for,
77             "simulate-to=s" => \$simulate_to,
78             "sprtf" => \$_add_horne_prune,
79             "input-class=s" => \$input_obj_class,
80             "stats-factors=f" => \%stats_factors,
81             ) or die "Extracting options from ARGV array failed - $!";
82              
83              
84 0 0         if ($help)
85             {
86 0           $self->_should_exit_immediately(1);
87 0           print <<"EOF";
88             $0 - optimize a game AI multi-tasking configuration
89              
90             --help | -h - displays this help screen
91             --output=[filename] | -o [filename] - output to this file instead of STDOUT.
92             EOF
93 0           return;
94             }
95              
96 0           $self->_start_board($_start_board);
97 0           $self->_num_boards($num_boards);
98 0           $self->_output_filename($output_filename);
99 0           $self->_should_trace_be_done($should_trace_be_done);
100 0           $self->_should_rle_be_done($should_rle_be_done);
101 0           $self->_quotas_expr($_quotas_expr);
102 0           $self->_quotas_are_cb($quotas_are_cb);
103 0           $self->_optimize_for($optimize_for);
104 0           $self->_offset_quotas($offset_quotas);
105 0           $self->_simulate_to($simulate_to);
106 0           $self->_add_horne_prune($_add_horne_prune);
107 0           $self->_stats_factors(\%stats_factors);
108 0           $self->input_obj_class($input_obj_class);
109              
110             {
111 0           my $class = $self->input_obj_class();
  0            
112 0 0         if ($class !~ m{\A$_module_re\z})
113             {
114 0           Carp::confess(
115             "Input object class does not seem like a good class:"
116             . $self->input_obj_class()
117             );
118             }
119 0           eval "require $class;";
120 0 0         if ($@)
121             {
122 0           die "Could not load '$class' - <<$@>>";
123             }
124              
125             # TODO : Restore later.
126             $self->_input_obj(
127 0           $class->new(
128             {
129             start_board => $self->_start_board(),
130             num_boards => $self->_num_boards(),
131             }
132             )
133             );
134             }
135              
136             $self->_post_processor(
137 0           AI::Pathfinding::OptimizeMultiple::PostProcessor->new(
138             {
139             do_rle => $self->_should_rle_be_done(),
140             offset_quotas => $self->_offset_quotas(),
141             }
142             )
143             );
144              
145 0           return;
146             }
147              
148             sub _selected_scans
149             {
150 0     0     my $self = shift;
151              
152 0           return $self->_input_obj->selected_scans();
153             }
154              
155             sub _map_all_but_last
156             {
157 0     0     my $self = shift;
158              
159 0           my ($cb, $arr_ref) = (@_);
160              
161 0           return [ (map {$cb->($_)} @$arr_ref[0 .. $#$arr_ref-1]), $arr_ref->[-1] ];
  0            
162             }
163              
164             sub _get_quotas
165             {
166 0     0     my $self = shift;
167 0 0         if ($self->_quotas_are_cb())
    0          
168             {
169 0           return scalar(eval($self->_quotas_expr()));
170             }
171             elsif (defined($self->_quotas_expr()))
172             {
173 0           return [eval $self->_quotas_expr()];
174             }
175             else
176             {
177 0           return $self->_get_default_quotas();
178             }
179             }
180              
181             sub _get_default_quotas
182             {
183 0     0     return [(350) x 5000];
184             }
185              
186             sub _get_script_fh
187             {
188 0     0     my $self = shift;
189 0 0         return IO::File->new(
190             ($self->_output_filename() eq "-") ?
191             ">&STDOUT" :
192             ($self->_output_filename(), "w")
193             );
194             }
195              
196             sub _get_script_terminator
197             {
198 0     0     return "\n\n\n";
199             }
200              
201             sub _out_script
202             {
203 0     0     my $self = shift;
204 0           my $cmd_line_string = shift;
205              
206 0           $self->_get_script_fh()->print(
207             $cmd_line_string,
208             $self->_get_script_terminator($cmd_line_string)
209             );
210             }
211              
212             sub _get_line_of_command
213             {
214 0     0     my $self = shift;
215              
216 0           my $args_string =
217             join(" ",
218             $self->_start_board(),
219             $self->_start_board() + $self->_num_boards() - 1,
220             1
221             );
222 0           return "freecell-solver-range-parallel-solve $args_string";
223             }
224              
225             sub _line_ends_mapping
226             {
227 0     0     my $self = shift;
228 0     0     return $self->_map_all_but_last(sub { "$_[0] \\\n" }, shift);
  0            
229             }
230              
231             sub _get_used_scans
232             {
233 0     0     my $self = shift;
234 0           return [ grep { $_->is_used() } @{$self->_selected_scans()}];
  0            
  0            
235             }
236              
237             sub _get_scan_line
238             {
239 0     0     my ($self, $line) = @_;
240              
241             return $line->{'cmd_line'} . " -step 500 "
242 0 0         . join(" ", map { $_, $line->{'id'} }
  0            
243             ("--st-name", ($self->_is_flares() ? "--flare-name" : ()))
244             );
245             }
246              
247             sub _get_lines_of_scan_defs
248             {
249 0     0     my $self = shift;
250             return
251             [map
252 0           { $self->_get_scan_line($_) }
253 0           @{$self->_get_used_scans()}
  0            
254             ];
255             }
256              
257             sub _scan_def_line_mapping
258             {
259 0     0     my ($self, $lines_aref) = @_;
260              
261             return $self->_map_all_but_last(
262             sub
263             {
264 0     0     my ($line) = @_;
265              
266 0 0         return $line . ' ' . ($self->_is_flares() ? "-nf" : "-nst");
267             },
268             [
269             map
270             {
271 0           my $line = $_;
  0            
272             # Add the -sp r:tf flag to each scan if specified - it enhances
273             # performance, but timing the scans with it makes the total
274             # scan sub-optimal.
275 0 0         if ($self->_add_horne_prune())
276             {
277 0           $line =~ s/( --st-name)/ -sp r:tf$1/;
278             }
279 0           $line;
280             }
281             @$lines_aref
282             ],
283             );
284             }
285              
286             sub _calc_iter_quota
287             {
288 0     0     my $self = shift;
289 0           my $quota = shift;
290              
291 0 0         if ($self->_offset_quotas())
292             {
293 0           return $quota+1;
294             }
295             else
296             {
297 0           return $quota;
298             }
299             }
300              
301             sub _map_scan_idx_to_id
302             {
303 0     0     my $self = shift;
304 0           my $index = shift;
305              
306 0           return $self->_selected_scans()->[$index]->id();
307             }
308              
309             sub _format_prelude_iter
310             {
311 0     0     my $self = shift;
312              
313 0           my $iter = shift;
314              
315 0 0         return ($self->_is_flares() ? "Run:" : "") . $iter->iters() . '@'
316             . $self->_map_scan_idx_to_id($iter->scan_idx())
317             ;
318             }
319              
320             sub _get_line_of_prelude
321             {
322 0     0     my $self = shift;
323             return +($self->_is_flares() ? "--flares-plan" : "--prelude") . qq{ "} .
324             join(",",
325 0           map { $self->_format_prelude_iter($_) }
326 0 0         @{$self->_chosen_scans()}
  0            
327             ) . "\"";
328             }
329              
330             sub _calc_script_lines
331             {
332 0     0     my $self = shift;
333             return
334             [
335             $self->_get_line_of_command(),
336 0           @{$self->_scan_def_line_mapping(
  0            
337             $self->_get_lines_of_scan_defs()
338             )},
339             $self->_get_line_of_prelude()
340             ];
341             }
342              
343             sub _calc_script_text
344             {
345 0     0     my $self = shift;
346             return
347             join("",
348 0           @{$self->_line_ends_mapping(
  0            
349             $self->_calc_script_lines()
350             )}
351             );
352             }
353              
354             sub _write_script
355             {
356 0     0     my $self = shift;
357              
358 0           $self->_out_script(
359             $self->_calc_script_text()
360             );
361             }
362              
363             sub _calc_scans_iters_pdls
364             {
365 0     0     my $self = shift;
366              
367 0 0         my $method =
368             (($self->_optimize_for() =~ m{len})
369             ? "get_scans_lens_iters_pdls"
370             : "get_scans_iters_pdls"
371             );
372              
373 0           return $self->_input_obj->$method();
374             }
375              
376             sub _arbitrator_trace_cb
377             {
378 0     0     my $args = shift;
379             printf("%s \@ %s (%s solved)\n",
380 0           @$args{qw(iters_quota selected_scan_idx total_boards_solved)}
381             );
382             }
383              
384             sub _init_arbitrator
385             {
386 0     0     my $self = shift;
387              
388             return $self->_arbitrator(
389             AI::Pathfinding::OptimizeMultiple->new(
390             {
391             'scans' =>
392             [
393 0           map { +{ name => $_->id() } }
394 0           @{$self->_input_obj->_suitable_scans_list()},
  0            
395             ],
396             'quotas' => $self->_get_quotas(),
397             'selected_scans' => $self->_selected_scans(),
398             'num_boards' => $self->_num_boards(),
399             'scans_iters_pdls' => $self->_calc_scans_iters_pdls(),
400             'trace_cb' => \&_arbitrator_trace_cb,
401             'optimize_for' => $self->_optimize_for(),
402             'stats_factors' => $self->_stats_factors(),
403             }
404             )
405             );
406             }
407              
408             sub _report_total_iters
409             {
410 0     0     my $self = shift;
411 0 0         if ($self->_arbitrator()->get_final_status() eq "solved_all")
412             {
413 0           print "Solved all!\n";
414             }
415 0           printf("total_iters = %s\n", $self->_arbitrator()->get_total_iters());
416             }
417              
418             sub _arbitrator_process
419             {
420 0     0     my $self = shift;
421              
422 0           $self->_arbitrator()->calc_meta_scan();
423              
424 0           my $scans = $self->_post_processor->process(
425             $self->_arbitrator->chosen_scans()
426             );
427              
428 0           $self->_chosen_scans($scans);
429             }
430              
431             sub _do_trace_for_board
432             {
433 0     0     my $self = shift;
434 0           my $board = shift;
435              
436 0           my $results = $self->_arbitrator()->calc_board_iters($board);
437 0           print "\@info=". join(",", @{$results->{per_scan_iters}}). "\n";
  0            
438 0           print +($board+$self->_start_board()) . ": ". $results->{board_iters} . "\n";
439             }
440              
441             sub _real_do_trace
442             {
443 0     0     my $self = shift;
444 0           foreach my $board (0 .. $self->_num_boards()-1)
445             {
446 0           $self->_do_trace_for_board($board);
447             }
448             }
449              
450             sub _do_trace
451             {
452 0     0     my $self = shift;
453             # Analyze the results
454              
455 0 0         if ($self->_should_trace_be_done())
456             {
457 0           $self->_real_do_trace();
458             }
459             }
460              
461             sub _get_run_string
462             {
463 0     0     my $self = shift;
464 0           my $results = shift;
465              
466             return join("",
467             map
468             {
469 0           sprintf('%i@%i,',
470             $_->iters(),
471             $self->_map_scan_idx_to_id($_->scan_idx())
472             )
473             }
474 0           @{$self->_post_processor->process($results->scan_runs())},
  0            
475             );
476             }
477              
478             sub _do_simulation_for_board
479             {
480 0     0     my ($self, $board) = @_;
481              
482 0           my $results = $self->_arbitrator()->simulate_board($board);
483              
484             my $scan_mapper = sub {
485 0     0     my $index = shift;
486              
487 0           return $self->_map_scan_idx_to_id($index);
488 0           };
489              
490             return
491 0           sprintf("%i:%s:%s:%i",
492             $board+1,
493             $results->get_status(),
494             $self->_get_run_string($results),
495             $results->get_total_iters(),
496             );
497             }
498              
499             sub _real_do_simulation
500             {
501 0     0     my $self = shift;
502              
503 0 0         open my $simulate_out_fh, ">", $self->_simulate_to()
504             or Carp::confess("Could not open " . $self->_simulate_to() . " - $!");
505              
506 0           foreach my $board (0 .. $self->_num_boards()-1)
507             {
508 0           print {$simulate_out_fh} $self->_do_simulation_for_board($board), "\n";
  0            
509             }
510              
511 0           close($simulate_out_fh);
512              
513 0           return;
514             }
515              
516              
517             sub _do_simulation
518             {
519 0     0     my $self = shift;
520             # Analyze the results
521              
522 0 0         if (defined($self->_simulate_to()))
523             {
524 0           $self->_real_do_simulation();
525             }
526              
527 0           return;
528             }
529              
530              
531             sub run
532             {
533 0     0 1   my $self = shift;
534              
535 0 0         if ($self->_should_exit_immediately())
536             {
537 0           return 0;
538             }
539              
540 0           $self->_init_arbitrator();
541 0           $self->_arbitrator_process();
542 0           $self->_report_total_iters();
543 0           $self->_write_script();
544 0           $self->_do_trace();
545 0           $self->_do_simulation();
546              
547 0           return 0;
548             }
549              
550              
551             sub run_flares
552             {
553 0     0 1   my $self = shift;
554              
555 0           $self->_optimize_for("len");
556 0           $self->_is_flares(1);
557              
558 0           $self->_init_arbitrator();
559              
560 0           $self->_arbitrator()->calc_flares_meta_scan();
561              
562 0           my $scans = $self->_post_processor->process(
563             $self->_arbitrator->chosen_scans()
564             );
565              
566 0           $self->_chosen_scans($scans);
567 0           $self->_report_total_iters();
568 0           $self->_write_script();
569 0           $self->_do_trace();
570 0           $self->_do_simulation();
571              
572 0           return 0;
573             }
574              
575              
576             1;
577              
578             __END__