13

In a previous question, I reproduced a contour plot generated with the fields package, in ggplot2 instead (full example below). The only trouble is, I would like to replicate the placement of the contour labels in contour(), which by default are at the "flattest" part of the line - the second picture might show why. I'm stumped by how to set up that calculation. I see here that it's possible to grab the data used to generate the contour lines, and then geom_text() could be used to plot the text. So what's left is figuring out how to calculate the "flattest" part. Ideas?

library(fields)
library(ggplot2)
library(reshape)
library(directlabels)

sumframe<-structure(list(Morph = c("LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW"), xvalue = c(4, 8, 9, 9.75, 13, 14, 16.25, 17.25, 18, 23, 27, 28, 28.75, 4, 8, 9, 9.75, 13, 14, 16.25, 17.25, 18, 23, 27, 28, 28.75), yvalue = c(17, 34, 12, 21.75, 29, 7, 36.25, 14.25, 24, 19, 36, 14, 23.75, 17, 34, 12, 21.75, 29, 7, 36.25, 14.25, 24, 19, 36, 14, 23.75), zvalue = c(126.852666666667, 182.843333333333, 147.883333333333, 214.686666666667, 234.511333333333, 198.345333333333, 280.9275, 246.425, 245.165, 247.611764705882, 266.068, 276.744, 283.325, 167.889, 229.044, 218.447777777778, 207.393, 278.278, 203.167, 250.495, 329.54, 282.463, 299.825, 286.942, 372.103, 307.068)), .Names = c("Morph", "xvalue", "yvalue", "zvalue"), row.names = c(NA, -26L), class = "data.frame")

sumframeLW<-subset(sumframe, Morph=="LW")

# FIELDS CONTOUR PLOT:
surf.teLW<-Tps(cbind(sumframeLW$xvalue, sumframeLW$yvalue), sumframeLW$zvalue, lambda=0.01)
summary(surf.teLW)
surf.te.outLW<-predict.surface(surf.teLW)
image(surf.te.outLW, col=tim.colors(128), xlim=c(0,38), ylim=c(0,38), zlim=c(100,400), lwd=5, las=1, font.lab=2, cex.lab=1.3, mgp=c(2.7,0.5,0), font.axis=1, lab=c(5,5,6), xlab=expression("X value"), ylab=expression("Y value"),main="LW plot")
contour(surf.te.outLW, lwd=2, labcex=1, add=T)

FieldsContourPlot.jpg

# GGPLOT2 CONTOUR PLOT:
LWsurfm<-melt(surf.te.outLW)
LWsurfm<-rename(LWsurfm, c("value"="z", "X1"="x", "X2"="y"))
LWsurfms<-na.omit(LWsurfm)

LWp<-ggplot(LWsurfms, aes(x,y,z=z))+geom_tile(aes(fill=z))+stat_contour(aes(x,y,z=z, colour=..level..), colour="black", size=0.6)+scale_fill_gradientn(colours=tim.colors(128))
LWp
LWp<-direct.label(LWp)

ggplotContourPlot.jpg

Community
  • 1
  • 1
rebeccmeister
  • 300
  • 2
  • 12

2 Answers2

3

I created a function to calculate the flattest section using the method for contour() (from plot3d), created a data frame with just the flattest values with help from plyr, and added it manually to the plot with geom_text(). To exactly match the contour() output, the labels need to be rotated, sections of the contour lines need to be erased to make room for the labels, and corrections need to be made to ensure the labels don't fall off the edges of the contour lines. I will work on these over the next couple of months (this is all still a side project).

library(fields)
library(ggplot2)
library(reshape)

sumframe<-structure(list(Morph = c("LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "LW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW", "SW"), xvalue = c(4, 8, 9, 9.75, 13, 14, 16.25, 17.25, 18, 23, 27, 28, 28.75, 4, 8, 9, 9.75, 13, 14, 16.25, 17.25, 18, 23, 27, 28, 28.75), yvalue = c(17, 34, 12, 21.75, 29, 7, 36.25, 14.25, 24, 19, 36, 14, 23.75, 17, 34, 12, 21.75, 29, 7, 36.25, 14.25, 24, 19, 36, 14, 23.75), zvalue = c(126.852666666667, 182.843333333333, 147.883333333333, 214.686666666667, 234.511333333333, 198.345333333333, 280.9275, 246.425, 245.165, 247.611764705882, 266.068, 276.744, 283.325, 167.889, 229.044, 218.447777777778, 207.393, 278.278, 203.167, 250.495, 329.54, 282.463, 299.825, 286.942, 372.103, 307.068)), .Names = c("Morph", "xvalue", "yvalue", "zvalue"), row.names = c(NA, -26L), class = "data.frame")

# Subdivide, calculate surfaces, recombine for ggplot:
sumframeLW<-subset(sumframe, Morph=="LW")
sumframeSW<-subset(sumframe, Morph="SW")

surf.teLW<-Tps(cbind(sumframeLW$xvalue, sumframeLW$yvalue), sumframeLW$zvalue, lambda=0.01)
surf.te.outLW<-predict.surface(surf.teLW)

surf.teSW<-Tps(cbind(sumframeSW$xvalue, sumframeSW$yvalue), sumframeSW$zvalue, lambda=0.01)
surf.te.outSW<-predict.surface(surf.teSW)

sumframe$Morph<-as.numeric(as.factor(sumframe$Morph))

LWsurfm<-melt(surf.te.outLW)
LWsurfm<-rename(LWsurfm, c("value"="z", "X1"="x", "X2"="y"))
LWsurfms<-na.omit(LWsurfm)
LWsurfms[,"Morph"]<-c("LW")

SWsurfm<-melt(surf.te.outSW)
SWsurfm<-rename(SWsurfm, c("value"="z", "X1"="x", "X2"="y"))
SWsurfms<-na.omit(SWsurfm)
SWsurfms[,"Morph"]<-c("SW")

LWSWsurf<-rbind(LWsurfms, SWsurfms)
# Note that I've lost my units - things have been rescaled to be between 0 and 80.

LWSWc<-ggplot(LWSWsurf, aes(x,y,z=z))+facet_wrap(~Morph)+geom_contour(colour="black", size=0.6)
LWSWc
# Create data frame from data used to generate this contour plot:
tmp3<-ggplot_build(LWSWc)$data[[1]]

In a nutshell, the tmp3 data frame contains a vector, tmp3$group, which was used as a grouping variable for subsequent calculations. Within each level of tmp3$group, the variances were calculated with flattenb. A new data frame was generated, and the values from that data frame were added to the plot with geom_text().

flattenb <- function (tmp3){
    counts = length(tmp3$group)
    xdiffs = diff(tmp3$x)
    ydiffs = diff(tmp3$y)
    avgGradient = ydiffs/xdiffs
    squareSum = avgGradient * avgGradient
    variance = (squareSum - (avgGradient * avgGradient) / counts / counts)
    data.frame(variance = c(9999999, variance) #99999 pads this so the length is same as original and the first values are not selected
    )
}

tmp3<-cbind(tmp3, ddply(tmp3, 'group', flattenb))
tmp3l<-ddply(tmp3, 'group', subset, variance==min(variance))
tmp3l[,"Morph"]<-c(rep("LW", times=8), rep("SW", times=8))

LWSWpp<-ggplot(LWSWsurf, aes(x,y,z=z))
LWSWpp<-LWSWpp+geom_tile(aes(fill=z))+stat_contour(aes(x,y,z=z, colour=..level..), colour="black", size=0.6)
LWSWpp<-LWSWpp+scale_fill_gradientn(colours=tim.colors(128))
LWSWpp<-LWSWpp+geom_text(data=tmp3l, aes(z=NULL, label=level))+facet_wrap(~Morph)
LWSWpp

PlotOfPositionedLabels

rebeccmeister
  • 300
  • 2
  • 12
  • With the `LWSWsurf` data frame and the comment from baptiste, this is closer to what I'm after, although it still doesn't look quite as pretty as I'd like: `levelplot(z~x*y|Morph, data=LWSWsurf, contour=TRUE, label.style="align", pretty=TRUE, col.regions=tim.colors(128), labels=TRUE)` – rebeccmeister Feb 21 '14 at 22:19
1

You need to implement the algorithm from here:

https://github.com/wch/r-source/blob/c3ba5b0be36d3a1290e18fe189142c88f1e43236/src/library/graphics/src/plot3d.c#L1668

the function doesn't return any information about the position of the contour labels, it does the actual drawing on the graphics device, so you can't hook it into ggplot. It also knows not to draw the contour line under the label.

Until this is implemented in ggplot, stick with base graphics.

Spacedman
  • 92,590
  • 12
  • 140
  • 224
  • Thank you for the link. I would stick with base graphics, except: (1) scale bar behavior in base graphics makes it difficult to combine multiple plots cleanly on one page, and (2) I am constructing multi-plot images of contour plots plus faceted (ggplot2) or trellis (lattice) plots. If I'm graphing just contour plots, `set.screen` works fine with the scale bar in its own screen. ggplot2 + base work okay using a modification of the method [here](http://stackoverflow.com/questions/14124373/combine-base-and-ggplot-graphics-in-r-figure-window), but scale bars get awkward again. – rebeccmeister Feb 19 '14 at 15:58
  • 1
    the algorithm is also implemented in `lattice::panel.levelplot` – baptiste Feb 21 '14 at 18:10
  • @baptiste i'm not convinced - contour uses a minimum wiggliness point, where panel.levelplot looks for the most horizontal point by minimum slope (for its 'flat' algorithm). – Spacedman Feb 21 '14 at 18:37
  • true, i guess i should have said "an algorithm" – baptiste Feb 21 '14 at 18:41