rshinyshinydashboard

Implement zoom and reset functionality using action buttons in R shiny


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)

Snapshot


Solution

  • 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 
    
        )
      })
    
    
    }