From 28fc1194c0bf7b82ffc14e1dc4fb0e43ef5c82b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Biecek?= Date: Sat, 18 Nov 2017 14:51:38 +0100 Subject: [PATCH] first version of the broken --- .Rbuildignore | 2 ++ .gitignore | 3 +++ DESCRIPTION | 11 +++++++++++ NAMESPACE | 6 ++++++ R/break.R | 37 +++++++++++++++++++++++++++++++++++++ R/create.R | 19 +++++++++++++++++++ R/plot.R | 26 ++++++++++++++++++++++++++ breakDown.Rproj | 21 +++++++++++++++++++++ man/breakDown.lm.Rd | 27 +++++++++++++++++++++++++++ man/create.broken.Rd | 16 ++++++++++++++++ man/plot.broken.Rd | 19 +++++++++++++++++++ 11 files changed, 187 insertions(+) create mode 100644 .Rbuildignore create mode 100644 .gitignore create mode 100644 DESCRIPTION create mode 100644 NAMESPACE create mode 100644 R/break.R create mode 100644 R/create.R create mode 100644 R/plot.R create mode 100644 breakDown.Rproj create mode 100644 man/breakDown.lm.Rd create mode 100644 man/create.broken.Rd create mode 100644 man/plot.broken.Rd diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..91114bf --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,2 @@ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..807ea25 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +.Rproj.user +.Rhistory +.RData diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..dc3554c --- /dev/null +++ b/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 diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..22f614f --- /dev/null +++ b/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) diff --git a/R/break.R b/R/break.R new file mode 100644 index 0000000..1a6633e --- /dev/null +++ b/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() { + +} + diff --git a/R/create.R b/R/create.R new file mode 100644 index 0000000..712d181 --- /dev/null +++ b/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 +} diff --git a/R/plot.R b/R/plot.R new file mode 100644 index 0000000..767775c --- /dev/null +++ b/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()) +} diff --git a/breakDown.Rproj b/breakDown.Rproj new file mode 100644 index 0000000..30e02be --- /dev/null +++ b/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 diff --git a/man/breakDown.lm.Rd b/man/breakDown.lm.Rd new file mode 100644 index 0000000..8d39f10 --- /dev/null +++ b/man/breakDown.lm.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/break.R +\name{breakDown.lm} +\alias{breakDown.lm} +\title{Create the broken object for lm models} +\usage{ +breakDown.lm(model, new_observation, ...) +} +\arguments{ +\item{model}{a lm model} + +\item{new_observation}{a new observation with collumns that correspnd to variables used in the model} + +\item{...}{other parameters} +} +\value{ +an object of the broken class +} +\description{ +Create the broken object for lm models +} +\examples{ +model <- lm(Sepal.Length~., data=iris) +new_observation <- iris[1,] +br <- break(model, new_observation) +plot(br) +} diff --git a/man/create.broken.Rd b/man/create.broken.Rd new file mode 100644 index 0000000..c887ed7 --- /dev/null +++ b/man/create.broken.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create.R +\name{create.broken} +\alias{create.broken} +\title{Clean the object of the broken class +Internatl function} +\usage{ +create.broken(broken_intercept) +} +\value{ +enriched broken class +} +\description{ +Clean the object of the broken class +Internatl function +} diff --git a/man/plot.broken.Rd b/man/plot.broken.Rd new file mode 100644 index 0000000..db3d213 --- /dev/null +++ b/man/plot.broken.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot.R +\name{plot.broken} +\alias{plot.broken} +\title{Break Down PLot} +\usage{ +\method{plot}{broken}(x, ...) +} +\arguments{ +\item{x}{the model model of 'broken' class} + +\item{...}{other parameters} +} +\value{ +a ggplot2 object +} +\description{ +Break Down PLot +}