Почему DT Table не печатает из-за функции formatStyle ()? - PullRequest
Новая
       40

Почему DT Table не печатает из-за функции formatStyle ()?

0 голосов
/ 02 мая 2020

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

Проблема в том, что когда фрейм данных определен таким образом, что в указанном диапазоне есть значения (в коде диапазон установлен на 3,5 - 4,5) работает нормально, т. е. таблица печатается, а нужные ячейки окрашиваются в желтый цвет. Странное поведение для меня - это когда значения фрейма данных находятся за пределами диапазона, а фрейм данных не печатается. Я ожидал, что в любом случае он будет напечатан, но ни одна ячейка не будет окрашена в желтый цвет. Я действительно сбит с толку, почему он не работает таким образом!

В следующем примере, представленном ниже, сразу же после наблюдающего события () я определил два фрейма данных с именем dfr . Все отлично работает с первым, но не со вторым (прокомментировано). Когда код запускается с 1-й (или верхней) dfr , он создает таблицу со следующими ячейками желтого цвета: X4 и Y3

Спасибо! 

#
#RepRex VERSION !!!
#
library(shiny)
library(shinydashboard)
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box
library(shinyWidgets)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(DT)
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable

# HEADER
header <- dashboardHeader(title = "", titleWidth = 310, disable = FALSE)
# SIDEBAR
sidebar <- dashboardSidebar(disable = TRUE)
# BODY
body <- dashboardBody(
  fluidRow(
    box(width = 2, title = "Input", status = "primary",solidHeader = TRUE, collapsible = FALSE,
      actionButton(inputId = "calc", label = "Calculate")
    ),
    box(width = 10, title = "Output", status = "primary",solidHeader = TRUE, collapsible = FALSE,
        DT::dataTableOutput("tb")
    )
  )
) # end of BODY

# UI
ui <- dashboardPage(header, sidebar, body, skin = "green")

# SERVER
server <- function(input, output) {

  observeEvent(input$calc, {
    dfr <- data.frame("X" = c(1, 2, 3, 4),         # DOES WORK WITH THIS 
                      "Y" = c(2, 3, 4, 5))

#    dfr <- data.frame("X" <- c(1, 2, 3, 4),          # DOES NOT WORK WITH THIS DATA FRAME !!!
#                      "Y" <- c(2, 3, 3.4, 5))

    # define the top and bottom boundary of the range around the mass loss, to be used for setting the cell color
    boundary_top <- 4.5
    boundary_bottom <- 3.5 

    ######### DT Table CELL COLOR PREP WORK ######################

    # determine the data frame values within this range. this returns logical data frame
    # with TRUE for values within the range. line below omits the 1st column
    # from the search
    dfr_remove1st <- dfr[, -1]
    hits_df <- (dfr_remove1st < boundary_top & dfr_remove1st > boundary_bottom)

    # get the actual values that are within the range and determine their number. use this in the formatStyle()
    hits_values <- dfr_remove1st[hits_df]
    number_of_hits_values <- length(hits_values)
    ######### END OF CELL COLOR PREP WORK #######################

    output$tb <- DT::renderDataTable(
      datatable(dfr, options = list(pageLength=19, lengthChange = FALSE, autoWidth = TRUE)
                ) %>%
        # set cell color based on the values within the 3.5 - 4.5 range 
        formatStyle(names(dfr), backgroundColor = styleEqual(hits_values, rep('yellow',number_of_hits_values)))
      )
  })
}

shinyApp(ui, server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
...