إعادة أخذ العينات والتحقق المتقاطع باستخدام rsample

لماذا إعادة أخذ العينات؟

library(rsample)

# Single split — performance estimate depends heavily
# on which 20% ended up as test data
split <- initial_split(mtcars, prop = 0.8)
train <- training(split)
test  <- testing(split)

cat('Train:', nrow(train), '| Test:', nrow(test))

initial_split()

library(rsample)

# Stratified split by outcome variable
split <- initial_split(ames, prop = 0.8, strata = Sale_Price)

train <- training(split)
test  <- testing(split)

cat('Train rows:', nrow(train))
cat('Test rows:', nrow(test))

vfold_cv() — التحقق المتقاطع k-Fold

folds <- vfold_cv(housing_train, v = 10, strata = price)

# Each fold is a split object
print(folds)

# Inspect one fold
fold_1 <- folds$splits[[1]]
train_1 <- analysis(fold_1)
val_1   <- assessment(fold_1)
cat('Fold 1 — Train:', nrow(train_1), '| Val:', nrow(val_1))

fit_resamples()

library(tune)

folds <- vfold_cv(housing_train, v = 10)

res <- fit_resamples(
  wf,       # your workflow
  folds,
  metrics = metric_set(rmse, rsq)
)

# Average metric across all 10 folds
collect_metrics(res)

collect_metrics()

metrics_df <- collect_metrics(res)
print(metrics_df)

#   .metric .estimator   mean  n std_err .config
#   rmse    standard    24500  10   1200  Preprocessor1_Model1
#   rsq     standard    0.882  10  0.012  Preprocessor1_Model1

# Pull a single metric
collect_metrics(res) |>
  dplyr::filter(.metric == 'rmse') |>
  dplyr::pull(mean)

bootstraps() — إعادة أخذ عينات Bootstrap

boot_samples <- bootstraps(housing_train, times = 25, strata = price)

print(boot_samples)

# Average proportion of unique rows in each bootstrap
mean(sapply(boot_samples$splits, function(s) {
  nrow(analysis(s)) / nrow(housing_train)
}))

التحقق المتقاطع بطريقة Monte Carlo

mc_splits <- mc_cv(housing_train, prop = 0.8, times = 20)

res_mc <- fit_resamples(
  wf,
  mc_splits,
  metrics = metric_set(rmse, rsq)
)

collect_metrics(res_mc)

tune_grid() — البحث عن المعلمات الفائقة

rf_spec <- rand_forest(mtry = tune(), trees = tune()) |>
  set_engine('ranger') |>
  set_mode('regression')

wf_tune <- workflow() |> add_recipe(rec) |> add_model(rf_spec)

grid <- grid_regular(mtry(range = c(2, 10)), trees(range = c(100, 500)), levels = 3)

tune_res <- tune_grid(wf_tune, resamples = folds, grid = grid)
collect_metrics(tune_res) |> head()

select_best() و finalize_workflow()

best_params <- select_best(tune_res, metric = 'rmse')
print(best_params)

# Substitute best values into the workflow
final_wf <- finalize_workflow(wf_tune, best_params)

# Fit on all training data, evaluate on test
final_fit <- last_fit(final_wf, split)
collect_metrics(final_fit)

التحقق المتقاطع المتداخل

# Outer folds for unbiased evaluation
outer_folds <- vfold_cv(housing_train, v = 5)

# For each outer fold, tune on the inner training data
res_nested <- tune_grid(
  wf_tune,
  resamples = outer_folds,
  grid = 10,  # 10 random configurations
  metrics = metric_set(rmse)
)

collect_metrics(res_nested)

مقارنة استراتيجيات إعادة أخذ العينات

# Repeated k-fold: 5-fold repeated 3 times = 15 models fitted
repeated_folds <- vfold_cv(housing_train, v = 5, repeats = 3)

res_rep <- fit_resamples(
  wf,
  repeated_folds,
  metrics = metric_set(rmse, rsq)
)

collect_metrics(res_rep)

تحقّق سريع

مراجعة إعادة أخذ العينات

# Full rsample pipeline
split  <- initial_split(data, prop = 0.8, strata = y)
train  <- training(split)
folds  <- vfold_cv(train, v = 10)

res    <- fit_resamples(wf, folds, metrics = metric_set(rmse, rsq))
collect_metrics(res)

# After tuning
best   <- select_best(tune_res, metric = 'rmse')
fin_wf <- finalize_workflow(wf_tune, best)
last_fit(fin_wf, split) |> collect_metrics()