feat: inteaction terms

Author: aravindhebbali

NAMESPACE

@@ -87,6 +87,7 @@ export(ols_correlations)
 export(ols_eigen_cindex)
 export(ols_fpe)
 export(ols_get_formula)
+export(ols_get_interaction_terms)
 export(ols_hadi)
 export(ols_hsp)
 export(ols_launch_app)

R/ols-model-info.R

@@ -18,3 +18,28 @@
 ols_get_formula <- function(model) {
   formula(model)
 }
+
+#' Interaction terms
+#'
+#' Returns interaction terms present in the model.
+#'
+#' @param model An object of class \code{lm}.
+#'
+#' @return \code{Character} vector or \code{NULL}.
+#'
+#' @examples
+#' model <- lm(mpg ~ wt + cyl * hp * disp + gear * drat, data = mtcars)
+#' ols_get_interaction_terms(model)
+#'
+#' @export
+#'
+ols_get_interaction_terms <- function(model) {
+  terms <- model$terms
+  i <- attr(terms, 'order')
+  if (any(i > 1)) {
+    iterms <- i > 1
+    return(attr(terms, 'term.labels')[iterms])
+  } else {
+    return(NULL)
+  }
+}

R/utils.R

@@ -90,4 +90,71 @@ max_nchar <- function(char, val, rn = 3, ns = 3) {
   max(nchar(char), nchar(format(round(val, rn), nsmall = ns)))
 }
 
+ols_get_terms <- function(model) {
+  attr(model$terms, 'term.label')
+}
+
+ols_get_variables <- function(model) {
+  vars  <- names(model$model)
+  n     <- length(vars)
+  resp  <- vars[1]
+  preds <- vars[2:n]
+  list(response = resp, predictors = preds)
+}
+
+ols_get_data <- function(model) {
+  model$model
+}
+
+ols_get_df <- function(model) {
+  model$df.residual
+}
+
+ols_get_intercept <- function(model) {
+  model$coefficients[[1]]
+}
+
+ols_get_model_matrix <- function(model) {
+  model.matrix(model)
+}
+
+ols_get_predicted <- function(model) {
+  as.numeric(model$fitted.values)
+}
+
+ols_get_sigma <- function(model) {
+  summary(model)$sigma
+}
 
+ols_get_residuals <- function(model) {
+  model$residuals
+}
+
+ols_get_deviance <- function(model) {
+  deviance(model)
+}
+
+ols_get_parameters <- function(model) {
+  params <- model$coefficients[, 1]
+  data.frame(Parameter = names(params), Estimate = unname(params))
+}
+
+ols_get_predictors <- function(model) {
+  model$model[, -1]
+}
+
+ols_get_response <- function(model) {
+  model$model[, 1]
+}
+
+ols_get_call <- function(model) {
+  model$call
+}
+
+ols_get_obs <- function(model) {
+  nrow(model$model)
+}
+
+ols_has_intercept <- function(model) {
+  as.logical(attr(model$terms, "intercept"))
+}

man/ols_get_interaction_terms.Rd

@@ -1,6 +1,20 @@
 test_that("the model forumula is returned", {
   model <- lm(mpg ~ disp + hp + wt, data = mtcars)
-  want <- as.formula(mpg ~ disp + hp + wt)
-  got <- ols_get_formula(model)
+  want  <- as.formula(mpg ~ disp + hp + wt)
+  got   <- ols_get_formula(model)
   expect_equal(want, got)
 })
+
+test_that("interaction terms are returned", {
+  model <- lm(mpg ~ wt * cyl + vs * hp * gear + carb, data = mtcars)
+  want  <- c("wt:cyl", "vs:hp", "vs:gear",  "hp:gear", "vs:hp:gear")
+  got   <- ols_get_interaction_terms(model)
+  expect_equal(want, got)
+})
+
+test_that("NULL is returned in absence of interaction terms", {
+  model <- lm(mpg ~ disp + hp + wt, data = mtcars)
+  want  <- NULL
+  got   <- ols_get_interaction_terms(model)
+  expect_null(want)
+})