chain-codes 0.2.0.0 → 0.3.0.0
raw patch · 8 files changed
+392/−23 lines, 8 filesdep +chain-codesdep +hspecdep ~basebinary-added
Dependencies added: chain-codes, hspec
Dependency ranges changed: base
Files
- chain-codes.cabal +25/−1
- src/Data/ChainCodes.hs +36/−22
- test/Data/ChainCodes/Blobs.hs +294/−0
- test/Data/ChainCodes/ChainSpec.hs +36/−0
- test/Spec.hs +1/−0
- test/res/a.gif binary
- test/res/b.gif binary
- test/res/c.gif binary
chain-codes.cabal view
@@ -1,5 +1,5 @@ name: chain-codes-version: 0.2.0.0+version: 0.3.0.0 synopsis: Library decoding chain codes from images description: Library decoding chain codes from images homepage: http://github.com/Fuuzetsu/chain-codes@@ -10,9 +10,33 @@ category: Data build-type: Simple cabal-version: >=1.10+extra-source-files: test/res/*.gif + library exposed-modules: Data.ChainCodes build-depends: base >=4.6 && <5, JuicyPixels, containers hs-source-dirs: src default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ main-is: Spec.hs++ hs-source-dirs:+ test+ , src++ other-modules:+ Data.ChainCodes.ChainSpec+ Data.ChainCodes.Blobs++ build-depends:+ base+ , hspec+ , JuicyPixels+ , containers++ build-depends:+ chain-codes
src/Data/ChainCodes.hs view
@@ -39,29 +39,43 @@ Left err → Left err -- | Given an 'Image' parametrised by 'PixelRGB8' and given a--- 'Colour', we try to find the first pixel that matches the 'Colour'.+-- background 'Colour', we try to find the first pixel that doesn't match the+-- 'Colour'. -- -- We start checking at the top left corner of the image, checking each row--- fully before progressing a column: we check @(width, height)@ then--- @(width, height + 1)@ and so on where top left corner of the image is (0, 0)--- and positive height is towards the bottom.+-- fully before progressing a column: we check @(height, width)@ then+-- @(height, width + 1)@ and so on where top left corner of the image is (0, 0)+-- and positive height is towards the bottom. Uses colour 'average' for+-- comparison with a small leeway of 1. findSpot ∷ Image PixelRGB8 → Colour → Maybe Position findSpot img@(Image w h d) c | w <= 0 || h <= 0 = Nothing | otherwise =- go [ (wi, hi) | wi ← [0 .. w - 1], hi ← [0 .. h - 1] ]+ go [ (hi, wi) | wi ← [0 .. w - 1], hi ← [0 .. h - 1] ] where go ∷ [(Int, Int)] → Maybe Position go [] = Nothing- go (x:xs) = if uncurry (pixelAt img) x == c- then Just x- else go xs+ go (x:xs) = let ac = average c+ ap = average $ uncurry (pixelAt img) x+ in if 1 < abs (ac - ap) then Just x else go xs +-- | Averages each colour value and sees how close it is too fully-white.+intensity ∷ PixelRGB8 → Double+intensity p = fromIntegral (average p) / 255++-- | Takes the average of RGB values+average ∷ PixelRGB8 → Integer+average (PixelRGB8 r g b) = toInteger $ r `div` 3 + g `div` 3 + b `div` 3++-- | Specialised version of 'chainCodeWith' which uses a comparison function+-- which simply asserts that the shape colour is not the same as the background.+chainCode ∷ Image PixelRGB8 → Colour → Maybe ChainCode+chainCode i c = chainCodeWith i c (/= c)+ -- | Given an 'Image' parametrised by 'PixelRGB8' and given a--- 'Colour', we try to find the chain code in the binary image which has--- the passed in colour. Note that this is the colour of your shape and any--- other colour is assumed to be the background: to process a black shape, pass--- in a black colour.+-- 'Colour' and a comparison function, we try to find the chain code in the+-- binary image which has the passed in colour. The comparison function's+-- purpose is to tell whether something is part of the shape. -- -- Note that only a single shape is accepted inside of the image. The -- starting positing is determined using 'findSpot'.@@ -69,10 +83,10 @@ -- The output list contains unique positions only: the beginning and -- end position are not treated the same. If 'findSpot' fails, we return -- 'Nothing'.-chainCode ∷ Image PixelRGB8 → Colour → Maybe ChainCode-chainCode img@(Image w h d) c = findSpot img c >>= \pos →+chainCodeWith ∷ Image PixelRGB8 → Colour → (Colour → Bool) → Maybe ChainCode+chainCodeWith img@(Image w h d) c f = findSpot img c >>= \pos → let ppos = (fst pos, snd pos, 0)- in Just $ go [0 ..] (fromList [(0, ppos)]) ppos+ in Just $ go [1 ..] (fromList [(0, (-1, -1, 0)), (1, ppos)]) ppos where ns ∷ Map Int (Int, Int) ns = fromList $ zip [0 ..]@@ -80,25 +94,25 @@ , (0, -1), (-1, -1), (-1, 0), (-1, 1)] go ∷ [Int] → Map Int PixelPos → PixelPos → ChainCode- go (count:counts) positions p@(sx, sy, _) =- map snd . toList $ loop (count:counts) positions+ go cs positions p@(sx, sy, _) =+ map snd . toList $ loop cs positions where loop ∷ [Int] → Map Int PixelPos → Map Int PixelPos loop (count:counts) positions- | count == 0 || not (eqV positions count) =+ | count == 1 || not (eqV positions count) = let current@(fx, fy, fd) = positions ! count inBounds (x, y) = x >= 0 && y >= 0 && x < w && y < h- places = [ (mx, my, m) | i ← [5 + fd .. fd + 13]+ places = [ (mx, my, m) | i ← [fd + 5 .. fd + 13] , let m = i `mod` 8 (nx, ny) = ns ! m- o@(mx, my) = (fx + nx, fy + ny)+ o@(mx, my) = (fx + ny, fy + nx) , inBounds o- , uncurry (pixelAt img) o == c+ , f $ uncurry (pixelAt img) o ] in loop counts $ case places of [] → positions x:_ → insert (count + 1) x positions- | otherwise = delete 0 positions+ | otherwise = delete 1 (delete 0 positions) eqV ∷ Map Int PixelPos → Int → Bool eqV p i = let (x, y, _) = p ! i
+ test/Data/ChainCodes/Blobs.hs view
@@ -0,0 +1,294 @@+{-# LANGUAGE UnicodeSyntax #-}+-- | Module with some chaincode dumps+module Data.ChainCodes.Blobs where++import Data.ChainCodes++-- The values we're getting are from model MATLAB program which indexes images+-- from 1, so we use this helper to change lower our results.+reduce (x, y, z) = (x - 1, y - 1, z)++-- a.gif chaincode+agifChain ∷ ChainCode+agifChain = map reduce+ [ (69, 3, 1)+ , (69, 4, 2)+ , (69, 5, 2)+ , (70, 6, 1)+ , (70, 7, 2)+ , (71, 8, 1)+ , (71, 9, 2)+ , (71, 10, 2)+ , (72, 11, 1)+ , (72, 12, 2)+ , (72, 13, 2)+ , (73, 14, 1)+ , (73, 15, 2)+ , (73, 16, 2)+ , (74, 17, 1)+ , (74, 18, 2)+ , (74, 19, 2)+ , (75, 20, 1)+ , (75, 21, 2)+ , (75, 22, 2)+ , (75, 23, 2)+ , (76, 24, 1)+ , (76, 25, 2)+ , (76, 26, 2)+ , (77, 27, 1)+ , (77, 28, 2)+ , (77, 29, 2)+ , (78, 30, 1)+ , (78, 31, 2)+ , (78, 32, 2)+ , (79, 33, 1)+ , (79, 34, 2)+ , (80, 35, 1)+ , (80, 36, 2)+ , (80, 37, 2)+ , (81, 38, 1)+ , (81, 39, 2)+ , (82, 40, 1)+ , (83, 39, 7)+ , (84, 38, 7)+ , (85, 37, 7)+ , (86, 37, 0)+ , (87, 36, 7)+ , (88, 35, 7)+ , (89, 34, 7)+ , (90, 33, 7)+ , (91, 32, 7)+ , (92, 32, 0)+ , (93, 31, 7)+ , (94, 30, 7)+ , (95, 29, 7)+ , (96, 28, 7)+ , (97, 27, 7)+ , (98, 27, 0)+ , (99, 26, 7)+ , (100, 25, 7)+ , (101, 24, 7)+ , (102, 23, 7)+ , (103, 22, 7)+ , (104, 22, 0)+ , (105, 21, 7)+ , (106, 20, 7)+ , (107, 19, 7)+ , (108, 18, 7)+ , (109, 17, 7)+ , (110, 17, 0)+ , (111, 16, 7)+ , (112, 15, 7)+ , (113, 14, 7)+ , (114, 13, 7)+ , (115, 12, 7)+ , (116, 12, 0)+ , (117, 11, 7)+ , (118, 10, 7)+ , (119, 9, 7)+ , (120, 9, 0)+ , (120, 10, 2)+ , (119, 11, 3)+ , (119, 12, 2)+ , (118, 13, 3)+ , (117, 14, 3)+ , (117, 15, 2)+ , (116, 16, 3)+ , (115, 17, 3)+ , (115, 18, 2)+ , (114, 19, 3)+ , (113, 20, 3)+ , (113, 21, 2)+ , (112, 22, 3)+ , (111, 23, 3)+ , (111, 24, 2)+ , (110, 25, 3)+ , (109, 26, 3)+ , (109, 27, 2)+ , (108, 28, 3)+ , (107, 29, 3)+ , (107, 30, 2)+ , (106, 31, 3)+ , (105, 32, 3)+ , (105, 33, 2)+ , (104, 34, 3)+ , (103, 35, 3)+ , (103, 36, 2)+ , (102, 37, 3)+ , (101, 38, 3)+ , (101, 39, 2)+ , (100, 40, 3)+ , (100, 41, 2)+ , (99, 42, 3)+ , (98, 43, 3)+ , (98, 44, 2)+ , (97, 45, 3)+ , (96, 46, 3)+ , (96, 47, 2)+ , (95, 48, 3)+ , (94, 49, 3)+ , (93, 50, 3)+ , (93, 51, 2)+ , (92, 52, 3)+ , (91, 53, 3)+ , (91, 54, 2)+ , (90, 55, 3)+ , (89, 56, 3)+ , (89, 57, 2)+ , (88, 58, 3)+ , (87, 59, 3)+ , (87, 60, 2)+ , (86, 61, 3)+ , (85, 62, 3)+ , (85, 63, 2)+ , (84, 64, 3)+ , (83, 65, 3)+ , (83, 66, 2)+ , (82, 67, 3)+ , (81, 68, 3)+ , (81, 69, 2)+ , (80, 70, 3)+ , (79, 71, 3)+ , (79, 72, 2)+ , (78, 73, 3)+ , (77, 74, 3)+ , (77, 75, 2)+ , (76, 76, 3)+ , (76, 77, 2)+ , (75, 78, 3)+ , (74, 79, 3)+ , (73, 78, 5)+ , (72, 77, 5)+ , (72, 76, 6)+ , (71, 75, 5)+ , (70, 74, 5)+ , (70, 73, 6)+ , (69, 72, 5)+ , (68, 71, 5)+ , (68, 70, 6)+ , (67, 69, 5)+ , (66, 68, 5)+ , (66, 67, 6)+ , (65, 66, 5)+ , (64, 65, 5)+ , (64, 64, 6)+ , (63, 63, 5)+ , (62, 62, 5)+ , (62, 61, 6)+ , (61, 60, 5)+ , (60, 59, 5)+ , (60, 58, 6)+ , (59, 57, 5)+ , (58, 56, 5)+ , (58, 55, 6)+ , (57, 54, 5)+ , (56, 53, 5)+ , (56, 52, 6)+ , (55, 51, 5)+ , (54, 50, 5)+ , (53, 49, 5)+ , (53, 48, 6)+ , (52, 47, 5)+ , (51, 46, 5)+ , (51, 45, 6)+ , (50, 44, 5)+ , (49, 43, 5)+ , (49, 42, 6)+ , (48, 41, 5)+ , (47, 40, 5)+ , (47, 39, 6)+ , (46, 38, 5)+ , (45, 37, 5)+ , (45, 36, 6)+ , (44, 35, 5)+ , (43, 34, 5)+ , (43, 33, 6)+ , (42, 32, 5)+ , (41, 31, 5)+ , (41, 30, 6)+ , (40, 29, 5)+ , (39, 28, 5)+ , (39, 27, 6)+ , (38, 26, 5)+ , (37, 25, 5)+ , (37, 24, 6)+ , (36, 23, 5)+ , (35, 22, 5)+ , (35, 21, 6)+ , (34, 20, 5)+ , (33, 19, 5)+ , (33, 18, 6)+ , (32, 17, 5)+ , (31, 16, 5)+ , (31, 15, 6)+ , (30, 14, 5)+ , (30, 13, 6)+ , (31, 13, 0)+ , (32, 13, 0)+ , (33, 14, 1)+ , (34, 15, 1)+ , (35, 16, 1)+ , (36, 17, 1)+ , (37, 18, 1)+ , (38, 18, 0)+ , (39, 19, 1)+ , (40, 20, 1)+ , (41, 21, 1)+ , (42, 22, 1)+ , (43, 23, 1)+ , (44, 23, 0)+ , (45, 24, 1)+ , (46, 25, 1)+ , (47, 26, 1)+ , (48, 27, 1)+ , (49, 28, 1)+ , (50, 28, 0)+ , (51, 29, 1)+ , (52, 30, 1)+ , (53, 31, 1)+ , (54, 32, 1)+ , (55, 33, 1)+ , (56, 33, 0)+ , (57, 34, 1)+ , (58, 35, 1)+ , (59, 36, 1)+ , (60, 37, 1)+ , (61, 38, 1)+ , (62, 38, 0)+ , (63, 37, 7)+ , (63, 36, 6)+ , (63, 35, 6)+ , (63, 34, 6)+ , (63, 33, 6)+ , (64, 32, 7)+ , (64, 31, 6)+ , (64, 30, 6)+ , (64, 29, 6)+ , (64, 28, 6)+ , (64, 27, 6)+ , (64, 26, 6)+ , (65, 25, 7)+ , (65, 24, 6)+ , (65, 23, 6)+ , (65, 22, 6)+ , (65, 21, 6)+ , (65, 20, 6)+ , (65, 19, 6)+ , (66, 18, 7)+ , (66, 17, 6)+ , (66, 16, 6)+ , (66, 15, 6)+ , (66, 14, 6)+ , (66, 13, 6)+ , (66, 12, 6)+ , (67, 11, 7)+ , (67, 10, 6)+ , (67, 9, 6)+ , (67, 8, 6)+ , (67, 7, 6)+ , (67, 6, 6)+ , (68, 5, 7)+ , (68, 4, 6)+ , (68, 3, 6)+ , (68, 2, 6)+ ]
+ test/Data/ChainCodes/ChainSpec.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.ChainCodes.ChainSpec (main, spec) where++import Data.ChainCodes+import Data.ChainCodes.Blobs+import Test.Hspec+import Codec.Picture++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "parseString" $ do+ let img = "test/res/a.gif"+ white = PixelRGB8 255 255 255+ black = PixelRGB8 0 0 0+ red = PixelRGB8 255 0 0+ readImg x = readRGB8 x >>= \case+ Left _ → fail $ "Failed reading " ++ img+ Right s → return s++ it "can find a spot" $ do+ i ← readImg img+ findSpot i black `shouldBe`Just (67, 1)++ it "fails with Nothing when it can't find a spot" $ do+ i ← readImg "test/res/c.gif"+ findSpot i red `shouldBe` Nothing++ it "can read in the correct chaincode" $ do+ i ← readImg img+ chainCode i black `shouldBe` Just agifChain
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/res/a.gif view
binary file changed (absent → 1839 bytes)
+ test/res/b.gif view
binary file changed (absent → 599 bytes)
+ test/res/c.gif view
binary file changed (absent → 62 bytes)