-
Notifications
You must be signed in to change notification settings - Fork 17
/
break.R
37 lines (30 loc) · 1.05 KB
/
break.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
#' Create the broken object for lm models
#'
#' @param model a lm model
#' @param new_observation a new observation with collumns that correspnd to variables used in the model
#' @param ... other parameters
#'
#' @return an object of the broken class
#' @export
#' @importFrom stats predict.lm
#'
#' @examples
#' model <- lm(Sepal.Length~., data=iris)
#' new_observation <- iris[1,]
#' br <- break(model, new_observation)
#' plot(br)
breakDown.lm <- function(model, new_observation, ...) {
model <- lm(Sepal.Length~., data=iris)
ny <- predict.lm(model, newdata = new_observation, type="terms")
broken <- data.frame(variable = paste(colnames(ny), "=",
sapply(new_observation[colnames(ny)], as.character)),
contribution = c(ny))
broken_sorted <- broken[order(-abs(broken$contribution)),]
broken_intercept <- rbind(
data.frame(variable = "(Intercept)",
contribution = attributes(ny)$constant),
broken_sorted)
create(broken_intercept)
}
breakDown.xgboost <- function() {
}