module CV.Sampling where
import CV.Image
import System.Random
import Control.Monad
import Foreign.C.Types
import qualified CV.ImageMath as IM
import Data.List(partition)
allPatches size image = [getRegion (x,y) size image
| x <- [0..w1], y <- [0..h1]]
where
(wi,hi) = getSize image
(wp,hp) = size
(w,h) = (wiwp,hihp)
allButLast = reverse.tail.reverse
getTiles size image = getOverlappedTiles size (0,0) image
getTilesC size image = getOverlappedTilesC size (0,0) image
getOverlappedTileCoords size (xover,yover) image
= [(x,y)
| x <- [0,wstep..wiw1]
, y <- [0,hstep..hih1]]
where
(w,h) = size
(wi,hi) = getSize image
(wstep,hstep) = (floor $ fromIntegral w*(1xover)
,floor $ fromIntegral h*(1yover))
getOverlappedTiles s o i = map snd $ getOverlappedTilesC s o i
getOverlappedTilesC :: (Int,Int) -> (CDouble,CDouble) -> Image c d -> [((Int,Int),Image c d)]
getOverlappedTilesC size overlap image
= map (\c -> (both fromIntegral c,getRegion c size image))
$ getOverlappedTileCoords size
overlap image
both f (a,b) = (f a, f b)
getMarkedAndUnmarkedTiles size overlap image marks =
(map fst markedTiles,map fst nonMarked)
where
samples = getOverlappedTiles size overlap image
marked = getOverlappedTiles size overlap marks
ismarked (_,m) = IM.maxValue m > 0.9
(markedTiles,nonMarked) = partition ismarked
$ zip samples marked
getPatches size coords image = map (\c -> getRegion c size image) coords
getCenteredPatches size coords image = map (\c -> getRegion (adjust c)
size image)
coords
where
(w,h) = size
adjust (x,y) = (xw`div`2
,yh`div`2)
randomSelect lst = randomRIO (0,length lst 1) >>= \x ->
return (lst !! x)
select k lst = sequence $ replicate k (randomSelect lst)
discardAroundEdges (iw,ih) (vb,hb) coords = filter inRange coords
where
inRange (x,y) = vb<x && x< iwvb
&& hb<y && y< ihhb
getCoordsFromMarks marks = [(x,y) | x <- [0..w1]
, y <- [0..h1]
, getPixel (x,y) marks >0.9]
where (w,h) = getSize marks
getMarkedPatches size source marks
| getSize source == getSize marks = getPatches size coords source
| otherwise = error "Image sizes mismatch"
where coords = getCoordsFromMarks marks