Compute all triangles for a given set of lines http://www.frank-buss.de/challenge/index.html The following imports are only needed for the refined version, but the must be at the beginning: > import List > import Array SIMPLE VERSION: First, define a list of all points that are used > points = [0..10] Now, define the lines by listing all points on a particular line. We call the lines 'blocks' as usual for semi-geometric structures, because the identifier 'lines' is already used in the Prelude. > 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]] For every two points x and y, there should be at most one line which contains both points. The following function either returns an empty list if there is no such line, or a list with the block as single element if there is such a list. This operation is usually called 'join' in abstract geometry. > x `join` y = filter (\l -> x `elem` l && y `elem` l) blocks Now we need the list of all triples of points x,y,z such that * x < y < z, to avoid duplicates * x and y are on the same line, which we call l * x,z and y,z are also on the same line, but we don't care which one it is * z is not on l, i.e. the triangle is not degenerated and has area > 0 In the following list comprehension, the order of these conditions is changed to make it more efficient. An empty list returned from 'join' acts like a false boolean condition. > triangles = [(x,y,z) | x <- points, y <- points, x < y, l <- x `join` y, > z <- points, x < z, y < z, _ <- x `join` z, _ <- y `join` z, z `notElem` l] And that's all -- 6 lines of Haskell. It should be obvious that this program is correct, because we have just written down a formal specification of the problem. And indeed, 'triangles' yields as output the 27 elements [(0,1,2),(0,1,3),(0,1,4),(0,1,5),(0,1,6),(0,1,7),(0,1,8),(0,1,9),(0,1,10), (0,2,3),(0,2,5),(0,3,5),(0,4,7),(0,4,8),(0,6,9),(0,6,10),(0,7,8),(0,9,10), (1,2,4),(1,2,6),(1,3,7),(1,3,9),(1,4,6),(1,5,8),(1,5,10),(1,7,9),(1,8,10)] REFINED VERSION: To make the program more efficient, several things can be improved: a) calculate the list of points from the blocks b) keep a list of remaining choices, to avoid comparison of x, y, z c) use the list of blocks as parameter d) precompute the join function, and store it in an array For (b), we use the auxiliary function > choices :: [a] -> [(a, [a])] > choices [] = [] > choices (x:xs) = (x,xs) : choices xs Leaving aside (d), triangles becomes now > triangles' :: (Eq a) => [[a]] -> [(a, a, a)] > triangles' blocks = let > points = nub (concat blocks) > x `join` y = filter (\l -> x `elem` l && y `elem` l) blocks > in [(x,y,z) | (x,points') <- choices points, > (y,points'') <- choices points', l <- x `join` y, > (z,_) <- choices points'', > _ <- x `join` z, _ <- y `join` z, z `notElem` l] Not so nice to read, but basically still the same. For (d), we again need the type of points to be ordered, and additionally indexable, hence this gets its own version. We use 'choices' in the precalculation, since join is symmetrical, and we can guarantee that we will index a with a pair which is ordered correctly. > triangles'' :: (Ord a, Ix a) => [[a]] -> [(a, a, a)] > triangles'' blocks = let > points = nub (concat blocks) > x `join` y = filter (\l -> x `elem` l && y `elem` l) blocks > s = minimum points > t = maximum points > a = array ((s,s),(t,t)) > [((x,y),x `join` y) | (x,points') <- choices points, y <- points'] > in [(x,y,z) | (x,points') <- choices points, > (y,points'') <- choices points', l <- a ! (x, y), > z <- points'', > _ <- a ! (x, z), _ <- a ! (y, z), z `notElem` l]