使用 R Shiny 中的操作按钮实现缩放和重置功能

Question

给定的 R 脚本创建一个带有四个操作按钮的 tabPanel 和一个来自虹膜数据的反应散点图。我想在其他三个按钮上启用功能，以便第二个按钮放大绘图，第三个按钮缩小，第四个按钮重置在绘图上所做的选择。我尝试了“缩放”包和 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

您可以按照this 链接中的建议为 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 

    )
  })


}