Mercurial > repos > bcclaywell > argo_navis
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 |