Haskell. Divided cubes into components

Question

Cubes in our model do overlap. To overlap, they need to have some shared volume, just touching is not enough. A component is a set of cubes that are overlapping. In other words, if we want to add a cube x to a component, we need to find a cube from the component, that overlaps with the cube x.

Write a function components that takes a list of cubes and as a result divides these cubes into components. The result will be [[Cube]], where each of inner lists represents a component (as was defined above). You can use function printIt to print each of these components on a separated line.

Here is my code that I was able to write, but this is not enough to solve the problem.

import Data.List (groupBy)

data Point = Point Int Int Int deriving (Eq, Show)

data Cube = Cube {start :: Point, size :: Int} deriving (Eq, Show)

sampleInput :: [Cube]
sampleInput = [ 
    Cube {start = Point 0 0 0, size = 5},
    Cube {start = Point 4 4 4, size = 5},
    Cube {start = Point 8 8 8, size = 4},
    Cube {start = Point 12 12 12, size = 2},
    Cube {start = Point 13 13 13, size = 2},
    Cube {start = Point 10 10 0, size = 2},
    Cube {start = Point 9 9 0, size = 4}
  ]

printIt :: [[Cube]] -> IO ()
printIt components = putStr (concat [show component ++ "\n" | component <- components])
function :: Cube -> Cube -> Bool
function (Cube (Point a00 b00 c00) size0) (Cube (Point a10 b10 c10) size1) = xyz
  where
    a01 = a00 + (size0 - 1)
    b01 = b00 + (size0 - 1)
    c01 = c00 + (size0 - 1)

    a11 = a10 + (size1 - 1)
    b11 = b10 + (size1 - 1)
    c11 = c10 + (size1 - 1)

    xyz = (a00 <= a11 && a01 >= a10) && (b00 <= b11 && b01 >= b10) && (c00 <= c11 && c01 >= c10)

What algorithm needs to be written to make it all work? For the result to be like this:

*Main> printIt (components sampleInput) 
[Cube {start = Point 0 0 0, size = 5},Cube {start = Point 4 4 4, size = 5},Cube {start = Point 8 8 8, size = 4}]
[Cube {start = Point 12 12 12, size = 2},Cube {start = Point 13 13 13, size = 2}]
[Cube {start = Point 10 10 0, size = 2},Cube {start = Point 9 9 0, size = 4}]

Answer 1

First, I visualize the problem:

Our task is to group cubes with an intersection. I've colored cubes by groups. Red, green, and blue. Your algorithm has difficulty with the red group and does not include the upper cube.

Cubes intersect if they have an intersection in all axes. Intervals intersect if the minimum of one is not greater or equal to the maximum of the other.

There is no problem with your function. Check equation marks and calculations.

The problem is in the groupBy function, which counts on equivalence. Specifically, yours is not transitive.

Further solutions depend on the exact assignment.

The easiest way is to swap the first and second lines in the assignment, and thus the lower and upper red cubes will be compared with the middle one, which has intersections.

    Cube {start = Point 4 4 4, size = 5}, -- This is compared
    Cube {start = Point 0 0 0, size = 5},
    Cube {start = Point 8 8 8, size = 4},
    Cube {start = Point 12 12 12, size = 2}, -- This doesn't have intersection
    Cube {start = Point 13 13 13, size = 2},
    Cube {start = Point 10 10 0, size = 2},
    Cube {start = Point 9 9 0, size = 4}

But this is a bit simplified because cube intersections are best calculated by sorting objects by coordinates and then going through the list sequentially.

So we can define a custom groupBy function that works as expected. (Mine is pretty ugly.)

--import Data.List (groupBy)

data Point = Point Int Int Int deriving (Eq, Show)

data Cube = Cube {start :: Point, size :: Int} deriving (Eq, Show)

-- ugly
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy a b = groupBy' a (tail b) (head b)

groupBy' :: (a -> a -> Bool) -> [a] -> a -> [[a]]
groupBy' _ [] prev = [[prev]]
groupBy' f (x:xs) prev
  | f x prev = [prev:list] ++ lists
  | otherwise = [[prev]] ++ (list:lists)
  where list:lists = groupBy' f xs x


sampleInput :: [Cube]
sampleInput = [ 
    Cube {start = Point 0 0 0, size = 5},
    Cube {start = Point 4 4 4, size = 5},
    Cube {start = Point 8 8 8, size = 4},
    Cube {start = Point 12 12 12, size = 2},
    Cube {start = Point 13 13 13, size = 2},
    Cube {start = Point 10 10 0, size = 2},
    Cube {start = Point 9 9 0, size = 4}
  ]

printIt :: [[Cube]] -> IO ()
printIt components = putStr (concat [show component ++ "\n" | component <- components])
function :: Cube -> Cube -> Bool
function (Cube (Point a00 b00 c00) size0) (Cube (Point a10 b10 c10) size1) = xyz
  where
    a01 = a00 + (size0)
    b01 = b00 + (size0)
    c01 = c00 + (size0)

    a11 = a10 + (size1)
    b11 = b10 + (size1)
    c11 = c10 + (size1)

    xyz = (a00 < a11 && a01 > a10) && (b00 < b11 && b01 > b10) && (c00 < c11 && c01 > c10)

components = groupBy function 

Command:

printIt (components sampleInput)

Output:

[Cube {start = Point 0 0 0, size = 5},Cube {start = Point 4 4 4, size = 5},Cube {start = Point 8 8 8, size = 4}]
[Cube {start = Point 12 12 12, size = 2},Cube {start = Point 13 13 13, size = 2}]
[Cube {start = Point 10 10 0, size = 2},Cube {start = Point 9 9 0, size = 4}]

Most bulletproof is creating a custom function that compares every two cubes and gives them into lists.

genList :: (a -> a -> Bool) -> [a] -> [[a]]
genList f [] = []
genList f (a:as) = genList' f a (genList f as) 

genList' :: (a -> a -> Bool) -> a -> [[a]] -> [[a]]
genList' _ a [] = [[a]]
genList' f a (x:xs) 
  | elemBy f a x = (a:x):xs 
  | otherwise = x:(genList' f a xs)

elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
elemBy f a [] = False
elemBy f a (b:bs) = (f a b) || elemBy f a bs