/R/mod_jhu_death_rate.R

https://github.com/JohnCoene/coronavirus · R · 105 lines · 71 code · 12 blank · 22 comment · 1 complexity · 292fc8343a00e0bd725e5297bb9e2567 MD5 · raw file

  1. # Module UI
  2. #' @title mod_jhu_death_rate_ui and mod_jhu_death_rate_server
  3. #' @description A shiny Module.
  4. #'
  5. #' @param id shiny id
  6. #' @param input internal
  7. #' @param output internal
  8. #' @param session internal
  9. #'
  10. #' @rdname mod_jhu_death_rate
  11. #'
  12. #' @keywords internal
  13. #' @export
  14. #' @importFrom shiny NS tagList
  15. mod_jhu_death_rate_ui <- function(id){
  16. ns <- NS(id)
  17. f7Card(
  18. id = ns("card"),
  19. title = "Death Rate",
  20. echarts4r::echarts4rOutput(ns("trend"), height = 395),
  21. footer = f7Row(
  22. f7Col(uiOutput(ns("copy_ui"))),
  23. f7Col("deaths / confirmed")
  24. )
  25. )
  26. }
  27. # Module Server
  28. #' @rdname mod_jhu_death_rate
  29. #' @export
  30. #' @keywords internal
  31. mod_jhu_death_rate_server <- function(input, output, session, df){
  32. ns <- session$ns
  33. embed_url <- golem::get_golem_options("embed_url")
  34. output$copy_ui <- renderUI({
  35. copy(embed_url, "jhu", "&chart=death-rate")
  36. })
  37. output$trend <- echarts4r::renderEcharts4r({
  38. mod_jhu_death_rate_echarts(df)
  39. })
  40. }
  41. mod_jhu_death_rate_echarts <- function(df){
  42. form <- htmlwidgets::JS("function(value){
  43. return(value + '%')
  44. }")
  45. df %>%
  46. dplyr::filter(country_iso2c == "CN") %>%
  47. dplyr::group_by(date, type) %>%
  48. dplyr::summarise(cases = sum(cases, na.rm = TRUE)) %>%
  49. dplyr::ungroup() %>%
  50. tidyr::pivot_wider(
  51. id_cols = date,
  52. names_from = type,
  53. values_from = cases,
  54. values_fill = list(
  55. cases = 0
  56. )
  57. ) %>%
  58. dplyr::mutate(
  59. rate = death / (confirmed),
  60. rate = round(rate * 100, 3)
  61. ) %>%
  62. echarts4r::e_charts(date) %>%
  63. echarts4r::e_area(rate, name = "Death rate") %>%
  64. echarts4r::e_tooltip(trigger = "axis") %>%
  65. echarts4r::e_legend(FALSE) %>%
  66. echarts4r::e_y_axis(formatter = form) %>%
  67. echarts4r::e_visual_map(
  68. rate,
  69. show = FALSE,
  70. inRange = list(
  71. color = deaths_pal
  72. )
  73. ) %>%
  74. echarts4r::e_mark_point(
  75. data = list(type = "max"),
  76. itemStyle = list(color = "white"),
  77. label = list(color = "#000"),
  78. title = "Max"
  79. ) %>%
  80. echarts4r::e_mark_line(
  81. data = list(type = "average"),
  82. itemStyle = list(color = "white"),
  83. title = "Average"
  84. ) %>%
  85. echarts4r::e_hide_grid_lines() %>%
  86. echarts4r::e_theme(theme) %>%
  87. echarts4r::e_group("JHU") %>%
  88. echarts4r::e_connect_group("JHU")
  89. }
  90. ## To be copied in the UI
  91. # mod_jhu_death_rate_ui("jhu_death_rate_ui_1")
  92. ## To be copied in the server
  93. # callModule(mod_jhu_death_rate_server, "jhu_death_rate_ui_1")