R highcharter: приводим в движение тепловые карты

Я пытаюсь использовать пакет highcharter R «Плагин движения», чтобы создать анимационную диаграмму для тепловой карты. Т.е. Я бы хотел, чтобы тепловая карта менялась со временем, используя ползунок с кнопкой воспроизведения / паузы (см. Ссылки ниже).

Я могу создать простую тепловую карту для определенного года, например:

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")

тепловая карта highcharter

Однако мне сложно сделать это анимационным графиком (в этом примере он скользит по 2016 и 2017 годам), используя функцию hc_motion(enabled = TRUE, ...).

Я прочитал и перешел по этим ссылкам:

https://www.r-bloggers.com/adding-motion-to-choropleths/

http://jkunst.com/highcharter/plugins.html

Но как бы я ни определял свою серию, я не получаю ожидаемого результата. Кто-нибудь может указать мне, как следует определять серии xVar, yVar и использовать функцию hc_motion, чтобы заставить их работать?

ОБНОВИТЬ:

После этого ответа мне удалось это сделать с помощью shiny, но я все же предпочел бы избегать этого решения:

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)

r highcharts heatmap r-highcharter
person Giora Simchoni    schedule 22.03.2017    source источник

Ответы (1)


arrow_upward
4
arrow_downward

Этот подход, безусловно, не самый чистый, потому что необходимо создать начальную позицию (как стандартную диаграмму), а затем создать последовательности te для каждой точки.

http://rpubs.com/jbkunst/questions-42945062

Итак, структура для добавления плагина движения будет следующей:

Имитация данных


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))))

Получить начальные значения

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

Группировка фиксированных переменных для создания списка с последовательностью

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

Присоединиться

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

И диаграмма

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])
person jbkunst    schedule 26.03.2017
comment
Большое спасибо! Однако обратите внимание на небольшую проблему при использовании nx = ny в строке distinct(xVar, yVar, .keep_all = TRUE) - вы получите тепло только при xVar == yVar и, в конечном итоге, тепловая карта только по диагонали. - person Giora Simchoni; 27.03.2017