Mercurial > repos > bcclaywell > argo_navis
comparison bin/plot_pact_tree.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 #!/usr/bin/env Rscript | |
| 2 | |
| 3 library(ggplot2) | |
| 4 library(argparse) | |
| 5 | |
| 6 parser <- ArgumentParser() | |
| 7 parser$add_argument('-b', '--brewer', help="Specify a color brewer pallete") | |
| 8 parser$add_argument('-c', '--color-spec', help="Specify a deme -> color CSV mapping") | |
| 9 parser$add_argument('-d', '--demes', help="For help with making colors consistent, always know what all the demes are") | |
| 10 parser$add_argument('common') | |
| 11 parser$add_argument('input') | |
| 12 parser$add_argument('output') | |
| 13 args <- parser$parse_args() | |
| 14 | |
| 15 # Load shared library | |
| 16 source(args$common) | |
| 17 | |
| 18 data <- read.csv(args$input, stringsAsFactors=F) | |
| 19 | |
| 20 # Factorify the demes and assign colors | |
| 21 deme.factor <- factorify.deme(data, args=args) | |
| 22 data <- deme.factor$data | |
| 23 deme.colors <- deme.factor$colors | |
| 24 | |
| 25 # We will be doing a separate geom data setting for the tip coloring and such | |
| 26 tips.data <- subset(data, klass == "tip") | |
| 27 | |
| 28 # Computing some values for getting spacing/padding right for tips | |
| 29 x.range <- abs(min(data$x) - max(data$x)) | |
| 30 x.end <- max(data$x) + (x.range * 0.13) | |
| 31 print(c(min(data$x), max(data$x), x.range, x.end)) | |
| 32 | |
| 33 # Move the tips names over just a touch from the dots | |
| 34 label.nudge <- x.range * 0.01 | |
| 35 | |
| 36 | |
| 37 # Go to town plotting | |
| 38 gg <- ggplot(data, aes(x=x, y=y, color=label, fill=label)) | |
| 39 gg <- gg + geom_segment(aes(xend=parent_x, yend=parent_y)) | |
| 40 gg <- gg + scale_color_manual(values=deme.colors) | |
| 41 gg <- gg + geom_text(aes(x=x+label.nudge, y=y, label=sequence, hjust=0), color="black", size=1.8) | |
| 42 gg <- gg + geom_point(aes(color=label), data=tips.data) | |
| 43 gg <- gg + theme_bw() | |
| 44 # Add some padding for the label names on right | |
| 45 gg <- gg + xlim(min(data$x), x.end) | |
| 46 gg <- gg + theme(axis.text.y=element_blank(), | |
| 47 axis.ticks.y=element_blank(), | |
| 48 axis.title.y=element_blank(), | |
| 49 legend.position="none") | |
| 50 gg <- gg + xlab("time (units same as tip dates)") | |
| 51 gg <- gg + labs(title="Maximum likelihood ancestral reconstruction") | |
| 52 | |
| 53 # Dynamically compute dimensions | |
| 54 n <- dim(tips.data)[1] | |
| 55 print(n) | |
| 56 height <- 9*(n/292) + 3 | |
| 57 | |
| 58 ggsave(args$output, gg, width=7, height=height) | |
| 59 |