Nie możesz wybrać więcej, niż 25 tematów Tematy muszą się zaczynać od litery lub cyfry, mogą zawierać myślniki ('-') i mogą mieć do 35 znaków.

117 lines
3.3KB

  1. #' Animates a set - wrapper function
  2. #'
  3. #' @param x left dataset
  4. #' @param y right dataset
  5. #' @param type type of the set, i.e., intersect, setdiff, etc.
  6. #' @param export if the function exports a gif, the first, or last picture
  7. #' @param ... further arguments passed to base_plot
  8. #'
  9. #'
  10. #' @name animate_set_function
  11. #' @return either a gif or a ggplot
  12. #'
  13. #' @examples
  14. #' NULL
  15. animate_set <- function(x, y, type, export = "gif", ...) {
  16. if (!all(names(x) %in% names(y)) && ncol(x) == ncol(y))
  17. stop("x and y must have the same variables/column-names")
  18. if (!type %in% c("union", "union_all", "intersect", "setdiff"))
  19. stop("type has to be a dplyr-set operation")
  20. if (!export %in% c("gif", "first", "last"))
  21. stop("export must be either gif, first, or last")
  22. title <- sprintf(paste0(type, "(%s, %s)"),
  23. deparse(substitute(x)),
  24. deparse(substitute(y)))
  25. if (type %in% c("union", "intersect", "setdiff")) {
  26. x <- dplyr::distinct(x)
  27. y <- dplyr::distinct(y)
  28. }
  29. if (type == "union_all") {
  30. ll <- preprocess_data(x, y, by = names(x), fill = FALSE)
  31. ll <- lapply(ll, function(a)
  32. a %>% mutate(.id_long = paste(.id_long, .side, sep = "-"))
  33. )
  34. } else {
  35. ll <- preprocess_data(x, y, by = names(x))
  36. }
  37. step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)
  38. step1 <- move_together(ll$x, ll$y, type) %>% mutate(.frame = 1)
  39. all <- bind_rows(step0, step1)
  40. if (export == "gif") {
  41. animate_plot(all, title, ...) %>% animate()
  42. } else if (export == "first") {
  43. title <- ""
  44. base_plot(step0, title, ...)
  45. } else if (export == "last") {
  46. base_plot(step1, title, ...)
  47. }
  48. }
  49. #' Animates a join - wrapper function
  50. #'
  51. #' @param x left dataset
  52. #' @param y right dataset
  53. #' @param by by arguments for the join
  54. #' @param type type of the join, i.e., left_join, right_join, etc.
  55. #' @param export if the function exports a gif, the first, or last picture
  56. #' @param ... further arguments passed to base_plot
  57. #'
  58. #' @return either a gif or a ggplot
  59. #'
  60. #' @name animate_join_function
  61. #' @examples
  62. #' NULL
  63. animate_join <- function(x, y, by, type, export = "gif", ...) {
  64. if (!type %in% c("full_join", "inner_join", "left_join", "right_join",
  65. "semi_join", "anti_join"))
  66. stop("type has to be a dplyr-join")
  67. if (!export %in% c("gif", "first", "last"))
  68. stop("export must be either gif, first, or last")
  69. by_args <- ifelse(length(by) == 1,
  70. sprintf("\"%s\"", by),
  71. sprintf("c(\"%s\")", paste(by, collapse = "\", \""))
  72. )
  73. title <- sprintf(paste0(type, "(%s, %s, by = %s)"),
  74. deparse(substitute(x)),
  75. deparse(substitute(y)),
  76. 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. y <- dplyr::distinct(y)
  80. }
  81. ll <- preprocess_data(x, 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, ...) %>% animate()
  87. } else if (export == "first") {
  88. title <- ""
  89. base_plot(step0, title, ...)
  90. } else if (export == "last") {
  91. base_plot(step1, title, ...)
  92. }
  93. }