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

Compare commits

base: MasseR:828fd6aead938f4ed12214a3c4cb96cecbf02825
Branches Tags
MasseR:master
...
compare: MasseR:4b6b9b8f197b3fdd81f597c50acbe98fa8103780
Branches Tags
MasseR:master

2 Commits
828fd6aead ... 4b6b9b8f19

Author SHA1 Message Date
Mats Rauhala
4b6b9b8f19 Retain filename 2019-01-01 17:30:55 +02:00
Mats Rauhala
f8f0cf5a56 Some type applications 2019-01-01 17:22:57 +02:00
1 changed files with 8 additions and 3 deletions
Show Stats Expand all files Collapse all files

11
src/Main.hs
View File

@ -3,10 +3,12 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Main where 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 Data.List (foldl') import Data.List (foldl')
import Data.Word (Word64) import Data.Word (Word64)
@ -16,6 +18,7 @@ import Pipes.Files
import qualified Pipes.Prelude as P import qualified Pipes.Prelude as P
import Pipes.Safe (runSafeT) import Pipes.Safe (runSafeT)
data Cmd = Cmd { source :: FilePath data Cmd = Cmd { source :: FilePath
, target :: FilePath , target :: FilePath
, recursive :: Bool , recursive :: Bool
@ -27,14 +30,16 @@ fingerprint = hash . grey . scale . convertRGB8
scale :: Image PixelRGB8 -> Image PixelRGB8 scale :: Image PixelRGB8 -> Image PixelRGB8
scale = scaleBilinear 8 8 scale = scaleBilinear 8 8
grey :: Image PixelRGB8 -> Image Pixel8 grey :: Image PixelRGB8 -> Image Pixel8
grey = pixelMap (\(PixelRGB8 r g b) -> ceiling ((fromIntegral r * 0.3) + (fromIntegral g * 0.59) + (fromIntegral b * 0.11))) grey = pixelMap (\(PixelRGB8 r g b) -> ceiling ((fromIntegral r * (0.3 :: Double)) + (fromIntegral g * 0.59) + (fromIntegral b * 0.11)))
hash :: Image Pixel8 -> Word64 hash :: Image Pixel8 -> Word64
hash img = -- the average fingerprint method hash img = -- the average fingerprint method
let avg = fromIntegral (foldl' (\acc (x,y) -> acc + fromIntegral (pixelAt img x y)) 0 [(x,y) | x <- [0..7], y <- [0..7]] `div` 64) let avg = fromIntegral (foldl' (\acc (x,y) -> acc + fromIntegral (pixelAt img x y)) (0 :: Int) [(x,y) | x <- [0..7], y <- [0..7]] `div` 64)
in foldr (\(shiftA, b) acc -> if b then 1 `shift` shiftA .|. acc else acc) 0 $ zip [0..] [pixelAt img x y > avg | x <- [0..7], y <- [0..7]] in foldr (\(shiftA, b) acc -> if b then 1 `shift` shiftA .|. acc else acc) 0 $ zip [0..] [pixelAt img x y > avg | x <- [0..7], y <- [0..7]]
main :: IO () main :: IO ()
main = do main = do
Cmd{..} <- getRecord "Image duplicate finder" Cmd{..} <- getRecord "Image duplicate finder"
runSafeT (runEffect (for (find source (glob "*.jpg" <> regular) >-> P.mapM (liftIO . readImage) >-> P.map (fmap fingerprint)) (liftIO . print))) 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!" putStrLn "Hello, Haskell!"