Closed pssguy closed 7 years ago
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.
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
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
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
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.
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.
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
I meant precomputing a specific value for the data and feeding it as a number in the fnDrawCallback
call.
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
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?
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
@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
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.
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
I will not be able to get to this before the weekend. If I come up with a solution, I will let you know.
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.
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
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?
@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'))
Thanks @ramnathv for the example with the precise comments on the steps. Thanks @rob-flatiron for the fix of the dependency!
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.
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
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