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
+}
+