{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module RiskWeaver.DSL.BDD where

import Control.Monad.Trans.Reader (ReaderT, ask, runReader)
import Control.Parallel.Strategies
import Data.Map qualified as Map
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.DSL.Core
import RiskWeaver.Format.Coco
import RiskWeaver.Metric
import RiskWeaver.Pip

data BoundingBoxGT = BoundingBoxGT
  { BoundingBoxGT -> Double
x :: Double,
    BoundingBoxGT -> Double
y :: Double,
    BoundingBoxGT -> Double
w :: Double,
    BoundingBoxGT -> Double
h :: Double,
    BoundingBoxGT -> Class
cls :: Class,
    BoundingBoxGT -> Int
idx :: Int
  }
  deriving (Int -> BoundingBoxGT -> ShowS
[BoundingBoxGT] -> ShowS
BoundingBoxGT -> String
(Int -> BoundingBoxGT -> ShowS)
-> (BoundingBoxGT -> String)
-> ([BoundingBoxGT] -> ShowS)
-> Show BoundingBoxGT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundingBoxGT -> ShowS
showsPrec :: Int -> BoundingBoxGT -> ShowS
$cshow :: BoundingBoxGT -> String
show :: BoundingBoxGT -> String
$cshowList :: [BoundingBoxGT] -> ShowS
showList :: [BoundingBoxGT] -> ShowS
Show, BoundingBoxGT -> BoundingBoxGT -> Bool
(BoundingBoxGT -> BoundingBoxGT -> Bool)
-> (BoundingBoxGT -> BoundingBoxGT -> Bool) -> Eq BoundingBoxGT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundingBoxGT -> BoundingBoxGT -> Bool
== :: BoundingBoxGT -> BoundingBoxGT -> Bool
$c/= :: BoundingBoxGT -> BoundingBoxGT -> Bool
/= :: BoundingBoxGT -> BoundingBoxGT -> Bool
Eq, Eq BoundingBoxGT
Eq BoundingBoxGT =>
(BoundingBoxGT -> BoundingBoxGT -> Ordering)
-> (BoundingBoxGT -> BoundingBoxGT -> Bool)
-> (BoundingBoxGT -> BoundingBoxGT -> Bool)
-> (BoundingBoxGT -> BoundingBoxGT -> Bool)
-> (BoundingBoxGT -> BoundingBoxGT -> Bool)
-> (BoundingBoxGT -> BoundingBoxGT -> BoundingBoxGT)
-> (BoundingBoxGT -> BoundingBoxGT -> BoundingBoxGT)
-> Ord BoundingBoxGT
BoundingBoxGT -> BoundingBoxGT -> Bool
BoundingBoxGT -> BoundingBoxGT -> Ordering
BoundingBoxGT -> BoundingBoxGT -> BoundingBoxGT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BoundingBoxGT -> BoundingBoxGT -> Ordering
compare :: BoundingBoxGT -> BoundingBoxGT -> Ordering
$c< :: BoundingBoxGT -> BoundingBoxGT -> Bool
< :: BoundingBoxGT -> BoundingBoxGT -> Bool
$c<= :: BoundingBoxGT -> BoundingBoxGT -> Bool
<= :: BoundingBoxGT -> BoundingBoxGT -> Bool
$c> :: BoundingBoxGT -> BoundingBoxGT -> Bool
> :: BoundingBoxGT -> BoundingBoxGT -> Bool
$c>= :: BoundingBoxGT -> BoundingBoxGT -> Bool
>= :: BoundingBoxGT -> BoundingBoxGT -> Bool
$cmax :: BoundingBoxGT -> BoundingBoxGT -> BoundingBoxGT
max :: BoundingBoxGT -> BoundingBoxGT -> BoundingBoxGT
$cmin :: BoundingBoxGT -> BoundingBoxGT -> BoundingBoxGT
min :: BoundingBoxGT -> BoundingBoxGT -> BoundingBoxGT
Ord, (forall x. BoundingBoxGT -> Rep BoundingBoxGT x)
-> (forall x. Rep BoundingBoxGT x -> BoundingBoxGT)
-> Generic BoundingBoxGT
forall x. Rep BoundingBoxGT x -> BoundingBoxGT
forall x. BoundingBoxGT -> Rep BoundingBoxGT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BoundingBoxGT -> Rep BoundingBoxGT x
from :: forall x. BoundingBoxGT -> Rep BoundingBoxGT x
$cto :: forall x. Rep BoundingBoxGT x -> BoundingBoxGT
to :: forall x. Rep BoundingBoxGT x -> BoundingBoxGT
Generic, BoundingBoxGT -> ()
(BoundingBoxGT -> ()) -> NFData BoundingBoxGT
forall a. (a -> ()) -> NFData a
$crnf :: BoundingBoxGT -> ()
rnf :: BoundingBoxGT -> ()
NFData)

data Class
  = Background
  | Pedestrian
  | Rider
  | Car
  | Truck
  | Bus
  | Train
  | Motorcycle
  | Bicycle
  deriving (Int -> Class -> ShowS
[Class] -> ShowS
Class -> String
(Int -> Class -> ShowS)
-> (Class -> String) -> ([Class] -> ShowS) -> Show Class
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Class -> ShowS
showsPrec :: Int -> Class -> ShowS
$cshow :: Class -> String
show :: Class -> String
$cshowList :: [Class] -> ShowS
showList :: [Class] -> ShowS
Show, Class -> Class -> Bool
(Class -> Class -> Bool) -> (Class -> Class -> Bool) -> Eq Class
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Class -> Class -> Bool
== :: Class -> Class -> Bool
$c/= :: Class -> Class -> Bool
/= :: Class -> Class -> Bool
Eq, Eq Class
Eq Class =>
(Class -> Class -> Ordering)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Class)
-> (Class -> Class -> Class)
-> Ord Class
Class -> Class -> Bool
Class -> Class -> Ordering
Class -> Class -> Class
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Class -> Class -> Ordering
compare :: Class -> Class -> Ordering
$c< :: Class -> Class -> Bool
< :: Class -> Class -> Bool
$c<= :: Class -> Class -> Bool
<= :: Class -> Class -> Bool
$c> :: Class -> Class -> Bool
> :: Class -> Class -> Bool
$c>= :: Class -> Class -> Bool
>= :: Class -> Class -> Bool
$cmax :: Class -> Class -> Class
max :: Class -> Class -> Class
$cmin :: Class -> Class -> Class
min :: Class -> Class -> Class
Ord, (forall x. Class -> Rep Class x)
-> (forall x. Rep Class x -> Class) -> Generic Class
forall x. Rep Class x -> Class
forall x. Class -> Rep Class x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Class -> Rep Class x
from :: forall x. Class -> Rep Class x
$cto :: forall x. Rep Class x -> Class
to :: forall x. Rep Class x -> Class
Generic, Class -> ()
(Class -> ()) -> NFData Class
forall a. (a -> ()) -> NFData a
$crnf :: Class -> ()
rnf :: Class -> ()
NFData)

data SubErrorType
  = Boundary
  | LowScore
  | MissClass
  | Occulusion
  deriving (Int -> SubErrorType -> ShowS
[SubErrorType] -> ShowS
SubErrorType -> String
(Int -> SubErrorType -> ShowS)
-> (SubErrorType -> String)
-> ([SubErrorType] -> ShowS)
-> Show SubErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubErrorType -> ShowS
showsPrec :: Int -> SubErrorType -> ShowS
$cshow :: SubErrorType -> String
show :: SubErrorType -> String
$cshowList :: [SubErrorType] -> ShowS
showList :: [SubErrorType] -> ShowS
Show, Eq SubErrorType
Eq SubErrorType =>
(SubErrorType -> SubErrorType -> Ordering)
-> (SubErrorType -> SubErrorType -> Bool)
-> (SubErrorType -> SubErrorType -> Bool)
-> (SubErrorType -> SubErrorType -> Bool)
-> (SubErrorType -> SubErrorType -> Bool)
-> (SubErrorType -> SubErrorType -> SubErrorType)
-> (SubErrorType -> SubErrorType -> SubErrorType)
-> Ord SubErrorType
SubErrorType -> SubErrorType -> Bool
SubErrorType -> SubErrorType -> Ordering
SubErrorType -> SubErrorType -> SubErrorType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SubErrorType -> SubErrorType -> Ordering
compare :: SubErrorType -> SubErrorType -> Ordering
$c< :: SubErrorType -> SubErrorType -> Bool
< :: SubErrorType -> SubErrorType -> Bool
$c<= :: SubErrorType -> SubErrorType -> Bool
<= :: SubErrorType -> SubErrorType -> Bool
$c> :: SubErrorType -> SubErrorType -> Bool
> :: SubErrorType -> SubErrorType -> Bool
$c>= :: SubErrorType -> SubErrorType -> Bool
>= :: SubErrorType -> SubErrorType -> Bool
$cmax :: SubErrorType -> SubErrorType -> SubErrorType
max :: SubErrorType -> SubErrorType -> SubErrorType
$cmin :: SubErrorType -> SubErrorType -> SubErrorType
min :: SubErrorType -> SubErrorType -> SubErrorType
Ord, SubErrorType -> SubErrorType -> Bool
(SubErrorType -> SubErrorType -> Bool)
-> (SubErrorType -> SubErrorType -> Bool) -> Eq SubErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubErrorType -> SubErrorType -> Bool
== :: SubErrorType -> SubErrorType -> Bool
$c/= :: SubErrorType -> SubErrorType -> Bool
/= :: SubErrorType -> SubErrorType -> Bool
Eq, (forall x. SubErrorType -> Rep SubErrorType x)
-> (forall x. Rep SubErrorType x -> SubErrorType)
-> Generic SubErrorType
forall x. Rep SubErrorType x -> SubErrorType
forall x. SubErrorType -> Rep SubErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubErrorType -> Rep SubErrorType x
from :: forall x. SubErrorType -> Rep SubErrorType x
$cto :: forall x. Rep SubErrorType x -> SubErrorType
to :: forall x. Rep SubErrorType x -> SubErrorType
Generic, SubErrorType -> ()
(SubErrorType -> ()) -> NFData SubErrorType
forall a. (a -> ()) -> NFData a
$crnf :: SubErrorType -> ()
rnf :: SubErrorType -> ()
NFData)

type BoundingBoxDT = Detection BoundingBoxGT

instance Rectangle BoundingBoxGT where
  rX :: BoundingBoxGT -> Double
rX BoundingBoxGT
b = BoundingBoxGT
b.x
  rY :: BoundingBoxGT -> Double
rY BoundingBoxGT
b = BoundingBoxGT
b.y
  rW :: BoundingBoxGT -> Double
rW BoundingBoxGT
b = BoundingBoxGT
b.w
  rH :: BoundingBoxGT -> Double
rH BoundingBoxGT
b = BoundingBoxGT
b.h
  
instance Rectangle (Detection BoundingBoxGT) where
  rX :: Detection BoundingBoxGT -> Double
rX Detection BoundingBoxGT
b = Detection BoundingBoxGT
b.x
  rY :: Detection BoundingBoxGT -> Double
rY Detection BoundingBoxGT
b = Detection BoundingBoxGT
b.y
  rW :: Detection BoundingBoxGT -> Double
rW Detection BoundingBoxGT
b = Detection BoundingBoxGT
b.w
  rH :: Detection BoundingBoxGT -> Double
rH Detection BoundingBoxGT
b = Detection BoundingBoxGT
b.h
  
instance BoundingBox BoundingBoxGT where
  data Detection _ = BoundingBoxDT
    { Detection BoundingBoxGT -> Double
x :: Double,
      Detection BoundingBoxGT -> Double
y :: Double,
      Detection BoundingBoxGT -> Double
w :: Double,
      Detection BoundingBoxGT -> Double
h :: Double,
      Detection BoundingBoxGT -> Class
cls :: Class,
      Detection BoundingBoxGT -> Double
score :: Double,
      Detection BoundingBoxGT -> Int
idx :: Int
    }
    deriving (Int -> Detection BoundingBoxGT -> ShowS
[Detection BoundingBoxGT] -> ShowS
Detection BoundingBoxGT -> String
(Int -> Detection BoundingBoxGT -> ShowS)
-> (Detection BoundingBoxGT -> String)
-> ([Detection BoundingBoxGT] -> ShowS)
-> Show (Detection BoundingBoxGT)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Detection BoundingBoxGT -> ShowS
showsPrec :: Int -> Detection BoundingBoxGT -> ShowS
$cshow :: Detection BoundingBoxGT -> String
show :: Detection BoundingBoxGT -> String
$cshowList :: [Detection BoundingBoxGT] -> ShowS
showList :: [Detection BoundingBoxGT] -> ShowS
Show, Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
(Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool)
-> (Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool)
-> Eq (Detection BoundingBoxGT)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
== :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
$c/= :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
/= :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
Eq, Eq (Detection BoundingBoxGT)
Eq (Detection BoundingBoxGT) =>
(Detection BoundingBoxGT -> Detection BoundingBoxGT -> Ordering)
-> (Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool)
-> (Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool)
-> (Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool)
-> (Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool)
-> (Detection BoundingBoxGT
    -> Detection BoundingBoxGT -> Detection BoundingBoxGT)
-> (Detection BoundingBoxGT
    -> Detection BoundingBoxGT -> Detection BoundingBoxGT)
-> Ord (Detection BoundingBoxGT)
Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
Detection BoundingBoxGT -> Detection BoundingBoxGT -> Ordering
Detection BoundingBoxGT
-> Detection BoundingBoxGT -> Detection BoundingBoxGT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Ordering
compare :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Ordering
$c< :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
< :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
$c<= :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
<= :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
$c> :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
> :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
$c>= :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
>= :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
$cmax :: Detection BoundingBoxGT
-> Detection BoundingBoxGT -> Detection BoundingBoxGT
max :: Detection BoundingBoxGT
-> Detection BoundingBoxGT -> Detection BoundingBoxGT
$cmin :: Detection BoundingBoxGT
-> Detection BoundingBoxGT -> Detection BoundingBoxGT
min :: Detection BoundingBoxGT
-> Detection BoundingBoxGT -> Detection BoundingBoxGT
Ord, (forall x.
 Detection BoundingBoxGT -> Rep (Detection BoundingBoxGT) x)
-> (forall x.
    Rep (Detection BoundingBoxGT) x -> Detection BoundingBoxGT)
-> Generic (Detection BoundingBoxGT)
forall x.
Rep (Detection BoundingBoxGT) x -> Detection BoundingBoxGT
forall x.
Detection BoundingBoxGT -> Rep (Detection BoundingBoxGT) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
Detection BoundingBoxGT -> Rep (Detection BoundingBoxGT) x
from :: forall x.
Detection BoundingBoxGT -> Rep (Detection BoundingBoxGT) x
$cto :: forall x.
Rep (Detection BoundingBoxGT) x -> Detection BoundingBoxGT
to :: forall x.
Rep (Detection BoundingBoxGT) x -> Detection BoundingBoxGT
Generic, Detection BoundingBoxGT -> ()
(Detection BoundingBoxGT -> ()) -> NFData (Detection BoundingBoxGT)
forall a. (a -> ()) -> NFData a
$crnf :: Detection BoundingBoxGT -> ()
rnf :: Detection BoundingBoxGT -> ()
NFData)
  type ClassG _ = Class
  type ClassD _ = Class
  data ErrorType _
    = FalsePositive (Set SubErrorType)
    | FalseNegative (Set SubErrorType)
    | TruePositive
    | TrueNegative
    deriving (Eq (ErrorType BoundingBoxGT)
Eq (ErrorType BoundingBoxGT) =>
(ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Ordering)
-> (ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool)
-> (ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool)
-> (ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool)
-> (ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool)
-> (ErrorType BoundingBoxGT
    -> ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT)
-> (ErrorType BoundingBoxGT
    -> ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT)
-> Ord (ErrorType BoundingBoxGT)
ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Ordering
ErrorType BoundingBoxGT
-> ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Ordering
compare :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Ordering
$c< :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
< :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
$c<= :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
<= :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
$c> :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
> :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
$c>= :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
>= :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
$cmax :: ErrorType BoundingBoxGT
-> ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT
max :: ErrorType BoundingBoxGT
-> ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT
$cmin :: ErrorType BoundingBoxGT
-> ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT
min :: ErrorType BoundingBoxGT
-> ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT
Ord, ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
(ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool)
-> (ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool)
-> Eq (ErrorType BoundingBoxGT)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
== :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
$c/= :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
/= :: ErrorType BoundingBoxGT -> ErrorType BoundingBoxGT -> Bool
Eq, (forall x.
 ErrorType BoundingBoxGT -> Rep (ErrorType BoundingBoxGT) x)
-> (forall x.
    Rep (ErrorType BoundingBoxGT) x -> ErrorType BoundingBoxGT)
-> Generic (ErrorType BoundingBoxGT)
forall x.
Rep (ErrorType BoundingBoxGT) x -> ErrorType BoundingBoxGT
forall x.
ErrorType BoundingBoxGT -> Rep (ErrorType BoundingBoxGT) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ErrorType BoundingBoxGT -> Rep (ErrorType BoundingBoxGT) x
from :: forall x.
ErrorType BoundingBoxGT -> Rep (ErrorType BoundingBoxGT) x
$cto :: forall x.
Rep (ErrorType BoundingBoxGT) x -> ErrorType BoundingBoxGT
to :: forall x.
Rep (ErrorType BoundingBoxGT) x -> ErrorType BoundingBoxGT
Generic, ErrorType BoundingBoxGT -> ()
(ErrorType BoundingBoxGT -> ()) -> NFData (ErrorType BoundingBoxGT)
forall a. (a -> ()) -> NFData a
$crnf :: ErrorType BoundingBoxGT -> ()
rnf :: ErrorType BoundingBoxGT -> ()
NFData)
  type InterestArea _ = [(Double, Double)]
  type InterestObject _ = Either BoundingBoxGT BoundingBoxDT -> Bool
  data Env _ = MyEnv
    { Env BoundingBoxGT -> Vector BoundingBoxGT
envGroundTruth :: Vector BoundingBoxGT,
      Env BoundingBoxGT -> Vector (Detection BoundingBoxGT)
envDetection :: Vector BoundingBoxDT,
      Env BoundingBoxGT -> Double
envConfidenceScoreThresh :: Double,
      Env BoundingBoxGT -> Double
envIoUThresh :: Double,
      Env BoundingBoxGT -> Bool
envUseInterestArea :: Bool,
      Env BoundingBoxGT -> ImageId
envImageId :: ImageId
    }
    deriving (Int -> Env BoundingBoxGT -> ShowS
[Env BoundingBoxGT] -> ShowS
Env BoundingBoxGT -> String
(Int -> Env BoundingBoxGT -> ShowS)
-> (Env BoundingBoxGT -> String)
-> ([Env BoundingBoxGT] -> ShowS)
-> Show (Env BoundingBoxGT)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Env BoundingBoxGT -> ShowS
showsPrec :: Int -> Env BoundingBoxGT -> ShowS
$cshow :: Env BoundingBoxGT -> String
show :: Env BoundingBoxGT -> String
$cshowList :: [Env BoundingBoxGT] -> ShowS
showList :: [Env BoundingBoxGT] -> ShowS
Show, Eq (Env BoundingBoxGT)
Eq (Env BoundingBoxGT) =>
(Env BoundingBoxGT -> Env BoundingBoxGT -> Ordering)
-> (Env BoundingBoxGT -> Env BoundingBoxGT -> Bool)
-> (Env BoundingBoxGT -> Env BoundingBoxGT -> Bool)
-> (Env BoundingBoxGT -> Env BoundingBoxGT -> Bool)
-> (Env BoundingBoxGT -> Env BoundingBoxGT -> Bool)
-> (Env BoundingBoxGT -> Env BoundingBoxGT -> Env BoundingBoxGT)
-> (Env BoundingBoxGT -> Env BoundingBoxGT -> Env BoundingBoxGT)
-> Ord (Env BoundingBoxGT)
Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
Env BoundingBoxGT -> Env BoundingBoxGT -> Ordering
Env BoundingBoxGT -> Env BoundingBoxGT -> Env BoundingBoxGT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Env BoundingBoxGT -> Env BoundingBoxGT -> Ordering
compare :: Env BoundingBoxGT -> Env BoundingBoxGT -> Ordering
$c< :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
< :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
$c<= :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
<= :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
$c> :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
> :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
$c>= :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
>= :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
$cmax :: Env BoundingBoxGT -> Env BoundingBoxGT -> Env BoundingBoxGT
max :: Env BoundingBoxGT -> Env BoundingBoxGT -> Env BoundingBoxGT
$cmin :: Env BoundingBoxGT -> Env BoundingBoxGT -> Env BoundingBoxGT
min :: Env BoundingBoxGT -> Env BoundingBoxGT -> Env BoundingBoxGT
Ord, Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
(Env BoundingBoxGT -> Env BoundingBoxGT -> Bool)
-> (Env BoundingBoxGT -> Env BoundingBoxGT -> Bool)
-> Eq (Env BoundingBoxGT)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
== :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
$c/= :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
/= :: Env BoundingBoxGT -> Env BoundingBoxGT -> Bool
Eq, (forall x. Env BoundingBoxGT -> Rep (Env BoundingBoxGT) x)
-> (forall x. Rep (Env BoundingBoxGT) x -> Env BoundingBoxGT)
-> Generic (Env BoundingBoxGT)
forall x. Rep (Env BoundingBoxGT) x -> Env BoundingBoxGT
forall x. Env BoundingBoxGT -> Rep (Env BoundingBoxGT) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Env BoundingBoxGT -> Rep (Env BoundingBoxGT) x
from :: forall x. Env BoundingBoxGT -> Rep (Env BoundingBoxGT) x
$cto :: forall x. Rep (Env BoundingBoxGT) x -> Env BoundingBoxGT
to :: forall x. Rep (Env BoundingBoxGT) x -> Env BoundingBoxGT
Generic, Env BoundingBoxGT -> ()
(Env BoundingBoxGT -> ()) -> NFData (Env BoundingBoxGT)
forall a. (a -> ()) -> NFData a
$crnf :: Env BoundingBoxGT -> ()
rnf :: Env BoundingBoxGT -> ()
NFData)
  type Idx _ = Int
  type ImgIdx _ = ImageId
  data Risk _ = BddRisk
    { Risk BoundingBoxGT -> ErrorType BoundingBoxGT
riskType :: ErrorType BoundingBoxGT,
      Risk BoundingBoxGT -> Double
risk :: Double,
      Risk BoundingBoxGT -> Maybe BoundingBoxGT
riskGt :: Maybe BoundingBoxGT,
      Risk BoundingBoxGT -> Maybe (Detection BoundingBoxGT)
riskDt :: Maybe (Detection BoundingBoxGT)
    } deriving (Int -> Risk BoundingBoxGT -> ShowS
[Risk BoundingBoxGT] -> ShowS
Risk BoundingBoxGT -> String
(Int -> Risk BoundingBoxGT -> ShowS)
-> (Risk BoundingBoxGT -> String)
-> ([Risk BoundingBoxGT] -> ShowS)
-> Show (Risk BoundingBoxGT)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Risk BoundingBoxGT -> ShowS
showsPrec :: Int -> Risk BoundingBoxGT -> ShowS
$cshow :: Risk BoundingBoxGT -> String
show :: Risk BoundingBoxGT -> String
$cshowList :: [Risk BoundingBoxGT] -> ShowS
showList :: [Risk BoundingBoxGT] -> ShowS
Show, Eq (Risk BoundingBoxGT)
Eq (Risk BoundingBoxGT) =>
(Risk BoundingBoxGT -> Risk BoundingBoxGT -> Ordering)
-> (Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool)
-> (Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool)
-> (Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool)
-> (Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool)
-> (Risk BoundingBoxGT -> Risk BoundingBoxGT -> Risk BoundingBoxGT)
-> (Risk BoundingBoxGT -> Risk BoundingBoxGT -> Risk BoundingBoxGT)
-> Ord (Risk BoundingBoxGT)
Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
Risk BoundingBoxGT -> Risk BoundingBoxGT -> Ordering
Risk BoundingBoxGT -> Risk BoundingBoxGT -> Risk BoundingBoxGT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Ordering
compare :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Ordering
$c< :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
< :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
$c<= :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
<= :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
$c> :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
> :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
$c>= :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
>= :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
$cmax :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Risk BoundingBoxGT
max :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Risk BoundingBoxGT
$cmin :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Risk BoundingBoxGT
min :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Risk BoundingBoxGT
Ord, Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
(Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool)
-> (Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool)
-> Eq (Risk BoundingBoxGT)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
== :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
$c/= :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
/= :: Risk BoundingBoxGT -> Risk BoundingBoxGT -> Bool
Eq, (forall x. Risk BoundingBoxGT -> Rep (Risk BoundingBoxGT) x)
-> (forall x. Rep (Risk BoundingBoxGT) x -> Risk BoundingBoxGT)
-> Generic (Risk BoundingBoxGT)
forall x. Rep (Risk BoundingBoxGT) x -> Risk BoundingBoxGT
forall x. Risk BoundingBoxGT -> Rep (Risk BoundingBoxGT) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Risk BoundingBoxGT -> Rep (Risk BoundingBoxGT) x
from :: forall x. Risk BoundingBoxGT -> Rep (Risk BoundingBoxGT) x
$cto :: forall x. Rep (Risk BoundingBoxGT) x -> Risk BoundingBoxGT
to :: forall x. Rep (Risk BoundingBoxGT) x -> Risk BoundingBoxGT
Generic, Risk BoundingBoxGT -> ()
(Risk BoundingBoxGT -> ()) -> NFData (Risk BoundingBoxGT)
forall a. (a -> ()) -> NFData a
$crnf :: Risk BoundingBoxGT -> ()
rnf :: Risk BoundingBoxGT -> ()
NFData)

  interestArea :: Env BoundingBoxGT -> InterestArea BoundingBoxGT
  interestArea :: Env BoundingBoxGT -> InterestArea BoundingBoxGT
interestArea Env BoundingBoxGT
_ = [(Double
0, Double
1), (Double
0.3, Double
0.6), (Double
0.7, Double
0.6), (Double
1, Double
1), (Double
1, Double
2), (Double
0, Double
2)]
  interestObject :: Env BoundingBoxGT -> InterestObject BoundingBoxGT
interestObject Env BoundingBoxGT
_ = \case
    Left BoundingBoxGT
gt -> BoundingBoxGT
gt.w Double -> Double -> Double
forall a. Num a => a -> a -> a
* BoundingBoxGT
gt.h Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1000
    Right Detection BoundingBoxGT
dt -> Detection BoundingBoxGT
dt.w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Detection BoundingBoxGT
dt.h Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1000
  groundTruth :: Env BoundingBoxGT -> Vector BoundingBoxGT
groundTruth Env BoundingBoxGT
env = Env BoundingBoxGT -> Vector BoundingBoxGT
envGroundTruth Env BoundingBoxGT
env
  detection :: Env BoundingBoxGT -> Vector (Detection BoundingBoxGT)
detection Env BoundingBoxGT
env = Env BoundingBoxGT -> Vector (Detection BoundingBoxGT)
envDetection Env BoundingBoxGT
env
  confidenceScoreThresh :: Env BoundingBoxGT -> Double
confidenceScoreThresh Env BoundingBoxGT
env = Env BoundingBoxGT -> Double
envConfidenceScoreThresh Env BoundingBoxGT
env
  ioUThresh :: Env BoundingBoxGT -> Double
ioUThresh Env BoundingBoxGT
env = Env BoundingBoxGT -> Double
envIoUThresh Env BoundingBoxGT
env
  scoreD :: Detection BoundingBoxGT -> Double
scoreD Detection BoundingBoxGT
v = Detection BoundingBoxGT
v.score
  classD :: Detection BoundingBoxGT -> ClassG BoundingBoxGT
classD Detection BoundingBoxGT
v = Detection BoundingBoxGT
v.cls
  idD :: Detection BoundingBoxGT -> Idx BoundingBoxGT
idD Detection BoundingBoxGT
v = Detection BoundingBoxGT
v.idx
  imageId :: Env BoundingBoxGT -> ImgIdx BoundingBoxGT
imageId Env BoundingBoxGT
env = Env BoundingBoxGT -> ImageId
envImageId Env BoundingBoxGT
env

  isBackD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isBackD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
isBackD Detection BoundingBoxGT
_ Detection BoundingBoxGT
_ = Bool
forall a. HasCallStack => a
undefined

  isLeftD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isLeftD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
isLeftD Detection BoundingBoxGT
_ Detection BoundingBoxGT
_ = Bool
forall a. HasCallStack => a
undefined
  isRightD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isRightD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
isRightD Detection BoundingBoxGT
_ Detection BoundingBoxGT
_ = Bool
forall a. HasCallStack => a
undefined
  isTopD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isTopD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
isTopD Detection BoundingBoxGT
_ Detection BoundingBoxGT
_ = Bool
forall a. HasCallStack => a
undefined
  isBottomD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isBottomD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
isBottomD Detection BoundingBoxGT
_ Detection BoundingBoxGT
_ = Bool
forall a. HasCallStack => a
undefined
  isBackGroundD :: ClassD BoundingBoxGT -> Bool
  isBackGroundD :: ClassD BoundingBoxGT -> Bool
isBackGroundD ClassD BoundingBoxGT
Class
Background = Bool
True
  isBackGroundD ClassD BoundingBoxGT
_ = Bool
False
  toErrorType :: Risk BoundingBoxGT -> ErrorType BoundingBoxGT
toErrorType = Risk BoundingBoxGT -> ErrorType BoundingBoxGT
riskType
  toRiskScore :: Risk BoundingBoxGT -> Double
toRiskScore = Risk BoundingBoxGT -> Double
RiskWeaver.DSL.BDD.risk

  classG :: BoundingBoxGT -> ClassG BoundingBoxGT
classG BoundingBoxGT
v = BoundingBoxGT
v.cls
  angle :: BoundingBoxGT -> Detection BoundingBoxGT -> Double
angle BoundingBoxGT
_ Detection BoundingBoxGT
_ = Double
forall a. HasCallStack => a
undefined
  idG :: BoundingBoxGT -> Idx BoundingBoxGT
idG BoundingBoxGT
v = BoundingBoxGT
v.idx

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

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

instance Show (ErrorType BoundingBoxGT) where
  show :: ErrorType BoundingBoxGT -> String
show (FalsePositive Set SubErrorType
suberrors) = String
"FP: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> SubErrorType -> String)
-> String -> [SubErrorType] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\String
acc SubErrorType
suberror -> String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ SubErrorType -> String
forall a. Show a => a -> String
show SubErrorType
suberror String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", ") String
"" (Set SubErrorType -> [SubErrorType]
forall a. Set a -> [a]
Set.toList Set SubErrorType
suberrors)
  show (FalseNegative Set SubErrorType
suberrors) = String
"FN: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> SubErrorType -> String)
-> String -> [SubErrorType] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\String
acc SubErrorType
suberror -> String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ SubErrorType -> String
forall a. Show a => a -> String
show SubErrorType
suberror String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", ") String
"" (Set SubErrorType -> [SubErrorType]
forall a. Set a -> [a]
Set.toList Set SubErrorType
suberrors)
  show ErrorType BoundingBoxGT
R:ErrorTypeBoundingBoxGT
TruePositive = String
"TP"
  show ErrorType BoundingBoxGT
R:ErrorTypeBoundingBoxGT
TrueNegative = String
"TN"

type BddRisk = Risk BoundingBoxGT

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

cocoResultToVector :: CocoMap -> ImageId -> (Vector BoundingBoxGT, Vector BoundingBoxDT)
cocoResultToVector :: CocoMap
-> ImageId
-> (Vector BoundingBoxGT, Vector (Detection BoundingBoxGT))
cocoResultToVector CocoMap
coco ImageId
imageId' = (Vector BoundingBoxGT
groundTruth', Vector (Detection BoundingBoxGT)
detection')
  where
    groundTruth' :: Vector BoundingBoxGT
groundTruth' =
      [BoundingBoxGT] -> Vector BoundingBoxGT
forall a. [a] -> Vector a
Vector.fromList ([BoundingBoxGT] -> Vector BoundingBoxGT)
-> [BoundingBoxGT] -> Vector BoundingBoxGT
forall a b. (a -> b) -> a -> b
$
        [BoundingBoxGT]
-> ([CocoAnnotation] -> [BoundingBoxGT])
-> Maybe [CocoAnnotation]
-> [BoundingBoxGT]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          []
          ( ((Int, CocoAnnotation) -> BoundingBoxGT)
-> [(Int, CocoAnnotation)] -> [BoundingBoxGT]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \(Int
index, CocoAnnotation {Double
Int
Maybe Int
Maybe [[Double]]
CoCoBoundingBox
CategoryId
ImageId
cocoAnnotationId :: Int
cocoAnnotationImageId :: ImageId
cocoAnnotationCategory :: CategoryId
cocoAnnotationSegment :: Maybe [[Double]]
cocoAnnotationArea :: Double
cocoAnnotationBbox :: CoCoBoundingBox
cocoAnnotationIsCrowd :: Maybe Int
cocoAnnotationId :: CocoAnnotation -> Int
cocoAnnotationImageId :: CocoAnnotation -> ImageId
cocoAnnotationCategory :: CocoAnnotation -> CategoryId
cocoAnnotationSegment :: CocoAnnotation -> Maybe [[Double]]
cocoAnnotationArea :: CocoAnnotation -> Double
cocoAnnotationBbox :: CocoAnnotation -> CoCoBoundingBox
cocoAnnotationIsCrowd :: CocoAnnotation -> Maybe Int
..}) ->
                  let CoCoBoundingBox (Double
cocox, Double
cocoy, Double
cocow, Double
cocoh) = CoCoBoundingBox
cocoAnnotationBbox
                   in BoundingBoxGT
                        { $sel:x:BoundingBoxGT :: Double
x = Double
cocox,
                          $sel:y:BoundingBoxGT :: Double
y = Double
cocoy,
                          $sel:w:BoundingBoxGT :: Double
w = Double
cocow,
                          $sel:h:BoundingBoxGT :: Double
h = Double
cocoh,
                          $sel:cls:BoundingBoxGT :: Class
cls = CocoMap -> CategoryId -> Class
cocoCategoryToClass CocoMap
coco CategoryId
cocoAnnotationCategory,
                          $sel:idx:BoundingBoxGT :: Int
idx = Int
index -- cocoAnnotationId
                        }
              )
              ([(Int, CocoAnnotation)] -> [BoundingBoxGT])
-> ([CocoAnnotation] -> [(Int, CocoAnnotation)])
-> [CocoAnnotation]
-> [BoundingBoxGT]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [CocoAnnotation] -> [(Int, CocoAnnotation)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
Item [Int]
0 ..]
          )
          (ImageId -> Map ImageId [CocoAnnotation] -> Maybe [CocoAnnotation]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ImageId
imageId' (CocoMap -> Map ImageId [CocoAnnotation]
cocoMapCocoAnnotation CocoMap
coco))
    detection' :: Vector (Detection BoundingBoxGT)
detection' =
      [Detection BoundingBoxGT] -> Vector (Detection BoundingBoxGT)
forall a. [a] -> Vector a
Vector.fromList ([Detection BoundingBoxGT] -> Vector (Detection BoundingBoxGT))
-> [Detection BoundingBoxGT] -> Vector (Detection BoundingBoxGT)
forall a b. (a -> b) -> a -> b
$
        [Detection BoundingBoxGT]
-> ([CocoResult] -> [Detection BoundingBoxGT])
-> Maybe [CocoResult]
-> [Detection BoundingBoxGT]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          []
          ( ((Int, CocoResult) -> Detection BoundingBoxGT)
-> [(Int, CocoResult)] -> [Detection BoundingBoxGT]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \(Int
index, CocoResult {CoCoBoundingBox
Score
CategoryId
ImageId
cocoResultImageId :: ImageId
cocoResultCategory :: CategoryId
cocoResultScore :: Score
cocoResultBbox :: CoCoBoundingBox
cocoResultImageId :: CocoResult -> ImageId
cocoResultCategory :: CocoResult -> CategoryId
cocoResultScore :: CocoResult -> Score
cocoResultBbox :: CocoResult -> CoCoBoundingBox
..}) ->
                  let CoCoBoundingBox (Double
cocox, Double
cocoy, Double
cocow, Double
cocoh) = CoCoBoundingBox
cocoResultBbox
                   in BoundingBoxDT
                        { $sel:x:BoundingBoxDT :: Double
x = Double
cocox,
                          $sel:y:BoundingBoxDT :: Double
y = Double
cocoy,
                          $sel:w:BoundingBoxDT :: Double
w = Double
cocow,
                          $sel:h:BoundingBoxDT :: Double
h = Double
cocoh,
                          $sel:cls:BoundingBoxDT :: Class
cls = CocoMap -> CategoryId -> Class
cocoCategoryToClass CocoMap
coco CategoryId
cocoResultCategory,
                          $sel:score:BoundingBoxDT :: Double
score = Score -> Double
unScore Score
cocoResultScore,
                          $sel:idx:BoundingBoxDT :: Int
idx = Int
index
                        }
              )
              ([(Int, CocoResult)] -> [Detection BoundingBoxGT])
-> ([CocoResult] -> [(Int, CocoResult)])
-> [CocoResult]
-> [Detection BoundingBoxGT]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [CocoResult] -> [(Int, CocoResult)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
Item [Int]
0 ..]
          )
          (ImageId -> Map ImageId [CocoResult] -> Maybe [CocoResult]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ImageId
imageId' (CocoMap -> Map ImageId [CocoResult]
cocoMapCocoResult CocoMap
coco))

data BddContext = BddContext
  { BddContext -> CocoMap
bddContextDataset :: CocoMap,
    BddContext -> Double
bddContextIouThresh :: Double,
    BddContext -> Double
bddContextScoreThresh :: Double,
    BddContext -> Bool
bddContextUseInterestArea :: Bool
  }
  deriving (Int -> BddContext -> ShowS
[BddContext] -> ShowS
BddContext -> String
(Int -> BddContext -> ShowS)
-> (BddContext -> String)
-> ([BddContext] -> ShowS)
-> Show BddContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BddContext -> ShowS
showsPrec :: Int -> BddContext -> ShowS
$cshow :: BddContext -> String
show :: BddContext -> String
$cshowList :: [BddContext] -> ShowS
showList :: [BddContext] -> ShowS
Show, BddContext -> BddContext -> Bool
(BddContext -> BddContext -> Bool)
-> (BddContext -> BddContext -> Bool) -> Eq BddContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BddContext -> BddContext -> Bool
== :: BddContext -> BddContext -> Bool
$c/= :: BddContext -> BddContext -> Bool
/= :: BddContext -> BddContext -> Bool
Eq)

instance World BddContext BoundingBoxGT where
  mAP :: BddContext -> Double
mAP BddContext {Bool
Double
CocoMap
$sel:bddContextDataset:BddContext :: BddContext -> CocoMap
$sel:bddContextIouThresh:BddContext :: BddContext -> Double
$sel:bddContextScoreThresh:BddContext :: BddContext -> Double
$sel:bddContextUseInterestArea:BddContext :: BddContext -> Bool
bddContextDataset :: CocoMap
bddContextIouThresh :: Double
bddContextScoreThresh :: Double
bddContextUseInterestArea :: Bool
..} = (Double, [(CategoryId, Double)]) -> Double
forall a b. (a, b) -> a
fst ((Double, [(CategoryId, Double)]) -> Double)
-> (Double, [(CategoryId, Double)]) -> Double
forall a b. (a -> b) -> a -> b
$ CocoMap -> IOU -> (Double, [(CategoryId, Double)])
RiskWeaver.Metric.mAP CocoMap
bddContextDataset (Double -> IOU
IOU Double
bddContextIouThresh)
  ap :: BddContext -> Map (ClassG BoundingBoxGT) Double
ap BddContext {Bool
Double
CocoMap
$sel:bddContextDataset:BddContext :: BddContext -> CocoMap
$sel:bddContextIouThresh:BddContext :: BddContext -> Double
$sel:bddContextScoreThresh:BddContext :: BddContext -> Double
$sel:bddContextUseInterestArea:BddContext :: BddContext -> Bool
bddContextDataset :: CocoMap
bddContextIouThresh :: Double
bddContextScoreThresh :: Double
bddContextUseInterestArea :: Bool
..} = [(ClassG BoundingBoxGT, Double)]
-> Map (ClassG BoundingBoxGT) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ClassG BoundingBoxGT, Double)]
 -> Map (ClassG BoundingBoxGT) Double)
-> [(ClassG BoundingBoxGT, Double)]
-> Map (ClassG BoundingBoxGT) Double
forall a b. (a -> b) -> a -> b
$ ((CategoryId, Double) -> (ClassG BoundingBoxGT, Double))
-> [(CategoryId, Double)] -> [(ClassG BoundingBoxGT, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(CategoryId
key, Double
value) -> (CocoMap -> CategoryId -> Class
cocoCategoryToClass CocoMap
bddContextDataset CategoryId
key, Double
value)) ([(CategoryId, Double)] -> [(ClassG BoundingBoxGT, Double)])
-> [(CategoryId, Double)] -> [(ClassG BoundingBoxGT, Double)]
forall a b. (a -> b) -> a -> b
$ (Double, [(CategoryId, Double)]) -> [(CategoryId, Double)]
forall a b. (a, b) -> b
snd ((Double, [(CategoryId, Double)]) -> [(CategoryId, Double)])
-> (Double, [(CategoryId, Double)]) -> [(CategoryId, Double)]
forall a b. (a -> b) -> a -> b
$ CocoMap -> IOU -> (Double, [(CategoryId, Double)])
RiskWeaver.Metric.mAP CocoMap
bddContextDataset (Double -> IOU
IOU Double
bddContextIouThresh)
  mF1 :: BddContext -> Double
mF1 BddContext {Bool
Double
CocoMap
$sel:bddContextDataset:BddContext :: BddContext -> CocoMap
$sel:bddContextIouThresh:BddContext :: BddContext -> Double
$sel:bddContextScoreThresh:BddContext :: BddContext -> Double
$sel:bddContextUseInterestArea:BddContext :: BddContext -> Bool
bddContextDataset :: CocoMap
bddContextIouThresh :: Double
bddContextScoreThresh :: Double
bddContextUseInterestArea :: Bool
..} = (Double, [(CategoryId, Double)]) -> Double
forall a b. (a, b) -> a
fst ((Double, [(CategoryId, Double)]) -> Double)
-> (Double, [(CategoryId, Double)]) -> Double
forall a b. (a -> b) -> a -> b
$ CocoMap -> IOU -> Score -> (Double, [(CategoryId, Double)])
RiskWeaver.Metric.mF1 CocoMap
bddContextDataset (Double -> IOU
IOU Double
bddContextIouThresh) (Double -> Score
Score Double
bddContextScoreThresh)
  f1 :: BddContext -> Map (ClassG BoundingBoxGT) Double
f1 BddContext {Bool
Double
CocoMap
$sel:bddContextDataset:BddContext :: BddContext -> CocoMap
$sel:bddContextIouThresh:BddContext :: BddContext -> Double
$sel:bddContextScoreThresh:BddContext :: BddContext -> Double
$sel:bddContextUseInterestArea:BddContext :: BddContext -> Bool
bddContextDataset :: CocoMap
bddContextIouThresh :: Double
bddContextScoreThresh :: Double
bddContextUseInterestArea :: Bool
..} = [(ClassG BoundingBoxGT, Double)]
-> Map (ClassG BoundingBoxGT) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ClassG BoundingBoxGT, Double)]
 -> Map (ClassG BoundingBoxGT) Double)
-> [(ClassG BoundingBoxGT, Double)]
-> Map (ClassG BoundingBoxGT) Double
forall a b. (a -> b) -> a -> b
$ ((CategoryId, Double) -> (ClassG BoundingBoxGT, Double))
-> [(CategoryId, Double)] -> [(ClassG BoundingBoxGT, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(CategoryId
key, Double
value) -> (CocoMap -> CategoryId -> Class
cocoCategoryToClass CocoMap
bddContextDataset CategoryId
key, Double
value)) ([(CategoryId, Double)] -> [(ClassG BoundingBoxGT, Double)])
-> [(CategoryId, Double)] -> [(ClassG BoundingBoxGT, Double)]
forall a b. (a -> b) -> a -> b
$ (Double, [(CategoryId, Double)]) -> [(CategoryId, Double)]
forall a b. (a, b) -> b
snd ((Double, [(CategoryId, Double)]) -> [(CategoryId, Double)])
-> (Double, [(CategoryId, Double)]) -> [(CategoryId, Double)]
forall a b. (a -> b) -> a -> b
$ CocoMap -> IOU -> Score -> (Double, [(CategoryId, Double)])
RiskWeaver.Metric.mF1 CocoMap
bddContextDataset (Double -> IOU
IOU Double
bddContextIouThresh) (Double -> Score
Score Double
bddContextScoreThresh)
  confusionMatrixRecall :: BddContext
-> Map
     (ClassG BoundingBoxGT, ClassD BoundingBoxGT) [Risk BoundingBoxGT]
confusionMatrixRecall context :: BddContext
context@BddContext {Bool
Double
CocoMap
$sel:bddContextDataset:BddContext :: BddContext -> CocoMap
$sel:bddContextIouThresh:BddContext :: BddContext -> Double
$sel:bddContextScoreThresh:BddContext :: BddContext -> Double
$sel:bddContextUseInterestArea:BddContext :: BddContext -> Bool
bddContextDataset :: CocoMap
bddContextIouThresh :: Double
bddContextScoreThresh :: Double
bddContextUseInterestArea :: Bool
..} = [((Class, Class), Risk BoundingBoxGT)]
-> Map (Class, Class) [Risk BoundingBoxGT]
forall k v. Ord k => [(k, v)] -> Map k [v]
sortAndGroup [((Class, Class), Risk BoundingBoxGT)]
risks
    where
      risks :: [((Class, Class), BddRisk)]
      risks :: [((Class, Class), Risk BoundingBoxGT)]
risks = [[((Class, Class), Risk BoundingBoxGT)]]
-> [((Class, Class), Risk BoundingBoxGT)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[((Class, Class), Risk BoundingBoxGT)]]
 -> [((Class, Class), Risk BoundingBoxGT)])
-> [[((Class, Class), Risk BoundingBoxGT)]]
-> [((Class, Class), Risk BoundingBoxGT)]
forall a b. (a -> b) -> a -> b
$ ((ImageId -> [((Class, Class), Risk BoundingBoxGT)])
 -> [ImageId] -> [[((Class, Class), Risk BoundingBoxGT)]])
-> [ImageId]
-> (ImageId -> [((Class, Class), Risk BoundingBoxGT)])
-> [[((Class, Class), Risk BoundingBoxGT)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ImageId -> [((Class, Class), Risk BoundingBoxGT)])
-> [ImageId] -> [[((Class, Class), Risk BoundingBoxGT)]]
forall a b. (a -> b) -> [a] -> [b]
map (CocoMap -> [ImageId]
cocoMapImageIds CocoMap
bddContextDataset) ((ImageId -> [((Class, Class), Risk BoundingBoxGT)])
 -> [[((Class, Class), Risk BoundingBoxGT)]])
-> (ImageId -> [((Class, Class), Risk BoundingBoxGT)])
-> [[((Class, Class), Risk BoundingBoxGT)]]
forall a b. (a -> b) -> a -> b
$ \ImageId
imageId' -> (Risk BoundingBoxGT -> ((Class, Class), Risk BoundingBoxGT))
-> [Risk BoundingBoxGT] -> [((Class, Class), Risk BoundingBoxGT)]
forall a b. (a -> b) -> [a] -> [b]
map Risk BoundingBoxGT -> ((Class, Class), Risk BoundingBoxGT)
getKeyValue (Reader (Env BoundingBoxGT) [Risk BoundingBoxGT]
-> Env BoundingBoxGT -> [Risk BoundingBoxGT]
forall r a. Reader r a -> r -> a
runReader Reader (Env BoundingBoxGT) [Risk BoundingBoxGT]
forall a (m :: * -> *).
(BoundingBox a, Monad m) =>
ReaderT (Env a) m [Risk a]
forall (m :: * -> *).
Monad m =>
ReaderT (Env BoundingBoxGT) m [Risk BoundingBoxGT]
riskForGroundTruth (BddContext -> ImgIdx BoundingBoxGT -> Env BoundingBoxGT
forall b a. World b a => b -> ImgIdx a -> Env a
toEnv BddContext
context ImgIdx BoundingBoxGT
ImageId
imageId'))
      getKeyValue :: BddRisk -> ((Class, Class), BddRisk)
      getKeyValue :: Risk BoundingBoxGT -> ((Class, Class), Risk BoundingBoxGT)
getKeyValue Risk BoundingBoxGT
bddRisk = ((Class -> (BoundingBoxGT -> Class) -> Maybe BoundingBoxGT -> Class
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Class
Background BoundingBoxGT -> ClassG BoundingBoxGT
BoundingBoxGT -> Class
forall a. BoundingBox a => a -> ClassG a
classG Risk BoundingBoxGT
bddRisk.riskGt, Class
-> (Detection BoundingBoxGT -> Class)
-> Maybe (Detection BoundingBoxGT)
-> Class
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Class
Background Detection BoundingBoxGT -> ClassG BoundingBoxGT
Detection BoundingBoxGT -> Class
forall a. BoundingBox a => Detection a -> ClassG a
classD Risk BoundingBoxGT
bddRisk.riskDt), Risk BoundingBoxGT
bddRisk)
  confusionMatrixPrecision :: BddContext
-> Map
     (ClassD BoundingBoxGT, ClassG BoundingBoxGT) [Risk BoundingBoxGT]
confusionMatrixPrecision context :: BddContext
context@BddContext {Bool
Double
CocoMap
$sel:bddContextDataset:BddContext :: BddContext -> CocoMap
$sel:bddContextIouThresh:BddContext :: BddContext -> Double
$sel:bddContextScoreThresh:BddContext :: BddContext -> Double
$sel:bddContextUseInterestArea:BddContext :: BddContext -> Bool
bddContextDataset :: CocoMap
bddContextIouThresh :: Double
bddContextScoreThresh :: Double
bddContextUseInterestArea :: Bool
..} = [((Class, Class), Risk BoundingBoxGT)]
-> Map (Class, Class) [Risk BoundingBoxGT]
forall k v. Ord k => [(k, v)] -> Map k [v]
sortAndGroup [((Class, Class), Risk BoundingBoxGT)]
risks
    where
      risks :: [((Class, Class), BddRisk)]
      risks :: [((Class, Class), Risk BoundingBoxGT)]
risks = [[((Class, Class), Risk BoundingBoxGT)]]
-> [((Class, Class), Risk BoundingBoxGT)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[((Class, Class), Risk BoundingBoxGT)]]
 -> [((Class, Class), Risk BoundingBoxGT)])
-> [[((Class, Class), Risk BoundingBoxGT)]]
-> [((Class, Class), Risk BoundingBoxGT)]
forall a b. (a -> b) -> a -> b
$ ((ImageId -> [((Class, Class), Risk BoundingBoxGT)])
 -> [ImageId] -> [[((Class, Class), Risk BoundingBoxGT)]])
-> [ImageId]
-> (ImageId -> [((Class, Class), Risk BoundingBoxGT)])
-> [[((Class, Class), Risk BoundingBoxGT)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ImageId -> [((Class, Class), Risk BoundingBoxGT)])
-> [ImageId] -> [[((Class, Class), Risk BoundingBoxGT)]]
forall a b. (a -> b) -> [a] -> [b]
map (CocoMap -> [ImageId]
cocoMapImageIds CocoMap
bddContextDataset) ((ImageId -> [((Class, Class), Risk BoundingBoxGT)])
 -> [[((Class, Class), Risk BoundingBoxGT)]])
-> (ImageId -> [((Class, Class), Risk BoundingBoxGT)])
-> [[((Class, Class), Risk BoundingBoxGT)]]
forall a b. (a -> b) -> a -> b
$ \ImageId
imageId' -> (Risk BoundingBoxGT -> ((Class, Class), Risk BoundingBoxGT))
-> [Risk BoundingBoxGT] -> [((Class, Class), Risk BoundingBoxGT)]
forall a b. (a -> b) -> [a] -> [b]
map Risk BoundingBoxGT -> ((Class, Class), Risk BoundingBoxGT)
getKeyValue (Reader (Env BoundingBoxGT) [Risk BoundingBoxGT]
-> Env BoundingBoxGT -> [Risk BoundingBoxGT]
forall r a. Reader r a -> r -> a
runReader Reader (Env BoundingBoxGT) [Risk BoundingBoxGT]
forall a (m :: * -> *).
(BoundingBox a, Monad m) =>
ReaderT (Env a) m [Risk a]
forall (m :: * -> *).
Monad m =>
ReaderT (Env BoundingBoxGT) m [Risk BoundingBoxGT]
riskForDetection (BddContext -> ImgIdx BoundingBoxGT -> Env BoundingBoxGT
forall b a. World b a => b -> ImgIdx a -> Env a
toEnv BddContext
context ImgIdx BoundingBoxGT
ImageId
imageId'))
      getKeyValue :: BddRisk -> ((Class, Class), BddRisk)
      getKeyValue :: Risk BoundingBoxGT -> ((Class, Class), Risk BoundingBoxGT)
getKeyValue Risk BoundingBoxGT
bddRisk = ((Class
-> (Detection BoundingBoxGT -> Class)
-> Maybe (Detection BoundingBoxGT)
-> Class
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Class
Background Detection BoundingBoxGT -> ClassG BoundingBoxGT
Detection BoundingBoxGT -> Class
forall a. BoundingBox a => Detection a -> ClassG a
classD Risk BoundingBoxGT
bddRisk.riskDt, Class -> (BoundingBoxGT -> Class) -> Maybe BoundingBoxGT -> Class
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Class
Background BoundingBoxGT -> ClassG BoundingBoxGT
BoundingBoxGT -> Class
forall a. BoundingBox a => a -> ClassG a
classG Risk BoundingBoxGT
bddRisk.riskGt), Risk BoundingBoxGT
bddRisk)

  toEnv :: BddContext -> ImgIdx BoundingBoxGT -> Env BoundingBoxGT
toEnv BddContext {Bool
Double
CocoMap
$sel:bddContextDataset:BddContext :: BddContext -> CocoMap
$sel:bddContextIouThresh:BddContext :: BddContext -> Double
$sel:bddContextScoreThresh:BddContext :: BddContext -> Double
$sel:bddContextUseInterestArea:BddContext :: BddContext -> Bool
bddContextDataset :: CocoMap
bddContextIouThresh :: Double
bddContextScoreThresh :: Double
bddContextUseInterestArea :: Bool
..} ImgIdx BoundingBoxGT
imageId' =
    let (Vector BoundingBoxGT
groundTruth', Vector (Detection BoundingBoxGT)
detection') = CocoMap
-> ImageId
-> (Vector BoundingBoxGT, Vector (Detection BoundingBoxGT))
cocoResultToVector CocoMap
bddContextDataset ImgIdx BoundingBoxGT
ImageId
imageId'
     in MyEnv
          { $sel:envGroundTruth:MyEnv :: Vector BoundingBoxGT
envGroundTruth = Vector BoundingBoxGT
groundTruth',
            $sel:envDetection:MyEnv :: Vector (Detection BoundingBoxGT)
envDetection = Vector (Detection BoundingBoxGT)
detection',
            $sel:envConfidenceScoreThresh:MyEnv :: Double
envConfidenceScoreThresh = Double
bddContextScoreThresh,
            $sel:envIoUThresh:MyEnv :: Double
envIoUThresh = Double
bddContextIouThresh,
            $sel:envUseInterestArea:MyEnv :: Bool
envUseInterestArea = Bool
bddContextUseInterestArea,
            $sel:envImageId:MyEnv :: ImageId
envImageId = ImgIdx BoundingBoxGT
ImageId
imageId'
          }

  toImageIds :: BddContext -> [ImgIdx BoundingBoxGT]
toImageIds BddContext {Bool
Double
CocoMap
$sel:bddContextDataset:BddContext :: BddContext -> CocoMap
$sel:bddContextIouThresh:BddContext :: BddContext -> Double
$sel:bddContextScoreThresh:BddContext :: BddContext -> Double
$sel:bddContextUseInterestArea:BddContext :: BddContext -> Bool
bddContextDataset :: CocoMap
bddContextIouThresh :: Double
bddContextScoreThresh :: Double
bddContextUseInterestArea :: Bool
..} = CocoMap -> [ImageId]
cocoMapImageIds CocoMap
bddContextDataset