R/preds_vs_obs_scatter_plot.R

In lorecatta/DENVclimate:

#------------------------------------------------------------------------------
#' preds_vs_obs_scatter_plot
#'
#' \code{preds_vs_obs_scatter_plot} makes a simple scatter plot of predicted vs
#'  oserved data points.
#'
#' @param df dataframe with the data to plot.
#' @param x variable to plot on the x axis.
#' @param y variable to plot on the y axis.
#' @param covar type of temperature (day or night) used to make predictions.
#'
#' @export


preds_vs_obs_scatter_plot <- function(df, x, y, covar) {

  x_range <- pretty(df[, x])
  y_range <- pretty(df[, y])

  lm <- lm(as.formula(paste0(y, "~ R0_1 - 1")), data = df)
  r_sq <- round(summary(lm)$r.squared, 3)

  par(mar = c(4, 4, 2, 1), oma = c(0, 0, 0, 0), xaxs = "r", yaxs = "r")

  plot(df[, x],
       df[, y],
       xlim = c(0, max(x_range)),
       ylim = c(0, max(y_range)),
       xlab = "Observations",
       ylab = "Predictions",
       pch = 19,
       cex = 0.5,
       axes = FALSE)

  title(covar, cex.main = 1)
  axis(side = 1, at = x_range)
  axis(side = 2, at = y_range, las = 2)

  abline(reg = lm, col = "red", lwd = 2)
  text(10, 6, labels = bquote(R^2 == .(r_sq)), col = "red", lwd = 2)

  p <- recordPlot()

}



#------------------------------------------------------------------------------

#' The function makes a scatter plot of predicted vs oserved data points, with
#' option to add a smooth function or a best fit line going through the origin,
#' with R squared.
#'
#' @title Makes simple scatter plot
#'
#' @param df dataframe with the data to plot.
#' @param x variable to plot on the x axis.
#' @param y variable to plot on the y axis.
#' @param add character name of additional feature to add to the plot.
#'  Allowed for now are "loess" and "R2".
#'
#' @importFrom ggplot2 aes_string geom_point geom_smooth theme_bw geom_abline
#'   geom_text


preds_vs_obs_scatter_plot_2 <- function(df, x, y, add = NULL) {

  # set the axes pretty ranges and intervals

  if(max(df[, x]) <= 15) {

    n_x <- 4

  } else {

    n_x <- 6

  }

  if(max(df[, y]) <= 15) {

    n_y <- 4

  } else {

    n_y <- 6

  }

  # create axes

  x_range <- pretty(df[, x], n = n_x)
  y_range <- pretty(df[, y], n = n_y)

  min_x <- min(x_range)
  max_x <- max(x_range)

  min_y <- min(y_range)
  max_y <- max(y_range)

  # plot

  p1 <- ggplot(df, aes_string(x = x, y = y)) +
    geom_point() +
    scale_x_continuous(limits = c(min_x, max_x), breaks = x_range) +
    scale_y_continuous(limits = c(min_y, max_y), breaks = y_range) +
    theme_bw()

  if(!is.null(add)) {

    if(add == "loess") {

      p2 <- p1 + geom_smooth(method = "loess", size = 1)

    }

    if(add == "R2") {

      lm <- lm(as.formula(paste0(y, "~ R0_1 - 1")), data = df)
      r_sq <- format(summary(lm)$r.squared, digits = 3)
      eq <- substitute(italic(R)^2~"="~r2,
                       list(r2 = r_sq))
      p2 <- p1 +
        geom_abline(slope = coef(lm), col = "red", lwd = 1, linetype = "dashed") +
        geom_text(x = max_x - 2,
                  y = max_y - 1,
                  label = as.character(as.expression(eq)),
                  col = "red",
                  size = 4,
                  parse = TRUE)

    }

  } else {

      p2 <- p1

  }

  p2

}