Move SSD group suppression to typed Kotlin

ober

67aaad272f9b218b3cb87d3794eaf13564f8ab81

diff --git a/templates/ssd-review.ss b/templates/ssd-review.ss
index 2809fb8..757f62d 100644
--- a/templates/ssd-review.ss
+++ b/templates/ssd-review.ss
@@ -331,6 +331,7 @@
                 SsdSession-suppressedGroups
                 SsdSession-ssdArea SsdSession-ssdArea-set!
                 ssdSessionCellInsideSsdArea ssdSessionGroupInsideSsdArea
+                ssdSessionSuppressedGroupPresent?
                 ssdSessionFindCellById ssdSessionRecomputeGroup
                 ssdSessionSetSsdArea ssdSessionPruneGroupsOutsideSsdArea
                 createManualCells
@@ -1603,6 +1604,76 @@
                           cy
                           (* (nearbyMaxFloat32 padX padY) (float32 1.5))))))))))))
 
+    (typed-kotlin-file "com/sfb/ssdreview/GroupSuppression.kt"
+      (typed-library (com sfb ssdreview)
+        (export suppressOverlappingCandidateGroups)
+        (type Float32)
+        (type Int32)
+        (def (suppressionMinFloat32 (a : Float32) (b : Float32)) : Float32
+          (if (< a b) a b))
+        (def (suppressionCandidateArea (candidate : SsdGroup)) : Float32
+          (let ((area (rectArea (SsdGroup-bbox candidate))))
+            (if (< area (float32 1.0)) (float32 1.0) area)))
+        (def (suppressionOverlapRatio (candidate : SsdGroup)
+                                      (reviewedGroup : SsdGroup)
+                                      (reviewedArea : Float32)) : Float32
+          (/ (rectOverlapArea (SsdGroup-bbox candidate) (SsdGroup-bbox reviewedGroup))
+             (suppressionMinFloat32
+               (suppressionCandidateArea candidate)
+               reviewedArea)))
+        (def (shouldSuppressOverlappingCandidate? (candidate : SsdGroup)
+                                                  (reviewedGroup : SsdGroup)
+                                                  (reviewedArea : Float32)) : Bool
+          (and (not (equal? (SsdGroup-id candidate) (SsdGroup-id reviewedGroup)))
+               (and (equal? (SsdGroup-status candidate) "candidate")
+                    (>= (suppressionOverlapRatio candidate reviewedGroup reviewedArea)
+                        (float32 0.70)))))
+        (def (overlappingCandidatesForSuppression (session : SsdSession)
+                                                  (reviewedGroup : SsdGroup)
+                                                  (reviewedArea : Float32)) : (MutableList SsdGroup)
+          (for/fold ((out (mutable-list-empty SsdGroup)))
+                    ((i (in-range (int32 0) (list-size (SsdSession-groups session)))))
+            (let ((candidate (list-ref (SsdSession-groups session) i)))
+              (if (shouldSuppressOverlappingCandidate? candidate reviewedGroup reviewedArea)
+                  (begin
+                    (mutable-list-add! out candidate)
+                    out)
+                  out))))
+        (def (suppressCandidateGroup! (session : SsdSession)
+                                      (reviewedGroup : SsdGroup)
+                                      (candidate : SsdGroup)) : Unit
+          (begin
+            (mutable-list-remove! (SsdSession-groups session) candidate)
+            (SsdGroup-status-set! candidate "suppressed")
+            (SsdGroup-notes-set!
+              candidate
+              (appendNote
+                (SsdGroup-notes candidate)
+                (string-append "Suppressed by reviewed " (SsdGroup-id reviewedGroup))))
+            (if (ssdSessionSuppressedGroupPresent? session (SsdGroup-id candidate))
+                (begin)
+                (mutable-list-add! (SsdSession-suppressedGroups session) candidate))))
+        (def (suppressOverlappingCandidateGroups (session : SsdSession)
+                                                 (reviewedGroup : SsdGroup)) : Int32
+          (let ((reviewedArea (rectArea (SsdGroup-bbox reviewedGroup))))
+            (if (<= reviewedArea (float32 0.0))
+                (int32 0)
+                (let ((removed
+                        (overlappingCandidatesForSuppression
+                          session
+                          reviewedGroup
+                          reviewedArea)))
+                  (begin
+                    (for/fold ((ignored (int32 0)))
+                              ((i (in-range (int32 0) (list-size removed))))
+                      (begin
+                        (suppressCandidateGroup!
+                          session
+                          reviewedGroup
+                          (list-ref removed i))
+                        ignored))
+                    (list-size removed))))))))
+
     (typed-kotlin-file "com/sfb/ssdreview/VisionPixels.kt"
       (typed-library (com sfb ssdreview)
         (export grayscale pixelsToRgba isColorMask looksLikeInk looksLikeBoxFill)
@@ -5294,12 +5365,14 @@
        "        for (i in 0 until groups.length()) {"
        "            val (group, truthCells) = ssdGroupFromTruthJson(groups.getJSONObject(i))"
        "            remapAndAddTruthCells(session, group, truthCells, cellIds)"
+       "            suppressOverlappingCandidateGroups(session, group)"
        "            session.groups.add(group)"
        "        }"
        "        val suppressed = truth.optJSONArray(\"suppressed_groups\") ?: JSONArray()"
        "        for (i in 0 until suppressed.length()) {"
        "            val (group, truthCells) = ssdGroupFromTruthJson(suppressed.getJSONObject(i))"
 	       "            remapAndAddTruthCells(session, group, truthCells, cellIds)"
+       "            suppressOverlappingCandidateGroups(session, group)"
 	       "            session.suppressedGroups.add(group)"
 	       "        }"
 	      "        ssdSessionPruneGroupsOutsideSsdArea(session)"