rendering a dataTable using sparklines

[pssguy]

Thanks for this Ramnath. It is a great way to indicate information concisely

Would it be possible to provide a more advanced example based on the table you provided

I would like to show, say, soccer results by season in a table with two columns, one the season in question and the other a sparkline of results - with a tooltip showing data from another column of the source data.frame

df <- data.frame(season=rep(1992:1993,each=5), result = c(1,0,1,-1,0,0,1,1,0,-1), goals=c(2,0,1,0,3,0,2,3,1,0))

example sparkline for one season
sparkline(df[df$season==1992,]$result,type='tristate',posBarColor="green",negBarColor="red", zeroBarColor="blue"
          ,highlightColor="orange")

This sparkline shows win,loss etc. which is good out of the box but it would be nice to have a tooltip that showed the goals instead. Guess, if possible, this is javascript for which I'd appreciate a hand

[ramnathv]

Great question! I have been trying to figure the same thing out for some time now. Can you point me to a page that displays sparklines in a datatable? Once we inspect the html/js, we can figure out how to achieve the same using htmlwidgets.

[pssguy]

I'll have a search. the type of look I would like to replicate include http://www.theguardian.com/football/tables

and the game results section of http://www.basketball-reference.com/teams/TOR/2015.html

but not sure that is going to help with nuts and bolts

[ramnathv]

I figured out an example that uses the DT package and sparkline.

We start by constructing some dummy data.

df <- data.frame(
  season = rep(1992:1993, each=5), 
  result = c(1,0,1,-1,0,0,1,1,0,-1), 
  goals = c(2,0,1,0,3,0,2,3,1,0)
)

We summarize each season by creating a column for results and goals, which are strings containing comma separated values.

library(dplyr)
x = df %>%
  group_by(season) %>%
  summarize(
    result = paste(result, collapse = ","),
    goals = paste(goals, collapse = ",")
  )

Before we construct the datatable, we need to use columnDefs to convert columns 2 and 3 (1 and 2 in javascript) into span elements with the class spark.

columnDefs = list(list(
  targets = c(1, 2),
  render = JS("function(data, type, full){
    return '<span class=spark>' + data + '</span>'           
  }")
))

We also define a callback that initializes a sparkline on elements which have not been initialized before. This is essential for the pagination controls to work correctly. See this question on SO for a more detailed explanation.

fnDrawCallback = JS("function (oSettings, json) {
  $('.spark:not(:has(canvas))').sparkline('html', {
    type: 'bar',
    highlightColor: 'orange'
  });
}")

The final step is to render the datatable. We use the sparkline package and the getDependencies function in htmlwidgets to get the dependencies required for constructing sparklines and then inject it into the dependencies needed by datatable.

d1 <- datatable(x, options = list(
  columnDefs = columnDefs,
  fnDrawCallback = fnDrawCallback
))
d1$dependencies <- htmlwidgets:::getDependency('sparkline')
d1

[pssguy]

Thanks very much.! I have successfully adapted it to some real data

The result field is a difference between goals for and against so that the height reflects the margin of victory or defeat. Ideally, it would display the actual result on rolling over each bar as a tooltip e.g 2-4 v Norwich. Is that possible?

One other point which I guess nothing can be done about is that the bar height relates to an individual sparkline. So it appears as though there is a maximum height which might relate to a victory margin of 6 in one year and 3 another

[ramnathv]

You can use the option chartRangeMax to fix that. The easiest way to do it would be to precompute it for the dataset and pass it on in the fnDrawCallback call.

[ramnathv]

jquery.sparkline does have options to control the tooltip. You will have to read the documentation to figure out what needs to be done. Look up the option tooltipFormatter in particular.

[pssguy]

How should I refer to the precomputed value, rangeMax

chartRangeMax: rangeMax

produced the results string e.g 1,0,0,0,3,0,-2,0,2,3,-1,-1,1,1,-1,3,0

[ramnathv]

I meant precomputing a specific value for the data and feeding it as a number in the fnDrawCallback call.

[pssguy]

That isn't ideal .The max value for each team will vary and I was looking to have an input value as a variable to the initial data.frame. No big deal

[ramnathv]

I am confused. I thought you wanted to set max height to be the same for all seasons, so that the bars are normalized correctly. But what you are saying now, is that you want to be able to vary it by season. Can you elaborate with an example?

[pssguy]

Sorry I was not clear I want this to be a shiny app

df <- data.frame(
  season = rep(1992:1993, each=4), 
  team= rep(c("teamA","teamB"), times=4), 
  goalDiff = c(2,0,-1,0,3,0,2,-7),stringsAsFactors=F
)

selectInput("team","choose team", choices= c("teamA","teamB"))

x = df %>%
  filter(team==input$team) %>%
  group_by(team,season) %>%
  summarize(
    result = paste(goalDiff, collapse = ",")
  ) %>%
  ungroup() %>%
  select(season,result)

fnDrawCallback = JS("function (oSettings, json) {
                $('.spark:not(:has(canvas))').sparkline('html', {
                type: 'bar',
                zeroColor: 'black'

                });
                }")

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

d1 <- datatable(x, options = list(
  columnDefs = columnDefs,
  fnDrawCallback = fnDrawCallback))
d1$dependencies <- htmlwidgets:::getDependency('sparkline')
d1

so the chartRangeMax would need to vary i.e 3 for teamA and 7 for teamB . Calculating this as rangeMax and attempting to put it in columnDefs as

chartRangeMax: rangeMax

does not work

[pssguy]

@ramnathv

Did the above make sense?

Also, how should I wrap this to show as shiny in rmarkdown

If I have

observe({

selectInput("team" ...)

processing

d1

}) The code runs but no table appears

if I replace observe with renderDataTable then a table with default input$team appears but any change although processed results in the error "Cannot reinitialise DataTable"

Not sure if this is relevant but normally in Rmarkdown shiny I run the app using Run Document. This is not an option here and I have to Knit HTML - although I set up file as shiny initially

[ramnathv]

Can you post reproducible code so I can take a look? I understand your use case of wanting to use different rangeMax and I think it is possible. I will post back with an example once I figure that out.

[pssguy]

OK here is an example. would wrap in shinyApp() but not sure wher to put df and libraries

ui.R

library(shiny)
library(dplyr)
library(DT)
library(sparkline)

shinyUI(fluidPage(

      selectInput("team","choose team", choices= c("teamA","teamB")),
      dataTableOutput("table")

))

server.R

df <- data.frame(
  season = rep(1992:1993, each=4), 
  team= rep(c("teamA","teamB"), times=4), 
  goalDiff = c(2,0,-1,0,3,0,2,-7),stringsAsFactors=F
)

shinyServer(function(input, output) {

  output$table <- renderDataTable({

  x = df %>%
    filter(team==input$team) %>%
    group_by(team,season) %>%
    summarize(
      result = paste(goalDiff, collapse = ",")
    ) %>%
    ungroup() %>%
    select(season,result)

  fnDrawCallback = JS("function (oSettings, json) {
                      $('.spark:not(:has(canvas))').sparkline('html', {
                      type: 'bar',
                      zeroColor: 'black'

                      });
}")

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

d1 <- datatable(x, options = list(
  columnDefs = columnDefs,
  fnDrawCallback = fnDrawCallback,
  destroy = TRUE
))

d1$dependencies <- htmlwidgets:::getDependency('sparkline')
d1

  })
})

destroy = TRUE gets rid of the error message but I stil have 2 issues

a) When a new team is selected the existing table remains, albeit filled with correct data b) The roll over no longer shows a value. Running the code outside shiny with a hard-coded input$team e.g. teamA does not have this issue

[ramnathv]

I will not be able to get to this before the weekend. If I come up with a solution, I will let you know.

[pssguy]

tx Likewise

On Wednesday, January 7, 2015 12:04 PM, Ramnath Vaidyanathan notifications@github.com wrote:

I will not be able to get to this before the weekend. If I come up with a solution, I will let you know. — Reply to this email directly or view it on GitHub.

[bthieurmel]

I don't know if it's still relevant, but you can fix the tooltip roll over bug, you can just add quickly this :

shinyUI(fluidPage(

  tags$head(
    tags$style(HTML("
    .jqstooltip{
        box-sizing: content-box;
    }"))
    ),

  selectInput("team","choose team", choices= c("teamA","teamB")),
  dataTableOutput("table")

))

You can find the global solution on https://github.com/gwatts/jquery.sparkline/issues/89

[Alainafox]

Thinks for the example you give above, but I encounter some problems when running your code ,This is the code : df <- data.frame( season = rep(1992:1993, each=5), result = c(1,0,1,-1,0,0,1,1,0,-1), goals = c(2,0,1,0,3,0,2,3,1,0) )

library(dplyr) x = df %>% group_by(season) %>% summarize( result = paste(result, collapse = ","), goals = paste(goals, collapse = ",") )

library(sparkline) library(DT) columnDefs = list(list( targets = c(1, 2), render = JS("function(data, type, full){ return '' + data + ''
}") ))

fnDrawCallback = JS("function (oSettings, json) { $('.spark:not(:has(canvas))').sparkline('html', { type: 'bar', highlightColor: 'orange' }); }")

d1 <- datatable(x, options = list( columnDefs = columnDefs, fnDrawCallback = fnDrawCallback )) d1$dependencies <- htmlwidgets:::getDependency('sparkline') d1

but it dose not show me a graph,so would you please help me with that? Thanks

maybe it is because the version change of DT?

[robrodkey]

@Alainafox : Had the same problem as you when attempting to recreate the above example.

For me, the issue was that

d1$dependencies <- htmlwidgets:::getDependency('sparkline')

was overwriting the "datatables" and "datatables-default" dependencies that were created in the previous statement. I patched this and got my dataTable to show up by modifying that line to the following:

d1$dependencies <- append(d1$dependencies, htmlwidgets:::getDependency('sparkline'))

[fbreitwieser]

Thanks @ramnathv for the example with the precise comments on the steps. Thanks @rob-flatiron for the fix of the dependency!

[timelyportfolio]

going to close, since this seems resolved. Thanks to all those who participated. sparkline is going to CRAN. Please contribute issues, tests, examples to #17.