## 四叉树表示

-- define colors
data Color = Black | White deriving (Eq, Show)
-- implement Quadtree (the order of quadrant is same as mathematical coordinate system, with top-right grid being the first quadrant)

-- ignore size if a Quadtree is in same color
allBlack _ = Cell Black

allWhite _ = Cell White

## 问题解答

{-
For this exercise, my general idea is that, first, find out all neighbours of each cell and store these information in a separate data structure (QuadtreeWN), then generate the new Quadtree which detects edges by those neighbours.
To find out all neighbours, I use two nested recursions. One is to update neighbour list gradually from leaves to root. At each level, I tell each grid their surroundings, and use another recursion to update given surrounding cells into neighbour lists of cells of the current quadtree.
This method does not care about the real size of cells, and so works on large, non-uniform quadtrees.
-}

-- define Quadtree with Neighbours which is represented as a list of cell colors
data Surroundings = Surroundings {
top :: Surrounding,
bottom :: Surrounding,
left :: Surrounding,
right :: Surrounding,
topLeft :: Surrounding,
topRight :: Surrounding,
bottomLeft :: Surrounding,
bottomRight :: Surrounding
} deriving (Eq, Show)

-- define helper functions to get the specific sub-quadtree of a quadtree
getGridA :: Surrounding -> Surrounding
getGridA Empty = Empty

getGridB :: Surrounding -> Surrounding
getGridB Empty = Empty

getGridC :: Surrounding -> Surrounding
getGridC Empty = Empty

getGridD :: Surrounding -> Surrounding
getGridD Empty = Empty

-- define helper functions to get cells of a quadtree in a given direction, e.g. getTopCells gives cells that compose the top edge of a quadtree
getTopCells :: Surrounding -> [Color]
getTopCells Empty = []
getTopCells (SQuadtree (Cell co)) = [co]

getBottomCells :: Surrounding -> [Color]
getBottomCells Empty = []
getBottomCells (SQuadtree (Cell co)) = [co]

getLeftCells :: Surrounding -> [Color]
getLeftCells Empty = []
getLeftCells (SQuadtree (Cell co)) = [co]

getRightCells :: Surrounding -> [Color]
getRightCells Empty = []
getRightCells (SQuadtree (Cell co)) = [co]

getTopLeftCell :: Surrounding -> [Color]
getTopLeftCell Empty = []
getTopLeftCell (SQuadtree (Cell co)) = [co]

getTopRightCell :: Surrounding -> [Color]
getTopRightCell Empty = []
getTopRightCell (SQuadtree (Cell co)) = [co]

getBottomLeftCell :: Surrounding -> [Color]
getBottomLeftCell Empty = []
getBottomLeftCell (SQuadtree (Cell co)) = [co]

getBottomRightCell :: Surrounding -> [Color]
getBottomRightCell Empty = []
getBottomRightCell (SQuadtree (Cell co)) = [co]

-- update border cells of given surroundings into neighbour list of each cell (recursion from root to leaves)
updateNeighbours (CellWN co neigs) surrs = CellWN co (neigs ++
getBottomCells (top surrs) ++
getTopCells (bottom surrs) ++
getRightCells (left surrs) ++
getLeftCells (right surrs) ++
getBottomRightCell (topLeft surrs) ++
getBottomLeftCell (topRight surrs) ++
getTopRightCell (bottomLeft surrs) ++
getTopLeftCell (bottomRight surrs)
)
-- pass specific sub-quadtree of given surrounding quadtree to form use sub-Surroundings
updateNeighbours (GridWN a b c d) surrs = GridWN
(updateNeighbours a (Surroundings {
top = getGridD (top surrs),
bottom = Empty,
left = Empty,
right = getGridB (right surrs),
topLeft = getGridC (top surrs),
topRight = getGridC (topRight surrs),
bottomLeft = Empty,
bottomRight = getGridC (right surrs)
}))
(updateNeighbours b (Surroundings {
top = getGridC (top surrs),
bottom = Empty,
left = getGridA (left surrs),
right = Empty,
topLeft = getGridD (topLeft surrs),
topRight = getGridD (top surrs),
bottomLeft = getGridD (left surrs),
bottomRight = Empty
}))
(updateNeighbours c (Surroundings {
top = Empty,
bottom = getGridB (bottom surrs),
left = getGridD (left surrs),
right = Empty,
topLeft = getGridA (left surrs),
topRight = Empty,
bottomLeft = getGridA (bottomLeft surrs),
bottomRight = getGridA (bottom surrs)
}))
(updateNeighbours d (Surroundings {
top = Empty,
bottom = getGridA (bottom surrs),
left = Empty,
right = getGridC (right surrs),
topLeft = Empty,
topRight = getGridB (right surrs),
bottomLeft = getGridB (bottom surrs),
bottomRight = getGridB (bottomRight surrs)
}))

-- compute neighbour list of each cell (from leaves to root)
computeNeighbours (Cell co) = CellWN co []
-- pass surroundings at each level to updateNeighbours
computeNeighbours (Grid a b c d) = GridWN
(updateNeighbours (computeNeighbours a) (Surroundings {
top = Empty,
right = Empty,
topLeft = Empty,
topRight = Empty,
bottomRight = Empty
}))
(updateNeighbours (computeNeighbours b) (Surroundings {
top = Empty,
left = Empty,
topLeft = Empty,
topRight = Empty,
bottomLeft = Empty,
}))
(updateNeighbours (computeNeighbours c) (Surroundings {
bottom = Empty,
left = Empty,
topLeft = Empty,
bottomLeft = Empty,
bottomRight = Empty
}))
(updateNeighbours (computeNeighbours d) (Surroundings {
bottom = Empty,
right = Empty,
topRight = Empty,
bottomLeft = Empty,
bottomRight = Empty
}))

-- decide if a given color is same as all of list elements
isSameColor :: Color -> [Color] -> Bool
isSameColor c [] = True
isSameColor c (x:xs) = c == x && isSameColor c xs

-- generate resulting matrix according to information in neighbour lists, which computes edges
detectEdges (CellWN co neigs) = if isSameColor co neigs then allWhite 1 else allBlack 1
detectEdges (GridWN a b c d) = Grid (detectEdges a) (detectEdges b) (detectEdges c) (detectEdges d)

-- my crude edge detector
ndiff grid = detectEdges (computeNeighbours grid)
• 