1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | bentleyOttmann ss = work eventQueue T.empty (bp, ep, xp) where --Our initial event queue consists of the endpoints of our input list of segments. eventQueue = S.fromList (concat $ map toPoints ss) --We initialize a lookup structure that maps event points to segments that interact there. --Beginning and endpoints are filled, and intersection points are empty. bp = M.fromListWith (++) $ zip (map lep ss) (map return ss) ep = M.fromListWith (++) $ zip (map rep ss) (map return ss) xp = M.empty --A convenient lookup function to use with our lookup structure. lookup = M.findWithDefault [] --work takes an event queue, a sweep line structure, and a lookup structure, and produces a list of intersection points --paired with the intersecting segments. work eq sl lk@(bp, ep, xp) --We check the event queue to see if it is non-empty. If there is an event to process, we do so. | Just (e@(Point x _), eq') <- S.minView eq = let line = Line (Point x 0) (Point x 1) --The current sweepline. bs = lookup e bp --What segments begin at this event point? es = lookup e ep --What segments end at this event point? xs = lookup e xp --What segments intersect at this event point? is = bs ++ es ++ xs --sl' and then sl'': We first remove segments ending and intersecting at this point from the sweepline. --We then add beginning segments and intersecting segments. This reverses the order of the x-ing segments --in the sweepline. sl' = foldl (flip ($)) sl (map (T.deleteBy (cmp line)) (xs ++ es)) sl'' = foldl (flip ($)) sl' (map (T.insertBy (cmp line)) (bs ++ xs)) --We now check for new intersections. `cmp line' is the ordering of segments w.r.t. to the sweepline. nxs = case bs ++ xs of --If we only removed segments from the sweepline, then we look for the immediate --neighbors of the removed segments in the old version of the structure. [] -> let nmin = fromJust $ T.findBy (cmp line) (minimumBy (cmp line) es) sl nmax = fromJust $ T.findBy (cmp line) (maximumBy (cmp line) es) sl in if T.isEmpty sl'' then [] else catMaybes [xtestl (T.prev nmin), xtestr (T.next nmax)] --If we added segments, we look for their neighbors in the new version of the sweepline structure, -- and check those for intersections. bxs -> let nmin = fromJust $ T.findBy (cmp line) (minimumBy (cmp line) bxs) sl'' nmax = fromJust $ T.findBy (cmp line) (maximumBy (cmp line) bxs) sl'' in catMaybes [xtestl nmin, xtestr nmax] --nxs' is what we get when we remove intersections that have already been found and recorded in our lookup structure. nxs' = filter (not . flip M.member xp . fst) nxs --eq'' is the new event queue, with the new intersection points added as new event points. eq'' = eq' `S.union` (S.fromList (map fst nxs')) --finally, lk' is the new lookup structure augmented with the new intersection points as keys. lk' = (bp, ep, xp `M.union` M.fromList nxs') --Now, we check the number of segments associated to the current endpoint. If there's more than one, it's an intersection. --We add it to the list if it exists and continue to process the rest of the events with the updated sweepline and lookup structures. in if length is > 1 then (e, is) : (work eq'' sl'' lk') else work eq'' sl'' lk' --At some point, the eventqueue will be empty. That means we are done and there are no new intersection points to report. | otherwise = [] |

4:28: Error: Use concatMap

Found:

concat $ map toPoints ss

Why not:

concatMap toPoints ss

7:30: Error: Use &&&

Found:

zip (map lep ss) (map return ss)

Why not:

map (lep Control.Arrow.&&& return) ss

8:30: Error: Use &&&

Found:

zip (map rep ss) (map return ss)

Why not:

map (rep Control.Arrow.&&& return) ss

42:16: Warning: Redundant bracket

Found:

eq' `S.union` (S.fromList (map fst nxs'))

Why not:

eq' `S.union` S.fromList (map fst nxs')

47:30: Warning: Redundant bracket

Found:

(e, is) : (work eq'' sl'' lk')

Why not:

(e, is) : work eq'' sl'' lk'

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | bentleyOttmann ss = work eventQueue T.empty (bp, ep, xp) where eventQueue = S.fromList (concat $ map toPoints ss) bp = M.fromListWith (++) $ zip (map lep ss) (map return ss) ep = M.fromListWith (++) $ zip (map rep ss) (map return ss) xp = M.empty lookup = M.findWithDefault [] work eq sl lk@(bp, ep, xp) | Just (e@(Point x _), eq') <- S.minView eq = let line = Line (Point x 0) (Point x 1) bs = lookup e bp es = lookup e ep xs = lookup e xp is = bs ++ es ++ xs sl' = foldl (flip ($)) sl (map (T.deleteBy (cmp line)) (xs ++ es)) sl'' = foldl (flip ($)) sl' (map (T.insertBy (cmp line)) (bs ++ xs)) nxs = case bs ++ xs of [] -> let nmin = getCandidate minimumBy es sl nmax = getCandidate maximumBy es sl in if T.isEmpty sl'' then [] else catMaybes [xtestl (T.prev nmin), xtestr (T.next nmax)] bxs -> let nmin = getCandidate minimumBy bxs sl'' nmax = getCandidate minimumBy bxs sl'' in catMaybes [xtestl nmin, xtestr nmax] where getCandidate f es sl = fromJust $ T.findBy (cmp line) (f (cmp line) es) sl nxs' = filter (not . flip M.member xp . fst) nxs eq'' = eq' `S.union` (S.fromList (map fst nxs')) lk' = (bp, ep, xp `M.union` M.fromList nxs') in if length is > 1 then (e, is) : (work eq'' sl'' lk') else work eq'' sl'' lk' | otherwise = [] |

26:16: Warning: Redundant bracket

Found:

eq' `S.union` (S.fromList (map fst nxs'))

Why not:

eq' `S.union` S.fromList (map fst nxs')

3:28: Error: Use concatMap

Found:

concat $ map toPoints ss

Why not:

concatMap toPoints ss

4:30: Error: Use &&&

Found:

zip (map lep ss) (map return ss)

Why not:

map (lep Control.Arrow.&&& return) ss

5:30: Error: Use &&&

Found:

zip (map rep ss) (map return ss)

Why not:

map (rep Control.Arrow.&&& return) ss

28:30: Warning: Redundant bracket

Found:

(e, is) : (work eq'' sl'' lk')

Why not:

(e, is) : work eq'' sl'' lk'

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | bentleyOttmann ss = work eventQueue T.empty (bp, ep, xp) where eventQueue = S.fromList (concatMap toPoints ss) bp = beginPoints ss ep = endPoints ss xp = M.empty lookup = M.findWithDefault [] work eq sl lk@(bp, ep, xp) | Just (e@(Point x _), eq') <- S.minView eq = let line = Line (Point x 0) (Point x 1) bs = lookup e bp es = lookup e ep xs = lookup e xp is = bs ++ es ++ xs sl' = foldl (flip ($)) sl (map (T.deleteBy (cmp line)) (xs ++ es)) sl'' = foldl (flip ($)) sl' (map (T.insertBy (cmp line)) (bs ++ xs)) nxs = case bs ++ xs of [] -> let nmin = getCandidate minimumBy es sl nmax = getCandidate maximumBy es sl in if T.isEmpty sl'' then [] else catMaybes [xtestl (T.prev nmin), xtestr (T.next nmax)] bxs -> let nmin = getCandidate minimumBy bxs sl'' nmax = getCandidate minimumBy bxs sl'' in catMaybes [xtestl nmin, xtestr nmax] where getCandidate f es sl = fromJust $ T.findBy (cmp line) (f (cmp line) es) sl nxs' = filter (not . flip M.member xp . fst) nxs eq'' = eq' `S.union` S.fromList (map fst nxs') lk' = (bp, ep, xp `M.union` M.fromList nxs') in if length is > 1 then (e, is) : work eq'' sl'' lk' else work eq'' sl'' lk' | otherwise = [] |

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | --There was a bug. bentleyOttmann ss = work eventQueue T.empty (bp, ep, xp) where eventQueue = S.fromList (concatMap toPoints ss) bp = beginPoints ss ep = endPoints ss xp = M.empty lookup = M.findWithDefault [] work eq sl lk@(bp, ep, xp) | Just (e@(Point x _), eq') <- S.minView eq = let line = Line (Point x 0) (Point x 1) bs = lookup e bp es = lookup e ep xs = lookup e xp is = bs ++ es ++ xs sl' = foldl (flip ($)) sl (map (T.deleteBy (cmp line)) (xs ++ es)) sl'' = foldl (flip ($)) sl' (map (T.insertBy (cmp line)) (bs ++ xs)) nxs = case bs ++ xs of [] -> let (nmin, nmax) = getCandidates es sl in if T.isEmpty sl'' then [] else catMaybes [xtestl (T.prev nmin), xtestr (T.next nmax)] bxs -> let (nmin, nmax) = getCandidates bxs sl'' in catMaybes [xtestl nmin, xtestr nmax] where getCandidates ss sl = (aux minimumBy ss sl, aux maximumBy ss sl) aux f ss sl = fromJust $ T.findBy (cmp line) (f (cmp line) ss) sl nxs' = filter (not . flip M.member xp . fst) nxs eq'' = eq' `S.union` S.fromList (map fst nxs') lk' = (bp, ep, M.unionWith ((nub .) . (++)) xp (M.fromList nxs)) in if length is > 1 then (e, is) : work eq'' sl'' lk' else work eq'' sl'' lk' | otherwise = [] |