From 44e58494afdec5cd5b725470616ad3ef223e0688 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 23 Oct 2017 16:12:38 -0400 Subject: [PATCH] Add the mappedness conditions to the alternative definition. --- src/RWS.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/RWS.hs b/src/RWS.hs index d9efd1ba1..ed5eab0fd 100644 --- a/src/RWS.hs +++ b/src/RWS.hs @@ -183,12 +183,12 @@ findNearestNeighbourTo' canCompare kdTreeA kdTreeB = go where go _ [] [] = [] go _ as [] = This . (termIndex &&& term) <$> as go _ [] bs = That . (termIndex &&& term) <$> bs - go previous unmappedA@(_ : restUnmappedA) (termB@(UnmappedTerm j _ b) : restUnmappedB) = + go previous unmappedA@(UnmappedTerm minA _ _ : restUnmappedA) (termB@(UnmappedTerm j _ b) : restUnmappedB) = fromMaybe (That (j, b) : go previous unmappedA restUnmappedB) $ do -- Look up the nearest unmapped term in `unmappedA`. - foundA@(UnmappedTerm i _ a) <- nearestUnmapped (isNearAndComparableTo canCompare previous b) kdTreeA termB + foundA@(UnmappedTerm i _ a) <- nearestUnmapped (\ a -> isNearAndComparableTo canCompare previous b a && termIndex a >= minA) kdTreeA termB -- Look up the nearest `foundA` in `unmappedB` - UnmappedTerm j' _ _ <- nearestUnmapped (isNearAndComparableTo (flip canCompare) (pred j) a) kdTreeB foundA + UnmappedTerm j' _ _ <- nearestUnmapped (\ b -> isNearAndComparableTo (flip canCompare) (pred j) a b && termIndex b >= j) kdTreeB foundA -- Return Nothing if their indices don't match guard (j == j') pure $!