.Rhistory

ale <- FeatureEffect$new(predictor, feature = "lstat")
ale$plot()
ale$set.feature("rm")
ale$plot()
effs <- FeatureEffects$new(predictor)
plot(effs)
str(X)
str(Boston)
library(box)
installed.packages()
install.packages("box")
ale$set.feature("a1age")
plot.FeatureEffect
iml:::plot.FeatureEffect
effs
library(iml)
# We train a random forest on the Boston dataset:
data("Boston", package = "MASS")
str(Boston)
library("rpart")
rf <- rpart(medv ~ ., data = Boston)
mod <- Predictor$new(rf, data = Boston)
mod
rf
# Compute the accumulated local effects for the first feature
eff <- FeatureEffect$new(mod, feature = "rm", grid.size = 30)
eff$plot()
# Again, but this time with a partial dependence plot and ice curves
eff <- FeatureEffect$new(mod,
feature = "rm", method = "pdp+ice",
grid.size = 30
)
plot(eff)
eff
eff$results |> str()
eff$results |>
count(.type)
eff$results |>
group_by(.type) |>
slice_head(n=3)
eff$results |>
group_by(.type, .id) |>
slice_head(n=3)
eff$results |>
count(.type, .id)
eff$results |>
count(.type, .id) |> view()
# Since the result is a ggplot object, you can extend it:
library("ggplot2")
plot(eff) +
# Adds a title
ggtitle("Partial dependence") +
# Adds original predictions
geom_point(
data = Boston, aes(y = mod$predict(Boston)[[1]], x = rm),
color = "pink", size = 0.5
)
mod$predict(Boston)[[1]] |> str()
mod$predict(Boston) |> str()
mod
str(mod)
# If you want to do your own thing, just extract the data:
eff.dat <- eff$results
head(eff.dat)
str(eff.dat)
# You can also use the object to "predict" the marginal values.
eff$predict(Boston[1:3, ])
# Instead of the entire data.frame, you can also use feature values:
eff$predict(c(5, 6, 7))
eff$predictor
eff$predict
eff$method
# Instead of the entire data.frame, you can also use feature values:
eff$predict(c(5, 6, 7))
# You can also use the object to "predict" the marginal values.
eff$predict(Boston[1:3, ])
# You can reuse the pdp object for other features:
eff$set.feature("lstat")
plot(eff)
# Only plotting the aggregated partial dependence:
eff <- FeatureEffect$new(mod, feature = "crim", method = "pdp")
eff$plot()
# Only plotting the individual conditional expectation:
eff <- FeatureEffect$new(mod, feature = "crim", method = "ice")
eff$plot()
# Accumulated local effects and partial dependence plots support up to two
# features:
eff <- FeatureEffect$new(mod, feature = c("crim", "lstat"))
install.packages("yaImpute")
# Accumulated local effects and partial dependence plots support up to two
# features:
eff <- FeatureEffect$new(mod, feature = c("crim", "lstat"))
plot(eff)
# FeatureEffect plots also works with multiclass classification
rf <- rpart(Species ~ ., data = iris)
mod <- Predictor$new(rf, data = iris, type = "prob")
mod
rf
mod$predict()
mod$predict(iris)
# For some models we have to specify additional arguments for the predict
# function
plot(FeatureEffect$new(mod, feature = "Petal.Width"))
library(iml)
# We train a random forest on the Boston dataset:
data("Boston", package = "MASS")
str(Boston)
library("rpart")
rf <- rpart(medv ~ ., data = Boston)
mod <- Predictor$new(rf, data = Boston)
# Compute the accumulated local effects for the first feature
eff <- FeatureEffect$new(mod, feature = "rm", grid.size = 30)
eff$plot()
# Again, but this time with a partial dependence plot and ice curves
eff <- FeatureEffect$new(mod,
feature = "rm", method = "pdp+ice",
grid.size = 30
)
plot(eff)
eff$results |> str()
eff$results |>
count(.type, .id) |> view()
eff$results |>
group_by(.type, .id) |>
slice_head(n=3)
# Since the result is a ggplot object, you can extend it:
library("ggplot2")
plot(eff) +
# Adds a title
ggtitle("Partial dependence") +
# Adds original predictions
geom_point(
data = Boston, aes(y = mod$predict(Boston)[[1]], x = rm),
color = "pink", size = 0.5
)
# If you want to do your own thing, just extract the data:
eff.dat <- eff$results
str(eff.dat)
head(eff.dat)
# You can also use the object to "predict" the marginal values.
eff$predict(Boston[1:3, ])
# Instead of the entire data.frame, you can also use feature values:
eff$predict(c(5, 6, 7))
# You can reuse the pdp object for other features:
eff$set.feature("lstat")
plot(eff)
# Only plotting the aggregated partial dependence:
eff <- FeatureEffect$new(mod, feature = "crim", method = "pdp")
eff$plot()
# Only plotting the individual conditional expectation:
eff <- FeatureEffect$new(mod, feature = "crim", method = "ice")
eff$plot()
# Accumulated local effects and partial dependence plots support up to two
# features:
eff <- FeatureEffect$new(mod, feature = c("crim", "lstat"))
plot(eff)
# FeatureEffect plots also works with multiclass classification
rf <- rpart(Species ~ ., data = iris)
mod <- Predictor$new(rf, data = iris, type = "prob")
# For some models we have to specify additional arguments for the predict
# function
plot(FeatureEffect$new(mod, feature = "Petal.Width"))
# FeatureEffect plots support up to two features:
eff <- FeatureEffect$new(mod, feature = c("Sepal.Length", "Petal.Length"))
eff$plot()
# show where the actual data lies
eff$plot(show.data = TRUE)
# For multiclass classification models, you can choose to only show one class:
mod <- Predictor$new(rf, data = iris, type = "prob", class = 1)
plot(FeatureEffect$new(mod, feature = "Sepal.Length"))
# For some models we have to specify additional arguments for the predict
# function
plot(FeatureEffect$new(mod, feature = "Petal.Width"))
# FeatureEffect plots also works with multiclass classification
rf <- rpart(Species ~ ., data = iris)
mod <- Predictor$new(rf, data = iris, type = "prob")
# For some models we have to specify additional arguments for the predict
# function
plot(FeatureEffect$new(mod, feature = "Petal.Width"))
# FeatureEffect plots support up to two features:
eff <- FeatureEffect$new(mod, feature = c("Sepal.Length", "Petal.Length"))
eff$plot()
# show where the actual data lies
eff$plot(show.data = TRUE)
# For multiclass classification models, you can choose to only show one class:
mod <- Predictor$new(rf, data = iris, type = "prob", class = 1)
plot(FeatureEffect$new(mod, feature = "Sepal.Length"))
data("Boston", package = "MASS")
head(Boston)
set.seed(42)
library("iml")
library("randomForest")
data("Boston", package = "MASS")
rf <- randomForest(medv ~ ., data = Boston, ntree = 50)
X <- Boston[which(names(Boston) != "medv")]
predictor <- Predictor$new(rf, data = X, y = Boston$medv)
imp <- FeatureImp$new(predictor, loss = "mae")
library("ggplot2")
plot(imp)
imp$results
imp$features
ale <- FeatureEffect$new(predictor, feature = "lstat")
ale$plot()
ale$set.feature("rm")
ale$plot()
interact <- Interaction$new(predictor)
plot(interact)
interact <- Interaction$new(predictor, feature = "crim")
plot(interact)
library("yardstick")
# Two class
data("two_class_example")
brier_class(two_class_example, truth, Class1)
glimpse(two_class_example)
# Multiclass
library(dplyr)
data(hpc_cv)
glimpse(hpc_cv)
# You can use the col1:colN tidyselect syntax
hpc_cv %>%
filter(Resample == "Fold01") %>%
brier_class(obs, VF:L)
# You can use the col1:colN tidyselect syntax
hpc_cv %>%
filter(Resample == "Fold01") %>%
brier_class(obs, VF:L)
data(hpc_cv)
glimpse(hpc_cv)
# You can use the col1:colN tidyselect syntax
hpc_cv %>%
filter(Resample == "Fold01") %>%
brier_class(obs, VF:L)
# You can use the col1:colN tidyselect syntax
hpc_cv %>%
filter(Resample == "Fold01") #%>%
# You can use the col1:colN tidyselect syntax
hpc_cv %>%
dplyr::filter(Resample == "Fold01") #%>%
# You can use the col1:colN tidyselect syntax
hpc_cv %>%
dplyr::filter(Resample == "Fold01") %>%
brier_class(obs, VF:L)
# Groups are respected
hpc_cv %>%
group_by(Resample) %>%
brier_class(obs, VF:L)
# Two class
data("two_class_example")
library("yardstick")
# Two class
data("two_class_example")
mn_log_loss(two_class_example, truth, Class1)
# Multiclass
library(dplyr)
data(hpc_cv)
# You can use the col1:colN tidyselect syntax
hpc_cv %>%
filter(Resample == "Fold01") %>%
mn_log_loss(obs, VF:L)
# You can use the col1:colN tidyselect syntax
hpc_cv %>%
dplyr::filter(Resample == "Fold01") %>%
mn_log_loss(obs, VF:L)
glimpse(hpc_cv)
# Groups are respected
hpc_cv %>%
group_by(Resample) %>%
mn_log_loss(obs, VF:L)
# Vector version
# Supply a matrix of class probabilities
fold1 <- hpc_cv %>%
filter(Resample == "Fold01")
# Vector version
# Supply a matrix of class probabilities
fold1 <- hpc_cv %>%
dplyr::filter(Resample == "Fold01")
mn_log_loss_vec(
truth = fold1$obs,
matrix(
c(fold1$VF, fold1$F, fold1$M, fold1$L),
ncol = 4
)
)
str(fold1)
matrix(
c(fold1$VF, fold1$F, fold1$M, fold1$L),
ncol = 4
)
matrix(
c(fold1$VF, fold1$F, fold1$M, fold1$L),
ncol = 4
) |> str()
str(fold1)
library(dplyr)
# Multiple regression metrics
multi_metric <- metric_set(rmse, rsq, ccc)
# The returned function has arguments:
# fn(data, truth, estimate, na_rm = TRUE, ...)
multi_metric(solubility_test, truth = solubility, estimate = prediction)
glimpse(solubility_test)
# Multiple regression metrics
multi_metric <- metric_set(rmse, rsq, ccc)
multi_metric
metric_set
# Groups are respected on the new metric function
class_metrics <- metric_set(accuracy, kap)
class_metrics
hpc_cv %>%
group_by(Resample) %>%
class_metrics(obs, estimate = pred)
# If you need to set options for certain metrics,
# do so by wrapping the metric and setting the options inside the wrapper,
# passing along truth and estimate as quoted arguments.
# Then add on the function class of the underlying wrapped function,
# and the direction of optimization.
ccc_with_bias <- function(data, truth, estimate, na_rm = TRUE, ...) {
ccc(
data = data,
truth = !!rlang::enquo(truth),
estimate = !!rlang::enquo(estimate),
# set bias = TRUE
bias = TRUE,
na_rm = na_rm,
...
)
}
# Use `new_numeric_metric()` to formalize this new metric function
ccc_with_bias <- new_numeric_metric(ccc_with_bias, "maximize")
multi_metric2 <- metric_set(rmse, rsq, ccc_with_bias)
multi_metric2
multi_metric2(solubility_test, truth = solubility, estimate = prediction)
str(multi_metric)
multi_metric()
multi_metric
multi_metric |> str()
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy)
hpc_cv %>%
group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
glimpse(hpc_cv)
hpc_cv %>%
group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy, logloss)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy, mn_log_loss)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy, mn_log_loss, brier_class)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
?accuracy
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy, mn_log_loss, brier_class, kap)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy, mn_log_loss, brier_class, kap, mcc)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy, mn_log_loss, brier_class, kap, mcc, roc_auc)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy, mn_log_loss, brier_class, kap, mcc, roc_auc, roc_aunp)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy, mn_log_loss, brier_class, kap, mcc, roc_auc, roc_aunu)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
class_and_probs_metrics <- metric_set(roc_auc, pr_auc, accuracy, mn_log_loss, brier_class, kap, mcc, roc_auc)
hpc_cv %>%
# group_by(Resample) %>%
class_and_probs_metrics(obs, VF:L, estimate = pred)
?ggplot
?aes
aes(x = mpg, y = wt)
ae <- aes(x = mpg, y = wt)
ae
ae$x
aes(col = x)
aes(fg = x)
aes(color = x)
aes(colour = x)
scatter_by <- function(data, ...) {
ggplot(data) + geom_point(aes(...))
}
scatter_by(mtcars, disp, drat)
scatter_by <- function(data, x, y) {
ggplot(data) + geom_point(aes({{ x }}, {{ y }}))
}
scatter_by(mtcars, disp, drat)
cut3 <- function(x) cut_number(x, 3)
scatter_by(mtcars, cut3(disp), drat)
library(ComplexUpset)
install.packages("ComplexUpset")
library(ComplexUpset)
movies = as.data.frame(ggplot2movies::movies)
install.packages("ggplot2movies")
movies = as.data.frame(ggplot2movies::movies)
head(movies, 3)
head(movies, 3)
t(head(movies[genres], 3))
genres
genres = colnames(movies)[18:24]
genres
movies[genres] = movies[genres] == 1
t(head(movies[genres], 3))
movies[movies$mpaa == '', 'mpaa'] = NA
movies = na.omit(movies)
str(movies)
set_size = function(w, h, factor=1.5) {
s = 1 * factor
options(
repr.plot.width=w * s,
repr.plot.height=h * s,
repr.plot.res=100 / factor,
jupyter.plot_mimetypes='image/png',
jupyter.plot_scale=1
)
}
set_size()
set_size
genres
library(shiny)
library(reactable)
install.packages("reactable")
library(shiny)
library(reactable)
library(widgetTools)
install.packages("widgetTools")
library(widgetTools)
library(chattr)
remotes::install_github("mlverse/chattr")
library(rstan)
install.packages(rstan)
install.packages("rstan")
library(rstan)
install.packages("INLA",repos=c(getOption("repos"),INLA="https://inla.r-inla-download.org/R/stable"), dep=TRUE)
library(INLA)
## Loading required package: Matrix
## Loading required package: sp
## The legacy packages maptools, rgdal, and rgeos, underpinning the sp package,
## which was just loaded, will retire in October 2023.
## Please refer to R-spatial evolution reports for details, especially
## https://r-spatial.org/r/2023/05/15/evolution4.html.
## It may be desirable to make the sf package available;
## package maintainers should consider adding sf to Suggests:.
## The sp package is now running under evolution status 2
##      (status 2 uses the sf package in place of rgdal)
## This is INLA_23.06.14 built 2023-06-13 23:16:56 UTC.
##  - See www.r-inla.org/contact-us for how to get help.
n = 100; a = 1; b = 1; tau = 100
z = rnorm(n)
eta = a + b*z
scale = exp(rnorm(n))
prec = scale*tau
y = rnorm(n, mean = eta, sd = 1/sqrt(prec))
data = list(y=y, z=z)
formula = y ~ 1+z
result = inla(formula, family = "gaussian", data = data)
summary(result)
result
str(z)
str(prec)
R.version
search()
# install.packages("INLA",repos=c(getOption("repos"),INLA="https://inla.r-inla-download.org/R/stable"), dep=TRUE)
library(INLA)
n = 100; a = 1; b = 1; tau = 100
z = rnorm(n)
eta = a + b*z
scale = exp(rnorm(n))
prec = scale*tau
y = rnorm(n, mean = eta, sd = 1/sqrt(prec))
data = list(y=y, z=z)
formula = y ~ 1+z
result = inla(formula, family = "gaussian", data = data)
summary(result)
library(rjags)
install.packages("rjags")
library(rjags)
library(geomtextpath)
install.packages("geomtextpath")
install.packages("geomtextpath")
library(geomtextpath)
?geom_textdensity
ggplot(iris, aes(Sepal.Length, label = Species, color = Species)) +
geom_textdensity()
quarto_version()
setwd("~/gDoc/learn/Quarto/quarto_website_positconf2024")
library(ggplot2)
ggplot(mtcars, aes(x = wt, y = mpg, colour = factor(cyl))) +
geom_point()
install.packages("here")
install.packages("janitor")
install.packages("extrafont")
install.packages("hrbrthemes")
install.packages("digest")
install.packages("digest")
library(digest)
install.packages("digest")
install.packages("digest")