Shinyのスパークラインでデータテーブルをレンダーする

Question

光沢のあるDTにスパークラインを含めることができます。 RStudioビューアでうまく動作しますが、Shinyではスパークラインがレンダリングされません。ここには最小の例があります。

# dependencies 
    require(sparkline) 
    require(DT) 
    require(shiny) 

# create data with sparklines 
    spark_data <- data.frame(
    id = c('spark1', 'spark2'), 
    spark = c(
     spk_chr(values = 1:3, elementId = 'spark1'), 
     spk_chr(values = 3:1, elementId = 'spark2') 
    ) 
) 

# render in RStudio viewer (this works) 
    tbl <- datatable(spark_data, escape = FALSE) 
    spk_add_deps(tbl) 

# render in Shiny (no sparklines rendered in DT) 
    ui <- fluidPage(
     sparklineOutput("test_spark"), 
     dataTableOutput("tbl") 
) 

    server <- function(input, output) { 
    # sparkline outside DT (works fine) - also ensures sparkline dependencies are attached 
     output$test_spark <- renderSparkline(sparkline(1:3)) 

    # sparkline inside DT (does not render) 
     output$tbl <- renderDataTable(
     expr = spark_data, 
     escape = FALSE 
    ) 
    } 

    shinyApp(ui = ui, server = server) 

Answer 1

スパークラインを生成するようにコードを修正しました。私はスパークラインを生成するためにこのlinkを参照しました。

require(sparkline) 
require(DT) 
require(shiny) 

# create data 
spark_data1<- data.frame(id = c('spark1', 'spark2'), 
          spark = c("1,2,3", "3,2,1")) 



ui <- fluidPage(
    sparklineOutput("test_spark"), 
    DT::dataTableOutput("tbl") 
) 

server <- function(input, output) { 

    line_string <- "type: 'line', lineColor: 'black', fillColor: '#ccc', highlightLineColor: 'orange', highlightSpotColor: 'orange'" 

    cd <- list(list(targets = 1, render = JS("function(data, type, full){ return '<span class=sparkSamples>' + data + '</span>' }"))) 

    cb = JS(paste0("function (oSettings, json) {\n $('.sparkSamples:not(:has(canvas))').sparkline('html', { ", 
       line_string, " });\n}"), collapse = "") 

    output$tbl <- DT::renderDataTable({ 
    dt <- DT::datatable(as.data.frame(spark_data1), rownames = FALSE, options = list(columnDefs = cd,fnDrawCallback = cb)) 
    }) 
} 

shinyApp(ui = ui, server = server) 

希望します。

Answer 2

古い質問ですが、私は知っていますが、質問の情報に基づいてAdd label to sparkline plot in datatable私は解決策は、もともと何を試しただけでプラスの数行と思う。ここでは、パーツをトリミングしてビューアでデモを行い、スパークラインを動作させるために必要なものを追加しました。

# dependencies 
require(sparkline) 
require(DT) 
require(shiny) 

# create data with sparklines 
spark_data <- data.frame(
    id = c('spark1', 'spark2'), 
    spark = c(
    spk_chr(values = 1:3, elementId = 'spark1'), 
    spk_chr(values = 3:1, elementId = 'spark2') 
) 
) 

### adding this <------------ 
cb <- htmlwidgets::JS('function(){debugger;HTMLWidgets.staticRender();}') 

ui <- fluidPage(
    ### and this <------------ 
    htmlwidgets::getDependency('sparkline'), 
    dataTableOutput("tbl") 
) 

server <- function(input, output) { 

    output$tbl <- renderDataTable(
    expr = spark_data, 
    escape = FALSE, 
    ### and this <------------ 
    options = list(
     drawCallback = cb 
    ) 
) 
} 

shinyApp(ui = ui, server = server)