custom correlation plot and wrap error #139

Closed
opened this issue Jan 28, 2016 · 11 comments

Member

schloerke commented Jan 28, 2016

 Question received.... Sometimes, the R shows: ``````> ggpairs(ar,upper=list(params=c(size=10)),lower=list(continuous='smooth')) Error in display_param_error() : 'params' is a deprecated argument. Please 'wrap' the function to supply arguments. help("wrap", package = "GGally") `````` Why? I used the following codes to create a correlation matrix for figure 1. ```panel.plot <- function(x, y) { usr <- par("usr"); on.exit(par(usr)) par(usr = c(0, 1, 0, 1)) ct <- cor.test(x,y) sig <- symnum(ct\$p.value, corr = FALSE, na = FALSE, cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) r <- ct\$estimate rt <- format(r, digits=2)[1] cex <- 0.5/strwidth(rt) text(.5, .5, rt, cex=cex *r) text(.8,.8,sig,cex=cex) } panel.smooth <- function(x,y) { points(x,y,col='blue') abline(lm(y~x)) } ar <- read.table('clipboard',T) attach(ar) pairs(ar,upper.panel=panel.plot,lower.panel=panel.smooth)``` And I used the following ggpairs codes to create figure 2. `ggpairs(ar,lower=list(continuous='smooth'))` As you can see the font size varies with the size of the correlation coefficient in the 1st figure. I would like to produce something similar with ggpairs. I would also like to remove 'Corr:' and add an indicator of significance behind the coefficient (just like the 3rd figure below). Would you please give me some suggestions or codes if possible?
Member Author

schloerke commented Jan 28, 2016

 To remove the warning, please upgrade your code from... ```library(ggplot2) library(GGally) # using iris, as I do not have the 'ar' dataset ggpairs( iris[,1:4], upper = list(params = c(size = 10)), lower = list(continuous = 'smooth') ) #Error in display_param_error() : # 'params' is a deprecated argument. Please 'wrap' the function to supply arguments. help("wrap", package = "GGally")``` to... ```ggpairs( iris[,1:4], upper = list(continuous = wrap(ggally_cor, size = 10)), lower = list(continuous = 'smooth') )``` To move the axes into the diagonal, use the `axisLabels` parameter... ```ggpairs( iris[,1:4], upper = list(continuous = wrap(ggally_cor, size = 10)), lower = list(continuous = 'smooth'), axisLabels = "internal" )``` Next, we make a custom correlation ggplot2 plot that uses `data`, `mapping`, and `...` as parameters... ```my_custom_cor <- function(data, mapping, color = I("grey50"), sizeRange = c(1, 5), ...) { # get the x and y data to use the other code x <- eval(mapping\$x, data) y <- eval(mapping\$y, data) ct <- cor.test(x,y) sig <- symnum( ct\$p.value, corr = FALSE, na = FALSE, cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ") ) r <- unname(ct\$estimate) rt <- format(r, digits=2)[1] # since we can't print it to get the strsize, just use the max size range cex <- max(sizeRange) # helper function to calculate a useable size percent_of_range <- function(percent, range) { percent * diff(range) + min(range, na.rm = TRUE) } # plot the cor value ggally_text( label = as.character(rt), mapping = aes(), xP = 0.5, yP = 0.5, size = I(percent_of_range(cex * abs(r), sizeRange)), color = color, ... ) + # add the sig stars geom_text( aes_string( x = 0.8, y = 0.8 ), label = sig, size = I(cex), color = color, ... ) + # remove all the background stuff and wrap it with a dashed line theme_classic() + theme( panel.background = element_rect( color = color, linetype = "longdash" ), axis.line = element_blank(), axis.ticks = element_blank(), axis.text.y = element_blank(), axis.text.x = element_blank() ) } my_custom_cor(iris, aes(Sepal.Length, Sepal.Width))``` Next, we make a custom 'smooth' ggplot2 plot that uses `data`, `mapping`, and `...` as parameters... ```my_custom_smooth <- function(data, mapping, ...) { ggplot(data = data, mapping = mapping) + geom_point(color = I("blue")) + geom_smooth(method = "lm", color = I("black"), ...) } my_custom_smooth(iris, aes(Sepal.Length, Sepal.Width))``` Custom final example ```ggpairs( iris[,1:4], upper = list(continuous = my_custom_cor), lower = list(continuous = my_custom_smooth), axisLabels = "internal" )``` ```# slightly smaller labels ggpairs( iris[,1:4], upper = list(continuous = wrap(my_custom_cor, sizeRange = c(1,3))), lower = list(continuous = my_custom_smooth), axisLabels = "internal" )``` Hope this helps! Feel free to adjust the code to your needs. Now that custom plots may be inserted, you have full control over what goes in the plot space. Barret

yzh402 commented Feb 3, 2016

 Could the size of the axis text or labels on the diag panel also be changed? Any external codes or have to rewrite the function package?
Member Author

schloerke commented Feb 4, 2016

 Normally, I would say you should `wrap` the function. But when axisLabels are "internal", (currently) ggpairs is stomping anything that is given. ... So I'll work on that. In the mean time... Continuing from the example above... ```# final example from above pm <- ggpairs( iris[,1:4], upper = list(continuous = my_custom_cor), lower = list(continuous = my_custom_smooth), axisLabels = "internal" ) pm``` The `pm` object is a ggmatrix object. ```str(pm) # # Custom str.ggmatrix output: # To view original object use 'str(pm, raw = TRUE)' # # List of 15 # \$ data :'data.frame': 150 obs. of 4 variables: # ..\$ Sepal.Length: num [1:150] 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ... # ..\$ Sepal.Width : num [1:150] 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ... # ..\$ Petal.Length: num [1:150] 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ... # ..\$ Petal.Width : num [1:150] 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ... # \$ plots :List of 16 # ..\$ : chr "PM; aes: c(x = Sepal.Length); fn: {wrap; fn: 'ggally_diagAxis'; with params: c(label = Sepal.Length)}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Sepal.Width, y = Sepal.Length); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Petal.Length, y = Sepal.Length); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Petal.Width, y = Sepal.Length); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Sepal.Length, y = Sepal.Width); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Sepal.Width); fn: {wrap; fn: 'ggally_diagAxis'; with params: c(label = Sepal.Width)}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Petal.Length, y = Sepal.Width); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Petal.Width, y = Sepal.Width); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Sepal.Length, y = Petal.Length); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Sepal.Width, y = Petal.Length); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Petal.Length); fn: {wrap; fn: 'ggally_diagAxis'; with params: c(label = Petal.Length)}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Petal.Width, y = Petal.Length); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Sepal.Length, y = Petal.Width); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Sepal.Width, y = Petal.Width); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Petal.Length, y = Petal.Width); fn: {wrap; fn: 'custom_function'; with params: c()}; gg: FALSE" # ..\$ : chr "PM; aes: c(x = Petal.Width); fn: {wrap; fn: 'ggally_diagAxis'; with params: c(label = Petal.Width)}; gg: FALSE" # \$ title : chr "" # \$ verbose : logi FALSE # \$ printInfo : logi FALSE # \$ showStrips : NULL # \$ xAxisLabels : NULL # \$ yAxisLabels : NULL # \$ showXAxisPlotLabels: logi FALSE # \$ showYAxisPlotLabels: logi FALSE # \$ legends : logi FALSE # \$ gg : NULL # \$ nrow : int 4 # \$ ncol : int 4 # \$ byrow : logi TRUE # - attr(*, "_class")= chr [1:2] "gg" "ggmatrix"``` From the str output above, we can see that it's using the ggmatrix_diagAxis function. (Currently) ggpairs is stomping the diag functions if we set axisLabels to "internal", so let's set the axisLabels to "show" (default), and adjust after ggpairs makes the plot matrix. ```pm <- ggpairs( iris[,1:4], upper = list(continuous = my_custom_cor), lower = list(continuous = my_custom_smooth), diag = list(continuous = wrap('diagAxis', labelSize = 3)), axisLabels = "show" ) pm``` Set the display of plot labels to false and remove all text labels ```pm\$showXAxisPlotLabels <- FALSE pm\$showYAxisPlotLabels <- FALSE pm\$xAxisLabels <- NULL pm\$yAxisLabels <- NULL pm``` Hope this helps! Barret

akhst7 commented Feb 29, 2016

 It is possible get rid of the diag panel ? I tried `diag=Null` but did not work. Also Is it possible to remove all the background from each panel ? Thanks.
Member Author

schloerke commented Mar 1, 2016

 Use: `diag = "blank"` I'll see why `diag = NULL` does not work. For the background, I would use the `theme_bw()` command. There is more explanation here about themes in general: http://docs.ggplot2.org/0.9.2.1/theme.html ```pm <- ggpairs(iris) pm <- pm + theme_bw() pm``` or ```library(ggthemes) pm <- ggpairs(iris) + theme_tufte() pm```

akhst7 commented Mar 2, 2016

 Another question. I got the output that I need and am wondering if it is possible to make a border of the particular plot that have the correlation p<0.05 read as shown in the example figure.
Member Author

schloerke commented Mar 3, 2016

 Inside your a custom 'continuous' function, you'll need to calculate the p-value. If that p-value is in the range you approve of, you'll add a theme to the plot. ```library(GGally) library(ggplot2) my_custom_smooth <- function(data, mapping, ...) { p <- ggplot(data = data, mapping = mapping) + geom_point(color = I("blue")) + geom_smooth(method = "lm", color = I("black"), ...) lmModel <- eval(substitute(lm(y ~ x, data = data), mapping)) fs <- summary(lmModel)\$fstatistic pValue <- pf(fs[1], fs[2], fs[3], lower.tail = FALSE) if (pValue < 0.05) { p <- p + theme( panel.border = element_rect( color = "red", size = 3, linetype = "solid", fill = "transparent" ) ) } p } ggpairs(iris[,1:4], lower = list(continuous = my_custom_smooth), upper = "blank", diag = "blank")```

ScottStetkiewicz commented Mar 10, 2016

 This thread has been wonderfully useful, especially the last point - I've tweaked it in a very clumsy way to work for the upper custom_cor, as I want to color-code that like in corrplot (but still want the rest of what ggpairs offers). In particular, I had a whale of a time trying to clear the background grey from each fo the plots... ``````my_custom_cor <- function(data, mapping, color = I("black"), sizeRange = c(1, 5), ...) { # get the x and y data to use the other code x <- eval(mapping\$x, data) y <- eval(mapping\$y, data) ct <- cor.test(x,y) r <- unname(ct\$estimate) rt <- format(r, digits=2)[1] tt <- as.character(rt) # plot the cor value p <- ggally_text( label = tt, mapping = aes(), xP = 0.5, yP = 0.5, size = 6, color=color, ... ) + theme(panel.background=element_rect(fill="white"), panel.background = element_rect(color = "black", linetype = "dashed"), panel.grid.minor=element_blank(), panel.grid.major=element_blank()) if (tt >= -0.6 && tt <= -0.8) {p=p+theme(panel.background = element_rect(fill="#ADDD8E"))} else if (tt >= -0.8 && tt <= -1.0) {p=p+theme(panel.background = element_rect(fill = "#FFFFE5"))} else if (tt >= 0.6 && tt <= 0.8) {p=p+theme(panel.background=element_rect(fill="#41AB5D"))} else if (tt >= 0.8 && tt <= 1.0) {p=p+theme(panel.background=element_rect(fill="#005A32"))} p } `````` and ``````my_custom_smooth <- function(data, mapping, ...) { ggplot(data = data, mapping = mapping) + geom_point(aes(color = I("black"))) + scale_color_brewer(palette="Accent") + geom_smooth(method = "lm", color = I("black"), ...) + theme(panel.background=element_blank(), panel.grid.minor=element_blank(), panel.grid.major=element_line(color="gray")) } `````` then ``````data(mtcars) ggpairs(mtcars,columns=2:10,upper=list(continuous=wrap(my_custom_cor)), diag=list(continuous="density"),lower=list(continuous=wrap(my_custom_smooth), combo = wrap("dot", color=Class)), axisLabels = "none") `````` However, as you can see below, the negative correlation values aren't being recognized as discrete from the positive ones. This leads to -0.7 and 0.7 being the same color, while I have (or so I thought) lines to make the negative values yellower, and positive values greener. I'm assuming the problem lies in what I'm defining as "tt" for the ifelse function. I'm brand new to to R, so I'd imagine I've made some stupidly trivial mistake, but for the life of me I can't see what it is. Do you have any suggestions? Thanks again for making such a useful post!
Member Author

schloerke commented Mar 11, 2016

 The if statements were checking against a character object, rather than a numeric object. I changed all `tt` to `r` Also, you have diverging information (correlation) from a neutral point (0). I'd really recommend going towards two different colors. Yellow and green are on the same color area, so it makes it difficult to interpret which is 'up' or 'down'. RColorBrewer has already solved the color spectrum suggestions. I've incorporated it into the correlation function. ```library(RColorBrewer) RColorBrewer::display.brewer.all()``` Palette RdYlGn looks pretty good, as we associate red and greed with positive and negative naturally. ``````# take the inner 5 colors of 7 colors so that the extreme color is not so intense corColors <- RColorBrewer::brewer.pal(n = 7, name = "RdYlGn")[2:6] corColors # [1] "#FC8D59" "#FEE08B" "#FFFFBF" "#D9EF8B" "#91CF60" `````` ```my_custom_cor_color <- function(data, mapping, color = I("black"), sizeRange = c(1, 5), ...) { # get the x and y data to use the other code x <- eval(mapping\$x, data) y <- eval(mapping\$y, data) ct <- cor.test(x,y) r <- unname(ct\$estimate) rt <- format(r, digits=2)[1] tt <- as.character(rt) # plot the cor value p <- ggally_text( label = tt, mapping = aes(), xP = 0.5, yP = 0.5, size = 6, color=color, ... ) + theme( panel.background=element_rect(fill="white"), panel.background = element_rect(color = "black", linetype = "dashed"), panel.grid.minor=element_blank(), panel.grid.major=element_blank() ) corColors <- RColorBrewer::brewer.pal(n = 7, name = "RdYlGn")[2:6] if (r <= -0.8) { corCol <- corColors[1] } else if (r <= -0.6) { corCol <- corColors[2] } else if (r < 0.6) { corCol <- corColors[3] } else if (r < 0.8) { corCol <- corColors[4] } else { corCol <- corColors[5] } p <- p + theme( panel.background = element_rect(fill= corCol) ) p } # no need to wrap functions if there are no parameters # lower\$combo had a wrap to the object Class which I couldn't find, so I removed it. ggpairs( mtcars, columns = 2:10, upper = list(continuous = my_custom_cor_color), diag = list(continuous = "density"), lower = list( continuous = my_custom_smooth, combo = "dot" ), axisLabels = "none" )```
Member Author

schloerke commented Mar 11, 2016 • edited

 I'm going to lock this conversation. If there are any more ggpairs (or any GGally) unexpected behavior or issues, please submit a new github issue. If there are any plot implementation questions, I'd like to divert the conversation to the gitter group for GGally: https://gitter.im/ggobi/ggally

Member Author

schloerke commented May 30, 2018

 For data evaluations to work with ggplot2 version >= 2.2.2, all calls similar to `eval(mapping\$x, data)` should be switched to `GGally::eval_data_col(data, mapping\$x)` to handle ggplot2's new `aes()` format.