Parasitemia/ParasitemiaCore/MatchingEllipses.fs

   1 module ParasitemiaCore.MatchingEllipses
   2
   3 open System.Drawing
   4 open System.Collections.Generic
   5
   6 open Types
   7 open Utils
   8
   9 // All ellipses with a score below this are removed.
  10 let matchingScoreThresholdPerRadiusUnit = 0.07f // For a radius of 1. // 0.25
  11 let matchingScorePower = 20.f
  12 let windowSizeRadiusFactor = 1.f / 2.f // Used when searching for neighbor ellipses.
  13 let minimumDistanceFromCenterRadiusFactor = 1.f / 3.f
  14 let minimumAreaFactor = 1.1f
  15
  16 type private EllipseScoreFlaggedKd (matchingScore : float32, e : Ellipse) =
  17     let mutable matchingScore = matchingScore
  18
  19     member this.Ellipse = e
  20
  21     member this.MatchingScore = matchingScore
  22
  23     member this.AddMatchingScore (score : float32) =
  24         matchingScore <- matchingScore + score
  25
  26     member val Processed = false with get, set
  27     member val Removed = false with get, set
  28
  29     interface KdTree.I2DCoords with
  30         member this.X = this.Ellipse.Cx
  31         member this.Y = this.Ellipse.Cy
  32
  33 type MatchingEllipses (radius : float32) =
  34     let ellipses = List<EllipseScoreFlaggedKd> ()
  35
  36     member this.Add (e : Ellipse) =
  37         ellipses.Add (EllipseScoreFlaggedKd (0.f, e))
  38
  39     member this.Ellipses : Ellipse list =
  40         List.ofSeq ellipses |> List.map (fun e -> e.Ellipse)
  41
  42     member this.PrunedEllipses : Ellipse list =
  43         if ellipses.Count = 0 then
  44             []
  45         else
  46             // 1) Create a kd-tree from the ellipses list.
  47             let tree = KdTree.Tree.BuildTree (List.ofSeq ellipses)
  48
  49             // 2) Compute the matching score of each ellipses.
  50             let windowSize = radius * windowSizeRadiusFactor
  51             for e in ellipses do
  52                 e.Processed <- true
  53                 let areaE = e.Ellipse.Area
  54                 let window =
  55                     {
  56                         KdTree.minX = e.Ellipse.Cx - windowSize / 2.f
  57                         KdTree.maxX = e.Ellipse.Cx + windowSize / 2.f
  58                         KdTree.minY = e.Ellipse.Cy - windowSize / 2.f
  59                         KdTree.maxY = e.Ellipse.Cy + windowSize / 2.f
  60                     }
  61                 for other in tree.Search window do
  62                     if not other.Processed then
  63                         let areaOther = other.Ellipse.Area
  64                         match EEOver.EEOverlapArea e.Ellipse other.Ellipse with
  65                         | Some (overlapArea, _, _)
  66                             // Because of approximation error, see https://github.com/chraibi/EEOver/issues/4
  67                             when overlapArea - areaE < 1.f && overlapArea - areaOther < 1.f ->
  68                                 let matchingScore = (2.f * overlapArea / (areaE + areaOther)) ** matchingScorePower
  69                                 other.AddMatchingScore matchingScore
  70                                 e.AddMatchingScore matchingScore
  71                         | _ -> ()
  72
  73             // 3) Remove ellipses whose center is near the center of another ellipse with a better score.
  74             let matchingScoreThreshold = matchingScoreThresholdPerRadiusUnit * radius
  75             for e in ellipses do
  76                 if e.MatchingScore < matchingScoreThreshold then
  77                     e.Removed <- true
  78                 else
  79                     let window =
  80                         {
  81                             KdTree.minX = e.Ellipse.Cx - e.Ellipse.A
  82                             KdTree.maxX = e.Ellipse.Cx + e.Ellipse.A
  83                             KdTree.minY = e.Ellipse.Cy - e.Ellipse.A
  84                             KdTree.maxY = e.Ellipse.Cy + e.Ellipse.A
  85                         }
  86                     for other in tree.Search window do
  87                         if not other.Removed && e.MatchingScore > other.MatchingScore then
  88                             // Case where ellipses are too close.
  89                             if distanceTwoPoints (PointF (e.Ellipse.Cx, e.Ellipse.Cy)) (PointF (other.Ellipse.Cx, other.Ellipse.Cy)) < minimumDistanceFromCenterRadiusFactor * e.Ellipse.B then
  90                                 other.Removed <- true
  91                             else
  92                                 // Case where ellipses are overlapped.
  93                                 match EEOver.EEOverlapArea e.Ellipse other.Ellipse with
  94                                 | Some (overlapArea, _, _) when e.Ellipse.Area < minimumAreaFactor * overlapArea || other.Ellipse.Area < minimumAreaFactor * overlapArea ->
  95                                     other.Removed <- true
  96                                 | _ ->
  97                                     ()
  98             ellipses
  99             |> List.ofSeq
 100             |> List.filter (fun e -> not e.Removed)
 101             |> List.sortWith (fun e1 e2 -> e2.MatchingScore.CompareTo e1.MatchingScore)
 102             |> List.map (fun e -> e.Ellipse)
 103