{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module RiskWeaver.Cmd.BDD where import Control.Monad import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT) import RiskWeaver.DSL.BDD qualified as BDD import Data.ByteString qualified as BS import Data.FileEmbed (embedFile) import Data.List (sortBy) import Data.Map qualified as Map import Data.Text qualified as T import Data.Vector (Vector) import Data.Vector qualified as Vector import RiskWeaver.Format.Coco import RiskWeaver.Metric import Options.Applicative import System.Random import Text.Printf import RiskWeaver.Cmd.Core (RiskCommands(..)) cocoCategoryToClass :: CocoMap -> CategoryId -> BDD.Class cocoCategoryToClass coco categoryId = let cocoCategory = (cocoMapCocoCategory coco) Map.! categoryId in case T.unpack (cocoCategoryName cocoCategory) of "pedestrian" -> BDD.Pedestrian "rider" -> BDD.Rider "car" -> BDD.Car "truck" -> BDD.Truck "bus" -> BDD.Bus "train" -> BDD.Train "motorcycle" -> BDD.Motorcycle "bicycle" -> BDD.Bicycle _ -> BDD.Background cocoResultToVector :: CocoMap -> ImageId -> (Vector BDD.BoundingBoxGT, Vector BDD.BoundingBoxDT) cocoResultToVector coco imageId = (groundTruth, detection) where groundTruth = Vector.fromList $ maybe [] ( map ( \CocoAnnotation {..} -> let CoCoBoundingBox (cocox, cocoy, cocow, cocoh) = cocoAnnotationBbox in BDD.BoundingBoxGT { x = cocox, y = cocoy, w = cocow, h = cocoh, cls = cocoCategoryToClass coco cocoAnnotationCategory, idx = cocoAnnotationId } ) ) (Map.lookup imageId (cocoMapCocoAnnotation coco)) detection = Vector.fromList $ maybe [] ( map ( \CocoResult {..} -> let CoCoBoundingBox (cocox, cocoy, cocow, cocoh) = cocoResultBbox in BDD.BoundingBoxDT { x = cocox, y = cocoy, w = cocow, h = cocoh, cls = cocoCategoryToClass coco cocoResultCategory, score = unScore cocoResultScore, idx = unImageId cocoResultImageId } ) ) (Map.lookup imageId (cocoMapCocoResult coco)) runRisk :: CocoMap -> IO [(ImageId, Double)] runRisk cocoMap = do forM (cocoMapImageIds cocoMap) $ \imageId -> do let (groundTruth, detection) = cocoResultToVector cocoMap imageId let env = BDD.MyEnv { envGroundTruth = groundTruth, envDetection = detection, envConfidenceScoreThresh = 0.4, envIoUThresh = 0.5 } risk <- flip runReaderT env (BDD.myRisk @BDD.BoundingBoxGT) return (imageId, risk) showRisk :: Coco -> [CocoResult] -> Maybe Double -> Maybe Double -> Maybe ImageId -> IO () showRisk coco cocoResults iouThreshold scoreThresh mImageId = do let cocoMap = let cocoMap' = toCocoMap coco cocoResults in case mImageId of Nothing -> cocoMap' Just imageId -> cocoMap' {cocoMapImageIds = [imageId]} iouThreshold' = case iouThreshold of Nothing -> IOU 0.5 Just iouThreshold -> IOU iouThreshold scoreThresh' = case scoreThresh of Nothing -> Score 0.4 Just scoreThresh -> Score scoreThresh risks <- runRisk cocoMap putStrLn $ printf "%-12s %-12s %s" "#ImageId" "Filename" "Risk" let sortedRisks = sortBy (\(_, risk1) (_, risk2) -> compare risk2 risk1) risks forM_ sortedRisks $ \(imageId, risk) -> do let cocoImage = (cocoMapCocoImage cocoMap) Map.! imageId putStrLn $ printf "%-12d %-12s %.3f" (unImageId imageId) (T.unpack (cocoImageFileName cocoImage)) risk generateRiskWeightedDataset :: Coco -> [CocoResult] -> FilePath -> Maybe Double -> Maybe Double -> IO () generateRiskWeightedDataset coco cocoResults cocoOutputFile iouThreshold scoreThresh = do let cocoMap = toCocoMap coco cocoResults iouThreshold' = case iouThreshold of Nothing -> IOU 0.5 Just iouThreshold -> IOU iouThreshold scoreThresh' = case scoreThresh of Nothing -> Score 0.4 Just scoreThresh -> Score scoreThresh risks <- runRisk cocoMap let sumRisks = sum $ map snd risks probabilitis = map (\(_, risk) -> risk / sumRisks) risks accumulatedProbabilitis = scanl (+) 0 probabilitis numDatasets = length $ cocoMapImageIds cocoMap seed = mkStdGen 0 -- Generate dataset by probability. -- The dataset's format is same as coco dataset. -- Accumurate probability -- Gen sorted list by accumulated probability with image id. -- Lottery by random number -- Get image id by lottery -- Generate random number between 0 and 1 -- Find accumulated probability that is greater than random number -- Get image id by accumulated probability -- imageSets has accumulated probability and image id. -- It uses binary search to find image id by random number. let imageSets :: Vector (Double, ImageId) imageSets = Vector.fromList $ zip accumulatedProbabilitis (cocoMapImageIds cocoMap) findImageIdFromImageSets :: Vector (Double, ImageId) -> Double -> ImageId findImageIdFromImageSets imageSets randomNum = let (start, end) = (0, Vector.length imageSets - 1) findImageIdFromImageSets' :: Int -> Int -> ImageId findImageIdFromImageSets' start end = let mid = (start + end) `div` 2 (accumulatedProbability, imageId) = imageSets Vector.! mid in if start == end then imageId else if accumulatedProbability > randomNum then findImageIdFromImageSets' start mid else findImageIdFromImageSets' (mid + 1) end in findImageIdFromImageSets' start end lotteryN :: Int -> StdGen -> Int -> [ImageId] lotteryN _ _ 0 = [] lotteryN numDatasets seed n = let (randNum, seed') = randomR (0, 1) seed imageId = findImageIdFromImageSets imageSets randNum in imageId : lotteryN numDatasets seed' (n - 1) imageIds = lotteryN numDatasets seed numDatasets cocoImages' = map (\imageId -> (cocoMapCocoImage cocoMap) Map.! imageId) imageIds newCoco = Coco { cocoImages = cocoImages', cocoCategories = cocoCategories coco, cocoAnnotations = [], cocoLicenses = cocoLicenses coco, cocoInfo = cocoInfo coco } writeCoco cocoOutputFile newCoco bddCommand :: RiskCommands bddCommand = RiskCommands { showRisk = RiskWeaver.Cmd.BDD.showRisk, generateRiskWeightedDataset = RiskWeaver.Cmd.BDD.generateRiskWeightedDataset }