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