comparison bin/common.R @ 0:d67268158946 draft

planemo upload commit a3f181f5f126803c654b3a66dd4e83a48f7e203b
author bcclaywell
date Mon, 12 Oct 2015 17:43:33 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:d67268158946
1 "Mostly deme coloring specific codez"
2
3 library(RColorBrewer)
4
5
6 read.color.spec <- function(filename) {
7 df <- read.csv(filename, stringsAsFactors=F)
8 colors <- df$color
9 names(colors) <- df$deme
10 colors
11 }
12
13 brewify.colors <- function(demes, pallette="RdBu") {
14 demes <- sort(unique(demes))
15 n <- length(demes)
16 colors <- brewer.pal(n, pallette)
17 names(colors) <- demes
18 colors
19 }
20
21 colors.from.args <- function(args) {
22 if (!is.null(args$color_spec)) {
23 return(read.color.spec(args$color_spec))
24 } else if (!is.null(args$brewer)) {
25 demes <- read.csv(args$demes, stringsAsFactors=F)$deme
26 return(brewify.colors(demes, pallette=args$brewer))
27 } else {
28 stop("You must specify either --brewer or --color-spec")
29 }
30 }
31
32 factorify.deme <- function(df, label='label', args=list()) {
33 df <- df
34 # Ugg... beast hacks, need to fix this upstream obviously
35 #if (!class(df[,label]) == "character") {
36 #rodent.col <- rgb(134/225, 197/225, 140/225)
37 #species <- c('bat', 'human', 'monkey', 'reference', 'rodent')
38 #df[,label] <- sapply(df[,label], function(i) species[i])
39 #df[,label] <- factor(df[,label], levels=species)
40 #}
41 colors <- colors.from.args(args)
42 keep.colors <- colors[as.character(sort(unique(df[,label])))]
43 list(data=df, colors=keep.colors)
44 }
45
46
47 # Parsing, extraction and prettification of migration stat name info
48 mig.regex <- "mig_(.+)_(.+)"
49 comp.from <- function(stats.names) {
50 gsub(mig.regex, "\\1", stats.names)
51 }
52 comp.to <- function(stats.names) {
53 gsub(mig.regex, "\\2", stats.names)
54 }
55 pretty.mig <- function(stats.names) {
56 gsub(mig.regex, "\\1 -> \\2", stats.names)
57 }
58 explode.mig <- function(df) {
59 # Add some columns (from, to and migration) that make plotting and such easier
60 df$from <- comp.from(df$statistic)
61 df$migration <- pretty.mig(df$statistic)
62 df$to <- comp.to(df$statistic)
63 df$subset.name <- df$subset #hack to get ggplot's dynamic resolution not to break
64 df
65 }
66