The Monad.Reader/Issue5/Generating Polyominoes - Revision history
https://wiki.haskell.org/index.php?title=The_Monad.Reader/Issue5/Generating_Polyominoes&action=history
Revision history for this page on the wikienMediaWiki 1.19.14+dfsg-1Fri, 24 Mar 2017 04:47:49 GMTNewacct at 21:39, 21 February 2010
https://wiki.haskell.org/index.php?title=The_Monad.Reader/Issue5/Generating_Polyominoes&diff=33792&oldid=prev
https://wiki.haskell.org/index.php?title=The_Monad.Reader/Issue5/Generating_Polyominoes&diff=33792&oldid=prev<p></p>
<table class='diff diff-contentalign-left'>
<col class='diff-marker' />
<col class='diff-content' />
<col class='diff-marker' />
<col class='diff-content' />
<tr valign='top'>
<td colspan='2' style="background-color: white; color:black;">← Older revision</td>
<td colspan='2' style="background-color: white; color:black;">Revision as of 21:39, 21 February 2010</td>
</tr><tr><td colspan="2" class="diff-lineno">Line 128:</td>
<td colspan="2" class="diff-lineno">Line 128:</td></tr>
<tr><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div>> newPoints :: Polyomino -> [Point]</div></td><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div>> newPoints :: Polyomino -> [Point]</div></td></tr>
<tr><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div>> newPoints p =</div></td><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div>> newPoints p =</div></td></tr>
<tr><td class='diff-marker'>−</td><td style="background: #ffa; color:black; font-size: smaller;"><div>>    let notInP = filter (<del class="diffchange diffchange-inline">not . flip elem </del>p) in</div></td><td class='diff-marker'>+</td><td style="background: #cfc; color:black; font-size: smaller;"><div>>    let notInP = filter (<ins class="diffchange diffchange-inline">`notElem` </ins>p) in</div></td></tr>
<tr><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div>>   unique . notInP . concatMap contiguous $ p</div></td><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div>>   unique . notInP . concatMap contiguous $ p</div></td></tr>
<tr><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"></td><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"></td></tr>
<tr><td colspan="2" class="diff-lineno">Line 138:</td>
<td colspan="2" class="diff-lineno">Line 138:</td></tr>
<tr><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"></td><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"></td></tr>
<tr><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div>> newPolys :: Polyomino -> [Polyomino]</div></td><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div>> newPolys :: Polyomino -> [Polyomino]</div></td></tr>
<tr><td class='diff-marker'>−</td><td style="background: #ffa; color:black; font-size: smaller;"><div>> newPolys p = unique . map (canonical . <del class="diffchange diffchange-inline">flip </del>(:<del class="diffchange diffchange-inline">) </del>p) $ newPoints p</div></td><td class='diff-marker'>+</td><td style="background: #cfc; color:black; font-size: smaller;"><div>> newPolys p = unique . map (canonical . (:p<ins class="diffchange diffchange-inline">)</ins>) $ newPoints p</div></td></tr>
<tr><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"></td><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"></td></tr>
<tr><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div></haskell></div></td><td class='diff-marker'> </td><td style="background: #eee; color:black; font-size: smaller;"><div></haskell></div></td></tr>
</table>Sun, 21 Feb 2010 21:39:12 GMTNewaccthttps://wiki.haskell.org/Talk:The_Monad.Reader/Issue5/Generating_PolyominoesGwern: fmt
https://wiki.haskell.org/index.php?title=The_Monad.Reader/Issue5/Generating_Polyominoes&diff=20886&oldid=prev
https://wiki.haskell.org/index.php?title=The_Monad.Reader/Issue5/Generating_Polyominoes&diff=20886&oldid=prev<p>fmt</p>
<a href="https://wiki.haskell.org/index.php?title=The_Monad.Reader/Issue5/Generating_Polyominoes&diff=20886&oldid=20840">Show changes</a>Sat, 10 May 2008 02:19:30 GMTGwernhttps://wiki.haskell.org/Talk:The_Monad.Reader/Issue5/Generating_PolyominoesWouterSwierstra at 14:25, 9 May 2008
https://wiki.haskell.org/index.php?title=The_Monad.Reader/Issue5/Generating_Polyominoes&diff=20840&oldid=prev
https://wiki.haskell.org/index.php?title=The_Monad.Reader/Issue5/Generating_Polyominoes&diff=20840&oldid=prev<p></p>
<p><b>New page</b></p><div>'''This article needs reformatting! Please help tidy it up.'''--[[User:WouterSwierstra|WouterSwierstra]] 14:25, 9 May 2008 (UTC)<br />
<br />
= Generating Polyominoes =<br />
== A simple algorithm for enumerating the polyominoes of a given rank, implemented in Haskell ==<br />
<br />
Readers of Arthur C. Clarke's novel ''Imperial Earth'' may remember the "Pentomino" puzzle that beguiles the book's protagonist, Duncan Mackenzie. The object of the puzzle is to arrange twelve puzzle pieces, each made of five congruent squares, in a rectangular box. For a box with the dimensions six squares by ten, there are many possible solutions; for a box with the dimensions three squares by twenty, there are only two. The young Duncan Mackenzie's initial encounter with the six-by-ten version of the puzzle teaches him a lesson about the uses of intuition in mathematical problem solving. Solving the harder three-by-twenty version requires that intuition be supplemented by technique: it is a task for a more developed formal imagination.<br />
<br />
In this article, we will take a first step towards the construction of a solver for the pentomino puzzle. We will begin with the task of ''enumerating'' the pentominoes, and other similar shapes. Duncan's puzzle has twelve pieces, and these pieces are the twelve distinct "free" pentominoes; that is, they are all the shapes that can be made by glueing five squares together orthogonally along their edges, that are different from each other even when rotated, reflected and/or translated. For example, under this definition, the following shapes are all the "same" free pentomino (the "F" pentomino):<br />
<br />
{{{<br />
** * * * ** * * * <br />
** *** ** *** ** *** ** ***<br />
* * ** * * * ** *<br />
}}}<br />
<br />
If we wanted to find out what the other eleven free pentominoes were, we would need both a way of generating new candidate pentominoes, and a way of recognising when one of these new candidates was the same - under rotation, reflection and/or translation - as a pentomino we had already found.<br />
<br />
The set of twelve pentominoes belongs to a larger set of "polyforms" known as polyominoes. The name "polyominoes" was first given to these shapes by the mathematician Solomon W. Golomb, whose book ''Polyominoes'' is a fascinating introduction to the subject of polyomino puzzles and techniques for solving them. Probably the best-known polyominoes are the five "tetrominoes" that appear in the game "Tetris":<br />
<br />
{{{<br />
**** ** *** ** ***<br />
** * ** *<br />
}}}<br />
As their name suggests, each of the tetrominoes is made of four squares orthogonally connected along their edges. Every pentomino is a tetromino with an additional square attached to one of its constituent squares along an edge not already taken by another square. In the same manner, every tetromino is a ''tromino'' - a polyomino made of three squares, or a polyomino of rank three - with an additional square attached to it. Every tromino is a domino with an extra square, and a domino is a monomino with an extra square.<br />
<br />
Given a definition of the polyominoes of rank zero as an empty set, and the polyominoes of rank one as a set containing a single monomino, we can define the polyominoes of rank ''n'' as all of the polyominoes that can be created by adding an extra square to some polyomino of rank ''n-1'', that are different from one another under translation, rotation and reflection. This definition gives us the outline of a simple algorithm for enumerating all of the polyominoes of rank ''n''.<br />
<br />
== Implementing the algorithm in Haskell ==<br />
<br />
Implementing such an algorithm in Haskell involves generating a list of candidate polyominoes of rank ''n'', based on a list of known polyominoes of rank ''n-1'', and removing from that list all polyominoes that are found to be the same as another included polyomino after they have been translated, rotated and/or reflected. The module described below does just that, providing a function, {{{rank}}}, that generates all the polyominoes of a given rank. The approach taken by this module is the least efficient of the three discussed in the [http://en.wikipedia.org/wiki/Polyomino wikipedia article on polyominoes], but it is easy to follow and provides a nice illustration of the usefulness of function composition in expressing algorithms in Haskell.<br />
<br />
We begin with the module declaration, some imports, and a couple of types:<br />
<br />
{{{<br />
<br />
> module Generator (rank) where<br />
<br />
> import List (sort)<br />
> import Data.Set (setToList, mkSet)<br />
<br />
> type Point = (Int, Int)<br />
> type Polyomino = [Point]<br />
<br />
}}}<br />
<br />
In order to compare two candidate polyominoes and determine whether they are the same, we introduce some functions that will convert any candidate polyomino into a normalised, "canonical" form. The first kind of normalisation we perform is to translate the candidate polyomino such that its bottom and left edges are aligned with the x and y axes:<br />
<br />
{{{<br />
<br />
> minima :: Polyomino -> Point<br />
> minima (p:ps) = foldr (\(x, y) (mx, my) -> (min x mx, min y my)) p ps<br />
<br />
> translateToOrigin :: Polyomino -> Polyomino<br />
> translateToOrigin p =<br />
> let (minx, miny) = minima p in<br />
> map (\(x, y) -> (x - minx, y - miny)) p<br />
<br />
}}}<br />
<br />
The second kind of normalisation we perform is to take all of the rotated and reflected forms of the translated polyomino, and sort them in order to find the "bottommost and leftmost" form.<br />
<br />
{{{<br />
<br />
> rotate90 :: Point -> Point<br />
> rotate90 (x, y) = (y, -x)<br />
<br />
> rotate180 :: Point -> Point<br />
> rotate180 (x, y) = (-x, -y)<br />
<br />
> rotate270 :: Point -> Point<br />
> rotate270 (x, y) = (-y, x)<br />
<br />
> reflect :: Point -> Point<br />
> reflect (x, y) = (-x, y)<br />
<br />
> rotationsAndReflections :: Polyomino -> [Polyomino]<br />
> rotationsAndReflections p =<br />
> [p,<br />
> map rotate90 p,<br />
> map rotate180 p,<br />
> map rotate270 p,<br />
> map reflect p,<br />
> map (rotate90 . reflect) p,<br />
> map (rotate180 . reflect) p,<br />
> map (rotate270 . reflect) p]<br />
<br />
> canonical :: Polyomino -> Polyomino<br />
> canonical = minimum . map (sort . translateToOrigin) . rotationsAndReflections<br />
<br />
}}}<br />
The function {{{canonical}}} is constructed by composing together other functions, so as to create a kind of pipeline of transformations which are applied to an initial value in right-to-left order. Thus, {{{rotationsAndReflections}}} takes a polyomino and returns a list of all the rotated and reflected forms of that polyomino. The next stage in the pipeline uses {{{map}}} to apply the composed function {{{sort . translateToOrigin}}} to each of these forms in turn, translating them so that their bottommost and leftmost square is in the position (0, 0) and sorting the list of points that makes up each polyomino so that the bottommost and leftmost square appears first in the list, and the rightmost and topmost appears last. We then use {{{minimum}}} take the lowest-ordered polyomino in the resulting list of translated and internally-sorted polyominoes.<br />
<br />
Given a polyomino of rank ''n'', we would like to know what polyominos of rank ''n+1'' can be generated by attaching another point to it. We therefore need to find all the unique places where another point can be attached. This definition of {{{unique}}} is efficient enough for short lists:<br />
<br />
{{{<br />
<br />
> unique :: (Eq a) => [a] -> [a]<br />
> unique [] = []<br />
> unique (x:xs) = foldr (\y ys -> if y `elem` ys then ys else y:ys) [x] xs<br />
<br />
}}}<br />
<br />
We also define an alternative {{{unique'}}} function for removing duplicates from a long list of polyominoes. This alternative function simply converts a list to a set, and then back into a list:<br />
<br />
{{{<br />
<br />
> unique' :: (Ord a) => [a] -> [a]<br />
> unique' = setToList . mkSet<br />
<br />
}}}<br />
<br />
The function {{{contiguous}}} returns all the orthogonally adjacent points of a given point.<br />
<br />
{{{<br />
<br />
> contiguous :: Point -> [Point]<br />
> contiguous (x, y) =<br />
> [(x - 1, y),<br />
> (x + 1, y),<br />
> (x, y - 1),<br />
> (x, y + 1)]<br />
<br />
}}}<br />
<br />
Given these two functions, we can find the contiguous points for each point in a polyomino. We're only interested in points that fall outside of the original polyomino, so we filter out any that are already taken.<br />
<br />
{{{<br />
<br />
> newPoints :: Polyomino -> [Point]<br />
> newPoints p =<br />
> let notInP = filter (not . flip elem p) in<br />
> unique . notInP . concatMap contiguous $ p<br />
<br />
}}}<br />
<br />
Now we can generate a list of new polyominoes using newPoints. We'll put them all into canonical form, and only take the unique ones.<br />
<br />
{{{<br />
<br />
> newPolys :: Polyomino -> [Polyomino]<br />
> newPolys p = unique . map (canonical . flip (:) p) $ newPoints p<br />
<br />
}}}<br />
<br />
Again, this function is composed out of smaller functions: {{{newPoints}}} feeds its results to a function that adds each new point to the initial polyomino and returns the resulting new polyomino in canonical form, and {{{unique}}} then removes all duplicates from the resulting list of new polyominoes.<br />
<br />
We now define the first two ranks of polyominoes. The zeroth rank of polyominoes is the empty list. The first rank of polyominoes is the monominoes, which is a list containing a single element:<br />
<br />
{{{<br />
<br />
> monomino = [(0, 0)]<br />
> monominoes = [monomino]<br />
<br />
> rank :: Int -> [Polyomino]<br />
> rank 0 = []<br />
> rank 1 = monominoes<br />
<br />
}}}<br />
<br />
The next rank of monominoes can be generated from the rank before it. We find all the new polyominoes in rank ''n'' that can be generated from each<br />
polyomino in rank ''n -1'', concatenate them together into a single list, and throw out any duplicates.<br />
<br />
{{{<br />
<br />
> rank n = unique' . concatMap newPolys $ rank (n - 1)<br />
<br />
}}}<br />
<br />
That is the entire algorithm!<br />
<br />
== Conclusions ==<br />
<br />
The above program uses function composition to express an algorithm as a pipeline made up of three kinds of function: functions of type {{{a -> [a]}}} that generate new values from some source value, functions of type {{{[a] -> [a]}}} that filter a list of values to remove duplicate or unwanted values, and functions of type {{{[a] -> a}}} that extract a single result from a list of values. Many algorithms based on the blind generation of a list of new candidate results, which is then filtered to extract only the valid answers, can easily be expressed in this style. It also lends itself to recursion, as each new generation of results can be fed back into the pipeline to produce another generation.<br />
<br />
Haskell's lazy evaluation and garbage collection can help to minimize the creation and retention of large data structures during the course of such pipelined processing. However, there are limitations to how much work lazy evaluation can help us to avoid. In the function {{{canonical}}} in the program above, for example, the entire list consumed by {{{minimum}}} must be constructed before the lowest-ordered value can be found.<br />
<br />
As I mentioned earlier, this is not by any means the best algorithm for enumerating polyominoes. It is better if possible to avoid generating values that will only be thrown away, as these still have to be checked before being discarded. It is worth looking for a heuristic that can limit the number of invalid or duplicate candidate results generated, as this will often have a greater impact on performance than any optimisation that can be applied to the validation stage.<br />
<br />
=== For Further Investigation ===<br />
<br />
Can an algorithm for enumerating polyforms made of cubes be constructed as easily as one for enumerating polyforms made of squares? How about polyforms of arbitrary dimension? And what about two-dimensional polyforms made out of other shapes, such as hexagons?<br />
----<br />
CategoryArticle</div>Fri, 09 May 2008 14:25:09 GMTWouterSwierstrahttps://wiki.haskell.org/Talk:The_Monad.Reader/Issue5/Generating_Polyominoes