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.16';
3 1     1   69159 use strict;
  1         11  
  1         30  
4 1     1   37 use warnings;
  1         4  
  1         39  
5              
6 1     1   443 use MooX qw/late/;
  1         13387  
  1         7  
7              
8 1     1   176789 use Getopt::Long qw(GetOptionsFromArray);
  1         10799  
  1         5  
9 1     1   719 use IO::File ();
  1         8776  
  1         28  
10              
11 1     1   553 use AI::Pathfinding::OptimizeMultiple ();
  1         5  
  1         34  
12 1     1   548 use AI::Pathfinding::OptimizeMultiple::PostProcessor ();
  1         5  
  1         29  
13              
14             # TODO : restore later.
15             # use MyInput;
16              
17 1     1   8 use Carp ();
  1         2  
  1         3006  
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 =>
24             ( isa => 'Bool', is => 'rw', default => sub { 0; }, );
25             has input_obj_class => ( isa => 'Str', is => 'rw' );
26             has _input_obj => ( is => 'rw' );
27             has _is_flares => ( is => 'rw', isa => 'Bool', default => sub { 0; }, );
28             has _num_boards => ( isa => 'Int', is => 'rw' );
29             has _offset_quotas => ( isa => 'Int', is => 'rw' );
30             has _optimize_for => ( isa => 'Str', is => 'rw' );
31             has _output_filename => ( isa => 'Str', is => 'rw' );
32             has _post_processor => (
33             isa => 'Maybe[AI::Pathfinding::OptimizeMultiple::PostProcessor]',
34             is => 'rw'
35             );
36             has _quotas_are_cb => ( isa => 'Bool', is => 'rw' );
37             has _quotas_expr => ( isa => 'Maybe[Str]', is => 'rw' );
38             has _should_rle_be_done => ( isa => 'Bool', is => 'rw' );
39             has _should_trace_be_done => ( isa => 'Bool', is => 'rw' );
40             has _simulate_to => ( isa => 'Maybe[Str]', is => 'rw' );
41             has _start_board => ( isa => 'Int', is => 'rw' );
42             has _stats_factors =>
43             ( isa => 'HashRef', is => 'rw', default => sub { return +{}; }, );
44              
45             my $_component_re = qr/[A-Za-z][A-Za-z0-9_]*/;
46             my $_module_re = qr/$_component_re(?:::$_component_re)*/;
47              
48             sub BUILD
49             {
50 0     0 1   my $self = shift;
51              
52             # Command line parameters
53 0           my $_start_board = 1;
54 0           my $num_boards = 32000;
55 0           my $output_filename = "-";
56 0           my $should_trace_be_done = 0;
57 0           my $should_rle_be_done = 1;
58 0           my $_quotas_expr = undef;
59 0           my $quotas_are_cb = 0;
60 0           my $optimize_for = "speed";
61 0           my $offset_quotas = 0;
62 0           my $simulate_to = undef;
63 0           my $_add_horne_prune = 0;
64 0           my $input_obj_class = 'AI::Pathfinding::OptimizeMultiple::DataInputObj';
65 0           my %stats_factors;
66              
67 0           my $help = 0;
68 0           my $man = 0;
69 0 0         GetOptionsFromArray(
70             $self->argv(),
71             'help|h' => \$help,
72             man => \$man,
73             "o|output=s" => \$output_filename,
74             "num-boards=i" => \$num_boards,
75             "trace" => \$should_trace_be_done,
76             "rle!" => \$should_rle_be_done,
77             "start-board=i" => \$_start_board,
78             "quotas-expr=s" => \$_quotas_expr,
79             "quotas-are-cb" => \$quotas_are_cb,
80             "offset-quotas" => \$offset_quotas,
81             "opt-for=s" => \$optimize_for,
82             "simulate-to=s" => \$simulate_to,
83             "sprtf" => \$_add_horne_prune,
84             "input-class=s" => \$input_obj_class,
85             "stats-factors=f" => \%stats_factors,
86             ) or die "Extracting options from ARGV array failed - $!";
87              
88 0 0         if ($help)
89             {
90 0           $self->_should_exit_immediately(1);
91 0           print <<"EOF";
92             $0 - optimize a game AI multi-tasking configuration
93              
94             --help | -h - displays this help screen
95             --output=[filename] | -o [filename] - output to this file instead of STDOUT.
96             EOF
97 0           return;
98             }
99              
100 0           $self->_start_board($_start_board);
101 0           $self->_num_boards($num_boards);
102 0           $self->_output_filename($output_filename);
103 0           $self->_should_trace_be_done($should_trace_be_done);
104 0           $self->_should_rle_be_done($should_rle_be_done);
105 0           $self->_quotas_expr($_quotas_expr);
106 0           $self->_quotas_are_cb($quotas_are_cb);
107 0           $self->_optimize_for($optimize_for);
108 0           $self->_offset_quotas($offset_quotas);
109 0           $self->_simulate_to($simulate_to);
110 0           $self->_add_horne_prune($_add_horne_prune);
111 0           $self->_stats_factors( \%stats_factors );
112 0           $self->input_obj_class($input_obj_class);
113              
114             {
115 0           my $class = $self->input_obj_class();
  0            
116 0 0         if ( $class !~ m{\A$_module_re\z} )
117             {
118 0           Carp::confess(
119             "Input object class does not seem like a good class:"
120             . $self->input_obj_class() );
121             }
122 0           eval "require $class;";
123 0 0         if ($@)
124             {
125 0           die "Could not load '$class' - <<$@>>";
126             }
127              
128             # TODO : Restore later.
129             $self->_input_obj(
130 0           $class->new(
131             {
132             start_board => $self->_start_board(),
133             num_boards => $self->_num_boards(),
134             }
135             )
136             );
137             }
138              
139             $self->_post_processor(
140 0           AI::Pathfinding::OptimizeMultiple::PostProcessor->new(
141             {
142             do_rle => $self->_should_rle_be_done(),
143             offset_quotas => $self->_offset_quotas(),
144             }
145             )
146             );
147              
148 0           return;
149             }
150              
151             sub _selected_scans
152             {
153 0     0     my $self = shift;
154              
155 0           return $self->_input_obj->selected_scans();
156             }
157              
158             sub _map_all_but_last
159             {
160 0     0     my $self = shift;
161              
162 0           my ( $cb, $arr_ref ) = (@_);
163              
164             return [
165 0           ( map { $cb->($_) } @$arr_ref[ 0 .. $#$arr_ref - 1 ] ),
  0            
166             $arr_ref->[-1]
167             ];
168             }
169              
170             sub _get_quotas
171             {
172 0     0     my $self = shift;
173 0 0         if ( $self->_quotas_are_cb() )
    0          
174             {
175 0           return scalar( eval( $self->_quotas_expr() ) );
176             }
177             elsif ( defined( $self->_quotas_expr() ) )
178             {
179 0           return [ eval $self->_quotas_expr() ];
180             }
181             else
182             {
183 0           return $self->_get_default_quotas();
184             }
185             }
186              
187             sub _get_default_quotas
188             {
189 0     0     return [ (350) x 5000 ];
190             }
191              
192             sub _get_script_fh
193             {
194 0     0     my $self = shift;
195 0 0         return IO::File->new(
196             ( $self->_output_filename() eq "-" )
197             ? ">&STDOUT"
198             : ( $self->_output_filename(), "w" )
199             );
200             }
201              
202             sub _get_script_terminator
203             {
204 0     0     return "\n\n\n";
205             }
206              
207             sub _out_script
208             {
209 0     0     my $self = shift;
210 0           my $cmd_line_string = shift;
211              
212 0           $self->_get_script_fh()
213             ->print( $cmd_line_string,
214             $self->_get_script_terminator($cmd_line_string) );
215             }
216              
217             sub _get_line_of_command
218             {
219 0     0     my $self = shift;
220              
221 0           my $args_string = join( " ",
222             $self->_start_board(),
223             $self->_start_board() + $self->_num_boards() - 1, 1 );
224 0           return "freecell-solver-range-parallel-solve $args_string";
225             }
226              
227             sub _line_ends_mapping
228             {
229 0     0     my $self = shift;
230 0     0     return $self->_map_all_but_last( sub { "$_[0] \\\n" }, shift );
  0            
231             }
232              
233             sub _get_used_scans
234             {
235 0     0     my $self = shift;
236 0           return [ grep { $_->is_used() } @{ $self->_selected_scans() } ];
  0            
  0            
237             }
238              
239             sub _get_scan_line
240             {
241 0     0     my ( $self, $line ) = @_;
242              
243             return
244             $line->{'cmd_line'}
245             . " -step 500 "
246             . join( " ",
247 0 0         map { $_, $line->{'id'} }
  0            
248             ( "--st-name", ( $self->_is_flares() ? "--flare-name" : () ) ) );
249             }
250              
251             sub _get_lines_of_scan_defs
252             {
253 0     0     my $self = shift;
254 0           return [ map { $self->_get_scan_line($_) } @{ $self->_get_used_scans() } ];
  0            
  0            
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 0     0     my ($line) = @_;
264              
265 0 0         return $line . ' ' . ( $self->_is_flares() ? "-nf" : "-nst" );
266             },
267             [
268             map {
269 0           my $line = $_;
  0            
270              
271             # Add the -sp r:tf flag to each scan if specified - it enhances
272             # performance, but timing the scans with it makes the total
273             # scan sub-optimal.
274 0 0         if ( $self->_add_horne_prune() )
275             {
276 0           $line =~ s/( --st-name)/ -sp r:tf$1/;
277             }
278 0           $line;
279             } @$lines_aref
280             ],
281             );
282             }
283              
284             sub _calc_iter_quota
285             {
286 0     0     my $self = shift;
287 0           my $quota = shift;
288              
289 0 0         if ( $self->_offset_quotas() )
290             {
291 0           return $quota + 1;
292             }
293             else
294             {
295 0           return $quota;
296             }
297             }
298              
299             sub _map_scan_idx_to_id
300             {
301 0     0     my $self = shift;
302 0           my $index = shift;
303              
304 0           return $self->_selected_scans()->[$index]->id();
305             }
306              
307             sub _format_prelude_iter
308             {
309 0     0     my $self = shift;
310              
311 0           my $iter = shift;
312              
313 0 0         return ( $self->_is_flares() ? "Run:" : "" ) . $iter->iters() . '@'
314             . $self->_map_scan_idx_to_id( $iter->scan_idx() );
315             }
316              
317             sub _get_line_of_prelude
318             {
319 0     0     my $self = shift;
320             return
321             +( $self->_is_flares() ? "--flares-plan" : "--prelude" ) . qq{ "}
322             . join( ",",
323 0 0         map { $self->_format_prelude_iter($_) } @{ $self->_chosen_scans() } )
  0            
  0            
324             . "\"";
325             }
326              
327             sub _calc_script_lines
328             {
329 0     0     my $self = shift;
330             return [
331             $self->_get_line_of_command(),
332             @{
333 0           $self->_scan_def_line_mapping( $self->_get_lines_of_scan_defs() )
  0            
334             },
335             $self->_get_line_of_prelude()
336             ];
337             }
338              
339             sub _calc_script_text
340             {
341 0     0     my $self = shift;
342             return join( "",
343 0           @{ $self->_line_ends_mapping( $self->_calc_script_lines() ) } );
  0            
344             }
345              
346             sub _write_script
347             {
348 0     0     my $self = shift;
349              
350 0           $self->_out_script( $self->_calc_script_text() );
351             }
352              
353             sub _calc_scans_iters_pdls
354             {
355 0     0     my $self = shift;
356              
357 0 0         my $method = (
358             ( $self->_optimize_for() =~ m{len} )
359             ? "get_scans_lens_iters_pdls"
360             : "get_scans_iters_pdls"
361             );
362              
363 0           return $self->_input_obj->$method();
364             }
365              
366             sub _arbitrator_trace_cb
367             {
368 0     0     my $args = shift;
369             printf( "%s \@ %s (%s solved)\n",
370 0           @$args{qw(iters_quota selected_scan_idx total_boards_solved)} );
371             }
372              
373             sub _init_arbitrator
374             {
375 0     0     my $self = shift;
376              
377             return $self->_arbitrator(
378             AI::Pathfinding::OptimizeMultiple->new(
379             {
380             'scans' => [
381 0           map { +{ name => $_->id() } }
382 0           @{ $self->_input_obj->_suitable_scans_list() },
  0            
383             ],
384             'quotas' => $self->_get_quotas(),
385             'selected_scans' => $self->_selected_scans(),
386             'num_boards' => $self->_num_boards(),
387             'scans_iters_pdls' => $self->_calc_scans_iters_pdls(),
388             'trace_cb' => \&_arbitrator_trace_cb,
389             'optimize_for' => $self->_optimize_for(),
390             'stats_factors' => $self->_stats_factors(),
391             }
392             )
393             );
394             }
395              
396             sub _report_total_iters
397             {
398 0     0     my $self = shift;
399 0 0         if ( $self->_arbitrator()->get_final_status() eq "solved_all" )
400             {
401 0           print "Solved all!\n";
402             }
403 0           printf( "total_iters = %s\n", $self->_arbitrator()->get_total_iters() );
404             }
405              
406             sub _arbitrator_process
407             {
408 0     0     my $self = shift;
409              
410 0           $self->_arbitrator()->calc_meta_scan();
411              
412 0           my $scans =
413             $self->_post_processor->process( $self->_arbitrator->chosen_scans() );
414              
415 0           $self->_chosen_scans($scans);
416             }
417              
418             sub _do_trace_for_board
419             {
420 0     0     my $self = shift;
421 0           my $board = shift;
422              
423 0           my $results = $self->_arbitrator()->calc_board_iters($board);
424 0           print "\@info=" . join( ",", @{ $results->{per_scan_iters} } ) . "\n";
  0            
425             print +( $board + $self->_start_board() ) . ": "
426 0           . $results->{board_iters} . "\n";
427             }
428              
429             sub _real_do_trace
430             {
431 0     0     my $self = shift;
432 0           foreach my $board ( 0 .. $self->_num_boards() - 1 )
433             {
434 0           $self->_do_trace_for_board($board);
435             }
436             }
437              
438             sub _do_trace
439             {
440 0     0     my $self = shift;
441              
442             # Analyze the results
443              
444 0 0         if ( $self->_should_trace_be_done() )
445             {
446 0           $self->_real_do_trace();
447             }
448             }
449              
450             sub _get_run_string
451             {
452 0     0     my $self = shift;
453 0           my $results = shift;
454              
455             return join(
456             "",
457             map {
458 0           sprintf( '%i@%i,',
459             $_->iters(), $self->_map_scan_idx_to_id( $_->scan_idx() ) )
460 0           } @{ $self->_post_processor->process( $results->scan_runs() ) },
  0            
461             );
462             }
463              
464             sub _do_simulation_for_board
465             {
466 0     0     my ( $self, $board ) = @_;
467              
468 0           my $results = $self->_arbitrator()->simulate_board($board);
469              
470             my $scan_mapper = sub {
471 0     0     my $index = shift;
472              
473 0           return $self->_map_scan_idx_to_id($index);
474 0           };
475              
476 0           return sprintf( "%i:%s:%s:%i",
477             $board + 1,
478             $results->get_status(),
479             $self->_get_run_string($results),
480             $results->get_total_iters(),
481             );
482             }
483              
484             sub _real_do_simulation
485             {
486 0     0     my $self = shift;
487              
488 0 0         open my $simulate_out_fh, ">", $self->_simulate_to()
489             or Carp::confess( "Could not open " . $self->_simulate_to() . " - $!" );
490              
491 0           foreach my $board ( 0 .. $self->_num_boards() - 1 )
492             {
493 0           print {$simulate_out_fh} $self->_do_simulation_for_board($board), "\n";
  0            
494             }
495              
496 0           close($simulate_out_fh);
497              
498 0           return;
499             }
500              
501             sub _do_simulation
502             {
503 0     0     my $self = shift;
504              
505             # Analyze the results
506              
507 0 0         if ( defined( $self->_simulate_to() ) )
508             {
509 0           $self->_real_do_simulation();
510             }
511              
512 0           return;
513             }
514              
515             sub run
516             {
517 0     0 1   my $self = shift;
518              
519 0 0         if ( $self->_should_exit_immediately() )
520             {
521 0           return 0;
522             }
523              
524 0           $self->_init_arbitrator();
525 0           $self->_arbitrator_process();
526 0           $self->_report_total_iters();
527 0           $self->_write_script();
528 0           $self->_do_trace();
529 0           $self->_do_simulation();
530              
531 0           return 0;
532             }
533              
534             sub run_flares
535             {
536 0     0 1   my $self = shift;
537              
538 0           $self->_optimize_for("len");
539 0           $self->_is_flares(1);
540              
541 0           $self->_init_arbitrator();
542              
543 0           $self->_arbitrator()->calc_flares_meta_scan();
544              
545 0           my $scans =
546             $self->_post_processor->process( $self->_arbitrator->chosen_scans() );
547              
548 0           $self->_chosen_scans($scans);
549 0           $self->_report_total_iters();
550 0           $self->_write_script();
551 0           $self->_do_trace();
552 0           $self->_do_simulation();
553              
554 0           return 0;
555             }
556              
557             1;
558              
559             __END__
560              
561             =pod
562              
563             =encoding UTF-8
564              
565             =head1 NAME
566              
567             AI::Pathfinding::OptimizeMultiple::App::CmdLine - the command line application class.
568              
569             =head1 VERSION
570              
571             version 0.0.16
572              
573             =head1 SUBROUTINES/METHODS
574              
575             =head2 $self->run()
576              
577             For internal use.
578              
579             =head2 $self->run_flares()
580              
581             For internal use.
582              
583             =head2 $self->argv()
584              
585             An array ref of command line arguments.
586              
587             =head2 $self->input_obj_class()
588              
589             The class to handle the input data - by default -
590             L<AI::Pathfinding::OptimizeMultiple::DataInputObj>.
591              
592             =head2 BUILD()
593              
594             Moo leftover. B<INTERNAL USE>.
595              
596             =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
597              
598             =head1 SUPPORT
599              
600             =head2 Websites
601              
602             The following websites have more information about this module, and may be of help to you. As always,
603             in addition to those websites please use your favorite search engine to discover more resources.
604              
605             =over 4
606              
607             =item *
608              
609             MetaCPAN
610              
611             A modern, open-source CPAN search engine, useful to view POD in HTML format.
612              
613             L<https://metacpan.org/release/AI-Pathfinding-OptimizeMultiple>
614              
615             =item *
616              
617             RT: CPAN's Bug Tracker
618              
619             The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN.
620              
621             L<https://rt.cpan.org/Public/Dist/Display.html?Name=AI-Pathfinding-OptimizeMultiple>
622              
623             =item *
624              
625             CPANTS
626              
627             The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.
628              
629             L<http://cpants.cpanauthors.org/dist/AI-Pathfinding-OptimizeMultiple>
630              
631             =item *
632              
633             CPAN Testers
634              
635             The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions.
636              
637             L<http://www.cpantesters.org/distro/A/AI-Pathfinding-OptimizeMultiple>
638              
639             =item *
640              
641             CPAN Testers Matrix
642              
643             The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.
644              
645             L<http://matrix.cpantesters.org/?dist=AI-Pathfinding-OptimizeMultiple>
646              
647             =item *
648              
649             CPAN Testers Dependencies
650              
651             The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.
652              
653             L<http://deps.cpantesters.org/?module=AI::Pathfinding::OptimizeMultiple>
654              
655             =back
656              
657             =head2 Bugs / Feature Requests
658              
659             Please report any bugs or feature requests by email to C<bug-ai-pathfinding-optimizemultiple at rt.cpan.org>, or through
660             the web interface at L<https://rt.cpan.org/Public/Bug/Report.html?Queue=AI-Pathfinding-OptimizeMultiple>. You will be automatically notified of any
661             progress on the request by the system.
662              
663             =head2 Source Code
664              
665             The code is open to the world, and available for you to hack on. Please feel free to browse it and play
666             with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
667             from your repository :)
668              
669             L<http://github.com/shlomif/fc-solve>
670              
671             git clone ssh://git@github.com/shlomif/fc-solve.git
672              
673             =head1 AUTHOR
674              
675             Shlomi Fish <shlomif@cpan.org>
676              
677             =head1 BUGS
678              
679             Please report any bugs or feature requests on the bugtracker website
680             L<https://github.com/shlomif/ai-pathfinding-optimizemultiple/issues>
681              
682             When submitting a bug or request, please include a test-file or a
683             patch to an existing test-file that illustrates the bug or desired
684             feature.
685              
686             =head1 COPYRIGHT AND LICENSE
687              
688             This software is Copyright (c) 2012 by Shlomi Fish.
689              
690             This is free software, licensed under:
691              
692             The MIT (X11) License
693              
694             =cut