R/AcuityView.R

In AcuityView: A Package for Displaying Visual Scenes as They May Appear to an Animal with Lower Acuity

#'AcuityView
#'
#'This function provides a simple method for displaying a visual scene as it may appear to an animal with lower acuity.
#'@param photo The photo you wish to alter; if NULL then a pop up window allows you to navigate to your photo, otherwise include the file path here
#'@param distance The distance from the viewer to the object of interest in the image; can be in any units so long as it is in the same units as RealWidth
#'@param realWidth The real width of the entire image; can be in any units as long as it is in the same units as distance 
#'@param eyeResolutionX The resolution of the viewer in degrees
#'@param eyeResolutionY The resolution of the viewer in the Y direction, if different than ResolutionX; defaults to NULL, as it is uncommon for this to differ from eyeResolutionX
#'@param plot Whether to plot the final image; defaults to T
#'@param output The name of the output file, must be in the format of output="image_name.filetype";
#'acceptable filetypes are .bmp, .png, or .jpeg
#'@return Returns an image in the specified format
#'@section Image Format Requirements: Image must be in 3-channel format, either PNG, JPEG or BMP.
#'Note: some PNG files have an alpha channel that makes them 4-channel images; this will not work with the code.
#'The image must be 3-channel.
#'@section Image size: Image must be square with each side a power of 2 pixels.
#'Example: 512x512, 1024 x 1024, 2048 x 2048 pixels
#'@section For Linux Users: You may need to install the fftw library in order for the R package "fftwtools"
#'to install and perform correctly.
#'The FFTW website and install information can be found here: http://www.fftw.org/
#'This library can easily be installed on Ubuntu with: apt-get install fftw3-dev
#'@importFrom grDevices dev.list dev.new dev.off png
#'@importFrom graphics par rasterImage
#'@importFrom tools file_ext
#'@importFrom imager load.image imsplit
#'@importFrom plotrix rescale
#'@importFrom fftwtools fftw2d
#'@importFrom grid grid.raster
#'@examples
#'\dontrun{
#'require(imager)
#'photo <- system.file("extdata/reef.bmp", package = "AcuityView")
#'reef <- load.image(photo)
#'AcuityView(photo = reef, distance = 2, realWidth = 2,
#'           eyeResolutionX = 2, eyeResolutionY = NULL,
#'           plot = TRUE,
#'           output = file.path(tempdir(), "Example.jpeg"))
#'}
#'@export

AcuityView <- function(photo = NULL,
                       distance = 2,
                       realWidth = 2,
                       eyeResolutionX = 0.2,
                       eyeResolutionY = NULL,
                       plot = TRUE,
                       output = NULL) {
  
  # Load the image.  The image must be a 3-channel image.
  if (is.null(photo)) {
    photo <- file.choose()
    image <- load.image(photo)
  } else {
    image <- photo
  }
  if (missing(image)) stop("Failed to load the image file")
  
  # ---- CRAN FIX Jan 28 2026: ensure output is written outside the check directory ----
  if (is.null(output)) {
    output_path <- file.path(tempdir(), "AcuityView_output.jpg")
  } else {
    if (!is.character(output)) stop("Output file must be a character string!")
    if (!grepl(.Platform$file.sep, output)) {
      output_path <- file.path(tempdir(), output)
    } else {
      output_path <- output
    }
  }
  
  # Check that a correct output format is provided
  if (!is.element(file_ext(output_path), c("png", "bmp", "jpeg", "jpg"))) {
    stop("Output file must be png, bmp, or jpeg format!")
  }
  
  # Get image dimensions
  dimensions <- dim(image)
  
  # Check to make sure dimensions are a power of two or give error
  if (!is.element(dimensions[1], 2^c(1:100)) ||
      !is.element(dimensions[2], 2^c(1:100))) {
    stop("Image dimensions must be a power of 2!!!")
  }
  
  # Plot the image if required
  if (plot && interactive()) {
    Devices <- dev.list()
    if (length(Devices)) for (i in Devices) dev.off(i)
    dev.new(width = 7, height = 4)
    par(mfrow = c(1, 2), mar = c(1, 0.1, 2, 0.1))
    plot(image, axes = FALSE, ylab = "", xlab = "", main = "Before")
  }
  
  #  If the X and Y resolutions differ, check here
  if (is.null(eyeResolutionY)) eyeResolutionY <- eyeResolutionX
  
  # Calculate the image width in degrees
  widthInDegrees <- 57.2958 * (2 * atan(realWidth / distance / 2))
  
  # Extract image width in pixels
  widthInPixels <- dimensions[2]
  
  # Calculate the center of the image
  center <- round(widthInPixels / 2) + 1
  pixelsPerDegree <- widthInPixels / widthInDegrees
  
  # Create a blur matrix, with the same dimensions as the image
  # Each element is based on the resolution of the eye, distance to the viewer,
  # and size of the image. See main text for more details
  blur <- matrix(NA, nrow = widthInPixels, ncol = widthInPixels)
  for (i in 1:widthInPixels) {
    for (j in 1:widthInPixels) {
      x <- i - center
      y <- j - center
      denom <- sqrt(x^2 + y^2)
      if (denom == 0) {
        blur[i, j] <- 1
      } else {
        freq <- round(denom) / widthInPixels * pixelsPerDegree
        mySin <- y / denom
        myCos <- x / denom
        eyeResolution <- eyeResolutionX * eyeResolutionY /
          sqrt((eyeResolutionY * myCos)^2 + (eyeResolutionX * mySin)^2)
        blur[i, j] <- exp(-3.56 * (eyeResolution * freq)^2)
      }
    }
  }
  
  # Convert the original 3 color channels into linear RGB space
  # as opposed to sRGB space, which is how color images are usually encoded.
  splitimage <- imsplit(image, "c")
  
  # Convert the data from matrix into array form
  array <- array(NA, dim = c(widthInPixels^2, length(splitimage)))
  for (i in 1:length(splitimage)) {
    matrix <- as.matrix(splitimage[[i]])
    vector <- as.vector(rescale(matrix, newrange = c(0, 1)))
    array[, i] <- vector
  }
  
  # Convert red, green, and blue to linearized values
  linearized_values <- array(NA, dim = c(widthInPixels, widthInPixels, 3))
  a <- 0.055
  
  for (i in 1:3) {
    vals <- array[, i]
    lin <- ifelse(vals <= 0.04045,
                  vals / 12.92,
                  ((vals + a) / (1 + a))^2.4)
    dim(lin) <- dim(splitimage[[i]])
    linearized_values[, , i] <- lin
  }
  
  # Perform the 2-D Fourier Transform, blur matrix multiplication
  # and inverse fourier transform on the linearized color values
  final <- array(NA, dim = dim(linearized_values))
  for (i in 1:3) {
    matrix <- linearized_values[, , i]
    fft <- (1 / widthInPixels) * fft_matrix_shift(fftw2d(matrix))
    transform <- fft * blur
    ifft <- (1 / widthInPixels) * fftw2d(transform, inverse = TRUE)
    final[, , i] <- Mod(ifft)
  }
  
  # Transform the colors back into sRGB space
  sRGB_values <- array(NA, dim = dim(final))
  for (i in 1:3) {
    vals <- as.vector(final[, , i])
    srgb <- ifelse(vals < 0.0031308,
                   vals * 12.92,
                   (1 + a) * vals^(1 / 2.4) - a)
    dim(srgb) <- dim(splitimage[[i]])
    sRGB_values[, , i] <- srgb
  }
  
  # Rescale the sRGB values for display
  for (i in 1:3) {
    if (max(sRGB_values[, , i]) > 1) {
      sRGB_values[, , i] <- rescale(
        sRGB_values[, , i],
        newrange = c(min(sRGB_values[, , i]), 1)
      )
    }
  }
  
  # Create final RGB matrix for plotting
  rgbmatrix <- array(NA, dim = dim(sRGB_values))
  rgbmatrix[, , 1] <- t(sRGB_values[, , 1])
  rgbmatrix[, , 2] <- t(sRGB_values[, , 2])
  rgbmatrix[, , 3] <- t(sRGB_values[, , 3])
  
  # Save output file in the provided format
  png(filename = output_path,
      width = dimensions[2],
      height = dimensions[2],
      units = "px")
  grid.raster(rgbmatrix, interpolate = FALSE)
  dev.off()
  
  # Display the final image if requested
  if (plot && interactive()) {
    plot(c(0, ncol(rgbmatrix)), c(0, nrow(rgbmatrix)),
         type = "n", axes = FALSE, main = "After")
    rasterImage(rgbmatrix, 1, 1,
                ncol(rgbmatrix), nrow(rgbmatrix),
                interpolate = FALSE)
  }
  
  message("The results are complete. The output file has been saved to ",
          normalizePath(output_path, winslash = "/", mustWork = FALSE))
  
  invisible(output_path)
}