inst/doc/ms-perks-features.R

In modelStudio: Interactive Studio for Explanatory Model Analysis

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = FALSE,
  comment = "#>",
  warning = FALSE,
  message = FALSE
)

## ----results="hide"-----------------------------------------------------------
train <- DALEX::HR
train$fired <- as.factor(ifelse(train$status == "fired", 1, 0))
train$status <- NULL

head(train)

## ----echo = FALSE, fig.align='center'-----------------------------------------
knitr::kable(head(train), digits = 2, caption = "DALEX::HR dataset")

## ----results="hide", eval = FALSE---------------------------------------------
#  # fit a ranger model
#  library("ranger")
#  model <- ranger(fired ~., data = train, probability = TRUE)
#  
#  # prepare validation dataset
#  test <- DALEX::HR_test[1:1000,]
#  test$fired <- ifelse(test$status == "fired", 1, 0)
#  test$status <- NULL
#  
#  # create an explainer for the model
#  explainer <- DALEX::explain(model,
#                              data = test,
#                              y = test$fired)
#  
#  # start modelStudio
#  library("modelStudio")

## ----eval = FALSE-------------------------------------------------------------
#  new_observation <- test[1:3,]
#  rownames(new_observation) <- c("John Snow", "Arya Stark", "Samwell Tarly")
#  true_labels <- test[1:3,]$fired
#  
#  modelStudio(explainer,
#              new_observation = new_observation,
#              new_observation_y  = true_labels)

## ----eval = FALSE-------------------------------------------------------------
#  modelStudio(explainer, new_observation_n = 5) # default is 3

## ----eval = FALSE-------------------------------------------------------------
#  # small dashboard with 2 panels
#  modelStudio(explainer,
#              facet_dim = c(1,2))
#  
#  # large dashboard with 9 panels
#  modelStudio(explainer,
#              facet_dim = c(3,3))

## ----eval = FALSE-------------------------------------------------------------
#  # slow down animations
#  modelStudio(explainer,
#              time = 1000)
#  
#  # turn off animations
#  modelStudio(explainer,
#              time = 0)

## ----eval = FALSE-------------------------------------------------------------
#  # faster, less precise
#  modelStudio(explainer,
#              N = 200, B = 5)
#  
#  # slower, more precise
#  modelStudio(explainer,
#              N = 500, B = 15)

## ----eval = FALSE-------------------------------------------------------------
#  modelStudio(explainer,
#              eda = FALSE)

## ----eval = FALSE-------------------------------------------------------------
#  modelStudio(explainer,
#              show_info = FALSE)

## ----eval = FALSE-------------------------------------------------------------
#  modelStudio(explainer,
#              viewer = "browser")

## ----eval = FALSE-------------------------------------------------------------
#  # set up the cluster
#  options(
#    parallelMap.default.mode        = "socket",
#    parallelMap.default.cpus        = 4,
#    parallelMap.default.show.info   = FALSE
#  )
#  
#  # calculations of local explanations will be distributed into 4 cores
#  modelStudio(explainer,
#              new_observation = test[1:16,],
#              parallel = TRUE)

## ----eval = FALSE-------------------------------------------------------------
#  # set additional graphical parameters
#  new_options <- ms_options(
#    show_subtitle = TRUE,
#    bd_subtitle = "Hello World",
#    line_size = 5,
#    point_size = 9,
#    line_color = "pink",
#    point_color = "purple",
#    bd_positive_color = "yellow",
#    bd_negative_color = "orange"
#  )
#  
#  modelStudio(explainer,
#              options = new_options)

## ----eval = FALSE-------------------------------------------------------------
#  old_ms <- modelStudio(explainer)
#  old_ms
#  
#  # update the options
#  new_ms <- ms_update_options(old_ms,
#                              time = 0,
#                              facet_dim = c(1,2),
#                              margin_left = 150)
#  new_ms

## ----eval = FALSE-------------------------------------------------------------
#  old_ms <- modelStudio(explainer)
#  old_ms
#  
#  # add new observations
#  plus_ms <- ms_update_observations(old_ms,
#                                    explainer,
#                                    new_observation = test[101:102,])
#  plus_ms
#  
#  # overwrite old observations
#  new_ms <- ms_update_observations(old_ms,
#                                   explainer,
#                                   new_observation = test[103:104,],
#                                   overwrite = TRUE)
#  new_ms

## ----eval = FALSE-------------------------------------------------------------
#  library(shiny)
#  library(r2d3)
#  
#  
#  ui <- fluidPage(
#    textInput("text", h3("Text input"),
#              value = "Enter text..."),
#    uiOutput('dashboard')
#  )
#  
#  server <- function(input, output) {
#    #:# id of div where modelStudio will appear
#    WIDGET_ID = 'MODELSTUDIO'
#  
#    #:# create modelStudio
#    library(modelStudio)
#    library(DALEX)
#    model <- glm(survived ~., data = titanic_imputed, family = "binomial")
#    explainer <- DALEX::explain(model,
#                                data = titanic_imputed,
#                                y = titanic_imputed$survived,
#                                label = "Titanic GLM",
#                                verbose = FALSE)
#    ms <- modelStudio(explainer,
#                      widget_id = WIDGET_ID,  #:# use the widget_id
#                      show_info = FALSE)
#    ms$elementId <- NULL                      #:# remove elementId to stop the warning
#  
#    #:# basic render d3 output
#    output[[WIDGET_ID]] <- renderD3({
#      ms
#    })
#  
#    #:# use render ui to set proper width and height
#    output$dashboard <- renderUI({
#      d3Output(WIDGET_ID, width=ms$width, height=ms$height)
#    })
#  }
#  
#  shinyApp(ui = ui, server = server)

## ----eval = FALSE-------------------------------------------------------------
#  library(DALEXtra)
#  library(mlr)
#  
#  # fit a model
#  task <- makeClassifTask(id = "task", data = train, target = "fired")
#  learner <- makeLearner("classif.ranger", predict.type = "prob")
#  model <- train(learner, task)
#  
#  # create an explainer for the model
#  explainer_mlr <- explain_mlr(model,
#                               data = test,
#                               y = test$fired,
#                               label = "mlr")
#  
#  # make a studio for the model
#  modelStudio(explainer_mlr)