keep() وdiscard() وتصفية القوائم

تصفية القوائم باستخدام purrr

library(purrr)

# A mixed list to filter
mixed <- list(1L, 'hello', 3.14, NULL, TRUE, 42L, 'world', NULL)

cat('Total elements:', length(mixed), '\n')
cat('Non-NULL elements:', length(compact(mixed)))

keep() — الاحتفاظ بالعناصر المطابقة لدالة اختبارية

library(purrr)

mixed <- list(1L, 'hello', 3.14, TRUE, 42L, 'world', 2.7)

# Keep only numeric values
numeric_only <- keep(mixed, is.numeric)
print(numeric_only)

# Keep values greater than 5
keep(mixed, ~is.numeric(.x) && .x > 5)

discard() — إزالة العناصر المطابقة لدالة اختبارية

library(purrr)

results <- list(
  model_a = list(rmse=2.5, converged=TRUE),
  model_b = list(rmse=NA, converged=FALSE),
  model_c = list(rmse=1.8, converged=TRUE),
  model_d = list(rmse=NA, converged=FALSE)
)

# Discard models that did not converge
converged_models <- discard(results, ~!.x$converged)
map_dbl(converged_models, ~.x$rmse)

compact() — إزالة عناصر NULL

library(purrr)

# Simulate fetching data that might return NULL
ids <- 1:6
fetch_data <- function(id) {
  if (id %% 2 == 0) NULL else list(id=id, value=id*10)
}

raw_results <- map(ids, fetch_data)
cat('With NULLs:', length(raw_results), '\n')

clean_results <- compact(raw_results)
cat('Without NULLs:', length(clean_results))

detect() — العثور على أول تطابق

library(purrr)

prices <- list(15.99, 8.50, 23.99, 5.25, 19.99, 4.75)

# Find first price under $10
first_cheap <- detect(prices, ~.x < 10)
cat('First price under $10:', first_cheap, '\n')

# Find last price under $10
last_cheap <- detect(prices, ~.x < 10, .right=TRUE)
cat('Last price under $10:', last_cheap)

detect_index() — العثور على موضع أول تطابق

library(purrr)

models <- list(
  list(name='lm', rmse=3.5),
  list(name='rf', rmse=2.1),
  list(name='xgb', rmse=1.8),
  list(name='svm', rmse=2.4)
)

# Find the index of the best model (lowest RMSE)
best_idx <- detect_index(models, function(m) m$rmse < 2.0)
cat('Best model index:', best_idx, '\n')
cat('Best model name:', models[[best_idx]]$name)

every() — هل تطابق جميع العناصر؟

library(purrr)

batch_results <- list(
  list(status='success', rows=150),
  list(status='success', rows=200),
  list(status='success', rows=175)
)

failed_batch <- list(
  list(status='success', rows=150),
  list(status='error', rows=0),
  list(status='success', rows=175)
)

cat('All success (good):', every(batch_results, ~.x$status == 'success'), '\n')
cat('All success (bad):', every(failed_batch, ~.x$status == 'success'))

some() — هل يطابق أي عنصر؟

library(purrr)

datasets <- list(
  data.frame(x=1:3, y=c(1,NA,3)),
  data.frame(x=4:6, y=7:9),
  data.frame(x=7:9, y=c(NA,NA,NA))
)

# Does any dataset contain NAs?
cat('Any NAs:', some(datasets, anyNA), '\n')

# Is every dataset NA-free?
cat('All clean:', every(datasets, ~!anyNA(.x)))

none() — هل لا يطابق أي عنصر؟

library(purrr)

api_responses <- list(
  list(code=200, data='OK'),
  list(code=200, data='OK'),
  list(code=201, data='Created')
)

# Ensure no errors occurred
no_errors <- none(api_responses, ~.x$code >= 400)
cat('No errors:', no_errors, '\n')

# Check another batch
bad_batch <- c(api_responses, list(list(code=500, data='Error')))
none(bad_batch, ~.x$code >= 400)

دمج keep() مع map()

library(purrr)

model_results <- list(
  list(name='A', converged=TRUE, rmse=2.5),
  list(name='B', converged=FALSE, rmse=NA),
  list(name='C', converged=TRUE, rmse=1.8),
  list(name='D', converged=TRUE, rmse=3.1)
)

# Keep converged, extract RMSE
model_results %>%
  keep(~.x$converged) %>%
  map_dbl(~.x$rmse)

استخدام keep() مع دوال is.*

library(purrr)

mixed_env <- list(
  count = 42L,
  name = 'Alice',
  ratio = 3.14,
  flag = TRUE,
  missing = NULL,
  data = data.frame(x=1:3)
)

# Extract different types
numeric_items <- keep(mixed_env, is.numeric)
cat('Numeric items:', length(numeric_items), '\n')

# Remove NULL items
cleaned <- discard(mixed_env, is.null)
cat('After removing NULL:', length(cleaned))

تحقّق سريع

مراجعة: دوال تصفية القوائم

library(purrr)

scores <- list(45, 72, 88, 53, 91, 67, 39, 85)

passing <- keep(scores, ~.x >= 60)
failing <- discard(scores, ~.x >= 60)

cat('Passing:', length(passing), 'students\n')
cat('Failing:', length(failing), 'students\n')
cat('All pass:', every(scores, ~.x >= 60), '\n')
cat('Any fail:', some(scores, ~.x < 60), '\n')
cat('First pass score:', detect(scores, ~.x >= 60))