inst/shinyapp/app19.R
In matloff/ShinyImage: Image Manipulation, with an Emphasis on Journaling
library(shiny)
library(shinyjs)
library(ShinyImage)
#version 19
#synchronizes shinyimg and img
#faster image rendering
#updated comments
#TODO
## (1) still needs to make rendering faster
## (2) need to make imagelog null for null images
## (3) test all combinations
## (4) add options for more functions in EBImage
# --currently rotation is hidden
# ______________________ start of UI _____________________
ui <- fluidPage(
shinyjs::useShinyjs(),
titlePanel("Shiny Image"),
tags$style(type='text/css', "#stop { float:right; }"),
actionButton("stop", "Return to command line"),
tabsetPanel(id = "tabs",
tabPanel("Image Editor", value = "tab1",
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = ("Sample or Upload Image"),
choices = list("Sample" = 1, "Upload Image" = 2, "Upload Link" = 3, "Upload Shiny Image" = 4), selected = 1),
conditionalPanel(
condition = "input.radio == 2",
fileInput(inputId = 'file1',
label = 'Upload Image',
##NM placeholder = 'JPEG, PNG, and TIFF are supported',
accept = c(
"image/jpeg",
"image/x-png",
"image/tiff",
".jpg",
".png",
".tiff"))
),
conditionalPanel(
condition = "input.radio == 3",
textInput(inputId = "url1",
label = 'Upload URL',
##NM placeholder = 'JPEG, PNG, and TIFF are supported',
value = '')
),
conditionalPanel(
condition = "input.radio == 4",
fileInput(inputId = 'file2',
label = 'Upload .si file',
##NM placeholder = "Must be a ShinyImg Object",
accept = c(
"file/si",
".si"))
),
actionButton("color", "Change Color Mode"),
sliderInput("bright", "Increase/Decrease Brightness:", min = -10, max = 10, value = 0, step = 0.1),
sliderInput("contrast", "Increase/Decrease Contrast:", min = -10, max = 10, value = 0, step = 0.1),
sliderInput("gamma", "Increase/Decrease Gamma Correction", min = 0, max = 50, value = 1, step = 0.5),
sliderInput("rotation", "Rotate Image", min = 0, max = 360, value = 0, step = 1),
actionButton("flip", "Flip"),
actionButton("flop", "Flop"),
sliderInput("blurring", "Blur Image", min = 0, max = 20, value = 0, step = 1),
actionButton("button1", "Undo"),
actionButton("button2", "Redo"),
actionButton("button3", "Reset")
#textOutput("dimetext"),
#textOutput("help")
),
mainPanel(
HTML(
paste(
h3('Image Editor', align = "center"),
plotOutput("plot1",
click = "plot_click",
dblclick = "plot_dblclick",
hover = "plot_hover",
brush = "plot_brush"),
'<br/>',
column(6, downloadButton("download1", label = "Download JPG Image")),
column(6, actionButton("download4", label = "Download SI Shiny Image Object")),
'<br/>',
tags$style(type='text/css', "#download1 { display: block; width:100%; margin-left: auto; margin-right:auto;}"),
tags$style(type='text/css', "#download4 { display:block; width:100%; margin-left: auto; margin-right:auto;}"),
'<br/>',
h4('Preview Crop', align = "center"),
h6('Click and drag where you would like to crop the photo. To save the cropped version, press keep', align = "center"),
'<br/>',
plotOutput("plot2"),
tags$style(type='text/css', "#keep { display:block; width:10%; margin-left: auto; margin-right:auto;}"),
'<br/>',
shinyjs::hidden(
actionButton("keep", label = "Keep")
),
'<br/>',
verbatimTextOutput("info")
)
)
)
)
),
tabPanel("View Image Log", value = "tab2",
sidebarLayout(
sidebarPanel(
radioButtons("radio2", label = ("Current Image or Upload .si File"),
choices = list("Current Image" = 1, "Upload .si file" = 2), selected = 1
),
conditionalPanel(
condition = "input.radio2 == 2",
fileInput(inputId = 'file3',
label = 'Upload .si file',
##NM placeholder = "Must be a ShinyImg Object",
accept = c(
"file/si",
".si"))
)
),
mainPanel(
h3("Image Log"),
verbatimTextOutput("ImageLog")
)
)
) # END OF TAB PANEL
) # END OF TAB SET PANEL
) # END OF UI
# ______________________ start of server _____________________
server <- function(input, output, session) {
options(shiny.maxRequestSize=30*1024^2) #file can be up to 30 mb; default is 5 mb
shinyImageFile <- reactiveValues(shiny_img_origin = NULL)
#checks if variable called current exists
#would contain si object if runShiny was given an argument
observeEvent(!is.null(current),
{
updateRadioButtons(session, "radio", selected = 4)
})
#checks radio for file input
observe({
#sample is chosen
#default
if(input$radio == 1)
{
#using image of tiger
# sample.jpg is titled A tiger in the water
# By Bob Jagendorf
# [CC BY 2.0 (http://creativecommons.org/licenses/by/2.0)],
# via Wikimedia Commons
output$plot1 <- renderPlot({
shinyImageFile$shiny_img_origin <-
shinyimg$new(system.file("images", "sample.jpg", package="ShinyImage"))
})
}
#user chose input file option
if (input$radio == 2)
{
reset('file1') #allows plot1 to be null when radio is clicked
# creates a warning to upload correct file
# otherwise outputs image
output$plot1 <- renderPlot({
validate(need(!is.null(input$file1), "Must upload a valid jpg, png, or tiff"))
if (is.null(input$file1))
return(NULL)
})
}
# user chose input link option
if(input$radio == 3)
{
reset('url1') #allows plot1 to be null when radio is clicked
# creates a warning to upload correct link
# otherwise outputs image
output$plot1 <- renderPlot({
validate(need(input$url1 != "", "Must type in a valid jpeg, png, or tiff"))
if (is.null(input$file1))
return(NULL)
})
}
# user chose input si object option
if(input$radio == 4)
{
if (!is.null(current))
{
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- current
updateSliderInput(session, "bright", value = shinyImageFile$shiny_img_origin$get_brightness() * 10)
updateSliderInput(session, "contrast", value = (shinyImageFile$shiny_img_origin$get_contrast() - 1) * 10)
updateSliderInput(session, "gamma", value = shinyImageFile$shiny_img_origin$get_gamma())
updateSliderInput(session, "blurring", value = shinyImageFile$shiny_img_origin$get_blur())
updateSliderInput(session, "rotation", value = shinyImageFile$shiny_img_origin$get_rotate())
# updateSliderInput(session, "flip", value = shinyImageFile$shiny_img_origin$get_flip())
# updateSliderInput(session, "flop", value = shinyImageFile$shiny_img_origin$get_flop())
# updateRadioButtons(session, "color", selected = shinyImageFile$shiny_img_origin$get_color() + 1)
})
}
else
{
reset('file2') #allows plot1 to be null when radio is clicked
# creates a warning to upload correct .si file
# otherwise outputs image
output$plot1 <- renderPlot({
validate(need(!is.null(input$file2), "Must upload a valid .si file"))
if (is.null(input$file1))
return(NULL)
})
} # end of else
} # end of input$radio == 4 if
}) # end of observe
# second observe
# looks at its first 3 lines and observes those inputs
# resets the sliders
observe({
#if user clicks a new radio button, uploads new file, or url
#the sliders will change
#and the brush will default
input$file1
input$url1
input$radio
# update sliders to inital values
# and reset plot brush
updateSliderInput(session, "bright", value = 0)
updateSliderInput(session, "contrast", value = 0)
updateSliderInput(session, "gamma", value = 1)
updateSliderInput(session, "rotation", value = 0)
updateSliderInput(session, "flip", value = 0)
# updateSliderInput(session, "flop", value = 0)
# updateSliderInput(session, "blurring", value = 0)
# updateRadioButtons(session, "color", selected = 1)
session$resetBrush("plot_brush")
# }
})
#//////// CDOE FOR RADIO BUTTONS /////////////
#when user uploads file
#the datapath is different from the one needed to properly recognize photo
#so this function renames the file
renameUpload <- function(inFile) {
if(is.null(inFile))
return(NULL)
oldNames = inFile$datapath
newNames = file.path(dirname(inFile$datapath), inFile$name)
file.rename(from = oldNames, to = newNames)
inFile$datapath <- newNames
return(inFile$datapath)
}
#if they enter a new file, their file will become the new imageFile
observeEvent(input$file1, {
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(renameUpload(input$file1))})
})
#if they enter a new url, their url will become the new new imageFile
observeEvent(input$url1, {
validate(need(input$url1 != "", "Must type in a valid jpeg, png, or tiff"))
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(input$url1)})
})
#if user uploads an image log, they will see the picture with previous settings
#need to update sliders
observeEvent(input$file2, {
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin$load(renameUpload(input$file2))})
#need to update sliders to saved image settings
updateSliderInput(session, "bright", value = shinyImageFile$shiny_img_origin$get_brightness() * 10)
updateSliderInput(session, "contrast", value = (shinyImageFile$shiny_img_origin$get_contrast() - 1) * 10)
updateSliderInput(session, "gamma", value = shinyImageFile$shiny_img_origin$get_gamma())
updateSliderInput(session, "blurring", value = shinyImageFile$shiny_img_origin$get_blur())
updateSliderInput(session, "rotation", value = shinyImageFile$shiny_img_origin$get_rotate())
# updateSliderInput(session, "flip", value = shinyImageFile$shiny_img_origin$get_flip())
# updateSliderInput(session, "flop", value = shinyImageFile$shiny_img_origin$get_flop())
# updateRadioButtons(session, "color", selected = shinyImageFile$shiny_img_origin$get_color() + 1)
})
# #//////// END OF CODE FOR RADIO BUTTONS /////////////
#//////// CODE FOR CROPPING AND PLOTS /////////////
#prompts shiny to look at recursive crop
observe({
recursiveCrop()
})
#only executes when keep is clicked
recursiveCrop <- eventReactive(input$keep,{
isolate({
p <- input$plot_brush
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin$crop(p$xmin,p$xmax,p$ymin,p$ymax)})
})
session$resetBrush("plot_brush")
})
#hides the keep button in the instance in which the user highlighted the plot
#then clicks on the side so that the brush plot disappears
#if user clicks keep without a valid brush, there will be errors
#so we need to hide the button
observeEvent(is.null(input$plot_brush), {
shinyjs::hide("keep")
})
#creates a clone of the image in the main image viewer
#shows the user a preview of the cropped image
#since shinyimg saves every image that is edited, we use a clone
#so that we aren't saving any of the previews
#till the user clicks keep
croppedShiny <- function(image)
{
p <- input$plot_brush
validate(need(p != 'NULL', "Highlight a portion of the photo to see a cropped version!"))
validate(need(p$xmax <= shinyImageFile$shiny_img_origin$size()[1], "Highlighted portion is out of bounds on the x-axis of your image 1"))
validate(need(p$ymax <= shinyImageFile$shiny_img_origin$size()[2], "Highlighted portion is out of bounds on the x-axis of your image 1"))
validate(need(p$xmin >= 0, "Highlighted portion is out of bounds on the x-axis of your image 2"))
validate(need(p$ymin >= 0, "Highlighted portion is out of bounds on the y-axis of your image 2"))
preview <- shinyImageFile$shiny_img_origin$copy()
return(preview$crop(p$xmin,p$xmax,p$ymin,p$ymax))
}
#shows a preview of the cropped function
#shows the keep button (originally hiding)
output$plot2 <- renderPlot({
p <- input$plot_brush
validate(need(p != 'NULL', "Highlight a portion of the photo to see a cropped version!"))
validate(need(p$xmax <= shinyImageFile$shiny_img_origin$size()[1], "Highlighted portion is out of bounds on the x-axis of your image 1"))
validate(need(p$ymax <= shinyImageFile$shiny_img_origin$size()[2], "Highlighted portion is out of bounds on the x-axis of your image 1"))
validate(need(p$xmin >= 0, "Highlighted portion is out of bounds on the x-axis of your image 2"))
validate(need(p$ymin >= 0, "Highlighted portion is out of bounds on the y-axis of your image 2"))
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
#UPDATES SLIDERS
#takes slider input and updates the image
#if statements are to skip rendering the image in the beginning
#with the preset image alterations
observeEvent(input$bright, {
if (input$bright != 0)
{
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_brightness(input$bright / 10))
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
}
})
observeEvent(input$contrast, {
#shiny img
if (input$contrast != 0) {
actualContrast = 1 + (input$contrast / 10)
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_contrast(actualContrast))
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
}
})
observeEvent(input$gamma, {
if (input$gamma != 1)
{
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_gamma(input$gamma))
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
}) }
})
observeEvent(input$rotation, {
if (input$rotation != 0)
{
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_rotate(input$rotation) )
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
}) }
})
observeEvent(input$flip, {
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$flip_horizontally() )
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
})
observeEvent(input$flop, {
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$flop_vertically() )
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
})
observeEvent(input$blurring, {
if (input$blurring != 0)
{
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_blur(input$blurring))
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
}) }
})
observeEvent(input$color, {
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$change_color_mode())
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
})
#//////// END OF CODE FOR CROPPING AND PLOTS /////////////
#//////// CODE FOR RESET /////////////
#if user clicks button3 (reset), then we will make imageFile become the original file
#also resets brightness, contrast, and gamma correction
#and resets plot_brush
#because its a radio button, we need if statements
observeEvent(input$button3, {
if(input$radio == 1)
{
#using image of tiger
# sample.jpg is titled A tiger in the water
# By Bob Jagendorf
# [CC BY 2.0 (http://creativecommons.org/licenses/by/2.0)],
# via Wikimedia Commons
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <-
shinyimg$new(system.file("images", "sample.jpg", package="ShinyImage"))})
}
if(input$radio == 2)
{
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(renameUpload(input$file1))})
}
if(input$radio == 3)
{
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(input$url1)})
}
if(input$radio == 4)
{
#TODO: more testing with previously saved objects
if (!is.null(current))
{
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- current})
}
else
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(renameUpload(input$file1))})
}
#TODO!!! if statement for #4
updateSliderInput(session, "bright", value = 0)
updateSliderInput(session, "contrast", value = 0)
updateSliderInput(session, "gamma", value = 1)
updateSliderInput(session, "rotation", value = 0)
updateSliderInput(session, "blurring", value = 0)
# updateRadioButtons(session, "color", selected = 1)
session$resetBrush("plot_brush")
})
#//////// END OF CODE FOR RESET /////////////
#//////// CODE FOR UNDO AND REDO /////////////
#undo button
observeEvent(input$button1, {
#needed to create a separate functino to check for the number of actions left
#because of the auto render
if (!shinyImageFile$shiny_img_origin$canUndo()) {
showModal(modalDialog(
title = "Important message",
"No more actions to undo!"))
}
else
{
output$plot1 <- renderPlot({
#TODO: look into why its render and not undo
shinyImageFile$shiny_img_origin$undo()
updateSliderInput(session, "bright", value = shinyImageFile$shiny_img_origin$get_brightness() * 10)
updateSliderInput(session, "contrast", value = (shinyImageFile$shiny_img_origin$get_contrast() - 1) * 10)
updateSliderInput(session, "gamma", value = shinyImageFile$shiny_img_origin$get_gamma())
updateSliderInput(session, "blurring", value = shinyImageFile$shiny_img_origin$get_blur())
updateSliderInput(session, "rotation", value = shinyImageFile$shiny_img_origin$get_rotate())
# updateRadioButtons(session, "color", selected = shinyImageFile$shiny_img_origin$get_color() + 1)
})
}
})
#redo button
observeEvent(input$button2, {
if (!shinyImageFile$shiny_img_origin$canRedo()) {
showModal(modalDialog(
title = "Important message",
"No more actions to redo!"))
}
#need to put in else statement otherwise it will try to output a null plot
#because the output of shinyImageFile$shiny_img_origin$redo() is not an image
#when there are no more actions to redo
else
{
output$plot1 <- renderPlot({
redo_output <- shinyImageFile$shiny_img_origin$redo()
updateSliderInput(session, "bright", value = shinyImageFile$shiny_img_origin$get_brightness() * 10)
updateSliderInput(session, "contrast", value = (shinyImageFile$shiny_img_origin$get_contrast() - 1) * 10)
updateSliderInput(session, "gamma", value = shinyImageFile$shiny_img_origin$get_gamma())
updateSliderInput(session, "blurring", value = shinyImageFile$shiny_img_origin$get_blur())
updateSliderInput(session, "rotation", value = shinyImageFile$shiny_img_origin$get_rotate())
# updateRadioButtons(session, "color", selected = shinyImageFile$shiny_img_origin$get_color() + 1)
})
}
})
#//////// END OF CODE FOR UNDO AND REDO /////////////
#//////// CODE FOR HELPFUL TEXTS /////////////
#textbox for user to see what the image ID is
output$idReader <- renderText({
paste0("ID: ", imgID())
})
#creates the textbox below plot2 about the plot_brush details and etc
output$info <- renderText({
xy_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
}
xy_range_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1),
" ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
}
paste0(
"click: ", xy_str(input$plot_click),
"dblclick: ", xy_str(input$plot_dblclick),
"hover: ", xy_str(input$plot_hover),
"brush: ", xy_range_str(input$plot_brush)
)
})
#//////// END OF CODE FOR HELPFUL TEXTS /////////////
#//////// CODE FOR DOWNLOAD BUTTONS /////////////
#_________________DOWNLOAD ____________________
#TODO: if user uploads a .png file, should return same type of file
#currently only returns jpeg because all three radio buttons dont have an image type
#allows user to download plot1 - imageFile
output$download1 <- downloadHandler('temp.jpeg', function(file) {
shinyImageFile$shiny_img_origin$saveImage(file)
})
observeEvent(input$download4, {
shinyImageFile$shiny_img_origin$save()
#creates a pop up window
showModal(modalDialog(
title = "Important message",
"Check your current directory", getwd() ,"for workplace.si for Image History!"))
})
#//////// END OF CODE FOR DOWNLOAD BUTTONS /////////////
#//////// CODE FOR IMAGE LOG VIEWER /////////////
#if user clicked view image log of current image --> edited image --> clicked the tab again
# the radio button is set at current image
# should re-render the img history
observeEvent(input$tabs, {
if (input$tabs == 'tab2' && input$radio2 == 1)
output$ImageLog <- renderPrint({shinyImageFile$shiny_img_origin$get_imghistory()})
})
#should utilize saveHistory
#need to figure out how to load saveHistory
observeEvent(input$file3, {
shinyImageFile$shiny_img_origin$load(renameUpload(input$file3))
output$ImageLog <- renderPrint({shinyImageFile$shiny_img_origin$get_imghistory()})
})
#//////// END OF CODE FOR IMAGE LOG VIEWER /////////////
#//////// START OF CODE FOR STOP SHINY APP ///////////////
#When user clicks the return to command line button
#stops the shiny app
# prevents user from quitting shiny using ^C on commandline
observeEvent(input$stop, {
stopApp()
})
#//////// END OF CODE FOR STOP SHINY APP ///////////////
} #end of server
shinyApp(ui, server)
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.
library(shiny)
library(shinyjs)
library(ShinyImage)
#version 19
#synchronizes shinyimg and img
#faster image rendering
#updated comments
#TODO
## (1) still needs to make rendering faster
## (2) need to make imagelog null for null images
## (3) test all combinations
## (4) add options for more functions in EBImage
# --currently rotation is hidden
# ______________________ start of UI _____________________
ui <- fluidPage(
shinyjs::useShinyjs(),
titlePanel("Shiny Image"),
tags$style(type='text/css', "#stop { float:right; }"),
actionButton("stop", "Return to command line"),
tabsetPanel(id = "tabs",
tabPanel("Image Editor", value = "tab1",
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = ("Sample or Upload Image"),
choices = list("Sample" = 1, "Upload Image" = 2, "Upload Link" = 3, "Upload Shiny Image" = 4), selected = 1),
conditionalPanel(
condition = "input.radio == 2",
fileInput(inputId = 'file1',
label = 'Upload Image',
##NM placeholder = 'JPEG, PNG, and TIFF are supported',
accept = c(
"image/jpeg",
"image/x-png",
"image/tiff",
".jpg",
".png",
".tiff"))
),
conditionalPanel(
condition = "input.radio == 3",
textInput(inputId = "url1",
label = 'Upload URL',
##NM placeholder = 'JPEG, PNG, and TIFF are supported',
value = '')
),
conditionalPanel(
condition = "input.radio == 4",
fileInput(inputId = 'file2',
label = 'Upload .si file',
##NM placeholder = "Must be a ShinyImg Object",
accept = c(
"file/si",
".si"))
),
actionButton("color", "Change Color Mode"),
sliderInput("bright", "Increase/Decrease Brightness:", min = -10, max = 10, value = 0, step = 0.1),
sliderInput("contrast", "Increase/Decrease Contrast:", min = -10, max = 10, value = 0, step = 0.1),
sliderInput("gamma", "Increase/Decrease Gamma Correction", min = 0, max = 50, value = 1, step = 0.5),
sliderInput("rotation", "Rotate Image", min = 0, max = 360, value = 0, step = 1),
actionButton("flip", "Flip"),
actionButton("flop", "Flop"),
sliderInput("blurring", "Blur Image", min = 0, max = 20, value = 0, step = 1),
actionButton("button1", "Undo"),
actionButton("button2", "Redo"),
actionButton("button3", "Reset")
#textOutput("dimetext"),
#textOutput("help")
),
mainPanel(
HTML(
paste(
h3('Image Editor', align = "center"),
plotOutput("plot1",
click = "plot_click",
dblclick = "plot_dblclick",
hover = "plot_hover",
brush = "plot_brush"),
'<br/>',
column(6, downloadButton("download1", label = "Download JPG Image")),
column(6, actionButton("download4", label = "Download SI Shiny Image Object")),
'<br/>',
tags$style(type='text/css', "#download1 { display: block; width:100%; margin-left: auto; margin-right:auto;}"),
tags$style(type='text/css', "#download4 { display:block; width:100%; margin-left: auto; margin-right:auto;}"),
'<br/>',
h4('Preview Crop', align = "center"),
h6('Click and drag where you would like to crop the photo. To save the cropped version, press keep', align = "center"),
'<br/>',
plotOutput("plot2"),
tags$style(type='text/css', "#keep { display:block; width:10%; margin-left: auto; margin-right:auto;}"),
'<br/>',
shinyjs::hidden(
actionButton("keep", label = "Keep")
),
'<br/>',
verbatimTextOutput("info")
)
)
)
)
),
tabPanel("View Image Log", value = "tab2",
sidebarLayout(
sidebarPanel(
radioButtons("radio2", label = ("Current Image or Upload .si File"),
choices = list("Current Image" = 1, "Upload .si file" = 2), selected = 1
),
conditionalPanel(
condition = "input.radio2 == 2",
fileInput(inputId = 'file3',
label = 'Upload .si file',
##NM placeholder = "Must be a ShinyImg Object",
accept = c(
"file/si",
".si"))
)
),
mainPanel(
h3("Image Log"),
verbatimTextOutput("ImageLog")
)
)
) # END OF TAB PANEL
) # END OF TAB SET PANEL
) # END OF UI
# ______________________ start of server _____________________
server <- function(input, output, session) {
options(shiny.maxRequestSize=30*1024^2) #file can be up to 30 mb; default is 5 mb
shinyImageFile <- reactiveValues(shiny_img_origin = NULL)
#checks if variable called current exists
#would contain si object if runShiny was given an argument
observeEvent(!is.null(current),
{
updateRadioButtons(session, "radio", selected = 4)
})
#checks radio for file input
observe({
#sample is chosen
#default
if(input$radio == 1)
{
#using image of tiger
# sample.jpg is titled A tiger in the water
# By Bob Jagendorf
# [CC BY 2.0 (http://creativecommons.org/licenses/by/2.0)],
# via Wikimedia Commons
output$plot1 <- renderPlot({
shinyImageFile$shiny_img_origin <-
shinyimg$new(system.file("images", "sample.jpg", package="ShinyImage"))
})
}
#user chose input file option
if (input$radio == 2)
{
reset('file1') #allows plot1 to be null when radio is clicked
# creates a warning to upload correct file
# otherwise outputs image
output$plot1 <- renderPlot({
validate(need(!is.null(input$file1), "Must upload a valid jpg, png, or tiff"))
if (is.null(input$file1))
return(NULL)
})
}
# user chose input link option
if(input$radio == 3)
{
reset('url1') #allows plot1 to be null when radio is clicked
# creates a warning to upload correct link
# otherwise outputs image
output$plot1 <- renderPlot({
validate(need(input$url1 != "", "Must type in a valid jpeg, png, or tiff"))
if (is.null(input$file1))
return(NULL)
})
}
# user chose input si object option
if(input$radio == 4)
{
if (!is.null(current))
{
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- current
updateSliderInput(session, "bright", value = shinyImageFile$shiny_img_origin$get_brightness() * 10)
updateSliderInput(session, "contrast", value = (shinyImageFile$shiny_img_origin$get_contrast() - 1) * 10)
updateSliderInput(session, "gamma", value = shinyImageFile$shiny_img_origin$get_gamma())
updateSliderInput(session, "blurring", value = shinyImageFile$shiny_img_origin$get_blur())
updateSliderInput(session, "rotation", value = shinyImageFile$shiny_img_origin$get_rotate())
# updateSliderInput(session, "flip", value = shinyImageFile$shiny_img_origin$get_flip())
# updateSliderInput(session, "flop", value = shinyImageFile$shiny_img_origin$get_flop())
# updateRadioButtons(session, "color", selected = shinyImageFile$shiny_img_origin$get_color() + 1)
})
}
else
{
reset('file2') #allows plot1 to be null when radio is clicked
# creates a warning to upload correct .si file
# otherwise outputs image
output$plot1 <- renderPlot({
validate(need(!is.null(input$file2), "Must upload a valid .si file"))
if (is.null(input$file1))
return(NULL)
})
} # end of else
} # end of input$radio == 4 if
}) # end of observe
# second observe
# looks at its first 3 lines and observes those inputs
# resets the sliders
observe({
#if user clicks a new radio button, uploads new file, or url
#the sliders will change
#and the brush will default
input$file1
input$url1
input$radio
# update sliders to inital values
# and reset plot brush
updateSliderInput(session, "bright", value = 0)
updateSliderInput(session, "contrast", value = 0)
updateSliderInput(session, "gamma", value = 1)
updateSliderInput(session, "rotation", value = 0)
updateSliderInput(session, "flip", value = 0)
# updateSliderInput(session, "flop", value = 0)
# updateSliderInput(session, "blurring", value = 0)
# updateRadioButtons(session, "color", selected = 1)
session$resetBrush("plot_brush")
# }
})
#//////// CDOE FOR RADIO BUTTONS /////////////
#when user uploads file
#the datapath is different from the one needed to properly recognize photo
#so this function renames the file
renameUpload <- function(inFile) {
if(is.null(inFile))
return(NULL)
oldNames = inFile$datapath
newNames = file.path(dirname(inFile$datapath), inFile$name)
file.rename(from = oldNames, to = newNames)
inFile$datapath <- newNames
return(inFile$datapath)
}
#if they enter a new file, their file will become the new imageFile
observeEvent(input$file1, {
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(renameUpload(input$file1))})
})
#if they enter a new url, their url will become the new new imageFile
observeEvent(input$url1, {
validate(need(input$url1 != "", "Must type in a valid jpeg, png, or tiff"))
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(input$url1)})
})
#if user uploads an image log, they will see the picture with previous settings
#need to update sliders
observeEvent(input$file2, {
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin$load(renameUpload(input$file2))})
#need to update sliders to saved image settings
updateSliderInput(session, "bright", value = shinyImageFile$shiny_img_origin$get_brightness() * 10)
updateSliderInput(session, "contrast", value = (shinyImageFile$shiny_img_origin$get_contrast() - 1) * 10)
updateSliderInput(session, "gamma", value = shinyImageFile$shiny_img_origin$get_gamma())
updateSliderInput(session, "blurring", value = shinyImageFile$shiny_img_origin$get_blur())
updateSliderInput(session, "rotation", value = shinyImageFile$shiny_img_origin$get_rotate())
# updateSliderInput(session, "flip", value = shinyImageFile$shiny_img_origin$get_flip())
# updateSliderInput(session, "flop", value = shinyImageFile$shiny_img_origin$get_flop())
# updateRadioButtons(session, "color", selected = shinyImageFile$shiny_img_origin$get_color() + 1)
})
# #//////// END OF CODE FOR RADIO BUTTONS /////////////
#//////// CODE FOR CROPPING AND PLOTS /////////////
#prompts shiny to look at recursive crop
observe({
recursiveCrop()
})
#only executes when keep is clicked
recursiveCrop <- eventReactive(input$keep,{
isolate({
p <- input$plot_brush
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin$crop(p$xmin,p$xmax,p$ymin,p$ymax)})
})
session$resetBrush("plot_brush")
})
#hides the keep button in the instance in which the user highlighted the plot
#then clicks on the side so that the brush plot disappears
#if user clicks keep without a valid brush, there will be errors
#so we need to hide the button
observeEvent(is.null(input$plot_brush), {
shinyjs::hide("keep")
})
#creates a clone of the image in the main image viewer
#shows the user a preview of the cropped image
#since shinyimg saves every image that is edited, we use a clone
#so that we aren't saving any of the previews
#till the user clicks keep
croppedShiny <- function(image)
{
p <- input$plot_brush
validate(need(p != 'NULL', "Highlight a portion of the photo to see a cropped version!"))
validate(need(p$xmax <= shinyImageFile$shiny_img_origin$size()[1], "Highlighted portion is out of bounds on the x-axis of your image 1"))
validate(need(p$ymax <= shinyImageFile$shiny_img_origin$size()[2], "Highlighted portion is out of bounds on the x-axis of your image 1"))
validate(need(p$xmin >= 0, "Highlighted portion is out of bounds on the x-axis of your image 2"))
validate(need(p$ymin >= 0, "Highlighted portion is out of bounds on the y-axis of your image 2"))
preview <- shinyImageFile$shiny_img_origin$copy()
return(preview$crop(p$xmin,p$xmax,p$ymin,p$ymax))
}
#shows a preview of the cropped function
#shows the keep button (originally hiding)
output$plot2 <- renderPlot({
p <- input$plot_brush
validate(need(p != 'NULL', "Highlight a portion of the photo to see a cropped version!"))
validate(need(p$xmax <= shinyImageFile$shiny_img_origin$size()[1], "Highlighted portion is out of bounds on the x-axis of your image 1"))
validate(need(p$ymax <= shinyImageFile$shiny_img_origin$size()[2], "Highlighted portion is out of bounds on the x-axis of your image 1"))
validate(need(p$xmin >= 0, "Highlighted portion is out of bounds on the x-axis of your image 2"))
validate(need(p$ymin >= 0, "Highlighted portion is out of bounds on the y-axis of your image 2"))
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
#UPDATES SLIDERS
#takes slider input and updates the image
#if statements are to skip rendering the image in the beginning
#with the preset image alterations
observeEvent(input$bright, {
if (input$bright != 0)
{
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_brightness(input$bright / 10))
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
}
})
observeEvent(input$contrast, {
#shiny img
if (input$contrast != 0) {
actualContrast = 1 + (input$contrast / 10)
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_contrast(actualContrast))
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
}
})
observeEvent(input$gamma, {
if (input$gamma != 1)
{
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_gamma(input$gamma))
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
}) }
})
observeEvent(input$rotation, {
if (input$rotation != 0)
{
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_rotate(input$rotation) )
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
}) }
})
observeEvent(input$flip, {
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$flip_horizontally() )
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
})
observeEvent(input$flop, {
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$flop_vertically() )
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
})
observeEvent(input$blurring, {
if (input$blurring != 0)
{
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$set_blur(input$blurring))
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
}) }
})
observeEvent(input$color, {
output$plot1 <- renderPlot(shinyImageFile$shiny_img_origin$change_color_mode())
output$plot2 <- renderPlot({
croppedShiny(shinyImageFile$shiny_img_origin)
shinyjs::show("keep")
})
})
#//////// END OF CODE FOR CROPPING AND PLOTS /////////////
#//////// CODE FOR RESET /////////////
#if user clicks button3 (reset), then we will make imageFile become the original file
#also resets brightness, contrast, and gamma correction
#and resets plot_brush
#because its a radio button, we need if statements
observeEvent(input$button3, {
if(input$radio == 1)
{
#using image of tiger
# sample.jpg is titled A tiger in the water
# By Bob Jagendorf
# [CC BY 2.0 (http://creativecommons.org/licenses/by/2.0)],
# via Wikimedia Commons
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <-
shinyimg$new(system.file("images", "sample.jpg", package="ShinyImage"))})
}
if(input$radio == 2)
{
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(renameUpload(input$file1))})
}
if(input$radio == 3)
{
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(input$url1)})
}
if(input$radio == 4)
{
#TODO: more testing with previously saved objects
if (!is.null(current))
{
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- current})
}
else
output$plot1 <- renderPlot({shinyImageFile$shiny_img_origin <- shinyimg$new(renameUpload(input$file1))})
}
#TODO!!! if statement for #4
updateSliderInput(session, "bright", value = 0)
updateSliderInput(session, "contrast", value = 0)
updateSliderInput(session, "gamma", value = 1)
updateSliderInput(session, "rotation", value = 0)
updateSliderInput(session, "blurring", value = 0)
# updateRadioButtons(session, "color", selected = 1)
session$resetBrush("plot_brush")
})
#//////// END OF CODE FOR RESET /////////////
#//////// CODE FOR UNDO AND REDO /////////////
#undo button
observeEvent(input$button1, {
#needed to create a separate functino to check for the number of actions left
#because of the auto render
if (!shinyImageFile$shiny_img_origin$canUndo()) {
showModal(modalDialog(
title = "Important message",
"No more actions to undo!"))
}
else
{
output$plot1 <- renderPlot({
#TODO: look into why its render and not undo
shinyImageFile$shiny_img_origin$undo()
updateSliderInput(session, "bright", value = shinyImageFile$shiny_img_origin$get_brightness() * 10)
updateSliderInput(session, "contrast", value = (shinyImageFile$shiny_img_origin$get_contrast() - 1) * 10)
updateSliderInput(session, "gamma", value = shinyImageFile$shiny_img_origin$get_gamma())
updateSliderInput(session, "blurring", value = shinyImageFile$shiny_img_origin$get_blur())
updateSliderInput(session, "rotation", value = shinyImageFile$shiny_img_origin$get_rotate())
# updateRadioButtons(session, "color", selected = shinyImageFile$shiny_img_origin$get_color() + 1)
})
}
})
#redo button
observeEvent(input$button2, {
if (!shinyImageFile$shiny_img_origin$canRedo()) {
showModal(modalDialog(
title = "Important message",
"No more actions to redo!"))
}
#need to put in else statement otherwise it will try to output a null plot
#because the output of shinyImageFile$shiny_img_origin$redo() is not an image
#when there are no more actions to redo
else
{
output$plot1 <- renderPlot({
redo_output <- shinyImageFile$shiny_img_origin$redo()
updateSliderInput(session, "bright", value = shinyImageFile$shiny_img_origin$get_brightness() * 10)
updateSliderInput(session, "contrast", value = (shinyImageFile$shiny_img_origin$get_contrast() - 1) * 10)
updateSliderInput(session, "gamma", value = shinyImageFile$shiny_img_origin$get_gamma())
updateSliderInput(session, "blurring", value = shinyImageFile$shiny_img_origin$get_blur())
updateSliderInput(session, "rotation", value = shinyImageFile$shiny_img_origin$get_rotate())
# updateRadioButtons(session, "color", selected = shinyImageFile$shiny_img_origin$get_color() + 1)
})
}
})
#//////// END OF CODE FOR UNDO AND REDO /////////////
#//////// CODE FOR HELPFUL TEXTS /////////////
#textbox for user to see what the image ID is
output$idReader <- renderText({
paste0("ID: ", imgID())
})
#creates the textbox below plot2 about the plot_brush details and etc
output$info <- renderText({
xy_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
}
xy_range_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1),
" ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
}
paste0(
"click: ", xy_str(input$plot_click),
"dblclick: ", xy_str(input$plot_dblclick),
"hover: ", xy_str(input$plot_hover),
"brush: ", xy_range_str(input$plot_brush)
)
})
#//////// END OF CODE FOR HELPFUL TEXTS /////////////
#//////// CODE FOR DOWNLOAD BUTTONS /////////////
#_________________DOWNLOAD ____________________
#TODO: if user uploads a .png file, should return same type of file
#currently only returns jpeg because all three radio buttons dont have an image type
#allows user to download plot1 - imageFile
output$download1 <- downloadHandler('temp.jpeg', function(file) {
shinyImageFile$shiny_img_origin$saveImage(file)
})
observeEvent(input$download4, {
shinyImageFile$shiny_img_origin$save()
#creates a pop up window
showModal(modalDialog(
title = "Important message",
"Check your current directory", getwd() ,"for workplace.si for Image History!"))
})
#//////// END OF CODE FOR DOWNLOAD BUTTONS /////////////
#//////// CODE FOR IMAGE LOG VIEWER /////////////
#if user clicked view image log of current image --> edited image --> clicked the tab again
# the radio button is set at current image
# should re-render the img history
observeEvent(input$tabs, {
if (input$tabs == 'tab2' && input$radio2 == 1)
output$ImageLog <- renderPrint({shinyImageFile$shiny_img_origin$get_imghistory()})
})
#should utilize saveHistory
#need to figure out how to load saveHistory
observeEvent(input$file3, {
shinyImageFile$shiny_img_origin$load(renameUpload(input$file3))
output$ImageLog <- renderPrint({shinyImageFile$shiny_img_origin$get_imghistory()})
})
#//////// END OF CODE FOR IMAGE LOG VIEWER /////////////
#//////// START OF CODE FOR STOP SHINY APP ///////////////
#When user clicks the return to command line button
#stops the shiny app
# prevents user from quitting shiny using ^C on commandline
observeEvent(input$stop, {
stopApp()
})
#//////// END OF CODE FOR STOP SHINY APP ///////////////
} #end of server
shinyApp(ui, server)
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.