{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module RiskWeaver.DSL.Core where import Control.Monad.Trans.Reader (ReaderT, ask) import Data.Kind (Type) import Data.Map (Map) import Data.Vector (Vector) class BoundingBox a where type 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 Risk a :: Type riskE :: Env a -> 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 classD :: Detection a -> ClassG a idD :: Detection a -> Idx a isFrontD :: Detection a -> Detection a -> Bool 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 errorType :: Env a -> Detection a -> Maybe (ErrorType a) sizeG :: a -> Double classG :: a -> ClassG a angle :: a -> Detection a -> Double idG :: a -> Idx a ioU :: a -> Detection a -> Double ioG :: a -> Detection a -> Double ioD :: a -> Detection a -> Double detectG :: Env a -> a -> Maybe (Detection a) isInIeterestAreaD :: InterestArea a -> Detection a -> Bool isInIeterestAreaG :: InterestArea a -> a -> Bool riskD :: Env a -> Detection a -> Risk a riskBB :: Env a -> Risk a confusionMatrixRecallBB :: Env a -> Map (ClassG a, ClassD a) Double confusionMatrixAccuracyBB :: Env a -> Map (ClassD a, ClassG a) Double confusionMatrixRecallBB' :: Env a -> Map (ClassG a, ClassD a) [Idx a] confusionMatrixAccuracyBB' :: Env a -> Map (ClassD a, ClassG a) [Idx a] errorGroupsBB :: Env a -> Map (ClassG a) (Map (ErrorType a) [Idx a]) class (BoundingBox a) => World a where type Image a :: Type idI :: Image a -> Int env :: Image a -> Env a mAP :: Vector (Image a) -> Double ap :: Vector (Image a) -> Map (ClassG a) Double risk :: Vector (Image a) -> Double confusionMatrixRecall :: Vector (Image a) -> Map (ClassG a, ClassD a) Double confusionMatrixAccuracy :: Vector (Image a) -> Map (ClassD a, ClassG a) Double confusionMatrixRecall' :: Vector (Image a) -> Map (ClassG a, ClassD a) [Idx a] confusionMatrixAccuracy' :: Vector (Image a) -> Map (ClassD a, ClassG a) [Idx a] errorGroups :: Vector (Image a) -> Map (ClassG a) (Map (ErrorType a) [Idx 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) 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)