Commit fa5ddc9f830af31fbff3949de5db4ee3e04dc431

created color histogram and feature plot
testclassification.hs
(72 / 16)
  
3939--import qualified Paths_gnuplot as Path
4040
4141import Foreign.ForeignPtr
42import GHC.Float
4243import System.IO.Unsafe
4344import System.FilePath.Glob
4445import System.Environment
330330data ColorHistogramBin =
331331 ColorHistogramBin{
332332 pos :: (Float,Float),
333 size :: (Float,Float),
333334 minVal :: (Int,Int),
334335 maxVal :: (Int,Int),
335336 count :: Float
343343 } deriving Show
344344
345345instance Graphical ColorHistogramBin where
346 draw (ColorHistogramBin (pu,pv) (minu,minv) (maxu,maxv) _) =
347 translate pu pv $
348 color (uvToColor $ colorPairToUV $ (((maxu-minu) `div` 2), ((maxv-minv) `div` 2))) $
349 circleSolid 1
346 draw (ColorHistogramBin (pu,pv) (su,sv) (minu,minv) (maxu,maxv) c) =
347 translate pu pv $ scale (c*su) (c*sv) $
348 color (uvToColor $ colorPairToUV $ (((maxu+minu) `div` 2), ((maxv+minv) `div` 2))) $
349 circleSolid 0.5
350350
351351instance Graphical ColorHistogram where
352352 draw (ColorHistogram (du,dv) bs) =
353 pictures $ map ((scale (1.0/(fromIntegral du)) (1.0/(fromIntegral dv))) . draw) bs
353 pictures $ map draw bs --map (scale (1.0/(fromIntegral du)) (1.0/(fromIntegral dv))) $
354354
355355-- number of divisions
356356-- minimum value
357357-- maximum value
358358makeColorHistogramBins :: (Int,Int) -> (Int,Int) -> (Int,Int) -> [ColorHistogramBin]
359359makeColorHistogramBins (nu,nv) (minu,minv) (maxu,maxv) =
360 [ (ColorHistogramBin (((fromIntegral pu) * (fromIntegral nu - 0.5)),
361 ((fromIntegral pv) * (fromIntegral nv - 0.5)))
360 [ (ColorHistogramBin ((((fromIntegral pu) + 0.5) * su - 0.5),
361 (((fromIntegral pv) + 0.5) * sv - 0.5))
362 (su,sv)
362363 ((bu (fromIntegral pu)), (bv (fromIntegral pv)))
363364 ((bu (fromIntegral $ pu+1)), (bv (fromIntegral $ pv+1))) 0.0) |
364365 pu <- [0..nu-1], pv <- [0..nv-1] ]
371371 bu p = (minu + (floor $ p * wu))::Int
372372 bv p = (minv + (floor $ p * wv))::Int
373373
374updateColorHistogramBin :: (Int,Int) -> ColorHistogramBin -> ColorHistogramBin
375updateColorHistogramBin (u,v) b@(ColorHistogramBin n s (minu,minv) (maxu,maxv) c)
376 | (126 <= u) && (u <= 130) && (126 <= v) && (v <= 130) = b
377 | (minu <= u) && (u < maxu) && (minv <= v) && (v < maxv) =
378 (ColorHistogramBin n s (minu,minv) (maxu,maxv) (c+1))
379 | otherwise = b
380
381updateColorHistogramBins :: [ColorHistogramBin] -> (Int,Int) -> [ColorHistogramBin]
382updateColorHistogramBins bs c = map (updateColorHistogramBin c) bs
383
384scaleColorHistogramBin :: Float -> ColorHistogramBin -> ColorHistogramBin
385scaleColorHistogramBin d (ColorHistogramBin n s minval maxval c) =
386 (ColorHistogramBin n s minval maxval ((c/d)*5))
387
388normalizeColorHistogram :: ColorHistogram -> ColorHistogram
389normalizeColorHistogram (ColorHistogram n bs) =
390 (ColorHistogram n $ map (scaleColorHistogramBin maxc) bs)
391 where
392 maxc = foldr (max . count) 0 bs
393
394plotBar :: Float -> Float -> Int -> Float -> Float -> Picture
395plotBar t s n w h =
396 pictures $ [ line [(p+w,(-0.4)),(p-w,(-0.4))],
397 polygon $ [(p-w,(-0.4+h)),(p+w,(-0.4+h)),(p+w,(-0.4)),(p-w,(-0.4))] ]
398 where
399 p = (fromIntegral n)*s+t
400
401plotFeature :: [Double] -> Picture
402plotFeature [] = blank
403plotFeature fs =
404 pictures $ [ plotBar t s n w (double2Float (0.8*(fs!!n))) | n <- [0..l-1] ]
405 where
406 l = length fs
407 s = 0.8/(fromIntegral l)
408 w = s / 4.0
409 t = 0.5 * s - 0.4
410
411plotFeatureList :: [[Double]] -> Picture
412plotFeatureList [] = blank
413plotFeatureList fs =
414 pictures $ [ color (c!!n) $ translate (-p*(fromIntegral n)) 0 $ plotFeature (fs!!n) | n <- [0..l-1] ]
415 where
416 c = cycle $ [ red, green, blue, cyan, magenta, yellow ]
417 l = length fs
418 n = length $ head fs
419 p = (0.8/(fromIntegral n))/8.0
420
374421-- list of color pairs with intensity
375422-- number of divisions in horizontal and vertical direction
376423-- number of bins on intensity axis
377424-- list of bins containing row and col number of bin, number of elements in bin
378425-- and list containing bin values on intensity axis
379makeColorHistogram :: [(Int,Int)] -> (Int,Int) -> Int -> [ColorHistogramBin]
380makeColorHistogram cs (nu,nv) ni = bs
426makeColorHistogram :: [(Int,Int)] -> (Int,Int) -> Int -> ColorHistogram
427makeColorHistogram cs (nu,nv) ni =
428 (ColorHistogram (nu,nv) (foldl updateColorHistogramBins bs cs))
381429 where
382430 (minu,maxu) = (0,255)
383431 (minv,maxv) = (0,255)
600600 print $ "No files found"
601601 else do
602602 print $ "Loading " ++ (show $ length fs) ++ " images"
603 let ps = normalize $ map fileToFeatureVector fs
604 plotHistList ps
605 --let ps = concatMap cvColorImageToColorPairs fs
603 --let ps = normalize $ map fileToFeatureVector fs
604 --plotHistList ps
605 --let cs = concatMap cvColorImageToColorPairs fs
606 let feats = foldr ((:) . fileToFeatureVector) [] fs
606607 --plotScatterPairs ps
607 print $ "Reading file " ++ (head fs)
608 --print $ "Reading file " ++ (head fs)
608609 i <- readFromFile $ head fs
610 --let feat = cvColorImageToFeatureVector i
611 --print $ feat
609612 f <- readCVImageForest i 8 8
610613 fb <- withForest f forestToBlocksWithFeatures
611614 ((cx,cy),(on,oe,os,ow)) <- withForest f forestGeometry
612
615 cp <- withForest f $ (mapDeep $ blockColorPair . block) . trees . divideForest . updateForest
613616 displayInWindow "forest" (512, 512) (200, 200) white $
617 --scale 512 512 $ plotFeatureList $ feats
614618 translate (-256) (256) $ pictures $ (map draw $ map mirrorYBlock fb) ++
615619 [ color red $ lineLoop [(ow,-on),(oe,-on),(oe,-os),(ow,-os)]
616620 , translate cx (-cy) $ color red $ circle 10 ]
617 -- translate (-50) 50 $ scale 100 100 $ draw $ makeColorHistogram p1 (16,16) 16
618 -- pictures $ map plotColor $ ps
621 --scale 512 512 $
622 --draw $ normalizeColorHistogram $ makeColorHistogram cs (16,16) 16
623 --pictures $ map plotColor $ ps
619624 print $ "Finished analyzing " ++ (show $ length fs) ++ " images"
620625
621626 --plotScatterAll