johncolby · November 8, 2011 21:26 · Nov 9, 2011 · Nov 9, 2011 · Nov 8, 2011
diff --git a/ggplot2_dynamic_ribbon.R b/ggplot2_dynamic_ribbon.R
@@ -32,11 +32,6 @@ Pf$variable = factor(as.numeric(gsub('Pf(.+)', '\\1', Pf$variable)))
 # Stack data
 data = rbind(Tg, Pf)
 
-# 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)
-p
-
 ################################################################################
 # 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))))
@@ -45,10 +40,6 @@ names(data)[4] = 'value'
 # Calculate ribbon extent for plotting
 ribbon.data = ddply(data, c('variable', 'x'), summarize, ymin=min(value), ymax=max(value))
 
-# 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)
-
 ################################################################################
 # Function to identify segments
 GetSegs <- function(x) {
@@ -68,6 +59,20 @@ GetSegs <- function(x) {
 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)
diff --git a/ggplot2_dynamic_ribbon.R b/ggplot2_dynamic_ribbon.R
@@ -0,0 +1,73 @@
+# 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)
+
+# 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)
+p
+
+################################################################################
+# 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))
+
+# 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)
+
+################################################################################
+# 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)
+
+# 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)
diff --git a/Pf.txt b/Pf.txt
@@ -0,0 +1,11 @@
+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 
diff --git a/Tg.txt b/Tg.txt
@@ -0,0 +1,11 @@
+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