R/figure_manual_extraction.R

In metagear: Comprehensive Research Synthesis Tools for Systematic Reviews and Meta-Analysis

#' Manually extract information from plot figure.
#'
#' Allows for the user to manually add an unlimited number of points to a
#' figure image, by left-clicking over a figure/image point.  Click on the red
#' upper-right box called "EXIT" to end recording the position of manually
#' detected points.
#'
#' @param file The file name and location of a figure.  Prompts for file name
#'    if none is explicitly called.  Can also be a binary figure image with
#'    detected points (an \code{EBImage} object). See: \code{\link{figure_detectAllPoints}}
#' @param color The color to paint the manually detected points; default is
#'    green.
#' @param size The radius of the painted points.
#'
#' @return A data frame with detected points.
#'
#' @seealso \link{figure_detectAllPoints}
#'
#' @import grid
#' @importFrom grDevices rgb col2rgb
#' @export

figure_add <- function (file = file.choose(),
                        color = "#009900",
                        size = 0.03) {

  # if EBImage not installed, do it
  .metagearDependencies("EBImage")

  # set up grid window
  grid.newpage()
  vp <- viewport(xscale = c(0, 1), yscale = c(0, 1))
  pushViewport(vp)

  # plot figure image on vp
  grid.raster(ifelse(class(file) == "Image", file, EBImage::readImage(file)))

  # plot exit box on figure
  grid.rect(x = 0.05,
            y = 0.95,
            width = 0.1,
            height = 0.1,
            gp = gpar(fill = "red", col = "red", alpha = 0.3))
  grid.text(x = 0.05,
            y = 0.95,
            "EXIT",
            gp = gpar(fontface = "bold"))

  # extract click coordinates and plot click-marker circles
  newPoints <- 0

  # capture click events and keep track of [x,y] location
  repeat{

    #get click x and y location
    click.loc <- grid.locator()

    if(newPoints == 0) {
      theCoordinates <- matrix(c(unitTrim(click.loc$x), unitTrim(click.loc$y)),
                               ncol = 2,
                               byrow = TRUE)
    } else {
      theCoordinates <- rbind(theCoordinates,
                              matrix(c(unitTrim(click.loc$x), unitTrim(click.loc$y)),
                                     ncol = 2,
                                     byrow = TRUE))
    }
    # keep track of clicked points
    newPoints <- newPoints + 1

    # exit manual detection when user clicks within EXIT box region
    if(unitTrim(click.loc$x) < unitTrim(unit(0.1,"native")) &
         unitTrim(click.loc$y) > unitTrim(unit(0.9,"native"))) {
      # delete last 'exit' click
      theCoordinates <- theCoordinates[-nrow(theCoordinates), ]
      break;
    }

    # paint the figure with a marker circle at the clicked location
    theColor <- rgb(t(col2rgb(color)), maxColorValue = 255)
    grid.circle(x = click.loc$x,
                y = click.loc$y,
                r = size,
                gp=gpar(col = theColor,
                        fill = theColor,
                        alpha = 0.3))
    grid.circle(x = click.loc$x,
                y = click.loc$y,
                r = 0.003,
                gp=gpar(col = theColor,
                        fill = theColor))

  }

  # organize the coordinates of clicked points in a data frame
  theCoordinates <- data.frame(theCoordinates)
  colnames(theCoordinates) <- c("x","y")
  theCoordinates["cluster"] <- "manual"

  return(theCoordinates)
}