r - 调整重置按钮位置并以闪亮显示

Question

我在下面输入了一个代码作为示例。我相信只有使用此代码，您才有可能帮助我。我想要的是：首先，我希望我的重置按钮仅在选择日历中的日期时出现。在observeEvent(input$reset，我输入了req(input$date2)，但它没有用。第二件事是我希望重置按钮出现在另一个sidebarPanel下方。

可执行代码如下：

library(shiny)
library(shinythemes)
library(dplyr)


ui <- fluidPage(
  
  ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                          br(),
                          
                          tabPanel("",
                                   sidebarLayout(
                                     sidebarPanel(
                                       
                                       uiOutput("date"),
                                       uiOutput("mycode"),
                                       actionButton("reset", "Reset"),

                                       br(),
                                       
                                       
                                     ),
                                     
                                     mainPanel(
                                       tabsetPanel(
                                         tabPanel("", plotOutput("graph",width = "100%", height = "600")
                                         )
                                       ),
                                     ))
                          )))


server <- function(input, output,session) {
  
  #data <- reactive(function.test())
  
  output$date <- renderUI({
    req(data())
    all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
    disabled <- as.Date(setdiff(all_dates, as.Date(data()$date2)), origin = "1970-01-01")
    dateInput(input = "date2", 
              label = h4("Data"),
              min = min(data()$date2),
              max = max(data()$date2),
              value = min(data()$date2),
              format = "dd-mm-yyyy",
              datesdisabled = disabled)
    
  })
  
  output$mycode <- renderUI({
    req(input$date2)
    df1 <- data()
    df2 <- df1[as.Date(df1$date2) %in% input$date2,]
    selectInput("code", label = h4("Category"),choices=unique(df2$Category))
  })
  
  output$graph <- renderPlot({
    req(input$date2,input$code)
    f1(data(),as.character(input$date2),as.character(input$code))
  })
  
  my <- reactiveValues(plot=NULL)
  output$graph <- renderPlot({
    if (!is.null(input$date2) & !is.null(input$code)) {
      my$plot <- f1(data(),as.character(input$date2),as.character(input$code))
    }else {
      my$plot <- NULL
    }
    my$plot
  })
  
  observeEvent(input$reset, {
    req(input$date2)
    df1 <- data()
    my$plot <- NULL 
    updateDateInput(session, 'date2', value = NA)
    updateSelectInput(session, 'code', h4("Category"),choices= unique(df1$Category), selected=character(0))
  })
  
  
}

shinyApp(ui = ui, server = server)

像这样：

按下按钮重置时类别中的奇怪错误

标签： rshiny

Answer 1

尝试

                       conditionalPanel(
                                         condition = "output.mycode",
                                         actionButton("reset", "Reset")
                                       ),

完整代码

function.test<-function(){

  df1 <- structure(
    list(date1= c("2021-06-28","2021-06-28","2021-06-28"),
         date2 = c("2021-07-01","2021-07-02","2021-07-04"),
         Category = c("ABC","ABC","ABC"),
         Week= c("Wednesday","Wednesday","Wednesday"),
         DR1 = c(4,1,0),
         DR01 = c(4,1,0), DR02= c(4,2,0),DR03= c(9,5,0),
         DR04 = c(5,4,0),DR05 = c(5,4,0),DR06 = c(5,4,0),DR07 = c(5,4,0),DR08 = c(5,4,0)),
    class = "data.frame", row.names = c(NA, -3L))



  return(df1)
}

library(shiny)
library(shinythemes)
library(dplyr)


ui <- fluidPage(

  ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                          br(),
                          
                          fluidRow(
                            column(3,
                                   wellPanel(uiOutput("date"),
                                             uiOutput("mycode")
                                             ),
                                   conditionalPanel(condition = "output.mycode", actionButton("reset", "Reset") )
                                   ),

                            column(9,
                                   wellPanel(
                                     plotOutput("graph",width = "100%", height = "600")
                                   ))
                          )
                          ))


server <- function(input, output,session) {

  data <- reactive(function.test())

  output$date <- renderUI({
    req(data())
    all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
    disabled <- as.Date(setdiff(all_dates, as.Date(data()$date2)), origin = "1970-01-01")
    dateInput(input = "date2",
              label = h4("Data"),
              min = min(data()$date2),
              max = max(data()$date2),
              value = NA, # min(data()$date2),
              format = "dd-mm-yyyy",
              datesdisabled = disabled)

  })

  output$mycode <- renderUI({
    req(input$date2)
    df1 <- data()
    df2 <- df1[as.Date(df1$date2) %in% input$date2,]
    selectInput("code", label = h4("Category"),choices=unique(df2$Category))
  })

  output$graph <- renderPlot({
    req(input$date2,input$code)
    f1(data(),as.character(input$date2),as.character(input$code))
  })

  my <- reactiveValues(plot=NULL)
  output$graph <- renderPlot({
    if (!is.null(input$date2) & !is.null(input$code)) {
      my$plot <- plot(cars) ###  f1(data(),as.character(input$date2),as.character(input$code))
    }else {
      my$plot <- NULL
    }
    my$plot
  })

  observeEvent(input$reset, {
    df1 <- data()
    my$plot <- NULL
    updateDateInput(session, 'date2', value = NA)
  })

}

shinyApp(ui = ui, server = server)