#'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, but if F, the final image will still be saved to your working directory
#'@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
#'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="Example.jpeg")
#'@export
AcuityView <- function(photo = NULL, distance = 2, realWidth = 2, eyeResolutionX = 0.2, eyeResolutionY = NULL, plot = T, output="test.jpg"){
# Load the image. The image must be a 3-channel image.
if (is.null(photo)) {
photo = file.choose()
#if (!is.element(file_ext(photo), c("png", "bmp", "jpeg", "jpg"))) stop("Input file must be png, bmp, or jpeg format!")
image <- load.image(photo)
} else {
#if (!is.element(file_ext(photo), c("png", "bmp", "jpeg", "jpg"))) stop("Input file must be png, bmp, or jpeg format!")
image<-photo
#image <- load.image(photo)
}
if (missing(image)) stop("Failed to load the image file")
# Check that a correct output format is provided
if (!is.character(output)) stop("Output file must be a character string!")
if (!is.element(file_ext(output), 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) {
Devices = dev.list()
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
freq <- round(sqrt(x^2 + y^2)) / widthInPixels * pixelsPerDegree
mySin <- y / sqrt(x^2 + y^2)
myCos <- x / sqrt(x^2 + y^2)
eyeResolution <- eyeResolutionX * eyeResolutionY /sqrt((eyeResolutionY * myCos)^2 +(eyeResolutionX * mySin)^2)
blur[i,j] <- exp(-3.56 * (eyeResolution * freq)^2)
}
}
# Define the center pixel to have a value of 1
blur[center, center] = 1
blur<<-blur
# Convert the original 3 color channels into linear RGB space
# as opposed to sRGB space, which is how color images are usually encoded.
# Each color channel must be linearized separately.
splitimage <- imsplit(image,"c")
channel <- splitimage[[1]][,]
# 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
# Begin by creating an empty array for your linearized values
linearized_values <- array(NA, dim = c(widthInPixels, widthInPixels, 3))
dim_array <- dim(array)
# Define the variable "a" for use in converting values to linearized color space
a <- 0.055
# To find the equations for converting to linearized space,
# see main text or: https://en.wikipedia.org/wiki/SRGB
# Specifically, the section entitled "The reverse transformation."
# Linearize the red color channel
redlinear <- array(NA, dim = c(dim_array[1], 1))
for (i in 1:dim_array[1]){
if (array[i,1] <= 0.04045){
redlinear[i] <- (array[i,1] / 12.92)
} else {
redlinear[i] <- ((array[i,1] + a) /(1 + a))^2.4
}}
dim(redlinear) <- dim(splitimage[[1]])
linearized_values[,,1] <- redlinear
#red_linearized_values<<-linearized_values[,,1]
# Linearize the green color channel
greenlinear <- array(NA, dim = c(dim_array[1], 1))
for (i in 1:dim_array[1]){
if (array[i,2] <= 0.04045){
greenlinear[i] <- (array[i,2] / 12.92)
} else {
greenlinear[i] <- ((array[i,2] + a)/(1 + a))^2.4
}
}
dim(greenlinear) <- dim(splitimage[[2]])
linearized_values[,,2] <- greenlinear
#green_linearized_values<<-linearized_values[,,2]
# Linearize the blue color channel
bluelinear <- array(NA, dim = c(dim_array[1], 1))
for (i in 1:dim_array[1]){
if (array[i,3] <= 0.04045){
bluelinear[i] <- (array[i,3]/12.92)
} else {
bluelinear[i] <- ((array[i,3] + a) / (1 + a))^2.4
}
}
dim(bluelinear) <- dim(splitimage[[3]])
linearized_values[,,3] <- bluelinear
#blue_linearized_values<<-linearized_values[,,3]
# Perform the 2-D Fourier Transform, blur matrix multiplication
# and inverse fourier transform on the linearized color values:
final <- array(NA, dim = c(widthInPixels, widthInPixels, length(splitimage)))
for (i in 1:length(splitimage)){
matrix <- linearized_values[,,i]
fft <- (1/widthInPixels) * fft_matrix_shift(fftw2d(matrix, inverse = 0))
transform <- fft * blur
ifft <- (1/widthInPixels) * fftw2d(transform, inverse = 1)
final[,,i] <- Mod(ifft)
}
#final_red<<-final[,,1]
#final_green<<-final[,,2]
#final_blue<<-final[,,3]
# Now, for display purposes, we need to transform the colors from
# linearized color space back into sRGB space
sRGB_values <- array(NA, dim = c(widthInPixels, widthInPixels, 3))
# Each dimension from the three-dimensional "final" array is a color
# channel that has been linearized, fourier transformed, blurred, and
# inverse fourier transformed. Create a vector from each of these
# so that you can do the calculations that retransform things back into
# sRGB space
red2 <- as.vector(final[,,1])
green2 <- as.vector(final[,,2])
blue2 <- as.vector(final[,,3])
# To see the equations for the transformation to sRGB space,
# see main text or: https://en.wikipedia.org/wiki/SRGB
# Speficially the section entitled "The forward transformation."
# Calculate sRGB values for the red channel
redsRGB <- array(NA, dim = c(dim_array[1]))
for (i in 1:dim_array[1]){
if (red2[i] < 0.0031308){
redsRGB[i] <- (red2[i] * 12.92)
} else {
redsRGB[i] <- (((1 + a) * red2[i]^(1 / 2.4)) - a)
}
}
dim(redsRGB) <- dim(splitimage[[1]])
sRGB_values[,,1] <- redsRGB
#red_sRGB<<-sRGB_values[,,1]
# Calculate sRGB values for the green channel
greensRGB <- array(NA, dim = c(dim_array[1]))
for (i in 1:dim_array[1]){
if (green2[i] < 0.0031308){
greensRGB[i] <- (green2[i] * 12.92)
} else {
greensRGB[i] <- (((1 + a) * green2[i]^(1 / 2.4)) - a)
}
}
dim(greensRGB) <- dim(splitimage[[1]])
sRGB_values[,,2] <- greensRGB
#green_sRGB<<-sRGB_values[,,2]
# Calculate sRGB values for the blue channel
bluesRGB <- array(NA, dim = c(dim_array[1]))
for (i in 1:dim_array[1]){
if (blue2[i] < 0.0031308){
bluesRGB[i] <- (blue2[i] * 12.92)
} else {
bluesRGB[i] <- (((1 + a) * blue2[i]^(1 / 2.4)) - a)
}
}
dim(bluesRGB) <- dim(splitimage[[1]])
sRGB_values[,,3] <- bluesRGB
#blue_sRGB<<-sRGB_values[,,3]
# Rescale the sRGB values so that the maximum is equal to 1,
# for the purposes of displaying the image
# Note: depending on the particular original image, the maximum
# values may not be above 1; scaling is only necessary if the
# maximum value is >1, hence the if/else statement
if (max(sRGB_values[,,1]) > 1){
rsc <- rescale(sRGB_values[,,1], newrange = c(min(sRGB_values[,,1]), 1))
} else {
rsc <- sRGB_values[,,1]
}
if (max(sRGB_values[,,2]) > 1){
gsc <- rescale(sRGB_values[,,2], newrange = c(min(sRGB_values[,,2]), 1))
} else {
gsc <- sRGB_values[,,2]
}
if (max(sRGB_values[,,3]) > 1){
bsc <- rescale(sRGB_values[,,3], newrange = c(min(sRGB_values[,,3]), 1))
} else {
bsc <- sRGB_values[,,3]
}
# Put the rescaled sRGB values into an array to plot as a raster,
# which displays them as an image
# This array should have the same dimensions as the original image
rgbmatrix <- array(NA, dim = c(widthInPixels, widthInPixels, length(splitimage)))
# Because of the fourier transform, the matrix needs to be transposed
# or the final image will end up sideways
rgbmatrix[,,1] <- t(rsc)
rgbmatrix[,,2] <- t(gsc)
rgbmatrix[,,3] <- t(bsc)
#rgbmatrix_red<<-rgbmatrix[,,1]
#rgbmatrix_green<<-rgbmatrix[,,2]
#rgbmatrix_blue<<-rgbmatrix[,,3]
# Save output file in the provided format
if (file_ext(output) == "png") {
png(filename = output, width = dimensions[2], height = dimensions[2], units = "px")
grid.raster(rgbmatrix, interpolate = FALSE)
dev.off()
}
if (file_ext(output) == "bmp") {
png(filename = output, width = dimensions[2], height = dimensions[2], units = "px")
grid.raster(rgbmatrix, interpolate = FALSE)
dev.off()
}
if (file_ext(output) == "jpeg") {
png(filename = output, width = dimensions[2], height = dimensions[2], units = "px")
grid.raster(rgbmatrix, interpolate = FALSE)
dev.off()
}
if (file_ext(output) == "jpg") {
png(filename = output, width = dimensions[2], height = dimensions[2], units = "px")
grid.raster(rgbmatrix, interpolate = FALSE)
dev.off()
}
# Now, display the final image (represented in rgbmatrix) in a separate box
if (plot) {
#grid.raster(rgbmatrix, interpolate = FALSE)
plot(c(0, ncol(rgbmatrix)), c(0, nrow(rgbmatrix)), type = "n", axes = F, xlab = "", ylab = "", main = "After")
rasterImage(rgbmatrix, 1, 1, ncol(rgbmatrix), nrow(rgbmatrix), interpolate = FALSE)
message(paste0('To save the side-by-side image, use a command like this before closing the device:\ndev.copy(jpeg,file="sidebyside.jpg")'))
}
message(paste0("The results are complete. The output file has been saved to ", output))
} # End of function
#'FFTMatrixShift
#'
#'This function rearranges the output of the FFT by moving the zero frequency component to the center
#'@param input_matrix the output of an FFT
#'@param dim -1 gives the correct matrix shift for the AcuityView function
#'@export
fft_matrix_shift <- function(input_matrix, dim = -1) {
rows <- dim(input_matrix)[1]
cols <- dim(input_matrix)[2]
# You need a check here for if dim != -1 or is NULL
if (dim == -1) {
input_matrix <- swap_up_down(input_matrix)
return(swap_left_right(input_matrix))
}
}
swap_up_down <- function(input_matrix) {
rows <- dim(input_matrix)[1]
cols <- dim(input_matrix)[2]
rows_half <- ceiling(rows / 2)
return(rbind(input_matrix[((rows_half + 1):rows), (1:cols)], input_matrix[(1:rows_half), (1:cols)]))
}
swap_left_right <- function(input_matrix) {
rows <- dim(input_matrix)[1]
cols <- dim(input_matrix)[2]
cols_half <- ceiling(cols / 2)
return(cbind(input_matrix[1:rows, ((cols_half+1):cols)], input_matrix[1:rows, 1:cols_half]))
}
#'Sample image for use in example code
#'@docType data
#'@name reef.bmp
#'@title Photograph of a coral reef
#'@format a .bmp image
#'@usage reef.bmp
#'@description This photograph is copyright the authors, and is used for the example code
#'@export
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.