MasseR/imageduplicates
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Strictness

Browse Source
This commit is contained in:
Mats Rauhala 2019-01-01 23:47:32 +02:00
parent c7e074b73f
commit b8884d4bf4
1 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/Data/BKTree.hs
View File

@ -22,8 +22,10 @@ instance Metric Point where
class Metric a where class Metric a where
distance :: a -> a -> Int distance :: a -> a -> Int
data Tuple a = Tuple !Int a deriving (Show, Functor, Foldable, Traversable)
data BKTree a = Empty data BKTree a = Empty
| Node a [(Int, BKTree a)] deriving (Show, Generic) | Node !a [Tuple (BKTree a)] deriving (Show, Generic)
makeBaseFunctor ''BKTree makeBaseFunctor ''BKTree
@ -41,9 +43,9 @@ insert a = \case
in Node b (addChild newDistance children) in Node b (addChild newDistance children)
where where
addChild d = \case addChild d = \case
[] -> (d, insert a Empty) : [] [] -> (Tuple d (insert a Empty)) : []
(d',child):children | d == d' -> (d', insert a child) : children (Tuple d' child):children | d == d' -> (Tuple d' (insert a child)) : children
| otherwise -> (d',child) : addChild d children | otherwise -> (Tuple d' child) : addChild d children
search :: forall a. Metric a => Int -> a -> BKTree a -> [a] 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 let thisDistance = distance a x
upper = thisDistance + n upper = thisDistance + n
lower = 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 in if thisDistance <= n then x : filteredChildren else filteredChildren