From 64584c9c5c2202617d4a9311dbcb914e99e9de27 Mon Sep 17 00:00:00 2001
From: Athos Damiani <athos.damiani@gmail.com>
Date: Sun, 28 Feb 2021 16:10:08 -0300
Subject: [PATCH 1/5] extensions

---
 R/extension.R | 13 +++++++++++++
 1 file changed, 13 insertions(+)
 create mode 100644 R/extension.R

diff --git a/R/extension.R b/R/extension.R
new file mode 100644
index 0000000..e4ac692
--- /dev/null
+++ b/R/extension.R
@@ -0,0 +1,13 @@
+has_ops <- function() {
+  not_implemented_error("has_ops() Not implemented yet. https://github.com/pytorch/vision/blob/b266c2f1a5c10f5caf22f5aea7418acc392a5075/torchvision/extension.py#L60")
+}
+
+assert_has_ops <- function() {
+  if(!has_ops()) {
+    runtime_error(
+      "Couldn't load custom C++ ops. This can happen if your torch and torchvision
+       versions are incompatible, or if you had errors while compiling torchvision
+       from source. Please reinstall torchvision so that it matches your torch install."
+    )
+  }
+}

From 7d0ba3e63e4dbc5dbcf6f70eccfa35612055e2df Mon Sep 17 00:00:00 2001
From: Athos Damiani <athos.damiani@gmail.com>
Date: Sun, 28 Feb 2021 16:10:17 -0300
Subject: [PATCH 2/5] box_convert

---
 R/ops-box_convert.R | 74 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 74 insertions(+)
 create mode 100644 R/ops-box_convert.R

diff --git a/R/ops-box_convert.R b/R/ops-box_convert.R
new file mode 100644
index 0000000..29bf678
--- /dev/null
+++ b/R/ops-box_convert.R
@@ -0,0 +1,74 @@
+#' box_cxcywh_to_xyxy
+#'
+#' Converts bounding boxes from  (cx, cy, w, h) format to (x1, y1, x2, y2) format.
+#'  (cx, cy) refers to center of bounding box
+#'  (w, h) are width and height of bounding box
+#'
+#' @param boxes  (Tensor[N, 4]): boxes in (cx, cy, w, h) format which will be converted.
+#'
+#' @return boxes (Tensor(N, 4)): boxes in (x1, y1, x2, y2) format.
+box_cxcywh_to_xyxy <- function(boxes) {
+  # We need to change all 4 of them so some temporary variable is needed.
+  c(cx, cy, w, h) %<-% boxes$unbind(-1)
+  x1 = cx - 0.5 * w
+  y1 = cy - 0.5 * h
+  x2 = cx + 0.5 * w
+  y2 = cy + 0.5 * h
+
+  boxes = torch::torch_stack(list(x1, y1, x2, y2), dim=-1)
+
+  return(boxes)
+}
+
+#' box_xyxy_to_cxcywh
+#'
+#' Converts bounding boxes from  (x1, y1, x2, y2) format to (cx, cy, w, h) format.
+#'  (x1, y1) refer to top left of bounding box
+#'  (x2, y2) refer to bottom right of bounding box
+#'
+#'  @param boxes  (Tensor[N, 4]): boxes in (x1, y1, x2, y2) format which will be converted.
+#'
+#' @return boxes (Tensor(N, 4)): boxes in (cx, cy, w, h) format.
+box_xyxy_to_cxcywh <- function(boxes) {
+  c(x1, y1, x2, y2) %<-% boxes$unbind(-1)
+  cx = (x1 + x2) / 2
+  cy = (y1 + y2) / 2
+  w = x2 - x1
+  h = y2 - y1
+
+  boxes = torch::torch_stack(list(cx, cy, w, h), dim=-1)
+
+  return(boxes)
+}
+
+#' box_xywh_to_xyxy
+#'
+#' Converts bounding boxes from  (x, y, w, h) format to (x1, y1, x2, y2) format.
+#' (x, y) refers to top left of bouding box.
+#' (w, h) refers to width and height of box.
+#'
+#' @param boxes  (Tensor[N, 4]): boxes in (x, y, w, h) which will be converted.
+#'
+#' @return boxes (Tensor[N, 4]): boxes in (x1, y1, x2, y2) format.
+box_xywh_to_xyxy <- function(boxes) {
+  c(x, y, w, h) %<-% boxes$unbind(-1)
+  boxes = torch::torch_stack(list(x, y, x + w, y + h), dim=-1)
+  return(boxes)
+}
+
+#' box_xyxy_to_xywh
+#'
+#' Converts bounding boxes from  (x1, y1, x2, y2) format to (x, y, w, h) format.
+#' (x1, y1) refer to top left of bounding box
+#' (x2, y2) refer to bottom right of bounding box
+#'
+#' @param boxes  (Tensor[N, 4]): boxes in (x1, y1, x2, y2) which will be converted.
+#'
+#' @return boxes (Tensor[N, 4]): boxes in (x, y, w, h) format.
+box_xyxy_to_xywh <- function(boxes) {
+  c(x1, y1, x2, y2) %<-% boxes$unbind(-1)
+  w = x2 - x1 # x2 - x1
+  h = y2 - y1 # y2 - y1
+  boxes = torch::torch_stack(list(x1, y1, w, h), dim=-1)
+  return(boxes)
+}

From 1b648edcd2ff7561f75580f05e613dc8be739f03 Mon Sep 17 00:00:00 2001
From: Athos Damiani <athos.damiani@gmail.com>
Date: Sun, 28 Feb 2021 16:10:28 -0300
Subject: [PATCH 3/5] boxes

---
 R/ops-boxes.R | 266 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 266 insertions(+)
 create mode 100644 R/ops-boxes.R

diff --git a/R/ops-boxes.R b/R/ops-boxes.R
new file mode 100644
index 0000000..e898e8e
--- /dev/null
+++ b/R/ops-boxes.R
@@ -0,0 +1,266 @@
+#' Non-maximum Suppression (NMS)
+#'
+#' Performs non-maximum suppression  (NMS) on the boxes according
+#' to their intersection-over-union  (IoU). NMS iteratively removes
+#' lower scoring boxes which have an IoU greater than iou_threshold
+#' with another (higher scoring) box.
+#'
+#' @param boxes  (Tensor[N, 4])): boxes to perform NMS on. They are
+#' expected to be in `` (x1, y1, x2, y2)`` format with
+#' ``0 <= x1 < x2`` and ``0 <= y1 < y2``.
+#' @param scores (Tensor[N]): scores for each one of the boxes
+#' @param iou_threshold  (float): discards all overlapping boxes with IoU > iou_threshold
+#'
+#' @details
+#'    If multiple boxes have the exact same score and satisfy the IoU
+#'    criterion with respect to a reference box, the selected box is
+#'    not guaranteed to be the same between CPU and GPU. This is similar
+#'    to the behavior of argsort in torch when repeated values are present.
+#'
+#' @return keep (Tensor): int64 tensor with the indices of the elements that
+#'  have been kept by NMS, sorted in decreasing order of scores.
+#'
+#' @export
+nms <- function(boxes, scores, iou_threshold) {
+  assert_has_ops()
+  return(torch_nms(boxes, scores, iou_threshold))
+}
+
+#' Batched Non-maximum Suppression (NMS)
+#'
+#'    Performs non-maximum suppression in a batched fashion.
+#'    Each index value correspond to a category, and NMS
+#'    will not be applied between elements of different categories.
+#'
+#' @param boxes (Tensor[N, 4]): boxes where NMS will be performed. They are expected to be
+#'  in `` (x1, y1, x2, y2)`` format with ``0 <= x1 < x2`` and ``0 <= y1 < y2``.
+#' @param scores  (Tensor[N]): scores for each one of the boxes
+#' @param idxs  (Tensor[N]): indices of the categories for each one of the boxes.
+#' @param iou_threshold  (float): discards all overlapping boxes with IoU > iou_threshold
+#'
+#'
+#' @return keep (Tensor): int64 tensor with the indices of
+#' the elements that have been kept by NMS, sorted
+#' in decreasing order of scores
+#'
+#' @export
+batched_nms <- function(
+  boxes,
+  scores,
+  idxs,
+  iou_threshold
+) {
+  boxes_dtype = boxes$dtype
+  boxes_device = boxes$device
+
+  # strategy: in order to perform NMS independently per class.
+  # we add an offset to all the boxes. The offset is dependent
+  # only on the class idx, and is large enough so that boxes
+  # from different classes do not overlap
+
+    if(boxes$numel() == 0) {
+      return(torch::torch_empty(0, dtype=torch::torch_int64(), device = boxes_device))
+    } else {
+      max_coordinate = boxes$max()
+      offsets = idxs$to(device = boxes_device, dtype = boxes_dtype) * (max_coordinate + torch::torch_tensor(1)$to(device = boxes_device, dtype = boxes_dtype))
+      boxes_for_nms = boxes + offsets[, NULL]
+      keep = nms(boxes_for_nms, scores, iou_threshold)
+      return(keep)
+    }
+}
+
+#' Remove Small Boxes
+#'
+#' Remove boxes which contains at least one side smaller than min_size.
+#'
+#' @param boxes  (Tensor[N, 4]): boxes in ``(x1, y1, x2, y2)`` format
+#'  with ``0 <= x1 < x2`` and ``0 <= y1 < y2``.
+#' @param min_size  (float): minimum size
+#'
+#' @return keep (Tensor[K]): indices of the boxes that have both sides
+#'  larger than min_size
+#'
+#' @export
+remove_small_boxes <- function(boxes, min_size) {
+  c(ws, hs) %<-% c(boxes[, 3] - boxes[, 1], boxes[, 4] - boxes[, 2])
+  keep = (ws >= min_size) & (hs >= min_size)
+  keep = torch::torch_where(keep)[[1]]
+  return(keep)
+}
+
+#' Clip Boxes to Image
+#'
+#' Clip boxes so that they lie inside an image of size `size`.
+#'
+#' @param boxes  (Tensor[N, 4]): boxes in ``(x1, y1, x2, y2)`` format
+#' with ``0 <= x1 < x2`` and ``0 <= y1 < y2``.
+#' @param size  (Tuple[height, width]): size of the image
+#'
+#' @return clipped_boxes (Tensor[N, 4])
+#'
+#' @export
+clip_boxes_to_image <- function(boxes, size) {
+  dim = boxes$dim()
+  boxes_x = boxes[.., seq(1, boxes$shape[2], 2)]
+  boxes_y = boxes[.., seq(2, boxes$shape[2], 2)]
+  c(height, width) %<-% size
+
+  # if(torchvision$_is_tracing()) {
+  #   boxes_x = torch::torch_max(boxes_x, other = torch::torch_tensor(0, dtype=boxes$dtype, device=boxes$device))
+  #   boxes_x = torch::torch_min(boxes_x, other = torch::torch_tensor(width, dtype=boxes$dtype, device=boxes$device))
+  #   boxes_y = torch::torch_max(boxes_y, other = torch::torch_tensor(0, dtype=boxes$dtype, device=boxes$device))
+  #   boxes_y = torch::torch_min(boxes_y, other = torch::torch_tensor(height, dtype=boxes$dtype, device=boxes$device))
+  # } else {
+  boxes_x = boxes_x$clamp(min=0, max=width)
+  boxes_y = boxes_y$clamp(min=0, max=height)
+
+  clipped_boxes = torch::torch_stack(c(boxes_x, boxes_y), dim=dim+1)
+  return(clipped_boxes$reshape(boxes$shape))
+}
+
+#' Box Convert
+#'
+#'  Converts boxes from given in_fmt to out_fmt.
+#'
+#' @param boxes  (Tensor[N, 4]): boxes which will be converted.
+#' @param in_fmt  (str): Input format of given boxes. Supported formats are ['xyxy', 'xywh', 'cxcywh'].
+#' @param out_fmt  (str): Output format of given boxes. Supported formats are ['xyxy', 'xywh', 'cxcywh']
+#' @return boxes (Tensor[N, 4]): Boxes into converted format.
+#'
+#' @details
+#' Supported in_fmt and out_fmt are:
+#'  'xyxy': boxes are represented via corners, x1, y1 being top left and x2, y2 being bottom right.
+#'  'xywh' : boxes are represented via corner, width and height, x1, y2 being top left, w, h being width and height.
+#'  'cxcywh' : boxes are represented via centre, width and height, cx, cy being center of box, w, h
+#'  being width and height.
+#'
+#' @export
+box_convert <- function(boxes, in_fmt, out_fmt) {
+  allowed_fmts = c("xyxy", "xywh", "cxcywh")
+  if((!in_fmt %in% allowed_fmts) | (!out_fmt %in% allowed_fmts))
+    value_error("Unsupported Bounding Box Conversions for given in_fmt and out_fmt")
+
+  if(in_fmt == out_fmt)
+    return(boxes$clone())
+
+  if(in_fmt != 'xyxy' & out_fmt != 'xyxy') {
+    # convert to xyxy and change in_fmt xyxy
+    if(in_fmt == "xywh") {
+      boxes = box_xywh_to_xyxy(boxes)
+    } else if(in_fmt == "cxcywh") {
+      boxes = box_cxcywh_to_xyxy(boxes)
+    }
+    in_fmt = 'xyxy'
+  }
+  if(in_fmt == "xyxy") {
+    if(out_fmt == "xywh") {
+      boxes = box_xyxy_to_xywh(boxes)
+    } else if(out_fmt == "cxcywh") {
+      boxes = box_xyxy_to_cxcywh(boxes)
+    }
+  } else if(out_fmt == "xyxy") {
+    if(in_fmt == "xywh") {
+      boxes = box_xywh_to_xyxy(boxes)
+    } else if(in_fmt == "cxcywh") {
+      boxes = box_cxcywh_to_xyxy(boxes)
+    }
+  }
+  return(boxes)
+}
+
+upcast <- function(t) {
+  t_dtype <- as.character(t$dtype)
+  # Protects from numerical overflows in multiplications by upcasting to the equivalent higher type
+  if(t$is_floating_point()) {
+    return(if(t_dtype %in% c("Float", "Double")) t else t$to(device = torch::torch_float()))
+  } else {
+    return(if(t_dtype %in% c("Int", "Long")) t else t$to(device = torch::torch_int()))
+  }
+}
+
+#' Box Area
+#'
+#' Computes the area of a set of bounding boxes, which are specified by its
+#' (x1, y1, x2, y2) coordinates.
+#'
+#' @param boxes  (Tensor[N, 4]): boxes for which the area will be computed. They
+#' are expected to be in  (x1, y1, x2, y2) format with ``0 <= x1 < x2`` and ``0 <= y1 < y2``.
+#'
+#' @return area (Tensor[N]): area for each box
+#'
+#' @export
+box_area <- function(boxes) {
+  boxes = upcast(boxes)
+  return((boxes[, 3] - boxes[, 1]) * (boxes[, 4] - boxes[, 2]))
+}
+
+box_inter_union <- function(boxes1, boxes2) {
+  # implementation from https://github.com/kuangliu/torchcv/blob/master/torchcv/utils/box.py
+  # with slight modifications
+  area1 = box_area(boxes1)
+  area2 = box_area(boxes2)
+
+  lt = torch::torch_max(boxes1[, NULL, 1:2], other = boxes2[, 1:2]) # [N,M,2]
+  rb = torch::torch_min(boxes1[, NULL, 3:N], other = boxes2[, 3:N]) # [N,M,2]
+
+  wh = upcast(rb - lt)$clamp(min=0) # [N,M,2]
+  inter = wh[, , 1] * wh[, , 2] # [N,M]
+
+  union = area1[, NULL] + area2 - inter
+
+  return(list(inter, union))
+}
+
+#' Box IoU
+#'
+#' Return intersection-over-union  (Jaccard index) of boxes.
+#' Both sets of boxes are expected to be in `` (x1, y1, x2, y2)`` format with
+#' ``0 <= x1 < x2`` and ``0 <= y1 < y2``.
+#'
+#' @param boxes1  (Tensor[N, 4])
+#' @param boxes2  (Tensor[M, 4])
+#'
+#' @return iou (Tensor[N, M]): the NxM matrix containing the pairwise IoU values for every element in boxes1 and boxes2
+#'
+#' @export
+box_iou <- function(boxes1, boxes2) {
+    c(inter, union) %<-% box_inter_union(boxes1, boxes2)
+    iou = inter / union
+    return(iou)
+}
+
+#' Generalized Box IoU
+#'
+#' Return generalized intersection-over-union  (Jaccard index) of boxes.
+#' Both sets of boxes are expected to be in `` (x1, y1, x2, y2)`` format with
+#' ``0 <= x1 < x2`` and ``0 <= y1 < y2``.
+#'
+#' @param boxes1  (Tensor[N, 4])
+#' @param boxes2  (Tensor[M, 4])
+#'
+#' @details
+#' Implementation adapted from https://github.com/facebookresearch/detr/blob/master/util/box_ops.py
+#'
+#' @return generalized_iou (Tensor[N, M]): the NxM matrix containing the pairwise generalized_IoU values
+#'        for every element in boxes1 and boxes2
+#'
+#' @export
+generalized_box_iou <- function(boxes1, boxes2) {
+  # degenerate boxes gives inf / nan results
+  # so do an early check
+  if(as.numeric((boxes1[, 3:N] >= boxes1[, 1:2])$all()) != 1)
+    value_error("(boxes1[, 3:N] >= boxes1[, 1:2])$all() not TRUE")
+  if(as.numeric((boxes2[, 3:N] >= boxes2[, 1:2])$all()) != 1)
+    value_error("(boxes2[, 3:N] >= boxes2[, 1:2])$all() not TRUE")
+
+  c(inter, union) %<-% box_inter_union(boxes1, boxes2)
+  iou = inter / union
+
+  lti = torch::torch_min(boxes1[, NULL, 1:2], other = boxes2[, 1:2])
+  rbi = torch::torch_max(boxes1[, NULL, 3:N], other = boxes2[, 3:N])
+
+  whi = upcast(rbi - lti)$clamp(min=0) # [N,M,2]
+  areai = whi[, , 1] * whi[, , 2]
+
+  return(iou - (areai - union) / areai)
+}

From 2a036c9225efd9f1eac43a41da173bf61fbab8d6 Mon Sep 17 00:00:00 2001
From: Athos Damiani <athos.damiani@gmail.com>
Date: Sun, 28 Feb 2021 16:10:38 -0300
Subject: [PATCH 4/5] tests

---
 tests/testthat/test-ops-box_convert.R | 17 +++++++++
 tests/testthat/test-ops-boxes.R       | 51 +++++++++++++++++++++++++++
 2 files changed, 68 insertions(+)
 create mode 100644 tests/testthat/test-ops-box_convert.R
 create mode 100644 tests/testthat/test-ops-boxes.R

diff --git a/tests/testthat/test-ops-box_convert.R b/tests/testthat/test-ops-box_convert.R
new file mode 100644
index 0000000..7924984
--- /dev/null
+++ b/tests/testthat/test-ops-box_convert.R
@@ -0,0 +1,17 @@
+x1 = torch::torch_ones(5)
+y1 = torch::torch_ones(5)
+x2 = x1 + 1
+y2 = y1 + 1
+xyxy = torch::torch_stack(list(x1,y1,x2,y2))$transpose(2,1)
+
+test_that("box_cxcywh_to_xyxy box_xyxy_to_cxcywh box_xywh_to_xyxy box_xyxy_to_xywh", {
+  # from xyxy
+  cxcywh <- box_cxcywh_to_xyxy(box_xyxy_to_cxcywh(xyxy))
+  xywh <- box_xywh_to_xyxy(box_xyxy_to_xywh(xyxy))
+
+  expect_tensor(cxcywh)
+  expect_tensor(xywh)
+  expect_equal(torch::as_array(cxcywh), torch::as_array(xyxy))
+  expect_equal(torch::as_array(xywh), torch::as_array(xyxy))
+})
+
diff --git a/tests/testthat/test-ops-boxes.R b/tests/testthat/test-ops-boxes.R
new file mode 100644
index 0000000..96c5577
--- /dev/null
+++ b/tests/testthat/test-ops-boxes.R
@@ -0,0 +1,51 @@
+x1 = torch::torch_ones(5)
+y1 = torch::torch_ones(5)
+x2 = x1 + 1
+y2 = y1 + 1
+boxes = torch::torch_stack(list(x1,y1,x2,y2))$transpose(2,1)
+
+test_that("batched_nms", {
+  expect_no_error(
+    x <- batched_nms(
+      boxes = boxes,
+      scores = torch::torch_ones(5)*0.6,
+      idxs = torch::torch_ones(5),
+      iou_threshold = 0.5
+    )
+  )
+  expect_tensor(x)
+})
+
+test_that("remove_small_boxes", {
+  expect_no_error(x <- remove_small_boxes(boxes, 1))
+  expect_tensor(x)
+})
+
+test_that("clip_boxes_to_image", {
+  expect_no_error(x <- clip_boxes_to_image(boxes, c(10,10)))
+  expect_tensor(x)
+})
+
+test_that("box_convert", {
+  xyxy <- boxes
+  xywh <- box_convert(xyxy, "xyxy", "xywh")
+  cxcywh <- box_convert(xyxy, "xyxy", "cxcywh")
+
+  expect_tensor(xywh)
+  expect_tensor(cxcywh)
+})
+
+test_that("box_area", {
+  area_6 <- torch::torch_tensor(matrix(c(0,0,2,3), 1, 4))
+  expect_no_error(x <- box_area(area_6))
+  expect_equal_to_r(x, 6)
+})
+
+test_that("box_iou", {
+  expect_no_error(x <- box_iou(boxes, boxes))
+  expect_tensor(x)
+
+  expect_no_error(x <- generalized_box_iou(boxes, boxes))
+  expect_tensor(x)
+})
+

From e72872ad6f9ee200fbad968fc901c7fcef9b01d7 Mon Sep 17 00:00:00 2001
From: Athos Damiani <athos.damiani@gmail.com>
Date: Mon, 1 Mar 2021 18:17:24 -0300
Subject: [PATCH 5/5] prefix torch::

---
 R/ops-boxes.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/ops-boxes.R b/R/ops-boxes.R
index e898e8e..9265008 100644
--- a/R/ops-boxes.R
+++ b/R/ops-boxes.R
@@ -23,7 +23,7 @@
 #' @export
 nms <- function(boxes, scores, iou_threshold) {
   assert_has_ops()
-  return(torch_nms(boxes, scores, iou_threshold))
+  return(torch::torch_nms(boxes, scores, iou_threshold))
 }
 
 #' Batched Non-maximum Suppression (NMS)