Запрос запуска на основе выбранного диапазона дат в Shiny R - PullRequest
Новая
       21

Запрос запуска на основе выбранного диапазона дат в Shiny R

0 голосов
/ 21 сентября 2018

Я извлек нижеупомянутый фрейм данных в R с помощью SQL-запроса. 

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

Используя вышеупомянутый фрейм данных, я создал нижеупомянутый сводный фрейм данных в 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

И мне просто нужна небольшая помощь, чтобы вызвать этот запрос на основе диапазона дат (например, если выбрать какой-либо диапазон дат на блестящей информационной панели, данные автоматически обновляются).

Для простоты я использовал только 4 столбца данных, но в исходных данных у меня 30 столбцов, и он не помещается в рамку на панели инструментов ui.Пожалуйста, предложите, как структурировать таблицу и покрасить заголовок.

Я использую приведенный ниже пример кода для передачи кадра данных. 

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)

Требуемый дизайн образца:

enter image description here

Ответы [ 3 ]

0 голосов
/ 24 сентября 2018

Для данных от - к вы можете использовать dateRangeInput(), а затем использовать вход оттуда для фильтрации ваших данных.

Например:

в вашем UI: 

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

, а затем в Server: 

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

Правильно ли я понял ваш вопрос?

0 голосов
/ 26 сентября 2018

Вот как вы можете это сделать - 

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 обновляется.

Также добавлен цвет в заголовок tableHTML.

Для таблицы с горизонтальной прокруткой я рекомендую пакет DT, как показано в разделе DTOutput("scrollable_table").

Надеюсь, это то, что вы искали.

Примечание: Убедитесь, что вы дезинфицируете Query, чтобы избежать каких-либо возможностей внедрения SQL.Базовый поиск в Google должен помочь с этим.

0 голосов
/ 22 сентября 2018

Вы можете добавить sliderInput, чтобы позволить пользователю выбрать желаемый диапазон дат, а затем создать реактивный фрейм данных, который будет подгруппировать данные на основе выбранного пользователем диапазона.Я использовал предоставленные вами образцы данных, используя минимальные и максимальные значения Date, чтобы назначить диапазон для 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)

Вы можете видеть, что я использовал renderDataTable и dataTableOutput изпакет DT.Это позволяет создавать таблицы с возможностью прокрутки для вашего блестящего приложения.

...