R Examples¶
Complete R examples demonstrating rfastloess capabilities with base R and visualization.
Batch Smoothing¶
Process complete datasets with confidence intervals, diagnostics, and cross-validation.
#!/usr/bin/env Rscript
# =============================================================================
# rfastloess Batch Smoothing - Comprehensive Examples
#
# 1. Basic smoothing
# 2. Robust smoothing with outliers
# 3. Uncertainty quantification (confidence/prediction intervals)
# 4. Cross-validation (K-Fold)
# 5. Complete diagnostic analysis
# 6. Different weight functions (kernels)
# 7. Robustness methods comparison
# 8. Benchmark
# 9. Scaling methods (MAR, MAD, Mean)
# 10. Boundary policies
# 11. Zero-weight fallback strategies
# 12. Polynomial degrees + iterations_used
# 13. Distance metrics
# 14. Surface modes and standard errors
# 15. Additional weight functions
# 16. LOOCV and auto-converge
# 17. Interpolation tuning (surface_mode effects)
# =============================================================================
library(rfastloess)
make_linear <- function(n) {
list(x = as.numeric(0:(n - 1)), y = 2 * as.numeric(0:(n - 1)) + 1)
}
# ── Example 1: Basic Smoothing ──────────────────────────────────────────────
example_1_basic_smoothing <- function() {
cat("Example 1: Basic Smoothing\n")
x <- c(1, 2, 3, 4, 5)
y <- c(2.0, 4.1, 5.9, 8.2, 9.8)
result <- Loess(fraction = 0.5, iterations = 3L)$fit(x, y)
cat(sprintf(" fraction_used=%g\n", result$fraction_used))
cat(" Smoothed:", paste(round(result$y, 3), collapse = ", "), "\n\n")
}
# ── Example 2: Robust Smoothing with Outliers ────────────────────────────────
example_2_robust_with_outliers <- function() {
cat("Example 2: Robust Smoothing with Outliers\n")
x <- c(1, 2, 3, 4, 5, 6, 7, 8)
y <- c(2.1, 4.0, 5.9, 25.0, 10.1, 12.0, 14.1, 15.9) # 25.0 is outlier
result <- Loess(
fraction = 0.5, iterations = 5L,
robustness_method = "bisquare",
return_robustness_weights = TRUE,
return_residuals = TRUE
)$fit(x, y)
if (!is.null(result$robustness_weights)) {
for (i in seq_along(result$robustness_weights)) {
if (result$robustness_weights[i] < 0.5) {
cat(sprintf(
" Outlier at index %d (y=%.1f): weight=%.3f\n",
i, y[i], result$robustness_weights[i]
))
}
}
}
cat(" Smoothed:", paste(round(result$y, 2), collapse = ", "), "\n\n")
}
# ── Example 3: Uncertainty Quantification ───────────────────────────────────
example_3_uncertainty_quant <- function() {
cat("Example 3: Uncertainty Quantification\n")
x <- c(1, 2, 3, 4, 5, 6, 7, 8)
y <- c(2.1, 3.8, 6.2, 7.9, 10.3, 11.8, 14.1, 15.7)
result <- Loess(
fraction = 0.5, iterations = 3L,
confidence_intervals = 0.95,
prediction_intervals = 0.95
)$fit(x, y)
cat(" x y_smooth conf_low conf_high pred_low pred_high\n")
for (i in seq_along(result$y)) {
cat(sprintf(
" %d %.4f %.4f %.4f %.4f %.4f\n",
result$x[i], result$y[i],
result$confidence_lower[i], result$confidence_upper[i],
result$prediction_lower[i], result$prediction_upper[i]
))
}
cat("\n")
}
# ── Example 4: Cross-Validation ──────────────────────────────────────────────
example_4_cross_validation <- function() {
cat("Example 4: Cross-Validation for Parameter Selection\n")
x <- 1:20
y <- 2 * x + 1 + sin(x * 0.5)
result <- Loess(
cv_fractions = c(0.2, 0.3, 0.5, 0.7),
cv_method = "kfold", cv_k = 5L,
iterations = 2L,
return_diagnostics = TRUE
)$fit(x, y)
cat(sprintf(" Selected fraction: %g\n", result$fraction_used))
if (!is.null(result$cv_scores)) {
fracs <- c(0.2, 0.3, 0.5, 0.7)
cat(" CV Scores (RMSE per fraction):\n")
for (i in seq_along(fracs)) {
cat(sprintf(
" fraction=%.1f: %.4f\n",
fracs[i], result$cv_scores[i]
))
}
}
cat("\n")
}
# ── Example 5: Complete Diagnostic Analysis ──────────────────────────────────
example_5_complete_diagnostics <- function() {
cat("Example 5: Complete Diagnostic Analysis\n")
x <- c(1, 2, 3, 4, 5, 6, 7, 8)
y <- c(2.1, 3.8, 6.2, 7.9, 10.3, 11.8, 14.1, 15.7)
result <- Loess(
fraction = 0.5, iterations = 3L,
confidence_intervals = 0.95,
prediction_intervals = 0.95,
return_diagnostics = TRUE,
return_residuals = TRUE,
return_robustness_weights = TRUE
)$fit(x, y)
if (!is.null(result$diagnostics)) {
d <- result$diagnostics
cat(" Diagnostics:\n")
cat(sprintf(" RMSE: %.6f\n", d$rmse))
cat(sprintf(" MAE: %.6f\n", d$mae))
cat(sprintf(" R²: %.6f\n", d$r_squared))
cat(sprintf(" Residual SD: %.6f\n", d$residual_sd))
if (!is.nan(d$aic)) cat(sprintf(" AIC: %.2f\n", d$aic))
if (!is.nan(d$aicc)) cat(sprintf(" AICc: %.2f\n", d$aicc))
if (!is.nan(d$effective_df)) {
cat(sprintf(" Eff. DF: %.2f\n", d$effective_df))
}
}
cat(sprintf(" smoothed[1]: %.5f\n", result$y[1]))
if (!is.null(result$residuals)) {
cat(sprintf(" residuals[1]: %.5f\n", result$residuals[1]))
}
if (!is.null(result$robustness_weights)) {
cat(sprintf(" rob_weight[1]: %.4f\n", result$robustness_weights[1]))
}
cat("\n")
}
# ── Example 6: Different Weight Functions (Kernels) ──────────────────────────
example_6_different_kernels <- function() {
cat("Example 6: Different Weight Functions (Kernels)\n")
x <- c(1, 2, 3, 4, 5)
y <- c(2.0, 4.1, 5.9, 8.2, 9.8)
for (kernel in c("tricube", "epanechnikov", "gaussian", "biweight")) {
result <- Loess(fraction = 0.5, weight_function = kernel)$fit(x, y)
cat(sprintf(
" %s: [%s]\n", kernel,
paste(round(result$y, 3), collapse = ", ")
))
}
cat("\n")
}
# ── Example 7: Robustness Methods Comparison ─────────────────────────────────
example_7_robustness_methods <- function() {
cat("Example 7: Robustness Methods Comparison\n")
x <- c(1, 2, 3, 4, 5)
y <- c(2.0, 4.1, 20.0, 8.2, 9.8) # 20.0 is an outlier
for (method in c("bisquare", "huber", "talwar")) {
result <- Loess(
fraction = 0.5, iterations = 5L,
robustness_method = method,
return_robustness_weights = TRUE
)$fit(x, y)
cat(sprintf(" %s:\n", method))
cat(sprintf(
" Smoothed: [%s]\n",
paste(round(result$y, 2), collapse = ", ")
))
if (!is.null(result$robustness_weights)) {
cat(sprintf(
" Weights: [%s]\n",
paste(round(result$robustness_weights, 3),
collapse = ", "
)
))
}
}
cat("\n")
}
# ── Example 8: Benchmark ─────────────────────────────────────────────────────
example_8_benchmark <- function() {
cat("Example 8: Benchmark\n")
n <- 1000L
x <- as.numeric(0:(n - 1))
y <- sin(x * 0.1) + cos(x * 0.01)
t0 <- proc.time()["elapsed"]
result <- Loess(parallel = TRUE)$fit(x, y)
elapsed_ms <- (proc.time()["elapsed"] - t0) * 1000
cat(sprintf(" %d points in %.2fms\n", n, elapsed_ms))
cat(sprintf(
" fraction_used=%g, y[1]=%.4f\n",
result$fraction_used, result$y[1]
))
cat("\n")
}
# ── Example 9: Scaling Methods (MAR, MAD, Mean) ──────────────────────────────
example_9_scaling_methods <- function() {
cat("Example 9: Scaling Methods\n")
d <- make_linear(20)
for (method in c("mar", "mad", "mean")) {
result <- Loess(fraction = 0.5, scaling_method = method)$fit(d$x, d$y)
cat(sprintf(" %s: y[1]=%.3f\n", method, result$y[1]))
}
cat("\n")
}
# ── Example 10: Boundary Policies ────────────────────────────────────────────
example_10_boundary_policies <- function() {
cat("Example 10: Boundary Policies\n")
d <- make_linear(30)
for (policy in c("extend", "reflect", "zero", "noboundary")) {
result <- Loess(fraction = 0.5, boundary_policy = policy)$fit(d$x, d$y)
n <- length(result$y)
cat(sprintf(
" %s: first=%.2f, last=%.2f\n",
policy, result$y[1], result$y[n]
))
}
cat("\n")
}
# ── Example 11: Zero-Weight Fallback Strategies ───────────────────────────────
example_11_zero_wt_fallback <- function() {
cat("Example 11: Zero-Weight Fallback Strategies\n")
d <- make_linear(20)
for (fb in c("use_local_mean", "return_original", "return_none")) {
result <- Loess(fraction = 0.5, zero_weight_fallback = fb)$fit(d$x, d$y)
cat(sprintf(" %s: y[1]=%.3f\n", fb, result$y[1]))
}
cat("\n")
}
# ── Example 12: Polynomial Degrees + iterations_used ──────────────────────────
example_12_polynomial_degrees <- function() {
cat("Example 12: Polynomial Degrees\n")
d <- make_linear(30)
for (deg in c("constant", "linear", "quadratic", "cubic", "quartic")) {
result <- Loess(
fraction = 0.5, iterations = 2L,
degree = deg
)$fit(d$x, d$y)
iter_used <- result$iterations_used
if (is.null(iter_used)) iter_used <- "NULL"
cat(sprintf(
" %s: y[1]=%.3f, iterations_used=%s\n",
deg, result$y[1], iter_used
))
}
cat("\n")
}
# ── Example 13: Distance Metrics ─────────────────────────────────────────────
example_13_distance_metrics <- function() {
cat("Example 13: Distance Metrics\n")
d <- make_linear(20)
for (metric in c("euclidean", "normalized", "manhattan", "chebyshev")) {
result <- Loess(fraction = 0.5, distance_metric = metric)$fit(d$x, d$y)
cat(sprintf(" %s: y[1]=%.3f\n", metric, result$y[1]))
}
# Minkowski with custom p via "minkowski:p" format
result_mink <- Loess(
fraction = 0.5,
distance_metric = "minkowski:3"
)$fit(d$x, d$y)
cat(sprintf(" minkowski(p=3): y[1]=%.3f\n", result_mink$y[1]))
cat("\n")
}
# ── Example 14: Surface Modes and Standard Errors ────────────────────────────
example_14_surface_modes_se <- function() {
cat("Example 14: Surface Modes and Standard Errors\n")
d <- make_linear(30)
# Direct surface — fits every point; SE fields fully populated
r_direct <- Loess(
fraction = 0.5, surface_mode = "direct",
return_se = TRUE,
confidence_intervals = 0.95,
prediction_intervals = 0.95
)$fit(d$x, d$y)
cat(" surface_mode=direct:\n")
cat(sprintf(
" confidence_lower non-null: %s\n",
!is.null(r_direct$confidence_lower)
))
cat(sprintf(
" prediction_lower non-null: %s\n",
!is.null(r_direct$prediction_lower)
))
if (!is.null(r_direct$standard_errors)) {
cat(sprintf(
" standard_errors[1]: %.4f\n",
r_direct$standard_errors[1]
))
}
if (!is.null(r_direct$enp)) cat(sprintf(" enp: %.3f\n", r_direct$enp))
if (!is.null(r_direct$trace_hat)) {
cat(sprintf(" trace_hat: %.3f\n", r_direct$trace_hat))
}
if (!is.null(r_direct$delta1)) {
cat(sprintf(" delta1: %.3f\n", r_direct$delta1))
}
if (!is.null(r_direct$delta2)) {
cat(sprintf(" delta2: %.3f\n", r_direct$delta2))
}
if (!is.null(r_direct$residual_scale)) {
cat(sprintf(" residual_scale: %.4f\n", r_direct$residual_scale))
}
if (!is.null(r_direct$leverage)) {
cat(sprintf(" leverage[1]: %.4f\n", r_direct$leverage[1]))
}
# Interpolation surface — faster, approximate
r_interp <- Loess(
fraction = 0.5, surface_mode = "interpolation",
return_se = TRUE
)$fit(d$x, d$y)
cat(" surface_mode=interpolation:\n")
cat(sprintf(" y[1]: %.3f\n", r_interp$y[1]))
if (!is.null(r_interp$standard_errors)) {
cat(sprintf(
" standard_errors[1]: %.4f\n",
r_interp$standard_errors[1]
))
}
cat("\n")
}
# ── Example 15: Additional Weight Functions (Uniform, Triangle, Cosine) ───────
example_15_additional_kernels <- function() {
cat("Example 15: Additional Weight Functions (Uniform, Triangle, Cosine)\n")
x <- c(1, 2, 3, 4, 5)
y <- c(2.0, 4.1, 5.9, 8.2, 9.8)
for (kernel in c("uniform", "triangle", "cosine")) {
result <- Loess(fraction = 0.5, weight_function = kernel)$fit(x, y)
cat(sprintf(
" %s: [%s]\n", kernel,
paste(round(result$y, 3), collapse = ", ")
))
}
cat("\n")
}
# ── Example 16: LOOCV, K-Fold, and Auto-Converge ─────────────────────────────
example_16_loocv_auto_conv <- function() {
cat("Example 16: LOOCV, K-Fold, and Auto-Converge\n")
x <- 1:20
y <- 2 * x + 1 + sin(x * 0.5)
# Leave-one-out cross-validation
r_loocv <- Loess(
cv_fractions = c(0.3, 0.5, 0.7),
cv_method = "loocv"
)$fit(x, y)
cat(sprintf(" LOOCV selected fraction: %g\n", r_loocv$fraction_used))
if (!is.null(r_loocv$cv_scores)) {
cat(sprintf(
" LOOCV scores: [%s]\n",
paste(round(r_loocv$cv_scores, 4), collapse = ", ")
))
}
# K-Fold cross-validation
r_kfold <- Loess(
cv_fractions = c(0.2, 0.4, 0.6),
cv_method = "kfold", cv_k = 5L
)$fit(x, y)
cat(sprintf(" KFold(k=5) selected fraction: %g\n", r_kfold$fraction_used))
if (!is.null(r_kfold$cv_scores)) {
cat(sprintf(
" KFold scores: [%s]\n",
paste(round(r_kfold$cv_scores, 4), collapse = ", ")
))
}
# Auto-converge: stop robustness iterations when change < tolerance
r_ac <- Loess(fraction = 0.5, auto_converge = 1e-4)$fit(x, y)
iter_used_ac <- r_ac$iterations_used
if (is.null(iter_used_ac)) iter_used_ac <- "NULL"
cat(sprintf(
" auto_converge=1e-4: iterations_used=%s\n",
iter_used_ac
))
cat("\n")
}
# ── Example 17: Interpolation Tuning (surface_mode effects) ──────────────────
example_17_interp_tuning <- function() {
cat("Example 17: Interpolation Tuning (surface_mode effects)\n")
n <- 50L
d <- make_linear(n)
# Default (interpolation) — fastest, uses a spatial grid
r_interp <- Loess(
fraction = 0.5,
surface_mode = "interpolation"
)$fit(d$x, d$y)
cat(sprintf(
" interpolation: y[1]=%.3f, y[%d]=%.3f\n",
r_interp$y[1], n, r_interp$y[n]
))
# Direct — fits every point exactly, more accurate but slower
r_direct <- Loess(fraction = 0.5, surface_mode = "direct")$fit(d$x, d$y)
cat(sprintf(
" direct: y[1]=%.3f, y[%d]=%.3f\n",
r_direct$y[1], n, r_direct$y[n]
))
# Fraction sweep with direct surface
for (frac in c(0.2, 0.5, 0.8)) {
r <- Loess(fraction = frac, surface_mode = "direct")$fit(d$x, d$y)
cat(sprintf(" direct fraction=%.1f: y[1]=%.3f\n", frac, r$y[1]))
}
# Interpolation + SE for hat-matrix statistics
r_se <- Loess(
fraction = 0.5, surface_mode = "interpolation",
return_se = TRUE
)$fit(d$x, d$y)
if (!is.null(r_se$enp)) {
cat(sprintf(" interpolation+SE enp: %.3f\n", r_se$enp))
}
cat("\n")
}
# ── Main ──────────────────────────────────────────────────────────────────────
main <- function() {
cat(strrep("=", 60), "\n")
cat("rfastloess Batch Smoothing - Comprehensive Examples\n")
cat(strrep("=", 60), "\n\n")
example_1_basic_smoothing()
example_2_robust_with_outliers()
example_3_uncertainty_quant()
example_4_cross_validation()
example_5_complete_diagnostics()
example_6_different_kernels()
example_7_robustness_methods()
example_8_benchmark()
example_9_scaling_methods()
example_10_boundary_policies()
example_11_zero_wt_fallback()
example_12_polynomial_degrees()
example_13_distance_metrics()
example_14_surface_modes_se()
example_15_additional_kernels()
example_16_loocv_auto_conv()
example_17_interp_tuning()
cat("=== Batch Smoothing Examples Complete ===\n")
}
if (sys.nframe() == 0) main()
Streaming Smoothing¶
Process large datasets in memory-efficient chunks with overlap merging.
#!/usr/bin/env Rscript
# =============================================================================
# rfastloess Streaming Smoothing - Comprehensive Examples
#
# 1. Basic chunked processing
# 2. Chunk size comparison
# 3. Overlap strategies
# 4. Large dataset processing
# 5. Outlier handling in streaming mode
# 6. File-based streaming simulation
# 7. Benchmark (sequential streaming)
# 8. Merge strategies
# 9. Advanced streaming options
# =============================================================================
library(rfastloess)
make_linear <- function(n) {
list(x = as.numeric(0:(n - 1)), y = 2 * as.numeric(0:(n - 1)) + 1)
}
process_all <- function(model, x, y, chunk_size, overlap) {
# Feed full-size chunks; let finalize() handle remaining data.
# Avoids panic when tail chunk would be smaller than overlap.
step <- chunk_size - overlap
n <- length(x)
result_x <- numeric(0)
result_y <- numeric(0)
start <- 1L
while (start + chunk_size - 1L <= n) {
end <- start + chunk_size - 1L
res <- model$process_chunk(x[start:end], y[start:end])
result_x <- c(result_x, res$x)
result_y <- c(result_y, res$y)
start <- start + step
}
fin <- model$finalize()
list(x = c(result_x, fin$x), y = c(result_y, fin$y))
}
# ── Example 1: Basic Chunked Processing ──────────────────────────────────────
example_1_basic_chunked <- function() {
cat("Example 1: Basic Chunked Processing\n")
n <- 50L
d <- make_linear(n)
chunk_size <- 15L
overlap <- 5L
model <- StreamingLoess(
fraction = 0.5, iterations = 2L,
chunk_size = chunk_size, overlap = overlap,
return_residuals = TRUE
)
cat(sprintf(" Dataset: %d pts, chunk=%d, overlap=%d\n",
n, chunk_size, overlap))
result_x <- numeric(0)
result_y <- numeric(0)
ci <- 0L
start <- 1L
while (start + chunk_size - 1L <= n) {
end <- start + chunk_size - 1L
res <- model$process_chunk(d$x[start:end], d$y[start:end])
if (length(res$x) > 0) {
result_x <- c(result_x, res$x)
result_y <- c(result_y, res$y)
cat(sprintf(" Chunk %d: %d pts (x: %.0f..%.0f)\n",
ci, length(res$x), res$x[1], res$x[length(res$x)]))
}
ci <- ci + 1L
start <- start + chunk_size - overlap
}
fin <- model$finalize()
if (length(fin$x) > 0) {
result_x <- c(result_x, fin$x)
result_y <- c(result_y, fin$y)
cat(sprintf(" Finalize: %d remaining pts\n", length(fin$x)))
}
cat(sprintf(" Total: %d/%d\n\n", length(result_y), n))
}
# ── Example 2: Chunk Size Comparison ─────────────────────────────────────────
example_2_chunk_comparison <- function() {
cat("Example 2: Chunk Size Comparison\n")
n <- 100L
d <- make_linear(n)
configs <- list(
list(cs = 20L, ov = 5L, label = "Small"),
list(cs = 50L, ov = 10L, label = "Medium"),
list(cs = 80L, ov = 15L, label = "Large")
)
for (cfg in configs) {
model <- StreamingLoess(
fraction = 0.5, iterations = 1L,
chunk_size = cfg$cs, overlap = cfg$ov
)
chunks <- 0L
total <- 0L
start <- 1L
while (start + cfg$cs - 1L <= n) {
end <- start + cfg$cs - 1L
res <- model$process_chunk(d$x[start:end], d$y[start:end])
if (length(res$x) > 0) {
chunks <- chunks + 1L
total <- total + length(res$x)
}
start <- start + cfg$cs - cfg$ov
}
fin <- model$finalize()
if (length(fin$x) > 0) {
chunks <- chunks + 1L
total <- total + length(fin$x)
}
cat(sprintf(" %s (size=%d, overlap=%d): chunks=%d, total=%d\n",
cfg$label, cfg$cs, cfg$ov, chunks, total))
}
cat("\n")
}
# ── Example 3: Overlap Strategies ────────────────────────────────────────────
example_3_overlap_strategies <- function() {
cat("Example 3: Overlap Strategies\n")
n <- 100L
d <- make_linear(n)
cs <- 40L
pairs <- list(c(0L, "No overlap"), c(10L, "10-pt overlap"),
c(20L, "20-pt overlap"))
for (pair in pairs) {
ov <- as.integer(pair[1])
label <- pair[2]
model <- StreamingLoess(fraction = 0.5, chunk_size = cs, overlap = ov)
total <- 0L
start <- 1L
while (start + cs - 1L <= n) {
end <- start + cs - 1L
res <- model$process_chunk(d$x[start:end], d$y[start:end])
total <- total + length(res$x)
start <- start + cs - ov
}
total <- total + length(model$finalize()$x)
cat(sprintf(" %s: total output=%d\n", label, total))
}
cat("\n")
}
# ── Example 4: Large Dataset Processing ──────────────────────────────────────
example_4_large_dataset <- function() {
cat("Example 4: Large Dataset Processing\n")
n <- 10000L
x <- as.numeric(0:(n - 1))
y <- sin(x * 0.01) + x * 0.001
cs <- 500L
ov <- 50L
model <- StreamingLoess(fraction = 0.05, iterations = 2L,
chunk_size = cs, overlap = ov)
total <- 0L
step <- cs - ov
start <- 1L
while (start + cs - 1L <= n) {
end <- start + cs - 1L
res <- model$process_chunk(x[start:end], y[start:end])
total <- total + length(res$x)
if (total > 0L && total %% 2000L < step)
cat(sprintf(" Progress: ~%d pts smoothed\n", total))
start <- start + step
}
total <- total + length(model$finalize()$x)
cat(sprintf(" Total: %d/%d, memory: constant (chunk=%d)\n\n",
total, n, cs))
}
# ── Example 5: Outlier Handling in Streaming Mode ─────────────────────────────
example_5_outlier_handling <- function() {
cat("Example 5: Outlier Handling in Streaming Mode\n")
n <- 100L
x <- as.numeric(0:(n - 1))
y <- 2 * x + 1 + sin(x * 0.2) * 2
y[c(26, 51, 76)] <- y[c(26, 51, 76)] + 50 # Outliers (1-indexed)
for (method in c("bisquare", "huber", "talwar")) {
model <- StreamingLoess(
fraction = 0.5, iterations = 5L,
robustness_method = method,
chunk_size = 30L, overlap = 10L,
return_residuals = TRUE
)
large <- 0L
start <- 1L
while (start + 29L <= n) {
end <- start + 29L
res <- model$process_chunk(x[start:end], y[start:end])
if (!is.null(res$residuals))
large <- large + sum(abs(res$residuals) > 10)
start <- start + 20L
}
fin <- model$finalize()
if (!is.null(fin$residuals))
large <- large + sum(abs(fin$residuals) > 10)
cat(sprintf(" %s: pts with |residual|>10: %d\n", method, large))
}
cat("\n")
}
# ── Example 6: File-Based Streaming Simulation ───────────────────────────────
example_6_file_simulation <- function() {
cat("Example 6: File-Based Streaming Simulation\n")
cat(" Simulating: input.csv -> Smooth -> output.csv\n")
total_lines <- 200L
cs <- 50L
ov <- 10L
model <- StreamingLoess(
fraction = 0.5, iterations = 2L, chunk_size = cs, overlap = ov,
return_residuals = TRUE
)
out_count <- 0L
n_chunks <- ceiling(total_lines / (cs - ov))
for (ci in seq_len(n_chunks)) {
start_line <- (ci - 1L) * (cs - ov)
end_line <- min(start_line + cs - 1L, total_lines - 1L)
xc <- as.numeric(start_line:end_line)
yc <- 2 * xc + 1 + sin(xc * 0.1) * 3
cat(sprintf(" Reading chunk %d (lines %d..%d)\n",
ci - 1L, start_line, end_line))
res <- model$process_chunk(xc, yc)
if (length(res$x) > 0) {
out_count <- out_count + length(res$x)
cat(sprintf(" -> Writing %d smoothed pts (total: %d)\n",
length(res$x), out_count))
}
}
fin <- model$finalize()
if (length(fin$x) > 0) {
out_count <- out_count + length(fin$x)
cat(sprintf(" Finalizing: %d remaining pts\n", length(fin$x)))
}
cat(sprintf(" Input: %d, Output: %d\n\n", total_lines, out_count))
}
# ── Example 7: Benchmark (Sequential Streaming) ───────────────────────────────
example_7_benchmark <- function() {
cat("Example 7: Benchmark (Sequential Streaming)\n")
n <- 1000L
cs <- 100L
ov <- 10L
model <- StreamingLoess(fraction = 0.5, iterations = 3L,
chunk_size = cs, overlap = ov)
t0 <- proc.time()["elapsed"]
total <- 0L
start <- 1L
while (start + cs - 1L <= n) {
end <- start + cs - 1L
xc <- as.numeric((start - 1L):(end - 1L))
yc <- sin(xc * 0.1) + cos(xc * 0.01)
total <- total + length(model$process_chunk(xc, yc)$x)
start <- start + cs - ov
}
total <- total + length(model$finalize()$x)
elapsed_ms <- (proc.time()["elapsed"] - t0) * 1000
cat(sprintf(" %d pts in %.2fms (chunk=%d, overlap=%d)\n\n",
total, elapsed_ms, cs, ov))
}
# ── Example 8: Merge Strategies ──────────────────────────────────────────────
example_8_merge_strategies <- function() {
cat("Example 8: Merge Strategies\n")
n <- 50L
d <- make_linear(n)
strategies <- c("average", "weighted_average", "take_first", "take_last")
for (strategy in strategies) {
model <- StreamingLoess(
fraction = 0.5, iterations = 2L,
chunk_size = 20L, overlap = 5L,
merge_strategy = strategy
)
total <- 0L
start <- 1L
while (start + 19L <= n) {
end <- start + 19L
res <- model$process_chunk(d$x[start:end], d$y[start:end])
total <- total + length(res$x)
start <- start + 15L
}
total <- total + length(model$finalize()$x)
cat(sprintf(" %s: total=%d\n", strategy, total))
}
cat("\n")
}
# ── Example 9: Advanced Streaming Options ─────────────────────────────────────
example_9_advanced_options <- function() {
cat("Example 9: Advanced Streaming Options\n")
n <- 50L
d <- make_linear(n)
model <- StreamingLoess(
fraction = 0.5, iterations = 2L,
degree = "quadratic",
scaling_method = "mar",
boundary_policy = "reflect",
zero_weight_fallback = "return_original",
distance_metric = "manhattan",
surface_mode = "direct",
return_se = TRUE,
return_diagnostics = TRUE,
return_robustness_weights = TRUE,
auto_converge = 1e-3,
chunk_size = 20L, overlap = 5L
)
total <- 0L
start <- 1L
while (start + 19L <= n) {
end <- start + 19L
res <- model$process_chunk(d$x[start:end], d$y[start:end])
total <- total + length(res$x)
start <- start + 15L
}
fin <- model$finalize()
total <- total + length(fin$x)
cat(sprintf(" total pts: %d\n", total))
if (!is.null(fin$standard_errors) && length(fin$standard_errors) > 0)
cat(sprintf(" standard_errors[1]: %.4f\n", fin$standard_errors[1]))
if (!is.null(fin$diagnostics)) {
cat(sprintf(" diagnostics$rmse: %.3f\n", fin$diagnostics$rmse))
cat(sprintf(" diagnostics$r_squared: %.3f\n",
fin$diagnostics$r_squared))
if (!is.nan(fin$diagnostics$aic))
cat(sprintf(" diagnostics$aic: %.3f\n", fin$diagnostics$aic))
}
if (!is.null(fin$robustness_weights) && length(fin$robustness_weights) > 0)
cat(sprintf(" robustness_weights[1]: %.4f\n",
fin$robustness_weights[1]))
cat("\n")
}
# ── Main ──────────────────────────────────────────────────────────────────────
main <- function() {
cat(strrep("=", 60), "\n")
cat("rfastloess Streaming Smoothing - Comprehensive Examples\n")
cat(strrep("=", 60), "\n\n")
example_1_basic_chunked()
example_2_chunk_comparison()
example_3_overlap_strategies()
example_4_large_dataset()
example_5_outlier_handling()
example_6_file_simulation()
example_7_benchmark()
example_8_merge_strategies()
example_9_advanced_options()
cat("=== Streaming Smoothing Examples Complete ===\n")
}
if (sys.nframe() == 0) main()
Download streaming_smoothing.R
Online Smoothing¶
Real-time smoothing with sliding window for streaming data applications.
#!/usr/bin/env Rscript
# =============================================================================
# rfastloess Online Smoothing - Comprehensive Examples
#
# 1. Basic incremental processing
# 2. Real-time sensor data simulation
# 3. Outlier handling in online mode
# 4. Window size comparison
# 5. Memory-bounded processing (embedded systems)
# 6. Sliding window behavior
# 7. Benchmark (sequential online)
# 8. Update modes (Full vs Incremental) and min_points
# 9. Advanced online options
# =============================================================================
library(rfastloess)
# Helper: feed all (x, y) pairs through add_point one at a time.
# Returns a named list with $smoothed (numeric vector,
# NA where window not full).
add_all_points <- function(model, x, y) {
results <- lapply(seq_along(x), function(i) model$add_point(x[i], y[i]))
list(
smoothed = sapply(
results, function(r) if (is.null(r)) NA_real_ else r$smoothed
)
)
}
# ── Example 1: Basic Incremental Processing ──────────────────────────────────
example_1_basic_streaming <- function() {
cat("Example 1: Basic Incremental Processing\n")
x <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
y <- c(3.1, 5.0, 7.2, 8.9, 11.1, 13.0, 15.2, 16.8, 19.1, 21.0)
model <- OnlineLoess(
fraction = 0.5, iterations = 2L,
window_capacity = 5L,
return_robustness_weights = FALSE
)
result <- add_all_points(model, x, y)
cat(sprintf(" %8s %12s %12s\n", "X", "Y_obs", "Y_smooth"))
for (i in seq_along(y)) {
smoothed <- if (is.na(result$smoothed[i])) {
"(buffering)"
} else {
sprintf("%.2f", result$smoothed[i])
}
cat(sprintf(" %8.2f %12.2f %12s\n", x[i], y[i], smoothed))
}
cat("\n")
}
# ── Example 2: Real-Time Sensor Data Simulation ───────────────────────────────
example_2_sensor_simulation <- function() {
cat("Example 2: Real-Time Sensor Data Simulation\n")
cat(" Simulating temperature sensor with noise...\n")
n <- 24L
hours <- as.numeric(0:(n - 1))
temp <- 20 + 5 * sin(hours * pi / 12) + ((hours * 7) %% 11) * 0.3 - 1.5
model <- OnlineLoess(
fraction = 0.4, iterations = 3L,
robustness_method = "bisquare",
window_capacity = 12L
)
result <- add_all_points(model, hours, temp)
cat(sprintf(" %6s %12s %12s\n", "Hour", "Raw", "Smoothed"))
for (i in seq_along(hours)) {
smoothed <- if (is.na(result$smoothed[i])) {
"(warming up)"
} else {
sprintf("%.2f degC", result$smoothed[i])
}
cat(sprintf(" %6.0f %10.2f degC %s\n", hours[i], temp[i], smoothed))
}
cat("\n")
}
# ── Example 3: Outlier Handling in Online Mode ────────────────────────────────
example_3_outlier_handling <- function() {
cat("Example 3: Outlier Handling in Online Mode\n")
x <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
y <- c(2.0, 4.1, 5.9, 25.0, 10.1, 12.0, 14.1, 50.0, 18.0, 20.1)
for (method in c("bisquare", "talwar")) {
model <- OnlineLoess(
fraction = 0.5, iterations = 5L,
robustness_method = method,
window_capacity = 6L
)
result <- add_all_points(model, x, y)
valid <- result$smoothed[!is.na(result$smoothed)]
cat(sprintf(
" %s: [%s]\n", method, paste(round(valid, 1), collapse = ", ")
))
}
cat("\n")
}
# ── Example 4: Window Size Comparison ────────────────────────────────────────
example_4_window_comparison <- function() {
cat("Example 4: Window Size Comparison\n")
x <- as.numeric(1:20)
y <- 2 * x + sin(x * 0.5) * 3
for (w in c(5L, 10L, 15L)) {
model <- OnlineLoess(
fraction = 0.5, iterations = 2L,
window_capacity = w
)
result <- add_all_points(model, x, y)
valid <- result$smoothed[!is.na(result$smoothed)]
last5 <- tail(valid, 5)
cat(sprintf(
" window_capacity=%d: last 5 = [%s]\n",
w, paste(round(last5, 2), collapse = ", ")
))
}
cat("\n")
}
# ── Example 5: Memory-Bounded Processing ──────────────────────────────────────
example_5_memory_bounded <- function() {
cat("Example 5: Memory-Bounded Processing (Embedded Systems)\n")
total <- 1000L
x <- as.numeric(0:(total - 1))
y <- 2 * x + sin(x * 0.1) * 5 + ((0:(total - 1)) %% 7 - 3) * 0.5
model <- OnlineLoess(fraction = 0.3, iterations = 1L, window_capacity = 20L)
result <- add_all_points(model, x, y)
valid_smoothed <- result$smoothed[!is.na(result$smoothed)]
n_out <- length(valid_smoothed)
for (milestone in c(200L, 400L, 600L, 800L, 1000L)) {
if (milestone <= n_out) {
cat(sprintf(
" Processed: %4d pts | smoothed=%.2f\n",
milestone, valid_smoothed[milestone]
))
}
}
cat(sprintf(
" Total smoothed: %d, final: %.2f\n",
n_out, tail(valid_smoothed, 1)
))
cat(" Memory: constant (window=20)\n\n")
}
# ── Example 6: Sliding Window Behavior ───────────────────────────────────────
example_6_sliding_window <- function() {
cat("Example 6: Sliding Window Behavior\n")
x <- c(1, 2, 3, 4, 5, 6, 7, 8)
y <- c(2, 4, 6, 8, 10, 12, 14, 16)
model <- OnlineLoess(fraction = 0.6, iterations = 0L, window_capacity = 4L)
result <- add_all_points(model, x, y)
cat(sprintf(
" %4s %6s %8s %10s %-22s\n",
"Pt", "X", "Y", "Smoothed", "Status"
))
for (i in seq_along(x)) {
if (!is.na(result$smoothed[i])) {
cat(sprintf(
" %4d %6.0f %8.0f %10.2f %-22s\n",
i, x[i], y[i], result$smoothed[i], "Window full (sliding)"
))
} else {
cat(sprintf(
" %4d %6.0f %8.0f %10s %-22s\n",
i, x[i], y[i], "-", sprintf("Filling (%d/4)", i)
))
}
}
cat(" Output starts after window fills (4 pts), then slides.\n\n")
}
# ── Example 7: Benchmark (Sequential Online) ──────────────────────────────────
example_7_benchmark <- function() {
cat("Example 7: Benchmark (Sequential Online)\n")
n <- 1000L
x <- as.numeric(0:(n - 1))
y <- sin(x * 0.1) + cos(x * 0.01)
t0 <- proc.time()["elapsed"]
model <- OnlineLoess(fraction = 0.5, iterations = 3L, window_capacity = 10L)
result <- add_all_points(model, x, y)
elapsed_ms <- (proc.time()["elapsed"] - t0) * 1000
valid <- result$smoothed[!is.na(result$smoothed)]
cat(sprintf(
" %d pts processed in %.2fms (window_capacity=10)\n\n",
length(valid), elapsed_ms
))
}
# ── Example 8: Update Modes (Full vs Incremental) and min_points ──────────────
example_8_update_modes <- function() {
cat("Example 8: Update Modes (Full vs Incremental) and min_points\n")
x <- as.numeric(0:29)
y <- 2 * x + 1
for (mode in c("full", "incremental")) {
model <- OnlineLoess(
fraction = 0.5, iterations = 2L,
update_mode = mode, min_points = 5L,
window_capacity = 15L
)
result <- add_all_points(model, x, y)
valid <- result$smoothed[!is.na(result$smoothed)]
cat(sprintf(
" %s: %d pts emitted (out of %d)\n",
mode, length(valid), length(x)
))
}
# Show last smoothed value
model <- OnlineLoess(
fraction = 0.5, iterations = 2L,
window_capacity = 10L, min_points = 3L
)
result <- add_all_points(model, x, y)
valid <- result$smoothed[!is.na(result$smoothed)]
if (length(valid) > 0) {
cat(sprintf(" last smoothed: %.3f\n", tail(valid, 1)))
}
cat("\n")
}
# ── Example 9: Advanced Online Options ────────────────────────────────────────
example_9_online_options <- function() {
cat("Example 9: Advanced Online Options\n")
x <- as.numeric(0:29)
y <- 2 * x + 1
model <- OnlineLoess(
fraction = 0.5, iterations = 2L,
degree = "quadratic",
scaling_method = "mar",
boundary_policy = "reflect",
zero_weight_fallback = "return_original",
distance_metric = "chebyshev",
auto_converge = 1e-3,
return_robustness_weights = TRUE,
min_points = 5L,
window_capacity = 15L
)
result <- add_all_points(model, x, y)
valid <- result$smoothed[!is.na(result$smoothed)]
cat(sprintf(" emitted: %d\n", length(valid)))
if (length(valid) > 0) {
cat(sprintf(" last smoothed: %.3f\n", tail(valid, 1)))
}
cat("\n")
}
# ── Main ──────────────────────────────────────────────────────────────────────
main <- function() {
cat(strrep("=", 60), "\n")
cat("rfastloess Online Smoothing - Comprehensive Examples\n")
cat(strrep("=", 60), "\n\n")
example_1_basic_streaming()
example_2_sensor_simulation()
example_3_outlier_handling()
example_4_window_comparison()
example_5_memory_bounded()
example_6_sliding_window()
example_7_benchmark()
example_8_update_modes()
example_9_online_options()
cat("=== Online Smoothing Examples Complete ===\n")
}
if (sys.nframe() == 0) main()
Running the Examples¶
# Install the package first
# From R:
# install.packages("rfastloess")
# Or from source:
# R CMD INSTALL bindings/r
# Run examples
Rscript examples/r/batch_smoothing.R
Rscript examples/r/streaming_smoothing.R
Rscript examples/r/online_smoothing.R
Quick Start¶
library(rfastloess)
# Generate sample data
set.seed(42)
x <- seq(0, 10, length.out = 100)
y <- sin(x) + rnorm(100, sd = 0.3)
# Basic smoothing
model <- Loess(fraction = 0.3)
print(model)
result <- model$fit(x, y)
print(result)
# With confidence intervals
model <- Loess(
fraction = 0.3,
confidence_intervals = 0.95,
return_diagnostics = TRUE
)
result <- model$fit(x, y)
# Visualization
plot(result, main = "Quick Start Example")