r - 更新 R shiny 中 ActionButton 单击事件的 Plot 输出

Question

我正在尝试使用 ActionButton 单击更新文本和绘图。

我的尝试-

library(shiny)
library(ggplot2)
library(shinyWidgets)

  ui <- fluidPage(
    actionGroupButtons(
      inputIds = c("Bar", "Histogram", "Line"),
      labels = list("Bar", "Histogram","Line"),
      status = "danger",
      fullwidth = T
    ),
   plotOutput('plot',height = '563px'),
   verbatimTextOutput('text')

  )

  server <- function(input, output) {
    output$plot <- renderPlot({

      if(req(input$Bar)!=0) {
      isolate({
        data <- iris
       ggplot(data, aes(Species,Petal.Length)) +
        geom_bar(stat="identity") 
      })

      } else if(req(input$Histogram)>0){
        isolate({
          data <-  iris
          ggplot(data, aes(Petal.Length)) +
            geom_histogram()

        })

      }  else if(req(input$Line)>0){
        isolate({
          data <-  iris
          ggplot(data, aes(Petal.Length,Sepal.Length)) +
            geom_line()

        })
      }

    })


    output$text <- renderText({

      if(req(input$Bar)!=0) {
        "Bar"

      } else if(req(input$Histogram)>0){

        "Histogram"

      }  else if(req(input$Line)>0){
        "Line"
      }

    })
  }

  shinyApp(ui, server)

我想在单击相应的操作按钮时更改情节和文本。

Answer 1

这是一种方法。在本质上，该方法在 action button example no. 3 中指出。来自 RStudio。

library(shiny)
library(ggplot2)
library(shinyWidgets)

ui <- fluidPage(

  actionGroupButtons(
    inputIds = c("Bar", "Histogram", "Line"),
    labels = list("Bar", "Histogram","Line"),
    status = "danger",
    fullwidth = T
  ),

  plotOutput('plot',height = '563px'),
  verbatimTextOutput('text')

)

server <- function(input, output) {

  v <- reactiveValues(data = iris,
                      plot = NULL,
                      text = NULL)

  observeEvent(input$Bar, {
    v$plot <- ggplot(v$data, aes(Species,Petal.Length)) +
                geom_bar(stat="identity") 
    v$text <- "Bar"
  })

  observeEvent(input$Histogram, {
    data <- iris
    v$plot <- ggplot(v$data, aes(Petal.Length)) +
                 geom_histogram()
    v$text <- "Histogram"
  })  

  observeEvent(input$Line, {
    data <- iris
    v$plot <- ggplot(v$data, aes(Petal.Length,Sepal.Length)) +
                  geom_line()
    v$text <- "Line"
  })  

  output$plot <- renderPlot({
    if (is.null(v$plot)) return()
    v$plot
  })


  output$text <- renderText({

    if (is.null(v$text)) return()
    v$text

  })
}

shinyApp(ui, server)

更新

如果您在响应式数据中使用输入过滤器，则必须稍微调整方法:

library(shiny)
library(ggplot2)
library(shinyWidgets)

ui <- fluidPage(

    selectInput(inputId = "species", label = "Select species:",
                choices = unique(as.character(iris$Species)),
                selected = "setosa"),

    sliderInput("sepal_length", "Limit sepal length:",
                round = 0,
                min = range(iris$Sepal.Length)[1], max = range(iris$Sepal.Length)[2],
                range(iris$Sepal.Length),
                step = 0.1),

    actionGroupButtons(
        inputIds = c("Bar", "Histogram", "Line"),
        labels = list("Bar", "Histogram","Line"),
        status = "danger",
        fullwidth = T
    ),

    plotOutput('plot',height = '563px'),
    verbatimTextOutput('text')

)

server <- function(input, output) {

    data <- reactive({

        temp <- subset(iris, Species == input$species)
        subset(temp, Sepal.Length < input$sepal_length)

    })

    v <- reactiveValues(plot = NULL,
                        text = NULL)

    observeEvent(input$Bar, {
        v$plot <- ggplot(data(), aes(Species,Petal.Length)) +
            geom_bar(stat="identity") 
        v$text <- "Bar"
    })

    observeEvent(input$Histogram, {
        v$plot <- ggplot(data(), aes(Petal.Length)) +
            geom_histogram()
        v$text <- "Histogram"
    })  

    observeEvent(input$Line, {
        v$plot <- ggplot(data(), aes(Petal.Length,Sepal.Length)) +
            geom_line()
        v$text <- "Line"
    })  

    output$plot <- renderPlot({
        if (is.null(v$plot)) return()
        v$plot
    })


    output$text <- renderText({

        if (is.null(v$text)) return()
        v$text

    })
}

shinyApp(ui, server)