Skip to content

Instantly share code, notes, and snippets.

@johncolby
Created November 8, 2011 21:26
Show Gist options
  • Save johncolby/1349300 to your computer and use it in GitHub Desktop.
Save johncolby/1349300 to your computer and use it in GitHub Desktop.
# Simulate data...then go out and manually clip some of it
n.row = 10
n.col = 4
Tg = data.frame(round(matrix(runif(n.row*n.col), nrow=n.row), 1))
names(Tg) = paste('Tg', 1:n.col, sep='')
Pf = data.frame(round(matrix(runif(n.row*n.col), nrow=n.row), 1))
names(Pf) = paste('Pf', 1:n.col, sep='')
write.table(Tg, 'Tg.txt', row.names=F, quote=F)
write.table(Pf, 'Pf.txt', row.names=F, quote=F)
################################################################################
library(ggplot2)
# Load data
Tg = read.table('Tg.txt', header=T, fill=T, sep=' ')
Pf = read.table('Pf.txt', header=T, fill=T, sep=' ')
# Format data
Tg$x = as.numeric(rownames(Tg))
Tg = melt(Tg, id.vars='x')
Tg$source = 'Tg'
Tg$variable = factor(as.numeric(gsub('Tg(.+)', '\\1', Tg$variable)))
Pf$x = as.numeric(rownames(Pf))
Pf = melt(Pf, id.vars='x')
Pf$source = 'Pf'
Pf$variable = factor(as.numeric(gsub('Pf(.+)', '\\1', Pf$variable)))
# Stack data
data = rbind(Tg, Pf)
################################################################################
# Interpolate data
data = ddply(data, c('variable', 'source'), function(x) data.frame(approx(x$x, x$value, xout=seq(min(x$x), max(x$x), length.out=100))))
names(data)[4] = 'value'
# Calculate ribbon extent for plotting
ribbon.data = ddply(data, c('variable', 'x'), summarize, ymin=min(value), ymax=max(value))
################################################################################
# Function to identify segments
GetSegs <- function(x) {
segs = x[x$source=='Tg', ]$value > x[x$source=='Pf', ]$value
segs.rle = rle(segs)
on.top = ifelse(segs, 'Tg', 'Pf')
on.top[is.na(on.top)] = 'Tg'
group = rep.int(1:length(segs.rle$lengths), times=segs.rle$lengths)
group[is.na(segs)] = NA
data.frame(x=unique(x$x), group, on.top)
}
# Merge segment data with ribbon data
groups = ddply(data, 'variable', GetSegs)
ribbon.data = join(ribbon.data, groups)
# (Optional) Remove NAs and set scales='free' below for x limits that are flush right
data = data[!is.na(data$value), ]
ribbon.data = ribbon.data[!is.na(ribbon.data$ymax), ]
################################################################################
# Plot
dev.new(width=5, height=4)
p = ggplot(data=data, aes(x=x)) + geom_line(aes(y=value, group=source, color=source)) + facet_wrap(~variable, scales='free')
p
# Plot with color between lines
dev.new(width=5, height=4)
p + geom_ribbon(aes(ymin=ymin, ymax=ymax), alpha=0.3, data=ribbon.data)
# Plot with dynamic color between lines
dev.new(width=5, height=4)
p + geom_ribbon(aes(ymin=ymin, ymax=ymax, group=group, fill=on.top), alpha=0.3, data=ribbon.data)
Pf1 Pf2 Pf3 Pf4
0.4 0.3 0.1 0.6
0.1 0.7 0.7 1
0.4 0.9 0.5 0.7
0.3 0.4 0.4 0.7
1 0.8 0.4 0.2
0.4 0 0.3
0.4 0.8 0.5
0.1 0.2
0.2 0.2
0.8 0.4
Tg1 Tg2 Tg3 Tg4
0.1 0 0.3 0.3
0.1 0.1 0.9 0.5
0.4 0.7 0.2 0
0.9 0.5 0.5 0.2
0.9 0.2 0.3 0.4
0.2 0 0.7 0.2
0.3 0.6 0.9
0.5 0.4 1
0.7 0.9
0.7 0.9
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment