Dynamische Bedingungen in Formattabelle

Question

Ich verwende Formattable, um eine bedingte Farbformatierung in einer Tabelle in einer glänzenden App zu implementieren. Nehmen wir zum Beispiel an, ich möchte Zellen unter dem Wert 2, grün, über 5, rot und zwischen 2 und 5, orange färben. Ich würde meine Formatierer Funktion wie folgt schreiben:

formatter(
    "span", 
    style = x ~ style(
    color = 'white', 
    'background-color' = 
    ifelse(x > 5, "red", 
     ifelse(x > 2 & x <= 5, "orange", 
     "green")))) 

Aber was ich wirklich tun wollen ist, diese Farbe Schwellenwerte haben, das heißt, 2 und 5, in der Lage sein vom Anwender geändert werden.

Sagen wir also user_low und user_high vom Benutzer definiert werden:

col_format <- 
    formatter(
     "span", 
     style = x ~ style(
     color = 'white', 
     'background-color' = 
     ifelse(x > input$user_high, "red", 
      ifelse(x > input$user_low & x <= input$user_high, "orange", 
      "green")))) 

Wenn ich versuche nun diese Formatierer in formatierbare in meinem glänzenden App zu füttern:

formattable(mtcars, col_format) 

ich folgende Fehlermeldung erhalten :

'col_format' of mode 'function' was not found 

Scheinbar Eingabe $ user_low und Eingabe $ user_high werden nicht ausgewertet und sind ins Tead als Zeichenfolgen im Formatierer behandelt. Ich habe versucht, eval(), eval (parse()), vergeblich.

Irgendwelche Ideen?

Answer 1

Ihr Code ist fast funktional, aber wenn Sie Eingabeelemente wie input$user_high in einem Ausdruck verwenden möchten, müssen Sie einen reactive verwenden.

Dies, um passieren wird:

ändern

1. Die Werte der Eingangselemente. (entweder input$user_low oder input$user_high)
2. Die Spaltenformatierungsbedingung (col_format) wird aktualisiert, da sich ihre Abhängigkeit geändert hat.
3. Die dataTableOutput wird neu gerendert, weil sie von col_format abhängt.

Beispielcode:

library(shiny) 
library(formattable) 
library(DT) 

ui <- fluidPage(
    sidebarLayout(
    sidebarPanel(
     numericInput("user_low", "User low", value = 2, min = 1, max = 5), 
     numericInput("user_high", "User high", value = 8, min = 6, max = 10) 
    ), 

    mainPanel(
     DT::dataTableOutput("table") 
    ) 
) 
) 

server <- function(input, output) { 
    output$table <- DT::renderDataTable({ 
    as.datatable(formattable(mtcars, list(
     cyl = col_format() 
    ))) 
    }) 

    col_format <- reactive({ 
    formatter(
     "span", 
     style = x ~ style(
     color = 'white', 
     'background-color' = 
      ifelse(x > input$user_high, "red", 
       ifelse(x > input$user_low & x <= input$user_high, "orange", 
         "green")))) 
    }) 

} 

shinyApp(ui, server) 

bearbeiten: die Formatierungs zu jeder Spalte (wie pro Ihren Kommentar) anwenden zu können, können Sie lapply verwenden, wie in der in den dynamisch zu erzeugen Formatierer Abschnitt gezeigt Formattable vignette. Der folgende Code wendet die Formatierung auf den gesamten Datensatz an.

Code:

output$table <- DT::renderDataTable({ 
    as.datatable(formattable(mtcars, lapply(1:ncol(mtcars), function(col) { 
    area(row = 1:nrow(mtcars), col) ~ col_format() 
    }))) 
})