{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DefaultSignatures #-}
module RiskWeaver.DSL.Core where
import Control.Monad.Trans.Reader (ReaderT, ask, runReader)
import Control.Parallel.Strategies
import Data.Kind (Type)
import Data.Map (Map)
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.List qualified as List
class Rectangle a where
rX :: a -> Double
rY :: a -> Double
rW :: a -> Double
rH :: a -> Double
class (Eq (ClassG a), Eq (ClassD a)) => BoundingBox a where
data Detection a :: Type
type ClassG a :: Type
type ClassD a :: Type
data ErrorType a :: Type
type InterestArea a :: Type
type InterestObject a :: Type
data Env a :: Type
type Idx a :: Type
type ImgIdx a :: Type
data Risk a :: Type
riskE :: Env a -> [Risk a]
riskE Env a
env = Reader (Env a) [Risk a] -> Env a -> [Risk a]
forall r a. Reader r a -> r -> a
runReader Reader (Env a) [Risk a]
myRisk Env a
env
where
myRisk :: Reader (Env a) [Risk a]
myRisk = do
![Risk a]
riskG <- Reader (Env a) [Risk a]
forall a (m :: * -> *).
(BoundingBox a, Monad m) =>
ReaderT (Env a) m [Risk a]
forall (m :: * -> *). Monad m => ReaderT (Env a) m [Risk a]
riskForGroundTruth
![Risk a]
riskD <- Reader (Env a) [Risk a]
forall a (m :: * -> *).
(BoundingBox a, Monad m) =>
ReaderT (Env a) m [Risk a]
forall (m :: * -> *). Monad m => ReaderT (Env a) m [Risk a]
riskForDetection
[Risk a] -> Reader (Env a) [Risk a]
forall a. a -> ReaderT (Env a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Risk a] -> Reader (Env a) [Risk a])
-> [Risk a] -> Reader (Env a) [Risk a]
forall a b. (a -> b) -> a -> b
$ [Risk a]
riskG [Risk a] -> [Risk a] -> [Risk a]
forall a. Semigroup a => a -> a -> a
<> [Risk a]
riskD
riskForGroundTruth :: Monad m => ReaderT (Env a) m [Risk a]
riskForDetection :: Monad m => ReaderT (Env a) m [Risk a]
interestArea :: Env a -> InterestArea a
interestObject :: Env a -> InterestObject a
groundTruth :: Env a -> Vector a
detection :: Env a -> Vector (Detection a)
confidenceScoreThresh :: Env a -> Double
ioUThresh :: Env a -> Double
scoreD :: Detection a -> Double
sizeD :: Detection a -> Double
default sizeD :: (Rectangle (Detection a)) => Detection a -> Double
sizeD Detection a
v = Detection a -> Double
forall a. Rectangle a => a -> Double
rW Detection a
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Detection a -> Double
forall a. Rectangle a => a -> Double
rH Detection a
v
classD :: Detection a -> ClassG a
idD :: Detection a -> Idx a
imageId :: Env a -> ImgIdx a
isFrontD :: Detection a -> Detection a -> Bool
default isFrontD :: (Rectangle (Detection a)) => Detection a -> Detection a -> Bool
isFrontD Detection a
dtBack Detection a
dtFront =
let intersection :: Double
intersection =
(Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
dtBack Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rW Detection a
dtBack) (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
dtFront Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rW Detection a
dtFront) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
dtBack) (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
dtFront))
Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
dtBack Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rH Detection a
dtBack) (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
dtFront Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rH Detection a
dtFront) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
dtBack) (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
dtFront))
in (Double
intersection Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Detection a -> Double
forall a. Rectangle a => a -> Double
rW Detection a
dtFront Double -> Double -> Double
forall a. Num a => a -> a -> a
* Detection a -> Double
forall a. Rectangle a => a -> Double
rH Detection a
dtFront)) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.99
isBackD :: Detection a -> Detection a -> Bool
isLeftD :: Detection a -> Detection a -> Bool
isRightD :: Detection a -> Detection a -> Bool
isTopD :: Detection a -> Detection a -> Bool
isBottomD :: Detection a -> Detection a -> Bool
isBackGroundD :: ClassD a -> Bool
detectD :: Env a -> Detection a -> Maybe a
detectD Env a
env Detection a
dt =
let gts :: Vector a
gts = Env a -> Vector a
forall a. BoundingBox a => Env a -> Vector a
groundTruth Env a
env
gts'' :: [a]
gts'' = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a
gt -> forall a. BoundingBox a => Detection a -> ClassG a
classD @a Detection a
dt ClassG a -> ClassG a -> Bool
forall a. Eq a => a -> a -> Bool
== forall a. BoundingBox a => a -> ClassG a
classG @a a
gt) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Vector a -> [a]
Vector.toList Vector a
gts
gts''' :: [(Double, a)]
gts''' = ((Double, a) -> Bool) -> [(Double, a)] -> [(Double, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Double
iou', a
_) -> Double
iou' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Env a -> Double
forall a. BoundingBox a => Env a -> Double
ioUThresh Env a
env) ([(Double, a)] -> [(Double, a)]) -> [(Double, a)] -> [(Double, a)]
forall a b. (a -> b) -> a -> b
$ (a -> (Double, a)) -> [a] -> [(Double, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
gt -> (a -> Detection a -> Double
forall a. BoundingBox a => a -> Detection a -> Double
ioU a
gt Detection a
dt, a
gt)) [a]
gts''
in case [(Double, a)]
gts''' of
[] -> Maybe a
forall a. Maybe a
Nothing
[(Double, a)]
gts_ -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (Double, a) -> a
forall a b. (a, b) -> b
snd ((Double, a) -> a) -> (Double, a) -> a
forall a b. (a -> b) -> a -> b
$ ((Double, a) -> (Double, a) -> Ordering)
-> [(Double, a)] -> (Double, a)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.maximumBy (\(Double
iou1, a
_) (Double
iou2, a
_) -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
iou1 Double
iou2) [(Double, a)]
gts_
toErrorType :: Risk a -> ErrorType a
toRiskScore :: Risk a -> Double
sizeG :: a -> Double
default sizeG :: (Rectangle a) => a -> Double
sizeG a
v = a -> Double
forall a. Rectangle a => a -> Double
rW a
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* a -> Double
forall a. Rectangle a => a -> Double
rH a
v
classG :: a -> ClassG a
angle :: a -> Detection a -> Double
idG :: a -> Idx a
ioU :: a -> Detection a -> Double
default ioU :: (Rectangle a, Rectangle (Detection a)) => a -> Detection a -> Double
ioU a
g Detection a
d =
let intersection :: Double
intersection =
(Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (a -> Double
forall a. Rectangle a => a -> Double
rX a
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a. Rectangle a => a -> Double
rW a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rW Detection a
d) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (a -> Double
forall a. Rectangle a => a -> Double
rX a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
d))
Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (a -> Double
forall a. Rectangle a => a -> Double
rY a
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a. Rectangle a => a -> Double
rH a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rH Detection a
d) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (a -> Double
forall a. Rectangle a => a -> Double
rY a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
d))
in Double
intersection Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (a -> Double
forall a. Rectangle a => a -> Double
rW a
g Double -> Double -> Double
forall a. Num a => a -> a -> a
* a -> Double
forall a. Rectangle a => a -> Double
rH a
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rW Detection a
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Detection a -> Double
forall a. Rectangle a => a -> Double
rH Detection a
d Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
intersection)
ioG :: a -> Detection a -> Double
default ioG :: (Rectangle a, Rectangle (Detection a)) => a -> Detection a -> Double
ioG a
g Detection a
d =
let intersection :: Double
intersection =
(Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (a -> Double
forall a. Rectangle a => a -> Double
rX a
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a. Rectangle a => a -> Double
rW a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rW Detection a
d) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (a -> Double
forall a. Rectangle a => a -> Double
rX a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
d))
Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (a -> Double
forall a. Rectangle a => a -> Double
rY a
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a. Rectangle a => a -> Double
rH a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rH Detection a
d) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (a -> Double
forall a. Rectangle a => a -> Double
rY a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
d))
in Double
intersection Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (a -> Double
forall a. Rectangle a => a -> Double
rW a
g Double -> Double -> Double
forall a. Num a => a -> a -> a
* a -> Double
forall a. Rectangle a => a -> Double
rH a
g)
ioD :: a -> Detection a -> Double
default ioD :: (Rectangle a, Rectangle (Detection a)) => a -> Detection a -> Double
ioD a
g Detection a
d =
let intersection :: Double
intersection =
(Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (a -> Double
forall a. Rectangle a => a -> Double
rX a
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a. Rectangle a => a -> Double
rW a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rW Detection a
d) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (a -> Double
forall a. Rectangle a => a -> Double
rX a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rX Detection a
d))
Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (a -> Double
forall a. Rectangle a => a -> Double
rY a
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a. Rectangle a => a -> Double
rH a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Detection a -> Double
forall a. Rectangle a => a -> Double
rH Detection a
d) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (a -> Double
forall a. Rectangle a => a -> Double
rY a
g) (Detection a -> Double
forall a. Rectangle a => a -> Double
rY Detection a
d))
in Double
intersection Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Detection a -> Double
forall a. Rectangle a => a -> Double
rW Detection a
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Detection a -> Double
forall a. Rectangle a => a -> Double
rH Detection a
d)
detectG :: Env a -> a -> Maybe (Detection a)
detectG Env a
env a
gt =
let dts :: Vector (Detection a)
dts = Env a -> Vector (Detection a)
forall a. BoundingBox a => Env a -> Vector (Detection a)
detection Env a
env
dts' :: [Detection a]
dts' = (Detection a -> Bool) -> [Detection a] -> [Detection a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Detection a
dt -> forall a. BoundingBox a => Detection a -> Double
scoreD @a Detection a
dt Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Env a -> Double
forall a. BoundingBox a => Env a -> Double
confidenceScoreThresh Env a
env) ([Detection a] -> [Detection a]) -> [Detection a] -> [Detection a]
forall a b. (a -> b) -> a -> b
$ Vector (Detection a) -> [Detection a]
forall a. Vector a -> [a]
Vector.toList Vector (Detection a)
dts
dts'' :: [Detection a]
dts'' = (Detection a -> Bool) -> [Detection a] -> [Detection a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Detection a
dt -> forall a. BoundingBox a => Detection a -> ClassG a
classD @a Detection a
dt ClassG a -> ClassG a -> Bool
forall a. Eq a => a -> a -> Bool
== forall a. BoundingBox a => a -> ClassG a
classG @a a
gt) [Detection a]
dts'
dts''' :: [(Double, Detection a)]
dts''' = ((Double, Detection a) -> Bool)
-> [(Double, Detection a)] -> [(Double, Detection a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Double
iou', Detection a
_) -> Double
iou' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Env a -> Double
forall a. BoundingBox a => Env a -> Double
ioUThresh Env a
env) ([(Double, Detection a)] -> [(Double, Detection a)])
-> [(Double, Detection a)] -> [(Double, Detection a)]
forall a b. (a -> b) -> a -> b
$ (Detection a -> (Double, Detection a))
-> [Detection a] -> [(Double, Detection a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Detection a
dt -> (a -> Detection a -> Double
forall a. BoundingBox a => a -> Detection a -> Double
ioU a
gt Detection a
dt, Detection a
dt)) [Detection a]
dts''
in case [(Double, Detection a)]
dts''' of
[] -> Maybe (Detection a)
forall a. Maybe a
Nothing
[(Double, Detection a)]
dts_ -> Detection a -> Maybe (Detection a)
forall a. a -> Maybe a
Just (Detection a -> Maybe (Detection a))
-> Detection a -> Maybe (Detection a)
forall a b. (a -> b) -> a -> b
$ (Double, Detection a) -> Detection a
forall a b. (a, b) -> b
snd ((Double, Detection a) -> Detection a)
-> (Double, Detection a) -> Detection a
forall a b. (a -> b) -> a -> b
$ ((Double, Detection a) -> (Double, Detection a) -> Ordering)
-> [(Double, Detection a)] -> (Double, Detection a)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.maximumBy (\(Double
iou1, Detection a
_) (Double
iou2, Detection a
_) -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
iou1 Double
iou2) [(Double, Detection a)]
dts_
isInIeterestAreaD :: InterestArea a -> Detection a -> Bool
isInIeterestAreaG :: InterestArea a -> a -> Bool
isInterestObjectD :: InterestObject a -> Detection a -> Bool
isInterestObjectG :: InterestObject a -> a -> Bool
class (NFData (ImgIdx a), NFData (Risk a), BoundingBox a) => World b a where
envs :: b -> [Env a]
envs b
context =
(ImgIdx a -> Env a) -> [ImgIdx a] -> [Env a]
forall a b. (a -> b) -> [a] -> [b]
map
(\ImgIdx a
imageId' -> forall b a. World b a => b -> ImgIdx a -> Env a
toEnv @b @a b
context ImgIdx a
imageId')
(forall b a. World b a => b -> [ImgIdx a]
toImageIds @b @a b
context)
toEnv :: b -> ImgIdx a -> Env a
toImageIds :: b -> [ImgIdx a]
mAP :: b -> Double
ap :: b -> Map (ClassG a) Double
mF1 :: b -> Double
f1 :: b -> Map (ClassG a) Double
risk :: b -> [Risk a]
risk b
context = [[Risk a]] -> [Risk a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Risk a]] -> [Risk a]) -> [[Risk a]] -> [Risk a]
forall a b. (a -> b) -> a -> b
$ ((ImgIdx a, [Risk a]) -> [Risk a])
-> [(ImgIdx a, [Risk a])] -> [[Risk a]]
forall a b. (a -> b) -> [a] -> [b]
map (ImgIdx a, [Risk a]) -> [Risk a]
forall a b. (a, b) -> b
snd ([(ImgIdx a, [Risk a])] -> [[Risk a]])
-> [(ImgIdx a, [Risk a])] -> [[Risk a]]
forall a b. (a -> b) -> a -> b
$ b -> [(ImgIdx a, [Risk a])]
forall context a.
World context a =>
context -> [(ImgIdx a, [Risk a])]
runRiskWithError b
context
confusionMatrixRecall :: b -> Map (ClassG a, ClassD a) [Risk a]
confusionMatrixPrecision :: b -> Map (ClassD a, ClassG a) [Risk a]
loopG :: forall a m b. (BoundingBox a, Monad m) => (b -> b -> b) -> b -> (a -> ReaderT (Env a) m b) -> ReaderT (Env a) m b
loopG :: forall a (m :: * -> *) b.
(BoundingBox a, Monad m) =>
(b -> b -> b)
-> b -> (a -> ReaderT (Env a) m b) -> ReaderT (Env a) m b
loopG b -> b -> b
add b
init' a -> ReaderT (Env a) m b
fn = do
Env a
env <- ReaderT (Env a) m (Env a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
(b -> b -> b) -> b -> Vector b -> b
forall b a. (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> b -> b
add b
init' (Vector b -> b)
-> ReaderT (Env a) m (Vector b) -> ReaderT (Env a) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> ReaderT (Env a) m b)
-> Vector a -> ReaderT (Env a) m (Vector b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM a -> ReaderT (Env a) m b
fn (forall a. BoundingBox a => Env a -> Vector a
groundTruth @a Env a
env)
{-# INLINEABLE loopG #-}
loopD :: 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 :: 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 b -> b -> b
add b
init' Detection a -> ReaderT (Env a) m b
fn = do
Env a
env <- ReaderT (Env a) m (Env a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
(b -> b -> b) -> b -> Vector b -> b
forall b a. (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> b -> b
add b
init' (Vector b -> b)
-> ReaderT (Env a) m (Vector b) -> ReaderT (Env a) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Detection a -> ReaderT (Env a) m b)
-> Vector (Detection a) -> ReaderT (Env a) m (Vector b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM Detection a -> ReaderT (Env a) m b
fn (forall a. BoundingBox a => Env a -> Vector (Detection a)
detection @a Env a
env)
{-# INLINEABLE loopD #-}
detectMaxIouG :: BoundingBox a => Env a -> a -> Maybe (Detection a)
detectMaxIouG :: forall a. BoundingBox a => Env a -> a -> Maybe (Detection a)
detectMaxIouG Env a
env a
gt =
let dts :: Vector (Detection a)
dts = Env a -> Vector (Detection a)
forall a. BoundingBox a => Env a -> Vector (Detection a)
detection Env a
env
dts' :: [(Double, Detection a)]
dts' = (Detection a -> (Double, Detection a))
-> [Detection a] -> [(Double, Detection a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Detection a
dt -> (a -> Detection a -> Double
forall a. BoundingBox a => a -> Detection a -> Double
ioU a
gt Detection a
dt, Detection a
dt)) ([Detection a] -> [(Double, Detection a)])
-> [Detection a] -> [(Double, Detection a)]
forall a b. (a -> b) -> a -> b
$ Vector (Detection a) -> [Detection a]
forall a. Vector a -> [a]
Vector.toList Vector (Detection a)
dts
in case [(Double, Detection a)]
dts' of
[] -> Maybe (Detection a)
forall a. Maybe a
Nothing
[(Double, Detection a)]
dts_ -> Detection a -> Maybe (Detection a)
forall a. a -> Maybe a
Just (Detection a -> Maybe (Detection a))
-> Detection a -> Maybe (Detection a)
forall a b. (a -> b) -> a -> b
$ (Double, Detection a) -> Detection a
forall a b. (a, b) -> b
snd ((Double, Detection a) -> Detection a)
-> (Double, Detection a) -> Detection a
forall a b. (a -> b) -> a -> b
$ ((Double, Detection a) -> (Double, Detection a) -> Ordering)
-> [(Double, Detection a)] -> (Double, Detection a)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.maximumBy (\(Double
iou1, Detection a
_) (Double
iou2, Detection a
_) -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
iou1 Double
iou2) [(Double, Detection a)]
dts_
detectMaxIouD :: BoundingBox a => Env a -> (Detection a) -> Maybe a
detectMaxIouD :: forall a. BoundingBox a => Env a -> Detection a -> Maybe a
detectMaxIouD Env a
env Detection a
dt =
let gts :: Vector a
gts = Env a -> Vector a
forall a. BoundingBox a => Env a -> Vector a
groundTruth Env a
env
gts' :: [(Double, a)]
gts' = (a -> (Double, a)) -> [a] -> [(Double, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
gt -> (a -> Detection a -> Double
forall a. BoundingBox a => a -> Detection a -> Double
ioU a
gt Detection a
dt, a
gt)) ([a] -> [(Double, a)]) -> [a] -> [(Double, a)]
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Vector a -> [a]
Vector.toList Vector a
gts
in case [(Double, a)]
gts' of
[] -> Maybe a
forall a. Maybe a
Nothing
[(Double, a)]
gts_ -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (Double, a) -> a
forall a b. (a, b) -> b
snd ((Double, a) -> a) -> (Double, a) -> a
forall a b. (a -> b) -> a -> b
$ ((Double, a) -> (Double, a) -> Ordering)
-> [(Double, a)] -> (Double, a)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.maximumBy (\(Double
iou1, a
_) (Double
iou2, a
_) -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
iou1 Double
iou2) [(Double, a)]
gts_
whenInterestAreaD :: forall m a b. (Monad m, BoundingBox a) => Bool -> Detection a -> ReaderT (Env a) m [b] -> ReaderT (Env a) m [b]
whenInterestAreaD :: forall (m :: * -> *) a b.
(Monad m, BoundingBox a) =>
Bool
-> Detection a -> ReaderT (Env a) m [b] -> ReaderT (Env a) m [b]
whenInterestAreaD Bool
cond Detection a
dt ReaderT (Env a) m [b]
func = do
Env a
env <- ReaderT (Env a) m (Env a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
if Bool
cond
then do
if InterestArea a -> Detection a -> Bool
forall a. BoundingBox a => InterestArea a -> Detection a -> Bool
isInIeterestAreaD (Env a -> InterestArea a
forall a. BoundingBox a => Env a -> InterestArea a
interestArea Env a
env) Detection a
dt Bool -> Bool -> Bool
&& InterestObject a -> Detection a -> Bool
forall a. BoundingBox a => InterestObject a -> Detection a -> Bool
isInterestObjectD (Env a -> InterestObject a
forall a. BoundingBox a => Env a -> InterestObject a
interestObject Env a
env) Detection a
dt
then ReaderT (Env a) m [b]
func
else [b] -> ReaderT (Env a) m [b]
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else ReaderT (Env a) m [b]
func
whenInterestAreaG :: forall m a b. (Monad m, BoundingBox a) => Bool -> a -> ReaderT (Env a) m [b] -> ReaderT (Env a) m [b]
whenInterestAreaG :: forall (m :: * -> *) a b.
(Monad m, BoundingBox a) =>
Bool -> a -> ReaderT (Env a) m [b] -> ReaderT (Env a) m [b]
whenInterestAreaG Bool
cond a
gt ReaderT (Env a) m [b]
func = do
Env a
env <- ReaderT (Env a) m (Env a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
if Bool
cond
then do
if InterestArea a -> a -> Bool
forall a. BoundingBox a => InterestArea a -> a -> Bool
isInIeterestAreaG (Env a -> InterestArea a
forall a. BoundingBox a => Env a -> InterestArea a
interestArea Env a
env) a
gt Bool -> Bool -> Bool
&& InterestObject a -> a -> Bool
forall a. BoundingBox a => InterestObject a -> a -> Bool
isInterestObjectG (Env a -> InterestObject a
forall a. BoundingBox a => Env a -> InterestObject a
interestObject Env a
env) a
gt
then ReaderT (Env a) m [b]
func
else [b] -> ReaderT (Env a) m [b]
forall a. a -> ReaderT (Env a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else ReaderT (Env a) m [b]
func
runRisk :: forall context a. (World context a) => context -> [(ImgIdx a, Double)]
runRisk :: forall context a.
World context a =>
context -> [(ImgIdx a, Double)]
runRisk context
context =
((ImgIdx a, [Risk a]) -> (ImgIdx a, Double))
-> [(ImgIdx a, [Risk a])] -> [(ImgIdx a, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ImgIdx a
imageId', [Risk a]
risks) -> (ImgIdx a
imageId', [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Risk a -> Double) -> [Risk a] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Risk a
r -> Risk a -> Double
forall a. BoundingBox a => Risk a -> Double
toRiskScore Risk a
r) [Risk a]
risks)) (forall context a.
World context a =>
context -> [(ImgIdx a, [Risk a])]
runRiskWithError @context @a context
context)
[(ImgIdx a, Double)]
-> Strategy [(ImgIdx a, Double)] -> [(ImgIdx a, Double)]
forall a. a -> Strategy a -> a
`using` Strategy (ImgIdx a, Double) -> Strategy [(ImgIdx a, Double)]
forall a. Strategy a -> Strategy [a]
parList Strategy (ImgIdx a, Double)
forall a. NFData a => Strategy a
rdeepseq
runRiskWithError :: forall context a. (World context a) => context -> [(ImgIdx a, [Risk a])]
runRiskWithError :: forall context a.
World context a =>
context -> [(ImgIdx a, [Risk a])]
runRiskWithError context
context =
(ImgIdx a -> (ImgIdx a, [Risk a]))
-> [ImgIdx a] -> [(ImgIdx a, [Risk a])]
forall a b. (a -> b) -> [a] -> [b]
map (\ImgIdx a
imageId' -> (ImgIdx a
imageId', Env a -> [Risk a]
forall a. BoundingBox a => Env a -> [Risk a]
riskE (context -> ImgIdx a -> Env a
forall b a. World b a => b -> ImgIdx a -> Env a
toEnv context
context ImgIdx a
imageId'))) (forall b a. World b a => b -> [ImgIdx a]
toImageIds @context @a context
context)
[(ImgIdx a, [Risk a])]
-> Strategy [(ImgIdx a, [Risk a])] -> [(ImgIdx a, [Risk a])]
forall a. a -> Strategy a -> a
`using` Strategy (ImgIdx a, [Risk a]) -> Strategy [(ImgIdx a, [Risk a])]
forall a. Strategy a -> Strategy [a]
parList Strategy (ImgIdx a, [Risk a])
forall a. NFData a => Strategy a
rdeepseq
generateRiskWeightedImages :: forall b a. World b a => b -> [ImgIdx a]
generateRiskWeightedImages :: forall b a. World b a => b -> [ImgIdx a]
generateRiskWeightedImages b
context =
let risks :: [(ImgIdx a, Double)]
risks = forall context a.
World context a =>
context -> [(ImgIdx a, Double)]
runRisk @b @a b
context
sumRisks :: Double
sumRisks = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ ((ImgIdx a, Double) -> Double) -> [(ImgIdx a, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (ImgIdx a, Double) -> Double
forall a b. (a, b) -> b
snd [(ImgIdx a, Double)]
risks
probs :: [Double]
probs = ((ImgIdx a, Double) -> Double) -> [(ImgIdx a, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\(ImgIdx a
_, Double
risk') -> Double
risk' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sumRisks) [(ImgIdx a, Double)]
risks
acc_probs :: [(Double, Double)]
acc_probs =
let loop :: [t] -> t -> [(t, t)]
loop [] t
_ = []
loop (t
x : [t]
xs) t
s = (t
s, t
s t -> t -> t
forall a. Num a => a -> a -> a
+ t
x) (t, t) -> [(t, t)] -> [(t, t)]
forall a. a -> [a] -> [a]
: [t] -> t -> [(t, t)]
loop [t]
xs (t
s t -> t -> t
forall a. Num a => a -> a -> a
+ t
x)
in [Double] -> Double -> [(Double, Double)]
forall {t}. Num t => [t] -> t -> [(t, t)]
loop [Double]
probs Double
0
numDatasets :: Int
numDatasets = [ImgIdx a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ImgIdx a] -> Int) -> [ImgIdx a] -> Int
forall a b. (a -> b) -> a -> b
$ forall b a. World b a => b -> [ImgIdx a]
toImageIds @b @a b
context
imageSets :: [((Double, Double), ImgIdx a)]
imageSets :: [((Double, Double), ImgIdx a)]
imageSets = [(Double, Double)] -> [ImgIdx a] -> [((Double, Double), ImgIdx a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Double, Double)]
acc_probs ([ImgIdx a] -> [((Double, Double), ImgIdx a)])
-> [ImgIdx a] -> [((Double, Double), ImgIdx a)]
forall a b. (a -> b) -> a -> b
$ ((ImgIdx a, Double) -> ImgIdx a)
-> [(ImgIdx a, Double)] -> [ImgIdx a]
forall a b. (a -> b) -> [a] -> [b]
map (ImgIdx a, Double) -> ImgIdx a
forall a b. (a, b) -> a
fst [(ImgIdx a, Double)]
risks
resample :: [((Double, Double), ImgIdx a)] -> Int -> Int -> [ImgIdx a]
resample [] Int
_ Int
_ = []
resample s :: [((Double, Double), ImgIdx a)]
s@(((Double
x, Double
y), ImgIdx a
img) : [((Double, Double), ImgIdx a)]
xs) Int
n Int
end =
if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end
then []
else
let p :: Double
p = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Double) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numDatasets :: Double)
in if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
p Bool -> Bool -> Bool
&& Double
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
y
then ImgIdx a
img ImgIdx a -> [ImgIdx a] -> [ImgIdx a]
forall a. a -> [a] -> [a]
: [((Double, Double), ImgIdx a)] -> Int -> Int -> [ImgIdx a]
resample [((Double, Double), ImgIdx a)]
s (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end
else [((Double, Double), ImgIdx a)] -> Int -> Int -> [ImgIdx a]
resample [((Double, Double), ImgIdx a)]
xs Int
n Int
end
in [((Double, Double), ImgIdx a)] -> Int -> Int -> [ImgIdx a]
resample [((Double, Double), ImgIdx a)]
imageSets Int
0 Int
numDatasets