color-counter (empty) → 0.1.2.1

raw patch · 13 files changed

+807/−0 lines, 13 filesdep +aesondep +basedep +cmdargssetup-changedbinary-added

Dependencies added: aeson, base, cmdargs, colour, containers, data-default, directory, friday, friday-devil, split, v4l2, vector, vector-space, yaml

Files

• LICENSE +20/−0
• ReadMe.md +74/−0
• Setup.hs +2/−0
• color-counter.cabal +79/−0
• data/R/classifications.png binary
• data/R/observations.png binary
• data/R/quantized.png binary
• data/configuration.yaml +57/−0
• data/sample.jpg binary
• src/Main.hs +213/−0
• src/Vision/Image/Color/Detection.hs +252/−0
• src/Vision/Image/IO.hs +59/−0
• src/Vision/Image/IO/Capture.hs +51/−0

@@ -0,0 +1,20 @@+Copyright (c) 2016 Brian W Bush++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,74 @@+Counting colors in images+=========================++This Haskell package contains functions for counting colors in images, either from a file or a camera feed.  The input image must in a standard format like JPEG or PNG.  The analyze function outputs the RGB and CIE-LAB values for each pixel, along with the color detected there.  The tally function outputs a histogram of the colors detected.  The quantize function outputs an image where the pixels have been replaced by the colors detected there.++A command-line tool for detecting and tallying colors is also provided.++Please report issues at <<https://bwbush.atlassian.net/projects/HCC/issues/>>.+++Example+-------++In this example we use [blank colored dice](http://www.amazon.com/dp/B00BNWGVDO) on a gray felt background:++![example input](data/sample.jpg)++We can process this file using the command-line tool:++```bash+  color-counter --analyze=analysis.tsv --tally=tallies.tsv --quantize=quantized.png data/sample.jpg+```++The tally of pixels is as follows:++| Color  | Pixels | Efficiency [pixels/cube] |+|--------|--------|-------------------------:|+| black  | 3222   |                   128.88 |+| blue   | 3285   |                   131.40 |+| green  | 3972   |                   154.88 |+| red    | 3738   |                   149.52 |+| yellow | 4156   |                   166.24 |++One can see that edge and shading effects cause the detection efficiency to vary by color.  The following image shows where colors are detected:++![colors detected](data/R/quantized.png)++Some simple R code can be used to look at the observed pixels in CIE-LAB space, and then compare that to the classification of those pixels:++```R+require(data.table)+analysis <- fread("analysis.tsv")+analysis[, RGB:=rgb(Red/255,Green/255,Blue/255)]+pairs(analysis[, .(L, A, B)], col=analysis$RGB, pch=".", main="Observations")+pairs(analysis[, .(L, A, B)], col=analysis$Color, pch=".", main="Classifications")+```++![observations](data/R/observations.png)++![classifications](data/R/classifications.png)++++Calibration+-----------++The calibration parameters are stored in the `ColorConfiguration` data type of the `Vision.Image.Color.Detection` module.  It contains a default color and a list of `ColorSpecificiation` entries, one for each color to be detected.  All colors must be specified by their [SVG names](https://www.w3.org/TR/SVG/types.html#ColorKeywords).++The `ColorSpecification` entries define the color being detected and a half plane in [CIE-LAB color space](https://en.wikipedia.org/wiki/Lab_color_space#CIELAB).  The color is considered "detected" when it lies deeper than the specified threshold into the half plane defined by the specified vertex and direction.  (The threshold parameter is redundant mathematically with the vertex location, but it is convenient to have such a parameter to make it easy to make minor adjustments to calibration.)  When an observation lies in the half planes for several colors, it is assigned to the one in whose half plane it is deepest.  We have found that calibration using this method of CIE-LAB half planes is robust under widely different lighting conditions.  (Eventually, we will add automatic calibration--see <<https://bwbush.atlassian.net/projects/HCC/issues/HCC-1>> for the status of this.)++Because the detection efficiency varies somewhat by color, an efficiency parameter is included in `ColorSpecification`. For instance, this efficiency can be used to convert the output of the tallying function from pixels to colored cubes.+++Skeletal example code illustrating the tallying of colors in an image+---------------------------------------------------------------------++```haskell+main :: IO ()+main = do+  input <- readRGB "data/sample.jpg"+  print $ tally def input+  let output = quantize def input+  writeRBG True (Nothing, Nothing) "analysis.png" output+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,79 @@+name:                color-counter+version:             0.1.2.1+synopsis:            Count colors in images+description:         This Haskell package contains functions for counting colors in images, either from a file or a camera feed.  The input image must in a standard format like JPEG or PNG.  The analyze function outputs the RGB and CIE-LAB values for each pixel, along with the color detected there.  The tally function outputs a histogram of the colors detected.  The quantize function outputs an image where the pixels have been replaced by the colors detected there.++license:             MIT+license-file:        LICENSE+author:              Brian W Bush <consult@brianwbush.info>+maintainer:          Brian W Bush <consult@brianwbush.info>+copyright:           (c) 2016 Brian W Bush+category:            Graphics+build-type:          Simple+cabal-version:       >= 1.10+homepage:            https://bitbucket.org/functionally/color-counter+bug-reports:         https://bwbush.atlassian.net/projects/HCC/issues/+package-url:         https://bitbucket.org/functinally/color-counter/downloads/color-counter-0.1.2.1.tar.gz++extra-source-files:  ReadMe.md+data-dir: data+data-files: configuration.yaml+            sample.jpg+            R/quantized.png+            R/observations.png+            R/classifications.png++source-repository head+  type: git+  location: https://bwbush@bitbucket.org/bwbush/color-counter.git++flag nocapture+  description: Compile without support for image capture.  (Capture support requires the "v4l2" package which is only available on Linux.) +  default: False++library+  build-depends:       base >= 4.8 && < 5+               ,       aeson+               ,       colour+               ,       containers+               ,       data-default+               ,       directory+               ,       friday+               ,       friday-devil+               ,       split+               ,       vector+               ,       vector-space+               ,       yaml+  exposed-modules:     Vision.Image.Color.Detection+                       Vision.Image.IO+  hs-source-dirs:      src+  exposed:          True+  buildable:        True+  ghc-options:      -Wall+  default-language: Haskell2010+  if !flag(nocapture) && os(linux)+     cpp-options: -DCAPTURE+     build-depends: v4l2+     exposed-modules: Vision.Image.IO.Capture++executable color-counter+  main-is:             Main.hs+  build-depends:       base+               ,       aeson+               ,       colour+               ,       cmdargs+               ,       containers+               ,       data-default+               ,       directory+               ,       friday+               ,       friday-devil+               ,       split+               ,       vector+               ,       vector-space+               ,       yaml+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall+  if !flag(nocapture) && os(linux)+     cpp-options: -DCAPTURE+     build-depends: v4l2

binary file changed (absent → 15319 bytes)

binary file changed (absent → 92482 bytes)

binary file changed (absent → 3104 bytes)

@@ -0,0 +1,57 @@+colorSpecifications:+- svgColor: green+  labVertex:+  - 0+  - 0+  - 5+  labDirection:+  - 0+  - -50+  - 25+  labThreshold: 15+  efficiency: 1+- svgColor: yellow+  labVertex:+  - 0+  - 0+  - 5+  labDirection:+  - 0+  - 0+  - 75+  labThreshold: 15+  efficiency: 1+- svgColor: blue+  labVertex:+  - 0+  - 0+  - 5+  labDirection:+  - 0+  - 10+  - -55+  labThreshold: 15+  efficiency: 1+- svgColor: red+  labVertex:+  - 0+  - 0+  - 5+  labDirection:+  - 0+  - 70+  - 45+  labThreshold: 15+  efficiency: 1+- svgColor: black+  labVertex:+  - 25+  - 0+  - 0+  labDirection:+  - -1+  - 0+  - 0+  labThreshold: 0+  efficiency: 1+svgDefault: gray

binary file changed (absent → 11948 bytes)

@@ -0,0 +1,213 @@+{-|+Module      :  Main+Copyright   :  (c) 2016 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Main entry.+-}+++{-# LANGUAGE CPP                 #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE RecordWildCards     #-}+++module Main (+-- * Main entry.+  main+) where+++import Control.Monad (unless)+import Data.Data (Data)+import Data.Typeable (Typeable)+import Data.Version (showVersion)+import Data.Yaml (decodeFile, encodeFile)+import Paths_color_counter (version)+import System.Console.CmdArgs ((&=), argPos, auto, cmdArgs, def, details, help, modes, name, opt, program, summary, typ, typFile)+import Vision.Image (RGBPixel(..))+import Vision.Image.IO (readRGB, writeRGB)+#ifdef CAPTURE+import Vision.Image.IO.Capture (captureRGB)+#endif++import qualified Data.Default as D (def)+import qualified Vision.Image.Color.Detection as C (ColorConfiguration, analyze, quantize, effectiveTally)+++stringVersion :: String+stringVersion = showVersion version ++ " (2016)"+++main :: IO ()+main =+  do+    command <- cmdArgs imager+    dispatch command+++imager :: Imager+imager =+  modes+    [+      process+    , defaults+#ifdef CAPTURE+    , capture+#endif+    ]+      &= program "color-counter"+      &= summary ("Color Counter, Version " ++ stringVersion)+      &= help "This tool detects and counts colors in an image or in a camera feed."+++data Imager =+    Process+    {+      configuration :: FilePath+    , input         :: FilePath+#ifdef CAPTURE+    , device        :: Bool+#endif+    , analyze       :: FilePath+    , tally         :: FilePath+    , quantize      :: FilePath+    , width         :: Maybe Int+    , height        :: Maybe Int+    }+  | Defaults+    {+      configuration :: FilePath+    }+#ifdef CAPTURE+  | Capture+    {+      input         :: FilePath+    , output        :: FilePath+    , width         :: Maybe Int+    , height        :: Maybe Int+    }+#endif+    deriving (Data, Show, Typeable)+++process :: Imager+process =+  Process+  {+    configuration  = def+                  &= typFile+                  &= help "YAML or JSON configuration file"+  , input          = def+                  &= opt "/dev/stdin"+                  &= typ "INPUT_IMAGE"+                  &= argPos 0+#ifdef CAPTURE+  , device         = def+                  &= typ "BOOLEAN"+                  &= help "the input is a Video for Linux device instead of a file"+#endif+  , analyze        = def+                  &= opt "/dev/stdout"+                  &= typFile+                  &= help "tab-separated-value file for pixel-by-pixel analysis"+  , tally          = def+                  &= opt "/dev/stdout"+                  &= typFile+                  &= help "tab-separated-value file for counts of pixels, by color"+  , quantize       = def+                  &= typFile+                  &= help "image file with quantized colors"+  , width          = def+                  &= help "width of output image"+  , height         = def+                  &= help "height of output image"+  }+    &= name "process"+    &= help "Process an image."+    &= details ["The input image must in a standard format like JPEG or PNG.  The analyze flag outputs the RGB and CIE-LAB values for each pixel, along with the color detected there.  The tally flag outputs a histogram of the colors detected.  The quantize flag outputs an image where the pixels have been replaced by the colors detected there.  The file extension must be that of a common format like PNG."]+    &= auto+++defaults :: Imager+defaults =+  Defaults+  {+    configuration  = def+                  &= opt "/dev/stdout"+                  &= typFile+                  &= help "YAML or JSON configuration file"+  }+    &= name "defaults"+    &= help "Write a default configuration file."+    &= details ["The default configuration file is written in YAML format.  SVG names are used to specify colors.  The 'svgDefault' field specifies the color to be used when no color is detected.  Each of the entries in 'colorSpecifications' specifies how to detect the color given by 'svgColor'.  The 'labVertex' and 'labDirection' fields specify a half plane in CIE LAB color space.  The given color is considered to be detected with probability 'efficiency' if its distance into the half plane is at least 'labThreshold'."]+++#ifdef CAPTURE+capture :: Imager+capture =+  Capture+  {+    input          = def+                  &= typ "DEVICE"+                  &= argPos 0+  , output         = def+                  &= typ "OUTPUT_IMAGE"+                  &= argPos 1+  , width          = def+                  &= help "width of output image"  -- FIXME: This does not appear in the help message.+  , height         = def+                  &= help "height of output image"  -- FIXME: This does not appear in the help message.+  }+    &= name "capture"+    &= help "Capture an image from a device."+    &= details ["The input must be a Video for Linux devices such as /dev/video0.  The file extension for the output must be that of a common format like PNG."]+#endif+++dispatch :: Imager -> IO ()++dispatch Process{..} =+  do+    Just configuration' <- if null configuration then return (Just D.def) else decodeFile configuration :: IO (Maybe (C.ColorConfiguration Double))+    image <-+#ifdef CAPTURE+      if device+        then captureRGB input (width, height)+        else readRGB input+#else+      readRGB input+#endif+    unless (null analyze)+      $ writeFile analyze+      $ unlines+      $ (("Red" +++ "Green" +++ "Blue" +++ "L" +++ "A" +++ "B" +++ "Color") :)+      $ map (\(RGBPixel{..}, (l, a, b), color) -> show rgbRed +++ show rgbGreen +++ show rgbBlue +++ show l +++ show a +++ show b +++ color)+      $ C.analyze configuration' image+    unless (null tally)+      $ writeFile tally+      $ unlines+      $ (("Color" +++ "Pixels") :)+      $ map (\(color, count) -> color +++ show count)+      $ C.effectiveTally configuration' image+    unless (null quantize)+      $ writeRGB True (width, height) quantize+      $ C.quantize configuration' image++dispatch Defaults{..} =+  encodeFile configuration (D.def :: C.ColorConfiguration Double)++#ifdef CAPTURE+dispatch Capture{..} =+  do+    image <- captureRGB input (width, height)+    writeRGB True (width, height) output image+#endif+++infixr 5 ++++(+++) :: String -> String -> String+x +++ y = x ++ "\t" ++ y

@@ -0,0 +1,252 @@+{-|+Module      :  Vision.Image.Color.Detection+Copyright   :  (c) 2016 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Color detection.+-}+++{-# LANGUAGE DeriveGeneric    #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards  #-}+{-# LANGUAGE TupleSections    #-}+{-# LANGUAGE TypeFamilies     #-}+++module Vision.Image.Color.Detection (+-- * Configuration+  ColorConfiguration(..)+, ColorSpecification(..)+, OptimizedConfiguration+, OptimizedSpecification+, optimizeConfiguration+, optimizeSpecification+-- * Classification+, classify+, measure+, quantize+, analyze+, tally+, effectiveTally+) where+++import Control.Monad (ap)+import Data.Aeson (FromJSON, ToJSON(toJSON), defaultOptions, genericToJSON)+import Data.AffineSpace (AffineSpace, Diff, (.-.))+import Data.Colour.CIE (Colour, cieLABView)+import Data.Colour.CIE.Illuminant (d65)+import Data.Colour.Names (readColourName)+import Data.Colour.RGBSpace (uncurryRGB)+import Data.Colour.SRGB (sRGB24, toSRGB24)+import Data.Default (Default(..))+import Data.Function (on)+import Data.List (maximumBy)+import Data.Maybe (fromJust, mapMaybe)+import Data.VectorSpace (InnerSpace, Scalar, (<.>), normalized)+import GHC.Generics (Generic)+import Vision.Image (RGB, RGBPixel(..), manifestVector)++import qualified Data.Map.Strict as M ((!), fromList, insert, toList)+import qualified Data.Vector.Storable as V (toList)+import qualified Vision.Image.Class as I (map)+++-- | Configuration for color detection.+data ColorConfiguration a =+  ColorConfiguration+  {+    colorSpecifications  :: [ColorSpecification a] -- ^ Specification of colors.+  , svgDefault           :: String                 -- ^ Default color.+  }+    deriving (Eq, Generic, Ord, Read, Show)++instance (FromJSON a, Generic a) => FromJSON (ColorConfiguration a)++instance (ToJSON a, Generic a) => ToJSON (ColorConfiguration a) where+  toJSON = genericToJSON defaultOptions++instance Num a => Default (ColorConfiguration a) where+  def =+    ColorConfiguration+      [+        ColorSpecification "green"  ( 0, 0, 5) ( 0, -50,  25) 15 1+      , ColorSpecification "yellow" ( 0, 0, 5) ( 0,   0,  75) 15 1+      , ColorSpecification "blue"   ( 0, 0, 5) ( 0,  10, -55) 15 1+      , ColorSpecification "red"    ( 0, 0, 5) ( 0,  70,  45) 15 1+      , ColorSpecification "black"  (25, 0, 0) (-1,   0,   0)  0 1+      ]+      "gray"+++-- | An optimized version of a configuration for color detection.+data OptimizedConfiguration a =+  OptimizedConfiguration+  {+    optimizedSpecifications :: [OptimizedSpecification a] -- ^ Optimized versions of the specifications.+  , optimizedDefault        :: (String, RGBPixel)         -- ^ Optimized version of the default color.+  }+++-- | Optimize a configuration fo color detection.+optimizeConfiguration :: (InnerSpace a, Floating (Scalar a))+                       => ColorConfiguration a      -- ^ The configuration.+                       -> OptimizedConfiguration a  -- ^ An optimized version of the configuration.+optimizeConfiguration ColorConfiguration{..} =+  OptimizedConfiguration+    {+      optimizedSpecifications = map optimizeSpecification colorSpecifications+    , optimizedDefault        = optimizeColor svgDefault+    }+++-- | Specification for detecting a color.+data ColorSpecification a =+  ColorSpecification+  {+    svgColor       :: String   -- ^ The color.+  , labVertex     :: (a, a, a) -- ^ A CIE-LAB point on the separating plane.+  , labDirection  :: (a, a, a) -- ^ A CIE-LAB direction pointing into the half plane.+  , labThreshold  :: a         -- ^ The distance beyond which the color is detected in the half plane.+  , efficiency    :: a         -- ^ The detection efficiency.+  }+    deriving (Eq, Generic, Ord, Read, Show)++instance (FromJSON a, Generic a) => FromJSON (ColorSpecification a)++instance (ToJSON a, Generic a) => ToJSON (ColorSpecification a) where+  toJSON = genericToJSON defaultOptions+++-- An optimized version of a specification for detecting a color.+data OptimizedSpecification a =+  OptimizedSpecification+  {+    optimizedColor      :: (String, RGBPixel) -- ^ The color.+  , optimizedVertex     :: (a, a, a)          -- ^ A CIE-LAB point on the separating plane.+  , optimizedDirection  :: (a, a, a)          -- ^ A CIE-LAB direction pointing into the half plane.+  , optimizedThreshold  :: a                  -- ^ The distance beyond which the color is detected in the half plane.+  }+++-- | Optimize a specification for detecting a color.+optimizeSpecification :: (InnerSpace a, Floating (Scalar a))+                      => ColorSpecification a     -- ^ The specification.+                      -> OptimizedSpecification a -- ^ An optimized version of the specification.+optimizeSpecification ColorSpecification{..} =+  OptimizedSpecification+    {+      optimizedColor     = optimizeColor svgColor+    , optimizedVertex    = labVertex+    , optimizedDirection = normalized labDirection+    , optimizedThreshold = labThreshold+    }+++-- | Optimize the representation of a color.+optimizeColor :: String             -- ^ The name of the color.+              -> (String, RGBPixel) -- ^ The name of the color and its RGB representation.+optimizeColor =+  ap (,)+    $ uncurryRGB RGBPixel+    . toSRGB24+    . fromJust+    . (readColourName :: String -> Maybe (Colour Double))+++-- | Replace the colors in an image with the colors detected there.+quantize :: (AffineSpace a, InnerSpace a, RealFloat a, a ~ Scalar (a, a, a), a ~ Diff a)+         => ColorConfiguration a -- ^ The configuration for detecting the colors.+         -> RGB                  -- ^ The original image.+         -> RGB                  -- ^ The recolored image.+quantize colorConfiguration =+  I.map+    $ snd+    . snd+    . classify (optimizeConfiguration colorConfiguration)+++-- | Retrieve the pixels in an image.+pixels :: RGB        -- ^ The image.+       -> [RGBPixel] -- ^ The pixels.+pixels = V.toList . manifestVector+++-- | List the colors and their detection in an image.+analyze :: (AffineSpace a, InnerSpace a, RealFloat a, a ~ Scalar (a, a, a), a ~ Diff a)+        => ColorConfiguration a            -- ^ The configuration for detecting the colors.+        -> RGB                             -- ^ The image.+        -> [(RGBPixel, (a, a, a), String)] -- ^ The RGB value, CIE-LAB value, and detected color for the pixels in the image.+analyze colorConfiguration image =+  [+    (p, lab, color)+  |+    p <- pixels image+  , let (lab, (color, _)) = classify optimizedConfiguration p+  ]+    where+      optimizedConfiguration = optimizeConfiguration colorConfiguration+++-- | Tally the colors detected in an image.+tally :: (AffineSpace a, InnerSpace a, RealFloat a, a ~ Scalar (a, a, a), a ~ Diff a)+      => ColorConfiguration a -- ^ The configuration for detecting the colors.+      -> RGB                  -- ^ The image.+      -> [(String, Int)]      -- ^ The detected colors and the number of times they occur in the image.+tally colorConfiguration@ColorConfiguration{..} =+  let+    zero = M.fromList $ map (, 0) $ (svgDefault :) $ map svgColor colorSpecifications+    visit counts (_, _, color) =+      let+        count = counts M.! color+      in+        M.insert color (count + 1) counts+  in+    M.toList+      . foldl visit zero+      . analyze colorConfiguration+++-- | Tally the colors detected in an image, including correction for detection efficiency.+effectiveTally :: (Show a, AffineSpace a, InnerSpace a, RealFloat a, a ~ Scalar (a, a, a), a ~ Diff a)+               => ColorConfiguration a -- ^ The configuration for detecting the colors.+               -> RGB                  -- ^ The image.+               -> [(String, a)]        -- ^ The detected colors and the number of times they occur in the image.+effectiveTally colorConfiguration@ColorConfiguration{..} =+  zipWith (\ColorSpecification{..} (color, count) -> (color, fromIntegral count / efficiency)) colorSpecifications+    . filter ((/= svgDefault) . fst)+    . tally colorConfiguration+    ++-- | Detect the color of a pixel.+classify :: (AffineSpace a, InnerSpace a, RealFloat a, a ~ Scalar (a, a, a), a ~ Diff a)+         => OptimizedConfiguration a        -- ^ The configuration for detecting the colors.+         -> RGBPixel                        -- ^ The pixel.+         -> ((a, a, a), (String, RGBPixel)) -- ^ The CIE-LAB value, the detected color, and the pixel.+classify OptimizedConfiguration{..} RGBPixel{..} =+  let+    lab = cieLABView d65 $ sRGB24 rgbRed rgbGreen rgbBlue+  in+    (lab, )+      $ snd+      $ maximumBy (compare `on` fst)+      $ (++ [(-100000, optimizedDefault)])+      $ mapMaybe (measure lab) optimizedSpecifications+++-- | Measure the distance of a pixel into a half plan for a color.+measure :: (AffineSpace a, InnerSpace a, Ord a, a ~ Scalar (a, a, a), a ~ Diff a)+        => (a, a, a)                     -- ^ The pixel's CIE-LAB value.+        -> OptimizedSpecification a      -- ^ The specification for the color.+        -> Maybe (a, (String, RGBPixel)) -- ^ The distance into the half plane, the color, and its pixel representation.+measure lab OptimizedSpecification{..} =+  let+    distance = (lab .-. optimizedVertex) <.> optimizedDirection+  in+    if distance > optimizedThreshold+      then Just (distance, optimizedColor)+      else Nothing

@@ -0,0 +1,59 @@+{-|+Module      :  Vision.Image.IO+Copyright   :  (c) 2016 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Image input/output.+-}+++{-# LANGUAGE TypeOperators #-}+++module Vision.Image.IO (+-- * Input/output+  readRGB+, writeRGB+) where+++import Control.Monad (when)+import Data.Maybe (fromMaybe)+import System.Directory (doesFileExist, removeFile)+import Vision.Image (RGB)+import Vision.Image.Type (manifestSize)+import Vision.Image.Storage.DevIL (Autodetect(..), StorageError, load, save)+import Vision.Image.Transform (InterpolMethod(TruncateInteger), resize)+import Vision.Primitive.Shape (Z(..), (:.)(..), ix2)+++-- | Read an image from a file.+readRGB :: FilePath  -- ^ The path to the file.+        -> IO RGB    -- ^ An action for reading the image as RGB.+readRGB path =+  do+    image <- load Autodetect path :: IO (Either StorageError RGB)+    either (error . show) return image+++-- | Write an image to a file.+writeRGB :: Bool                   -- ^ Whether to overwrite the file if it already exists.+         -> (Maybe Int, Maybe Int) -- ^ The width and height for the output image.+         -> FilePath               -- ^ The path to the file.+         -> RGB                    -- ^ The image.+         -> IO ()                  -- ^ An action to write the image.+writeRGB overwrite (width, height) path image =+  do+    exists <- doesFileExist path+    let+      size' = manifestSize image+      Z :. height' :. width' = size'+      size = fromMaybe height' height `ix2` fromMaybe width' width+      image' = if size == size' then image else resize TruncateInteger size image+    when (overwrite && exists)+      $ removeFile path+    status <- save Autodetect path image'+    maybe (return ()) (error . show) status

@@ -0,0 +1,51 @@+{-|+Module      :  Vision.Image.IO.Capture+Copyright   :  (c) 2016 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Image capture.+-}+++{-# LANGUAGE RecordWildCards #-}+++module Vision.Image.IO.Capture (+-- * Input/output+  captureRGB+) where+++import Data.List.Split (chunksOf)+import Data.Maybe (fromMaybe)+import Foreign.Storable (peekElemOff)+import Graphics.V4L2 (Direction(Capture), ImageFormat(..), PixelFormat(PixelRGB24), imagePixelFormat, getFormat, setFormat, withDevice, withFrame)+import Vision.Image (RGB, RGBPixel(..))+import Vision.Image.Type (Manifest(..))+import Vision.Primitive.Shape (ix2)++import qualified Data.Vector.Storable as V (fromList)+++-- | Capture an image from a Video for Linux device.+captureRGB :: FilePath               -- ^ The device name.+           -> (Maybe Int, Maybe Int) -- ^ The width and height for the output image.+           -> IO RGB                 -- ^ An action to capture one image frame.+captureRGB deviceName (width, height) =+  withDevice deviceName $ \device -> do+    format <- setFormat device Capture . (\format@ImageFormat{..} -> format {imagePixelFormat = PixelRGB24, imageWidth = fromMaybe imageWidth width, imageHeight = fromMaybe imageHeight height}) =<< getFormat device Capture+    let+      w = imageWidth format+      h = imageHeight format+    withFrame device format $ \p n -> do+      raw <- mapM (peekElemOff p) [0..(n - 1)]+      return+        Manifest+          {+            manifestSize   = h `ix2` w+          , manifestVector = V.fromList $ map (\[r, g, b] -> RGBPixel r g b) $ chunksOf 3 raw+          }+