first version of the broken

.Rbuildignore

@@ -0,0 +1,2 @@
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -0,0 +1,3 @@
+.Rproj.user
+.Rhistory
+.RData

DESCRIPTION

@@ -0,0 +1,11 @@
+Package: breakDown
+Title: What the Package Does (one line, title case)
+Version: 0.0.0.9000
+Authors@R: person("First", "Last", email = "first.last@example.com", role = c("aut", "cre"))
+Description: What the package does (one paragraph).
+Depends: R (>= 3.4.2)
+License: What license is it under?
+Encoding: UTF-8
+LazyData: true
+Imports: ggplot2
+RoxygenNote: 6.0.1.9000

NAMESPACE

@@ -0,0 +1,6 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(plot,broken)
+export(breakDown.lm)
+import(ggplot2)
+importFrom(stats,predict.lm)

R/break.R

@@ -0,0 +1,37 @@
+#' 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() {
+
+}
+

R/create.R

@@ -0,0 +1,19 @@
+#' Clean the object of the broken class
+#' Internatl function
+#'
+#' @return enriched broken class
+#' @examples
+create.broken <- function(broken_intercept) {
+  broken_cumm <- data.frame(broken_intercept,
+                            cummulative = cumsum(as.numeric(broken_intercept$contribution)),
+                            sign = factor(sign(as.numeric(broken_intercept$contribution)), levels = c(-1, 0, 1)),
+                            position = seq_along(broken_intercept$variable))
+  broken_cumm <- rbind(broken_cumm,
+                       data.frame(variable = "final_prognosis",
+                                  contribution = sum(broken_cumm$contribution),
+                                  cummulative = sum(broken_cumm$contribution),
+                                  sign = "X",
+                                  position = max(broken_cumm$position)+1))
+ class(broken_cumm) = "broken"
+ broken_cumm
+}

R/plot.R

@@ -0,0 +1,26 @@
+#' Break Down PLot
+#'
+#' @param x the model model of 'broken' class
+#' @param ... other parameters
+#'
+#' @return a ggplot2 object
+#' @export
+#' @import ggplot2
+#'
+#' @examples
+plot.broken <- function(x, ...) {
+  broken_cumm <- x
+  ggplot(broken_cumm, aes(x = position + 0.5,
+                          y = pmax(cummulative, cummulative - contribution),
+                          xmin = position, xmax=position + 0.95,
+                          ymin = cummulative, ymax = cummulative - contribution,
+                          fill = sign,
+                          label = sapply(contribution, function(tmp) as.character(signif(tmp, 2))))) +
+    geom_rect(alpha=0.9) +
+    geom_text(nudge_y = 0.1, vjust = 0.5, hjust=0) +
+    scale_y_continuous(expand = c(0.1,0.1), name="") +
+    scale_x_continuous(labels = broken_cumm$variable, breaks = broken_cumm$position+0.5, name="") +
+    scale_fill_manual(values = c("-1" = "#d8b365", "0" = "#f5f5f5", "1" = "#5ab4ac", "X" = "darkgrey")) +
+    coord_flip() +
+    theme_light() + theme(legend.position = "none", panel.border = element_blank())
+}

breakDown.Rproj

@@ -0,0 +1,21 @@
+Version: 1.0
+
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: knitr
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace