diff --git a/Algebra/Polygon.hs b/Algebra/Polygon.hs index 3b1d5e3..c8bdb93 100644 --- a/Algebra/Polygon.hs +++ b/Algebra/Polygon.hs @@ -10,9 +10,9 @@ import MyPrelude -- |Split a polygon by a given segment which must be vertices of the -- polygon (returns empty array otherwise). -splitPoly :: [P2] - -> (P2, P2) - -> [[P2]] +splitPoly :: [P2 Double] + -> (P2 Double, P2 Double) + -> [[P2 Double]] splitPoly pts (a, b) | elem a pts && elem b pts = [b : takeWhile (/= b) shiftedPoly, a : dropWhile (/= b) shiftedPoly] @@ -22,7 +22,7 @@ splitPoly pts (a, b) -- |Get all edges of a polygon. -polySegments :: [P2] -> [(P2, P2)] +polySegments :: [P2 Double] -> [(P2 Double, P2 Double)] polySegments p@(x':_:_:_) = go p ++ [(last p, x')] where go (x:y:xs) = (x, y) : go (y:xs) @@ -33,7 +33,7 @@ polySegments _ = [] -- |Check whether the given segment is inside the polygon. -- This doesn't check for segments that are completely outside -- of the polygon yet. -isInsidePoly :: [P2] -> (P2, P2) -> Bool +isInsidePoly :: [P2 Double] -> (P2 Double, P2 Double) -> Bool isInsidePoly pts seg = null . catMaybes @@ -42,21 +42,21 @@ isInsidePoly pts seg = -- |Check whether two points are adjacent vertices of a polygon. -adjacent :: P2 -> P2 -> [P2] -> Bool +adjacent :: P2 Double -> P2 Double -> [P2 Double] -> Bool adjacent u v = any (\x -> x == (u, v) || x == (v, u)) . polySegments -- |Check whether the polygon is a triangle polygon. -isTrianglePoly :: [P2] -> Bool +isTrianglePoly :: [P2 Double] -> Bool isTrianglePoly [_, _, _] = True isTrianglePoly _ = False -- |Get all triangle polygons. -triangleOnly :: [[P2]] -> [[P2]] +triangleOnly :: [[P2 Double]] -> [[P2 Double]] triangleOnly = filter isTrianglePoly -- |Get all non-triangle polygons. -nonTriangleOnly :: [[P2]] -> [[P2]] +nonTriangleOnly :: [[P2 Double]] -> [[P2 Double]] nonTriangleOnly = filter (not . isTrianglePoly) diff --git a/Algebra/Vector.hs b/Algebra/Vector.hs index 12934dd..4a3e239 100644 --- a/Algebra/Vector.hs +++ b/Algebra/Vector.hs @@ -30,8 +30,8 @@ dimToSquare (x1, x2) (y1, y2) = ((x1, y1), (x2, y2)) -- |Checks whether the Point is in a given Square. inRange :: ((Double, Double), (Double, Double)) -- ^ the square: ((xmin, ymin), (xmax, ymax)) - -> P2 -- ^ Coordinate - -> Bool -- ^ result + -> P2 Double -- ^ Coordinate + -> Bool -- ^ result inRange ((xmin, ymin), (xmax, ymax)) (coords -> x :& y) = x >= min xmin xmax && x <= max xmin xmax @@ -40,7 +40,7 @@ inRange ((xmin, ymin), (xmax, ymax)) (coords -> x :& y) -- |Get the angle between two vectors. -getAngle :: R2 -> R2 -> Double +getAngle :: V2 Double -> V2 Double -> Double getAngle a b = acos . flip (/) (vecLength a * vecLength b) @@ -49,50 +49,50 @@ getAngle a b = -- |Get the length of a vector. -vecLength :: R2 -> Double +vecLength :: V2 Double -> Double vecLength v = sqrt (x^(2 :: Int) + y^(2 :: Int)) where (x, y) = unr2 v -- |Compute the scalar product of two vectors. -scalarProd :: R2 -> R2 -> Double -scalarProd (R2 a1 a2) (R2 b1 b2) = a1 * b1 + a2 * b2 +scalarProd :: V2 Double -> V2 Double -> Double +scalarProd (V2 a1 a2) (V2 b1 b2) = a1 * b1 + a2 * b2 -- |Multiply a scalar with a vector. -scalarMul :: Double -> R2 -> R2 -scalarMul d (R2 a b) = R2 (a * d) (b * d) +scalarMul :: Double -> V2 Double -> V2 Double +scalarMul d (V2 a b) = V2 (a * d) (b * d) -- |Construct a vector that points to a point from the origin. -pt2Vec :: P2 -> R2 +pt2Vec :: P2 Double -> V2 Double pt2Vec = r2 . unp2 -- |Give the point which is at the coordinates the vector -- points to from the origin. -vec2Pt :: R2 -> P2 +vec2Pt :: V2 Double -> P2 Double vec2Pt = p2 . unr2 -- |Construct a vector between two points. -vp2 :: P2 -- ^ vector origin - -> P2 -- ^ vector points here - -> R2 +vp2 :: P2 Double -- ^ vector origin + -> P2 Double -- ^ vector points here + -> V2 Double vp2 a b = pt2Vec b - pt2Vec a -- |Computes the determinant of 3 points. -det :: P2 -> P2 -> P2 -> Double +det :: P2 Double -> P2 Double -> P2 Double -> Double det (coords -> ax :& ay) (coords -> bx :& by) (coords -> cx :& cy) = (bx - ax) * (cy - ay) - (by - ay) * (cx - ax) -- |Get the point where two lines intesect, if any. -intersectSeg' :: (P2, P2) -- ^ first segment - -> (P2, P2) -- ^ second segment - -> Maybe P2 +intersectSeg' :: (P2 Double, P2 Double) -- ^ first segment + -> (P2 Double, P2 Double) -- ^ second segment + -> Maybe (P2 Double) intersectSeg' (a, b) (c, d) = glossToPt <$> intersectSegSeg (ptToGloss a) (ptToGloss b) @@ -105,7 +105,7 @@ intersectSeg' (a, b) (c, d) = -- |Get the point where two lines intesect, if any. Excludes the -- case of end-points intersecting. -intersectSeg'' :: (P2, P2) -> (P2, P2) -> Maybe P2 +intersectSeg'' :: (P2 Double, P2 Double) -> (P2 Double, P2 Double) -> Maybe (P2 Double) intersectSeg'' (a, b) (c, d) = case intersectSeg' (a, b) (c, d) of Just x -> if x `notElem` [a,b,c,d] then Just a else Nothing Nothing -> Nothing @@ -115,7 +115,7 @@ intersectSeg'' (a, b) (c, d) = case intersectSeg' (a, b) (c, d) of -- * clock-wise -- * counter-clock-wise -- * collinear -getOrient :: P2 -> P2 -> P2 -> Alignment +getOrient :: P2 Double -> P2 Double -> P2 Double -> Alignment getOrient a b c = case compare (det a b c) 0 of LT -> CW GT -> CCW @@ -125,7 +125,7 @@ getOrient a b c = case compare (det a b c) 0 of --- |Checks if 3 points a,b,c do not build a clockwise triangle by --- connecting a-b-c. This is done by computing the determinant and --- checking the algebraic sign. -notcw :: P2 -> P2 -> P2 -> Bool +notcw :: P2 Double -> P2 Double -> P2 Double -> Bool notcw a b c = case getOrient a b c of CW -> False _ -> True @@ -134,22 +134,22 @@ notcw a b c = case getOrient a b c of --- |Checks if 3 points a,b,c do build a clockwise triangle by --- connecting a-b-c. This is done by computing the determinant and --- checking the algebraic sign. -cw :: P2 -> P2 -> P2 -> Bool +cw :: P2 Double -> P2 Double -> P2 Double -> Bool cw a b c = not . notcw a b $ c -- |Sort X and Y coordinates lexicographically. -sortedXY :: [P2] -> [P2] +sortedXY :: [P2 Double] -> [P2 Double] sortedXY = fmap p2 . sortLex . fmap unp2 -- |Sort Y and X coordinates lexicographically. -sortedYX :: [P2] -> [P2] +sortedYX :: [P2 Double] -> [P2 Double] sortedYX = fmap p2 . sortLexSwapped . fmap unp2 -- |Sort all points according to their X-coordinates only. -sortedX :: [P2] -> [P2] +sortedX :: [P2 Double] -> [P2 Double] sortedX xs = fmap p2 . sortBy (\(a1, _) (a2, _) -> compare a1 a2) @@ -157,7 +157,7 @@ sortedX xs = -- |Sort all points according to their Y-coordinates only. -sortedY :: [P2] -> [P2] +sortedY :: [P2 Double] -> [P2 Double] sortedY xs = fmap p2 . sortBy (\(_, b1) (_, b2) -> compare b1 b2) @@ -165,25 +165,25 @@ sortedY xs = -- |Apply a function on the coordinates of a point. -onPT :: ((Double, Double) -> (Double, Double)) -> P2 -> P2 +onPT :: ((Double, Double) -> (Double, Double)) -> P2 Double -> P2 Double onPT f = p2 . f . unp2 -- |Compare the y-coordinate of two points. -ptCmpY :: P2 -> P2 -> Ordering +ptCmpY :: P2 Double -> P2 Double -> Ordering ptCmpY (coords -> _ :& y1) (coords -> _ :& y2) = compare y1 y2 -- |Compare the x-coordinate of two points. -ptCmpX :: P2 -> P2 -> Ordering +ptCmpX :: P2 Double -> P2 Double -> Ordering ptCmpX (coords -> x1 :& _) (coords -> x2 :& _) = compare x1 x2 -posInfPT :: P2 +posInfPT :: P2 Double posInfPT = p2 (read "Infinity", read "Infinity") -negInfPT :: P2 +negInfPT :: P2 Double negInfPT = p2 (negate . read $ "Infinity", negate . read $ "Infinity") diff --git a/Algorithms/GrahamScan.hs b/Algorithms/GrahamScan.hs index d394fae..11777c0 100644 --- a/Algorithms/GrahamScan.hs +++ b/Algorithms/GrahamScan.hs @@ -75,18 +75,18 @@ ys = [] return [(100, 100), (400, 200)] ========================================================= --} -grahamCH :: [P2] -> [P2] +grahamCH :: [P2 Double] -> [P2 Double] grahamCH vs = grahamUCH vs ++ (tailInit . grahamLCH $ vs) -- |Get the lower part of the convex hull. -grahamLCH :: [P2] -> [P2] +grahamLCH :: [P2 Double] -> [P2 Double] grahamLCH vs = uncurry (\x y -> last . scanH x $ y) (first reverse . splitAt 3 . sortedXY $ vs) -- |Get the upper part of the convex hull. -grahamUCH :: [P2] -> [P2] +grahamUCH :: [P2 Double] -> [P2 Double] grahamUCH vs = uncurry (\x y -> last . scanH x $ y) (first reverse . splitAt 3 . reverse . sortedXY $ vs) @@ -96,9 +96,9 @@ grahamUCH vs = uncurry (\x y -> last . scanH x $ y) -- If it's the upper or lower half depends on the input. -- Also, the first list is expected to be reversed since we only care -- about the last 3 elements and want to stay efficient. -scanH :: [P2] -- ^ the first 3 starting points in reversed order - -> [P2] -- ^ the rest of the points - -> [[P2]] -- ^ all convex hull points iterations for the half +scanH :: [P2 Double] -- ^ the first 3 starting points in reversed order + -> [P2 Double] -- ^ the rest of the points + -> [[P2 Double]] -- ^ all convex hull points iterations for the half scanH hs@(x:y:z:xs) (r':rs') | notcw z y x = hs : scanH (r':hs) rs' | otherwise = hs : scanH (x:z:xs) (r':rs') @@ -112,12 +112,12 @@ scanH hs _ = [hs] -- |Compute all steps of the graham scan algorithm to allow -- visualizing it. -- Whether the upper or lower hull is computed depends on the input. -grahamCHSteps :: Int -> [P2] -> [P2] -> [[P2]] +grahamCHSteps :: Int -> [P2 Double] -> [P2 Double] -> [[P2 Double]] grahamCHSteps c xs' ys' = take c . scanH xs' $ ys' -- |Get all iterations of the upper hull of the graham scan algorithm. -grahamUHSteps :: [P2] -> [[P2]] +grahamUHSteps :: [P2 Double] -> [[P2 Double]] grahamUHSteps vs = (++) [getLastX 2 . sortedXY $ vs] . rmdups @@ -128,7 +128,7 @@ grahamUHSteps vs = -- |Get all iterations of the lower hull of the graham scan algorithm. -grahamLHSteps :: [P2] -> [[P2]] +grahamLHSteps :: [P2 Double] -> [[P2 Double]] grahamLHSteps vs = (++) [take 2 . sortedXY $ vs] . rmdups diff --git a/Algorithms/KDTree.hs b/Algorithms/KDTree.hs index 7d7b35f..682acc9 100644 --- a/Algorithms/KDTree.hs +++ b/Algorithms/KDTree.hs @@ -42,9 +42,9 @@ instance Not Direction where -- |Construct a kd-tree from a list of points in O(n log n). -kdTree :: [P2] -- ^ list of points to construct the kd-tree from +kdTree :: [P2 Double] -- ^ list of points to construct the kd-tree from -> Direction -- ^ initial direction of the root-node - -> KDTree P2 -- ^ resulting kd-tree + -> KDTree (P2 Double) -- ^ resulting kd-tree kdTree xs' = go (sortedX xs') (sortedY xs') where go [] _ _ = KTNil @@ -67,10 +67,10 @@ kdTree xs' = go (sortedX xs') (sortedY xs') -- If you want to partition against the pivot of X, then you pass -- partition' (pivot xs) (ys, xs) -- and get ((y1, y2), (x1, x2)). -partition' :: P2 -- ^ the pivot to partition against - -> (P2 -> P2 -> Ordering) -- ^ ptCmpY or ptCmpX - -> ([P2], [P2]) -- ^ both lists (X, Y) or (Y, X) - -> (([P2], [P2]), ([P2], [P2])) -- ^ ((x1, x2), (y1, y2)) or +partition' :: P2 Double -- ^ the pivot to partition against + -> (P2 Double -> P2 Double -> Ordering) -- ^ ptCmpY or ptCmpX + -> ([P2 Double], [P2 Double]) -- ^ both lists (X, Y) or (Y, X) + -> (([P2 Double], [P2 Double]), ([P2 Double], [P2 Double])) -- ^ ((x1, x2), (y1, y2)) or -- ((y1, y2), (x1, x2)) partition' piv cmp' (xs, ys) = ((x1, x2), (y1, y2)) where @@ -83,16 +83,16 @@ partition' piv cmp' (xs, ys) = ((x1, x2), (y1, y2)) -- |Partition two sorted lists of points X and Y against the pivot of -- Y. This function is unsafe as it does not check if there is a valid -- pivot. -partitionY :: ([P2], [P2]) -- ^ both lists (X, Y) - -> (([P2], [P2]), ([P2], [P2])) -- ^ ((x1, x2), (y1, y2)) +partitionY :: ([P2 Double], [P2 Double]) -- ^ both lists (X, Y) + -> (([P2 Double], [P2 Double]), ([P2 Double], [P2 Double])) -- ^ ((x1, x2), (y1, y2)) partitionY (xs, ys) = partition' (fromJust . pivot $ ys) ptCmpY (xs, ys) -- |Partition two sorted lists of points X and Y against the pivot of -- X. This function is unsafe as it does not check if there is a valid -- pivot. -partitionX :: ([P2], [P2]) -- ^ both lists (X, Y) - -> (([P2], [P2]), ([P2], [P2])) -- ^ ((x1, x2), (y1, y2)) +partitionX :: ([P2 Double], [P2 Double]) -- ^ both lists (X, Y) + -> (([P2 Double], [P2 Double]), ([P2 Double], [P2 Double])) -- ^ ((x1, x2), (y1, y2)) partitionX (xs, ys) = (\(x, y) -> (y, x)) . partition' (fromJust . pivot $ xs) ptCmpX $ (ys, xs) @@ -100,9 +100,9 @@ partitionX (xs, ys) = (\(x, y) -> (y, x)) -- |Execute a range search in O(log n). It returns a tuple -- of the points found in the range and also gives back a pretty -- rose tree suitable for printing. -rangeSearch :: KDTree P2 -- ^ tree to search in +rangeSearch :: KDTree (P2 Double) -- ^ tree to search in -> ((Double, Double), (Double, Double)) -- ^ square describing the range - -> ([P2], Tree String) + -> ([P2 Double], Tree String) rangeSearch kd' sq' = (goPt kd' sq', goTree kd' sq' True) where -- either y1 or x1 depending on the orientation @@ -112,7 +112,7 @@ rangeSearch kd' sq' = (goPt kd' sq', goTree kd' sq' True) -- either the second or first of the tuple, depending on the orientation cur' dir = if' (dir == Vertical) snd fst -- All points in the range. - goPt :: KDTree P2 -> ((Double, Double), (Double, Double)) -> [P2] + goPt :: KDTree (P2 Double) -> ((Double, Double), (Double, Double)) -> [P2 Double] goPt KTNil _ = [] goPt (KTNode ln pt dir rn) sq = [pt | inRange sq pt] @@ -124,7 +124,7 @@ rangeSearch kd' sq' = (goPt kd' sq', goTree kd' sq' True) (goPt rn sq) []) -- A pretty rose tree suitable for printing. - goTree :: KDTree P2 -> ((Double, Double), (Double, Double)) -> Bool -> Tree String + goTree :: KDTree (P2 Double) -> ((Double, Double), (Double, Double)) -> Bool -> Tree String goTree KTNil _ _ = Node "nil" [] goTree (KTNode ln pt dir rn) sq vis | ln == KTNil && rn == KTNil = Node treeText [] @@ -181,7 +181,7 @@ getDirection _ = Nothing -- |Convert a kd-tree to a rose tree, for pretty printing. -kdTreeToRoseTree :: KDTree P2 -> Tree String +kdTreeToRoseTree :: KDTree (P2 Double) -> Tree String kdTreeToRoseTree (KTNil) = Node "nil" [] kdTreeToRoseTree (KTNode ln val _ rn) = Node (show . unp2 $ val) [kdTreeToRoseTree ln, kdTreeToRoseTree rn] diff --git a/Algorithms/PolygonIntersection.hs b/Algorithms/PolygonIntersection.hs index 85998d3..33305b8 100644 --- a/Algorithms/PolygonIntersection.hs +++ b/Algorithms/PolygonIntersection.hs @@ -18,14 +18,14 @@ import QueueEx -- successor are saved for convenience. data PolyPT = PolyA { - id' :: P2 - , pre :: P2 - , suc :: P2 + id' :: P2 Double + , pre :: P2 Double + , suc :: P2 Double } | PolyB { - id' :: P2 - , pre :: P2 - , suc :: P2 + id' :: P2 Double + , pre :: P2 Double + , suc :: P2 Double } deriving (Show, Eq) @@ -42,7 +42,7 @@ isPolyB = not . isPolyA -- |Shift a list of sorted convex hull points of a polygon so that -- the first element in the list is the one with the highest y-coordinate. -- This is done in O(n). -sortLexPoly :: [P2] -> [P2] +sortLexPoly :: [P2 Double] -> [P2 Double] sortLexPoly ps = maybe [] (`shiftM` ps) (elemIndex (yMax ps) ps) where yMax = foldl1 (\x y -> if ptCmpY x y == GT then x else y) @@ -50,8 +50,8 @@ sortLexPoly ps = maybe [] (`shiftM` ps) (elemIndex (yMax ps) ps) -- |Make a PolyPT list out of a regular list of points, so -- the predecessor and successors are all saved. -mkPolyPTList :: (P2 -> P2 -> P2 -> PolyPT) -- ^ PolyA or PolyB function - -> [P2] -- ^ polygon points +mkPolyPTList :: (P2 Double -> P2 Double -> P2 Double -> PolyPT) -- ^ PolyA or PolyB function + -> [P2 Double] -- ^ polygon points -> [PolyPT] mkPolyPTList f' pts@(x':y':_:_) = f' x' (last pts) y' : go f' pts @@ -64,7 +64,7 @@ mkPolyPTList _ _ = [] -- |Sort the points of two polygons according to their y-coordinates, -- while saving the origin of that point. This is done in O(n). -sortLexPolys :: ([P2], [P2]) -> [PolyPT] +sortLexPolys :: ([P2 Double], [P2 Double]) -> [PolyPT] sortLexPolys (pA'@(_:_), pB'@(_:_)) = queueToList $ go (Q.fromList . mkPolyPTList PolyA . sortLexPoly $ pA') (Q.fromList . mkPolyPTList PolyB . sortLexPoly $ pB') @@ -104,7 +104,7 @@ sortLexPolys _ = [] -- |Get all points that intersect between both polygons. This is done -- in O(n). -intersectionPoints :: [PolyPT] -> [P2] +intersectionPoints :: [PolyPT] -> [P2 Double] intersectionPoints xs' = rmdups . go $ xs' where go [] = [] @@ -113,7 +113,7 @@ intersectionPoints xs' = rmdups . go $ xs' -- Get the scan line or in other words the -- Segment pairs we are going to check for intersection. - scanLine :: [PolyPT] -> ([(P2, P2)], [(P2, P2)]) + scanLine :: [PolyPT] -> ([(P2 Double, P2 Double)], [(P2 Double, P2 Double)]) scanLine sp@(_:_) = (,) (getSegment isPolyA) (getSegment isPolyB) where getSegment f = fromMaybe [] @@ -124,7 +124,7 @@ intersectionPoints xs' = rmdups . go $ xs' -- Gets the actual intersections between the segments of -- both polygons we currently examine. This is done in O(1) -- since we have max 4 segments. - segIntersections :: ([(P2, P2)], [(P2, P2)]) -> [P2] + segIntersections :: ([(P2 Double, P2 Double)], [(P2 Double, P2 Double)]) -> [P2 Double] segIntersections (a@(_:_), b@(_:_)) = catMaybes . fmap (\[x, y] -> intersectSeg' x y) diff --git a/Algorithms/PolygonTriangulation.hs b/Algorithms/PolygonTriangulation.hs index 5c34295..fc7d9cd 100644 --- a/Algorithms/PolygonTriangulation.hs +++ b/Algorithms/PolygonTriangulation.hs @@ -19,12 +19,12 @@ data VCategory = VStart -- |Classify all vertices on a polygon into five categories (see VCategory). -classifyList :: [P2] -> [(P2, VCategory)] +classifyList :: [P2 Double] -> [(P2 Double, VCategory)] classifyList p@(x:y:_:_) = -- need to handle the first and last element separately [classify (last p) x y] ++ go p ++ [classify (last . init $ p) (last p) x] where - go :: [P2] -> [(P2, VCategory)] + go :: [P2 Double] -> [(P2 Double, VCategory)] go (x':y':z':xs) = classify x' y' z' : go (y':z':xs) go _ = [] classifyList _ = [] @@ -32,10 +32,10 @@ classifyList _ = [] -- |Classify a vertex on a polygon given it's next and previous vertex -- into five categories (see VCategory). -classify :: P2 -- ^ prev vertex - -> P2 -- ^ classify this one - -> P2 -- ^ next vertex - -> (P2, VCategory) +classify :: P2 Double -- ^ prev vertex + -> P2 Double -- ^ classify this one + -> P2 Double -- ^ next vertex + -> (P2 Double, VCategory) classify prev v next | isVStart prev v next = (v, VStart) | isVSplit prev v next = (v, VSplit) @@ -46,9 +46,9 @@ classify prev v next -- |Whether the vertex, given it's next and previous vertex, -- is a start vertex. -isVStart :: P2 -- ^ previous vertex - -> P2 -- ^ vertice to check - -> P2 -- ^ next vertex +isVStart :: P2 Double -- ^ previous vertex + -> P2 Double -- ^ vertice to check + -> P2 Double -- ^ next vertex -> Bool isVStart prev v next = ptCmpY next v == LT && ptCmpY prev v == LT && cw next v prev @@ -56,9 +56,9 @@ isVStart prev v next = -- |Whether the vertex, given it's next and previous vertex, -- is a split vertex. -isVSplit :: P2 -- ^ previous vertex - -> P2 -- ^ vertice to check - -> P2 -- ^ next vertex +isVSplit :: P2 Double -- ^ previous vertex + -> P2 Double -- ^ vertice to check + -> P2 Double -- ^ next vertex -> Bool isVSplit prev v next = ptCmpY prev v == LT && ptCmpY next v == LT && cw prev v next @@ -66,9 +66,9 @@ isVSplit prev v next = -- |Whether the vertex, given it's next and previous vertex, -- is an end vertex. -isVEnd :: P2 -- ^ previous vertex - -> P2 -- ^ vertice to check - -> P2 -- ^ next vertex +isVEnd :: P2 Double -- ^ previous vertex + -> P2 Double -- ^ vertice to check + -> P2 Double -- ^ next vertex -> Bool isVEnd prev v next = ptCmpY prev v == GT && ptCmpY next v == GT && cw next v prev @@ -76,9 +76,9 @@ isVEnd prev v next = -- |Whether the vertex, given it's next and previous vertex, -- is a merge vertex. -isVMerge :: P2 -- ^ previous vertex - -> P2 -- ^ vertice to check - -> P2 -- ^ next vertex +isVMerge :: P2 Double -- ^ previous vertex + -> P2 Double -- ^ vertice to check + -> P2 Double -- ^ next vertex -> Bool isVMerge prev v next = ptCmpY next v == GT && ptCmpY prev v == GT && cw prev v next @@ -86,9 +86,9 @@ isVMerge prev v next = -- |Whether the vertex, given it's next and previous vertex, -- is a regular vertex. -isVRegular :: P2 -- ^ previous vertex - -> P2 -- ^ vertice to check - -> P2 -- ^ next vertex +isVRegular :: P2 Double -- ^ previous vertex + -> P2 Double -- ^ vertice to check + -> P2 Double -- ^ next vertex -> Bool isVRegular prev v next = (not . isVStart prev v $ next) @@ -99,7 +99,7 @@ isVRegular prev v next = -- |A polygon P is y-monotone, if it has no split and merge vertices. -isYmonotone :: [P2] -> Bool +isYmonotone :: [P2 Double] -> Bool isYmonotone poly = not . any (\x -> x == VSplit || x == VMerge) @@ -108,12 +108,12 @@ isYmonotone poly = -- |Partition P into y-monotone pieces. -monotonePartitioning :: [P2] -> [[P2]] +monotonePartitioning :: [P2 Double] -> [[P2 Double]] monotonePartitioning pts | isYmonotone pts = [pts] | otherwise = go (monotoneDiagonals pts) pts where - go :: [(P2, P2)] -> [P2] -> [[P2]] + go :: [(P2 Double, P2 Double)] -> [P2 Double] -> [[P2 Double]] go (x:xs) pts'@(_:_) | isYmonotone a && isYmonotone b = [a, b] | isYmonotone b = b : go xs a @@ -125,37 +125,37 @@ monotonePartitioning pts -- |Try to eliminate the merge and split vertices by computing the -- diagonals we have to use for splitting the polygon. -monotoneDiagonals :: [P2] -> [(P2, P2)] +monotoneDiagonals :: [P2 Double] -> [(P2 Double, P2 Double)] monotoneDiagonals pts = catMaybes . go $ classifyList pts where - go :: [(P2, VCategory)] -> [Maybe (P2, P2)] + go :: [(P2 Double, VCategory)] -> [Maybe (P2 Double, P2 Double)] go (x:xs) = case snd x of VMerge -> getSeg (belowS . fst $ x) (fst x) : go xs VSplit -> getSeg (aboveS . fst $ x) (fst x) : go xs _ -> [] ++ go xs go [] = [] - getSeg :: [P2] -- all points above/below the current point - -> P2 -- current point - -> Maybe (P2, P2) + getSeg :: [P2 Double] -- all points above/below the current point + -> P2 Double -- current point + -> Maybe (P2 Double, P2 Double) getSeg [] _ = Nothing getSeg (z:zs) pt | isInsidePoly pts (z, pt) = Just (z, pt) | otherwise = getSeg zs pt - aboveS :: P2 -> [P2] + aboveS :: P2 Double -> [P2 Double] aboveS pt = tail . dropWhile (/= pt) $ sortedYX pts - belowS :: P2 -> [P2] + belowS :: P2 Double -> [P2 Double] belowS pt = reverse . takeWhile (/= pt) $ sortedYX pts -- |Triangulate a y-monotone polygon. -triangulate :: [P2] -> [[P2]] +triangulate :: [P2 Double] -> [[P2 Double]] triangulate pts = go pts . A.first reverse . splitAt 3 . reverse . sortedYX $ pts where - go :: [P2] -- current polygon - -> ([P2], [P2]) -- (stack of visited vertices, rest) + go :: [P2 Double] -- current polygon + -> ([P2 Double], [P2 Double]) -- (stack of visited vertices, rest) -- sorted by Y-coordinate - -> [[P2]] + -> [[P2 Double]] go xs (p@[_, _], r:rs) = go xs (r:p, rs) go xs (p@(u:vi:vi1:ys), rs) -- case 1 and 3 diff --git a/Algorithms/QuadTree.hs b/Algorithms/QuadTree.hs index 19b5723..08669bf 100644 --- a/Algorithms/QuadTree.hs +++ b/Algorithms/QuadTree.hs @@ -80,9 +80,9 @@ isSEchild _ = False -- |Builds a quadtree of a list of points which recursively divides up 2D -- space into quadrants, so that every leaf-quadrant stores either zero or one -- point. -quadTree :: [P2] -- ^ the points to divide +quadTree :: [P2 Double] -- ^ the points to divide -> ((Double, Double), (Double, Double)) -- ^ the initial square around the points - -> QuadTree P2 -- ^ the quad tree + -> QuadTree (P2 Double) -- ^ the quad tree quadTree [] _ = TNil quadTree [pt] _ = TLeaf pt quadTree pts sq = TNode (quadTree nWPT . nwSq $ sq) (quadTree nEPT . neSq $ sq) @@ -97,7 +97,7 @@ quadTree pts sq = TNode (quadTree nWPT . nwSq $ sq) (quadTree nEPT . neSq $ sq) -- |Get all squares of a quad tree. quadTreeSquares :: ((Double, Double), (Double, Double)) -- ^ the initial square around the points - -> QuadTree P2 -- ^ the quad tree + -> QuadTree (P2 Double) -- ^ the quad tree -> [((Double, Double), (Double, Double))] -- ^ all squares of the quad tree quadTreeSquares sq (TNil) = [sq] quadTreeSquares sq (TLeaf _) = [sq] @@ -203,7 +203,7 @@ lookupByNeighbors :: [Orient] -> QTZipper a -> Maybe (QTZipper a) lookupByNeighbors = flip (foldlM (flip findNeighbor)) -quadTreeToRoseTree :: QTZipper P2 -> Tree String +quadTreeToRoseTree :: QTZipper (P2 Double) -> Tree String quadTreeToRoseTree z' = go (rootNode z') where go z = case z of diff --git a/CG2.cabal b/CG2.cabal index 99400e4..e0b9a55 100644 --- a/CG2.cabal +++ b/CG2.cabal @@ -76,21 +76,20 @@ executable Gtk -- Other library packages from which modules are imported. build-depends: attoparsec >= 0.12.1.1, - base >=4.6 && <4.8, + base >=4.6, bytestring >= 0.10.4.0, containers >= 0.5.0.0, dequeue >= 0.1.5, - diagrams-lib >=1.2 && <1.3, - diagrams-cairo >=1.2 && <1.3, - diagrams-contrib >= 1.1.2.1, - directory >=1.2 && <1.3, + diagrams-lib >=1.3, + diagrams-cairo >=1.3, + diagrams-contrib >= 1.3.0.0, + directory >=1.2, filepath >= 1.3.0.2, - glade >=0.12 && <0.13, + glade >=0.12, gloss >= 1.2.0.1, - gtk >=0.12 && <0.13, - multiset-comb >= 0.2.1, + gtk >=0.12, safe >= 0.3.8, - transformers >=0.4 && <0.5 + transformers >=0.4 -- Directories containing source files. -- hs-source-dirs: @@ -126,18 +125,17 @@ executable Gif -- Other library packages from which modules are imported. build-depends: attoparsec >= 0.12.1.1, - base >=4.6 && <4.8, + base >=4.6, bytestring >= 0.10.4.0, containers >= 0.5.0.0, dequeue >= 0.1.5, - diagrams-lib >=1.2 && <1.3, - diagrams-cairo >=1.2 && <1.3, - diagrams-contrib >= 1.1.2.1, + diagrams-lib >=1.3, + diagrams-cairo >=1.3, + diagrams-contrib >= 1.3.0.0, gloss >= 1.2.0.1, JuicyPixels >= 3.1.7.1, - multiset-comb >= 0.2.1, - transformers >=0.4 && <0.5, - safe >= 0.3.8 + safe >= 0.3.8, + transformers >=0.4 -- Directories containing source files. -- hs-source-dirs: @@ -175,18 +173,14 @@ executable Test -- Other library packages from which modules are imported. build-depends: attoparsec >= 0.12.1.1, - base >=4.6 && <4.8, + base >=4.6, bytestring >= 0.10.4.0, containers >= 0.5.0.0, - dequeue >= 0.1.5, - diagrams-lib >=1.2 && <1.3, - diagrams-cairo >=1.2 && <1.3, - diagrams-contrib >= 1.1.2.1, + diagrams-lib >=1.3, + diagrams-cairo >=1.3, + diagrams-contrib >= 1.3.0.0, gloss >= 1.2.0.1, - JuicyPixels >= 3.1.7.1, - multiset-comb >= 0.2.1, QuickCheck >= 2.4.2, - transformers >=0.4 && <0.5, safe >= 0.3.8 -- Directories containing source files. diff --git a/GUI/Gtk.hs b/GUI/Gtk.hs index 5e53753..5cfb5c4 100644 --- a/GUI/Gtk.hs +++ b/GUI/Gtk.hs @@ -63,9 +63,9 @@ data MyGUI = MkMyGUI { -- |Path entry widget for the quad tree. quadPathEntry :: Entry, -- |Horizontal box containing the path entry widget. - vbox7 :: Box, + vbox7 :: Graphics.UI.Gtk.Box, -- |Horizontal box containing the Rang search entry widgets. - vbox10 :: Box, + vbox10 :: Graphics.UI.Gtk.Box, -- |Range entry widget for lower x bound rangeXminEntry :: Entry, -- |Range entry widget for upper x bound @@ -299,9 +299,9 @@ saveAndDrawDiag fp fps mygui = renderDiag winWidth winHeight buildDiag = renderDia Cairo (CairoOptions fps - (Dims (fromIntegral winWidth) (fromIntegral winHeight)) + (mkSizeSpec2D (Just $ fromIntegral winWidth) (Just $ fromIntegral winHeight)) SVG False) - (buildDiag (def{ + (buildDiag (MyPrelude.def{ dotSize = scaleVal, xDimension = fromMaybe (0, 500) xDim, yDimension = fromMaybe (0, 500) yDim, diff --git a/Graphics/Diagram/AlgoDiags.hs b/Graphics/Diagram/AlgoDiags.hs index 2c6fba2..3cf2543 100644 --- a/Graphics/Diagram/AlgoDiags.hs +++ b/Graphics/Diagram/AlgoDiags.hs @@ -123,9 +123,9 @@ kdSquares = Diag f where -- Gets all lines that make up the kdSquares. Every line is -- described by two points, start and end respectively. - kdLines :: KDTree P2 + kdLines :: KDTree (P2 Double) -> ((Double, Double), (Double, Double)) -- ^ square - -> [(P2, P2)] + -> [(P2 Double, P2 Double)] kdLines (KTNode ln pt Horizontal rn) ((xmin, ymin), (xmax, ymax)) = (\(x, _) -> [(p2 (x, ymin), p2 (x, ymax))]) (unp2 pt) @@ -180,7 +180,7 @@ kdTreeDiag = Diag f -- |Get the quad tree corresponding to the given points and diagram properties. -qt :: [P2] -> DiagProp -> QuadTree P2 +qt :: [P2 Double] -> DiagProp -> QuadTree (P2 Double) qt vt p = quadTree vt (diagDimSquare p) @@ -194,7 +194,7 @@ quadPathSquare = Diag f (getSquare (stringToQuads (quadPath p)) (qt (mconcat vts) p, [])) where getSquare :: [Either Quad Orient] - -> QTZipper P2 + -> QTZipper (P2 Double) -> ((Double, Double), (Double, Double)) getSquare [] z = getSquareByZipper (diagDimSquare p) z getSquare (q:qs) z = case q of @@ -212,7 +212,7 @@ gifQuadPath = GifDiag f <$> getSquares (stringToQuads (quadPath p)) (qt vt p, []) where getSquares :: [Either Quad Orient] - -> QTZipper P2 + -> QTZipper (P2 Double) -> [((Double, Double), (Double, Double))] getSquares [] z = [getSquareByZipper (diagDimSquare p) z] getSquares (q:qs) z = case q of @@ -233,12 +233,12 @@ treePretty = Diag f . quadPath $ p) where - getCurQT :: [Either Quad Orient] -> QTZipper P2 -> QTZipper P2 + getCurQT :: [Either Quad Orient] -> QTZipper (P2 Double) -> QTZipper (P2 Double) getCurQT [] z = z getCurQT (q:qs) z = case q of Right x -> getCurQT qs (fromMaybe z (findNeighbor x z)) Left x -> getCurQT qs (fromMaybe z (goQuad x z)) - prettyRoseTree :: Tree String -> Diagram Cairo R2 + prettyRoseTree :: Tree String -> Diagram Cairo prettyRoseTree tree = -- HACK: in order to give specific nodes a specific color renderTree (\n -> case head n of diff --git a/Graphics/Diagram/Core.hs b/Graphics/Diagram/Core.hs index f072639..8a8f0b7 100644 --- a/Graphics/Diagram/Core.hs +++ b/Graphics/Diagram/Core.hs @@ -15,18 +15,18 @@ data Diag = Diag { mkDiag :: DiagProp - -> [[P2]] - -> Diagram Cairo R2 + -> [[P2 Double]] + -> Diagram Cairo } | GifDiag { mkGifDiag :: DiagProp -> Colour Double - -> ([P2] -> [[P2]]) - -> [P2] - -> [Diagram Cairo R2] + -> ([P2 Double] -> [[P2 Double]]) + -> [P2 Double] + -> [Diagram Cairo] } - | EmptyDiag (Diagram Cairo R2) + | EmptyDiag (Diagram Cairo) -- |Holds the properties for a Diagram, like thickness of 2d points etc. @@ -134,7 +134,7 @@ maybeDiag b d | otherwise = mempty -filterValidPT :: DiagProp -> [P2] -> [P2] +filterValidPT :: DiagProp -> [P2 Double] -> [P2 Double] filterValidPT = filter . inRange @@ -146,21 +146,21 @@ diagDimSquare p = dimToSquare (xDimension p) $ yDimension p -- |Draw a list of points. -drawP :: [P2] -- ^ the points to draw +drawP :: [P2 Double] -- ^ the points to draw -> Double -- ^ dot size - -> Diagram Cairo R2 -- ^ the resulting diagram + -> Diagram Cairo -- ^ the resulting diagram drawP [] _ = mempty drawP vt ds = position (zip vt (repeat dot)) where - dot = circle ds :: Diagram Cairo R2 + dot = circle ds :: Diagram Cairo -- |Create a rectangle around a diagonal line, which has sw -- as startpoint and nw as endpoint. rectByDiagonal :: (Double, Double) -- ^ sw point -> (Double, Double) -- ^ nw point - -> Diagram Cairo R2 + -> Diagram Cairo rectByDiagonal (xmin, ymin) (xmax, ymax) = fromVertices [p2 (xmin, ymin) , p2 (xmax, ymin) @@ -172,7 +172,7 @@ rectByDiagonal (xmin, ymin) (xmax, ymax) = -- |Creates a Diagram from a point that shows the coordinates -- in text format, such as "(1.0, 2.0)". -pointToTextCoord :: P2 -> Diagram Cairo R2 +pointToTextCoord :: P2 Double -> Diagram Cairo pointToTextCoord pt = text ("(" ++ (show . trim') x ++ ", " ++ (show . trim') y ++ ")") # scale 10 where diff --git a/Graphics/Diagram/Gif.hs b/Graphics/Diagram/Gif.hs index 6079ce8..faff801 100644 --- a/Graphics/Diagram/Gif.hs +++ b/Graphics/Diagram/Gif.hs @@ -2,7 +2,7 @@ module Graphics.Diagram.Gif where -import Algebra.Vector(PT) +import Algebra.Vector import Algorithms.GrahamScan import Codec.Picture.Gif import qualified Data.ByteString.Char8 as B @@ -16,7 +16,7 @@ import Parser.Meshparser -- |Return a list of tuples used by 'gifMain' to generate an animated gif. -gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, GifDelay)] +gifDiag :: DiagProp -> [P2 Double] -> [(Diagram Cairo, GifDelay)] gifDiag p xs = fmap ((\x -> (x, 50)) . (<> nonChDiag)) (upperHullList @@ -35,5 +35,5 @@ gifDiag p xs = -- |Same as gifDiag, except that it takes a string containing the -- mesh file content instead of the the points. -gifDiagS :: DiagProp -> B.ByteString -> [(Diagram Cairo R2, GifDelay)] +gifDiagS :: DiagProp -> B.ByteString -> [(Diagram Cairo, GifDelay)] gifDiagS p = gifDiag p . filterValidPT p . meshToArr diff --git a/Graphics/Diagram/Gtk.hs b/Graphics/Diagram/Gtk.hs index 32e7f19..db28137 100644 --- a/Graphics/Diagram/Gtk.hs +++ b/Graphics/Diagram/Gtk.hs @@ -2,6 +2,7 @@ module Graphics.Diagram.Gtk where +import Algebra.Vector import qualified Data.ByteString.Char8 as B import Data.List(find) import Diagrams.Backend.Cairo @@ -45,7 +46,7 @@ diagTreAlgos = -- |Create the Diagram from the points. -diag :: DiagProp -> [DiagAlgo] -> [[P2]] -> Diagram Cairo R2 +diag :: DiagProp -> [DiagAlgo] -> [[P2 Double]] -> Diagram Cairo diag p das vts = maybe mempty (\x -> mkDiag x p vts) $ mconcat -- get the actual [Diag] array @@ -57,7 +58,7 @@ diag p das vts = maybe mempty (\x -> mkDiag x p vts) -- |Create the Diagram from a String which is supposed to be the contents -- of an obj file. -diagS :: DiagProp -> B.ByteString -> Diagram Cairo R2 +diagS :: DiagProp -> B.ByteString -> Diagram Cairo diagS p mesh = diag p diagAlgos . fmap (filterValidPT p) @@ -68,7 +69,7 @@ diagS p mesh = -- |Create the tree diagram from a String which is supposed to be the contents -- of an obj file. -diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo R2 +diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo diagTreeS p mesh = diag p diagTreAlgos . fmap (filterValidPT p) diff --git a/Parser/Meshparser.hs b/Parser/Meshparser.hs index ce3408f..d530ea3 100644 --- a/Parser/Meshparser.hs +++ b/Parser/Meshparser.hs @@ -11,7 +11,7 @@ import Diagrams.TwoD.Types -- |Convert a text String with multiple vertices and faces into -- a list of vertices, ordered by the faces specification. -facesToArr :: B.ByteString -> [[P2]] +facesToArr :: B.ByteString -> [[P2 Double]] facesToArr str = fmap (fmap (\y -> meshToArr str !! (fromIntegral y - 1))) (faces str) where @@ -21,7 +21,7 @@ facesToArr str = fmap (fmap (\y -> meshToArr str !! (fromIntegral y - 1))) -- |Convert a text String with multiple vertices into -- an array of float tuples. meshToArr :: B.ByteString -- ^ the string to convert - -> [P2] -- ^ the resulting vertice table + -> [P2 Double] -- ^ the resulting vertice table meshToArr = fmap p2 . rights diff --git a/Test/Vector.hs b/Test/Vector.hs index 358d567..fed852b 100644 --- a/Test/Vector.hs +++ b/Test/Vector.hs @@ -21,19 +21,19 @@ newtype PosRoundDouble = PosRoundDouble { getPRD :: Double } deriving (Eq, Ord, Show, Read) -newtype RoundR2 = RoundR2 { getRR2 :: R2 } +newtype RoundR2 = RoundR2 { getRR2 :: V2 Double } deriving (Eq, Ord, Show, Read) -newtype PosRoundR2 = PosRoundR2 { getPRR2 :: R2 } +newtype PosRoundR2 = PosRoundR2 { getPRR2 :: V2 Double } deriving (Eq, Ord, Show, Read) -newtype RoundP2 = RoundP2 { getRP2 :: P2 } +newtype RoundP2 = RoundP2 { getRP2 :: P2 Double } deriving (Eq, Ord, Show, Read) -newtype PosRoundP2 = PosRoundP2 { getPRP2 :: P2 } +newtype PosRoundP2 = PosRoundP2 { getPRP2 :: P2 Double } deriving (Eq, Ord, Show, Read) @@ -72,11 +72,11 @@ instance Arbitrary PosRoundP2 where <*> (arbitrary :: Gen PosRoundDouble) -instance Arbitrary R2 where +instance Arbitrary (V2 Double) where arbitrary = curry r2 <$> arbitrary <*> arbitrary -instance Arbitrary P2 where +instance Arbitrary (P2 Double) where arbitrary = curry p2 <$> arbitrary <*> arbitrary @@ -126,51 +126,51 @@ inRangeProp6 sq@((x1, y1), (x2, y2)) (Positive a) (Positive b) = -- apply id function on the point -onPTProp1 :: P2 -> Bool +onPTProp1 :: P2 Double -> Bool onPTProp1 pt = onPT id pt == pt -- add a random value to the point coordinates -onPTProp2 :: P2 -> Positive R2 -> Bool -onPTProp2 pt (Positive (R2 rx ry)) +onPTProp2 :: P2 Double -> Positive (V2 Double) -> Bool +onPTProp2 pt (Positive (V2 rx ry)) = onPT (\(x, y) -> (x + rx, y + ry)) pt /= pt -- angle between two vectors both on the x-axis must be 0 -getAngleProp1 :: Positive R2 -> Positive R2 -> Bool -getAngleProp1 (Positive (R2 x1 _)) (Positive (R2 x2 _)) - = getAngle (R2 x1 0) (R2 x2 0) == 0 +getAngleProp1 :: Positive (V2 Double) -> Positive (V2 Double) -> Bool +getAngleProp1 (Positive (V2 x1 _)) (Positive (V2 x2 _)) + = getAngle (V2 x1 0) (V2 x2 0) == 0 -- angle between two vectors both on the y-axis must be 0 -getAngleProp2 :: Positive R2 -> Positive R2 -> Bool -getAngleProp2 (Positive (R2 _ y1)) (Positive (R2 _ y2)) - = getAngle (R2 0 y1) (R2 0 y2) == 0 +getAngleProp2 :: Positive (V2 Double) -> Positive (V2 Double) -> Bool +getAngleProp2 (Positive (V2 _ y1)) (Positive (V2 _ y2)) + = getAngle (V2 0 y1) (V2 0 y2) == 0 -- angle between two vectors both on the x-axis but with opposite direction -- must be pi -getAngleProp3 :: Positive R2 -> Positive R2 -> Bool -getAngleProp3 (Positive (R2 x1 _)) (Positive (R2 x2 _)) - = getAngle (R2 (negate x1) 0) (R2 x2 0) == pi +getAngleProp3 :: Positive (V2 Double) -> Positive (V2 Double) -> Bool +getAngleProp3 (Positive (V2 x1 _)) (Positive (V2 x2 _)) + = getAngle (V2 (negate x1) 0) (V2 x2 0) == pi -- angle between two vectors both on the y-axis but with opposite direction -- must be pi -getAngleProp4 :: Positive R2 -> Positive R2 -> Bool -getAngleProp4 (Positive (R2 _ y1)) (Positive (R2 _ y2)) - = getAngle (R2 0 (negate y1)) (R2 0 y2) == pi +getAngleProp4 :: Positive (V2 Double) -> Positive (V2 Double) -> Bool +getAngleProp4 (Positive (V2 _ y1)) (Positive (V2 _ y2)) + = getAngle (V2 0 (negate y1)) (V2 0 y2) == pi -- angle between vector in x-axis direction and y-axis direction must be -- p/2 -getAngleProp5 :: Positive R2 -> Positive R2 -> Bool -getAngleProp5 (Positive (R2 x1 _)) (Positive (R2 _ y2)) - = getAngle (R2 x1 0) (R2 0 y2) == pi / 2 +getAngleProp5 :: Positive (V2 Double) -> Positive (V2 Double) -> Bool +getAngleProp5 (Positive (V2 x1 _)) (Positive (V2 _ y2)) + = getAngle (V2 x1 0) (V2 0 y2) == pi / 2 -- commutative -getAngleProp6 :: Positive R2 -> Positive R2 -> Bool +getAngleProp6 :: Positive (V2 Double) -> Positive (V2 Double) -> Bool getAngleProp6 (Positive v1) (Positive v2) = getAngle v1 v2 == getAngle v2 v1 @@ -183,7 +183,7 @@ getAngleProp7 (PosRoundR2 v) -- commutative -scalarProdProp1 :: R2 -> R2 -> Bool +scalarProdProp1 :: (V2 Double) -> (V2 Double) -> Bool scalarProdProp1 v1 v2 = v1 `scalarProd` v2 == v2 `scalarProd` v1 @@ -212,9 +212,9 @@ scalarProdProp4 (RoundDouble s1) (RoundDouble s2) (RoundR2 v1) (RoundR2 v2) -- orthogonal -scalarProdProp5 :: Positive R2 -> Positive R2 -> Bool -scalarProdProp5 (Positive (R2 x1 _)) (Positive (R2 _ y2)) - = scalarProd (R2 x1 0) (R2 0 y2) == 0 +scalarProdProp5 :: Positive (V2 Double) -> Positive (V2 Double) -> Bool +scalarProdProp5 (Positive (V2 x1 _)) (Positive (V2 _ y2)) + = scalarProd (V2 x1 0) (V2 0 y2) == 0 -- this is almost the same as the function definition @@ -226,49 +226,49 @@ dimToSquareProp1 (x1, x2) (y1, y2) = -- multiply scalar with result of vecLength or with the vector itself... -- both results must be the same. We can't check against 0 -- because of sqrt in vecLength. -vecLengthProp1 :: PosRoundDouble -> R2 -> Bool +vecLengthProp1 :: PosRoundDouble -> (V2 Double) -> Bool vecLengthProp1 (PosRoundDouble r) v = abs (vecLength v * r - vecLength (scalarMul r v)) < 0.0001 -- convert to vector and back again -pt2VecProp1 :: P2 -> Bool +pt2VecProp1 :: P2 Double -> Bool pt2VecProp1 pt = (vec2Pt . pt2Vec $ pt) == pt -- unbox coordinates and check if equal -pt2VecProp2 :: P2 -> Bool +pt2VecProp2 :: P2 Double -> Bool pt2VecProp2 pt = (unr2 . pt2Vec $ pt) == unp2 pt -- convert to point and back again -vec2PtProp1 :: R2 -> Bool +vec2PtProp1 :: V2 Double -> Bool vec2PtProp1 v = (pt2Vec . vec2Pt $ v) == v -- unbox coordinates and check if equal -vec2PtProp2 :: R2 -> Bool +vec2PtProp2 :: V2 Double -> Bool vec2PtProp2 v = (unp2 . vec2Pt $ v) == unr2 v -- vector from a to b must not be the same as b to a -vp2Prop1 :: P2 -> P2 -> Bool +vp2Prop1 :: P2 Double -> P2 Double -> Bool vp2Prop1 p1' p2' | p1' == origin && p2' == origin = True | otherwise = vp2 p1' p2' /= vp2 p2' p1' -- negating vector from a to be must be the same as vector b to a -vp2Prop2 :: P2 -> P2 -> Bool +vp2Prop2 :: P2 Double -> P2 Double -> Bool vp2Prop2 p1' p2' | p1' == origin && p2' == origin = True - | otherwise = vp2 p1' p2' == (\(R2 x y) -> negate x ^& negate y) + | otherwise = vp2 p1' p2' == (\(V2 x y) -> negate x ^& negate y) (vp2 p2' p1') && - vp2 p2' p1' == (\(R2 x y) -> negate x ^& negate y) + vp2 p2' p1' == (\(V2 x y) -> negate x ^& negate y) (vp2 p1' p2') -- determinant of the 3 same points is always 0 -detProp1 :: P2 -> Bool +detProp1 :: P2 Double -> Bool detProp1 pt' = det pt' pt' pt' == 0