使用R Shiny中的動作按鈕實現縮放和重置功能

Question

給定的R腳本從虹膜數據創建一個帶有四個操作按鈕和一個反應性scatterPlot的tabPanel。 我想在其他三個按鈕上啟用功能，例如第二個按鈕放大繪圖，第三個按鈕縮小，第四個按鈕重置在繪圖上所做的選擇。 我嘗試了“ zoom”包和zm（），但沒有達到我的目的。 請幫忙，謝謝。

## 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

您可以按照此鏈接中的建議將高度和寬度賦予renderPlot函數。

第一步是使用默認值創建高度和寬度的反應值，然后根據單擊按鈕的要求更改高度和寬度值。

我已經修改了您的服務器代碼以做到這一點。 希望能幫助到你！

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 

    )
  })


}