Compare commits

..

1 Commits

Author SHA1 Message Date
b33b45a4ea wip 2019-01-01 20:49:26 +02:00
2 changed files with 16 additions and 20 deletions

View File

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

View File

@ -8,8 +8,8 @@ module Main where
import Codec.Picture import Codec.Picture
import Codec.Picture.Extra (scaleBilinear) import Codec.Picture.Extra (scaleBilinear)
import Data.Bifunctor (second)
import Data.Bits import Data.Bits
import qualified Data.BKTree as BK
import Data.List (foldl') import Data.List (foldl')
import Data.Word (Word64) import Data.Word (Word64)
import Options.Generic import Options.Generic
@ -17,6 +17,7 @@ import Pipes
import Pipes.Files import Pipes.Files
import qualified Pipes.Prelude as P import qualified Pipes.Prelude as P
import Pipes.Safe (runSafeT) import Pipes.Safe (runSafeT)
import qualified Data.BKTree as BK
data Cmd = Cmd { source :: FilePath data Cmd = Cmd { source :: FilePath
@ -33,7 +34,7 @@ instance BK.Metric Fingerprint where
-- hamming distance -- hamming distance
distance (Fingerprint _ a) (Fingerprint _ b) = distance (Fingerprint _ a) (Fingerprint _ b) =
let xored = a `xor` b let xored = a `xor` b
in foldr (\shiftA acc -> acc + if 1 `shift` shiftA .&. xored > 0 then 1 else 0) 0 [0..63] in _
fingerprint :: DynamicImage -> Word64 fingerprint :: DynamicImage -> Word64
@ -53,4 +54,5 @@ main = do
Cmd{..} <- getRecord "Image duplicate finder" Cmd{..} <- getRecord "Image duplicate finder"
runSafeT $ runSafeT $
runEffect $ runEffect $
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) for (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (second fingerprint))) (liftIO . print)
putStrLn "Hello, Haskell!"