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

Compare commits

base: MasseR:8833880c225a0bf8b18f1bf37c8f49d9e6bd0888
Branches Tags
MasseR:master
..
compare: MasseR:4139562a49b87509357ebae7a2d5a1d0f6a90127
Branches Tags
MasseR:master

No commits in common. "8833880c225a0bf8b18f1bf37c8f49d9e6bd0888" and "4139562a49b87509357ebae7a2d5a1d0f6a90127" have entirely different histories.
8833880c22 ... 4139562a49

1 changed files with 9 additions and 27 deletions
Show Stats Expand all files Collapse all files

32
src/Main.hs
View File

@ -14,7 +14,6 @@ import Control.Monad (forM_, void, when)
import Data.Bits import Data.Bits
import qualified Data.BKTree as BK import qualified Data.BKTree as BK
import Data.List (foldl') import Data.List (foldl')
import Data.Maybe (fromMaybe)
import Data.Word (Word64) import Data.Word (Word64)
import Options.Generic import Options.Generic
import Pipes import Pipes
@ -25,14 +24,9 @@ import System.Directory (createDirectoryIfMissing, createFileLink)
import System.FilePath (takeFileName, (</>)) import System.FilePath (takeFileName, (</>))
data Alg = Average | DHash deriving (Read, Show, Generic)
instance ParseField Alg
data Cmd = Cmd { source :: FilePath data Cmd = Cmd { source :: FilePath
, target :: FilePath , target :: FilePath
, range :: Maybe Int , recursive :: Bool
, algorithm :: Maybe Alg
} deriving (Show, Generic, ParseRecord) } deriving (Show, Generic, ParseRecord)
data Fingerprint = data Fingerprint =
@ -47,40 +41,28 @@ instance BK.Metric Fingerprint where
in foldr (\shiftA acc -> acc + if 1 `shift` shiftA .&. xored > 0 then 1 else 0) 0 [0..63] in foldr (\shiftA acc -> acc + if 1 `shift` shiftA .&. xored > 0 then 1 else 0) 0 [0..63]
fingerprint :: Alg -> DynamicImage -> Word64 fingerprint :: DynamicImage -> Word64
fingerprint alg = hash . grey . scale . convertRGB8 fingerprint = hash . grey . scale . convertRGB8
where where
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 :: Double)) + (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 = case alg of hash img = -- the average fingerprint method
Average -> averageHash
DHash -> dhash
dhash :: Image Pixel8 -> Word64
dhash img =
foldr (\(shiftA, b) acc -> if b then 1 `shift` shiftA .|. acc else acc) 0 $ zip [0..] [(x < 7) && (pixelAt img x y > pixelAt img (x+1) y) | x <- [0..7], y <- [0..7]]
averageHash :: Image Pixel8 -> Word64
averageHash img = -- the average fingerprint method
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) 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"
index <- runSafeT (P.fold foldTree BK.empty id (find source (glob "*.jpg" <> regular) -- XXX: This is a really long line, split it up
>-> P.mapM readImg index <- runSafeT (P.fold (\acc -> either (const acc) (\x -> x `seq` BK.insert x acc)) BK.empty id (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> liftIO (putStrLn path) >> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (\(path, img) -> Fingerprint path (fingerprint img)))))
>-> P.map (fmap (toFingerprint (fromMaybe Average algorithm)))))
forM_ index $ \fp -> do forM_ index $ \fp -> do
let similar = BK.search (fromMaybe 1 range) fp index let similar = BK.search 1 fp index
when (length similar > 1) $ do when (length similar > 1) $ do
print similar print similar
let targetDir = target </> show (hash fp) let targetDir = target </> show (hash fp)
createDirectoryIfMissing True targetDir createDirectoryIfMissing True targetDir
forM_ similar $ \fp' -> forM_ similar $ \fp' ->
void $ try @SomeException (createFileLink (imagePath fp') (targetDir </> takeFileName (imagePath fp'))) void $ try @SomeException (createFileLink (imagePath fp') (targetDir </> takeFileName (imagePath fp')))
where
readImg path = liftIO (putStrLn path >> fmap (path,) <$> readImage path)
foldTree acc = either (const acc) (\x -> x `seq` BK.insert x acc)
toFingerprint alg (path,img) = Fingerprint path (fingerprint alg img)