perceptual-hash 0.1.3.5 → 0.1.4.1
raw patch · 8 files changed
+90/−37 lines, 8 filesdep +JuicyPixelsdep +bytestringdep +webpdep ~hipbinary-addedPVP ok
version bump matches the API change (PVP)
Dependencies added: JuicyPixels, bytestring, webp
Dependency ranges changed: hip
API changes (from Hackage documentation)
+ PerceptualHash: hammingDistance :: Bits a => a -> a -> Int
Files
- CHANGELOG.md +8/−0
- app/Parallel.hs +3/−3
- bench/Bench.cpphs +3/−1
- demo-data/liz-taylor.png binary
- demo-data/liz-taylor.webp binary
- perceptual-hash.cabal +25/−20
- src/PerceptualHash.hs +46/−11
- test/Spec.hs +5/−2
CHANGELOG.md view
@@ -1,5 +1,13 @@ # phash +## 0.1.4.1++ * Add support for [webp](https://developers.google.com/speed/webp) images.++## 0.1.4.0++ * Add `hammingDistance` function in `PerceptualHash` module+ ## 0.1.3.5 * Allows files to be passed via the command-line
app/Parallel.hs view
@@ -32,9 +32,9 @@ case hash of Right x -> pure $ \hashes ->- case M.lookup x hashes of- Just others -> M.insert x (fp <| others) hashes- Nothing -> M.insert x (fp :| []) hashes+ let go (Just others) = Just (fp <| others)+ go Nothing = Just (fp :| [])+ in M.alter go x hashes Left err -> putStrLn ("WARNING: skipping " ++ fp ++ "\n" ++ err) $> id stepMap :: TVar (M.Map Word64 (NonEmpty FilePath)) -> FilePath -> IO ()
bench/Bench.cpphs view
@@ -9,12 +9,14 @@ import System.FilePath (takeFileName) mkBGroup :: NFData a => String -> (FilePath -> IO a) -> Benchmark-mkBGroup str f = bgroup str (toBench <$> [catPath, frogJpeg, frogPng])+mkBGroup str f = bgroup str (toBench <$> [catPath, frogJpeg, frogPng, lizTaylorWebp, lizTaylorPng]) where toBench fp = bench (takeFileName fp) $ nfIO (f fp) catPath = "demo-data/cat.png" frogJpeg = "demo-data/frog.jpeg" frogPng = "demo-data/frog.png"+ lizTaylorWebp = "demo-data/liz-taylor.webp"+ lizTaylorPng = "demo-data/liz-taylor.png" main :: IO () main =
+ demo-data/liz-taylor.png view
binary file changed (absent → 808457 bytes)
+ demo-data/liz-taylor.webp view
binary file changed (absent → 154000 bytes)
perceptual-hash.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: perceptual-hash-version: 0.1.3.5+version: 0.1.4.1 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2019-2020 Vanessa McHale@@ -16,6 +16,8 @@ demo-data/frog.png demo-data/meme.png demo-data/meme-watermark.jpg+ demo-data/liz-taylor.webp+ demo-data/liz-taylor.png extra-source-files: include/hs_phash.h extra-doc-files:@@ -45,16 +47,19 @@ ghc-options: -Wall -O2 build-depends: base >=4.8 && <5,- hip -any,- vector-algorithms -any,- vector -any,- primitive -any+ hip,+ vector-algorithms,+ vector,+ primitive,+ webp,+ bytestring,+ JuicyPixels if flag(llvm) ghc-options: -fllvm if flag(with-phash)- pkgconfig-depends: pHash -any+ pkgconfig-depends: pHash if flag(with-phash) exposed-modules: ForeignHash@@ -79,8 +84,8 @@ install-includes: hs_phash.h ghc-options: -Wall build-depends:- base -any,- perceptual-hash -any+ base,+ perceptual-hash lib-version-info: 1:0:0 @@ -112,9 +117,9 @@ ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N -qg" build-depends: base >=4.9 && <5,- perceptual-hash -any,- containers -any,- filepath -any,+ perceptual-hash,+ containers,+ filepath, optparse-applicative >=0.13.0.0, par-traverse >=0.2.1.0, stm >=2.3@@ -140,9 +145,9 @@ default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N -K1K" build-depends:- base -any,- perceptual-hash -any,- hspec -any+ base,+ perceptual-hash,+ hspec if impl(ghc >=8.0) ghc-options:@@ -158,7 +163,7 @@ benchmark phash-bench type: exitcode-stdio-1.0 main-is: Bench.hs- build-tool-depends: cpphs:cpphs -any+ build-tool-depends: cpphs:cpphs hs-source-dirs: bench default-language: Haskell2010 ghc-options:@@ -167,11 +172,11 @@ -Wredundant-constraints build-depends:- base -any,- perceptual-hash -any,- criterion -any,- filepath -any,- deepseq -any+ base,+ perceptual-hash,+ criterion,+ filepath,+ deepseq if flag(llvm) ghc-options: -fllvm
src/PerceptualHash.hs view
@@ -3,19 +3,35 @@ module PerceptualHash ( imgHash , fileHash+ , hammingDistance ) where -import Control.Monad.ST (runST)-import Data.Bits (shiftL, (.|.))-import qualified Data.Vector.Generic as V-import Data.Word (Word64)-import Graphics.Image (Array, Bilinear (..), Border (Edge, Reflect), Image,- Pixel (PixelX, PixelY), RSU (..), X, Y, convolve, crop,- makeImage, readImage, resize, transpose, (|*|))-import Graphics.Image.Interface (toVector)-import qualified Graphics.Image.Interface as Hip-import Median (median)+import qualified Codec.Picture as JuicyPixels+import Codec.Picture.WebP (decodeRgb8)+import Control.Monad.ST (runST)+import Data.Bits (Bits, popCount, shiftL, xor, (.|.))+import qualified Data.ByteString as BS+import Data.List (isSuffixOf)+import qualified Data.Vector.Generic as V+import qualified Data.Vector.Storable as VS+import Data.Word (Word64, Word8)+import Graphics.Image (Array, Bilinear (..), Border (Edge, Reflect), Image,+ Pixel (PixelX, PixelY), RGB, RSU (..), VS, X, Y,+ convert, convolve, crop, makeImage, readImage,+ resize, transpose, (|*|))+import Graphics.Image.Interface (fromVector, toVector)+import qualified Graphics.Image.Interface as Hip+import Graphics.Image.Interface.Repa (fromRepaArrayS, toRepaArray)+import Median (median) +-- | See+-- [wiki](https://en.wikipedia.org/wiki/Hamming_distance#Algorithm_example).+--+-- @since 0.1.4.0+{-# SPECIALIZE hammingDistance :: Word64 -> Word64 -> Int #-}+hammingDistance :: Bits a => a -> a -> Int+hammingDistance x y = popCount (x `xor` y)+ dct32 :: (Floating e, Array arr Y e) => Image arr Y e dct32 = makeImage (32,32) gen where gen (i,j) = PixelY $ sqrt(2/n) * cos((fromIntegral ((2*i) * (j-1)) * pi)/(2*n))@@ -61,5 +77,24 @@ let med = medianImmut v in V.map (<med) v +fileWebp :: FilePath -> IO (Image VS RGB Word8)+fileWebp fp = do+ contents <- BS.readFile fp+ let (JuicyPixels.Image m n pixels) = decodeRgb8 contents+ pure $ fromVector (m, n) $ VS.unsafeCast pixels++readWebp :: FilePath -> IO (Image VS Y Double)+readWebp = fmap convert . fileWebp++-- | @since 0.1.5.0+fileHashWebp :: FilePath -> IO Word64+fileHashWebp = fmap (imgHash . convRepa) . readWebp+ -- faster+ where convRepa = fromRepaArrayS . toRepaArray+ fileHash :: FilePath -> IO (Either String Word64)-fileHash = fmap (fmap (imgHash :: Image RSU Y Double -> Word64)) . readImage+fileHash fp | ".webp" `isSuffixOf` fp = pure <$> fileHashWebp fp+ | otherwise = fileHashHip fp++fileHashHip :: FilePath -> IO (Either String Word64)+fileHashHip = fmap (fmap (imgHash :: Image RSU Y Double -> Word64)) . readImage
test/Spec.hs view
@@ -1,5 +1,3 @@--- vim: syntax=hspec- import PerceptualHash (fileHash) import Test.Hspec @@ -21,3 +19,8 @@ actual <- fileHash "demo-data/cat.png" expected <- fileHash "demo-data/frog.png" actual `shouldSatisfy` (/= expected)++ parallel $ it "should match when same" $ do+ actual <- fileHash "demo-data/liz-taylor.webp"+ expected <- fileHash "demo-data/liz-taylor.png"+ actual `shouldBe` expected