http://www.perlmonks.org?node_id=508698

SmugX has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks,

An interesting-sounding (to me!) problem has landed on my desk.

I have a number of photographs, each of which are either of landscape or portrait orientation. The order of these photos is important, and is for the purposes of the excercise fixed.

I also have a number of potential page layouts (or templates), each of which contain one or more spaces for photos; the spaces are either landscape or portrait in nature. (e.g. layout 1 may contain one "Landscape" ,layout 2 "Portrait then Portrait", layout 3 "Landscape then Portrait then Portrait" etc.)

I need to find a combination of page layouts that holds the photos in their correct order, which each photo fitting into a space with matching orientation.

There are a couple of additional contraints; the number of layouts that can be in the solution is fixed, because I must produce a book containing exactly X layouts. Also, I want to minimise the re-use of layouts where possible, and I definitely don't want to use the same layout consecutively unless absolutely necessary.

My first thought was this sounded like a tree-type problem, so I knocked up the following code using a simple recursive algorithm. My scoring algorithm is a little arbitrary at the moment, but should suffice for testing. (Also of note is my short-cut assumption that the score will never get better as subsequent pages are added.)

The good news is the code appears to work. However, the problem is that as more potential page layouts are added, the time taken increases vastly. I gave the program 40 possible layouts and 40 images, and ... well, let's just say it's still running. :-)

So, I now need to figure out ways to improve the speed of this program. (For the record, whilst a good solution is required, the best-possible solution isn't really necessary.)

Can anyone suggest a better methodology, either by changing my existing code, or perhaps by using one of the many Algorithm:: modules on CPAN, virtually all of which very quickly go right over my head as soon as I start to read the documentation? :-)

Any help will be greatly appreciated.

Many thanks,
Neil.

use strict; my $desired_page_count = 10; # Structure holding all the different page layouts. ('l' = Landsca +pe, '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 alread +y 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 car +ry on with this book. # (This makes an assumption that the score will ne +ver 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 s +orts. } 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 F +or Twice, 4 Points For Three Times, 8, 16 ... if ($refs{$sol}) { $score += $refs{$sol}^2; } $lastsol = $sol; $refs{$sol} ++; } return $score; }
P.S. This does beg the questions of how can one determine if a selection of layouts could deal with every possible selection of photos, and similarly, what is the smallest possible selection of layouts that are similarly "complete"? I don't need to know the answer, but it is intriguing!