Having trouble displaying R^2^ on graphs

ggplot2

#1

Hey everyone. I am brand new to R and to this community, so I apologize if I make formatting mistakes in this question, and for how easy this problem would be to solve for most of you.

I am doing a few linear regressions for a project. I waived the white flag on getting R to produce the equation on the graph in ggplot, so I am now opting to add a line of best fit with geom_smooth and then manually adding my R2 values calculated in Excel. My ultimate goal is to display four different graphs on one grid, each with the R2 value in the graph. I have accomplished the first part of that using Plot_grid, but have only managed to get the R2 values as subtitles underneath each graph rather than inside of them.

Here is the best example of me getting the R2 in an individual graph:

Caption <- TeX("$R^{2}$ = 0.56")
Byrd.Reg <- ggplot(Byrd,aes(x=Observed, y=Counter)) + 
  geom_point(shape = 1) + 
  geom_smooth(method='lm', se = FALSE)+
  theme_classic()+
  labs(title = "Byrd House", caption = (Caption) )
ggdraw(add_sub(Byrd.Reg, (Caption), vpadding=grid::unit(0, "lines"),
       y = 15, x = 0.1, hjust = 0))
Byrd.Reg

This sort of works, except it produces two different graphs, one with the product of ggdraw and one without. Later, which I use Plot_grid it seems to plot the version without the ggdraw function.

I would love to understand what I am doing that makes R produce two graphs here, and how I can fix it so that I have only one which is incorporated into my Plot_grid function later.

Thanks!


#2

Here is an example of displaying the R squared on each of four plots on a 2x2 grid.

library(ggplot2)
library(dplyr)
#Make a toy data set
set.seed(1234)
x <- seq(1,10)
y1 <- seq(3,12) + rnorm(10)
y2 <- seq(3,12) + rnorm(10, 0,2)
y3 <- seq(3,12) + rnorm(10, 0, 3)
y4 <- seq(3,12) + rnorm(10, 0 ,4)
df <- data.frame(Population = rep(c("A", "B", "C", "D"), each = 10),
                 x= rep(x,4), y = c(y1,y2, y3, y4))

#Calculate R squared for each sub group of the Population column 
Rsqrd <- df %>% group_by(Population ) %>% 
  summarize(R2 = summary(lm(y ~ x))$r.squared)

#Add x and y values for the position on the final plot & text for the label
Rsqrd <- mutate(Rsqrd, x = 2.5, y = 10, Label = paste("R sqr =", round(R2, 4)))

#Plot the grid
ggplot(df, aes(x,y)) + geom_point() + 
geom_smooth(method = "lm", se = FALSE) +
  geom_text(mapping = aes(x, y, label = Label), data = Rsqrd) +
  facet_wrap(~Population)

#3

Here are two methods for displaying the fit equation and R squared on each facet of a grid of plots

library(ggplot2)
library(dplyr)
set.seed(6734)
#make a toy data set
x <- seq(0,9)
y1 <- seq(0,9) + rnorm(10)
y2 <- seq(0,9) + rnorm(10, 0,2)
y3 <- seq(0,9) + rnorm(10, 0, 3)
y4 <- seq(0,9) + rnorm(10, 0 ,4)
df <- data.frame(Population = rep(c("A", "B", "C", "D"), each = 10),
                 x= rep(x,4), y = c(y1,y2, y3, y4), stringsAsFactors = FALSE)

#Add fit equations to each facet

#Define a function returning a string representation of the fit result
#FIT$coeff[1] is the intercept
#FIT$coeff[2] is the slope
#signif(x, n) returns x rounded to n significant digits

GetEq <- function(xcol, ycol) {
  FIT <- lm( ycol ~ xcol)
  if(FIT$coeff[1] >= 0) {
    paste0( "y = ", signif(FIT$coeff[2],4), "x + ", signif(FIT$coeff[1],4), "\n",
            "R sqr = ", round(summary(FIT)$r.squared, 4))
  } else {
    paste0( "y = ", signif(FIT$coeff[2],4), "x -  ", abs(signif(FIT$coeff[1],4)), "\n",
            "R sqr = ", round(summary(FIT)$r.squared,4 ))
  }
}

#apply GetEq to each subset of df
Eqs <- df %>% group_by(Population) %>% 
  summarize(Form = GetEq( x, y))

#Method 1 use geom_text to print the fit equation on each facet

#provide x and y locations for placing the equations.
EqsXY <- mutate(Eqs, x = 2.5, y = 10)

#Plot the data and use EqsXY as the data for geom_text()
ggplot(df, aes(x,y)) + geom_point() + geom_smooth(method = "lm", se = FALSE) +
  geom_text(mapping = aes(x, y, label = Form), data = EqsXY) +
  facet_wrap(~Population)

#Method 2: Use the labeller of facet_wrap to put the fit equation and R^2 in 
#the facet title
Labels <- paste0(Eqs$Population, ": ", Eqs$Form)

ggplot(df, aes(x,y)) + geom_point() + geom_smooth(method = "lm", se = FALSE) +
  facet_wrap(~Population, 
             labeller = as_labeller(setNames(Labels, Eqs$Population)))

#4

I just learned about the ggpmisc package. Its stat_ploy_eq function adds an equation and R squared to ggplot output.

library(ggplot2)
library(dplyr)
library(ggpmisc)
set.seed(6734)
#make a toy data set
x <- seq(0,9)
y1 <- seq(0,9) + rnorm(10)
y2 <- seq(0,9) + rnorm(10, 0,2)
y3 <- seq(0,9) + rnorm(10, 0, 3)
y4 <- seq(0,9) + rnorm(10, 0 ,4)
df <- data.frame(Population = rep(c("A", "B", "C", "D"), each = 10),
                 x= rep(x,4), y = c(y1,y2, y3, y4), stringsAsFactors = FALSE)

ggplot(df, aes(x,y)) + geom_point() + 
  geom_smooth(method = "lm", se = FALSE) +
  stat_poly_eq(aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")),
               label.x.npc = "right", label.y.npc = 0.10,
               formula = y~x, parse = TRUE, rr.digits = 3) +
  facet_wrap(~Population)