R/plotdf.R

In lfpdroubi/appraiseR: R Package For Real Estate Appraisals

#' Plot data frames
#'
#' \code{plotdf} creates standardized plots for easy data frames visualizations.
#'
#' @param formula a generic formula.
#' @param data a data frame.
#'
#' @export
#' @examples
#' library(sf)
#' dados <- st_drop_geometry(centro_2015)
#' plotdf(valor ~ ., dados)
#' plotdf(log(valor) ~ ., dados)
#' plotdf(log(valor) ~ area_total + quartos + suites + garagens +
#' log(dist_b_mar) + padrao , dados)

plotdf <- function(formula, data){

  data <- as.data.frame(data)
  f <- formula

  lhs <- f[[2]]
  rhs <- f[[3]]

  if (length(all.vars(rhs)) == 1){
    groups <- FALSE
  } else if ("|" != deparse(rhs[[1]])) {
      groups <- FALSE
    } else {
      groups <- TRUE
    }

  if(groups == TRUE) {
    ff <- as.formula(paste(deparse(lhs), "~",
                           paste(deparse(rhs[[2]], width.cutoff = 500), "+",
                                 deparse(rhs[[3]], width.cutoff = 500),
                                 collapse = ""),
                           collapse = ""))
  } else {
    ff <- f
  }

  mf <- stats::model.frame(formula = ff, data = data)

  predictors <- attr(stats::terms.formula(x = ff, data = data), "term.labels")
  response <-
    colnames(mf)[attr(stats::terms.formula(x = ff, data = data), "response")]
  parameters <- union(response, predictors)

  p <- list()
  WMedia <- mean(mf[, deparse(lhs), drop = T], na.rm = TRUE)

  if (groups == FALSE) {
    for (i in predictors) {
      if (is.character(mf[, i]) | is.factor(mf[, i]))
        #p[[i]] <- bboxplot(y = response, g = i, data = mf)+
        p[[i]] <- ggplot(mf, aes(x = .data[[i]], y =  .data[[response]])) +
          geom_hline(yintercept = WMedia, colour = "red", lty = 2) +
          geom_violin(aes(fill = .data[[i]]), alpha = .3) +
          geom_jitter(aes(colour = .data[[i]]), width = .1) +
          stat_summary(fun = "median", colour = "red", size = 2, stroke = 2,
                       pch = 4, geom = "point") +
          scale_y_continuous(labels = scales::label_number_auto()) +
          # xlab(predictors[i]) +
          theme(legend.position="none")
      else
        p[[i]] <- ggplot(mf, aes(x = .data[[i]], y = .data[[response]])) +
          geom_point() +
          stat_smooth(method = "lm", se = F)+
          scale_y_continuous(labels = scales::label_number_auto()) +
          scale_x_continuous(labels = scales::label_number_auto()) +
          theme(axis.text.x=element_text(angle = 45, vjust = 1, hjust = 1))
    }
  } else {
    group <- rhs[[3]]
    for (i in predictors) {
      if (is.character(mf[, i]) | is.factor(mf[, i]))
        #p[[i]] <- bboxplot(y = response, g = i, data = mf)+
        p[[i]] <- ggplot(mf, aes(x = .data[[i]], y =  .data[[response]])) +
          geom_hline(yintercept = WMedia, colour = "red", lty = 2) +
          geom_violin(aes(fill = .data[[i]]), alpha = .3) +
          geom_jitter(aes(colour = .data[[i]]), width = .1) +
          stat_summary(fun = "median", colour = "red", size = 2, stroke = 2,
                       pch = 4, geom = "point") +
          scale_y_continuous(labels = scales::label_number_auto()) +
          # xlab(predictors[i]) +
          theme(legend.position="none")
      else
        p[[i]] <- ggplot(mf, aes(x = .data[[i]], y = .data[[response]],
                                 group = {{group}})) +
          geom_point(aes(colour = {{group}})) +
          stat_smooth(method = "lm", se = F, aes(colour = {{group}}))+
          scale_y_continuous(labels = scales::label_number_auto()) +
          scale_x_continuous(labels = scales::label_number_auto()) +
          theme(axis.text.x=element_text(angle = 45, vjust = 1, hjust = 1)) +
          theme(legend.position="none")
    }
  }

  r <- length(predictors)
  par1 <- round(sqrt(r))
  par2 <- ceiling(r/par1)

  est <- list(plots = p,
              par1 = par1,
              par2 = par2)
  class(est) <- "plotdf"
  est
}

#' @export
#'
print.plotdf <- function(x, ...){
  gridExtra::grid.arrange(grobs =x$plots, nrow =x$par1, ncol = x$par2)
}