I just had to generalize the 'challange' to arbitrary n-sided polygons. We define such a polygon to consist of points x_0, ..., x_{n-1}, where two adjacent points x_i and x_{i+1} (resp. x0 and x_{n-1}) must be on a line. The polygon is not degenerate if additionally no point is on any such line besides its two adjacent ones. The list comprehension is generalized by using the list monad, which allows to perform an (iterated) arbitrary number of steps, each time choosing new candidates. In each step, we know the list of points and lines so far. We add a new line from the last point, and a new point from this line, provided that neither the new point is on any line seen so far, nor any of the known points (except the last) is on the new line. Thus the polygon will not be degenerate. Aequivalent polygons are found by rotating the list of points, or by changing direction. To fix the first, choose the 'smallest' point as given by the arbitrary order imposed by 'choices'. To fix the second, pick the second and the last point after the first point, and make sure the second point is 'smaller' than the last point. Hence, we have to pick the three points x0, x1 and x_{n-1} (which is called xn for simplicity below) in advance. To make the function simpler, we just iterate the steps as often as necessary and then check that the last new point is identical to x_{n-1}, so we don't have to redo all the checks for it. Hence, we cannot include the line ln between x0 and x_{n-1} in the lines to check, so we still have to check this line at the end. To do this, we have to exclude x0 from the number of points xs found so far (it's inconvenient to remove a point from the end of the list). This means we have to add x0 during the check in the step. So we end up with [x1] as the initial list of points, and [l1] as the initial list of lines. > import Data.List > import Control.Monad > polygons n blocks = > let > choice = init . tails > join x y = filter (\l -> x `elem` l && y `elem` l) blocks > in do > x1:p <- choice $ nub $ concat blocks > x0:q <- choice p > x2:_ <- choice q > l1 <- join x0 x1 > l2 <- join x1 x2 > let > start = [([x2,x1,x0], [l2,l1])] > step (xs@(x:_), ls) = do > l <- filter (x `elem`) blocks > y <- intersect l (p\\xs) > return (y:xs, l:ls) > (xs@(x:_), ls) <- iterate (>>= step) start !! (n-3) > ln <- join x x0 > guard (all ((==2) . length . intersect xs) (ln:ls)) > return xs There are several ways to make this faster, but it's fast enough for toy examples as it is. Examples of blocks to test with. Frank's figure: > blocks = > [[0,1],[0,2,4,6],[1,2,3,5],[0,3,7,9],[1,4,7,8],[0,5,8,10],[1,6,9,10]] A square with one diagonal: 0 -- 1 | \ | | \ | 2 -- 3 > blocks2 = [[0,1],[0,2],[0,3],[1,3],[2,3]] A square with two diagonals: 0 -- 1 | \/ | | /\ | 2 -- 3 > blocks3 = [[0,1],[0,2],[0,3],[1,3],[2,3],[1,2]] We get for example Main> polygons 3 blocks2 [[0,3,1],[0,3,2]] Main> polygons 4 blocks2 [[0,2,3,1]] Main> polygons 3 blocks3 [[0,2,1],[0,3,1],[0,3,2],[1,3,2]] Main> polygons 4 blocks3 [[0,2,3,1],[0,3,2,1],[0,3,1,2]] Frank's figure only admits triangles, quadrangles and hexagons: Main> map (\n -> length $ polygons n blocks) [3..10] [27,27,0,6,0,0,0,0] Main> polygons 3 blocks [[0,2,1],[0,4,1],[0,6,1],[0,3,1],[0,5,1],[0,7,1],[0,9,1],[0,8,1],[0,10,1], [0,3,2],[0,5,2],[0,7,4],[0,8,4],[0,9,6],[0,10,6],[0,5,3],[0,8,7],[0,10,9], [1,4,2],[1,6,2],[1,6,4],[1,7,3],[1,9,3],[1,8,5],[1,10,5],[1,9,7],[1,10,8]] Main> polygons 4 blocks [[0,7,1,2],[0,9,1,2],[0,8,1,2],[0,10,1,2],[0,3,1,4],[0,5,1,4],[0,9,1,4], [0,10,1,4],[0,3,1,6],[0,5,1,6],[0,7,1,6],[0,8,1,6],[0,8,1,3],[0,10,1,3], [0,7,1,5],[0,9,1,5],[0,10,1,7],[0,8,1,9],[2,3,7,4],[2,5,8,4],[2,3,9,6], [2,5,10,6],[4,7,9,6],[4,8,10,6],[3,7,8,5],[3,9,10,5],[7,8,10,9]] Main> polygons 6 blocks [[2,3,9,10,8,4],[2,5,10,9,7,4],[2,3,7,8,10,6],[2,5,8,7,9,6],[4,7,3,5,10,6], [4,8,5,3,9,6]] For triangles (n=3) the iteration is empty and so the function reduces to > triangles blocks = > let > choice = init . tails > join x y = filter (\l -> x `elem` l && y `elem` l) blocks > in do > x1:p <- choice $ nub $ concat blocks > x0:q <- choice p > x2:_ <- choice q > l1 <- join x0 x1 > l2 <- join x1 x2 > ln <- join x2 x0 > guard (all ((==2) . length . intersect [x2,x1,x0]) [ln,l2,l1]) > return xs which further shortens to > triangles blocks = [(x,y,z) | x:p <-choice$nub$concat blocks, y:q <-choice p, > l <-join x y, z:_ <-choice (q\\l), _ <-join y z, _ <-join z x] where > choice = init . tails > join x y = filter (\l -> x `elem` l && y `elem` l) blocks