На последнее задание (13-е) угробил несколько часов. Требовалось написать алгоритм построения выпуклой оболочки по Грэхему. Код жуткий, но работает =)))
import Data.List (sortBy, minimumBy) -- 10 -- data Direction = DirLeft | DirRight | DirStraight deriving (Eq, Show) data Point = Point { xcoord :: Double, ycoord :: Double } deriving (Eq, Show) minus (Point x1 y1) (Point x2 y2) = Point (x1-x2) (y1-y2) cross (Point x1 y1) (Point x2 y2) = x1*y2 - x2*y1 -- 11 -- dirTriple :: Point -> Point -> Point -> Direction dirTriple a b c | crossprod < 0 = DirRight | crossprod > 0 = DirLeft | otherwise = DirStraight where crossprod = (b `minus` a) `cross` (c `minus` b) -- 12 -- dirListTriple :: [Point] -> [Direction] dirListTriple (x:y:z:xs) = [dirTriple x y z] ++ dirListTriple (y:z:xs) dirListTriple _ = [] -- 13 -- comparePointsByPos (Point x1 y1) (Point x2 y2) | cmpYResult == EQ = compare x1 x2 | otherwise = cmpYResult where cmpYResult = compare y1 y2 mostBottomLeft x = minimumBy comparePointsByPos x sortByAngle p ps = p: (sortBy cmpByAngle (filter isNotMin ps)) ++ [p] where findCos x = (xcoord x - xcoord p)/(sqrt (distSqPoints p x)) distSqPoints (Point x1 y1) (Point x2 y2) = (x2-x1)**2+(y2-y1)**2 isNotMin x = x/=p cmpByAngle a b | cmpCosRes /= EQ = cmpCosRes | otherwise = compare (distSqPoints p a) (distSqPoints p b) where cmpCosRes = compare (findCos b) (findCos a) sortPoints ps = sortByAngle p ps where p = mostBottomLeft ps convexHull a = init (reverse (__convexHull (reverse (take 2 zs)) (drop 2 zs))) where zs = sortPoints a __convexHull (t1:t2:ts) (x:xs) | dirTriple t2 t1 x == DirRight = __convexHull (t2:ts) (x:xs) | otherwise = __convexHull (x:t1:t2:ts) xs __convexHull ys _ = ys -------------------------------------------------------------------------------- plist = [(Point 100 50), (Point 110 70), (Point 110 40), (Point 112 55), (Point 120 100), (Point 125 70), (Point 128 10), (Point 129 50), (Point 139 91), (Point 140 45), (Point 145 75), (Point 150 60), (Point 160 35), (Point 165 45), (Point 170 45), (Point 180 60), (Point 200 30), (Point 210 55)] main = putStr (show (convexHull plist))
No comments:
Post a Comment