{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module RiskWeaver.Cmd.BDD where
import Codec.Picture
import Control.Monad
import Control.Monad.Trans.Reader (runReader)
import Data.List (sortBy)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Data.Vector qualified as Vector
import RiskWeaver.Cmd.Core (RiskCommands (..))
import RiskWeaver.DSL.BDD qualified as BDD
import RiskWeaver.DSL.Core qualified as Core
import RiskWeaver.Display (putImage)
import RiskWeaver.Draw
import RiskWeaver.Metric qualified as M
import RiskWeaver.Format.Coco
import System.FilePath ((</>))
import Text.Printf
toBddContext :: CocoMap -> Maybe Double -> Maybe Double -> BDD.BddContext
toBddContext :: CocoMap -> Maybe Double -> Maybe Double -> BddContext
toBddContext CocoMap
cocoMap Maybe Double
iouThreshold Maybe Double
scoreThresh =
let iouThreshold'' :: Double
iouThreshold'' = case Maybe Double
iouThreshold of
Maybe Double
Nothing -> Double
0.5
Just Double
iouThreshold' -> Double
iouThreshold'
scoreThresh'' :: Double
scoreThresh'' = case Maybe Double
scoreThresh of
Maybe Double
Nothing -> Double
0.4
Just Double
scoreThresh' -> Double
scoreThresh'
context :: BddContext
context =
BDD.BddContext
{ $sel:bddContextDataset:BddContext :: CocoMap
bddContextDataset = CocoMap
cocoMap,
$sel:bddContextIouThresh:BddContext :: Double
bddContextIouThresh = Double
iouThreshold'',
$sel:bddContextScoreThresh:BddContext :: Double
bddContextScoreThresh = Double
scoreThresh'',
$sel:bddContextUseInterestArea:BddContext :: Bool
bddContextUseInterestArea = Bool
False
}
in BddContext
context
showRisk :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
showRisk :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
showRisk CocoMap
cocoMap Maybe Double
iouThreshold Maybe Double
scoreThresh = do
let context :: BddContext
context = CocoMap -> Maybe Double -> Maybe Double -> BddContext
toBddContext CocoMap
cocoMap Maybe Double
iouThreshold Maybe Double
scoreThresh
risks :: [(ImgIdx BoundingBoxGT, Double)]
risks = forall context a.
World context a =>
context -> [(ImgIdx a, Double)]
Core.runRisk @BDD.BddContext @BDD.BoundingBoxGT BddContext
context
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s %-12s %s" String
"#ImageId" String
"Filename" String
"Risk"
let sortedRisks :: [(ImageId, Double)]
sortedRisks = ((ImageId, Double) -> (ImageId, Double) -> Ordering)
-> [(ImageId, Double)] -> [(ImageId, Double)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(ImageId
_, Double
risk1) (ImageId
_, Double
risk2) -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
risk2 Double
risk1) [(ImageId, Double)]
risks
[(ImageId, Double)] -> ((ImageId, Double) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ImageId, Double)]
sortedRisks (((ImageId, Double) -> IO ()) -> IO ())
-> ((ImageId, Double) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ImageId
imageId, Double
risk) -> do
let cocoImage :: CocoImage
cocoImage = (CocoMap -> Map ImageId CocoImage
cocoMapCocoImage CocoMap
cocoMap) Map ImageId CocoImage -> ImageId -> CocoImage
forall k a. Ord k => Map k a -> k -> a
Map.! ImageId
imageId
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12d %-12s %.3f" (ImageId -> Int
unImageId ImageId
imageId) (Text -> String
T.unpack (CocoImage -> Text
cocoImageFileName CocoImage
cocoImage)) Double
risk
showRiskWithError :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
showRiskWithError :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
showRiskWithError CocoMap
cocoMap Maybe Double
iouThreshold Maybe Double
scoreThresh = do
let context :: BddContext
context = CocoMap -> Maybe Double -> Maybe Double -> BddContext
toBddContext CocoMap
cocoMap Maybe Double
iouThreshold Maybe Double
scoreThresh
risks :: [(ImageId, [BddRisk])]
risks = forall context a.
World context a =>
context -> [(ImgIdx a, [Risk a])]
Core.runRiskWithError @BDD.BddContext @BDD.BoundingBoxGT BddContext
context :: [(ImageId, [BDD.BddRisk])]
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s %-12s %-12s %-12s" String
"#ImageId" String
"Filename" String
"Risk" String
"ErrorType"
let sum' :: [r] -> a
sum' [r]
riskWithErrors = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (r -> a) -> [r] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\r
r -> r
r.risk) [r]
riskWithErrors
sortedRisks :: [(ImageId, [BddRisk])]
sortedRisks = ((ImageId, [BddRisk]) -> (ImageId, [BddRisk]) -> Ordering)
-> [(ImageId, [BddRisk])] -> [(ImageId, [BddRisk])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(ImageId
_, [BddRisk]
risk1) (ImageId
_, [BddRisk]
risk2) -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([BddRisk] -> Double
forall {a} {r}. (Num a, HasField "risk" r a) => [r] -> a
sum' [BddRisk]
risk2) ([BddRisk] -> Double
forall {a} {r}. (Num a, HasField "risk" r a) => [r] -> a
sum' [BddRisk]
risk1)) [(ImageId, [BddRisk])]
risks
[(ImageId, [BddRisk])] -> ((ImageId, [BddRisk]) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ImageId, [BddRisk])]
sortedRisks (((ImageId, [BddRisk]) -> IO ()) -> IO ())
-> ((ImageId, [BddRisk]) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ImageId
imageId, [BddRisk]
risks') -> do
let cocoImage :: CocoImage
cocoImage = (CocoMap -> Map ImageId CocoImage
cocoMapCocoImage CocoMap
cocoMap) Map ImageId CocoImage -> ImageId -> CocoImage
forall k a. Ord k => Map k a -> k -> a
Map.! ImageId
imageId
[BddRisk] -> (BddRisk -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BddRisk]
risks' ((BddRisk -> IO ()) -> IO ()) -> (BddRisk -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BddRisk
bddRisk -> do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> Double -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12d %-12s %.3f %-12s" (ImageId -> Int
unImageId ImageId
imageId) (Text -> String
T.unpack (CocoImage -> Text
cocoImageFileName CocoImage
cocoImage)) BddRisk
bddRisk.risk (ErrorType BoundingBoxGT -> String
forall a. Show a => a -> String
show BddRisk
bddRisk.riskType)
generateRiskWeightedDataset :: CocoMap -> FilePath -> Maybe Double -> Maybe Double -> IO ()
generateRiskWeightedDataset :: CocoMap -> String -> Maybe Double -> Maybe Double -> IO ()
generateRiskWeightedDataset CocoMap
cocoMap String
cocoOutputFile Maybe Double
iouThreshold Maybe Double
scoreThresh = do
let context :: BddContext
context = CocoMap -> Maybe Double -> Maybe Double -> BddContext
toBddContext CocoMap
cocoMap Maybe Double
iouThreshold Maybe Double
scoreThresh
imageIds :: [ImgIdx BoundingBoxGT]
imageIds = forall b a. World b a => b -> [ImgIdx a]
Core.generateRiskWeightedImages @BDD.BddContext @BDD.BoundingBoxGT BddContext
context
(Coco
newCoco, [CocoResult]
newCocoResult) = CocoMap -> [ImageId] -> (Coco, [CocoResult])
resampleCocoMapWithImageIds CocoMap
cocoMap [ImageId]
imageIds
String -> Coco -> IO ()
writeCoco String
cocoOutputFile Coco
newCoco
let newCocoMap :: CocoMap
newCocoMap = Coco -> [CocoResult] -> String -> String -> CocoMap
toCocoMap Coco
newCoco [CocoResult]
newCocoResult String
cocoOutputFile String
""
CocoMap -> Maybe Double -> Maybe Double -> IO ()
RiskWeaver.Cmd.BDD.evaluate CocoMap
newCocoMap Maybe Double
iouThreshold Maybe Double
scoreThresh
green :: (Int, Int, Int)
green :: (Int, Int, Int)
green = (Int
0, Int
255, Int
0)
red :: (Int, Int, Int)
red :: (Int, Int, Int)
red = (Int
255, Int
0, Int
0)
black :: (Int, Int, Int)
black :: (Int, Int, Int)
black = (Int
0, Int
0, Int
0)
showDetectionImage :: CocoMap -> FilePath -> Maybe Double -> Maybe Double -> IO ()
showDetectionImage :: CocoMap -> String -> Maybe Double -> Maybe Double -> IO ()
showDetectionImage CocoMap
cocoMap String
imageFile Maybe Double
iouThreshold Maybe Double
scoreThreshold = do
let imageDir :: String
imageDir = CocoMap -> String
getImageDir CocoMap
cocoMap
imagePath :: String
imagePath = String
imageDir String -> String -> String
</> String
imageFile
let image' :: Maybe (CocoImage, [CocoResult])
image' = CocoMap -> String -> Maybe (CocoImage, [CocoResult])
forall a.
CocoMapable a =>
CocoMap -> a -> Maybe (CocoImage, [CocoResult])
getCocoResult CocoMap
cocoMap String
imageFile
context :: BddContext
context = CocoMap -> Maybe Double -> Maybe Double -> BddContext
toBddContext CocoMap
cocoMap Maybe Double
iouThreshold Maybe Double
scoreThreshold
case Maybe (CocoImage, [CocoResult])
image' of
Maybe (CocoImage, [CocoResult])
Nothing -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Image file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
imageFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not found."
Just (CocoImage
image, [CocoResult]
_) -> do
Either String DynamicImage
imageBin' <- String -> IO (Either String DynamicImage)
readImage String
imagePath
let env :: Env BoundingBoxGT
env = forall b a. World b a => b -> ImgIdx a -> Env a
Core.toEnv @BDD.BddContext @BDD.BoundingBoxGT BddContext
context (CocoImage -> ImageId
cocoImageId CocoImage
image)
riskG :: [BddRisk]
riskG = Reader (Env BoundingBoxGT) [BddRisk]
-> Env BoundingBoxGT -> [BddRisk]
forall r a. Reader r a -> r -> a
runReader Reader (Env BoundingBoxGT) [BddRisk]
forall a (m :: * -> *).
(BoundingBox a, Monad m) =>
ReaderT (Env a) m [Risk a]
forall (m :: * -> *).
Monad m =>
ReaderT (Env BoundingBoxGT) m [BddRisk]
Core.riskForGroundTruth Env BoundingBoxGT
env
riskD :: [BddRisk]
riskD = Reader (Env BoundingBoxGT) [BddRisk]
-> Env BoundingBoxGT -> [BddRisk]
forall r a. Reader r a -> r -> a
runReader Reader (Env BoundingBoxGT) [BddRisk]
forall a (m :: * -> *).
(BoundingBox a, Monad m) =>
ReaderT (Env a) m [Risk a]
forall (m :: * -> *).
Monad m =>
ReaderT (Env BoundingBoxGT) m [BddRisk]
Core.riskForDetection Env BoundingBoxGT
env
[BddRisk] -> (BddRisk -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BddRisk]
riskG ((BddRisk -> IO ()) -> IO ()) -> (BddRisk -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BddRisk
riskg -> do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ BddRisk -> String
forall a. Show a => a -> String
show BddRisk
riskg
[BddRisk] -> (BddRisk -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BddRisk]
riskD ((BddRisk -> IO ()) -> IO ()) -> (BddRisk -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BddRisk
riskd -> do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ BddRisk -> String
forall a. Show a => a -> String
show BddRisk
riskd
case Either String DynamicImage
imageBin' of
Left String
err -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Image file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
imagePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" can not be read. : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
err
Right DynamicImage
imageBin -> do
let imageRGB8 :: Image PixelRGB8
imageRGB8 = DynamicImage -> Image PixelRGB8
convertRGB8 DynamicImage
imageBin
Image PixelRGB8
groundTruthImage <- Image PixelRGB8 -> IO (Image PixelRGB8)
cloneImage Image PixelRGB8
imageRGB8
Image PixelRGB8
detectionImage <- Image PixelRGB8 -> IO (Image PixelRGB8)
cloneImage Image PixelRGB8
imageRGB8
[BddRisk] -> (BddRisk -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BddRisk]
riskG ((BddRisk -> IO ()) -> IO ()) -> (BddRisk -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BDD.BddRisk {Double
Maybe BoundingBoxDT
Maybe BoundingBoxGT
ErrorType BoundingBoxGT
riskType :: ErrorType BoundingBoxGT
risk :: Double
riskGt :: Maybe BoundingBoxGT
riskDt :: Maybe BoundingBoxDT
$sel:riskType:BddRisk :: BddRisk -> ErrorType BoundingBoxGT
$sel:risk:BddRisk :: BddRisk -> Double
$sel:riskGt:BddRisk :: BddRisk -> Maybe BoundingBoxGT
$sel:riskDt:BddRisk :: BddRisk -> Maybe BoundingBoxDT
..} -> do
case Maybe BoundingBoxGT
riskGt of
Maybe BoundingBoxGT
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just BoundingBoxGT
riskGt' -> do
let annotation :: BoundingBoxGT
annotation = Env BoundingBoxGT
env.envGroundTruth Vector BoundingBoxGT -> Int -> BoundingBoxGT
forall a. Vector a -> Int -> a
Vector.! (BoundingBoxGT -> Idx BoundingBoxGT
forall a. BoundingBox a => a -> Idx a
Core.idG BoundingBoxGT
riskGt')
(Double
bx, Double
by, Double
bw, Double
bh) = (BoundingBoxGT
annotation.x, BoundingBoxGT
annotation.y, BoundingBoxGT
annotation.w, BoundingBoxGT
annotation.h)
category :: Class
category = BoundingBoxGT
annotation.cls
x :: Int
x = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
bx
y :: Int
y = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
by
width :: Int
width = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
bw
height :: Int
height = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
bh
draw :: IO ()
draw = do
let color :: (Int, Int, Int)
color = case ErrorType BoundingBoxGT
riskType of
ErrorType BoundingBoxGT
R:ErrorTypeBoundingBoxGT
BDD.TruePositive -> (Int, Int, Int)
green
ErrorType BoundingBoxGT
_ -> (Int, Int, Int)
red
Int
-> Int -> Int -> Int -> (Int, Int, Int) -> Image PixelRGB8 -> IO ()
drawRect Int
x Int
y (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
width) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
height) (Int, Int, Int)
color Image PixelRGB8
groundTruthImage
String
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawString (Class -> String
forall a. Show a => a -> String
show Class
category) Int
x Int
y (Int, Int, Int)
color (Int, Int, Int)
black Image PixelRGB8
groundTruthImage
String
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawString (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f" Double
risk) Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10) (Int, Int, Int)
color (Int, Int, Int)
black Image PixelRGB8
groundTruthImage
String
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawString (ErrorType BoundingBoxGT -> String
forall a. Show a => a -> String
show ErrorType BoundingBoxGT
riskType) Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
20) (Int, Int, Int)
color (Int, Int, Int)
black Image PixelRGB8
groundTruthImage
IO ()
draw
[BddRisk] -> (BddRisk -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BddRisk]
riskD ((BddRisk -> IO ()) -> IO ()) -> (BddRisk -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BDD.BddRisk {Double
Maybe BoundingBoxDT
Maybe BoundingBoxGT
ErrorType BoundingBoxGT
$sel:riskType:BddRisk :: BddRisk -> ErrorType BoundingBoxGT
$sel:risk:BddRisk :: BddRisk -> Double
$sel:riskGt:BddRisk :: BddRisk -> Maybe BoundingBoxGT
$sel:riskDt:BddRisk :: BddRisk -> Maybe BoundingBoxDT
riskType :: ErrorType BoundingBoxGT
risk :: Double
riskGt :: Maybe BoundingBoxGT
riskDt :: Maybe BoundingBoxDT
..} -> do
case Maybe BoundingBoxDT
riskDt of
Maybe BoundingBoxDT
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just BoundingBoxDT
riskDt' -> do
let annotation :: BoundingBoxDT
annotation = Env BoundingBoxGT
env.envDetection Vector BoundingBoxDT -> Int -> BoundingBoxDT
forall a. Vector a -> Int -> a
Vector.! BoundingBoxDT -> Idx BoundingBoxGT
forall a. BoundingBox a => Detection a -> Idx a
Core.idD BoundingBoxDT
riskDt'
(Double
bx, Double
by, Double
bw, Double
bh) = (BoundingBoxDT
annotation.x, BoundingBoxDT
annotation.y, BoundingBoxDT
annotation.w, BoundingBoxDT
annotation.h)
category :: Class
category = BoundingBoxDT
annotation.cls
x :: Int
x = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
bx
y :: Int
y = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
by
width :: Int
width = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
bw
height :: Int
height = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
bh
draw :: IO ()
draw = do
let color :: (Int, Int, Int)
color = case ErrorType BoundingBoxGT
riskType of
ErrorType BoundingBoxGT
R:ErrorTypeBoundingBoxGT
BDD.TruePositive -> (Int, Int, Int)
green
ErrorType BoundingBoxGT
_ -> (Int, Int, Int)
red
Int
-> Int -> Int -> Int -> (Int, Int, Int) -> Image PixelRGB8 -> IO ()
drawRect Int
x Int
y (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
width) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
height) (Int, Int, Int)
color Image PixelRGB8
detectionImage
String
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawString (Class -> String
forall a. Show a => a -> String
show Class
category) Int
x Int
y (Int, Int, Int)
color (Int, Int, Int)
black Image PixelRGB8
detectionImage
String
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawString (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f" (BoundingBoxDT
annotation.score)) Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10) (Int, Int, Int)
color (Int, Int, Int)
black Image PixelRGB8
detectionImage
String
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawString (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f" Double
risk) Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
20) (Int, Int, Int)
color (Int, Int, Int)
black Image PixelRGB8
detectionImage
String
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawString (ErrorType BoundingBoxGT -> String
forall a. Show a => a -> String
show ErrorType BoundingBoxGT
riskType) Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30) (Int, Int, Int)
color (Int, Int, Int)
black Image PixelRGB8
detectionImage
if BoundingBoxDT
annotation.score Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= BddContext
context.bddContextScoreThresh
then IO ()
draw
else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Image PixelRGB8
concatImage <- Image PixelRGB8 -> Image PixelRGB8 -> IO (Image PixelRGB8)
concatImageByHorizontal Image PixelRGB8
groundTruthImage Image PixelRGB8
detectionImage
Either String (Image PixelRGB8) -> IO ()
putImage (Image PixelRGB8 -> Either String (Image PixelRGB8)
forall a b. b -> Either a b
Right Image PixelRGB8
concatImage)
(!!!) :: forall a b. Ord b => Map.Map b [a] -> b -> [a]
!!! :: forall a b. Ord b => Map b [a] -> b -> [a]
(!!!) Map b [a]
dat b
key = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [] (b -> Map b [a] -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup b
key Map b [a]
dat)
evaluate :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
evaluate :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
evaluate CocoMap
cocoMap Maybe Double
iouThreshold Maybe Double
scoreThresh = do
let context :: BddContext
context = CocoMap -> Maybe Double -> Maybe Double -> BddContext
toBddContext CocoMap
cocoMap Maybe Double
iouThreshold Maybe Double
scoreThresh
mAP :: Double
mAP = forall b a. World b a => b -> Double
Core.mAP @BDD.BddContext @BDD.BoundingBoxGT BddContext
context
ap' :: Map (ClassG BoundingBoxGT) Double
ap' = forall b a. World b a => b -> Map (ClassG a) Double
Core.ap @BDD.BddContext @BDD.BoundingBoxGT BddContext
context
f1 :: Map (ClassG BoundingBoxGT) Double
f1 = forall b a. World b a => b -> Map (ClassG a) Double
Core.f1 @BDD.BddContext @BDD.BoundingBoxGT BddContext
context
mF1 :: Double
mF1 = forall b a. World b a => b -> Double
Core.mF1 @BDD.BddContext @BDD.BoundingBoxGT BddContext
context
confusionMatrixR :: Map.Map (BDD.Class, BDD.Class) [BDD.BddRisk]
confusionMatrixR :: Map (Class, Class) [BddRisk]
confusionMatrixR = forall b a. World b a => b -> Map (ClassG a, ClassD a) [Risk a]
Core.confusionMatrixRecall @BDD.BddContext @BDD.BoundingBoxGT BddContext
context
confusionMatrixP :: Map.Map (BDD.Class, BDD.Class) [BDD.BddRisk]
confusionMatrixP :: Map (Class, Class) [BddRisk]
confusionMatrixP = forall b a. World b a => b -> Map (ClassD a, ClassG a) [Risk a]
Core.confusionMatrixPrecision @BDD.BddContext @BDD.BoundingBoxGT BddContext
context
confusionMatrixR_cnt :: Map.Map (BDD.Class, BDD.Class) Int
confusionMatrixR_cnt :: Map (Class, Class) Int
confusionMatrixR_cnt = [((Class, Class), Int)] -> Map (Class, Class) Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([((Class, Class), Int)] -> Map (Class, Class) Int)
-> [((Class, Class), Int)] -> Map (Class, Class) Int
forall a b. (a -> b) -> a -> b
$ [[((Class, Class), Int)]] -> [((Class, Class), Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[((Class, Class), Int)]] -> [((Class, Class), Int)])
-> [[((Class, Class), Int)]] -> [((Class, Class), Int)]
forall a b. (a -> b) -> a -> b
$
((CategoryId -> [((Class, Class), Int)])
-> [CategoryId] -> [[((Class, Class), Int)]])
-> [CategoryId]
-> (CategoryId -> [((Class, Class), Int)])
-> [[((Class, Class), Int)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CategoryId -> [((Class, Class), Int)])
-> [CategoryId] -> [[((Class, Class), Int)]]
forall a b. (a -> b) -> [a] -> [b]
map (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> [((Class, Class), Int)])
-> [[((Class, Class), Int)]])
-> (CategoryId -> [((Class, Class), Int)])
-> [[((Class, Class), Int)]]
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId ->
let classG :: Class
classG = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId
keyBG :: (Class, Class)
keyBG = (Class
classG, Class
BDD.Background)
toBG :: ((Class, Class), Int)
toBG = ((Class, Class)
keyBG, [BddRisk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([BddRisk] -> Int) -> [BddRisk] -> Int
forall a b. (a -> b) -> a -> b
$ Map (Class, Class) [BddRisk]
confusionMatrixR Map (Class, Class) [BddRisk] -> (Class, Class) -> [BddRisk]
forall a b. Ord b => Map b [a] -> b -> [a]
!!! (Class, Class)
keyBG)
toClasses :: [((Class, Class), Int)]
toClasses =
((CategoryId -> ((Class, Class), Int))
-> [CategoryId] -> [((Class, Class), Int)])
-> [CategoryId]
-> (CategoryId -> ((Class, Class), Int))
-> [((Class, Class), Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CategoryId -> ((Class, Class), Int))
-> [CategoryId] -> [((Class, Class), Int)]
forall a b. (a -> b) -> [a] -> [b]
map (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> ((Class, Class), Int)) -> [((Class, Class), Int)])
-> (CategoryId -> ((Class, Class), Int)) -> [((Class, Class), Int)]
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId' ->
let classD :: Class
classD = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId'
keyCl :: (Class, Class)
keyCl = (Class
classG, Class
classD)
in ((Class, Class)
keyCl, [BddRisk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([BddRisk] -> Int) -> [BddRisk] -> Int
forall a b. (a -> b) -> a -> b
$ Map (Class, Class) [BddRisk]
confusionMatrixR Map (Class, Class) [BddRisk] -> (Class, Class) -> [BddRisk]
forall a b. Ord b => Map b [a] -> b -> [a]
!!! (Class, Class)
keyCl)
in ((Class, Class), Int)
toBG((Class, Class), Int)
-> [((Class, Class), Int)] -> [((Class, Class), Int)]
forall a. a -> [a] -> [a]
: [((Class, Class), Int)]
toClasses
confusionMatrixP_cnt :: Map.Map (BDD.Class, BDD.Class) Int
confusionMatrixP_cnt :: Map (Class, Class) Int
confusionMatrixP_cnt = [((Class, Class), Int)] -> Map (Class, Class) Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([((Class, Class), Int)] -> Map (Class, Class) Int)
-> [((Class, Class), Int)] -> Map (Class, Class) Int
forall a b. (a -> b) -> a -> b
$ [[((Class, Class), Int)]] -> [((Class, Class), Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[((Class, Class), Int)]] -> [((Class, Class), Int)])
-> [[((Class, Class), Int)]] -> [((Class, Class), Int)]
forall a b. (a -> b) -> a -> b
$
((CategoryId -> [((Class, Class), Int)])
-> [CategoryId] -> [[((Class, Class), Int)]])
-> [CategoryId]
-> (CategoryId -> [((Class, Class), Int)])
-> [[((Class, Class), Int)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CategoryId -> [((Class, Class), Int)])
-> [CategoryId] -> [[((Class, Class), Int)]]
forall a b. (a -> b) -> [a] -> [b]
map (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> [((Class, Class), Int)])
-> [[((Class, Class), Int)]])
-> (CategoryId -> [((Class, Class), Int)])
-> [[((Class, Class), Int)]]
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId ->
let classD :: Class
classD = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId
keyBG :: (Class, Class)
keyBG = (Class
classD, Class
BDD.Background)
toBG :: ((Class, Class), Int)
toBG = ((Class, Class)
keyBG, [BddRisk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([BddRisk] -> Int) -> [BddRisk] -> Int
forall a b. (a -> b) -> a -> b
$ Map (Class, Class) [BddRisk]
confusionMatrixP Map (Class, Class) [BddRisk] -> (Class, Class) -> [BddRisk]
forall a b. Ord b => Map b [a] -> b -> [a]
!!! (Class, Class)
keyBG)
toClasses :: [((Class, Class), Int)]
toClasses =
((CategoryId -> ((Class, Class), Int))
-> [CategoryId] -> [((Class, Class), Int)])
-> [CategoryId]
-> (CategoryId -> ((Class, Class), Int))
-> [((Class, Class), Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CategoryId -> ((Class, Class), Int))
-> [CategoryId] -> [((Class, Class), Int)]
forall a b. (a -> b) -> [a] -> [b]
map (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> ((Class, Class), Int)) -> [((Class, Class), Int)])
-> (CategoryId -> ((Class, Class), Int)) -> [((Class, Class), Int)]
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId' ->
let classG :: Class
classG = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId'
keyCl :: (Class, Class)
keyCl = (Class
classD, Class
classG)
in ((Class, Class)
keyCl, [BddRisk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([BddRisk] -> Int) -> [BddRisk] -> Int
forall a b. (a -> b) -> a -> b
$ Map (Class, Class) [BddRisk]
confusionMatrixP Map (Class, Class) [BddRisk] -> (Class, Class) -> [BddRisk]
forall a b. Ord b => Map b [a] -> b -> [a]
!!! (Class, Class)
keyCl)
in ((Class, Class), Int)
toBG((Class, Class), Int)
-> [((Class, Class), Int)] -> [((Class, Class), Int)]
forall a. a -> [a] -> [a]
: [((Class, Class), Int)]
toClasses
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"#%-12s, %s" String
"CocoFile" CocoMap
cocoMap.cocoMapCocoFile
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"#%-12s, %s" String
"CocoResultFile" CocoMap
cocoMap.cocoMapCocoResultFile
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %s" String
"#Category" String
"AP"
[CategoryId] -> (CategoryId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> IO ()) -> IO ()) -> (CategoryId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId -> do
let class' :: Class
class' = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %.3f" (Text -> String
T.unpack (CocoCategory -> Text
cocoCategoryName ((CocoMap -> Map CategoryId CocoCategory
cocoMapCocoCategory CocoMap
cocoMap) Map CategoryId CocoCategory -> CategoryId -> CocoCategory
forall k a. Ord k => Map k a -> k -> a
Map.! CategoryId
categoryId))) (Map Class Double
ap' Map Class Double -> Class -> Double
forall k a. Ord k => Map k a -> k -> a
Map.! Class
class')
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %.3f" String
"mAP" Double
mAP
String -> IO ()
putStrLn String
""
let risks :: [(ImgIdx BoundingBoxGT, Double)]
risks = forall context a.
World context a =>
context -> [(ImgIdx a, Double)]
Core.runRisk @BDD.BddContext @BDD.BoundingBoxGT BddContext
context
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s" String
"#Risk"
let num_of_images :: Int
num_of_images = ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [Double] -> Int
forall a b. (a -> b) -> a -> b
$ ((ImageId, Double) -> Double) -> [(ImageId, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (ImageId, Double) -> Double
forall a b. (a, b) -> b
snd [(ImageId, Double)]
risks)
max_risks :: Double
max_risks = ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((ImageId, Double) -> Double) -> [(ImageId, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (ImageId, Double) -> Double
forall a b. (a, b) -> b
snd [(ImageId, Double)]
risks)
sorted_risks :: [Double]
sorted_risks = (Double -> Double -> Ordering) -> [Double] -> [Double]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Double
r1 Double
r2 -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
r2 Double
r1) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ ((ImageId, Double) -> Double) -> [(ImageId, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (ImageId, Double) -> Double
forall a b. (a, b) -> b
snd [(ImageId, Double)]
risks
percentile_90 :: [Double]
percentile_90 = Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take (Int
num_of_images Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100) [Double]
sorted_risks
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %.2f" String
"total" ([Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((ImageId, Double) -> Double) -> [(ImageId, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (ImageId, Double) -> Double
forall a b. (a, b) -> b
snd [(ImageId, Double)]
risks)
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %.2f" String
"maximum" Double
max_risks
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %.2f" String
"average" ([Double] -> Double
forall a (f :: * -> *).
(Num a, Foldable f, Fractional a) =>
f a -> a
M.average ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((ImageId, Double) -> Double) -> [(ImageId, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (ImageId, Double) -> Double
forall a b. (a, b) -> b
snd [(ImageId, Double)]
risks)
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %.2f" String
"minimum" ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((ImageId, Double) -> Double) -> [(ImageId, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (ImageId, Double) -> Double
forall a b. (a, b) -> b
snd [(ImageId, Double)]
risks)
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %.2f" String
"90percentile" (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ [Double] -> Double
forall a. HasCallStack => [a] -> a
head ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double]
forall a. [a] -> [a]
reverse [Double]
percentile_90
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %d" String
"num_of_images" Int
num_of_images
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
"#confusion matrix of recall: row is ground truth, column is prediction."
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s," String
"#GT \\ DT"
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s," String
"Backgroud"
[CategoryId] -> (CategoryId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> IO ()) -> IO ()) -> (CategoryId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId -> do
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s," (Text -> String
T.unpack (CocoCategory -> Text
cocoCategoryName ((CocoMap -> Map CategoryId CocoCategory
cocoMapCocoCategory CocoMap
cocoMap) Map CategoryId CocoCategory -> CategoryId -> CocoCategory
forall k a. Ord k => Map k a -> k -> a
Map.! CategoryId
categoryId)))
String -> IO ()
putStrLn String
""
[CategoryId] -> (CategoryId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> IO ()) -> IO ()) -> (CategoryId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId -> do
let classG :: Class
classG = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s," (Text -> String
T.unpack (CocoCategory -> Text
cocoCategoryName ((CocoMap -> Map CategoryId CocoCategory
cocoMapCocoCategory CocoMap
cocoMap) Map CategoryId CocoCategory -> CategoryId -> CocoCategory
forall k a. Ord k => Map k a -> k -> a
Map.! CategoryId
categoryId)))
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%-12d," (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Map (Class, Class) Int
confusionMatrixR_cnt Map (Class, Class) Int -> (Class, Class) -> Int
forall k a. Ord k => Map k a -> k -> a
Map.! (Class
classG, Class
BDD.Background)
[CategoryId] -> (CategoryId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> IO ()) -> IO ()) -> (CategoryId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId' -> do
let classD :: Class
classD = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId'
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%-12d," (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Map (Class, Class) Int
confusionMatrixR_cnt Map (Class, Class) Int -> (Class, Class) -> Int
forall k a. Ord k => Map k a -> k -> a
Map.! (Class
classG, Class
classD)
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
"#confusion matrix of precision: row is prediction, column is ground truth."
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"#%-11s," String
"DT \\ GT"
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s," String
"Backgroud"
[CategoryId] -> (CategoryId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> IO ()) -> IO ()) -> (CategoryId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId -> do
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s," (Text -> String
T.unpack (CocoCategory -> Text
cocoCategoryName ((CocoMap -> Map CategoryId CocoCategory
cocoMapCocoCategory CocoMap
cocoMap) Map CategoryId CocoCategory -> CategoryId -> CocoCategory
forall k a. Ord k => Map k a -> k -> a
Map.! CategoryId
categoryId)))
String -> IO ()
putStrLn String
""
[CategoryId] -> (CategoryId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> IO ()) -> IO ()) -> (CategoryId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId -> do
let classD :: Class
classD = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-12s," (Text -> String
T.unpack (CocoCategory -> Text
cocoCategoryName ((CocoMap -> Map CategoryId CocoCategory
cocoMapCocoCategory CocoMap
cocoMap) Map CategoryId CocoCategory -> CategoryId -> CocoCategory
forall k a. Ord k => Map k a -> k -> a
Map.! CategoryId
categoryId)))
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%-12d," (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Map (Class, Class) Int
confusionMatrixP_cnt Map (Class, Class) Int -> (Class, Class) -> Int
forall k a. Ord k => Map k a -> k -> a
Map.! (Class
classD, Class
BDD.Background)
[CategoryId] -> (CategoryId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> IO ()) -> IO ()) -> (CategoryId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId' -> do
let classG :: Class
classG = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId'
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%-12d," (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Map (Class, Class) Int
confusionMatrixP_cnt Map (Class, Class) Int -> (Class, Class) -> Int
forall k a. Ord k => Map k a -> k -> a
Map.! (Class
classD, Class
classG)
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
"#F1 Scores"
[CategoryId] -> (CategoryId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CocoMap -> [CategoryId]
cocoMapCategoryIds CocoMap
cocoMap) ((CategoryId -> IO ()) -> IO ()) -> (CategoryId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CategoryId
categoryId -> do
let class' :: Class
class' = CocoMap -> CategoryId -> Class
BDD.cocoCategoryToClass CocoMap
cocoMap CategoryId
categoryId
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %.3f" (Text -> String
T.unpack (CocoCategory -> Text
cocoCategoryName ((CocoMap -> Map CategoryId CocoCategory
cocoMapCocoCategory CocoMap
cocoMap) Map CategoryId CocoCategory -> CategoryId -> CocoCategory
forall k a. Ord k => Map k a -> k -> a
Map.! CategoryId
categoryId))) (Map Class Double
f1 Map Class Double -> Class -> Double
forall k a. Ord k => Map k a -> k -> a
Map.! Class
class')
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%-12s, %.3f" String
"mF1" Double
mF1
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
""
bddCommand :: RiskCommands
bddCommand :: RiskCommands
bddCommand =
RiskCommands
{ showRisk :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
showRisk = CocoMap -> Maybe Double -> Maybe Double -> IO ()
RiskWeaver.Cmd.BDD.showRisk,
showRiskWithError :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
showRiskWithError = CocoMap -> Maybe Double -> Maybe Double -> IO ()
RiskWeaver.Cmd.BDD.showRiskWithError,
generateRiskWeightedDataset :: CocoMap -> String -> Maybe Double -> Maybe Double -> IO ()
generateRiskWeightedDataset = CocoMap -> String -> Maybe Double -> Maybe Double -> IO ()
RiskWeaver.Cmd.BDD.generateRiskWeightedDataset,
showDetectionImage :: CocoMap -> String -> Maybe Double -> Maybe Double -> IO ()
showDetectionImage = CocoMap -> String -> Maybe Double -> Maybe Double -> IO ()
RiskWeaver.Cmd.BDD.showDetectionImage,
evaluate :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
evaluate = CocoMap -> Maybe Double -> Maybe Double -> IO ()
RiskWeaver.Cmd.BDD.evaluate
}