Mercurial > repos > bcclaywell > argo_navis
diff bin/common.R @ 0:d67268158946 draft
planemo upload commit a3f181f5f126803c654b3a66dd4e83a48f7e203b
author | bcclaywell |
---|---|
date | Mon, 12 Oct 2015 17:43:33 -0400 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/bin/common.R Mon Oct 12 17:43:33 2015 -0400 @@ -0,0 +1,66 @@ +"Mostly deme coloring specific codez" + +library(RColorBrewer) + + +read.color.spec <- function(filename) { + df <- read.csv(filename, stringsAsFactors=F) + colors <- df$color + names(colors) <- df$deme + colors +} + +brewify.colors <- function(demes, pallette="RdBu") { + demes <- sort(unique(demes)) + n <- length(demes) + colors <- brewer.pal(n, pallette) + names(colors) <- demes + colors +} + +colors.from.args <- function(args) { + if (!is.null(args$color_spec)) { + return(read.color.spec(args$color_spec)) + } else if (!is.null(args$brewer)) { + demes <- read.csv(args$demes, stringsAsFactors=F)$deme + return(brewify.colors(demes, pallette=args$brewer)) + } else { + stop("You must specify either --brewer or --color-spec") + } +} + +factorify.deme <- function(df, label='label', args=list()) { + df <- df + # Ugg... beast hacks, need to fix this upstream obviously + #if (!class(df[,label]) == "character") { + #rodent.col <- rgb(134/225, 197/225, 140/225) + #species <- c('bat', 'human', 'monkey', 'reference', 'rodent') + #df[,label] <- sapply(df[,label], function(i) species[i]) + #df[,label] <- factor(df[,label], levels=species) + #} + colors <- colors.from.args(args) + keep.colors <- colors[as.character(sort(unique(df[,label])))] + list(data=df, colors=keep.colors) +} + + +# Parsing, extraction and prettification of migration stat name info +mig.regex <- "mig_(.+)_(.+)" +comp.from <- function(stats.names) { + gsub(mig.regex, "\\1", stats.names) +} +comp.to <- function(stats.names) { + gsub(mig.regex, "\\2", stats.names) +} +pretty.mig <- function(stats.names) { + gsub(mig.regex, "\\1 -> \\2", stats.names) +} +explode.mig <- function(df) { + # Add some columns (from, to and migration) that make plotting and such easier + df$from <- comp.from(df$statistic) + df$migration <- pretty.mig(df$statistic) + df$to <- comp.to(df$statistic) + df$subset.name <- df$subset #hack to get ggplot's dynamic resolution not to break + df +} +