# 08.08.07

Posted in Uncategorized at 11:13 pm by admin

twice :: (a -> a) -> a -> a
twice f = (\x -> f (f x)) |

twice :: (a -> a) -> a -> a
twice f = (\x -> f (f x))

`twice twice` applies the function 4 times:

twice twice f
= twice (\y -> f (f y))
= (\x -> (\y -> f (f y)) ((\y -> f (f y)) x))
= (\x -> (\y -> f (f y)) (f (f x)))
= (\x -> f (f (f (f x)))) |

twice twice f
= twice (\y -> f (f y))
= (\x -> (\y -> f (f y)) ((\y -> f (f y)) x))
= (\x -> (\y -> f (f y)) (f (f x)))
= (\x -> f (f (f (f x))))

`twice twice twice` and `twice (twice twice)` each apply the function 16 times.

Permalink

Posted in Uncategorized at 10:52 pm by admin

appendr = foldr (flip (++)) []
appendr [x,y,z]
= foldr (flip (++)) [] [x,y,z]
= flip (++) x (flip (++) y (flip (++) z []))
= flip (++) x (flip (++) y ([] ++ z))
= flip (++) x (([] ++ z) ++ y)
= (([] ++ z) ++ y) ++ x |

appendr = foldr (flip (++)) []
appendr [x,y,z]
= foldr (flip (++)) [] [x,y,z]
= flip (++) x (flip (++) y (flip (++) z []))
= flip (++) x (flip (++) y ([] ++ z))
= flip (++) x (([] ++ z) ++ y)
= (([] ++ z) ++ y) ++ x

Running time of `appendr` is O(n^{2}) since `(++)` traverses the length of its first argument.

appendl = foldl (flip (++)) []
appendl [x,y,z]
= foldl (flip (++)) [] [x,y,z]
= flip (++) (flip (++) (flip (++) [] x) y) z
= flip (++) (flip (++) (x ++ []) y) z
= flip (++) (y ++ (x ++ [])) z
= z ++ (y ++ (x ++ [])) |

appendl = foldl (flip (++)) []
appendl [x,y,z]
= foldl (flip (++)) [] [x,y,z]
= flip (++) (flip (++) (flip (++) [] x) y) z
= flip (++) (flip (++) (x ++ []) y) z
= flip (++) (y ++ (x ++ [])) z
= z ++ (y ++ (x ++ []))

Running time of `appendl` is O(n).

(Technical error 16 applies to this exercise.)

Permalink

Posted in Uncategorized at 10:35 pm by admin

applyAll :: [(a -> a)] -> a -> a
applyAll [] x = x
applyAll (f:fs) x = f (applyAll fs x) |

applyAll :: [(a -> a)] -> a -> a
applyAll [] x = x
applyAll (f:fs) x = f (applyAll fs x)

Permalink

Posted in Uncategorized at 10:34 pm by admin

applyEach :: [(a -> b)] -> a -> [b]
applyEach [] _ = []
applyEach (f:fs) x = f x : applyEach fs x |

applyEach :: [(a -> b)] -> a -> [b]
applyEach [] _ = []
applyEach (f:fs) x = f x : applyEach fs x

Permalink

Posted in Uncategorized at 10:30 pm by admin

flip f x y = f y x
flip (flip f) x y
= flip f y x
= f x y
∴ flip (flip f) = f |

flip f x y = f y x
flip (flip f) x y
= flip f y x
= f x y
∴ flip (flip f) = f

Permalink

Posted in Uncategorized at 10:25 pm by admin

(Polygon pts) `containsS` p
= let leftOfList = map isLeftOfp
(zip pts (tail pts ++ [head pts]))
isLeftOfp = isLeftOf p
in and leftOfList |

(Polygon pts) `containsS` p
= let leftOfList = map isLeftOfp
(zip pts (tail pts ++ [head pts]))
isLeftOfp = isLeftOf p
in and leftOfList

Permalink

# 08.07.07

Posted in Uncategorized at 11:25 pm by admin

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)) |

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 |

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 |

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') |

(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 |

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) |

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)

Permalink

# 08.05.07

Posted in Uncategorized at 9:26 pm by admin

There are a couple of ways to do this (the basic problem being how to deal with concave polygons). One way is to convert the polygon to a convex hull and a list of triangles representing subtractions from the convex hull, then check containment within the hull and non-containment within the triangles. However, I present a simpler way: pick a point guaranteed not to be in the polygon, form the ray between that and the point in question, and count the number of times that ray crosses the polygon sides. If it’s even, the point is outside the polygon. This method also works for self-crossing polygons (provided that one considers any internal spaces formed as outside the polygon: consider a pentagram for example).

raysCross :: Ray -> Ray -> Bool
raysCross (a,b) (x,y) = let h = isLeftOf x (a,b) && isRightOf y (a,b)
i = isLeftOf y (a,b) && isRightOf x (a,b)
j = isLeftOf a (x,y) && isRightOf b (x,y)
k = isLeftOf b (x,y) && isRightOf a (x,y)
in (h || i) && (j || k)
countCrossings :: Ray -> [Ray] -> Int
countCrossings r rs = foldl (+) 0
(map (\x -> if raysCross r x then 1 else 0) rs)
guaranteedOutside :: [Vertex] -> Vertex
guaranteedOutside vs
= (foldl maxop 0 xs + 1, foldl maxop 0 ys + 1)
where (xs, ys) = unzip vs
maxop a b = if a > b then a else b
containsS' :: Shape -> Coordinate -> Bool
(Polygon ps) `containsS'` p
= let poutside = guaranteedOutside ps
in (countCrossings (p,poutside)
(zip ps (tail ps ++ [head ps]))) `mod` 2 == 1 |

raysCross :: Ray -> Ray -> Bool
raysCross (a,b) (x,y) = let h = isLeftOf x (a,b) && isRightOf y (a,b)
i = isLeftOf y (a,b) && isRightOf x (a,b)
j = isLeftOf a (x,y) && isRightOf b (x,y)
k = isLeftOf b (x,y) && isRightOf a (x,y)
in (h || i) && (j || k)
countCrossings :: Ray -> [Ray] -> Int
countCrossings r rs = foldl (+) 0
(map (\x -> if raysCross r x then 1 else 0) rs)
guaranteedOutside :: [Vertex] -> Vertex
guaranteedOutside vs
= (foldl maxop 0 xs + 1, foldl maxop 0 ys + 1)
where (xs, ys) = unzip vs
maxop a b = if a > b then a else b
containsS' :: Shape -> Coordinate -> Bool
(Polygon ps) `containsS'` p
= let poutside = guaranteedOutside ps
in (countCrossings (p,poutside)
(zip ps (tail ps ++ [head ps]))) `mod` 2 == 1

See Exercise 8.4 for definitions of `isLeftOf` and `isRightOf`. I am also left feeling that there must be a more elegant way to count the number of list elements that fulfil a predicate (which is what `countCrossings` is really doing).

Permalink

# 08.03.07

Posted in Uncategorized at 10:37 pm by admin

See Exercises 2.4 and 5.1. Then:

area'' :: Shape -> Float
area'' (Polygon (v1:vs)) = if convex (Polygon (v1:vs))
then let areas = map ((v2, v3) -> triArea v1 v2 v3)
(zip vs (tail vs))
in foldl (+) 0 areas
else error "Non-convex polygon" |

area'' :: Shape -> Float
area'' (Polygon (v1:vs)) = if convex (Polygon (v1:vs))
then let areas = map ((v2, v3) -> triArea v1 v2 v3)
(zip vs (tail vs))
in foldl (+) 0 areas
else error "Non-convex polygon"

Permalink