From b8884d4bf4627b1d49320c4540e9374e65e7d3a3 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Tue, 1 Jan 2019 23:47:32 +0200 Subject: [PATCH] Strictness --- src/Data/BKTree.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/Data/BKTree.hs b/src/Data/BKTree.hs index 4180056..e0659ac 100644 --- a/src/Data/BKTree.hs +++ b/src/Data/BKTree.hs @@ -22,8 +22,10 @@ instance Metric Point where class Metric a where distance :: a -> a -> Int +data Tuple a = Tuple !Int a deriving (Show, Functor, Foldable, Traversable) + data BKTree a = Empty - | Node a [(Int, BKTree a)] deriving (Show, Generic) + | Node !a [Tuple (BKTree a)] deriving (Show, Generic) makeBaseFunctor ''BKTree @@ -41,9 +43,9 @@ insert a = \case in Node b (addChild newDistance children) where addChild d = \case - [] -> (d, insert a Empty) : [] - (d',child):children | d == d' -> (d', insert a child) : children - | otherwise -> (d',child) : addChild d children + [] -> (Tuple d (insert a Empty)) : [] + (Tuple d' child):children | d == d' -> (Tuple d' (insert a child)) : children + | otherwise -> (Tuple d' child) : addChild d children search :: forall a. Metric a => Int -> a -> BKTree a -> [a] @@ -56,5 +58,5 @@ search n a tree = cata alg tree let thisDistance = distance a x upper = thisDistance + n lower = thisDistance - n - filteredChildren = concat [xs | (d, xs) <- children, d <= upper, d >= lower] + filteredChildren = concat [xs | Tuple d xs <- children, d <= upper, d >= lower] in if thisDistance <= n then x : filteredChildren else filteredChildren