R/imagehistory.R
In matloff/ShinyImage: Image Manipulation, with an Emphasis on Journaling
Defines functions
shinyload
Documented in
shinyload
library(EBImage) #Include EBImage Lib
library(R6)
#used to keep track of rotate, crop, or any other function that requires order
Queue <- setRefClass(Class = "Queue",
fields = list(
name = "character",
data = "list"
),
methods = list(
size = function() {
'Returns the number of items in the queue.'
return(length(data))
},
#
push = function(item) {
'Inserts element at back of the queue.'
data[[size()+1]] <<- item
},
#
pop = function() {
'Removes and returns head of queue (or raises error if queue is empty).'
if (size() == 0) stop("queue is empty!")
value <- data[[1]]
data[[1]] <<- NULL
value
},
reverse_pop = function() {
'Removes tail of queue'
if (size() == 0) stop("queue is empty!")
value <- data[[size()]]
data[[size()]] <<- NULL
value
},
#
poll = function() {
'Removes and returns head of queue (or NULL if queue is empty).'
if (size() == 0) return(NULL)
else pop()
},
#
peek = function(pos = c(1)) {
'Returns (but does not remove) specified positions in queue (or NULL if any one of them is not available).'
if (size() < max(pos)) return(NULL)
#
if (length(pos) == 1) return(data[[pos]])
else return(data[pos])
},
initialize=function(...) {
callSuper(...)
#
# Initialise fields here (place holder)...
#
.self
}
)
)
#' Class providing object describing one action.
#'
#' @docType class
#' @importFrom R6 R6Class
#' @export
#' @keywords data
#' @return Object of \code{\link{R6Class}} representing a single ShinyImage action.
#' @format \code{\link{R6Class}} object.
#' @examples
#' crop = c(c(0, 0), c(1200, 1400))
#' siaction$new(0.1, 1, 0, crop, 1, 0, 0)
#' @field brightness Stores address of your lightning server.
#' @field contrast Stores id of your current session on the server.
#' @field gamma Stores url of the last visualization created by this object.
#' @field crop A double nested sequence of crops c\(c\(x1, y1\), c\(x2, y2\)\).
#' @field blur stores value of blur
#' @field rotate stores value of rotate
#' @field grayscale stores value of colormode (1 if grayscale, 0 if color)
#' #' @section Methods:
#' \describe{
#' \item{Documentation}{The user should not need to create an action object. This is a class used exclusively by a shinyimg to keep track of a set of changes.}
#' \item{\code{new(brightness, contrast, gamma, crop)}}{This method is used to create object of this class with the appropriate parameters.}
#'
#' \item{\code{get_action()}}{This method returns a c() list of the input parameters.}
#' }
#'
siaction <- R6Class("siaction",
# Make this action mutable. TODO: Make it so that
# it doesn't need to be
lock_objects = FALSE,
public = list(
# Initialize all the values of this action
initialize = function(brightness, contrast, gamma, crop, blur, rotate, grayscale, flip, flop) {
private$brightness <- brightness
private$contrast <- contrast
private$gamma <- gamma
private$crop <- crop
private$blur <- blur
private$rotate <- rotate
private$grayscale <- grayscale
private$flip <- flip
private$flop <- flop
},
# Get the c()'d properties of this particular action
get_action = function() {
# Note that because private$crop consists of 4 values,
# it contributes 4 slots to this vector.
return (c(private$brightness,
private$contrast,
private$gamma,
private$crop,
private$blur,
private$rotate,
private$grayscale,
private$flip,
private$flop))
}
),
private = list(
# Properties of this action
brightness = 0,
contrast = 0,
gamma = 0,
crop = NULL, # vector of length 4
blur = 0,
rotate = 0,
grayscale = 0,
flip = 0,
flop = 0
)
)
#' An EBImage wrapper with integrated history tracking.
#'
#' @docType class
#' @importFrom EBImage display imageData Image colorMode readImage
#' writeImage gblur combine channel rotate
#' @importFrom R6 R6Class
#' @export
#' @keywords data
#' @return Object of \code{\link{R6Class}} with manipulation functions.
#' @format \code{\link{R6Class}} object.
#' @examples
#'
#' small_tiger = shinyimg$new(system.file("images","tiger_small.jpg",package="ShinyImage"))
#'
#' small_tiger$add_brightness() # Adds brightness to image
#'
#' small_tiger$undo() # Undoes the brightness addition
#'
#' small_tiger$redo() # Redoes the brightness addition
#'
#' small_tiger$add_contrast() #Adds contrast to image
#'
#' small_tiger$remove_contrast() #Removes the contrast from the image
#'
#' small_tiger$add_gamma() #Adds Gamma correction
#'
#' small_tiger$remove_gamma() #Removes the Gamma Correction
#'
#' small_tiger$add_blur() #Adds blur to image
#'
#' small_tiger$remove_blur() #removes the blur from the image
#'
#' small_tiger$add_rotate() #Adds rotation by 1 degree
#'
#' small_tiger$remove_rotate() #Remoes the rotation by 1 degree
#'
#' small_tiger$set_brightness(.5) #Sets brightness by number inputted
#'
#' small_tiger$set_contrast(2) #Sets contrast by number inputted
#'
#' small_tiger$set_gamma(2) #Sets gamma by number inputted
#'
#' small_tiger$set_blur(6) #sets blurring to number inputted
#'
#' small_tiger$set_rotate(180) #sets rotationt to degrees inputted
#'
#' small_tiger$set_grayscale(1) #changes image to colormode
#'
#' small_tiger$set_grayscale(0) #reverts back to colormode
#'
#' small_tiger$crop(0,10,0,10) #crops by the coordinates inputted
#'
#' small_tiger$undo #undoes the crop
#'
#' small_tiger$gethistory() #returns recorded changes to image
#'
#' small_tiger$save('save.si') # Saves the current state. The filename is optional.
#'
#' small_tiger$saveImage('temp.jpg') #Saves current image to jpg file
#'
#' small_tiger$load('save.si') # Loads from a previously saved state. The filename is optional.
#' #Requires a previously instantiated shinyimg instance (argument provided to new can be null).
#'
#' @section Methods:
#' \describe{
#' \item{Documentation}{The user should not need to create an action object. This is a class used exclusively by a shinyimg to keep track of a set of changes.}
#' \item{\code{new(img)}}{Default constructor. \code{img} can be either a URL or a location of a local image.}
#' \item{\code{undo()}}{Undoes the last change done to this image. When the original image state is reached, no more undos are possible.}
#' \item{\code{redo()}}{Redos the next action after an undo has been performed. Will no longer redo if there are no more undos to redo.}
#' \item{\code{canUndo()}}{Checks if can undo; used by Shiny.}
#' \item{\code{redo()}}{Redos the next action after an undo has been performed without autorendering; used by Shiny.
#' Will no longer redo if there are no more undos to redo.}
#' \item{\code{canRedo()}}{Checks if can redo; used by Shiny.}
#' \item{\code{copy()}}{Returns a copy of the image.}
#' \item{\code{add_brightness()}}{Adds brightness to the image.}
#' \item{\code{remove_brightness()}}{Removes brightness (darkens) to the image.}
#' \item{\code{add_contrast()}}{Adds contrast to the image.}
#' \item{\code{remove_contrast()}}{Removes contrast from the image.}
#' \item{\code{add_gamma()}}{Adds gamma correction to the image.}
#' \item{\code{remove_gamma()}}{Remoevs gamma correction from the image.}
#' \item{\code{add_blur()}}{Adds blur to the entire photo.}
#' \item{\code{remove_blur()}}{Removes blur from the entire photo.}
#' \item{\code{add_rotate()}}{Rotates image to the right.}
#' \item{\code{remove_rotate()}}{Rotates image to the left.}
#' \item{\code{set_brightness()}}{Sets the brightness of the image by number inputted.}
#' \item{\code{set_contrast()}}{Sets the contrast of the image by number inputted.}
#' \item{\code{set_gamma()}}{Sets the gamma correction of the image by number inputted.}
#' \item{\code{set_blur()}}{Sets the blur of the image by number inputted.}
#' \item{\code{set_rotate()}}{Sets the degree of rotation of the image by number inputted.}
#' \item{\code{set_grayscale((num))}}{Sets the image to grayscale if 1 is inputted; Reverts the image back to colormode if 0 is inputted}
#' \item{\code{change_color_mode()}}{Toggles between grayscale and colormode.}
#' \item{\code{crop()}}{Uses locator to get corners of an image. Automatically finds min and max coordinates.
#' After two points are selected, a cropping selection can be create in order to crop the image to the desired size.
#' If crop coordinates are passed, uses those instead of asking user.}
#' \item{\code{flip_horizontally()}}{Flips image around horizontal axis.}
#' \item{\code{flop_vertically()}}{Flops image around vertical axis.}
#' \item{\code{get_raw()}}{Gets the raw matrix slices of the current image.}
#' \item{\code{gethistory()}}{Returns a copy of the members of the shinyimg object stored in myhistory.}
#' \item{\code{get_brightness()}}{Returns a copy of the value stored for brightness.}
#' \item{\code{get_contrast()}}{Returns a copy of the value stored for contrast.}
#' \item{\code{get_gamma()}}{Returns a copy of the value stored for gamma correction.}
#' \item{\code{get_blur()}}{Returns a copy of the value stored for blur.}
#' \item{\code{get_rotate()}}{Returns a copy of the value stored for rotation.}
#' \item{\code{get_color()}}{Returns a copy of the value stored for grayscale/colormode.}
#' \item{\code{get_flip()}}{Returns copy of the value stored for flip (1 means flipped).}
#' \item{\code{get_flop()}}{Returns copy of the value stored for flop (1 means flopped).}
#' \item{\code{get_imghistory()}}{Returns a copy of the list of image histories.}
#' \item{\code{get_actions()}}{Returns a copy of the list of the input parameters.}
#' \item{\code{get_history_directory()}}{Gets directory of the history.R file.}
#' \item{\code{save(filepath)}}{Saves the current state to be resumed later. \code{filepath} has a default value of 'workspace.si'}
#' \item{\code{saveImage(filepath)}}{Saves a jpg of the image.}
#' \item{\code{load(filepath)}}{Loads a previously saved state. \code{filepath} has a default value of 'workspace.si'}
#' \item{\code{size()}}{Returns the current image dimentions.}
#' \item{\code{render()}}{Renders the current image.}
#' }
#'
shinyimg <- R6Class("shinyimg",
lock_objects = FALSE,
public = list(
logged_image = format(Sys.time(), "image_%b%y_%X"),
# Constructor of the shinyimg class
initialize = function(inputImage = NULL,
autosave_filename = NULL) {
self$logged_image <<- format(Sys.time(), "image_%b%y_%X")
#update name when initializing image
cat(self$logged_image,' <- shinyimg$new(\'',inputImage,'\')\n',sep='',file='~/history.R',append=TRUE)
self$set_default()
private$startup(inputImage, autosave_filename)
},
# Resets this object's values to the default ones.
set_default = function() {
cat(self$logged_image,'$set_default()\n',sep='',file='~/history.R',append=TRUE)
# Default brightness
private$myhistory = c(0,0,0,0,0,0,0,0,0,0,0,0,0)
private$brightness = 0
# Default Contrast
private$contrast = 1
# Default Gamma
private$gamma = 1
# Default Blur
private$blur = 0
# Default Rotate
private$rotate = 0
# Default grayscale
private$grayscale = 0
# Default flip (flips an image horizontally)
private$flip = 0
# Default flop (flips an image vertically)
private$flop = 0
# CURRENT Number of actions. Can be less than the
# Actual number of actions due to undos.
private$actions = 0
# Crop coordinates
private$xy1 = c(0, 0)
private$xy2 = NULL
# Crop offsets
# (relative to top left, which is 0, 0)
private$xoffset = 0
private$yoffset = 0
# List of image histories (instances of "siaction")
private$img_history = c()
# Variable to store the source image
private$local_img = NULL
# Variable to store the current image to display
private$current_image = NULL
# The filename used for the autosave in
# case of crashes
#private$autosave_filename = "workspace.si"
#heere
private$autosave_filename =
paste(format(Sys.time(), "%b%d%H%M%S"), "-", "workspace.si",sep="")
# bool value to determine if user can undo
private$order_list = Queue$new()
# Queue that stores non-commutative actions
# currently only supports rotate and crop
private$indexed_images <- vector("list")
# list that stores copies of all versions
# of si objects created
},
# Function to write the current state of the program to
# file.
save = function(file = private$autosave_filename) {
cat(self$logged_image,'$save(',file,')\n',sep="",file='~/history.R',append=TRUE)
# Generated action matrix done in O(1) time.
action_matrix <- matrix(NA,
nrow=length(private$img_history),
ncol=12)
# Fill in the history data
i = 1
for (item in private$img_history) {
history <- item$get_action()
# TODO: Map function perhaps?
action_matrix[i, ] <- c(history[1], history[2],
history[3], history[4],
history[5], history[6],
history[7], history[8],
history[9], history[10],
history[11], history[12])
i = i + 1
}
# Save the current action number
actions <- private$actions
# Save the current image as well
img <- imageData(private$local_img)
order_list = private$order_list
indexed_images = private$indexed_images
# Save everything to file.
base::save(action_matrix, actions, img,
order_list, indexed_images, file=file)
},
# Counterpart to the save function, will load from
# previous save file.
load = function(file = private$autosave_filename) {
cat(self$logged_image,'$load(',file,')\n',sep="",file='~/history.R',append=TRUE)
base::load(file)
# Generate the image history.
private$img_history = c()
private$local_img <- Image(img)
private$order_list = order_list
private$indexed_images = indexed_images
# Not sure if this fixes the issue -- Had
# some weird color issues like loading in
# black and white. This seems to have fixed the
# issue.
colorMode(private$local_img) = Color
# FIll in the action matrix
for (i in 1:dim(action_matrix)[1]) {
# private$add_action(action_matrix[i, 1],
# action_matrix[i, 2],
# action_matrix[i, 3],
# action_matrix[i, 4],
# action_matrix[i, 5],
# action_matrix[i, 6],
# action_matrix[i, 7],
# action_matrix[i, 8],
# action_matrix[i, 9],
# action_matrix[i, 10]
# )
private$update_img_history(
action_matrix[i, 1],
action_matrix[i, 2],
action_matrix[i, 3],
action_matrix[i, 4],
action_matrix[i, 5],
action_matrix[i, 6],
action_matrix[i, 7],
action_matrix[i, 8],
action_matrix[i, 9],
action_matrix[i, 10],
action_matrix[i, 11],
action_matrix[i, 12]
)
}
private$actions <- actions
# Apply the latest action
private$update_all_img_values()
private$current_image <<- private$indexed_images[[private$actions]]
private$render()
},
# Uses the actions list (img_history) to undo the last
# done action. DOES NOT PRUNE THE LIST AT THIS POINT.
undo = function() {
cat(self$logged_image,'$undo()\n',sep='',file='~/history.R',append=TRUE)
# If there are more actions to undo besides the
# original
# image (aka action #1)
if (private$actions != 1) {
private$doUndo()
display(private$current_image, method = "raster")
} else {
# There are no actions to undo.
print("No action to undo")
}
},
# undo function for Shiny app
canUndo = function() {
# If there are more actions to undo besides the
# original
# image (aka action #1)
return (private$actions > 1)
},
# Uses the actions list (img_history) to redo the last
# undone action.
redo = function() {
cat(self$logged_image,'$redo()\n',sep='',file='~/history.R',append=TRUE)
# If there are actions to redo
if (private$actions < length(private$img_history)) {
private$doRedo()
display(private$current_image, method = "raster")
} else {
# No actions to redo.
print("No action to redo")
}
},
# Redo action for Shiny app
canRedo = function() {
cat(self$logged_image,'$redo()\n',sep='',file='~/history.R',append=TRUE)
# If there are actions to redo
return (private$actions < length(private$img_history))
},
# Returns a copy of this image.
# One copy's changes will not affect the other.
copy = function() {
cat(self$logged_image,'$copy()\n',sep='',file='~/history.R',append=TRUE)
#TODO: Different options for cloning,
# like collapsing history
return (self$clone())
},
# Adjusts brightness by 0.1. This is a good increment
# but a variable brightness function should be added.
add_brightness = function() {
#adds function to the history log
cat(self$logged_image,'$add_brightness()\n',sep='',file='~/history.R',append=TRUE)
# Adds 0.1 brightness.
private$do_action(1, 0.1)
},
# Adjusts brightness by -0.1. This is a good decrement
# but a variable brightness function should be added.
remove_brightness = function() {
#adds function to the history log
cat(self$logged_image,'$remove_brightness()\n',sep='',file='~/history.R',append=TRUE)
# removes 0.1 brightness.
private$do_action(1, -0.1)
},
# Adjusts contrast by 0.1. This is a good increment
# but a variable contrast function should be added.
add_contrast = function() {
#adds function to the history log
cat(self$logged_image,'$add_contrast()\n',sep='',file='~/history.R',append=TRUE)
# Adds 0.1 contrast.
private$do_action(3, 0.1)
},
# Adjusts contrast by -0.1. This is a good increment
# but a variable contrast function should be added.
remove_contrast = function() {
#adds function to the history log
cat(self$logged_image,'$remove_contrast()\n',sep='',file='~/history.R',append=TRUE)
# removes 0.1 contrast.
private$do_action(3, -0.1)
},
# Adjusts gamma by 0.5
add_gamma = function() {
#adds function to the history log
cat(self$logged_image,'$add_gamma()\n',sep='',file='~/history.R',append=TRUE)
private$do_action(5, 0.5)
},
# Adjusts gamma by -0.5
remove_gamma = function() {
#adds function to the history log
cat(self$logged_image,'$remove_gamma()\n',sep='',file='~/history.R',append=TRUE)
private$do_action(5, -0.5)
},
# Adjusts blur by 1
add_blur = function() {
#adds function to the history log
cat(self$logged_image,'$add_blur()\n',sep='',file='~/history.R',append=TRUE)
private$do_action(7, 1)
},
# Adjusts blur by -1
remove_blur = function() {
#adds function to the history log
cat(self$logged_image,'$remove_blur()\n',sep='',file='~/history.R',append=TRUE)
private$do_action(7, -1)
},
# Adjusts rotate by 1 degree
add_rotate = function() {
#adds function to the history log
cat(self$logged_image,'$add_rotate()\n',sep='',file='~/history.R',append=TRUE)
# need to add 1 to private$actions because it will only be updated
# after it calls do_action
# private$add_order(2, private$actions + 1, 10, NULL, NULL, NULL)
# actionID = 9
# mutatorAmount = 10; how much rotate is changing
# isNonCommutative = TRUE
# whichNonCommAction = 2 (bc its rotate, not crop)
private$do_action(9, 10, TRUE, 2)
},
# Adjusts rotate by -1 degree
remove_rotate = function() {
#adds function to the history log
cat(self$logged_image,'$remove_rotate()\n',sep='',file='~/history.R',append=TRUE)
# need to add 1 to private$actions because it will only be updated
# after it calls mutator
# private$add_order(2, private$actions + 1, -10, NULL, NULL, NULL)
# private$mutator(9, -10)
# actionID = 9
# mutatorAmount = -10; how much rotate is changing
# isNonCommutative = TRUE
# whichNonCommAction = 2 (bc its rotate, not crop)
private$do_action(9, -10, TRUE, 2)
},
set_brightness = function(brightness) {
#adds function to the history log
cat(self$logged_image,'$set_brightness(',brightness,')\n',sep="",file='~/history.R',append=TRUE)
# Sets brightness.
private$do_action(2, brightness)
},
set_contrast = function(contrast) {
#adds function to the history log
cat(self$logged_image,'$set_contrast(',contrast,')\n',sep="",file='~/history.R',append=TRUE)
# Sets brightness.
private$do_action(4, contrast)
},
set_gamma = function(gamma) {
#adds function to the history log
cat(self$logged_image,'$set_gamma(',gamma,')\n',sep="",file='~/history.R',append=TRUE)
private$do_action(6, gamma)
# Sets gamma correction
},
set_blur = function(blur) {
#adds function to the history log
cat(self$logged_image,'$set_blur(',blur,')\n',sep="",file='~/history.R',append=TRUE)
# Sets blur
private$do_action(8, blur)
},
set_rotate = function(rotate) {
#adds function to the history log
cat(self$logged_image,'$set_rotate(',rotate,')\n',sep="",file='~/history.R',append=TRUE)
# need to add 1 to private$actions because it will only be updated
# after it calls mutator
# private$add_order(2, private$actions + 1, rotate - private$rotate, NULL, NULL, NULL)
# # Sets rotation of image
# private$mutator(10, rotate)
# private$add_order(2, private$actions + 1, 10, NULL, NULL, NULL)
# actionID = 9 (9 was for add/remove rotate but we need to keep it
# for set_rotate so we can pass in the relative value for updating queue)
# mutatorAmount = 10; how much rotate is changing
# isNonCommutative = TRUE
# whichNonCommAction = 2 (bc its rotate, not crop)
private$do_action(9, rotate - private$rotate, TRUE, 2)
},
set_grayscale = function(grayscale) {
#adds function to the history log
cat(self$logged_image,'$set_grayscale(',grayscale,')\n',sep="",file='~/history.R',append=TRUE)
# Sets image to grayscale if argument is 1
# Else image is colormode
# Can revert image to colormode if argument is 0
private$do_action(11, grayscale)
},
change_color_mode = function() {
cat(self$logged_image,'$change_color_mode()\n',sep="",file='~/history.R',append=TRUE)
if (private$grayscale == 1)
private$do_action(11, 0)
else
private$do_action(11, 1)
},
# The command line cropper uses locator to have the
# user locate the two corners of the subimage.
crop = function(x1, x2, y1, y2) {
# If crop coordinates not given, get them from the user.
if (missing(x1) || missing(x2) || missing(y1) || missing(y2))
{
print("Select the two opposite corners
of a rectangle on the plot.")
location = locator(2)
x1 = min(location$x[1], location$x[2])
y1 = min(location$y[1], location$y[2])
x2 = max(location$x[1], location$x[2])
y2 = max(location$y[1], location$y[2])
}
# NM: for history file
cmd <- paste('crop(',
x1, ',', x2, ',', y1, ',', y2, ')', sep='')
cat(self$logged_image,'$',cmd,'\n',sep='',file='~/history.R',append=TRUE)
private$do_action(12, c(x1=x1,x2=x2,y1=y1,y2=y2), TRUE, 1)
},
# flips an image around the horizontal axis
flip_horizontally = function() {
cat(self$logged_image,'$flip_horizontally()\n',sep="",file='~/history.R',append=TRUE)
if (private$flip == 0)
{
flip <- 1
}
if (private$flip == 1)
{
flip <- 0
}
# actionID = 13 for flip
# mutatorAmount = flip (how much flip is changing -- either 1 or 0)
# isNonCommutative = TRUE
# whichNonCommAction = 3 (bc its flip, not crop or rotate or flop)
private$do_action(13, flip, TRUE, 3)
},
# flops an image around the vertical axis
flop_vertically = function() {
cat(self$logged_image,'$flop_horizontally()\n',sep="",file='~/history.R',append=TRUE)
# flips image
if (private$flop == 0)
{
flop <- 1
}
if (private$flop == 1)
{
flop <- 0
}
# actionID = 14 for flop
# mutatorAmount = flop (how much flip is changing -- either 1 or 0)
# isNonCommutative = TRUE
# whichNonCommAction = 4 (bc its flop, not crop or rotate or flip)
private$do_action(14, flop, TRUE, 4)
},
# Returns the size of the current image.
# Needed for Shiny to determine the max values of
# the sliders.
size = function() {
dim(private$current_image)
},
# Gets the raw matrix slices of the current image
get_raw = function() {
return (imageData(private$current_img))
},
# saves image as a jpeg
saveImage = function(file) {
cat(self$logged_image,'$','saveImage(',file,')\n',sep="",file='~/history.R',append=TRUE)
if(missing(file))
{
writeImage(private$current_image, files = "temp.jpg")
}
else
writeImage(private$current_image, file)
},
# returns a copy of the members of the shinyimg object
gethistory = function() {
return(private$myhistory)
},
# returns a copy of the brightness value
get_brightness = function() {
return (private$brightness)
},
# returns a copy of the contrast value
get_contrast = function() {
return (private$contrast)
},
# returns a copy of the gamma value
get_gamma = function() {
return (private$gamma)
},
# returns a copy of the blur value
get_blur = function() {
return (private$blur)
},
# returns a copy of the rotate value
get_rotate = function() {
return(private$rotate)
},
# returns a copy of the grayscale value
# indicates colormode
get_color = function() {
return(private$grayscale)
},
# returns a copy of the flip value
get_flip = function() {
return(private$flip)
},
# returns a copy of the flop value
get_flop = function() {
return(private$flop)
},
# returns a copy of the list of image histories
get_imghistory = function() {
return(private$img_history)
},
# returns a copy of the list of input parameters
get_actions = function() {
return(private$actions)
},
#gets directory of history.R file
get_history_directory = function() {
setwd('~')
return(cat('history.R is located at ', getwd(), '/history.R\n', sep = ""))
}
#Uses a matrix as the image. Can be used to reintegrate
# a get_raw generated matrix.
# Disabled as this feature could be abused.
#import_matrix = function(m) {
# private$set_default()
# private$startup(NULL, NULL, m)
#}
),
private = list(
# The following are the members of the shinyimg obj.
# Default brightness
myhistory = c(0,0,0,0,0,0,0,0,0,0,0,0,0),
#names(myhistory) <- c(1,2,3,4,5,6,7,8,9,10),
brightness = 0,
# Default Contrast
contrast = 1,
gamma = 1,
blur = 0,
rotate = 0,
grayscale = 0,
flip = 0,
flop = 0,
# CURRENT Number of actions. Can be less than the
# Actual number of actions due to undos.
actions = 0,
# Crop coordinates
xy1 = c(0, 0),
xy2 = NULL,
# Crop offsets (relative to top left, which is 0, 0)
xoffset = 0,
yoffset = 0,
# List of image histories
img_history = c(),
# Variable to store the source image
local_img = NULL,
# Variable to store the current image to display
current_image = NULL,
# The filename used for the autosave in case of crashes
#autosave_filename = "workspace.si",
autosave_filename =
paste(format(Sys.time(), "%b%d%H%M%S"), "-", "workspace.si",sep=""),
# refactoring all of the actions from the previous functions
# add_action, mtuator, and add_order
# calls a bunch of helpers
# isNonCommutative: bool value indicates if Non-Commutative (i.e. crop or rotate)
# whichNonCommAction: int to indicate if crop or rotate
# actionIndex: action ID #
# nonCommValues: values of crop or rotate
do_action = function(actionID, mutatorAmount, isNonCommutative = FALSE, whichNonCommAction = -1) {
# default values for functions that modify nonComm
private$remove_potential_redos()
private$actions <- private$actions + 1
if (isNonCommutative)
# do_action parameter that tells if non-commutative
# if non-commuatate
{
private$update_queue(private$actions, whichNonCommAction, mutatorAmount)
}
private$update_img_amount(actionID, mutatorAmount)
private$update_img_history()
private$generate_current_image()
private$generate_queued_image()
private$update_colormode()
# must have a generted image
private$update_saved_images()
private$render()
},
doUndo = function() {
# Step back by one action
private$actions <- private$actions - 1
# we go to our list that contains all the versions
# of our si object
# we go back to the action number
private$update_all_img_values()
private$current_image <<- private$indexed_images[[private$actions]]
},
doRedo = function() {
# Increment by one action, then apply it
private$actions <- private$actions + 1
# we go to our list that contains all the versions
# of our si object
# we go back to the action number
private$update_all_img_values()
private$current_image <<- private$indexed_images[[private$actions]]
},
# prunes img_history and indexed_images
remove_potential_redos = function() {
# private$actions is not updated for this function
# only function to have an un-updated private$actions
# in do_action
# If we are not at the most recent image, we need
# to prune the extra actions for img_history
if (private$actions <
length(private$img_history)) {
private$img_history <-
private$img_history[1:private$actions]
}
# If we are not at the most recent image, we need
# to prune the extra actions for indexed_images
if (private$actions <
length(private$indexed_images)) {
private$indexed_images <-
private$indexed_images[1:private$actions]
}
while (private$order_list$size() > 0 &&
private$actions
< private$order_list$peek(private$order_list$size())[["actionID"]])
{
private$order_list$reverse_pop()
}
},
update_queue = function(actionID, whichNonCommAction, nonCommValue) {
private$order_list$push(c(actionID=actionID,
whichNonCommAction=whichNonCommAction, nonCommValue=nonCommValue))
},
update_crop_values = function(cropValues) {
if (length(cropValues) != 4)
stop("Bad cropValues vector")
cropValues = as.list(cropValues)
x1 = cropValues$x1
x2 = cropValues$x2
y1 = cropValues$y1
y2 = cropValues$y2
# In order to maintain a correct cropping,
# we need to know how much of
# the original image has already been cropped.
xdiff = x2 - x1
ydiff = y2 - y1
# The offset is needed to maintain the ABSOLUTE
# crop data.
private$xoffset = private$xoffset + x1
private$yoffset = private$yoffset + y1
# Create the absolute crop data using the offsets
# and new area.
private$xy1 = c(private$xoffset, private$yoffset)
private$xy2 = c(private$xoffset + xdiff,
private$yoffset + ydiff)
},
# amount is a length 4 vector if the action is a crop.
update_img_amount = function(actionID, amount) {
switch(actionID,
# ActionID 1, brightness adjustment
private$brightness <-
private$brightness + amount,
# ActionID 2, brightness setting
private$brightness <- amount,
# ActionID 3, contrast adjustment
private$contrast <-
private$contrast + amount,
# ActionID 4, contrast setting
private$contrast <- amount,
# ActionID 5, gamm adjustment
private$gamma <-
private$gamma + amount,
# ActionID 6, gamma setting
private$gamma <- amount,
# Action ID 7, blur adjustment
private$blur <-
private$blur + amount,
# Action ID 8, blur setting
private$blur <- amount,
# Action ID 9, rotate adjustment
private$rotate <-
private$rotate + amount,
# Action ID 10, rotate setting
private$rotate <- amount,
# Action ID 11, grayscale setting
private$grayscale <- amount,
# Action ID 12, crop
private$update_crop_values(amount),
# Action ID 13, flip
private$flip <- amount,
# Action ID 14, flop
private$flop <- amount
)
# private$add_action()
},
update_img_history = function(bright = private$brightness,
cont = private$contrast,
gam = private$gamma,
crop1x = private$xy1[1],
crop1y = private$xy1[2],
crop2x = private$xy2[1],
crop2y = private$xy2[2],
blurring = private$blur,
rotation = private$rotate,
colorMode = private$grayscale,
flip_value = private$flip,
flop_value = private$flop) {
private$img_history <-
c(private$img_history, siaction$new(bright,
cont,
gam,
c(
c(crop1x,crop1y),
c(crop2x, crop2y)
),
blurring,
rotation,
colorMode,
flip_value,
flop_value
))
},
# Sets all image values to what they are/were for the
# current action.
update_all_img_values = function() {
# Get the vector of image values of the current action.
args = private$img_history[private$actions]
args = args[[1]]
args = args$get_action()
private$myhistory <- args
private$brightness = args[1]
private$contrast = args[2]
private$gamma = args[3]
# private$xy1 = c(args[4], args[5])
# private$xy2 = c(args[6], args[7])
private$blur = args[8]
private$rotate = args[9]
private$grayscale = args[10]
private$flip = args[11]
private$flop = args[12]
},
generate_current_image = function() {
private$update_all_img_values()
if (private$blur > 0)
{
private$current_image <-
gblur(private$local_img, sigma = private$blur)
}
#need to fix blur back to original image
if (private$blur <= 0)
{
private$current_image <- private$local_img
}
private$current_image <-
private$current_image * private$contrast
private$current_image <-
private$current_image + private$brightness
private$current_image <-
private$current_image ^ private$gamma
},
generate_queued_image = function() {
order_copy <- private$order_list$copy()
while (order_copy$size() != 0)
{
popped <- order_copy$pop()
if (popped[2] == 1)
{
cropValues = as.list(popped[3:6])
x1 = cropValues$nonCommValue.x1
x2 = cropValues$nonCommValue.x2
y1 = cropValues$nonCommValue.y1
y2 = cropValues$nonCommValue.y2
private$current_image <- private$current_image[x1:x2, y1:y2,]
}
else if (popped[2] == 2)
{
private$current_image <- rotate(private$current_image, popped[3])
}
else if (popped[2] == 3)
{
private$current_image <- flip(private$current_image)
}
else if (popped[2] == 4)
{
private$current_image <- flop(private$current_image)
}
}
},
update_colormode = function() {
if (private$grayscale == 1)
private$current_image <- channel(private$current_image, "gray")
},
update_saved_images = function() {
length <- length(private$indexed_images)
private$indexed_images[[length + 1]] <- private$current_image
},
render = function() {
if (!is.null(private$current_image)) {
display(private$current_image, method = "raster")
}
},
# The matr argument imports a matrix as the image.
# The remaining two arguments are supplied by the
# constructors for shinyimg.
startup = function(inputImage, autosave_filename,
matr = NULL) {
# Set the autosave filename if it is not null
if (!is.null(autosave_filename))
private$autosave_filename <- autosave_filename
if (!is.null(inputImage)) {
# Here the user passed in an argument for
# inputImage We use the readImage functionality
# to read in the image to form an EBImage. This
# may be changed at a later time.
private$local_img <- readImage(inputImage)
# Here we set the current image to the original
# image. Multiplying by one essentially copies
# the image. The reason this works is that the
# multiplication function when applied to an
# image changes contrast. In this case, 1 is
# the default contrast, and thus we are
# essentially making a copy by not changing
# the contrast but telling it to make another
# image.
private$current_image <- private$local_img * 1
private$update_saved_images()
# Here we set the xy2 coordinate, which is the
# lower right coordinate of the image.
private$xy2 <- c(dim(private$local_img)[1],
dim(private$local_img)[2])
# Add the "base" action, which is the original
# image.
private$update_img_history()
private$actions <- private$actions + 1
private$render()
# 03/13 COMMENTED OUT
# private$add_action()
} else if (!is.null(matr)) {
# TODO: Possible that m is not actually a matrix.
# Could error.
result = tryCatch({
private$local_img <- Image(matr)
}, warning = function(w) {
return
}, error = function(e) {
return
}, finally = {
});
# Here we set the current image to the original
# image. Multiplying by one essentially copies
# the image. The reason this works is that the
# multiplication function when applied to an
# image changes contrast. In this case, 1 is
# the default contrast, and thus we are
# essentially making a copy by not changing
# the contrast but telling it to make another
# image.
private$current_image <- private$local_img * 1
# Here we set the xy2 coordinate, which is the
# lower right coordinate of the image.
private$xy2 <- c(dim(private$local_img)[1],
dim(private$local_img)[2])
# Add the "base" action, which is the original
# image.
private$update_img_history()
private$actions <- private$actions + 1
private$render()
# 03/13 COMMENTED OUT
# private$add_action()
} else {
# TODO: Maybe some sort of error message?
result = tryCatch({
private$load()
}, warning = function(w) {
}, error = function(e) {
}, finally = {
});
}
}
)
)
#' Wrapper to load an image from a cold boot.
#'
#' @param filename The filename of a file previously generated by shinyimg's $save function.
#' @examples
#'
#' small_tiger = shinyimg$new(system.file("images","tiger_small.jpg",package="ShinyImage"))
#'
#' small_tiger$save("tiger.si")
#' # Restart R
#' reloaded_tiger = shinyload("tiger.si")
#'
#' @export
shinyload = function(filename) {
shinyimg$new(NULL, filename)
}
matloff/ShinyImage documentation built on May 21, 2019, 12:56 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions shinyload
Documented in shinyload
library(EBImage) #Include EBImage Lib
library(R6)
#used to keep track of rotate, crop, or any other function that requires order
Queue <- setRefClass(Class = "Queue",
fields = list(
name = "character",
data = "list"
),
methods = list(
size = function() {
'Returns the number of items in the queue.'
return(length(data))
},
#
push = function(item) {
'Inserts element at back of the queue.'
data[[size()+1]] <<- item
},
#
pop = function() {
'Removes and returns head of queue (or raises error if queue is empty).'
if (size() == 0) stop("queue is empty!")
value <- data[[1]]
data[[1]] <<- NULL
value
},
reverse_pop = function() {
'Removes tail of queue'
if (size() == 0) stop("queue is empty!")
value <- data[[size()]]
data[[size()]] <<- NULL
value
},
#
poll = function() {
'Removes and returns head of queue (or NULL if queue is empty).'
if (size() == 0) return(NULL)
else pop()
},
#
peek = function(pos = c(1)) {
'Returns (but does not remove) specified positions in queue (or NULL if any one of them is not available).'
if (size() < max(pos)) return(NULL)
#
if (length(pos) == 1) return(data[[pos]])
else return(data[pos])
},
initialize=function(...) {
callSuper(...)
#
# Initialise fields here (place holder)...
#
.self
}
)
)
#' Class providing object describing one action.
#'
#' @docType class
#' @importFrom R6 R6Class
#' @export
#' @keywords data
#' @return Object of \code{\link{R6Class}} representing a single ShinyImage action.
#' @format \code{\link{R6Class}} object.
#' @examples
#' crop = c(c(0, 0), c(1200, 1400))
#' siaction$new(0.1, 1, 0, crop, 1, 0, 0)
#' @field brightness Stores address of your lightning server.
#' @field contrast Stores id of your current session on the server.
#' @field gamma Stores url of the last visualization created by this object.
#' @field crop A double nested sequence of crops c\(c\(x1, y1\), c\(x2, y2\)\).
#' @field blur stores value of blur
#' @field rotate stores value of rotate
#' @field grayscale stores value of colormode (1 if grayscale, 0 if color)
#' #' @section Methods:
#' \describe{
#' \item{Documentation}{The user should not need to create an action object. This is a class used exclusively by a shinyimg to keep track of a set of changes.}
#' \item{\code{new(brightness, contrast, gamma, crop)}}{This method is used to create object of this class with the appropriate parameters.}
#'
#' \item{\code{get_action()}}{This method returns a c() list of the input parameters.}
#' }
#'
siaction <- R6Class("siaction",
# Make this action mutable. TODO: Make it so that
# it doesn't need to be
lock_objects = FALSE,
public = list(
# Initialize all the values of this action
initialize = function(brightness, contrast, gamma, crop, blur, rotate, grayscale, flip, flop) {
private$brightness <- brightness
private$contrast <- contrast
private$gamma <- gamma
private$crop <- crop
private$blur <- blur
private$rotate <- rotate
private$grayscale <- grayscale
private$flip <- flip
private$flop <- flop
},
# Get the c()'d properties of this particular action
get_action = function() {
# Note that because private$crop consists of 4 values,
# it contributes 4 slots to this vector.
return (c(private$brightness,
private$contrast,
private$gamma,
private$crop,
private$blur,
private$rotate,
private$grayscale,
private$flip,
private$flop))
}
),
private = list(
# Properties of this action
brightness = 0,
contrast = 0,
gamma = 0,
crop = NULL, # vector of length 4
blur = 0,
rotate = 0,
grayscale = 0,
flip = 0,
flop = 0
)
)
#' An EBImage wrapper with integrated history tracking.
#'
#' @docType class
#' @importFrom EBImage display imageData Image colorMode readImage
#' writeImage gblur combine channel rotate
#' @importFrom R6 R6Class
#' @export
#' @keywords data
#' @return Object of \code{\link{R6Class}} with manipulation functions.
#' @format \code{\link{R6Class}} object.
#' @examples
#'
#' small_tiger = shinyimg$new(system.file("images","tiger_small.jpg",package="ShinyImage"))
#'
#' small_tiger$add_brightness() # Adds brightness to image
#'
#' small_tiger$undo() # Undoes the brightness addition
#'
#' small_tiger$redo() # Redoes the brightness addition
#'
#' small_tiger$add_contrast() #Adds contrast to image
#'
#' small_tiger$remove_contrast() #Removes the contrast from the image
#'
#' small_tiger$add_gamma() #Adds Gamma correction
#'
#' small_tiger$remove_gamma() #Removes the Gamma Correction
#'
#' small_tiger$add_blur() #Adds blur to image
#'
#' small_tiger$remove_blur() #removes the blur from the image
#'
#' small_tiger$add_rotate() #Adds rotation by 1 degree
#'
#' small_tiger$remove_rotate() #Remoes the rotation by 1 degree
#'
#' small_tiger$set_brightness(.5) #Sets brightness by number inputted
#'
#' small_tiger$set_contrast(2) #Sets contrast by number inputted
#'
#' small_tiger$set_gamma(2) #Sets gamma by number inputted
#'
#' small_tiger$set_blur(6) #sets blurring to number inputted
#'
#' small_tiger$set_rotate(180) #sets rotationt to degrees inputted
#'
#' small_tiger$set_grayscale(1) #changes image to colormode
#'
#' small_tiger$set_grayscale(0) #reverts back to colormode
#'
#' small_tiger$crop(0,10,0,10) #crops by the coordinates inputted
#'
#' small_tiger$undo #undoes the crop
#'
#' small_tiger$gethistory() #returns recorded changes to image
#'
#' small_tiger$save('save.si') # Saves the current state. The filename is optional.
#'
#' small_tiger$saveImage('temp.jpg') #Saves current image to jpg file
#'
#' small_tiger$load('save.si') # Loads from a previously saved state. The filename is optional.
#' #Requires a previously instantiated shinyimg instance (argument provided to new can be null).
#'
#' @section Methods:
#' \describe{
#' \item{Documentation}{The user should not need to create an action object. This is a class used exclusively by a shinyimg to keep track of a set of changes.}
#' \item{\code{new(img)}}{Default constructor. \code{img} can be either a URL or a location of a local image.}
#' \item{\code{undo()}}{Undoes the last change done to this image. When the original image state is reached, no more undos are possible.}
#' \item{\code{redo()}}{Redos the next action after an undo has been performed. Will no longer redo if there are no more undos to redo.}
#' \item{\code{canUndo()}}{Checks if can undo; used by Shiny.}
#' \item{\code{redo()}}{Redos the next action after an undo has been performed without autorendering; used by Shiny.
#' Will no longer redo if there are no more undos to redo.}
#' \item{\code{canRedo()}}{Checks if can redo; used by Shiny.}
#' \item{\code{copy()}}{Returns a copy of the image.}
#' \item{\code{add_brightness()}}{Adds brightness to the image.}
#' \item{\code{remove_brightness()}}{Removes brightness (darkens) to the image.}
#' \item{\code{add_contrast()}}{Adds contrast to the image.}
#' \item{\code{remove_contrast()}}{Removes contrast from the image.}
#' \item{\code{add_gamma()}}{Adds gamma correction to the image.}
#' \item{\code{remove_gamma()}}{Remoevs gamma correction from the image.}
#' \item{\code{add_blur()}}{Adds blur to the entire photo.}
#' \item{\code{remove_blur()}}{Removes blur from the entire photo.}
#' \item{\code{add_rotate()}}{Rotates image to the right.}
#' \item{\code{remove_rotate()}}{Rotates image to the left.}
#' \item{\code{set_brightness()}}{Sets the brightness of the image by number inputted.}
#' \item{\code{set_contrast()}}{Sets the contrast of the image by number inputted.}
#' \item{\code{set_gamma()}}{Sets the gamma correction of the image by number inputted.}
#' \item{\code{set_blur()}}{Sets the blur of the image by number inputted.}
#' \item{\code{set_rotate()}}{Sets the degree of rotation of the image by number inputted.}
#' \item{\code{set_grayscale((num))}}{Sets the image to grayscale if 1 is inputted; Reverts the image back to colormode if 0 is inputted}
#' \item{\code{change_color_mode()}}{Toggles between grayscale and colormode.}
#' \item{\code{crop()}}{Uses locator to get corners of an image. Automatically finds min and max coordinates.
#' After two points are selected, a cropping selection can be create in order to crop the image to the desired size.
#' If crop coordinates are passed, uses those instead of asking user.}
#' \item{\code{flip_horizontally()}}{Flips image around horizontal axis.}
#' \item{\code{flop_vertically()}}{Flops image around vertical axis.}
#' \item{\code{get_raw()}}{Gets the raw matrix slices of the current image.}
#' \item{\code{gethistory()}}{Returns a copy of the members of the shinyimg object stored in myhistory.}
#' \item{\code{get_brightness()}}{Returns a copy of the value stored for brightness.}
#' \item{\code{get_contrast()}}{Returns a copy of the value stored for contrast.}
#' \item{\code{get_gamma()}}{Returns a copy of the value stored for gamma correction.}
#' \item{\code{get_blur()}}{Returns a copy of the value stored for blur.}
#' \item{\code{get_rotate()}}{Returns a copy of the value stored for rotation.}
#' \item{\code{get_color()}}{Returns a copy of the value stored for grayscale/colormode.}
#' \item{\code{get_flip()}}{Returns copy of the value stored for flip (1 means flipped).}
#' \item{\code{get_flop()}}{Returns copy of the value stored for flop (1 means flopped).}
#' \item{\code{get_imghistory()}}{Returns a copy of the list of image histories.}
#' \item{\code{get_actions()}}{Returns a copy of the list of the input parameters.}
#' \item{\code{get_history_directory()}}{Gets directory of the history.R file.}
#' \item{\code{save(filepath)}}{Saves the current state to be resumed later. \code{filepath} has a default value of 'workspace.si'}
#' \item{\code{saveImage(filepath)}}{Saves a jpg of the image.}
#' \item{\code{load(filepath)}}{Loads a previously saved state. \code{filepath} has a default value of 'workspace.si'}
#' \item{\code{size()}}{Returns the current image dimentions.}
#' \item{\code{render()}}{Renders the current image.}
#' }
#'
shinyimg <- R6Class("shinyimg",
lock_objects = FALSE,
public = list(
logged_image = format(Sys.time(), "image_%b%y_%X"),
# Constructor of the shinyimg class
initialize = function(inputImage = NULL,
autosave_filename = NULL) {
self$logged_image <<- format(Sys.time(), "image_%b%y_%X")
#update name when initializing image
cat(self$logged_image,' <- shinyimg$new(\'',inputImage,'\')\n',sep='',file='~/history.R',append=TRUE)
self$set_default()
private$startup(inputImage, autosave_filename)
},
# Resets this object's values to the default ones.
set_default = function() {
cat(self$logged_image,'$set_default()\n',sep='',file='~/history.R',append=TRUE)
# Default brightness
private$myhistory = c(0,0,0,0,0,0,0,0,0,0,0,0,0)
private$brightness = 0
# Default Contrast
private$contrast = 1
# Default Gamma
private$gamma = 1
# Default Blur
private$blur = 0
# Default Rotate
private$rotate = 0
# Default grayscale
private$grayscale = 0
# Default flip (flips an image horizontally)
private$flip = 0
# Default flop (flips an image vertically)
private$flop = 0
# CURRENT Number of actions. Can be less than the
# Actual number of actions due to undos.
private$actions = 0
# Crop coordinates
private$xy1 = c(0, 0)
private$xy2 = NULL
# Crop offsets
# (relative to top left, which is 0, 0)
private$xoffset = 0
private$yoffset = 0
# List of image histories (instances of "siaction")
private$img_history = c()
# Variable to store the source image
private$local_img = NULL
# Variable to store the current image to display
private$current_image = NULL
# The filename used for the autosave in
# case of crashes
#private$autosave_filename = "workspace.si"
#heere
private$autosave_filename =
paste(format(Sys.time(), "%b%d%H%M%S"), "-", "workspace.si",sep="")
# bool value to determine if user can undo
private$order_list = Queue$new()
# Queue that stores non-commutative actions
# currently only supports rotate and crop
private$indexed_images <- vector("list")
# list that stores copies of all versions
# of si objects created
},
# Function to write the current state of the program to
# file.
save = function(file = private$autosave_filename) {
cat(self$logged_image,'$save(',file,')\n',sep="",file='~/history.R',append=TRUE)
# Generated action matrix done in O(1) time.
action_matrix <- matrix(NA,
nrow=length(private$img_history),
ncol=12)
# Fill in the history data
i = 1
for (item in private$img_history) {
history <- item$get_action()
# TODO: Map function perhaps?
action_matrix[i, ] <- c(history[1], history[2],
history[3], history[4],
history[5], history[6],
history[7], history[8],
history[9], history[10],
history[11], history[12])
i = i + 1
}
# Save the current action number
actions <- private$actions
# Save the current image as well
img <- imageData(private$local_img)
order_list = private$order_list
indexed_images = private$indexed_images
# Save everything to file.
base::save(action_matrix, actions, img,
order_list, indexed_images, file=file)
},
# Counterpart to the save function, will load from
# previous save file.
load = function(file = private$autosave_filename) {
cat(self$logged_image,'$load(',file,')\n',sep="",file='~/history.R',append=TRUE)
base::load(file)
# Generate the image history.
private$img_history = c()
private$local_img <- Image(img)
private$order_list = order_list
private$indexed_images = indexed_images
# Not sure if this fixes the issue -- Had
# some weird color issues like loading in
# black and white. This seems to have fixed the
# issue.
colorMode(private$local_img) = Color
# FIll in the action matrix
for (i in 1:dim(action_matrix)[1]) {
# private$add_action(action_matrix[i, 1],
# action_matrix[i, 2],
# action_matrix[i, 3],
# action_matrix[i, 4],
# action_matrix[i, 5],
# action_matrix[i, 6],
# action_matrix[i, 7],
# action_matrix[i, 8],
# action_matrix[i, 9],
# action_matrix[i, 10]
# )
private$update_img_history(
action_matrix[i, 1],
action_matrix[i, 2],
action_matrix[i, 3],
action_matrix[i, 4],
action_matrix[i, 5],
action_matrix[i, 6],
action_matrix[i, 7],
action_matrix[i, 8],
action_matrix[i, 9],
action_matrix[i, 10],
action_matrix[i, 11],
action_matrix[i, 12]
)
}
private$actions <- actions
# Apply the latest action
private$update_all_img_values()
private$current_image <<- private$indexed_images[[private$actions]]
private$render()
},
# Uses the actions list (img_history) to undo the last
# done action. DOES NOT PRUNE THE LIST AT THIS POINT.
undo = function() {
cat(self$logged_image,'$undo()\n',sep='',file='~/history.R',append=TRUE)
# If there are more actions to undo besides the
# original
# image (aka action #1)
if (private$actions != 1) {
private$doUndo()
display(private$current_image, method = "raster")
} else {
# There are no actions to undo.
print("No action to undo")
}
},
# undo function for Shiny app
canUndo = function() {
# If there are more actions to undo besides the
# original
# image (aka action #1)
return (private$actions > 1)
},
# Uses the actions list (img_history) to redo the last
# undone action.
redo = function() {
cat(self$logged_image,'$redo()\n',sep='',file='~/history.R',append=TRUE)
# If there are actions to redo
if (private$actions < length(private$img_history)) {
private$doRedo()
display(private$current_image, method = "raster")
} else {
# No actions to redo.
print("No action to redo")
}
},
# Redo action for Shiny app
canRedo = function() {
cat(self$logged_image,'$redo()\n',sep='',file='~/history.R',append=TRUE)
# If there are actions to redo
return (private$actions < length(private$img_history))
},
# Returns a copy of this image.
# One copy's changes will not affect the other.
copy = function() {
cat(self$logged_image,'$copy()\n',sep='',file='~/history.R',append=TRUE)
#TODO: Different options for cloning,
# like collapsing history
return (self$clone())
},
# Adjusts brightness by 0.1. This is a good increment
# but a variable brightness function should be added.
add_brightness = function() {
#adds function to the history log
cat(self$logged_image,'$add_brightness()\n',sep='',file='~/history.R',append=TRUE)
# Adds 0.1 brightness.
private$do_action(1, 0.1)
},
# Adjusts brightness by -0.1. This is a good decrement
# but a variable brightness function should be added.
remove_brightness = function() {
#adds function to the history log
cat(self$logged_image,'$remove_brightness()\n',sep='',file='~/history.R',append=TRUE)
# removes 0.1 brightness.
private$do_action(1, -0.1)
},
# Adjusts contrast by 0.1. This is a good increment
# but a variable contrast function should be added.
add_contrast = function() {
#adds function to the history log
cat(self$logged_image,'$add_contrast()\n',sep='',file='~/history.R',append=TRUE)
# Adds 0.1 contrast.
private$do_action(3, 0.1)
},
# Adjusts contrast by -0.1. This is a good increment
# but a variable contrast function should be added.
remove_contrast = function() {
#adds function to the history log
cat(self$logged_image,'$remove_contrast()\n',sep='',file='~/history.R',append=TRUE)
# removes 0.1 contrast.
private$do_action(3, -0.1)
},
# Adjusts gamma by 0.5
add_gamma = function() {
#adds function to the history log
cat(self$logged_image,'$add_gamma()\n',sep='',file='~/history.R',append=TRUE)
private$do_action(5, 0.5)
},
# Adjusts gamma by -0.5
remove_gamma = function() {
#adds function to the history log
cat(self$logged_image,'$remove_gamma()\n',sep='',file='~/history.R',append=TRUE)
private$do_action(5, -0.5)
},
# Adjusts blur by 1
add_blur = function() {
#adds function to the history log
cat(self$logged_image,'$add_blur()\n',sep='',file='~/history.R',append=TRUE)
private$do_action(7, 1)
},
# Adjusts blur by -1
remove_blur = function() {
#adds function to the history log
cat(self$logged_image,'$remove_blur()\n',sep='',file='~/history.R',append=TRUE)
private$do_action(7, -1)
},
# Adjusts rotate by 1 degree
add_rotate = function() {
#adds function to the history log
cat(self$logged_image,'$add_rotate()\n',sep='',file='~/history.R',append=TRUE)
# need to add 1 to private$actions because it will only be updated
# after it calls do_action
# private$add_order(2, private$actions + 1, 10, NULL, NULL, NULL)
# actionID = 9
# mutatorAmount = 10; how much rotate is changing
# isNonCommutative = TRUE
# whichNonCommAction = 2 (bc its rotate, not crop)
private$do_action(9, 10, TRUE, 2)
},
# Adjusts rotate by -1 degree
remove_rotate = function() {
#adds function to the history log
cat(self$logged_image,'$remove_rotate()\n',sep='',file='~/history.R',append=TRUE)
# need to add 1 to private$actions because it will only be updated
# after it calls mutator
# private$add_order(2, private$actions + 1, -10, NULL, NULL, NULL)
# private$mutator(9, -10)
# actionID = 9
# mutatorAmount = -10; how much rotate is changing
# isNonCommutative = TRUE
# whichNonCommAction = 2 (bc its rotate, not crop)
private$do_action(9, -10, TRUE, 2)
},
set_brightness = function(brightness) {
#adds function to the history log
cat(self$logged_image,'$set_brightness(',brightness,')\n',sep="",file='~/history.R',append=TRUE)
# Sets brightness.
private$do_action(2, brightness)
},
set_contrast = function(contrast) {
#adds function to the history log
cat(self$logged_image,'$set_contrast(',contrast,')\n',sep="",file='~/history.R',append=TRUE)
# Sets brightness.
private$do_action(4, contrast)
},
set_gamma = function(gamma) {
#adds function to the history log
cat(self$logged_image,'$set_gamma(',gamma,')\n',sep="",file='~/history.R',append=TRUE)
private$do_action(6, gamma)
# Sets gamma correction
},
set_blur = function(blur) {
#adds function to the history log
cat(self$logged_image,'$set_blur(',blur,')\n',sep="",file='~/history.R',append=TRUE)
# Sets blur
private$do_action(8, blur)
},
set_rotate = function(rotate) {
#adds function to the history log
cat(self$logged_image,'$set_rotate(',rotate,')\n',sep="",file='~/history.R',append=TRUE)
# need to add 1 to private$actions because it will only be updated
# after it calls mutator
# private$add_order(2, private$actions + 1, rotate - private$rotate, NULL, NULL, NULL)
# # Sets rotation of image
# private$mutator(10, rotate)
# private$add_order(2, private$actions + 1, 10, NULL, NULL, NULL)
# actionID = 9 (9 was for add/remove rotate but we need to keep it
# for set_rotate so we can pass in the relative value for updating queue)
# mutatorAmount = 10; how much rotate is changing
# isNonCommutative = TRUE
# whichNonCommAction = 2 (bc its rotate, not crop)
private$do_action(9, rotate - private$rotate, TRUE, 2)
},
set_grayscale = function(grayscale) {
#adds function to the history log
cat(self$logged_image,'$set_grayscale(',grayscale,')\n',sep="",file='~/history.R',append=TRUE)
# Sets image to grayscale if argument is 1
# Else image is colormode
# Can revert image to colormode if argument is 0
private$do_action(11, grayscale)
},
change_color_mode = function() {
cat(self$logged_image,'$change_color_mode()\n',sep="",file='~/history.R',append=TRUE)
if (private$grayscale == 1)
private$do_action(11, 0)
else
private$do_action(11, 1)
},
# The command line cropper uses locator to have the
# user locate the two corners of the subimage.
crop = function(x1, x2, y1, y2) {
# If crop coordinates not given, get them from the user.
if (missing(x1) || missing(x2) || missing(y1) || missing(y2))
{
print("Select the two opposite corners
of a rectangle on the plot.")
location = locator(2)
x1 = min(location$x[1], location$x[2])
y1 = min(location$y[1], location$y[2])
x2 = max(location$x[1], location$x[2])
y2 = max(location$y[1], location$y[2])
}
# NM: for history file
cmd <- paste('crop(',
x1, ',', x2, ',', y1, ',', y2, ')', sep='')
cat(self$logged_image,'$',cmd,'\n',sep='',file='~/history.R',append=TRUE)
private$do_action(12, c(x1=x1,x2=x2,y1=y1,y2=y2), TRUE, 1)
},
# flips an image around the horizontal axis
flip_horizontally = function() {
cat(self$logged_image,'$flip_horizontally()\n',sep="",file='~/history.R',append=TRUE)
if (private$flip == 0)
{
flip <- 1
}
if (private$flip == 1)
{
flip <- 0
}
# actionID = 13 for flip
# mutatorAmount = flip (how much flip is changing -- either 1 or 0)
# isNonCommutative = TRUE
# whichNonCommAction = 3 (bc its flip, not crop or rotate or flop)
private$do_action(13, flip, TRUE, 3)
},
# flops an image around the vertical axis
flop_vertically = function() {
cat(self$logged_image,'$flop_horizontally()\n',sep="",file='~/history.R',append=TRUE)
# flips image
if (private$flop == 0)
{
flop <- 1
}
if (private$flop == 1)
{
flop <- 0
}
# actionID = 14 for flop
# mutatorAmount = flop (how much flip is changing -- either 1 or 0)
# isNonCommutative = TRUE
# whichNonCommAction = 4 (bc its flop, not crop or rotate or flip)
private$do_action(14, flop, TRUE, 4)
},
# Returns the size of the current image.
# Needed for Shiny to determine the max values of
# the sliders.
size = function() {
dim(private$current_image)
},
# Gets the raw matrix slices of the current image
get_raw = function() {
return (imageData(private$current_img))
},
# saves image as a jpeg
saveImage = function(file) {
cat(self$logged_image,'$','saveImage(',file,')\n',sep="",file='~/history.R',append=TRUE)
if(missing(file))
{
writeImage(private$current_image, files = "temp.jpg")
}
else
writeImage(private$current_image, file)
},
# returns a copy of the members of the shinyimg object
gethistory = function() {
return(private$myhistory)
},
# returns a copy of the brightness value
get_brightness = function() {
return (private$brightness)
},
# returns a copy of the contrast value
get_contrast = function() {
return (private$contrast)
},
# returns a copy of the gamma value
get_gamma = function() {
return (private$gamma)
},
# returns a copy of the blur value
get_blur = function() {
return (private$blur)
},
# returns a copy of the rotate value
get_rotate = function() {
return(private$rotate)
},
# returns a copy of the grayscale value
# indicates colormode
get_color = function() {
return(private$grayscale)
},
# returns a copy of the flip value
get_flip = function() {
return(private$flip)
},
# returns a copy of the flop value
get_flop = function() {
return(private$flop)
},
# returns a copy of the list of image histories
get_imghistory = function() {
return(private$img_history)
},
# returns a copy of the list of input parameters
get_actions = function() {
return(private$actions)
},
#gets directory of history.R file
get_history_directory = function() {
setwd('~')
return(cat('history.R is located at ', getwd(), '/history.R\n', sep = ""))
}
#Uses a matrix as the image. Can be used to reintegrate
# a get_raw generated matrix.
# Disabled as this feature could be abused.
#import_matrix = function(m) {
# private$set_default()
# private$startup(NULL, NULL, m)
#}
),
private = list(
# The following are the members of the shinyimg obj.
# Default brightness
myhistory = c(0,0,0,0,0,0,0,0,0,0,0,0,0),
#names(myhistory) <- c(1,2,3,4,5,6,7,8,9,10),
brightness = 0,
# Default Contrast
contrast = 1,
gamma = 1,
blur = 0,
rotate = 0,
grayscale = 0,
flip = 0,
flop = 0,
# CURRENT Number of actions. Can be less than the
# Actual number of actions due to undos.
actions = 0,
# Crop coordinates
xy1 = c(0, 0),
xy2 = NULL,
# Crop offsets (relative to top left, which is 0, 0)
xoffset = 0,
yoffset = 0,
# List of image histories
img_history = c(),
# Variable to store the source image
local_img = NULL,
# Variable to store the current image to display
current_image = NULL,
# The filename used for the autosave in case of crashes
#autosave_filename = "workspace.si",
autosave_filename =
paste(format(Sys.time(), "%b%d%H%M%S"), "-", "workspace.si",sep=""),
# refactoring all of the actions from the previous functions
# add_action, mtuator, and add_order
# calls a bunch of helpers
# isNonCommutative: bool value indicates if Non-Commutative (i.e. crop or rotate)
# whichNonCommAction: int to indicate if crop or rotate
# actionIndex: action ID #
# nonCommValues: values of crop or rotate
do_action = function(actionID, mutatorAmount, isNonCommutative = FALSE, whichNonCommAction = -1) {
# default values for functions that modify nonComm
private$remove_potential_redos()
private$actions <- private$actions + 1
if (isNonCommutative)
# do_action parameter that tells if non-commutative
# if non-commuatate
{
private$update_queue(private$actions, whichNonCommAction, mutatorAmount)
}
private$update_img_amount(actionID, mutatorAmount)
private$update_img_history()
private$generate_current_image()
private$generate_queued_image()
private$update_colormode()
# must have a generted image
private$update_saved_images()
private$render()
},
doUndo = function() {
# Step back by one action
private$actions <- private$actions - 1
# we go to our list that contains all the versions
# of our si object
# we go back to the action number
private$update_all_img_values()
private$current_image <<- private$indexed_images[[private$actions]]
},
doRedo = function() {
# Increment by one action, then apply it
private$actions <- private$actions + 1
# we go to our list that contains all the versions
# of our si object
# we go back to the action number
private$update_all_img_values()
private$current_image <<- private$indexed_images[[private$actions]]
},
# prunes img_history and indexed_images
remove_potential_redos = function() {
# private$actions is not updated for this function
# only function to have an un-updated private$actions
# in do_action
# If we are not at the most recent image, we need
# to prune the extra actions for img_history
if (private$actions <
length(private$img_history)) {
private$img_history <-
private$img_history[1:private$actions]
}
# If we are not at the most recent image, we need
# to prune the extra actions for indexed_images
if (private$actions <
length(private$indexed_images)) {
private$indexed_images <-
private$indexed_images[1:private$actions]
}
while (private$order_list$size() > 0 &&
private$actions
< private$order_list$peek(private$order_list$size())[["actionID"]])
{
private$order_list$reverse_pop()
}
},
update_queue = function(actionID, whichNonCommAction, nonCommValue) {
private$order_list$push(c(actionID=actionID,
whichNonCommAction=whichNonCommAction, nonCommValue=nonCommValue))
},
update_crop_values = function(cropValues) {
if (length(cropValues) != 4)
stop("Bad cropValues vector")
cropValues = as.list(cropValues)
x1 = cropValues$x1
x2 = cropValues$x2
y1 = cropValues$y1
y2 = cropValues$y2
# In order to maintain a correct cropping,
# we need to know how much of
# the original image has already been cropped.
xdiff = x2 - x1
ydiff = y2 - y1
# The offset is needed to maintain the ABSOLUTE
# crop data.
private$xoffset = private$xoffset + x1
private$yoffset = private$yoffset + y1
# Create the absolute crop data using the offsets
# and new area.
private$xy1 = c(private$xoffset, private$yoffset)
private$xy2 = c(private$xoffset + xdiff,
private$yoffset + ydiff)
},
# amount is a length 4 vector if the action is a crop.
update_img_amount = function(actionID, amount) {
switch(actionID,
# ActionID 1, brightness adjustment
private$brightness <-
private$brightness + amount,
# ActionID 2, brightness setting
private$brightness <- amount,
# ActionID 3, contrast adjustment
private$contrast <-
private$contrast + amount,
# ActionID 4, contrast setting
private$contrast <- amount,
# ActionID 5, gamm adjustment
private$gamma <-
private$gamma + amount,
# ActionID 6, gamma setting
private$gamma <- amount,
# Action ID 7, blur adjustment
private$blur <-
private$blur + amount,
# Action ID 8, blur setting
private$blur <- amount,
# Action ID 9, rotate adjustment
private$rotate <-
private$rotate + amount,
# Action ID 10, rotate setting
private$rotate <- amount,
# Action ID 11, grayscale setting
private$grayscale <- amount,
# Action ID 12, crop
private$update_crop_values(amount),
# Action ID 13, flip
private$flip <- amount,
# Action ID 14, flop
private$flop <- amount
)
# private$add_action()
},
update_img_history = function(bright = private$brightness,
cont = private$contrast,
gam = private$gamma,
crop1x = private$xy1[1],
crop1y = private$xy1[2],
crop2x = private$xy2[1],
crop2y = private$xy2[2],
blurring = private$blur,
rotation = private$rotate,
colorMode = private$grayscale,
flip_value = private$flip,
flop_value = private$flop) {
private$img_history <-
c(private$img_history, siaction$new(bright,
cont,
gam,
c(
c(crop1x,crop1y),
c(crop2x, crop2y)
),
blurring,
rotation,
colorMode,
flip_value,
flop_value
))
},
# Sets all image values to what they are/were for the
# current action.
update_all_img_values = function() {
# Get the vector of image values of the current action.
args = private$img_history[private$actions]
args = args[[1]]
args = args$get_action()
private$myhistory <- args
private$brightness = args[1]
private$contrast = args[2]
private$gamma = args[3]
# private$xy1 = c(args[4], args[5])
# private$xy2 = c(args[6], args[7])
private$blur = args[8]
private$rotate = args[9]
private$grayscale = args[10]
private$flip = args[11]
private$flop = args[12]
},
generate_current_image = function() {
private$update_all_img_values()
if (private$blur > 0)
{
private$current_image <-
gblur(private$local_img, sigma = private$blur)
}
#need to fix blur back to original image
if (private$blur <= 0)
{
private$current_image <- private$local_img
}
private$current_image <-
private$current_image * private$contrast
private$current_image <-
private$current_image + private$brightness
private$current_image <-
private$current_image ^ private$gamma
},
generate_queued_image = function() {
order_copy <- private$order_list$copy()
while (order_copy$size() != 0)
{
popped <- order_copy$pop()
if (popped[2] == 1)
{
cropValues = as.list(popped[3:6])
x1 = cropValues$nonCommValue.x1
x2 = cropValues$nonCommValue.x2
y1 = cropValues$nonCommValue.y1
y2 = cropValues$nonCommValue.y2
private$current_image <- private$current_image[x1:x2, y1:y2,]
}
else if (popped[2] == 2)
{
private$current_image <- rotate(private$current_image, popped[3])
}
else if (popped[2] == 3)
{
private$current_image <- flip(private$current_image)
}
else if (popped[2] == 4)
{
private$current_image <- flop(private$current_image)
}
}
},
update_colormode = function() {
if (private$grayscale == 1)
private$current_image <- channel(private$current_image, "gray")
},
update_saved_images = function() {
length <- length(private$indexed_images)
private$indexed_images[[length + 1]] <- private$current_image
},
render = function() {
if (!is.null(private$current_image)) {
display(private$current_image, method = "raster")
}
},
# The matr argument imports a matrix as the image.
# The remaining two arguments are supplied by the
# constructors for shinyimg.
startup = function(inputImage, autosave_filename,
matr = NULL) {
# Set the autosave filename if it is not null
if (!is.null(autosave_filename))
private$autosave_filename <- autosave_filename
if (!is.null(inputImage)) {
# Here the user passed in an argument for
# inputImage We use the readImage functionality
# to read in the image to form an EBImage. This
# may be changed at a later time.
private$local_img <- readImage(inputImage)
# Here we set the current image to the original
# image. Multiplying by one essentially copies
# the image. The reason this works is that the
# multiplication function when applied to an
# image changes contrast. In this case, 1 is
# the default contrast, and thus we are
# essentially making a copy by not changing
# the contrast but telling it to make another
# image.
private$current_image <- private$local_img * 1
private$update_saved_images()
# Here we set the xy2 coordinate, which is the
# lower right coordinate of the image.
private$xy2 <- c(dim(private$local_img)[1],
dim(private$local_img)[2])
# Add the "base" action, which is the original
# image.
private$update_img_history()
private$actions <- private$actions + 1
private$render()
# 03/13 COMMENTED OUT
# private$add_action()
} else if (!is.null(matr)) {
# TODO: Possible that m is not actually a matrix.
# Could error.
result = tryCatch({
private$local_img <- Image(matr)
}, warning = function(w) {
return
}, error = function(e) {
return
}, finally = {
});
# Here we set the current image to the original
# image. Multiplying by one essentially copies
# the image. The reason this works is that the
# multiplication function when applied to an
# image changes contrast. In this case, 1 is
# the default contrast, and thus we are
# essentially making a copy by not changing
# the contrast but telling it to make another
# image.
private$current_image <- private$local_img * 1
# Here we set the xy2 coordinate, which is the
# lower right coordinate of the image.
private$xy2 <- c(dim(private$local_img)[1],
dim(private$local_img)[2])
# Add the "base" action, which is the original
# image.
private$update_img_history()
private$actions <- private$actions + 1
private$render()
# 03/13 COMMENTED OUT
# private$add_action()
} else {
# TODO: Maybe some sort of error message?
result = tryCatch({
private$load()
}, warning = function(w) {
}, error = function(e) {
}, finally = {
});
}
}
)
)
#' Wrapper to load an image from a cold boot.
#'
#' @param filename The filename of a file previously generated by shinyimg's $save function.
#' @examples
#'
#' small_tiger = shinyimg$new(system.file("images","tiger_small.jpg",package="ShinyImage"))
#'
#' small_tiger$save("tiger.si")
#' # Restart R
#' reloaded_tiger = shinyload("tiger.si")
#'
#' @export
shinyload = function(filename) {
shinyimg$new(NULL, filename)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.