Добавьте стрелку индикации внутри ячейки DT, которая будет показывать тренд для каждого периода времени - PullRequest
Новая
       4

Добавьте стрелку индикации внутри ячейки DT, которая будет показывать тренд для каждого периода времени

0 голосов
/ 24 января 2020

Я создал блестящее приложение, которое использует приведенный ниже кадр данных для суммирования на Dealer, показывающего счет за предыдущий день name и счет за последние 3 дня name на основе того факта, что мы находимся в самой последней дате ("2020-01-09").

Теперь я хочу добавить к каждому выбранному периоду (ячейке) стрелку индикации, которая будет отображать тренд по сравнению с последним периодом той же длины, чтобы вы вычислили среднее число * Например, 1007 * за 3 дня, а затем в фоновом режиме вычислите предыдущие 3 дня. То же самое за предыдущий день. Стрелка будет указывать, если отображается выше или ниже. Я работаю на основе этого ответа здесь . 

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

name<-c("John","John","John","John","John","John","John")
Dealer<-c("ASD","ASD","ASD","ASD","ASD","ASD","ASD")
Date<-c("2020-01-03","2020-01-04","2020-01-05","2020-01-06","2020-01-07","2020-01-08","2020-01-09")
dataset<-data.frame(name,Dealer,Date)

new<-dataset %>%
  mutate(Date = as.Date(Date)) %>%
  arrange_all %>%
  group_by(Dealer) %>%
  summarise(PreviousDay = sum(Date == last(Date) - 1), 
            PreviousThree = sum(Date %in% (last(Date) - 3) : last(Date)))

new2<-dataset %>%
  mutate(Date = as.Date(Date)) %>%
  arrange_all %>%
  group_by(Dealer) %>%
  summarise(PreviousDay = sum(Date == last(Date) - 2), 
            PreviousThree = sum(Date %in% (last(Date) - 6) : last(Date)))

total<-rbind(new,new2)

sidebar <- dashboardSidebar()

body <- dashboardBody(
  fluidRow(box(width = 12, solidHeader = TRUE,
               tableOutput("example_table"))
  )
)

ui <- dashboardPage(dashboardHeader(title = "Example"),
                    sidebar,
                    body
)


server <- function(input, output) {
  output$example_table <- renderTable(total)
}

shinyApp(ui, server)

1 Ответ

1 голос
/ 27 января 2020

Исходя из вашего примера, вот что я сделал: 

library(shiny)
library(shinydashboard)
library(dplyr)
library(formattable)

name<-c("John","John","John","John","John","John","John")
Dealer<-c("ASD","ASD","ASD","ASD","ASD","ASD","ASD")
Date<-c("2020-01-03","2020-01-04","2020-01-05","2020-01-06","2020-01-07","2020-01-08","2020-01-09")
dataset<-data.frame(name,Dealer,Date)

new<-dataset %>%
  mutate(Date = as.Date(Date)) %>%
  arrange_all %>%
  group_by(Dealer) %>%
  summarise(PreviousDay = sum(Date == last(Date) - 1), 
            PreviousThree = sum(Date %in% (last(Date) - 3) : last(Date))) %>%
  mutate(period = 2)

new2<-dataset %>%
  mutate(Date = as.Date(Date)) %>%
  arrange_all %>%
  group_by(Dealer) %>%
  summarise(PreviousDay = sum(Date == last(Date) - 2), 
            PreviousThree = sum(Date %in% (last(Date) - 6) : last(Date))) %>%
  mutate(period = 1)

total<-rbind(new,new2) %>%
  arrange(period)

sidebar <- dashboardSidebar()

body <- dashboardBody(
  fluidRow(box(width = 12, solidHeader = TRUE,
               formattableOutput("example_table"))
  )
)

ui <- dashboardPage(dashboardHeader(title = "Example"),
                    sidebar,
                    body
)


server <- function(input, output) {

  output$example_table <- renderFormattable({
    improvement_formatter <- formatter("span", 
                                       style = x ~ style(font.weight = "bold", 
                                                         color = ifelse(x-lag(x) > 0, "green", 
                                                                        ifelse(x-lag(x) < 0, "red", "black"))), 
                                       x ~ icontext(ifelse(x-lag(x)>0, "arrow-up", 
                                                           ifelse(x-lag(x)<0, "arrow-down", "")), 
                                                    x)
    )
    formattable(total, list(
                `PreviousThree` = improvement_formatter,
                `PreviousDay` = improvement_formatter)
    )
  })
}

shinyApp(ui, server)

В formatter я использую знак x-lag(x), чтобы определить цвет числа и направление стрелки, так как вы хочу эволюцию между двумя периодами. Для этого необходимо создать период столбца в вашем конечном кадре данных, чтобы определить значение lag(x). Если вы не хотите отображать столбец period, вы можете поставить total[, -4] вместо total в formattable.

Я не знаю, может ли это решение быть легко обобщено, но, по крайней мере, это рабочая основа.

См. здесь , чтобы настроить formattable.

...