use strict; my $desired_page_count = 10; # Structure holding all the different page layouts. ('l' = Landscape, 'p' = Portrait) my $pages = [ {'ll' => '01'}, {'pp' => '02'}, {'lp' => '03'}, {'pl' => '04'}, {'lpp' => '05'}, {'pll' => '06'}, {'plp' => '07'}, {'lpl' => '08'}, {'lll' => '09'}, {'ppp' => '10'}, {'ppl' => '11'}, {'llp' => '12'}, {'ppll' => '13'}, {'llpp' => '14'}, ]; # String of orientation of photos to be used, in the correct order. my $photos = "llppllpplpppllplpplpplpllplpll"; my $best_score = 999999; my $best_solution = []; my $solution = []; do_rest_of_book($photos,$solution); print "\nBest: " . join (',', @$best_solution); print "\nWith score of $best_score\n"; sub do_rest_of_book { my $cur = shift; my $solution = shift; # If there's still more book to process, and we haven't already surpassed the desired page count if ($cur and scalar(@$solution) <= $desired_page_count) { # Consider each page layout foreach my $page_object (@$pages) { my $page_object_page = [keys %$page_object]->[0]; my $page_object_solution = [values %$page_object]->[0]; # If the book we have left starts with the page layout we're considering, let's proceed if ($cur =~ /^$page_object_page/) { my $this_solution = $page_object_solution; my $local_solution = [@{$solution}]; push @{$local_solution}, $this_solution; my $rest_of_book = substr($cur,length($page_object_page)); # If score SO FAR is lower than minimum, let's carry on with this book. # (This makes an assumption that the score will never lower as we add more pages.) if (score_solution($local_solution) < $best_score) { do_rest_of_book($rest_of_book, $local_solution); } } } # Otherwise, if there's no more book, we have a solution, of sorts. } elsif (!($cur)) { if (scalar(@$solution) == $desired_page_count) { my $score = score_solution($solution); if ($score < $best_score) { $best_score = $score; $best_solution = [@$solution]; } print "SOLUTION FOUND! Score " . $score . "\n"; } } return; } sub score_solution { # Solution Scorer. 0 is perfect, higher is worse. my $solution = shift; my $score = 0; my %refs = (); my $lastsol = ""; foreach my $sol (@$solution) { # 20 Points For Using The Same Layout Twice In A Row if ($sol eq $lastsol) { $score += 20; } # 1 Point For Using The Same Layout Previously, 2 Points For Twice, 4 Points For Three Times, 8, 16 ... if ($refs{$sol}) { $score += $refs{$sol}^2; } $lastsol = $sol; $refs{$sol} ++; } return $score; }