问题描述
我已经使用SQL查询在R中提取了下面提到的数据框。
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).
为了简单起见，我只使用了4列数据框，但是在我的原始数据中有30列，它不适合 ui 仪表板的框架。请建议如何构造表并为页眉着色。
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)
所需的样本设计：
推荐答案
在这里您可以做到-
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)
您会接受使用 dateRangeInput（）将日期作为输入，它在 Dev1 中提供查询（在我的代码中已注释掉）。实时查询显示在 verbatimTextOutput（ query）下。我已经创建了 Dev1 eventReactive ，这意味着仅当用户单击运行查询按钮时才会提取数据。这将允许用户在运行查询之前设置日期，从开始到结束（如果要提取大量数据，则很有用）。 mytable 将在 Dev1 更新时进行更新。
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.
还必须
对于水平滚动表，我建议使用 DT 包，如 DTOutput（ scrollable_table）。
For horizontally scroll-able table I'd recommend DT package as demonstrated under DTOutput("scrollable_table").
希望这就是您想要的。
注意：请确保清除 Query 以避免任何SQL注入的可能性。基本的Google搜索应对此有所帮助。
Note: Make sure you sanitize Query to avoid any SQL injection possibilities. Basic google search should help with that.
这篇关于根据Shiny R中的选定日期范围触发查询的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！