Record to fingerprint

This commit is contained in:
Mats Rauhala 2019-01-01 20:49:26 +02:00
parent dbb5cbb209
commit b61ca54011
2 changed files with 30 additions and 13 deletions

View File

@ -4,13 +4,13 @@
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.BKTree where
import Data.Functor.Foldable.TH
import Data.Functor.Foldable
import Data.Functor.Foldable.TH
import GHC.Generics (Generic)
-- Point for testing purposes
@ -27,6 +27,12 @@ data BKTree a = Empty
makeBaseFunctor ''BKTree
empty :: BKTree a
empty = Empty
singleton :: Metric a => a -> BKTree a
singleton a = insert a empty
insert :: Metric a => a -> BKTree a -> BKTree a
insert a = \case
Empty -> Node a []

View File

@ -8,8 +8,8 @@ module Main where
import Codec.Picture
import Codec.Picture.Extra (scaleBilinear)
import Data.Bifunctor (second)
import Data.Bits
import qualified Data.BKTree as BK
import Data.List (foldl')
import Data.Word (Word64)
import Options.Generic
@ -24,6 +24,18 @@ data Cmd = Cmd { source :: FilePath
, recursive :: Bool
} deriving (Show, Generic, ParseRecord)
data Fingerprint =
Fingerprint { imagePath :: FilePath
, hash :: !Word64
} deriving Show
instance BK.Metric Fingerprint where
-- hamming distance
distance (Fingerprint _ a) (Fingerprint _ b) =
let xored = a `xor` b
in foldr (\shiftA acc -> acc + if 1 `shift` shiftA .&. xored > 0 then 1 else 0) 0 [0..63]
fingerprint :: DynamicImage -> Word64
fingerprint = hash . grey . scale . convertRGB8
where
@ -41,5 +53,4 @@ main = do
Cmd{..} <- getRecord "Image duplicate finder"
runSafeT $
runEffect $
for (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (second fingerprint))) (liftIO . print)
putStrLn "Hello, Haskell!"
for (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (\(path, img) -> Fingerprint path (fingerprint img)))) (liftIO . print)