Antonio
Antonio

Reputation: 1111

Adjust reset button position and display in shiny

I have entered a code below just as an example. I believe that only with this code will it be possible for you to help me. What I would like is this: first is that I would like my reset button to appear only when date in the calendar is selected. In observeEvent(input$reset, I entered req(input$date2), but it didn't work. The second thing is that I would like the reset button to appear in other sidebarPanel below the other one.

Executable code below:

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)

Like this:

enter image description here

Strange error in Category when press button reset enter image description here

Upvotes: 1

Views: 200

Answers (1)

YBS
YBS

Reputation: 21349

Try

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

Full code

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)

output

Upvotes: 1

Related Questions