Mercurial > repos > bcclaywell > argo_navis
view bin/common.R @ 2:7eaf6f9abd28 draft default tip
planemo upload commit a3f181f5f126803c654b3a66dd4e83a48f7e203b-dirty
author | bcclaywell |
---|---|
date | Mon, 12 Oct 2015 17:57:38 -0400 |
parents | d67268158946 |
children |
line wrap: on
line source
"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 }