R highcharter: enable movements
I am trying to use the highcharter
R "Motion Plugin" package to create a motion diagram for a heat map. That is, I would like the heatmap to change over time using a slider with a play / pause button (see links below).
I can create a simple heat map for a specific year, for example:
df <- tibble(year = c(rep(2016, 6), rep(2017, 6)),
xVar = rep(c("a", "a", "b", "b", "c", "c"), 2),
yVar = rep(c("d", "e"), 6),
heatVar = rnorm(12))
df %>%
filter(year == 2016) %>%
hchart(type = "heatmap", hcaes(x = xVar, y = yVar, value = heatVar)) %>%
hc_legend(layout = "vertical", verticalAlign = "top", align = "right")
However, I am struggling to make it a motion chart (sliding in 2016, 2017 in this example) using a function hc_motion(enabled = TRUE, ...)
.
I have read and followed these links:
https://www.r-bloggers.com/adding-motion-to-choropleths/
http://jkunst.com/highcharter/plugins.html
But no matter how I define my series, I am not getting the expected result. Anyone can show me how to be picked in a series xVar
, yVar
and use the function hc_motion
to make it work?
UPDATE:
Following these answers, I was able to do it using shiny
, but I would rather avoid this solution:
server <- shinyServer(function(input, output) {
output$heatmap <- renderHighchart({
df <- tibble(year = c(rep(2016, 6), rep(2017, 6)),
xVar = rep(c("a", "a", "b", "b", "c", "c"), 2),
yVar = rep(c("d", "e"), 6),
heatVar = rnorm(12))
# filter data based on selected year
df.select <- dplyr::filter(df, year == input$year)
# chart
hchart(df.select, type = "heatmap", hcaes(x = xVar, y = yVar, value = heatVar))
})
})
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Highcharts Heatmap Motion Chart"),
# Sidebar with a slider input for the selected year
sidebarLayout(
sidebarPanel(
sliderInput("year",
"Year:",
min = 2016,
max = 2017,
step = 1,
value = 2016,
animate = TRUE,
sep = "")
),
# Show a bubble plot for the selected year
mainPanel(
highchartOutput("heatmap")
)
)
))
shinyApp(ui = ui, server = server)
source to share
The approach is of course not the cleanest, because it needs to create an initial position (like a standard chart) and then create te sequences for each point.
http://rpubs.com/jbkunst/questions-42945062
So the structure for adding a motion plugin will be:
Simulate data
library(highcharter) library(dplyr) library(purrr) years <- 10 nx <- 5 ny <- 6 df <- data_frame(year = rep(c(2016 + 1:years - 1), each = nx * ny), xVar = rep(1:nx, times = years * ny), yVar = rep(1:ny, times = years * nx)) df <- df %>% group_by(xVar, yVar) %>% mutate(heatVar = cumsum(rnorm(length(year))))
Get initial values
df_start <- df %>% arrange(year) %>% distinct(xVar, yVar, .keep_all = TRUE) df_start #> Source: local data frame [30 x 4] #> Groups: xVar, yVar [30] #> #> year xVar yVar heatVar #> <dbl> <int> <int> <dbl> #> 1 2016 1 1 0.5894443 #> 2 2016 2 2 -1.0991727 #> 3 2016 3 3 1.1209292 #> 4 2016 4 4 0.4936719 #> 5 2016 5 5 -0.4614157 #> # ... with 25 more rows
Grouping for fixed variables to create a list with a sequence
df_seqc <- df %>% group_by(xVar, yVar) %>% do(sequence = list_parse(select(., value = heatVar))) df_seqc #> Source: local data frame [30 x 3] #> Groups: <by row> #> #> # A tibble: 30 × 3 #> xVar yVar sequence #> * <int> <int> <list> #> 1 1 1 <list [10]> #> 2 1 2 <list [10]> #> 3 1 3 <list [10]> #> 4 1 4 <list [10]> #> 5 1 5 <list [10]> #> # ... with 25 more rows
check in
data <- left_join(df_start, df_seqc) #> Joining, by = c("xVar", "yVar") data #> Source: local data frame [30 x 5] #> Groups: xVar, yVar [?] #> #> year xVar yVar heatVar sequence #> <dbl> <int> <int> <dbl> <list> #> 1 2016 1 1 0.5894443 <list [10]> #> 2 2016 2 2 -1.0991727 <list [10]> #> 3 2016 3 3 1.1209292 <list [10]> #> 4 2016 4 4 0.4936719 <list [10]> #> 5 2016 5 5 -0.4614157 <list [10]> #> # ... with 25 more rows
And the diagram
limits <- (unlist(data$sequence)) %>% { c(min(.), max(.)) } limits #> [1] -5.332709 6.270384 hc1 <- hchart(data, type = "heatmap", hcaes(x = xVar, y = yVar, value = heatVar)) hc2 <- hchart(data, type = "heatmap", hcaes(x = xVar, y = yVar, value = heatVar)) %>% hc_motion(enabled = TRUE, series = 0, startIndex = 0, labels = unique(df$year)) %>% hc_legend(layout = "vertical", verticalAlign = "top", align = "right") %>% hc_colorAxis(min = limits[1], max = limits[2])
source to share