问题
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:
回答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.
回答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.
回答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?
来源：https://stackoverflow.com/questions/52447285/trigger-query-based-on-selected-date-range-in-shiny-r