Core.hs

{-# 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 add init fn = do
  env <- ask
  foldl add init <$> mapM fn (groundTruth @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 add init fn = do
  env <- ask
  foldl add init <$> mapM fn (detection @a env)