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]