{-# 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
                -- Use printf format to show score
                -- drawString (printf "%.2f" (unScore $ riskGt.score)) x (y + 10) green black imageRGB8
                -- drawString (show $ cocoResultScore annotation)  x (y + 10) (255,0,0) (0,0,0) imageRGB8
                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
          -- let resizedImage = resizeRGB8 groundTruthImage.imageWidth groundTruthImage.imageHeight True concatImage
          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 -- Metric.confusionMatrix @(Sum Int) cocoMap iouThreshold' scoreThresh'
      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 -- Metric.confusionMatrix @(Sum Int) cocoMap iouThreshold' scoreThresh'
      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
""

  -- Print risk scores statistically
  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
""

  -- Print confusion matrix
  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
""

  -- Print F1 scores
  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
    }