I'm unable to display a Shiny reactive DT within the tabPanel. May I know where the bug is?

The dataset is from Hong Kong Government. It is about the departure / arrival population from various control points since 2021:

Also, may I know how to plot the graph showing the time changes using plotly? I only know how to plot in static version:

df %>%
  mutate(Date = as.Date(Date, format = "%d-%m-%Y")) %>%
  filter(`Control Point` == "Airport") %>%
  gather(Item, Count, `Hong Kong Residents`:Total) %>%
  ggplot(aes(
    x = Date,
    y = Count,
    fill = Item,
    color = `Arrival / Departure`
  ))  
  ggtitle("Daily passenger traffic")  
  scale_x_date(date_labels = "%y/%m", date_breaks  = "3 month")  
  theme(legend.position = "bottom")  
  geom_line()  
  facet_wrap( ~ Item)

Thank you for your help.

CodePudding user response：

Building on a couple of comments above.

Need to format your date in accordance with dateRangeInput() Need to filter with == rather than assignment operator <- Need to filter with column names in the dataframe

library(readr)
library(dplyr)
myData <- read_csv('...statistics_on_daily_passenger_traffic.csv')

#need to reorder and format the Date column
df <- myData %>%
  separate(Date, into = c('day', 'month', 'year'), sep = '-') %>% 
  unite(col = 'date', c(year, month, day), sep = '-') %>% 
  mutate(date = as.Date(date))

ui <-   fluidPage(
  titlePanel("Daily passenger traffic at control points in Hong Kong"),
  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = 'control_point',
       label =  'Select Control Point',
       choices =  unique(df$`Control Point`)
      ),
      radioButtons(
       inputId =  'arrival_departure',
       label =  'Travel',
       choices =  unique(df$`Arrival / Departure`)
      ),
      dateRangeInput(
       inputId =  'date_range',
       label =  'Select Date',
       start = '2021-01-01',
       end = Sys.Date() - 1,
       min = '2021-01-01',
       max = Sys.Date() - 1
      )
    ),
    mainPanel(tabsetPanel(
      tabPanel('Hong Kong Residents', 
DT::DTOutput('plot_hk'),
 plotlyOutput('plot') #there are multiple ways to add plotly graphs
),
      tabPanel('Mainland Visitors'),
      tabPanel('Other Visitors'),
      tabPanel('Total')
    ))
  )
)

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

  rval_plot_hk <- reactive({

      df %>% filter(
        date >= input$date_range[1],
        date <= input$date_range[2],
        `Control Point` == input$control_point, #your code had non-existent column names: control_point & arrival_departure
# your code needs == not assignment operating for filtering
        `Arrival / Departure` == input$arrival_departure
      )
    })

  output$plot_hk <- DT::renderDT({
    rval_plot_hk()
  })
  output$plot <- renderPlotly({
    
p <-     df %>%
      filter(`Control Point` == "Airport") %>%
      gather(Item, Count, `Hong Kong Residents`:Total) %>%
      ggplot(aes(
        x = date,
        y = Count,
        fill = Item,
        color = `Arrival / Departure`
      ))  
      ggtitle("Daily passenger traffic")  
      scale_x_date(date_labels = "%y/%m", date_breaks  = "3 month")  
      theme(legend.position = "bottom")  
      geom_line()  
      facet_wrap( ~ Item)

library(plotly)
ggplotly(p)

    
  })
  
}

shinyApp(ui, server)

CodePudding user response：

@Susan's solution works for me. But I also quickly worked through this:

The following should get your DT to display - you needed to get your date formatted correctly (as mentioned above) and you needed to filter according to the correct column names. Also change the reactive({}) call.

library(readr)
library(dplyr)

statistics_on_daily_passenger_traffic <-
  read_csv(
    "statistics_on_daily_passenger_traffic.csv"
  )
df <- statistics_on_daily_passenger_traffic
df <- df %>%
  select(-ncol(df)) %>%
  mutate(Date = as.Date(Date, format = '%d-%m-%Y')) %>%
  setNames(c('date', 'control_point', 'arrival_departure', 'HK', 'MV', 'OV', 'total')) #use effective names to match your filtering

library(shiny)
library(DT)


ui <-
  fluidPage(
    titlePanel("Daily passenger traffic at control points in Hong Kong"),
    sidebarLayout(
      sidebarPanel(
        selectInput(
          'control_point',
          'Select Control Point',
          unique(df$control_point) #have to change names to match above
        ),
        radioButtons(
          'arrival_departure',
          'Travel',
          unique(df$arrival_departure) #have to change names to match above
        ),
        dateRangeInput(
          'date_range',
          'Select Date',
          start = '2021-01-01',
          end = Sys.Date() - 1,
          min = '2021-01-01',
          max = Sys.Date() - 1
        )
      ),
      mainPanel(tabsetPanel(
        tabPanel('Hong Kong Residents', DTOutput('plot_hk')),
        tabPanel('Mainland Visitors'),
        tabPanel('Other Visitors'),
        tabPanel('Total')
      ))
    )
  )



server <- function(input, output, session) {
  rval_plot_hk <- reactive({
      df %>% filter(
        date >= input$date_range[1], #now your filtering names match your colnames for df
        date <= input$date_range[2],
        control_point == input$control_point, #you need '==' to filter, not assignment ('<-"). 
        arrival_departure == input$arrival_departure
      )
    })
  
  output$plot_hk <- renderDT(rval_plot_hk())
}


shinyApp(ui, server)

Regarding plotly you can simply wrap your plot in ggplotly() (as per @Susan's solution).

Note that for this to work you need to leave the names as you had them - i.e. not update them the way that I did. Also note that gather has been superseded by pivot_longer (https://tidyr.tidyverse.org/reference/gather.html).

library('ggplot2')
library('plotly')
library('tidyr')

ggplotly(df %>%
  mutate(Date = as.Date(Date, format = "%d-%m-%Y")) %>%
  filter(`Control Point` == "Airport") %>% #note that you call the filter verb correctly here, while you use assignment above
  gather(Item, Count, `Hong Kong Residents`:Total) %>%
  ggplot(aes(
    x = Date,
    y = Count,
    fill = Item,
    color = `Arrival / Departure`
  ))  
  ggtitle("Daily passenger traffic")  
  scale_x_date(date_labels = "%y/%m", date_breaks  = "3 month")  
  theme(legend.position = "bottom")  
  geom_line()  
  facet_wrap( ~ Item))