First, the new definitions:
data Region = UnitCircle | Polygon [Coordinate] | AffineTransform Matrix3x3 Region | Empty deriving Show type Vector3 = (Float, Float, Float) type Matrix3x3 = (Vector3, Vector3, Vector3) type Matrix2x2 = ((Float, Float), (Float, Float)) |
And some old ones that will suffice unchanged:
type Coordinate = (Float, Float) type Ray = (Coordinate, Coordinate) isLeftOf :: Coordinate -> Ray -> Bool (px,py) `isLeftOf` ((ax,ay), (bx,by)) = let (s,t) = (px-ax, py-ay) (u,v) = (px-bx, py-by) in s * v >= t * u isRightOf :: Coordinate -> Ray -> Bool (px,py) `isRightOf` ((ax,ay), (bx,by)) = let (s,t) = (px-ax, py-ay) (u,v) = (px-bx, py-by) in s * v <= t * u containsR :: Region -> Coordinate -> Bool (Polygon pts) `containsR` p = let leftOfList = map isLeftOfp (zip pts (tail pts ++ [head pts])) isLeftOfp p' = isLeftOf p p' rightOfList = map isRightOfp (zip pts (tail pts ++ [head pts])) isRightOfp p' = isRightOf p p' in and leftOfList || and rightOfList Empty `containsR` p = False |
Now we have the new forms of containsR to write. The UnitCircle is easy:
UnitCircle `containsR` (x,y) = x^2 + y^2 <= 1 |
And in general, the transform of a region contains a point if the region contains the inverse transform of that point.
(AffineTransform m r) `containsR` (x,y) = if determinant3 m == 0 then singularContains m (x,y) else let m' = inverse m (x', y', _) = matrixMul m' (x,y,1) in r `containsR` (x', y') |
Now some standard code for multiplying and inverting matrices:
matrixMul :: Matrix3x3 -> Vector3 -> Vector3 matrixMul (r1, r2, r3) v = (dotProduct r1 v, dotProduct r2 v, dotProduct r3 v) dotProduct :: Vector3 -> Vector3 -> Float dotProduct (a,b,c) (x,y,z) = a*x + b*y + c*z inverse :: Matrix3x3 -> Matrix3x3 inverse ((a,b,c), (d,e,f), (g,h,i)) = let det = determinant3 ((a,b,c), (d,e,f), (g,h,i)) a' = determinant2 ((e,f), (h,i)) / det b' = determinant2 ((c,b), (i,h)) / det c' = determinant2 ((b,c), (e,f)) / det d' = determinant2 ((f,d), (i,g)) / det e' = determinant2 ((a,c), (g,i)) / det f' = determinant2 ((c,a), (f,d)) / det g' = determinant2 ((d,e), (g,h)) / det h' = determinant2 ((b,a), (h,g)) / det i' = determinant2 ((a,b), (d,e)) / det in ((a',b',c'), (d',e',f'), (g',h',i')) determinant3 :: Matrix3x3 -> Float determinant3 ((a,b,c), (d,e,f), (g,h,i)) = let aei = a * e * i afh = a * f * h bdi = b * d * i cdh = c * d * h bfg = b * f * g ceg = c * e * g in aei - afh - bdi + cdh + bfg - ceg determinant2 :: Matrix2x2 -> Float determinant2 ((a,b), (c,d)) = a * d - b * c |
The only thing left is the question of how to deal with a singular (non-invertible) matrix. If an affine matrix is non-invertible, that means that AE – BD = 0. Either all four coefficients are 0, or AE = BD. If all 4 are 0, then every point in the region will be collapsed into the single point (C,F), and we need to check that this is the given point. If AE = BD otherwise, we have for any point (x,y) in the region:
x' = Ax + By + C
y' = Dx + Ey + F
Dx' = ADx + BDy + CD
Ay' = ADx + AEy + AF
= ADx + BDy + AF [AE = BD]
∴ Dx' - Ay' = CD - AF
Dx' - Ay' + AF - CD = 0
so any point in the region will be collapsed into the line Dx’ – Ay’ + AF – CD = 0, and we need to check that the given point satisfies this equation.
singularContains :: Matrix3x3 -> Coordinate -> Bool singularContains ((a,b,c), (d,e,f), _) (x,y) = if (a == 0 && b == 0 && d == 0 && e == 0) then (x == c && y == f) else (d*x - a*y + a*f - c*d == 0) |