The given R script creates a tabPanel with four action buttons and a reactive scatterPlot from iris data. I want to enable functionality on other three buttons such that second button zooms in the plot, third button zooms-out and fourth button resets the selections done on the plot. I tried "zoom" package and zm() but not serving my purpose. Please help and thanks.
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Zoom and Reset Dashboard",titleWidth = 290),
dashboardSidebar(
width = 0
),
dashboardBody(
# Creation of tabs and tabsetPanel
tabsetPanel(type = "tab",
tabPanel("Resource Dashboard",
fluidRow(
column(1,
tags$head(
tags$style(HTML('#buttonresfreqone:hover {
background-color: #008CBA;
color: #ffffff;
width: 150%;
}'))
),
tags$br(actionButton("buttonresfreqone",
"Activity",style="color: #000000; width:100%;height:50px; ")),
tags$br(),
tags$head(
tags$style(HTML('#buttonresfreqtwo:hover {
background-color: #008CBA;
color: #ffffff;
width: 150%;
}'))
),
tags$br(actionButton("buttonresfreqtwo",
"Zoom-In",style="color: #000000; width:100%;height:50px; ")),
tags$br(),
tags$head(
tags$style(HTML('#buttonresfreqthree:hover {
background-color: #008CBA;
color: #ffffff;
width: 150%;
}'))
),
tags$br(actionButton("buttonresfreqthree",
"Zoom-Out",style="color: #000000; width:100%;height:50px; ")),
tags$br(),
tags$head(
tags$style(HTML('#buttonresfreqfour:hover {
background-color: #008CBA;
color: #ffffff;
width: 150%;
}'))
),
tags$br(actionButton("buttonresfreqfour",
HTML("Reset"),
style="color: #000000;
width:100%;height:50px;"))),
tags$br(),
column(10,
box(title = "Resource Frequency", status =
"primary",height = "460",width = "550", solidHeader = T,
plotOutput("res_freq_plot"))))
),
id= "tabselected"
)
))
server <- function(input, output) {
#Code for Resource Dashboard Resource Frequency Plots
values_res_freq <- reactiveValues(res_freq_one = 0, res_freq_two = 0,
res_freq_three = 0,
res_freq_four = 0, res_freq_five = 0)
observeEvent(input$buttonresfreqone, {
values_res_freq$res_freq_one <- 1
values_res_freq$res_freq_two <- 0
values_res_freq$res_freq_three <- 0
values_res_freq$res_freq_four <- 0
values_res_freq$res_freq_five <- 0
})
observeEvent(input$buttonresfreqtwo, {
values_res_freq$res_freq_one <- 0
values_res_freq$res_freq_two <- 1
values_res_freq$res_freq_three <- 0
values_res_freq$res_freq_four <- 0
values_res_freq$res_freq_five <- 0
})
observeEvent(input$buttonresfreqthree, {
values_res_freq$res_freq_one <- 0
values_res_freq$res_freq_two <- 0
values_res_freq$res_freq_three <- 1
values_res_freq$res_freq_four <- 0
values_res_freq$res_freq_five <- 0
})
observeEvent(input$buttonresfreqfour, {
values_res_freq$res_freq_one <- 0
values_res_freq$res_freq_two <- 0
values_res_freq$res_freq_three <- 0
values_res_freq$res_freq_four <- 1
values_res_freq$res_freq_five <- 0
})
output$res_freq_plot <- renderPlot(
{
if(values_res_freq$res_freq_one)
plot(iris$Sepal.Length)
else
return()
}
)
}
shinyApp(ui, server)
You could give the height and width to the renderPlot function as suggested in this link.
The first step would be creating reactive values for height and width with the default values, then altering the height and width value as per requirement of the clicked button.
I have modified your server code to do exactly that. Hope it helps!
server <- function(input, output) {
#Code for Resource Dashboard Resource Frequency Plots
values_res_freq <- reactiveValues(res_freq_one = 0, res_freq_two = 0,
res_freq_three = 0,
res_freq_four = 0, res_freq_five = 0)
#Reactive values for height and width of the plot
Val <- reactiveValues(height = 400, width = 600)
observeEvent(input$buttonresfreqone, {#Activity
values_res_freq$res_freq_one <- 1
values_res_freq$res_freq_two <- 0
values_res_freq$res_freq_three <- 0
values_res_freq$res_freq_four <- 0
values_res_freq$res_freq_five <- 0
})
observeEvent(input$buttonresfreqtwo, {#Zoom in
values_res_freq$res_freq_one <- 0
values_res_freq$res_freq_two <- 1
values_res_freq$res_freq_three <- 0
values_res_freq$res_freq_four <- 0
values_res_freq$res_freq_five <- 0
#Increase height and width
Val$height <- Val$height *1.25
Val$width <- Val$width *1.25
})
observeEvent(input$buttonresfreqthree, {#Zoom out
values_res_freq$res_freq_one <- 0
values_res_freq$res_freq_two <- 0
values_res_freq$res_freq_three <- 1
values_res_freq$res_freq_four <- 0
values_res_freq$res_freq_five <- 0
#Decrease height and width
Val$height <- Val$height /1.25
Val$width <- Val$width /1.25
})
observeEvent(input$buttonresfreqfour, {#Reset
values_res_freq$res_freq_one <- 0
values_res_freq$res_freq_two <- 0
values_res_freq$res_freq_three <- 0
values_res_freq$res_freq_four <- 1
values_res_freq$res_freq_five <- 0
#Set default value for height and width
Val$height <- 400
Val$width <- 600
})
observe({
output$res_freq_plot <- renderPlot(
{
if(values_res_freq$res_freq_one)
plot(iris$Sepal.Length)
else
return()
}, height = Val$height, width = Val$width
)
})
}