{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module RiskWeaver.DSL.BDD where

import Control.Monad (mapM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Reader (ReaderT, ask, runReader, runReaderT)
import RiskWeaver.DSL.Core
import Data.List qualified as List
import Data.Map (Map)
import Data.Maybe (Maybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import RiskWeaver.Format.Coco

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)

data BoundingBoxDT = BoundingBoxDT
  { BoundingBoxDT -> Double
x :: Double,
    BoundingBoxDT -> Double
y :: Double,
    BoundingBoxDT -> Double
w :: Double,
    BoundingBoxDT -> Double
h :: Double,
    BoundingBoxDT -> Class
cls :: Class,
    BoundingBoxDT -> Double
score :: Double,
    BoundingBoxDT -> Int
idx :: Int
  }
  deriving (Int -> BoundingBoxDT -> ShowS
[BoundingBoxDT] -> ShowS
BoundingBoxDT -> String
(Int -> BoundingBoxDT -> ShowS)
-> (BoundingBoxDT -> String)
-> ([BoundingBoxDT] -> ShowS)
-> Show BoundingBoxDT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundingBoxDT -> ShowS
showsPrec :: Int -> BoundingBoxDT -> ShowS
$cshow :: BoundingBoxDT -> String
show :: BoundingBoxDT -> String
$cshowList :: [BoundingBoxDT] -> ShowS
showList :: [BoundingBoxDT] -> ShowS
Show, BoundingBoxDT -> BoundingBoxDT -> Bool
(BoundingBoxDT -> BoundingBoxDT -> Bool)
-> (BoundingBoxDT -> BoundingBoxDT -> Bool) -> Eq BoundingBoxDT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundingBoxDT -> BoundingBoxDT -> Bool
== :: BoundingBoxDT -> BoundingBoxDT -> Bool
$c/= :: BoundingBoxDT -> BoundingBoxDT -> Bool
/= :: BoundingBoxDT -> BoundingBoxDT -> Bool
Eq)

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)

data FNError
  = Boundary
  | LowScore
  | MissClass
  | Occulusion
  deriving (Int -> FNError -> ShowS
[FNError] -> ShowS
FNError -> String
(Int -> FNError -> ShowS)
-> (FNError -> String) -> ([FNError] -> ShowS) -> Show FNError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FNError -> ShowS
showsPrec :: Int -> FNError -> ShowS
$cshow :: FNError -> String
show :: FNError -> String
$cshowList :: [FNError] -> ShowS
showList :: [FNError] -> ShowS
Show, FNError -> FNError -> Bool
(FNError -> FNError -> Bool)
-> (FNError -> FNError -> Bool) -> Eq FNError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FNError -> FNError -> Bool
== :: FNError -> FNError -> Bool
$c/= :: FNError -> FNError -> Bool
/= :: FNError -> FNError -> Bool
Eq)

instance BoundingBox BoundingBoxGT where
  type Detection _ = BoundingBoxDT
  type ClassG _ = Class
  type ClassD _ = Class
  data ErrorType _
    = FalsePositive
    | FalseNegative (Set FNError)
    | TruePositive
    | TrueNegative
    deriving (Int -> ErrorType BoundingBoxGT -> ShowS
[ErrorType BoundingBoxGT] -> ShowS
ErrorType BoundingBoxGT -> String
(Int -> ErrorType BoundingBoxGT -> ShowS)
-> (ErrorType BoundingBoxGT -> String)
-> ([ErrorType BoundingBoxGT] -> ShowS)
-> Show (ErrorType BoundingBoxGT)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorType BoundingBoxGT -> ShowS
showsPrec :: Int -> ErrorType BoundingBoxGT -> ShowS
$cshow :: ErrorType BoundingBoxGT -> String
show :: ErrorType BoundingBoxGT -> String
$cshowList :: [ErrorType BoundingBoxGT] -> ShowS
showList :: [ErrorType BoundingBoxGT] -> ShowS
Show, 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)
  type InterestArea _ = [(Double, Double)]
  type InterestObject _ = BoundingBoxGT
  data Env _ = MyEnv
    { Env BoundingBoxGT -> Vector BoundingBoxGT
envGroundTruth :: Vector BoundingBoxGT,
      Env BoundingBoxGT -> Vector BoundingBoxDT
envDetection :: Vector BoundingBoxDT,
      Env BoundingBoxGT -> Double
envConfidenceScoreThresh :: Double,
      Env BoundingBoxGT -> Double
envIoUThresh :: Double
    }
  type Idx _ = Int
  type Risk _ = Double

  riskE :: Env BoundingBoxGT -> Risk BoundingBoxGT
riskE Env BoundingBoxGT
env = Reader (Env BoundingBoxGT) Double -> Env BoundingBoxGT -> Double
forall r a. Reader r a -> r -> a
runReader (forall a (m :: * -> *).
(Fractional (Risk a), Num (Risk a), BoundingBox a, Monad m) =>
ReaderT (Env a) m (Risk a)
myRisk @BoundingBoxGT) Env BoundingBoxGT
env
  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
_ = InterestObject BoundingBoxGT
BoundingBoxGT
forall a. HasCallStack => a
undefined
  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 BoundingBoxDT
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
BoundingBoxDT
v.score
  sizeD :: Detection BoundingBoxGT -> Double
sizeD Detection BoundingBoxGT
v = Detection BoundingBoxGT
BoundingBoxDT
v.w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Detection BoundingBoxGT
BoundingBoxDT
v.h
  classD :: Detection BoundingBoxGT -> ClassG BoundingBoxGT
classD Detection BoundingBoxGT
v = Detection BoundingBoxGT
BoundingBoxDT
v.cls
  idD :: Detection BoundingBoxGT -> Idx BoundingBoxGT
idD Detection BoundingBoxGT
v = Detection BoundingBoxGT
BoundingBoxDT
v.idx

  isFrontD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isFrontD :: Detection BoundingBoxGT -> Detection BoundingBoxGT -> Bool
isFrontD Detection BoundingBoxGT
dtBack Detection BoundingBoxGT
dtFront =
    let intersection :: Double
intersection =
          (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Detection BoundingBoxGT
BoundingBoxDT
dtBack.x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
dtBack.w) (Detection BoundingBoxGT
BoundingBoxDT
dtFront.x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
dtFront.w) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Detection BoundingBoxGT
BoundingBoxDT
dtBack.x Detection BoundingBoxGT
BoundingBoxDT
dtFront.x)
            Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Detection BoundingBoxGT
BoundingBoxDT
dtBack.y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
dtBack.h) (Detection BoundingBoxGT
BoundingBoxDT
dtFront.y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
dtFront.h) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Detection BoundingBoxGT
BoundingBoxDT
dtBack.y Detection BoundingBoxGT
BoundingBoxDT
dtFront.y)
     in (Double
intersection Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Detection BoundingBoxGT
BoundingBoxDT
dtFront.w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Detection BoundingBoxGT
BoundingBoxDT
dtFront.h)) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.99

  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
  detectD :: Env BoundingBoxGT -> Detection BoundingBoxGT -> Maybe BoundingBoxGT
  detectD :: Env BoundingBoxGT -> Detection BoundingBoxGT -> Maybe BoundingBoxGT
detectD Env BoundingBoxGT
_ Detection BoundingBoxGT
_ = Maybe BoundingBoxGT
forall a. HasCallStack => a
undefined
  errorType :: Env BoundingBoxGT -> Detection BoundingBoxGT -> Maybe (ErrorType BoundingBoxGT)
  errorType :: Env BoundingBoxGT
-> Detection BoundingBoxGT -> Maybe (ErrorType BoundingBoxGT)
errorType Env BoundingBoxGT
_ Detection BoundingBoxGT
_ = Maybe (ErrorType BoundingBoxGT)
forall a. HasCallStack => a
undefined

  sizeG :: BoundingBoxGT -> Double
sizeG BoundingBoxGT
v = BoundingBoxGT
v.w Double -> Double -> Double
forall a. Num a => a -> a -> a
* BoundingBoxGT
v.h
  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
  ioU :: BoundingBoxGT -> Detection BoundingBoxGT -> Double
ioU BoundingBoxGT
g Detection BoundingBoxGT
d =
    let intersection :: Double
intersection =
          (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (BoundingBoxGT
g.x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BoundingBoxGT
g.w) (Detection BoundingBoxGT
BoundingBoxDT
d.x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
d.w) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max BoundingBoxGT
g.x Detection BoundingBoxGT
BoundingBoxDT
d.x)
            Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (BoundingBoxGT
g.y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BoundingBoxGT
g.h) (Detection BoundingBoxGT
BoundingBoxDT
d.y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
d.h) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max BoundingBoxGT
g.y Detection BoundingBoxGT
BoundingBoxDT
d.y)
     in Double
intersection Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (BoundingBoxGT
g.w Double -> Double -> Double
forall a. Num a => a -> a -> a
* BoundingBoxGT
g.h Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
d.w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Detection BoundingBoxGT
BoundingBoxDT
d.h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
intersection)
  ioG :: BoundingBoxGT -> Detection BoundingBoxGT -> Double
ioG BoundingBoxGT
g Detection BoundingBoxGT
d =
    let intersection :: Double
intersection =
          (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (BoundingBoxGT
g.x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BoundingBoxGT
g.w) (Detection BoundingBoxGT
BoundingBoxDT
d.x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
d.w) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max BoundingBoxGT
g.x Detection BoundingBoxGT
BoundingBoxDT
d.x)
            Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (BoundingBoxGT
g.y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BoundingBoxGT
g.h) (Detection BoundingBoxGT
BoundingBoxDT
d.y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
d.h) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max BoundingBoxGT
g.y Detection BoundingBoxGT
BoundingBoxDT
d.y)
     in Double
intersection Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (BoundingBoxGT
g.w Double -> Double -> Double
forall a. Num a => a -> a -> a
* BoundingBoxGT
g.h)
  ioD :: BoundingBoxGT -> Detection BoundingBoxGT -> Double
ioD BoundingBoxGT
g Detection BoundingBoxGT
d =
    let intersection :: Double
intersection =
          (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (BoundingBoxGT
g.x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BoundingBoxGT
g.w) (Detection BoundingBoxGT
BoundingBoxDT
d.x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
d.w) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max BoundingBoxGT
g.x Detection BoundingBoxGT
BoundingBoxDT
d.x)
            Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (BoundingBoxGT
g.y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BoundingBoxGT
g.h) (Detection BoundingBoxGT
BoundingBoxDT
d.y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection BoundingBoxGT
BoundingBoxDT
d.h) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max BoundingBoxGT
g.y Detection BoundingBoxGT
BoundingBoxDT
d.y)
     in Double
intersection Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Detection BoundingBoxGT
BoundingBoxDT
d.w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Detection BoundingBoxGT
BoundingBoxDT
d.h)
  detectG :: Env BoundingBoxGT -> BoundingBoxGT -> Maybe (Detection BoundingBoxGT)
  detectG :: Env BoundingBoxGT
-> BoundingBoxGT -> Maybe (Detection BoundingBoxGT)
detectG Env BoundingBoxGT
env BoundingBoxGT
gt =
    let dts :: Vector (Detection BoundingBoxGT)
dts = Env BoundingBoxGT -> Vector (Detection BoundingBoxGT)
forall a. BoundingBox a => Env a -> Vector (Detection a)
detection Env BoundingBoxGT
env
        dts' :: [BoundingBoxDT]
dts' = (BoundingBoxDT -> Bool) -> [BoundingBoxDT] -> [BoundingBoxDT]
forall a. (a -> Bool) -> [a] -> [a]
filter (\BoundingBoxDT
dt -> forall a. BoundingBox a => Detection a -> Double
scoreD @BoundingBoxGT Detection BoundingBoxGT
BoundingBoxDT
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) ([BoundingBoxDT] -> [BoundingBoxDT])
-> [BoundingBoxDT] -> [BoundingBoxDT]
forall a b. (a -> b) -> a -> b
$ Vector BoundingBoxDT -> [BoundingBoxDT]
forall a. Vector a -> [a]
Vector.toList Vector (Detection BoundingBoxGT)
Vector BoundingBoxDT
dts
        dts'' :: [BoundingBoxDT]
dts'' = (BoundingBoxDT -> Bool) -> [BoundingBoxDT] -> [BoundingBoxDT]
forall a. (a -> Bool) -> [a] -> [a]
filter (\BoundingBoxDT
dt -> forall a. BoundingBox a => Detection a -> ClassG a
classD @BoundingBoxGT Detection BoundingBoxGT
BoundingBoxDT
dt Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== forall a. BoundingBox a => a -> ClassG a
classG @BoundingBoxGT BoundingBoxGT
gt) [BoundingBoxDT]
dts'
        -- Get max IOU detection with ioUThresh
        dts''' :: [(Double, BoundingBoxDT)]
dts''' = ((Double, BoundingBoxDT) -> Bool)
-> [(Double, BoundingBoxDT)] -> [(Double, BoundingBoxDT)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Double
iou, BoundingBoxDT
_) -> Double
iou Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Env BoundingBoxGT -> Double
forall a. BoundingBox a => Env a -> Double
ioUThresh Env BoundingBoxGT
env) ([(Double, BoundingBoxDT)] -> [(Double, BoundingBoxDT)])
-> [(Double, BoundingBoxDT)] -> [(Double, BoundingBoxDT)]
forall a b. (a -> b) -> a -> b
$ (BoundingBoxDT -> (Double, BoundingBoxDT))
-> [BoundingBoxDT] -> [(Double, BoundingBoxDT)]
forall a b. (a -> b) -> [a] -> [b]
map (\BoundingBoxDT
dt -> (BoundingBoxGT -> Detection BoundingBoxGT -> Double
forall a. BoundingBox a => a -> Detection a -> Double
ioU BoundingBoxGT
gt Detection BoundingBoxGT
BoundingBoxDT
dt, BoundingBoxDT
dt)) [BoundingBoxDT]
dts''
     in case [(Double, BoundingBoxDT)]
dts''' of
          [] -> Maybe (Detection BoundingBoxGT)
Maybe BoundingBoxDT
forall a. Maybe a
Nothing
          [(Double, BoundingBoxDT)]
dts -> Detection BoundingBoxGT -> Maybe (Detection BoundingBoxGT)
forall a. a -> Maybe a
Just (Detection BoundingBoxGT -> Maybe (Detection BoundingBoxGT))
-> Detection BoundingBoxGT -> Maybe (Detection BoundingBoxGT)
forall a b. (a -> b) -> a -> b
$ (Double, Detection BoundingBoxGT) -> Detection BoundingBoxGT
forall a b. (a, b) -> b
snd ((Double, Detection BoundingBoxGT) -> Detection BoundingBoxGT)
-> (Double, Detection BoundingBoxGT) -> Detection BoundingBoxGT
forall a b. (a -> b) -> a -> b
$ ((Double, BoundingBoxDT) -> (Double, BoundingBoxDT) -> Ordering)
-> [(Double, BoundingBoxDT)] -> (Double, BoundingBoxDT)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.maximumBy (\(Double
iou1, BoundingBoxDT
_) (Double
iou2, BoundingBoxDT
_) -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
iou1 Double
iou2) [(Double, BoundingBoxDT)]
dts

  isInIeterestAreaD :: InterestArea BoundingBoxGT -> Detection BoundingBoxGT -> Bool
  isInIeterestAreaD :: InterestArea BoundingBoxGT -> Detection BoundingBoxGT -> Bool
isInIeterestAreaD InterestArea BoundingBoxGT
_ Detection BoundingBoxGT
_ = Bool
forall a. HasCallStack => a
undefined
  isInIeterestAreaG :: InterestArea BoundingBoxGT -> BoundingBoxGT -> Bool
isInIeterestAreaG InterestArea BoundingBoxGT
_ BoundingBoxGT
_ = Bool
forall a. HasCallStack => a
undefined

  riskD :: Env BoundingBoxGT -> Detection BoundingBoxGT -> Risk BoundingBoxGT
riskD Env BoundingBoxGT
_ Detection BoundingBoxGT
_ = Double
Risk BoundingBoxGT
forall a. HasCallStack => a
undefined
  riskBB :: Env BoundingBoxGT -> Risk BoundingBoxGT
riskBB Env BoundingBoxGT
_ = Double
Risk BoundingBoxGT
forall a. HasCallStack => a
undefined

  confusionMatrixRecallBB :: Env BoundingBoxGT
-> Map (ClassG BoundingBoxGT, ClassD BoundingBoxGT) Double
confusionMatrixRecallBB Env BoundingBoxGT
_ = Map (ClassG BoundingBoxGT, ClassD BoundingBoxGT) Double
Map (Class, Class) Double
forall a. HasCallStack => a
undefined
  confusionMatrixAccuracyBB :: Env BoundingBoxGT
-> Map (ClassD BoundingBoxGT, ClassG BoundingBoxGT) Double
confusionMatrixAccuracyBB Env BoundingBoxGT
_ = Map (ClassD BoundingBoxGT, ClassG BoundingBoxGT) Double
Map (Class, Class) Double
forall a. HasCallStack => a
undefined
  confusionMatrixRecallBB' :: Env BoundingBoxGT
-> Map
     (ClassG BoundingBoxGT, ClassD BoundingBoxGT) [Idx BoundingBoxGT]
confusionMatrixRecallBB' Env BoundingBoxGT
_ = Map
  (ClassG BoundingBoxGT, ClassD BoundingBoxGT) [Idx BoundingBoxGT]
Map (Class, Class) [Int]
forall a. HasCallStack => a
undefined
  confusionMatrixAccuracyBB' :: Env BoundingBoxGT
-> Map
     (ClassD BoundingBoxGT, ClassG BoundingBoxGT) [Idx BoundingBoxGT]
confusionMatrixAccuracyBB' Env BoundingBoxGT
_ = Map
  (ClassD BoundingBoxGT, ClassG BoundingBoxGT) [Idx BoundingBoxGT]
Map (Class, Class) [Int]
forall a. HasCallStack => a
undefined
  errorGroupsBB :: Env BoundingBoxGT
-> Map
     (ClassG BoundingBoxGT)
     (Map (ErrorType BoundingBoxGT) [Idx BoundingBoxGT])
errorGroupsBB Env BoundingBoxGT
_ = Map
  (ClassG BoundingBoxGT)
  (Map (ErrorType BoundingBoxGT) [Idx BoundingBoxGT])
Map Class (Map (ErrorType BoundingBoxGT) [Int])
forall a. HasCallStack => a
undefined

myRisk :: forall a m. (Fractional (Risk a), Num (Risk a), BoundingBox a, Monad m) => ReaderT (Env a) m (Risk a)
myRisk :: forall a (m :: * -> *).
(Fractional (Risk a), Num (Risk a), BoundingBox a, Monad m) =>
ReaderT (Env a) m (Risk a)
myRisk = do
  Env a
env <- ReaderT (Env a) m (Env a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  (Risk a -> Risk a -> Risk a)
-> Risk a
-> (a -> ReaderT (Env a) m (Risk a))
-> ReaderT (Env a) m (Risk a)
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 a -> Risk a -> Risk a
forall a. Num a => a -> a -> a
(+) Risk a
0 ((a -> ReaderT (Env a) m (Risk a)) -> ReaderT (Env a) m (Risk a))
-> (a -> ReaderT (Env a) m (Risk a)) -> ReaderT (Env a) m (Risk a)
forall a b. (a -> b) -> a -> b
$ \(a
gt :: a) ->
    case Env a -> a -> Maybe (Detection a)
forall a. BoundingBox a => Env a -> a -> Maybe (Detection a)
detectG Env a
env a
gt of
      Maybe (Detection a)
Nothing -> Risk a -> ReaderT (Env a) m (Risk a)
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return Risk a
10
      Just (Detection a
obj :: Detection a) -> do
        if a -> Detection a -> Double
forall a. BoundingBox a => a -> Detection a -> Double
ioU a
gt Detection a
obj Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Env a -> Double
forall a. BoundingBox a => Env a -> Double
ioUThresh Env a
env
          then Risk a -> ReaderT (Env a) m (Risk a)
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return Risk a
0.001
          else
            if a -> Detection a -> Double
forall a. BoundingBox a => a -> Detection a -> Double
ioG a
gt Detection a
obj Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Env a -> Double
forall a. BoundingBox a => Env a -> Double
ioUThresh Env a
env
              then Risk a -> ReaderT (Env a) m (Risk a)
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return Risk a
1
              else Risk a -> ReaderT (Env a) m (Risk a)
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return Risk a
5

myRiskWithError :: forall a m. (Monoid [(Risk a, ErrorType a)], BoundingBox a, Monad m, a ~ BoundingBoxGT) => ReaderT (Env a) m [(Risk a, ErrorType a)]
myRiskWithError :: forall a (m :: * -> *).
(Monoid [(Risk a, ErrorType a)], BoundingBox a, Monad m,
 a ~ BoundingBoxGT) =>
ReaderT (Env a) m [(Risk a, ErrorType a)]
myRiskWithError = do
  Env a
env <- ReaderT (Env a) m (Env a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  ([(Double, ErrorType BoundingBoxGT)]
 -> [(Double, ErrorType BoundingBoxGT)]
 -> [(Double, ErrorType BoundingBoxGT)])
-> [(Double, ErrorType BoundingBoxGT)]
-> (a -> ReaderT (Env a) m [(Double, ErrorType BoundingBoxGT)])
-> ReaderT (Env a) m [(Double, ErrorType 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 [(Double, ErrorType BoundingBoxGT)]
-> [(Double, ErrorType BoundingBoxGT)]
-> [(Double, ErrorType BoundingBoxGT)]
forall a. [a] -> [a] -> [a]
(++) [] ((a -> ReaderT (Env a) m [(Double, ErrorType BoundingBoxGT)])
 -> ReaderT (Env a) m [(Double, ErrorType BoundingBoxGT)])
-> (a -> ReaderT (Env a) m [(Double, ErrorType BoundingBoxGT)])
-> ReaderT (Env a) m [(Double, ErrorType BoundingBoxGT)]
forall a b. (a -> b) -> a -> b
$ \(a
gt :: a) ->
    case Env a -> a -> Maybe (Detection a)
forall a. BoundingBox a => Env a -> a -> Maybe (Detection a)
detectG Env a
env a
gt of
      Maybe (Detection a)
Nothing -> [(Double, ErrorType BoundingBoxGT)]
-> ReaderT (Env a) m [(Double, ErrorType BoundingBoxGT)]
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Double
10, Set FNError -> ErrorType BoundingBoxGT
FalseNegative Set FNError
forall a. Set a
Set.empty)]
      Just (Detection a
obj :: Detection a) -> do
        if a -> Detection a -> Double
forall a. BoundingBox a => a -> Detection a -> Double
ioU a
gt Detection a
obj Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Env a -> Double
forall a. BoundingBox a => Env a -> Double
ioUThresh Env a
env
          then [(Double, ErrorType BoundingBoxGT)]
-> ReaderT (Env a) m [(Double, ErrorType BoundingBoxGT)]
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Double
0, ErrorType BoundingBoxGT
TruePositive)]
          else
            if a -> Detection a -> Double
forall a. BoundingBox a => a -> Detection a -> Double
ioG a
gt Detection a
obj Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Env a -> Double
forall a. BoundingBox a => Env a -> Double
ioUThresh Env a
env
              then [(Double, ErrorType BoundingBoxGT)]
-> ReaderT (Env a) m [(Double, ErrorType BoundingBoxGT)]
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Double
1, Set FNError -> ErrorType BoundingBoxGT
FalseNegative Set FNError
forall a. Set a
Set.empty)]
              else [(Double, ErrorType BoundingBoxGT)]
-> ReaderT (Env a) m [(Double, ErrorType BoundingBoxGT)]
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Double
5, Set FNError -> ErrorType BoundingBoxGT
FalseNegative Set FNError
forall a. Set a
Set.empty)]