trinker / plotflow

A group of tools to speed up work flow associated with plotting tasks.

Geek Repo:Geek Repo

Github PK Tool:Github PK Tool

Add nested_map

trinker opened this issue · comments

#' Nested Map
#' 
#' Generate a nested map that shows nested, hierarchical proportions of a whole.
#' 
#' @param x A vector of nested, decreasing values.
#' @param labels The labels atached to each element of \code{x}.
#' @param text_size The text size for the labels.
#' @export
#' @examples
#' nested_map(x = c(100, 94, 84, 55, 22, 14, 9))
nested_map <- function(x, labels = c(LETTERS[1:length(x)]), text_size = 2.25){

    if(any(diff(x) >= 0)) stop("Nested maps works for vectors of decreasing values.")

    dat <- get_measurements(x, labels)

    dat[['xmin']] <- dat[['s2']][1] - dat[['s2']]
    dat[['xmax']] <- dat[['s2']][1]

    dat[['ymin']] <- 0
    dat[['ymax']] <- dat[['s1']]
    dat[['text_x']] <- dat[['xmin']]
    dat[['text_y']] <- dat[['ymax']]

    ggplot2::ggplot(dat, ggplot2::aes_string(xmin = 'xmin', xmax = 'xmax', ymin = 'ymin', ymax = 'ymax')) +
        ggplot2::geom_rect(alpha=.05, size=.8, ggplot2::aes_string(fill='labels', color='labels')) +
        geom_text(aes_string(x='text_x', y='text_y', label='txt'), hjust=-.1, vjust=1.1, size = text_size) +
        ggplot2::theme_minimal() +
        ggplot2::theme(
            legend.position='none',
            axis.text = ggplot2::element_blank(),
            axis.title = ggplot2::element_blank(),
            panel.grid = ggplot2::element_blank()
        )
}


get_measurements <- function(x, labels){

    gr <- (1+sqrt(5))/2

    prop <- c(NA, x[-1]/x[-c(length(x))])
    of <- c("", paste0(" of ", x[-length(x)]))
    txt <- paste0(labels, ": ", x, of, c("", paste0(" (", pp(prop[-1]), ")")))
    s1 <- c(1, rep(NA, length(x) - 1))
    s2 <- c(1/gr, rep(NA, length(x) - 1))
    A <- c(x1[1]*x2[1], rep(NA, length(x) - 1))

    for (i in 2:length(x)){
        A[i] <- A[i-1]*prop[i]
        s2[i] <- sqrt(A[i]/gr)
        s1[i] <- A[i]/s2[i]  
    }

    data.frame(lablels=labels, x=x, s1=s1, s2=s2, A=A, txt=txt, prop=prop, stringsAsFactors = FALSE)
}

pp <- function(x){gsub("^0", "", paste0(round(100*x, 1), "%"))}

Learned about from stephanie evergreen: http://stephanieevergreen.com/blog/ Not sure of value yet.