R/s3_methods.R

In eliscl/lab4: Estimates linear regression.

#' Prints  the formula and coefficient from linreg-object x
#'
#' @param x a 'linreg' object
#' @method print linreg
#' @return formula & coefficients
#' @export

print.linreg <- function(x, ...) { # not the prettiest solution but works
  cat("Call:\n  ")
  print(x$call)
  cat("Coefficients:\n  ")
  print(round(x$Coefficients), 3)
}

#' Plot residuals
#' @method plot linreg
#' @return 2 plots. 1 residual vs fitted value plots and 1 Scale-location plot.
#' @export
plot.linreg <-
  function(x, ...) {
    # Seems like only the latest plot is in the output. How to fix this?
    # Preparing data for plots
    # library(ggplot2)# How to add these in a packages? ImportFrom in NAMESPACE ???
    # library(ggthemes) # Same as above.

    plotdf <- data.frame(Fitted.values = x$`Fitted values`, Residuals = x$Residuals)
    # print(plotdf)

    # Plotting
    p1 <- ggplot2::ggplot(plotdf, aes(x = Fitted.values, y = Residuals)) +
      geom_point(shape = 1) +
      geom_smooth(
        method = "loess",
        se = F,
        color = "red",
        size = .6
      ) +
      geom_hline(yintercept = 0,
                 color = "lightgray",
                 linetype = "dotted") +
      geom_text(
        aes(label = ifelse(abs(Residuals) > 1.5 * sd(Residuals) + mean(Residuals),
                           rownames(plotdf), ''
        )),
        hjust = .45,
        vjust = -.6,
        size = 2.5
      ) +  # Defining outliers as further than 1.5 sd away from the mean.
      labs(title = "Residuals vs Fitted values",
           y = "Residuals",
           x = bquote(atop("Fitted values",.(x$Formula)))) + #TO BE COMPLETED: Print out the model specification
      ggthemes::theme_base()

    # Defining outliers as further than 1.5 sd away from the mean.
    plotdf$st_res <- sqrt(abs(plotdf$Residuals / sd(plotdf$Residuals)))

    # Plotting
    p2 <- ggplot2::ggplot(plotdf, aes(x = Fitted.values, y = st_res)) +
      geom_point(shape = 1) +
      geom_smooth(
        method = "loess",
        se = F,
        color = "red",
        size = .6
      ) +
      geom_text(
        aes(label = ifelse((abs(st_res)) > 1.5 * abs(sd(st_res)) + mean(st_res), rownames(plotdf), ''
        )),
        hjust = .45,
        vjust = -.6,
        size = 2.5
      ) +
      labs(title = "Scale-Location",
           y = expression(sqrt(Standardized ~ Residuals)),
           x = bquote(atop("Fitted values", .(x$Formula))))+ #TO BE COMPLETED: Print out the model specification
      ggthemes::theme_base()

    gridExtra::grid.arrange(p1,p2, nrow = 2)

  }

#' Shows residuals of x
#' @method resid linreg
#' @return residuals

resid <- function(x,...) {
  a <-as.vector(x$Residuals)
  a
}

#' Shows fitted values of x
#' @method pred linreg
#' @return prints each fitted value for x

pred <- function(x, ...) {
  print(round(x$`Fitted values`,2))
}

#' Shows coefficients x
#'@method coef linreg
#'@return coefficients

coef <- function(x,...) {
  print(x$Coefficients)
}


#' Summarises x
#' @method summary linreg
#' @return Summarises x
#' @export
summary.linreg <- function(x, ...) {
    cat("Coefficients:\n  ")
    d <- data.frame(round(x$Coefficients,3),
                     round(x$Std.e.,3),
                     round(x$`T-values`,3),
                     round(x$`P-values`,3))
    colnames(d) <- c("Estimate", "Std. Error", "t value", "Pr(>|t|)")
    print(d)
    cat("\nResidual standard error:", round(sd(x$Residuals), 3), "on", x$df, "degrees of freedom")

}

# old version
# summary.linreg <- function(x, ...) {
#   sum_tab <-
#     list(Coefficients = (cbind(
#       round(x$Coefficients,3), round(x$Std.e.,3), round(x$`T-values`,3), round(x$`P-values`,3)
#     )),
#     (
#       paste(
#         "Residual standard error:",
#         round(sd(x$Residuals), 3),
#         "on",
#         x$df,
#         "degrees of freedom"
#       )
#     ))
#
#   colnames(sum_tab$Coefficients) <-
#     c("Estimate", "Std. Error", "t value", "Pr(>|t|)")
#
#   print(sum_tab)
#
# }