Сюжетно не работает должным образом в приложении R shiny

#r #plotly #shinyapps

Вопрос:

Я пытаюсь показать диаграмму графика после нажатия кнопки, что означает, что диаграмма будет отображаться только при нажатии кнопки, но диаграмма просто не отображается… есть какие-либо подсказки по этому поводу? Вот код:

 shinyApp(
  ui = fluidPage(
    sidebarLayout(
      sidebarPanel(
        actionButton("button", "Show Chart")
      ),
      mainPanel(
        plotOutput("bar")
      )
    )
  ),
  server = function(input, output) {
    observeEvent(input$button, {
      category <- c('task1', 'task2', 'task2','task1','task1')
      start_min <- c(0, 0, 16, 45, 40)
      stop_min <- c(14.9,18.8,17.5,65.5, 70)
      group <- c('A', 'B', 'A', 'A', 'B')
      data <- data.frame(category,start_min,stop_min,group)
      
      task_bars <- ggplot(data, mapping=aes(ymin=0, ymax=1,
                                            xmin=start_min, xmax=stop_min,
                                            fill=as.factor(category),
                                            text=paste("Task:", str_wrap(string = category, width = 70,),
                                                       "<br>Start: ", format(start_min, digits=1), "min", 
                                                       "<br>Stop: ", format(stop_min, digits=1), "min")
      ))  
        geom_rect(alpha=0.8)  
        theme_minimal() 
        theme(
          axis.title.x=element_text(color="white"), axis.text.x=element_text(color="white"),
          axis.text.y=element_blank(), axis.ticks.y=element_blank(),
          panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
          panel.border = element_blank(), panel.background = element_blank())  
        scale_fill_discrete(breaks=data$category)
      
      task_bars <- plotly::ggplotly(task_bars, tooltip="text", width = 970, height = 120) %>%
        plotly::config(displayModeBar = TRUE) %>% 
        plotly::layout(plot_bgcolor='black', paper_bgcolor='black', margin = list(b=30, l=0, r=10, t=30))
      
      print(task_bars)
      output$bar <- renderPlotly(task_bars)
    })
  }
)
 

Ответ №1:

Вам нужно переместиться за output$bar пределы observeEvent . Я создал объект reactiveValues для вашего сюжета. observeEvent Создает график, а затем он будет отображаться в выходных данных.

У вас также был plotOutput пользовательский интерфейс вместо plotlyOutput пользовательского интерфейса.

 library(shiny)
library(ggplot2)
library(plotly)

task_bars <- reactiveValues(plot = NULL)

shinyApp(
  ui = fluidPage(
    sidebarLayout(
      sidebarPanel(
        actionButton("button", "Show Chart")
      ),
      mainPanel(
        plotlyOutput("bar")
      )
    )
  ),
  server = function(input, output) {
    observeEvent(input$button, {
      category <- c('task1', 'task2', 'task2','task1','task1')
      start_min <- c(0, 0, 16, 45, 40)
      stop_min <- c(14.9,18.8,17.5,65.5, 70)
      group <- c('A', 'B', 'A', 'A', 'B')
      data <- data.frame(category,start_min,stop_min,group)
      
      task_bars$plot <- ggplot(data, mapping=aes(ymin=0, ymax=1,
                                            xmin=start_min, xmax=stop_min,
                                            fill=as.factor(category)
      ))  
        geom_rect(alpha=0.8)  
        theme_minimal() 
        theme(
          axis.title.x=element_text(color="white"), axis.text.x=element_text(color="white"),
          axis.text.y=element_blank(), axis.ticks.y=element_blank(),
          panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
          panel.border = element_blank(), panel.background = element_blank())  
        scale_fill_discrete(breaks=data$category)

    })
      
    output$bar <- renderPlotly({
if(input$button == 0){
return()
} else {
      print(plotly::ggplotly(task_bars$plot, tooltip="text", width = 970, height = 120) %>%
        plotly::config(displayModeBar = TRUE) %>% 
        plotly::layout(plot_bgcolor='black', paper_bgcolor='black', margin = list(b=30, l=0, r=10, t=30))
      )
}
    })
  }
)