Drawing labels on flat section of contour lines in ggplot2

前端 未结 2 1196
星月不相逢
星月不相逢 2021-02-05 16:09

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 t

相关标签:
2条回答
  • 2021-02-05 17:04

    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

    0 讨论(0)
  • 2021-02-05 17:08

    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.

    0 讨论(0)
提交回复
热议问题