Implement zoom and reset functionality using action buttons in R shiny

Question

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)

Answer 1

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 

    )
  })


}