cv-combinators 0.1.1 → 0.1.2

raw patch · 4 files changed

+174/−67 lines, 4 filesdep ~HOpenCVPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: HOpenCV

API changes (from Hackage documentation)

Files

• cv-combinators.cabal +5/−3
• src/AI/CV/ImageProcessors.hs +24/−16
• src/AI/CV/Processor.hs +136/−45
• src/Test.hs +9/−3

@@ -1,15 +1,17 @@ name: cv-combinators-version: 0.1.1+version: 0.1.2 license: BSD3 maintainer: Noam Lewis <jones.noamle@gmail.com> bug-reports: mailto:jones.noamle@gmail.com category: AI, Graphics synopsis: Functional Combinators for Computer Vision description:-   Initial version; using the HOpenCV package as a backend.+   Initial version; using the "HOpenCV" package as a backend.    .    Provides a functional combinator library, naturally expressed as Arrow instances (but also Category, Functor and Applicative).     .+   Online documentation, if not built below, can be found at <http://www.ee.bgu.ac.il/~noamle/>.+   .    Read the module docs for more information.    See the test program (@src/Test.hs@) for example usage.    .@@ -22,7 +24,7 @@    exposed-modules: AI.CV.Processor,                     AI.CV.ImageProcessors    hs-Source-Dirs: src-   build-depends: base >= 3 && < 5, HOpenCV+   build-depends: base >= 3 && < 5, HOpenCV >= 0.1.2    ghc-options: -Wall  executable test-cv-combinators

@@ -20,7 +20,9 @@ -- > cam = camera 0        -- Autodetect camera -- > edge = canny 30 190 3 -- Edge detecting processor using canny operator -- >--- > test = win . edge . cam   -- A processor that captures frames from camera and displays edge-detected version in the window.+-- > test = cam >>> edge >>> win   +--+-- The last expression is a processor that captures frames from camera and displays edge-detected version in the window. -------------------------------------------------------------- module AI.CV.ImageProcessors where @@ -35,9 +37,9 @@  import Foreign.Ptr -type ImageSink      = Processor IO (Ptr IplImage) ()-type ImageSource    = Processor IO ()             (Ptr IplImage)-type ImageProcessor = Processor IO (Ptr IplImage) (Ptr IplImage)+type ImageSink      = IOSink      (Ptr IplImage) +type ImageSource    = IOSource    ()             (Ptr IplImage)+type ImageProcessor = IOProcessor (Ptr IplImage) (Ptr IplImage)   @@ -51,21 +53,16 @@  -- | Runs the processor until a predicate is true, for predicates, and processors that take () as input -- (such as chains that start with a camera).-runTill :: Monad m => Processor m () b -> (b -> m Bool) -> m b+runTill :: IOProcessor () b -> (b -> IO Bool) -> IO b runTill = flip runUntil ()  -- | Name (and type) says it all.-runTillKeyPressed :: (Show a) => Processor IO () a -> IO ()+runTillKeyPressed :: (Show a) => IOProcessor () a -> IO () runTillKeyPressed f = (f `runTill` keyPressed) >> (return ())  ----------------------------------------------------------------------- | A capture device, using OpenCV's HighGui lib's cvCreateCameraCapture--- should work with most webcames. See OpenCV's docs for information.--- This processor outputs the latest image from the camera at each invocation.-camera :: Int -> ImageSource-camera index = processor processQueryFrame allocateCamera fromState releaseNext+capture :: IO (Ptr HighGui.CvCapture) -> ImageSource+capture pCap = processor processQueryFrame allocateCamera fromState releaseNext     where processQueryFrame :: () -> (Ptr CxCore.IplImage, Ptr HighGui.CvCapture)                                 -> IO (Ptr CxCore.IplImage, Ptr HighGui.CvCapture)           processQueryFrame _ (_, cap) = do@@ -74,7 +71,7 @@                      allocateCamera :: () -> IO (Ptr CxCore.IplImage, Ptr HighGui.CvCapture)           allocateCamera _ = do-            cap <- HighGui.cvCreateCameraCapture (fromIntegral index)+            cap <- pCap             newFrame <- HighGui.cvQueryFrame cap             return (newFrame, cap)           @@ -83,6 +80,17 @@                      releaseNext (_, cap) = do             HighGui.cvReleaseCapture $ cap+++-- | A capture device, using OpenCV's HighGui lib's cvCreateCameraCapture+-- should work with most webcames. See OpenCV's docs for information.+-- This processor outputs the latest image from the camera at each invocation.+camera :: Int -> ImageSource+camera index = capture (HighGui.cvCreateCameraCapture (fromIntegral index))++videoFile :: String -> ImageSource+videoFile fileName = capture (HighGui.cvCreateFileCapture fileName)+ ------------------------------------------------------------------ -- GUI stuff               @@ -155,7 +163,7 @@            -> Int     -- ^ min neighbors            -> CV.HaarDetectFlag -- ^ flags            -> CvSize  -- ^ min size-           -> Processor IO (Ptr IplImage) [CvRect]+           -> IOProcessor (Ptr IplImage) [CvRect] haarDetect cascadeFileName scaleFactor minNeighbors flags minSize = processor procFunc allocFunc convFunc freeFunc      where procFunc :: (Ptr IplImage) -> ([CvRect], (Ptr CvHaarClassifierCascade, Ptr CvMemStorage))                     -> IO ([CvRect], (Ptr CvHaarClassifierCascade, Ptr CvMemStorage))@@ -184,7 +192,7 @@ -- need a datatype that combines the shape types for that.              -- | OpenCV's cvRectangle, currently without width, color or line type control-drawRects :: Processor IO (Ptr IplImage, [CvRect]) (Ptr IplImage)+drawRects :: IOProcessor (Ptr IplImage, [CvRect]) (Ptr IplImage) drawRects = processor procFunc (CxCore.cvCloneImage . fst) (do return) CxCore.cvReleaseImage     where procFunc (src,rects) dst = do             CxCore.cvCopy src dst

@@ -8,23 +8,26 @@ -- Stability   : experimental -- Portability : tested on GHC only ----- Framework for expressing monadic actions that require initialization and finalizers.+-- Framework for expressing IO actions that require initialization and finalizers. -- This module provides a *functional* interface for defining and chaining a series of processors. -- -- Motivating example: bindings to C libraries that use functions such as: f(foo *src, foo *dst), -- where the pointer `dst` must be pre-allocated. In this case we normally do: -----   foo *dst = allocateFoo();---   ... ---   while (something) {---      f(src, dst);---      ...---   }---   releaseFoo(dst);+--   > foo *dst = allocateFoo();+--   > ... +--   > while (something) {+--   >    f(src, dst);+--   >    ...+--   > }+--   > releaseFoo(dst); -- -- You can use the 'runUntil' function below to emulate that loop. -- -- Processor is an instance of Category, Functor, Applicative and Arrow. +--+-- In addition to the general type @'Processor' m a b@, this module also defines the semantic model+-- for @'Processor' IO a b@, which has synonym @'IOProcessor' a b@.  module AI.CV.Processor where @@ -38,18 +41,9 @@  -- | The type of Processors ----- The semantic model is: ------ > [[ Processor m o a b ]] = a -> b------ The idea is that the monad m is usually IO, and that a and b are usually pointers.--- It is meant for functions that require a pre-allocated output pointer to operate.---  --    * a, b = the input and output types of the processor (think a -> b) -----    * m = monad in which the processor operates------    * x = type of internal state+--    * x = type of internal state (existentially quantified) -- -- The arguments to the constructor are: --@@ -64,13 +58,58 @@ data Processor m a b where     Processor :: Monad m => (a -> x -> m x) -> (a -> m x) -> (x -> m b) -> (x -> m ()) -> (Processor m a b)     -processor :: (Monad m) =>+-- | The semantic model for 'IOProcessor' is a function:+--+-- > [[ 'IOProcessor' a b ]] = a -> b+--+-- And the following laws:+--+--    1. The processing function (@a -> x -> m x@) must act as if purely, so that indeed for a given input the+--       output is always the same. One particular thing to be careful with is that the output does not depend+--       on time (for example, you shouldn't use IOProcessor to implement an input device). The @IOSource@ type+--       is defined exactly for time-dependent processors. For pointer typed inputs and outputs, see next law.+--+--    2. For processors that work on pointers, @[[ Ptr t ]] = t@. This is guaranteed by the following+--       implementation constraints for @IOProcessor a b@:+--+--       1. If `a` is a pointer type (@a = Ptr p@), then the processor must NOT write (modify) the referenced data.+--+--       2. If `b` is a pointer, the memory it points to (and its allocation status) is only allowed to change+--          by the processor that created it (in the processing and releasing functions). In a way this+--          generalizes the first constraint.+--+-- Note, that unlike "Yampa", this model does not allow transformations of the type @(Time -> a) -> (Time ->+-- b)@. The reason is that I want to prevent arbitrary time access (whether causal or not). This limitation+-- means that everything is essentially "point-wise" in time. To allow memory-full operations under this+-- model, 'scanlT' is defined. See <http://www.ee.bgu.ac.il/~noamle/_downloads/gaccum.pdf> for more about+-- arbitrary time access.+type IOProcessor a b = Processor IO a b++-- | @'IOSource' a b@ is the type of time-dependent processors, such that:+--+-- > [[ 'IOSource' a b ]] = (a, Time) -> b+--+-- Thus, it is ok to implement a processing action that outputs arbitrary time-dependent values during runtime+-- regardless of input. (Although the more useful case is to calculate something from the input @a@ that is+-- also time-dependent. The @a@ input is often not required and in those cases @a = ()@ is used.+--+-- Notice that this means that IOSource doesn't qualify as an 'IOProcessor'. However, currently the+-- implementation /does NOT/ enforce this, i.e. IOSource is not a newtype; I don't know how to implement it+-- correctly. Also, one question is whether primitives like "chain" will have to disallow placing 'IOSource'+-- as the second element in a chain. Maybe they should, maybe they shouldn't.+type IOSource a b = Processor IO a b++-- | TODO: What's the semantic model for @'IOSink' a@?+type IOSink a = IOProcessor a ()++-- | TODO: do we need this? we're exporting the data constructor anyway for now, so maybe we don't.+processor :: Monad m =>              (a -> x -> m x) -> (a -> m x) -> (x -> m b) -> (x -> m ())           -> Processor m a b processor = Processor  -- | Chains two processors serially, so one feeds the next.-chain :: (Monad m) => Processor m a b'  -> Processor m b' b -> Processor m a b+chain :: Processor m a b'  -> Processor m b' b -> Processor m a b chain (Processor pf1 af1 cf1 rf1) (Processor pf2 af2 cf2 rf2) = processor pf3 af3 cf3 rf3     where pf3 a (x1,x2) = do             x1' <- pf1 a x1@@ -94,7 +133,7 @@    -- | A processor that represents two sub-processors in parallel (although the current implementation runs them -- sequentially, but that may change in the future)-parallel :: (Monad m) => Processor m a b -> Processor m c d -> Processor m (a,c) (b,d)+parallel :: Processor m a b -> Processor m c d -> Processor m (a,c) (b,d) parallel (Processor pf1 af1 cf1 rf1) (Processor pf2 af2 cf2 rf2) = processor pf3 af3 cf3 rf3     where pf3 (a,c) (x1,x2) = do             x1' <- pf1 a x1@@ -120,29 +159,31 @@ --  -- Semantic meaning, using Arrow's (&&&) operator: -- [[ forkJoin ]] = &&& --- Or, considering the Monad instance of functions (which are the semantic meanings of a processor):--- [[ forkJoin ]] = liftM2 (,)+-- Or, considering the Applicative instance of functions (which are the semantic meanings of a processor):+-- [[ forkJoin ]] = liftA2 (,) -- Alternative implementation to consider: f &&& g = (,) <&> f <*> g-forkJoin :: (Monad m) => Processor m a b  -> Processor m a b' -> Processor m a (b,b')+forkJoin :: Processor m a b  -> Processor m a b' -> Processor m a (b,b') forkJoin (Processor pf1 af1 cf1 rf1) (Processor pf2 af2 cf2 rf2) = processor pf3 af3 cf3 rf3-    where pf3 a (x1,x2) = do+    where --pf3 :: a -> (x1,x2) -> m (x1,x2)+          pf3 a (x1,x2) = do             x1' <- pf1 a x1             x2' <- pf2 a x2             return (x1', x2')             +          --af3 :: a -> m (x1, x2)           af3 a = do             x1 <- af1 a             x2 <- af2 a             return (x1,x2)-            +          +          --cf3 :: (x1,x2) -> m (b,b')           cf3 (x1,x2) = do-            b  <- cf1 x1+            b <- cf1 x1             b' <- cf2 x2             return (b,b')-            -          rf3 (x1,x2) = do-            rf2 x2-            rf1 x1+          +          --rf3 :: (x1,x2) -> m ()+          rf3 (x1,x2) = rf2 x2 >> rf1 x1   -------------------------------------------------------------@@ -167,18 +208,7 @@   fmap f (Processor pf af cf rf) = processor pf af cf' rf     where cf' x = liftM f (cf x)  --- | Splits (duplicates) the output of a functor, or on this case a processor.-split :: Functor f => f a -> f (a,a)-split = (join (,) <$>)---- | 'f --< g' means: split f and feed it into g. Useful for feeding parallelized (***'d) processors.--- For example, a --< (b &&& c)-(--<) :: (Functor (cat a), Category cat) => cat a a1 -> cat (a1, a1) c -> cat a c-f --< g = split f >>> g-infixr 1 --<---instance (Monad m) => Applicative (Processor m a) where+instance Monad m => Applicative (Processor m a) where   -- |    -- > [[ pure ]] = const   pure b = processor pf af cf rf@@ -222,15 +252,29 @@   first = (*** id)   second = (id ***)   + -------------------------------------------------------------++-- | Splits (duplicates) the output of a functor, or on this case a processor.+split :: Functor f => f a -> f (a,a)+split = (join (,) <$>)++-- | 'f --< g' means: split f and feed it into g. Useful for feeding parallelized (***'d) processors.+-- For example, a --< (b *** c) = a >>> (b &&& c)+(--<) :: (Functor (cat a), Category cat) => cat a a1 -> cat (a1, a1) c -> cat a c+f --< g = split f >>> g+infixr 1 --<+++-------------------------------------------------------------              -- | Runs the processor once: allocates, processes, converts to output, and deallocates.-run :: (Monad m) => Processor m a b -> a -> m b+run :: Monad m => Processor m a b -> a -> m b run = runWith id  -- | Keeps running the processing function in a loop until a predicate on the output is true. -- Useful for processors whose main function is after the allocation and before deallocation.-runUntil :: (Monad m) => Processor m a b -> a -> (b -> m Bool) -> m b+runUntil :: Monad m => Processor m a b -> a -> (b -> m Bool) -> m b runUntil (Processor pf af cf rf) a untilF = do   x <- af a   let repeatF y = do@@ -250,4 +294,51 @@         b' <- f (pf a x >>= cf)         rf x         return b'+++-------------------------------------------------------------+type DTime = Double++type Clock m = m Double++-- | scanlT provides the primitive for performing memory-full operations on time-dependent processors, as described in <http://www.ee.bgu.ac.il/~noamle/_downloads/gaccum.pdf>.+--+-- /Untested/.+scanlT :: Clock IO -> (b -> b -> DTime -> c -> c) -> c -> IOSource a b -> IOSource a c+scanlT clock transFunc initOut (Processor pf af cf rf) = processor procFunc allocFunc convFunc releaseFunc+    where procFunc curIn' (prevIn, prevTime, prevOut, x) = do+            x' <- pf curIn' x+            curIn <- cf x'+            curTime <- clock+            let dtime = curTime - prevTime+                curOut = transFunc prevIn curIn dtime prevOut+            return (curIn, curTime, curOut, x')+          +          allocFunc firstIn' = do+            x <- af firstIn'+            firstIn <- cf x+            curTime <- clock+            return (firstIn, curTime, initOut, x)+          +          convFunc (_, _, curOut, _) = return curOut+          +          releaseFunc (_, _, _, x') = rf x'+          +          +-- | Differentiate using scanlT. TODO: test, and also generalize for any monad (trivial change of types).+differentiate :: (Real b) => Clock IO -> IOSource a b -> IOSource a Double+differentiate clock = scanlT clock diffFunc 0+    where diffFunc y' y dt _ = (realToFrac (y' - y)) / dt -- horrible approximation!+          +integrate :: (Real b) => Clock IO -> IOSource a b -> IOSource a Double+integrate clock p = scanlT clock intFunc 0 p+    where intFunc y' y dt prevSum = prevSum + (realToFrac (y' + y)) * dt / 2 -- horrible approximation!++max_ :: Ord b => Clock IO -> b -> IOSource a b -> IOSource a b+max_ clock minVal = scanlT clock maxFunc minVal+    where maxFunc y' y _ _ = max y' y+          +min_ :: Ord b => Clock IO -> b -> IOSource a b -> IOSource a b+min_ clock maxVal = scanlT clock minFunc maxVal+    where minFunc y' y _ _ = min y' y 

@@ -19,12 +19,18 @@ edges :: ImageProcessor edges = canny 30 190 3 -faceDetect :: Processor.Processor IO PImage [CvRect]-faceDetect = haarDetect "/usr/share/opencv/haarcascades/haarcascade_frontalface_default.xml" 1.2 3 CV.cvHaarDoCannyPruning (CvSize 50 50)+faceDetect :: Processor.IOProcessor PImage [CvRect]+faceDetect = haarDetect "/usr/share/opencv/haarcascades/haarcascade_frontalface_alt.xml" 1.1 3 CV.cvHaarFlagNone (CvSize 20 20)   +captureDev :: ImageSource+captureDev = videoFile "/tmp/video.flv" -- Many formats are supported, not just flv (FFMPEG-based, normally). +-- If you have a webcam, uncomment this, and comment the other definition.+-- captureDev = camera 0+ main :: IO ()-main = runTillKeyPressed (camera 0 --< (second faceDetect) >>> drawRects >>> window 0) +main = runTillKeyPressed (captureDev >>> resizer --< (faces *** edges) >>> (window 0 *** window 1))+    where faces = (id &&& faceDetect) >>> drawRects              -- Shows the camera output in two windows (same images in both). --main = runTillKeyPressed ((camera 0) --< (window 0 *** window 1))