Robuste Funktionen mit stop() und warning() schreiben

# Without validation: wrong result, no error
bad_mean <- function(x) sum(x) / length(x)
bad_mean('hello')   # no error, just NA

# With validation: clear error
good_mean <- function(x) {
  if (!is.numeric(x)) stop('x must be numeric')
  sum(x) / length(x)
}
tryCatch(good_mean('hello'), error = function(e) cat(e$message, '\n'))

check_numeric <- function(x, arg_name = 'x') {
  if (!is.numeric(x)) {
    stop(sprintf(
      "'%s' must be numeric, but got class '%s'",
      arg_name, class(x)
    ))
  }
}
tryCatch(check_numeric('abc', 'score'),
  error = function(e) cat(e$message, '\n'))

validate_prob <- function(p) {
  if (!is.numeric(p)) stop(paste0('p must be numeric, got: ', class(p)))
  if (length(p) != 1) stop(paste0('p must be length 1, got: ', length(p)))
  if (p < 0 || p > 1) stop(paste0('p must be in [0,1], got: ', p))
  p
}
cat(validate_prob(0.7), '\n')
tryCatch(validate_prob(1.5), error = function(e) cat(e$message, '\n'))

clamp <- function(x, lo, hi) {
  if (any(x < lo)) warning(paste0(sum(x < lo), ' value(s) below lo, clamped'))
  if (any(x > hi)) warning(paste0(sum(x > hi), ' value(s) above hi, clamped'))
  pmax(lo, pmin(hi, x))
}
result <- clamp(c(2, -5, 7, 100, 4), 0, 10)
cat('Result:', result, '\n')

# With call. = TRUE (default): shows calling function
f1 <- function(x) stop('bad input')
tryCatch(f1(1), error = function(e) cat(conditionMessage(e), '\n'))

# With call. = FALSE: cleaner message
f2 <- function(x) stop('bad input', call. = FALSE)
tryCatch(f2(1), error = function(e) cat(conditionMessage(e), '\n'))

value_error <- function(msg, call = sys.call(-1)) {
  structure(
    class = c('value_error', 'error', 'condition'),
    list(message = msg, call = call)
  )
}
check_positive <- function(x) {
  if (x <= 0) stop(value_error(paste0('Expected positive, got: ', x)))
  x
}
tryCatch(check_positive(-3),
  value_error = function(e) cat('ValueError:', e$message, '\n'),
  error        = function(e) cat('Other error:', e$message, '\n'))

require_cols <- function(df, cols) {
  missing <- setdiff(cols, names(df))
  if (length(missing) > 0) {
    stop(paste0('Missing columns: ', paste(missing, collapse = ', ')))
  }
  invisible(df)
}
df <- data.frame(x = 1:3, y = 4:6)
tryCatch(
  require_cols(df, c('x', 'z', 'w')),
  error = function(e) cat(e$message, '\n')
)

compute_area <- function(width, height) {
  stopifnot(
    is.numeric(width),
    is.numeric(height),
    width > 0,
    height > 0
  )
  width * height
}
cat(compute_area(5, 3), '\n')
tryCatch(compute_area(-1, 3), error = function(e) cat(e$message, '\n'))

validate_age <- function(age) {
  stopifnot(
    'age must be numeric'    = is.numeric(age),
    'age must be positive'   = age > 0,
    'age must be under 150'  = age < 150
  )
  invisible(age)
}
tryCatch(validate_age(-5), error = function(e) cat(e$message, '\n'))
tryCatch(validate_age('x'), error = function(e) cat(e$message, '\n'))

discount_price <- function(price, pct) {
  if (!is.numeric(price) || price <= 0)
    stop(paste0('price must be positive numeric, got: ', price))
  if (!is.numeric(pct) || pct < 0 || pct > 100)
    stop(paste0('pct must be in [0,100], got: ', pct))
  if (pct > 50) warning('discount > 50% is unusual')
  price * (1 - pct / 100)
}
cat(discount_price(100, 20), '\n')
cat(suppressWarnings(discount_price(100, 60)), '\n')

safe_log <- function(x) {
  tryCatch({
    if (!is.numeric(x)) stop('not numeric')
    if (x <= 0) stop('must be positive')
    log(x)
  }, error = function(e) {
    warning(paste0('safe_log failed for x=', x, ': ', e$message))
    NA_real_
  })
}
results <- sapply(list(10, -1, 'a', 100), safe_log)
cat(results, '\n')

robust_divide <- function(x, y) {
  stopifnot('x must be numeric' = is.numeric(x),
            'y must be numeric' = is.numeric(y))
  if (y == 0) stop('Division by zero', call. = FALSE)
  if (abs(y) < 1e-10) warning('y is very small; result may be inaccurate')
  x / y
}
cat(robust_divide(10, 2), '\n')
tryCatch(robust_divide(10, 0), error = function(e) cat(e$message, '\n'))