risk-weaver-0.1.0.2: bin/sample-risk.hs

#!/usr/bin/env cabal
{- cabal:
build-depends: base
             , risk-weaver == 0.1.0.2
	     , containers
	     , vector
	     , text
	     , random
	     , transformers
       , parallel
       , filepath
       , JuicyPixels
-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

import Codec.Picture
import Control.Monad
import Control.Monad.Trans.Reader (ReaderT, ask, runReader)
import Control.Parallel.Strategies
import Data.List (sortBy)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import GHC.Generics
import RiskWeaver.Cmd.Core (RiskCommands (..), baseMain)
import RiskWeaver.DSL.Core
import RiskWeaver.DSL.Core qualified as Core
import RiskWeaver.Display (putImage)
import RiskWeaver.Draw
import RiskWeaver.Format.Coco
import RiskWeaver.Metric
import RiskWeaver.Metric qualified as M
import RiskWeaver.Pip
import System.FilePath ((</>))
import Text.Printf




data BoundingBoxGT = BoundingBoxGT
  { x :: Double,
    y :: Double,
    w :: Double,
    h :: Double,
    cls :: Class,
    idx :: Int
  }
  deriving (Show, Eq, Ord, Generic, NFData)

data Class
  = Background
  | Pedestrian
  | Rider
  | Car
  | Truck
  | Bus
  | Train
  | Motorcycle
  | Bicycle
  deriving (Show, Eq, Ord, Generic, NFData)

data SubErrorType
  = Boundary
  | LowScore
  | MissClass
  | Occulusion
  deriving (Show, Ord, Eq, Generic, NFData)

type BoundingBoxDT = Detection BoundingBoxGT

instance Rectangle BoundingBoxGT where
  rX b = b.x
  rY b = b.y
  rW b = b.w
  rH b = b.h
  
instance Rectangle (Detection BoundingBoxGT) where
  rX b = b.x
  rY b = b.y
  rW b = b.w
  rH b = b.h
  
instance BoundingBox BoundingBoxGT where
  data Detection _ = BoundingBoxDT
    { x :: Double,
      y :: Double,
      w :: Double,
      h :: Double,
      cls :: Class,
      score :: Double,
      idx :: Int
    }
    deriving (Show, Eq, Ord, Generic, NFData)
  type ClassG _ = Class
  type ClassD _ = Class
  data ErrorType _
    = FalsePositive (Set SubErrorType)
    | FalseNegative (Set SubErrorType)
    | TruePositive
    | TrueNegative
    deriving (Ord, Eq, Generic, NFData)
  type InterestArea _ = [(Double, Double)]
  type InterestObject _ = Either BoundingBoxGT BoundingBoxDT -> Bool
  data Env _ = MyEnv
    { envGroundTruth :: Vector BoundingBoxGT,
      envDetection :: Vector BoundingBoxDT,
      envConfidenceScoreThresh :: Double,
      envIoUThresh :: Double,
      envUseInterestArea :: Bool,
      envImageId :: ImageId
    }
    deriving (Show, Ord, Eq, Generic, NFData)
  type Idx _ = Int
  type ImgIdx _ = ImageId
  data Risk _ = BddRisk
    { riskType :: ErrorType BoundingBoxGT,
      risk :: Double,
      riskGt :: Maybe BoundingBoxGT,
      riskDt :: Maybe (Detection BoundingBoxGT)
    } deriving (Show, Ord, Eq, Generic, NFData)

  interestArea :: Env BoundingBoxGT -> InterestArea BoundingBoxGT
  interestArea _ = [(0, 1), (0.3, 0.6), (0.7, 0.6), (1, 1), (1, 2), (0, 2)]
  interestObject _ = \case
    Left gt -> gt.w * gt.h > 1000
    Right dt -> dt.w * dt.h > 1000
  groundTruth env = envGroundTruth env
  detection env = envDetection env
  confidenceScoreThresh env = envConfidenceScoreThresh env
  ioUThresh env = envIoUThresh env
  scoreD v = v.score
  classD v = v.cls
  idD v = v.idx
  imageId env = envImageId env

  isBackD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isBackD _ _ = undefined

  isLeftD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isLeftD _ _ = undefined
  isRightD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isRightD _ _ = undefined
  isTopD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isTopD _ _ = undefined
  isBottomD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isBottomD _ _ = undefined
  isBackGroundD :: ClassD BoundingBoxGT -> Bool
  isBackGroundD Background = True
  isBackGroundD _ = False
  toErrorType = riskType
  toRiskScore = Main.risk

  classG v = v.cls
  angle _ _ = undefined
  idG v = v.idx

  isInIeterestAreaD :: InterestArea BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isInIeterestAreaD polygon dt = pointInPolygon (Polygon polygon) (Point (dt.x, dt.y))
  isInIeterestAreaG :: InterestArea BoundingBoxGT -> BoundingBoxGT -> Bool
  isInIeterestAreaG polygon gt = pointInPolygon (Polygon polygon) (Point (gt.x, gt.y))
  isInterestObjectD :: InterestObject BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isInterestObjectD fn dt = fn $ Right dt
  isInterestObjectG :: InterestObject BoundingBoxGT -> BoundingBoxGT -> Bool
  isInterestObjectG fn gt = fn $ Left gt

  riskForGroundTruth :: forall m. (Monad m) => ReaderT (Env BoundingBoxGT) m [Risk BoundingBoxGT]
  riskForGroundTruth = do
    env <- ask
    loopG (++) [] $ \(gt :: a) ->
      whenInterestAreaG (envUseInterestArea env) gt $ do
        let riskBias = if classG @BoundingBoxGT gt == Pedestrian then 10 else 1
        case detectG env gt of
          Just (dt :: Detection a) ->
            return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = 0.0001, riskType = TruePositive}]
          Nothing -> do
            case detectMaxIouG env gt of
              Nothing -> return [BddRisk {riskGt = Just gt, riskDt = Nothing, risk = riskBias * 30, riskType = FalseNegative []}]
              Just (dt :: Detection a) -> do
                case ( classD @BoundingBoxGT dt == classG @BoundingBoxGT gt,
                       scoreD @BoundingBoxGT dt > confidenceScoreThresh env,
                       ioU gt dt > ioUThresh env,
                       ioG gt dt > ioUThresh env
                     ) of
                  (False, False, False, True) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 5.1, riskType = FalseNegative [MissClass, LowScore, Occulusion]}]
                  (False, False, True, _) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 5, riskType = FalseNegative [MissClass, LowScore]}]
                  (False, True, False, True) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 5.1, riskType = FalseNegative [MissClass, Occulusion]}]
                  (False, True, True, _) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 2, riskType = FalseNegative [MissClass]}]
                  (True, False, False, True) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 5.1, riskType = FalseNegative [LowScore, Occulusion]}]
                  (True, False, True, _) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 5, riskType = FalseNegative [LowScore]}]
                  (True, True, False, True) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 0.1, riskType = FalseNegative [Occulusion]}]
                  (True, True, True, _) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 0.0001, riskType = TruePositive}]
                  (_, _, False, False) -> return [BddRisk {riskGt = Just gt, riskDt = Nothing, risk = riskBias * 30, riskType = FalseNegative []}]
  {-# INLINEABLE riskForGroundTruth #-}
  
  riskForDetection :: forall m. (Monad m) => ReaderT (Env BoundingBoxGT) m [Risk BoundingBoxGT]
  riskForDetection = do
    env <- ask
    loopD (++) [] $ \(dt :: Detection a) ->
      whenInterestAreaD (envUseInterestArea env) dt $ do
        let riskBias = if classD @BoundingBoxGT dt == Pedestrian then 10 else 1
        case detectD env dt of
          Just (gt :: a) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = 0.0001, riskType = TruePositive}]
          Nothing -> do
            case detectMaxIouD env dt of
              Nothing -> return [BddRisk {riskGt = Nothing, riskDt = Just dt, risk = riskBias * 5, riskType = FalsePositive []}]
              Just (gt :: a) -> do
                case ( classD @BoundingBoxGT dt == classG @BoundingBoxGT gt,
                       scoreD @BoundingBoxGT dt > confidenceScoreThresh env,
                       ioU gt dt > ioUThresh env,
                       ioG gt dt > ioUThresh env
                     ) of
                  (False, True, False, True) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 2.1, riskType = FalsePositive [MissClass, Occulusion]}]
                  (False, True, True, _) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 2, riskType = FalsePositive [MissClass]}]
                  (True, True, False, True) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 0.1, riskType = FalsePositive [Occulusion]}]
                  (True, True, True, _) -> return [BddRisk {riskGt = Just gt, riskDt = Just dt, risk = riskBias * 0.0001, riskType = TruePositive}]
                  (_, True, False, False) -> return [BddRisk {riskGt = Nothing, riskDt = Just dt, risk = riskBias * 5, riskType = FalsePositive []}]
                  (_, False, _, _) -> return []
  {-# INLINEABLE riskForDetection #-}

instance Show (ErrorType BoundingBoxGT) where
  show (FalsePositive suberrors) = "FP: " ++ foldl (\acc suberror -> acc ++ show suberror ++ ", ") "" (Set.toList suberrors)
  show (FalseNegative suberrors) = "FN: " ++ foldl (\acc suberror -> acc ++ show suberror ++ ", ") "" (Set.toList suberrors)
  show TruePositive = "TP"
  show TrueNegative = "TN"

type BddRisk = Risk BoundingBoxGT

cocoCategoryToClass :: CocoMap -> CategoryId -> Class
cocoCategoryToClass coco categoryId =
  let cocoCategory = (cocoMapCocoCategory coco) Map.! categoryId
   in case T.unpack (cocoCategoryName cocoCategory) of
        "pedestrian" -> Pedestrian
        "rider" -> Rider
        "car" -> Car
        "truck" -> Truck
        "bus" -> Bus
        "train" -> Train
        "motorcycle" -> Motorcycle
        "bicycle" -> Bicycle
        _ -> Background

cocoResultToVector :: CocoMap -> ImageId -> (Vector BoundingBoxGT, Vector BoundingBoxDT)
cocoResultToVector coco imageId' = (groundTruth', detection')
  where
    groundTruth' =
      Vector.fromList $
        maybe
          []
          ( map
              ( \(index, CocoAnnotation {..}) ->
                  let CoCoBoundingBox (cocox, cocoy, cocow, cocoh) = cocoAnnotationBbox
                   in BoundingBoxGT
                        { x = cocox,
                          y = cocoy,
                          w = cocow,
                          h = cocoh,
                          cls = cocoCategoryToClass coco cocoAnnotationCategory,
                          idx = index -- cocoAnnotationId
                        }
              )
              . zip [0 ..]
          )
          (Map.lookup imageId' (cocoMapCocoAnnotation coco))
    detection' =
      Vector.fromList $
        maybe
          []
          ( map
              ( \(index, CocoResult {..}) ->
                  let CoCoBoundingBox (cocox, cocoy, cocow, cocoh) = cocoResultBbox
                   in BoundingBoxDT
                        { x = cocox,
                          y = cocoy,
                          w = cocow,
                          h = cocoh,
                          cls = cocoCategoryToClass coco cocoResultCategory,
                          score = unScore cocoResultScore,
                          idx = index
                        }
              )
              . zip [0 ..]
          )
          (Map.lookup imageId' (cocoMapCocoResult coco))

data BddContext = BddContext
  { bddContextDataset :: CocoMap,
    bddContextIouThresh :: Double,
    bddContextScoreThresh :: Double,
    bddContextUseInterestArea :: Bool
  }
  deriving (Show, Eq)

instance World BddContext BoundingBoxGT where
  mAP BddContext {..} = fst $ RiskWeaver.Metric.mAP bddContextDataset (IOU bddContextIouThresh)
  ap BddContext {..} = Map.fromList $ map (\(key, value) -> (cocoCategoryToClass bddContextDataset key, value)) $ snd $ RiskWeaver.Metric.mAP bddContextDataset (IOU bddContextIouThresh)
  mF1 BddContext {..} = fst $ RiskWeaver.Metric.mF1 bddContextDataset (IOU bddContextIouThresh) (Score bddContextScoreThresh)
  f1 BddContext {..} = Map.fromList $ map (\(key, value) -> (cocoCategoryToClass bddContextDataset key, value)) $ snd $ RiskWeaver.Metric.mF1 bddContextDataset (IOU bddContextIouThresh) (Score bddContextScoreThresh)
  confusionMatrixRecall context@BddContext {..} = sortAndGroup risks
    where
      risks :: [((Class, Class), BddRisk)]
      risks = concat $ flip map (cocoMapImageIds bddContextDataset) $ \imageId' -> map getKeyValue (runReader riskForGroundTruth (toEnv context imageId'))
      getKeyValue :: BddRisk -> ((Class, Class), BddRisk)
      getKeyValue bddRisk = ((maybe Background classG bddRisk.riskGt, maybe Background classD bddRisk.riskDt), bddRisk)
  confusionMatrixPrecision context@BddContext {..} = sortAndGroup risks
    where
      risks :: [((Class, Class), BddRisk)]
      risks = concat $ flip map (cocoMapImageIds bddContextDataset) $ \imageId' -> map getKeyValue (runReader riskForDetection (toEnv context imageId'))
      getKeyValue :: BddRisk -> ((Class, Class), BddRisk)
      getKeyValue bddRisk = ((maybe Background classD bddRisk.riskDt, maybe Background classG bddRisk.riskGt), bddRisk)

  toEnv BddContext {..} imageId' =
    let (groundTruth', detection') = cocoResultToVector bddContextDataset imageId'
     in MyEnv
          { envGroundTruth = groundTruth',
            envDetection = detection',
            envConfidenceScoreThresh = bddContextScoreThresh,
            envIoUThresh = bddContextIouThresh,
            envUseInterestArea = bddContextUseInterestArea,
            envImageId = imageId'
          }

  toImageIds BddContext {..} = cocoMapImageIds bddContextDataset




toBddContext :: CocoMap -> Maybe Double -> Maybe Double -> Main.BddContext
toBddContext cocoMap iouThreshold scoreThresh =
  let iouThreshold'' = case iouThreshold of
        Nothing -> 0.5
        Just iouThreshold' -> iouThreshold'
      scoreThresh'' = case scoreThresh of
        Nothing -> 0.4
        Just scoreThresh' -> scoreThresh'
      context =
        Main.BddContext
          { bddContextDataset = cocoMap,
            bddContextIouThresh = iouThreshold'',
            bddContextScoreThresh = scoreThresh'',
            bddContextUseInterestArea = False
          }
   in context

showRisk :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
showRisk cocoMap iouThreshold scoreThresh = do
  let context = toBddContext cocoMap iouThreshold scoreThresh
      risks = Core.runRisk @Main.BddContext @Main.BoundingBoxGT context
  putStrLn $ printf "%-12s %-12s %s" "#ImageId" "Filename" "Risk"
  let sortedRisks = sortBy (\(_, risk1) (_, risk2) -> compare risk2 risk1) risks
  forM_ sortedRisks $ \(imageId, risk) -> do
    let cocoImage = (cocoMapCocoImage cocoMap) Map.! imageId
    putStrLn $ printf "%-12d %-12s %.3f" (unImageId imageId) (T.unpack (cocoImageFileName cocoImage)) risk

showRiskWithError :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
showRiskWithError cocoMap iouThreshold scoreThresh = do
  let context = toBddContext cocoMap iouThreshold scoreThresh
      risks = Core.runRiskWithError @Main.BddContext @Main.BoundingBoxGT context :: [(ImageId, [Main.BddRisk])]
  putStrLn $ printf "%-12s %-12s %-12s %-12s" "#ImageId" "Filename" "Risk" "ErrorType"
  let sum' riskWithErrors = sum $ map (\r -> r.risk) riskWithErrors
      sortedRisks = sortBy (\(_, risk1) (_, risk2) -> compare (sum' risk2) (sum' risk1)) risks
  forM_ sortedRisks $ \(imageId, risks') -> do
    let cocoImage = (cocoMapCocoImage cocoMap) Map.! imageId
    forM_ risks' $ \bddRisk -> do
      putStrLn $ printf "%-12d %-12s %.3f %-12s" (unImageId imageId) (T.unpack (cocoImageFileName cocoImage)) bddRisk.risk (show bddRisk.riskType)


generateRiskWeightedDataset :: CocoMap -> FilePath -> Maybe Double -> Maybe Double -> IO ()
generateRiskWeightedDataset cocoMap cocoOutputFile iouThreshold scoreThresh = do
  let context = toBddContext cocoMap iouThreshold scoreThresh
      imageIds = Core.generateRiskWeightedImages @Main.BddContext @Main.BoundingBoxGT context
      (newCoco, newCocoResult) = resampleCocoMapWithImageIds cocoMap imageIds
  writeCoco cocoOutputFile newCoco
  let newCocoMap = toCocoMap newCoco newCocoResult cocoOutputFile ""
  Main.evaluate newCocoMap iouThreshold scoreThresh

green :: (Int, Int, Int)
green = (0, 255, 0)

red :: (Int, Int, Int)
red = (255, 0, 0)

black :: (Int, Int, Int)
black = (0, 0, 0)

showDetectionImage :: CocoMap -> FilePath -> Maybe Double -> Maybe Double -> IO ()
showDetectionImage cocoMap imageFile iouThreshold scoreThreshold = do
  let imageDir = getImageDir cocoMap
      imagePath = imageDir </> imageFile
  let image' = getCocoResult cocoMap imageFile
      context = toBddContext cocoMap iouThreshold scoreThreshold
  case image' of
    Nothing -> putStrLn $ "Image file " ++ imageFile ++ " is not found."
    Just (image, _) -> do
      imageBin' <- readImage imagePath
      let env = Core.toEnv @Main.BddContext @Main.BoundingBoxGT context (cocoImageId image)
          riskG = runReader Core.riskForGroundTruth env
          riskD = runReader Core.riskForDetection env
      forM_ riskG $ \riskg -> do
        putStrLn $ show riskg
      forM_ riskD $ \riskd -> do
        putStrLn $ show riskd
      case imageBin' of
        Left err -> putStrLn $ "Image file " ++ imagePath ++ " can not be read. : " ++ show err
        Right imageBin -> do
          let imageRGB8 = convertRGB8 imageBin
          groundTruthImage <- cloneImage imageRGB8
          detectionImage <- cloneImage imageRGB8
          forM_ riskG $ \Main.BddRisk {..} -> do
            case riskGt of
              Nothing -> return ()
              Just riskGt' -> do
                let annotation = env.envGroundTruth Vector.! (Core.idG riskGt')
                    (bx, by, bw, bh) = (annotation.x, annotation.y, annotation.w, annotation.h)
                    category = annotation.cls
                    x = round bx
                    y = round by
                    width = round bw
                    height = round bh
                    draw = do
                      let color = case riskType of
                            Main.TruePositive -> green
                            _ -> red
                      drawRect x y (x + width) (y + height) color groundTruthImage
                      drawString (show category) x y color black groundTruthImage
                      drawString (printf "%.2f" risk) x (y + 10) color black groundTruthImage
                      drawString (show riskType) x (y + 20) color black 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
                draw
          forM_ riskD $ \Main.BddRisk {..} -> do
            case riskDt of
              Nothing -> return ()
              Just riskDt' -> do
                let annotation = env.envDetection Vector.! Core.idD riskDt'
                    (bx, by, bw, bh) = (annotation.x, annotation.y, annotation.w, annotation.h)
                    category = annotation.cls
                    x = round bx
                    y = round by
                    width = round bw
                    height = round bh
                    draw = do
                      let color = case riskType of
                            Main.TruePositive -> green
                            _ -> red
                      drawRect x y (x + width) (y + height) color detectionImage
                      drawString (show category) x y color black detectionImage
                      drawString (printf "%.2f" (annotation.score)) x (y + 10) color black detectionImage
                      drawString (printf "%.2f" risk) x (y + 20) color black detectionImage
                      drawString (show riskType) x (y + 30) color black detectionImage
                if annotation.score >= context.bddContextScoreThresh
                  then draw
                  else return ()
          concatImage <- concatImageByHorizontal groundTruthImage detectionImage
          -- let resizedImage = resizeRGB8 groundTruthImage.imageWidth groundTruthImage.imageHeight True concatImage
          putImage (Right concatImage)

(!!!) :: forall a b. Ord b => Map.Map b [a] -> b -> [a]
(!!!) dat key = fromMaybe [] (Map.lookup key dat)

evaluate :: CocoMap -> Maybe Double -> Maybe Double -> IO ()
evaluate cocoMap iouThreshold scoreThresh = do
  let context = toBddContext cocoMap iouThreshold scoreThresh
      mAP = Core.mAP @Main.BddContext @Main.BoundingBoxGT context
      ap' = Core.ap @Main.BddContext @Main.BoundingBoxGT context
      f1 = Core.f1 @Main.BddContext @Main.BoundingBoxGT context
      mF1 = Core.mF1 @Main.BddContext @Main.BoundingBoxGT context
      confusionMatrixR :: Map.Map (Main.Class, Main.Class) [Main.BddRisk]
      confusionMatrixR = Core.confusionMatrixRecall @Main.BddContext @Main.BoundingBoxGT context -- Metric.confusionMatrix @(Sum Int) cocoMap iouThreshold' scoreThresh'
      confusionMatrixP :: Map.Map (Main.Class, Main.Class) [Main.BddRisk]
      confusionMatrixP = Core.confusionMatrixPrecision @Main.BddContext @Main.BoundingBoxGT context -- Metric.confusionMatrix @(Sum Int) cocoMap iouThreshold' scoreThresh'
      confusionMatrixR_cnt :: Map.Map (Main.Class, Main.Class) Int
      confusionMatrixR_cnt = Map.fromList $ concat $
        flip map (cocoMapCategoryIds cocoMap) $ \categoryId ->
          let classG = Main.cocoCategoryToClass cocoMap categoryId
              keyBG = (classG, Main.Background)
              toBG = (keyBG, length $ confusionMatrixR !!! keyBG)
              toClasses =
                flip map (cocoMapCategoryIds cocoMap) $ \categoryId' ->
                  let classD = Main.cocoCategoryToClass cocoMap categoryId'
                      keyCl = (classG, classD)
                  in (keyCl, length $ confusionMatrixR !!! keyCl)
          in toBG: toClasses
      confusionMatrixP_cnt :: Map.Map (Main.Class, Main.Class) Int
      confusionMatrixP_cnt = Map.fromList $ concat $
        flip map (cocoMapCategoryIds cocoMap) $ \categoryId ->
          let classD = Main.cocoCategoryToClass cocoMap categoryId
              keyBG = (classD, Main.Background)
              toBG = (keyBG, length $ confusionMatrixP !!! keyBG)
              toClasses =
                flip map (cocoMapCategoryIds cocoMap) $ \categoryId' ->
                  let classG = Main.cocoCategoryToClass cocoMap categoryId'
                      keyCl = (classD, classG)
                  in (keyCl, length $ confusionMatrixP !!! keyCl)
          in toBG: toClasses
        
  putStrLn $ printf "#%-12s, %s" "CocoFile" cocoMap.cocoMapCocoFile
  putStrLn $ printf "#%-12s, %s" "CocoResultFile" cocoMap.cocoMapCocoResultFile

  putStrLn $ printf "%-12s, %s" "#Category" "AP"
  forM_ (cocoMapCategoryIds cocoMap) $ \categoryId -> do
    let class' = Main.cocoCategoryToClass cocoMap categoryId
    putStrLn $ printf "%-12s, %.3f" (T.unpack (cocoCategoryName ((cocoMapCocoCategory cocoMap) Map.! categoryId))) (ap' Map.! class')
  putStrLn $ printf "%-12s, %.3f" "mAP" mAP
  putStrLn ""

  -- Print risk scores statistically
  let risks = Core.runRisk @Main.BddContext @Main.BoundingBoxGT context
  putStrLn $ printf "%-12s" "#Risk"
  let num_of_images = (length $ map snd risks)
      max_risks = (maximum $ map snd risks)
      sorted_risks = sortBy (\r1 r2 -> compare r2 r1) $ map snd risks
      percentile_90 = take (num_of_images * 10 `div` 100) sorted_risks
  putStrLn $ printf "%-12s, %.2f" "total" (sum $ map snd risks)
  putStrLn $ printf "%-12s, %.2f" "maximum" max_risks
  putStrLn $ printf "%-12s, %.2f" "average" (M.average $ map snd risks)
  putStrLn $ printf "%-12s, %.2f" "minimum" (minimum $ map snd risks)
  putStrLn $ printf "%-12s, %.2f" "90percentile" $ head $ reverse percentile_90
  putStrLn $ printf "%-12s, %d" "num_of_images" num_of_images
  putStrLn ""

  -- Print confusion matrix
  putStrLn "#confusion matrix of recall: row is ground truth, column is prediction."
  putStr $ printf "%-12s," "#GT \\ DT"
  putStr $ printf "%-12s," "Backgroud"
  forM_ (cocoMapCategoryIds cocoMap) $ \categoryId -> do
    putStr $ printf "%-12s," (T.unpack (cocoCategoryName ((cocoMapCocoCategory cocoMap) Map.! categoryId)))
  putStrLn ""
  forM_ (cocoMapCategoryIds cocoMap) $ \categoryId -> do
    let classG = Main.cocoCategoryToClass cocoMap categoryId
    putStr $ printf "%-12s," (T.unpack (cocoCategoryName ((cocoMapCocoCategory cocoMap) Map.! categoryId)))
    putStr $ printf "%-12d," $ confusionMatrixR_cnt Map.! (classG, Main.Background)
    forM_ (cocoMapCategoryIds cocoMap) $ \categoryId' -> do
      let classD = Main.cocoCategoryToClass cocoMap categoryId'
      putStr $ printf "%-12d," $ confusionMatrixR_cnt Map.! (classG, classD)
    putStrLn ""
  putStrLn ""

  putStrLn "#confusion matrix of precision: row is prediction, column is ground truth."
  putStr $ printf "#%-11s," "DT \\ GT"
  putStr $ printf "%-12s," "Backgroud"
  forM_ (cocoMapCategoryIds cocoMap) $ \categoryId -> do
    putStr $ printf "%-12s," (T.unpack (cocoCategoryName ((cocoMapCocoCategory cocoMap) Map.! categoryId)))
  putStrLn ""
  forM_ (cocoMapCategoryIds cocoMap) $ \categoryId -> do
    let classD = Main.cocoCategoryToClass cocoMap categoryId
    putStr $ printf "%-12s," (T.unpack (cocoCategoryName ((cocoMapCocoCategory cocoMap) Map.! categoryId)))
    putStr $ printf "%-12d," $ confusionMatrixP_cnt Map.! (classD, Main.Background)
    forM_ (cocoMapCategoryIds cocoMap) $ \categoryId' -> do
      let classG = Main.cocoCategoryToClass cocoMap categoryId'
      putStr $ printf "%-12d," $ confusionMatrixP_cnt Map.! (classD, classG)
    putStrLn ""
  putStrLn ""

  -- Print F1 scores
  putStrLn "#F1 Scores"
  forM_ (cocoMapCategoryIds cocoMap) $ \categoryId -> do
    let class' = Main.cocoCategoryToClass cocoMap categoryId
    putStrLn $ printf "%-12s, %.3f" (T.unpack (cocoCategoryName ((cocoMapCocoCategory cocoMap) Map.! categoryId))) (f1 Map.! class')
  putStrLn $ printf "%-12s, %.3f" "mF1" mF1
  putStrLn ""
  putStrLn ""

bddCommand :: RiskCommands
bddCommand =
  RiskCommands
    { showRisk = Main.showRisk,
      showRiskWithError = Main.showRiskWithError,
      generateRiskWeightedDataset = Main.generateRiskWeightedDataset,
      showDetectionImage = Main.showDetectionImage,
      evaluate = Main.evaluate
    }
main = baseMain bddCommand