Commit 8689a23fd190f1e1d436abbe7ff46572d6cf3ed4

Some fixes, cleaning up, this is acceptable test program for iteration 1
signclassification.cabal
(2 / 1)
  
3131 svm-simple >= 0.2.5 && < 0.3,
3232 gnuplot >= 0.4.2,
3333 array >= 0.3.0.2,
34 time >= 1.2.0.3
34 time >= 1.2.0.3,
35 Glob >= 0.6.1
testclassification.hs
(36 / 36)
  
11{-# LANGUAGE FlexibleInstances #-}
22{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE ParallelListComp #-}
43module Main where
54
65--import Graphical
286286cvGreyImageToBlocksWithFeatures :: String -> [ImageBlock BlockFeatures]
287287cvGreyImageToBlocksWithFeatures s =
288288 unsafePerformIO $ do
289 i <- loadImage8 s
290 if isNothing i
291 then
292 return []
293 else
294 withForestFromGreyCVImage (fromJust i) 8 8 forestToBlocksWithFeatures
289 i <- readFromFile s
290 withForestFromGreyCVImage i 8 8 forestToBlocksWithFeatures
295291
296292-- load color image using CV and extract image blocks with features.
297293cvColorImageToBlocksWithFeatures :: String -> [ImageBlock BlockFeatures]
298294cvColorImageToBlocksWithFeatures s =
299295 unsafePerformIO $ do
300 i <- loadColorImage8 s
301 if isNothing i
302 then
303 return []
304 else
305 withForestFromColorCVImage (fromJust i) 8 8 forestToBlocksWithFeatures
296 i <- readFromFile s
297 withForestFromColorCVImage i 8 8 forestToBlocksWithFeatures
306298
307299--forestToCategory :: String -> ImageForest -> Category BlockFeatures
308300--forestToCategory l f = (C l (map toFeatures (trees f)))
326326 | i == 5 = w6
327327 | otherwise = w1
328328
329data ColorHistogramBin =
330 ColorHistogramBin{
329data ColorHistogramBin =
330 ColorHistogramBin{
331331 pos :: (Float,Float),
332332 minVal :: (Int,Int),
333333 maxVal :: (Int,Int),
343343instance Graphical ColorHistogramBin where
344344 draw (ColorHistogramBin (pu,pv) (minu,minv) (maxu,maxv) _) =
345345 translate pu pv $
346 color (uvToColor $ colorPairToUV $ (((maxu-minu) `div` 2), ((maxv-minv) `div` 2))) $
346 color (uvToColor $ colorPairToUV $ (((maxu-minu) `div` 2), ((maxv-minv) `div` 2))) $
347347 circleSolid 1
348348
349349instance Graphical ColorHistogram where
427427
428428shapes = triangles ++ rectangles
429429
430bs1 = map (fmap triangle) b1
430--bs1 = map (fmap triangle) b1
431431
432432-- normalize shapes using min and max of feature.
433433
441441r3NormShapes = map (mapSample (normalizeFeatures (features (findSampleMin shapes)) (features (findSampleMax shapes)))) rectangles3
442442r4NormShapes = map (mapSample (normalizeFeatures (features (findSampleMin shapes)) (features (findSampleMax shapes)))) rectangles4
443443
444bn1 = map (fmap $ mapSample (normalizeFeatures (features (findSampleMin shapes)) (features (findSampleMax shapes)))) bs1
444--bn1 = map (fmap $ mapSample (normalizeFeatures (features (findSampleMin shapes)) (features (findSampleMax shapes)))) bs1
445445
446446decodedShapes = map decodeSample normShapes
447447
448bd1 = map (fmap decodeSample) bn1
448--bd1 = map (fmap decodeSample) bn1
449449
450450--bw1 = map (fmap $ features . fst) bd1
451bw1 = map (fmap $ toWord . snd) bd1
451--bw1 = map (fmap $ toWord . snd) bd1
452452
453453-- count the amount of each word using foldl and incWord.
454454
534534plotHistList xs = do
535535 Plot.plot X11.cons $ Plot2D.list Graph2D.boxes $ zip [0..(length xs)] xs
536536
537imagefile = "./sign/418px-Muu_nahtavyys_772f.svg.png" --ajoneuvolla_ajo_kielletty.png"
538b1 = cvColorImageToBlocksWithFeatures imagefile
539p1 = cvColorImageToColorPairs imagefile
537--b1 = cvColorImageToBlocksWithFeatures imagefile
538--p1 = cvColorImageToColorPairs imagefile
540539
541540main = do
542541 args <- getArgs
544544 print $ "Please give a pattern to find image files"
545545 else do
546546 fs <- glob $ compile $ head $ args
547 print $ "Loading " ++ (show $ length fs) ++ " images"
548
549 let ps = normalize $ map fileToFeatureVector fs
550 plotHistList ps
551 --let ps = concatMap cvColorImageToColorPairs fs
552 --plotScatterPairs ps
553 --displayInWindow "forest" (512, 512) (200, 200) white $
554 -- translate (-50) 50 $ scale 100 100 $ draw $ makeColorHistogram p1 (16,16) 16
555 -- pictures $ map plotColor $ ps
556 print $ "Finished analyzing " ++ (show $ length fs) ++ " images"
547 if null fs
548 then do
549 print $ "No files found"
550 else do
551 print $ "Loading " ++ (show $ length fs) ++ " images"
552 let ps = normalize $ map fileToFeatureVector fs
553 plotHistList ps
554 --let ps = concatMap cvColorImageToColorPairs fs
555 --plotScatterPairs ps
556 print $ "Reading file " ++ (head fs)
557 i <- readFromFile $ head fs
558 f <- readCVImageForest i 8 8
559 fb <- withForest f forestToBlocksWithFeatures
560 ((cx,cy),(on,oe,os,ow)) <- withForest f forestGeometry
557561
562 displayInWindow "forest" (512, 512) (200, 200) white $
563 translate (-256) (256) $ pictures $ (map draw $ map mirrorYBlock fb) ++
564 [ color red $ lineLoop [(ow,-on),(oe,-on),(oe,-os),(ow,-os)]
565 , translate cx (-cy) $ color red $ circle 10 ]
566 -- translate (-50) 50 $ scale 100 100 $ draw $ makeColorHistogram p1 (16,16) 16
567 -- pictures $ map plotColor $ ps
568 print $ "Finished analyzing " ++ (show $ length fs) ++ " images"
569
558570 --plotScatterAll
559571 --print $ normShapes
560572 --do
580580 -}
581581 --plotHistList $ fileToFeatureVector "./sign/Pakollinen_pysayttaminen_232.svg.png"
582582 --plotHistList $ fileToFeatureVector "./sign/200px-Pakollinen_pysayttaminen_232.svg.png"
583
583
584584 --print $ countedWords
585585 --print $ "All Triangles: " ++ (show tWords)
586586 --print $ "Triangle 1: " ++ (show t1Words)
601601 -- translate (-256) (256) $ pictures $ map draw $ map mirrorYBlock b1
602602 -- pictures $ map plotColor p1
603603 --print $ length p1
604
605--convert -background "#808080" -mattecolor "#808080" -bordercolor "#808080" Pakollinen_pysäyttäminen_232.svg -size 512x512 -rotate 4 -distort perspective "0,0,0,0 0,512,0,512 512,0,512,64 512,512,512,448" -frame 20x20 -flatten ---channel RGB -depth 8 -evaluate Gaussian-noise 6 Pakollinen_pysäyttäminen_232.svg.png