Merge pull request #448 from schistyakov/lm-intercept

Update lm.R
topepo · Jul 26, 2016 · 1164648 · 1164648
2 parents db679cb + aeb550f
commit 1164648
Showing 1 changed file with 17 additions and 7 deletions.
diff --git a/models/files/lm.R b/models/files/lm.R
@@ -2,23 +2,33 @@ modelInfo <- list(label = "Linear Regression",
                   library = NULL,
                   loop = NULL,
                   type = "Regression",
-                  parameters = data.frame(parameter = "parameter",
-                                          class = "character",
-                                          label = "parameter"),
-                  grid = function(x, y, len = NULL, search = "grid") data.frame(parameter = "none"),
+                  parameters = data.frame(parameter = "intercept",
+                                          class = "logical",
+                                          label = "intercept"),
+                  grid = function(x, y, len = NULL, search = "grid") 
+                    data.frame(intercept = TRUE),
                   fit = function(x, y, wts, param, lev, last, classProbs, ...) {
                     dat <- if(is.data.frame(x)) x else as.data.frame(x)
                     dat$.outcome <- y
                     if(!is.null(wts))
                     {
-                      out <- lm(.outcome ~ ., data = dat, weights = wts, ...)
-                    } else out <- lm(.outcome ~ ., data = dat, ...)
+                      if (param$intercept)
+                        out <- lm(.outcome ~ ., data = dat, weights = wts, ...)
+                      else
+                        out <- lm(.outcome ~ 0 + ., data = dat, weights = wts, ...)
+                    } else 
+                    {
+                      if (param$intercept)
+                        out <- lm(.outcome ~ ., data = dat, ...)
+                      else
+                        out <- lm(.outcome ~ 0 + ., data = dat, ...)
+                    }
                     out
                   },
                   predict = function(modelFit, newdata, submodels = NULL) {
                     if(!is.data.frame(newdata)) newdata <- as.data.frame(newdata)
                     predict(modelFit, newdata)
-                    },
+                  },
                   prob = NULL,
                   predictors = function(x, ...) predictors(x$terms),
                   tags = c("Linear Regression", "Accepts Case Weights"),