R/tidy-arch-ncov.R

Defines functions tidy_arch_ncov

Documented in tidy_arch_ncov

#' Tidy data
#' @description The data of confirmed cases and spiral coordinates were
#' arranged into visual data.
#' @param data a data frame.
#' @param trans.log logical. If TRUE, If true, a logarithmic transformation
#' is performed on the confirmed case data.
#' @param start.angle,end.angle angle of start/end of spiral.
#' @param rep.end a logical value indicating hether the starting point of
#' each cell is the end point of its previous cell, and if FALSE, there will
#' be gaps between each cell.
#' @param max.width,min.width max/min width of spiral.
#' @param max.size,min.size max size of label.
#' @param na.rm if TRUE (default), the row whose name contains the missing
#' value will be removed.
#' @param ... extra parameters.
#' @rdname tidy_arch_ncov
#' @importFrom dplyr mutate arrange bind_rows group_by ungroup summarise %>% left_join select
#' @examples \dontrun{
#' require(nCov2019)
#' get_nCov2019()[] %>% tidy_arch_ncov()
#' }
#' @author Houyun Huang
#' @export
tidy_arch_ncov <- function(data,
                           trans.log = TRUE,
                           start.angle = 0,
                           end.angle = 3.2 * pi,
                           rep.end = TRUE,
                           max.width = 50, #mm
                           min.width = 1,
                           max.size = 7,
                           min.size = 0.5,
                           na.rm = TRUE,
                           ...) {
  if(identical(na.rm, TRUE)) {
    data <- filter(data, !is.na(name))
  }
  data <- if(identical(trans.log, TRUE)) {
    data %>%
      mutate(label = paste0(name, "\n", "(", confirm, ")"),
             confirm = round(log(confirm + 1) * 20)) %>%
      arrange(confirm)
  } else {
    data %>%
      mutate(label = paste0(name, "\n", "(", confirm, ")")) %>%
      arrange(confirm)
  }

  n <- length(unique(data$name))
  total <- sum(data$confirm)
  each <- data$confirm
  if(total < 2500) {
    total <- total * 3
    each <- each * 3
  }
  data <- arch_spiral(seq(start.angle, end.angle, length.out = total), ...) %>%
    mutate(name = rep(data$name, times = each),
           width = seq(min.width, max.width, length.out = total),
           label.filter = !duplicated(name),
           id = 1:total) %>%
    left_join(data, by = c("name" = "name")) %>%
    select(x, y, name, confirm, width, angle, label, label.filter, id)
  if(identical(rep.end, TRUE)) {
    idx <- which(!duplicated(data$name))[-1]
    data <- data[idx - 1, ] %>%
      mutate(name = data[idx, ]$name,
             confirm = data[idx, ]$confirm) %>%
      bind_rows(data) %>% arrange(id, -confirm) %>%
      mutate(name = factor(name, rev(unique(name))),
             id = 1:dplyr::n())
  }

  data_text <- data %>%
    repairs_angle(name, angle) %>%
    group_by(name) %>%
    summarise(label.x = mean(x),
              label.y = mean(y),
              label.angle = mean(angle, na.rm = TRUE),
              vertical = (any(angle < 90) && any(angle > 90) && all(angle <= 180)) ||
                         (any(angle > 270) && any(angle < 270) && all(angle >= 180))) %>%
    ungroup() %>%
    mutate(size = seq(max.size, min.size, length.out = nrow(.)),
           colour = paste0("grey", round(seq(100, 40, length.out = nrow(.)))))
  data <- left_join(data, data_text, by = c("name" = "name"))
  structure(.Data = data, class = c("arch_tbl", "tbl_df", "tbl", "data.frame"))
}
houyunhuang/archncov documentation built on April 2, 2020, 9:41 p.m.