#' 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"))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.