選択できるのは25トピックまでです。 トピックは、先頭が英数字で、英数字とダッシュ('-')を使用した35文字以内のものにしてください。

151 行
4.1KB

  1. #' Animates a join operation
  2. #'
  3. #' Functions to visualise the join operations either static as a ggplot, or
  4. #' dynamic as a gif.
  5. #'
  6. #' @param x the x dataset
  7. #' @param y the y dataset
  8. #' @param by the by arguments for the join
  9. #' @param export the export type, either gif, first or last. The latter two
  10. #' export ggplots of the first/last state of the join
  11. #' @param ... further arguments passed to static_plot
  12. #'
  13. #' @return either a gif or a ggplot
  14. #'
  15. #' @seealso \code{\link[dplyr]{join}}
  16. #'
  17. #' @name animate_join
  18. #' @examples
  19. #' x <- data_frame(id = 1:3, x = paste0("x", 1:3))
  20. #' y <- data_frame(id = (1:4)[-3], y = paste0("y", (1:4)[-3]))
  21. #'
  22. #' # Animate the first or last state of the join
  23. #' animate_full_join(x, y, by = "id", export = "first")
  24. #' animate_full_join(x, y, by = "id", export = "last")
  25. #'
  26. #' # animate the transition as a gif (default)
  27. #' \donttest{
  28. #' animate_full_join(x, y, by = "id", export = "gif")
  29. #' }
  30. #'
  31. #' # different options include
  32. #' \donttest{
  33. #' animate_full_join(x, y, by = "id")
  34. #' animate_inner_join(x, y, by = "id")
  35. #' animate_left_join(x, y, by = "id")
  36. #' animate_right_join(x, y, by = "id")
  37. #' animate_semi_join(x, y, by = "id")
  38. #' animate_anti_join(x, y, by = "id")
  39. #'
  40. #' # further arguments can be passed to all animate_* functions
  41. #' animate_full_join(
  42. #' x, y, by = "id", export = "last",
  43. #' text_size = 5, title_size = 25,
  44. #' color_header = "black",
  45. #' color_other = "lightblue",
  46. #' color_fun = viridis::viridis
  47. #' )
  48. #' }
  49. #'
  50. #' # Save the results
  51. #' \donttest{
  52. #' # to save the ggplot, use
  53. #' fj <- animate_full_join(x, y, by = "id", export = "last")
  54. #' ggsave("full-join.pdf", fj)
  55. #'
  56. #' # to save the gif, use
  57. #' fj <- animate_full_join(x, y, by = "id", export = "gif")
  58. #' anim_save(fj, "full-join.gif")
  59. #' }
  60. animate_join <- function(
  61. x,
  62. y,
  63. by,
  64. type = c("full_join", "inner_join", "left_join", "right_join",
  65. "semi_join", "anti_join"),
  66. export = c("gif", "first", "last"),
  67. ...
  68. ) {
  69. type <- match.arg(type)
  70. export <- match.arg(export)
  71. x_name <- get_input_text(x)
  72. y_name <- get_input_text(y)
  73. data <- make_named_data(x, y)
  74. by_args <- if (length(by) == 1) sprintf("\"%s\"", by) else
  75. sprintf("c(\"%s\")", paste(by, collapse = "\", \""))
  76. title <- sprintf(paste0(type, "(%s, %s, by = %s)"), x_name, y_name, by_args)
  77. if (type %in% c("semi_join", "anti_join")) {
  78. # for semi and anti_joins, there is no adding of multiple rows
  79. data$y <- dplyr::distinct(data$y)
  80. }
  81. ll <- process_join(data$x, data$y, by, ...)
  82. step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)
  83. step1 <- move_together(ll$x, ll$y, type) %>% mutate(.frame = 1)
  84. all <- bind_rows(step0, step1)
  85. if (export == "gif") {
  86. animate_plot(all, title, ...)
  87. } else if (export == "first") {
  88. title <- ""
  89. static_plot(step0, title, ...)
  90. } else if (export == "last") {
  91. static_plot(step1, title, ...)
  92. }
  93. }
  94. #' @rdname animate_join
  95. #' @export
  96. animate_full_join <- function(x, y, by, export = "gif", ...) {
  97. x <- rlang::enquo(x)
  98. y <- rlang::enquo(y)
  99. animate_join(x, y, by, type = "full_join", export = export, ...)
  100. }
  101. #' @rdname animate_join
  102. #' @export
  103. animate_inner_join <- function(x, y, by, export = "gif", ...) {
  104. x <- rlang::enquo(x)
  105. y <- rlang::enquo(y)
  106. animate_join(x, y, by, type = "inner_join", export = export, ...)
  107. }
  108. #' @rdname animate_join
  109. #' @export
  110. animate_left_join <- function(x, y, by, export = "gif", ...) {
  111. x <- rlang::enquo(x)
  112. y <- rlang::enquo(y)
  113. animate_join(x, y, by, type = "left_join", export = export, ...)
  114. }
  115. #' @rdname animate_join
  116. #' @export
  117. animate_right_join <- function(x, y, by, export = "gif", ...) {
  118. x <- rlang::enquo(x)
  119. y <- rlang::enquo(y)
  120. animate_join(x, y, by, type = "right_join", export = export, ...)
  121. }
  122. #' @rdname animate_join
  123. #' @export
  124. animate_semi_join <- function(x, y, by, export = "gif", ...) {
  125. x <- rlang::enquo(x)
  126. y <- rlang::enquo(y)
  127. animate_join(x, y, by, type = "semi_join", export = export, ...)
  128. }
  129. #' @rdname animate_join
  130. #' @export
  131. animate_anti_join <- function(x, y, by, export = "gif", ...) {
  132. x <- rlang::enquo(x)
  133. y <- rlang::enquo(y)
  134. animate_join(x, y, by, type = "anti_join", export = export, ...)
  135. }