Skip to content

Instantly share code, notes, and snippets.

View RaphaelS1's full-sized avatar
🐢

Raphael Sonabend RaphaelS1

🐢
View GitHub Profile
@RaphaelS1
RaphaelS1 / riscitation.R
Last active November 25, 2023 10:43
Create a .ris file from an R citation
#' riscitation - Create .ris file from R citation
#'
#' Suggests:
#' Package `berryFunctions` if `opendelete = TRUE`.
#'
#' Arguments
#' `pkg:character(1)` - Name of package to cite
#' `path:character(1)` - Path to write file too, should include file name but not extension
#' `opendelete:logical(1)` - If `TRUE` (default), opens the .ris file in the default application then deletes
#' the file.
## select holdout as the resampling strategy
resampling <- rsmp("cv", folds = 3)
## add KM and CPH
learners <- c(learners, lrns(c("surv.kaplan", "surv.coxph")))
design <- benchmark_grid(tasks, learners, resampling)
bm <- benchmark(design)
## Aggreggate with Harrell's C and Integrated Graf Score
msrs <- msrs(c("surv.cindex", "surv.graf"))
@RaphaelS1
RaphaelS1 / Documentation.yml
Last active September 19, 2022 05:35
Workflow to check if all objects in Julia package documented as expected.
name: Documentation
on:
push:
branches:
- main
- master
tags: '*'
pull_request:
options(repos=c(
mlrorg = 'https://mlr-org.r-universe.dev',
raphaels1 = 'https://raphaels1.r-universe.dev',
CRAN = 'https://cloud.r-project.org'
))
install.packages(c("ggplot2", "mlr3benchmark", "mlr3pipelines", "mlr3proba", "mlr3tuning",
"survivalmodels", "mlr3extralearners"))
@RaphaelS1
RaphaelS1 / shaps.R
Created June 18, 2022 11:58
shaps.R
#' Get SHAPs from a trained xgboost model
#' @param model trained xgboost model
#' @param data new data for calculating shaps
get_shaps <- function(model, data) {
p = predict(model, data,
predcontrib = T, approxcontrib = F)
p = p[, -ncol(p)]
shaps = reshape2::melt(p)
vars = reshape2::melt(data)
@RaphaelS1
RaphaelS1 / raincloud.R
Last active April 22, 2022 10:09
Create raincloud plots with ggplot2
raincloudplot <- function(data, y, fill, x = fill, cols = NULL,
boxplots = c("below", "in", "none")) {
require(dplyr)
require(ggplot2)
source("https://raw.githubusercontent.com/datavizpyr/data/master/half_flat_violinplot.R")
boxplots <- match.arg(boxplots)
p <- ggplot(data, aes_string(y = y, x = x, fill = fill)) +
@RaphaelS1
RaphaelS1 / massign.R
Last active March 16, 2022 15:52
Multiple assignment of variable values in R
`%=%` <- function(l, r) {
l <- trimws(strsplit(l, ",", TRUE)[[1]])
if (all(l == "USE.NAMES") || all(l == "*") || all(l == "?")) {
stopifnot(length(names(r)) > 0)
l <- names(r)
} else {
stopifnot(identical(length(l), length(r)))
which <- l == "?"
if (any(which)) {
stopifnot(length(names(r)) > 0)
library(mlr3benchmark)
## create mlr3benchmark object
bma <- as.BenchmarkAggr(bm)
## run global Friedman test
bma$friedman_test()
## learners are stored in mlr3extralearners
library(mlr3extralearners)
## load learners
learners <- lrns(
 paste0("surv.", c("coxtime", "deephit", "deepsurv", "loghaz", "pchazard")),
 frac = 0.3, early_stopping = TRUE, epochs = 10, optimizer = "adam"
)
# apply our function
library(paradox)
search_space <- ps(
 ## p_dbl for numeric valued parameters
 dropout = p_dbl(lower = 0, upper = 1),
 weight_decay = p_dbl(lower = 0, upper = 0.5),
 learning_rate = p_dbl(lower = 0, upper = 1),
 ## p_int for integer valued parameters
 nodes = p_int(lower = 1, upper = 32),