Trigger query based on selected date range in Shiny R

Question

I have exctracted below mentioned dataframe in R using SQL query.

Query<-paste0("select ID, Date, Value, Result
               From Table1
               where date(date)>='2018-07-01'
               and date(date)<='2018-08-31');")

Dev1<-dbgetquery(database,Query)

Dev1:

ID        Date                   Value        Result
KK-112    2018-07-01 15:37:45    ACR          Pending
KK-113    2018-07-05 18:14:25    ACR          Pass
KK-114    2018-07-07 13:21:55    ARR          Accepted
KK-115    2018-07-12 07:47:05    ARR          Rejected
KK-116    2018-07-04 11:31:12    RTR          Duplicate
KK-117    2018-07-07 03:27:15    ACR          Pending
KK-118    2018-07-18 08:16:32    ARR          Rejected
KK-119    2018-07-21 18:19:14    ACR          Pending

Using above mentioned dataframe, I have created below mentioned pivot dataframe in R.

Value      Pending   Pass    Accepted   Rejected   Duplicate
ACR          3        1         0          0          0
ARR          0        0         1          2          0
RTR          0        0         0          0          0

And I just want a little help here to trigger those query based on a date range (for example, if one selects some date range on shiny dashboard, data gets automatically updated).

For the sake of simplicity, I have used only 4 columns of dataframe but in my original data I have 30 columns and it's not fitting in the frame on ui dashboard. Please suggest how to structure the table and color the header.

I am using below mentioned sample code to pass the dataframe.

library(shiny)
library(dplyr)
library(shinydashboard)
library(tableHTML)

ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
  tableHTML_output("mytable")
   )
)
server <- function(input, output) {

    Date<-Dev1$Date
    {
    output$mytable <- render_tableHTML( {
      Pivot<-data.table::dcast(Dev1, Value ~ Result, value.var="ID", 
                               fun.aggregate=length)

      Pivot$Total<-rowSums(Pivot[2:3])

      Pivot %>% 
        tableHTML(rownames = FALSE,
                  widths = rep(80, 7))
      })
    }
}
shinyApp(ui, server)

Rrequired sample design:

Answer 1

Here's how you can do it -

library(shiny)
library(dplyr)
library(data.table)
library(shinydashboard)
library(tableHTML)
library(DT)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    dateRangeInput("dates", "Select Dates"),
    actionButton("run_query", "Run Query"),
    br(), br(),
    tags$strong("Query that will be run when user hits above button"),
    verbatimTextOutput("query"),
    br(),
    tableHTML_output("mytable"),
    br(),
    DTOutput("scrollable_table")
  )
)
server <- function(input, output) {

  Dev1 <- eventReactive(input$run_query, {
    # Query <- sprintf("select ID, Date, Value, Result From Table1 where date(date) >= '%s' and date(date) <= '%s');",
    #                  input$dates[1], input$dates[2])
    # dbgetquery(database, Query)
    structure(list(ID = c("KK-112", "KK-113", "KK-114", "KK-115", 
                                  "KK-116", "KK-117", "KK-118", "KK-119"),
                           Date = c("2018-07-01 15:37:45", "2018-07-05 18:14:25", "2018-07-07 13:21:55", "2018-07-12 07:47:05", 
                                    "2018-07-04 11:31:12", "2018-07-07 03:27:15", "2018-07-18 08:16:32", 
                                    "2018-07-21 18:19:14"),
                           Value = c("ACR", "ACR", "ARR", "ARR", "RTR", "ACR", "ARR", "ACR"),
                           Result = c("Pending", "Pass", "Accepted", "Rejected", "Duplicate", "Pending", "Rejected", "Pending")),
                      .Names = c("ID", "Date", "Value", "Result"),
                      row.names = c(NA, -8L), class = "data.frame")
  })

  output$mytable <- render_tableHTML({
    req(Dev1())
    Pivot <- data.table::dcast(Dev1(), Value ~ Result, value.var="ID",
                             fun.aggregate=length)
    Pivot$Total <- rowSums(Pivot[, 2:6])
    Pivot %>%
      tableHTML(rownames = FALSE, widths = rep(80, 7)) %>%
      add_css_header(., css = list(c('background-color'), c('blue')), headers = 1:7)
  })

  output$query <- renderPrint({
    sprintf("select ID, Date, Value, Result From Table1 where date(date) >= '%s' and date(date) <= '%s');",
            input$dates[1], input$dates[2])
  })

  output$scrollable_table <- renderDT({
    data.frame(matrix("test", ncol = 30, nrow = 5), stringsAsFactors = F) %>%
      datatable(options = list(scrollX = TRUE, paginate = F))
  })
}
shinyApp(ui, server)

You would take dates as inputs using dateRangeInput() which feeds the query (commented out in my code) in Dev1. Live query is shown under verbatimTextOutput("query"). I have made Dev1 eventReactive meaning the data will be pulled only when user hits 'Run Query' button. This will allow user to set both, from and to, dates before running the query (useful if you are pulling lot of data). mytable will update whenever Dev1 updates.

Have also added color to tableHTML header.

For horizontally scroll-able table I'd recommend DT package as demonstrated under DTOutput("scrollable_table").

Hope this is what you were looking for.

Note: Make sure you sanitize Query to avoid any SQL injection possibilities. Basic google search should help with that.

Answer 2

You can add a sliderInput to let the user select the desired range of dates, and then make a reactive dataframe that'll subset data based on the user's selected range. I have used the sample data you provided, using minimum and maximum values of Date to assign the range for sliderInput.

library(shiny)
library(dplyr)
library(shinydashboard)
library(tableHTML)
library(DT)

structure(list(ID = structure(1:8, .Label = c("KK-112", "KK-113", "KK-114", "KK-115", "KK-116", "KK-117", "KK-118", "KK-119"), 
                              class = "factor"), 
               Date = structure(c(17713, 17717, 17719, 17724, 17716, 17719, 17730, 17733), 
                                class = "Date"), 
               Value = structure(c(1L, 1L, 2L, 2L, 3L, 1L, 2L, 1L), .Label = c("ACR", "ARR", "RTR"), class = "factor"), 
               Result = structure(c(4L, 3L, 1L, 5L, 2L, 4L, 5L, 4L), .Label = c("Accepted", "Duplicate", "Pass", "Pending", "Rejected"), 
                                  class = "factor")), class = "data.frame", row.names = c(NA, -8L))

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    # Add sliderInput for date - lets the user select a range of dates
    sliderInput("dates.range",
                "Dates:",
                min = min(Dev1$Date),
                max = max(Dev1$Date),
                value = as.Date("2018-07-18"),
                timeFormat="%Y-%m-%d")
  ),
  dashboardBody(
    tableHTML_output("mytable"),
    dataTableOutput("mytable2")
  )
)

server <- function(input, output) {

  data.subsetted.by.date <- reactive({
    # Subset data - select dates which are in the user selected range of dates
    subset(Dev1, Date > min(Dev1$Date) & Date < input$dates.range)
  })
  # Output subsetted data as a DataTable
  output$mytable2 <- renderDataTable(data.subsetted.by.date())

  Date <- Dev1$Date

  output$mytable <- render_tableHTML({
      Pivot <- data.table::dcast(Dev1, Value ~ Result, value.var = "ID", fun.aggregate=length)
      Pivot$Total <- rowSums(Pivot[2:3])
      Pivot %>% 
        tableHTML(rownames = FALSE, widths = rep(80, 7))
    })

}

shinyApp(ui, server)

You can see I have used renderDataTable and dataTableOutput from the DT package. These allow creating scroll-able tables for your shiny app.

Answer 3

For from - to data you can use dateRangeInput() and then use the input from there to filter your data.

For example:

in your UI:

dateRangeInput("ID", "Date", min = as.Date(min(Dev1$Date)), max = as.Date(max(Dev1$Date))

and then in Server:

Pivot <- Dev1 %>% filter(Date >= input$ID[1] & Date <= input$ID[2])

Did I understand your question correct?