Как установить градиентный оттенок в столбцах DT :: datable? - PullRequest
Новая
       21

Как установить градиентный оттенок в столбцах DT :: datable?

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

У меня есть блестящее приложение, в котором я хочу заполнить числовые c пространства столбцов матричного вывода разными цветами от низкого до высокого в соответствии с каждым значением строки (все они, кроме 'topi c'). Я видел в этой ссылке способ цветовых пространств с помощью color = styleInterval(), но я не могу найти способ подгонки разных цветов для каждого столбца по topi c (учитывая, что они не будут Количество тем каждый раз должно быть одинаковым, но наверняка их будет не более 15 тем, и, конечно, номера каждой колонки будут разными). Важно отметить, что мне нужны одинаковые цвета для каждого из этих 3 других числовых столбцов c, градиент согласно соответствующим значениям. Может кто-нибудь, пожалуйста, скажите мне путь? 

# --------------------------------------- Global --------------------------------------- #

#1. App
if("shiny" %in% rownames(installed.packages()) == FALSE){ install.packages("shiny") }
library(shiny)

#3. Easier data handling
if("dplyr" %in% rownames(installed.packages()) == FALSE){ install.packages("dplyr") }
library(dplyr)

#8. Data Table shiny outputs 
if("DT" %in% rownames(installed.packages()) == FALSE){ install.packages("DT") }
library(DT)

#--------------------------------------- User Interface ---------------------------------------#
ui <- fluidPage( 
  DT::dataTableOutput("topic_info_table")
  )

#--------------------------------------- Server ---------------------------------------#

server <- function(input, output, session) {
# COLOR TABLE BY TOPIC

bytopic <- NULL

output$topic_info_table <- DT::renderDataTable({

  bytopic <- structure(c("Chocolate", "Pineapple", "Coconut", "Jam", "Jelly", 
                        "Soup", "Ice-Cream", "Cake", "Pudin", "Candy", "Pizza", "Rum", 
                        "Vodka", "2016", "2016", "2017", "2016", "2016", "2018", "2016", 
                        "2017", "2016", "2016", "2016", "2017", "2017", "2034", "2036", 
                        "2036", "2029", "2035", "2036", "2035", "2033", "2035", "2035", 
                        "2035", "2034", "2037", "14030.57", "13488.00", "12402.98", "16053.32", 
                        "13256.43", "11388.83", "12005.04", "13691.61", "13161.59", "12605.35", 
                        "12348.48", "12872.83", "10963.04"), .Dim = c(13L, 4L), .Dimnames = list(
                          c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
                            "12", "13"), c("topic", "year", "expiration", "cost")))

  DT::datatable(bytopic, options = list(pageLength = 15)) %>% formatCurrency(c('cost')) 
}) 
}
shinyApp(ui,server)

Идея будет получить что-то вроде: this Легко сделать с помощью conditional formating Excel, где вы форматируете ячейки на основе их ценности. В примере я использовал самый прозрачный зеленый оттенок для минимального значения и самый темный синий оттенок для максимального. Надеюсь, с легендой, которая говорит что-то вроде самого низкого -> самого высокого с градиентом цвета.

1 Ответ

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

Вот решение.

По сути, я использовал этот код для создания функции, которая создает диапазон цветов (помещается перед ui, поскольку он должен запускаться только один раз и не требует перезагрузки с помощью входные данные): 

# General function
colfunc <- colorRampPalette(c("blue", "deepskyblue"))

Затем, поскольку ваши данные представляли собой матрицу, я преобразовал их в кадр данных, а затем не обработал столбцы, чтобы получить их в цифрах c (благодаря функции unfactor, из пакета varhandle): 

bytopic <- as.data.frame(bytopic)
bytopic <- unfactor(bytopic)

Наконец, я использовал эти примеры , чтобы раскрасить столбцы в соответствии с их значениями (только столбец year в блоке ниже): 

formatStyle("year", 
            backgroundColor = styleEqual(sort(unique(bytopic$year), 
                                              decreasing = TRUE),
                                          colfunc(length(unique(bytopic$year)))
                                         )
            )

Проблема в том, что я не могу поместить этот кусок в функцию (возможно, это легко сделать, но мне это не удалось), поэтому вам придется повторять этот код для каждого столбца, который вы хочу раскрасить (надеюсь, у вас их немного). Это не идеально, но, по крайней мере, это рабочая основа.

Вот полный код: 

# --------------------------------------- Global --------------------------------------- #

#1. App
if("shiny" %in% rownames(installed.packages()) == FALSE){ install.packages("shiny") }
library(shiny)

#3. Easier data handling
if("dplyr" %in% rownames(installed.packages()) == FALSE){ install.packages("dplyr") }
library(dplyr)

#8. Data Table shiny outputs 
if("DT" %in% rownames(installed.packages()) == FALSE){ install.packages("DT") }
library(DT)

# General function
colfunc <- colorRampPalette(c("blue", "deepskyblue"))

# Additional package
if("varhandle" %in% rownames(installed.packages()) == FALSE){ install.packages("varhandle") }
library(varhandle)


#--------------------------------------- User Interface ---------------------------------------#
ui <- fluidPage( 
  DT::dataTableOutput("topic_info_table")
)

#--------------------------------------- Server ---------------------------------------#

server <- function(input, output, session) {
  # COLOR TABLE BY TOPIC

  bytopic <- NULL

  output$topic_info_table <- DT::renderDataTable({

    bytopic <- structure(c("Chocolate", "Pineapple", "Coconut", "Jam", "Jelly", 
                           "Soup", "Ice-Cream", "Cake", "Pudin", "Candy", "Pizza", "Rum", 
                           "Vodka", "2016", "2016", "2017", "2016", "2016", "2018", "2016", 
                           "2017", "2016", "2016", "2016", "2017", "2017", "2034", "2036", 
                           "2036", "2029", "2035", "2036", "2035", "2033", "2035", "2035", 
                           "2035", "2034", "2037", "14030.57", "13488.00", "12402.98", "16053.32", 
                           "13256.43", "11388.83", "12005.04", "13691.61", "13161.59", "12605.35", 
                           "12348.48", "12872.83", "10963.04"), .Dim = c(13L, 4L), .Dimnames = list(
                             c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
                               "12", "13"), c("topic", "year", "expiration", "cost")))

    bytopic <- as.data.frame(bytopic)
    bytopic <- unfactor(bytopic)

    DT::datatable(bytopic, options = list(pageLength = 15)) %>% 
      formatCurrency(c('cost')) %>%
      formatStyle("year", 
                  backgroundColor = styleEqual(sort(unique(bytopic$year), 
                                                    decreasing = TRUE),
                                               colfunc(length(unique(bytopic$year)))
                                               )
      ) %>%
      formatStyle("expiration", 
                  backgroundColor = styleEqual(sort(unique(bytopic$expiration), 
                                                    decreasing = TRUE),
                                               colfunc(length(unique(bytopic$expiration)))
                  )
      ) %>%
      formatStyle("cost", 
                  backgroundColor = styleEqual(sort(unique(bytopic$cost), 
                                                    decreasing = TRUE),
                                               colfunc(length(unique(bytopic$cost)))
                  )
      ) 
  }) 
}
shinyApp(ui,server)
...