Commit d4fb2505ad7425b7b3191742d91da880d65cb4b1

Moved generic tree code to ImageTree
testclassification.hs
(19 / 315)
  
4040
4141import Foreign.ForeignPtr
4242import System.IO.Unsafe
43import Debug.Trace
4344
4445import CV.Image
4546
180180 ImageBlock{ value = StatDirColor(StatDir(Stat(m,d),Dir(h,v)),_,_) } } =
181181 ((fromIntegral m), (fromIntegral d), (abs $ fromIntegral h), (abs $ fromIntegral v))
182182
183calculateDir :: Int -> Int -> Int -> Int -> Dir
184calculateDir mnw mne msw mse
185 | (abs 2*h) < (abs v) = Dir(0,v)
186 | (abs 2*v) < (abs h) = Dir(h,0)
187 | otherwise = Dir(h,v)
188 where
189 h = (mnw + mne) - (msw + mse)
190 v = (mnw + msw) - (mne + mse)
191
192statColor :: StatColor -> Stat
193statColor (StatColor(s,_,_)) = s
194
195statColor1 :: StatColor -> Stat
196statColor1 (StatColor(_,s1,_)) = s1
197
198statColor2 :: StatColor -> Stat
199statColor2 (StatColor(_,_,s2)) = s2
200
201treeStat :: (StatColor -> Stat) -> ImageTree StatColor -> Stat
202treeStat _ EmptyTree = Stat(0,0)
203treeStat f t = f . value . block $ t
204
205treeMean :: (StatColor -> Stat) -> ImageTree StatColor -> Int
206treeMean _ EmptyTree = 0
207treeMean f t = statMean . f . value . block $ t
208
209treeStatMean :: ImageTree Stat -> Int
210treeStatMean EmptyTree = 0
211treeStatMean t = statMean . value . block $ t
212
213treeStatColorMean :: ImageTree StatColor -> Int
214treeStatColorMean EmptyTree = 0
215treeStatColorMean t = statColorMean . value . block $ t
216
217treeDivideMean :: (StatColor -> Stat) -> ImageTree StatColor -> DivideMean
218treeDivideMean _ EmptyTree = (0,0,0,0)
219treeDivideMean f (ImageTree _ _ tnw tne tsw tse) =
220 ((treeMean f tnw),(treeMean f tne),(treeMean f tsw),(treeMean f tse))
221
222treeStatColorToStatDir :: (StatColor -> Stat) -> ImageTree StatColor -> ImageTree StatDir
223treeStatColorToStatDir _ EmptyTree = EmptyTree
224treeStatColorToStatDir f (ImageTree p b EmptyTree EmptyTree EmptyTree EmptyTree) =
225 (ImageTree p (fmap (nullStatDir . f) b) EmptyTree EmptyTree EmptyTree EmptyTree)
226treeStatColorToStatDir f t@(ImageTree p b tnw tne tsw tse) =
227 (ImageTree p
228 (fmap ((statDir (treeDivideMean f t)) . f) b)
229 (fmap (nullStatDir . f) tnw)
230 (fmap (nullStatDir . f) tne)
231 (fmap (nullStatDir . f) tsw)
232 (fmap (nullStatDir . f) tse))
233
234treeStatColorToStatDirColor :: ImageTree StatColor -> ImageTree StatDirColor
235treeStatColorToStatDirColor EmptyTree = EmptyTree
236treeStatColorToStatDirColor (ImageTree p b EmptyTree EmptyTree EmptyTree EmptyTree) =
237 (ImageTree p (fmap nullStatDirColor b) EmptyTree EmptyTree EmptyTree EmptyTree)
238treeStatColorToStatDirColor t@(ImageTree p b tnw tne tsw tse) =
239 (ImageTree p
240 (fmap (statDirColor (treeDivideMean statColor t)
241 (treeDivideMean statColor1 t)
242 (treeDivideMean statColor2 t)) b)
243 (fmap nullStatDirColor tnw)
244 (fmap nullStatDirColor tne)
245 (fmap nullStatDirColor tsw)
246 (fmap nullStatDirColor tse))
247
248treeDev :: (StatColor -> Stat) -> ImageTree StatColor -> Int
249treeDev _ EmptyTree = 0
250treeDev f t = statDev . f . value . block $ t
251
252treeDir :: (StatColor -> Stat) -> ImageTree StatColor -> Dir
253treeDir _ EmptyTree = Dir(0,0)
254treeDir _ (ImageTree _ _ EmptyTree EmptyTree EmptyTree EmptyTree) = Dir(0,0)
255treeDir f t@(ImageTree _ _ tnw tne tsw tse)
256 | (treeDev f t) < 10 = Dir(0,0)
257 | otherwise = (calculateDir (treeMean f tnw) (treeMean f tne) (treeMean f tsw) (treeMean f tse))
258
259treeStatDir :: (StatColor -> Stat) -> ImageTree StatColor -> StatDir
260treeStatDir f t = StatDir(treeStat f t,treeDir f t)
261
262183treeBlockFeatures :: (StatColor -> Stat) -> ImageTree StatColor -> BlockFeatures
263184treeBlockFeatures f EmptyTree = (0,0,0,0)
264185treeBlockFeatures f t =
265186 ((fromIntegral m), (fromIntegral d), (fromIntegral h), (fromIntegral v))
266187 where
267 (Stat(m,d)) = treeStat f t
188 (Stat(m,d)) = blockStat f (block t)
268189 (Dir(h,v)) = treeDir f t
269190
270191treeBlockWithFeatures :: (StatColor -> Stat) -> ImageTree StatColor -> ImageBlock BlockFeatures
200200 (ImageBlock bn be bs bw
201201 ((fromIntegral m), (fromIntegral d), (abs $ fromIntegral dh), (abs $ fromIntegral dv)))
202202
203toColorPair :: ImageTree StatColor -> (Int, Int)
204toColorPair t = (statMean . statColor2 . value . block $ t, statMean . statColor1 . value . block $ t)
205
206203-- extract FeatureSet from ImageTree and create an ImageBlock.
207204-- could be done with fmap...
208205toBlockWithFeatureSet :: ImageTree StatDir -> ImageBlock FeatureSet
263263mirrorYForest (ImageForest ptr r c ts) =
264264 (ImageForest ptr r c (map mirrorYTree ts))
265265
266divideWithDevBigger :: Int -> ImageTree StatColor -> ImageTree StatColor
267divideWithDevBigger _ EmptyTree = EmptyTree
268divideWithDevBigger n t@(ImageTree _ b EmptyTree EmptyTree EmptyTree EmptyTree)
269 | d > n = divideTree t
270 | otherwise = t
271 where d = statDev . statColor . value $ b
272divideWithDevBigger _ t = t
273
274divideForest :: ImageForest StatColor -> ImageForest StatColor
275divideForest (ImageForest ptr r c ts) =
276 (ImageForest ptr r c (map (divideWithDevBigger 10) ts))
277
278266forestToFeatures :: ImageForest StatColor -> [BlockFeatures]
279267forestToFeatures =
280 (mapForestDeep $ (treeBlockFeatures statColor) . divideTree) . updateForest
268 (mapDeep $ (treeBlockFeatures statColor)) . trees . divideForest . updateForest
281269
282270forestToBlocksWithFeatures :: ImageForest StatColor -> [ImageBlock BlockFeatures]
283271forestToBlocksWithFeatures =
284 (mapForestDeep $ (treeBlockWithFeatures statColor1) . divideTree) . updateForest
272 (mapDeep $ (treeBlockWithFeatures statColor)) . trees . divideForest . updateForest
285273
286274imageToBlocksWithFeatures :: String -> [ImageBlock BlockFeatures]
287275imageToBlocksWithFeatures s =
302302 else
303303 withForestFromColorCVImage (fromJust i) 8 8 forestToBlocksWithFeatures
304304
305cvColorImageToColorPairs :: String -> [(Int, Int)]
306cvColorImageToColorPairs s =
307 unsafePerformIO $ do
308 i <- loadColorImage8 s
309 if isNothing i
310 then
311 return []
312 else
313 withForestFromColorCVImage (fromJust i) 8 8 $ (mapForestDeep $ toColorPair . divideTree) . updateForest
314
315
316blockCenter :: ImageBlock a -> (Float, Float)
317blockCenter (ImageBlock bn be bs bw _) =
318 ((bw+be)/2,(bn+bs)/2)
319
320colorDistance :: (Float, Float) -> (Float, Float) -> Float
321colorDistance (c1a,c2a) (c1b,c2b) =
322 sqrt $ (c1a - c1b)**2.0 + (c2a - c2b)**2.0
323
324isFlat :: Dir -> Double
325isFlat d
326 | d == nullDir = 1.0
327 | otherwise = 0.0
328
329isEdge :: Dir -> Double
330isEdge d
331 | d == nullDir = 0.0
332 | otherwise = 1.0
333
334isHorizontalEdge :: Dir -> Double
335isHorizontalEdge (Dir(h,v))
336 | h /= 0 && v == 0 = 1.0
337 | otherwise = 0.0
338
339isVerticalEdge :: Dir -> Double
340isVerticalEdge (Dir(h,v))
341 | h == 0 && v /= 0 = 1.0
342 | otherwise = 0.0
343
344isForwardEdge :: Dir -> Double
345isForwardEdge (Dir(h,v))
346 | (h > 0 && v > 0) || (h < 0 && v < 0) = 1.0
347 | otherwise = 0.0
348
349isBackwardEdge :: Dir -> Double
350isBackwardEdge (Dir(h,v))
351 | (h > 0 && v < 0) || (h < 0 && v > 0) = 1.0
352 | otherwise = 0.0
353
354isBackground :: (Float, Float) -> Int -> Bool
355isBackground c m
356 | d < 10 && m > 96 && m < 160 = True
357 | otherwise = False
358 where
359 d = colorDistance c (128,128)
360
361isNotBackground :: (Float, Float) -> Int -> Double
362isNotBackground c m
363 | d > 10 || (m < 96 || m > 160) = 0.0
364 | otherwise = 1.0
365 where
366 d = colorDistance c (128,128)
367
368isRed :: (Float, Float) -> Double
369isRed c
370 | d < 10 = 1.0
371 | otherwise = 0.0
372 where
373 d = colorDistance c (125,134)
374
375isYellow :: (Float, Float) -> Double
376isYellow c
377 | d < 10 = 1.0
378 | otherwise = 0.0
379 where
380 d = colorDistance c (23, 178)
381
382isGreen :: (Float, Float) -> Double
383isGreen c
384 | d < 10 = 1.0
385 | otherwise = 0.0
386 where
387 d = colorDistance c (120, 80)
388
389isBlue :: (Float, Float) -> Double
390isBlue c
391 | d < 10 = 1.0
392 | otherwise = 0.0
393 where
394 d = colorDistance c (192,38)
395
396isBlack :: (Float, Float) -> Int -> Double
397isBlack c m
398 | d < 10 && m < 64 = 1.0
399 | otherwise = 0.0
400 where
401 d = colorDistance c (128,128)
402
403isWhite :: (Float, Float) -> Int -> Double
404isWhite c m
405 | d < 10 && m > 192 = 1.0
406 | otherwise = 0.0
407 where
408 d = colorDistance c (128,128)
409
410isAtLeft :: (Float, Float) -> (Float, Float) -> Double
411isAtLeft (fx,fy) (bx,by)
412 | bx < fx = 1.0
413 | otherwise = 0.0
414
415isAtRight :: (Float, Float) -> (Float, Float) -> Double
416isAtRight (fx,fy) (bx,by)
417 | bx > fx = 1.0
418 | otherwise = 0.0
419
420isAtTop :: (Float, Float) -> (Float, Float) -> Double
421isAtTop (fx,fy) (bx,by)
422 | by < fy = 1.0
423 | otherwise = 0.0
424
425isAtBottom :: (Float, Float) -> (Float, Float) -> Double
426isAtBottom (fx,fy) (bx,by)
427 | by > fy = 1.0
428 | otherwise = 0.0
429
430isAtCenter :: (Float, Float) -> (Float, Float) -> Double
431isAtCenter (fx,fy) (bx,by)
432 | (abs $ bx - fx) < 30 && (abs $ by - fy) < 30 = 1.0
433 | otherwise = 0.0
434
435isAtRim :: (Float, Float) -> (Float, Float) -> Double
436isAtRim (fx,fy) (bx,by)
437 | (abs $ bx - fx) > 30 && (abs $ by - fy) > 30 = 1.0
438 | otherwise = 0.0
439
440treeToFeatureVector :: (Float, Float) -> ImageTree StatColor -> [Double]
441treeToFeatureVector fc t@(ImageTree p b tnw tne tsw tse) =
442 [ (min (isFlat d) (isNotBackground cp m))
443 , isHorizontalEdge d
444 , isVerticalEdge d
445 , isForwardEdge d
446 , isBackwardEdge d
447 , isRed cp
448 , isYellow cp
449 , isGreen cp
450 , isBlue cp
451 , isBlack cp m
452 , isWhite cp m
453 , (min (isAtLeft fc bc) (isEdge d))
454 , (min (isAtRight fc bc) (isEdge d))
455 , (min (isAtTop fc bc) (isEdge d))
456 , (min (isAtBottom fc bc) (isEdge d))
457 , (min (isAtCenter fc bc) (isEdge d))
458 , (min (isAtRim fc bc) (isEdge d))
459 ]
460 where
461 m = treeMean statColor t
462 d = treeDir statColor t
463 (c1,c2) = toColorPair t
464 cp = (fromIntegral c1, fromIntegral c2)
465 bc = blockCenter b
466
467normalize :: [[Double]] -> [Double]
468normalize fs = map ((* scaleValue) . (+ transValue)) sfs
469 where
470 sfs = foldl (zipWith (+)) (repeat 0) fs
471 transValue = minimum sfs
472 scaleValue = 1.0 / ((maximum sfs) - (minimum sfs))
473
474cvImageToFeatureVector :: (Image RGB D8) -> [Double]
475cvImageToFeatureVector i = unsafePerformIO $
476 withForestFromColorCVImage i 8 8 $ normalize .
477 (mapForestDeep $ (treeToFeatureVector (80,80)) . divideTree) . updateForest
478
479
480fileToFeatureVector :: String -> [Double]
481fileToFeatureVector s =
482 unsafePerformIO $ do
483 i <- loadColorImage8 s
484 if isNothing i
485 then
486 return []
487 else
488 return $ cvImageToFeatureVector (fromJust i)
489
490305--forestToCategory :: String -> ImageForest -> Category BlockFeatures
491306--forestToCategory l f = (C l (map toFeatures (trees f)))
492307
332332 | i == 5 = w6
333333 | otherwise = w1
334334
335boundToByte :: Float -> Int
336boundToByte d
337 | i < 0 = 0
338 | i > 255 = 255
339 | otherwise = i
340 where i = floor d
341
342colorPairToUV :: (Int, Int) -> (Float, Float)
343colorPairToUV (c1,c2) =
344 (u,v)
345 where
346 u = ((fromIntegral c1 / 255.0) * 2.0 * 0.436) - 0.436
347 v = ((fromIntegral c2 / 255.0) * 2.0 * 0.615) - 0.615
348
349uvToColor :: (Float, Float) -> Color
350uvToColor (u,v) =
351 makeColor r g b 1.0
352 where
353 r = (0.5 + 0.00000 * u + 1.13983 * v)
354 g = (0.5 - 0.39465 * u - 0.58060 * v)
355 b = (0.5 + 2.03211 * u + 0.00000 * v)
356
357335plotColor :: (Int, Int) -> Picture
358336plotColor (c1,c2) =
359337 (translate (u * 200) (v * 200)) $ color (uvToColor (u,v)) $ (circleSolid 10.0)
486486plotHistList xs = do
487487 Plot.plot X11.cons $ Plot2D.list Graph2D.boxes $ zip [0..(length xs)] xs
488488
489imagefile = "./sign/168px-Moottoriliikennetie_563.svg.png" --ajoneuvolla_ajo_kielletty.png"
489imagefile = "./sign/200px-Pakollinen_pysayttaminen_232.svg.png" --ajoneuvolla_ajo_kielletty.png"
490490b1 = cvColorImageToBlocksWithFeatures imagefile
491491p1 = cvColorImageToColorPairs imagefile
492492
493493main = --plotScatterAll
494494 --print $ normShapes
495495 do
496 --plotHistList $ fileToFeatureVector "./sign/ajoneuvolla_ajo_kielletty.png"
497 --plotHistList $ fileToFeatureVector "./sign/kielletty_ajosuunta.png"
498 --plotHistList $ fileToFeatureVector "./sign/kapeneva_tie.png"
499 --plotHistList $ fileToFeatureVector "./sign/lapsia.png"
500 --plotHistList $ fileToFeatureVector "./sign/leirintaalue.png"
496 plotHistList $ fileToFeatureVector "./sign/ajoneuvolla_ajo_kielletty.png"
497 plotHistList $ fileToFeatureVector "./sign/kielletty_ajosuunta.png"
498 plotHistList $ fileToFeatureVector "./sign/kapeneva_tie.png"
499 plotHistList $ fileToFeatureVector "./sign/lapsia.png"
500 plotHistList $ fileToFeatureVector "./sign/leirintaalue.png"
501501 plotHistList $ fileToFeatureVector "./sign/levahdysalue.png"
502 --plotHistList $ fileToFeatureVector "./sign/Pakollinen_pysayttaminen_232.svg.png"
503 --plotHistList $ fileToFeatureVector "./sign/200px-Pakollinen_pysayttaminen_232.svg.png"
502504
503505 --print $ countedWords
504506 --print $ "All Triangles: " ++ (show tWords)
516516
517517 --plotScatterAll
518518 --plotHistAll
519 plotScatterPairs $ p1 -- cvColorImageToColorPairs imagefile
519 --plotScatterPairs $ p1 -- cvColorImageToColorPairs imagefile
520520 --print $ bw1
521 displayInWindow "forest" (512, 512) (200, 200) white $
522 --translate (-256) (256) $ pictures $ map draw $ map mirrorYBlock b1
523 pictures $ map plotColor p1
524 print $ length p1
521 --displayInWindow "forest" (512, 512) (200, 200) white $
522 -- translate (-256) (256) $ pictures $ map draw $ map mirrorYBlock b1
523 --pictures $ map plotColor p1
524 --print $ length p1
525
526--amnipar@amnipar-aspire-kubuntu:~/Projects/trafficsigner/signclassification/sign$ 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