--- title: "RVFLnet model" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{RVFLnet model} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r 0-packages} library(rvflnet) library(glmnet) library(MASS) ``` # 1 - Regression # 1 - 1 Regression on `Boston` data set ```{r 1-regression-1, fig.width=7} set.seed(123) # ------------------------- # Data # ------------------------- X <- as.matrix(MASS::Boston[, -14]) # predictors y <- MASS::Boston$medv # response # Train/test split n <- nrow(X) idx <- sample(1:n, size = round(0.8 * n)) X_train <- X[idx, ] y_train <- y[idx] X_test <- X[-idx, ] y_test <- y[-idx] # ------------------------- # Fit model (No CV) # ------------------------- fit <- rvflnet(X_train, y_train, n_hidden = 200, activation = "sigmoid", W_type = "gaussian") plot(fit) print(fit) head(coef(fit, s = c(0.1, 0.05, 0.01))) tail(coef(fit, s = c(0.1, 0.05, 0.01))) preds <- predict(fit, newx = X_test, s = c(0.05, 0.03, 0.01)) print(head(preds)) sqrt(colMeans((preds - y_test)**2)) # ------------------------- # Fit model (CV) # ------------------------- cv_model <- cv.rvflnet( X_train, y_train, n_hidden = 200, activation = "sigmoid", W_type = "gaussian", alpha = 0.1, # elastic net mix nfolds = 5 ) print(cv_model) plot(cv_model) print(cv_model$cvfit$lambda.min) print(str(cv_model)) # ------------------------- # Predictions # ------------------------- y_pred <- predict(cv_model, X_test) # ------------------------- # Diagnostics # ------------------------- # RMSE rmse <- sqrt(mean((y_test - y_pred)^2)) cat("Test RMSE:", rmse, "\n") # ------------------------- # Sparsity diagnostics # ------------------------- coef_min <- coef(cv_model, s = "lambda.min") nonzero <- sum(coef_min[-1, 1] != 0) cat("Non-zero coefficients:", nonzero, "\n") # Optional: inspect how many come from original vs hidden p <- ncol(X_train) orig_nz <- sum(coef_min[2:(p+1), 1] != 0) hidden_nz <- sum(coef_min[(p+2):length(coef_min), 1] != 0) cat("Original features used:", orig_nz, "\n") cat("Hidden features used:", hidden_nz, "\n") ``` # 1 - 2 Regression on `mtcars` data set ```{r 1-regression-2, fig.width=7} set.seed(123) # ------------------------- # Data # ------------------------- data(mtcars) X <- as.matrix(mtcars[, -1]) # predictors y <- mtcars$mpg # response # Train/test split n <- nrow(X) idx <- sample(1:n, size = round(0.7 * n)) X_train <- X[idx, ] y_train <- y[idx] X_test <- X[-idx, ] y_test <- y[-idx] # ------------------------- # Fit model (CV) # ------------------------- cv_model <- cv.rvflnet( X_train, y_train, n_hidden = 50, activation = "tanh", W_type = "sobol", alpha = 0.5, # elastic net mix nfolds = 5 ) print(cv_model) # ------------------------- # Predictions # ------------------------- (y_pred <- predict(cv_model, X_test)) # ------------------------- # Diagnostics # ------------------------- # RMSE rmse <- sqrt(mean((y_test - y_pred)^2)) cat("Test RMSE:", rmse, "\n") # R-squared r2 <- 1 - sum((y_test - y_pred)^2) / sum((y_test - mean(y_test))^2) cat("Test R^2:", r2, "\n") # Residual plot plot(y_pred, y_test - y_pred, main = "Residuals vs Predictions", xlab = "Predicted", ylab = "Residuals") abline(h = 0, col = "red") # QQ-plot of residuals qqnorm(y_test - y_pred) qqline(y_test - y_pred, col = "red") shapiro.test(y_test - y_pred) # ------------------------- # Sparsity diagnostics # ------------------------- (coef_min <- coef(cv_model, s = "lambda.min")) nonzero <- sum(coef_min[-1, 1] != 0) cat("Non-zero coefficients:", nonzero, "\n") # Optional: inspect how many come from original vs hidden p <- ncol(X_train) orig_nz <- sum(coef_min[2:(p+1), 1] != 0) hidden_nz <- sum(coef_min[(p+2):length(coef_min), 1] != 0) cat("Original features used:", orig_nz, "\n") cat("Hidden features used:", hidden_nz, "\n") ``` # 2 Classification # 2 - 1 Binary classification ```{r 2-binary-classification, fig.width=7} set.seed(123) data(iris) # Binary classification: setosa vs others y <- ifelse(iris$Species == "setosa", 1, 0) X <- as.matrix(iris[, 1:4]) # Train/test split n <- nrow(X) idx <- sample(1:n, size = round(0.8 * n)) X_train <- X[idx, ] y_train <- y[idx] X_test <- X[-idx, ] y_test <- y[-idx] # ------------------------- # Fit model # ------------------------- cv_model <- cv.rvflnet( X_train, y_train, n_hidden = 50, activation = "relu", W_type = "gaussian", family = "binomial", nfolds = 5 ) # ------------------------- # Predictions (probabilities) # ------------------------- (probs <- predict(cv_model, X_test, type = "response")) # Convert to class y_pred <- ifelse(probs > 0.5, 1, 0) all.equal(as.numeric(y_pred), as.numeric(predict(cv_model, X_test, type="class"))) # ------------------------- # Diagnostics # ------------------------- # Accuracy acc <- mean(drop(y_pred) == y_test) cat("Accuracy:", acc, "\n") # Confusion matrix table(Predicted = y_pred, Actual = y_test) # ROC-style diagnostic (simple) plot(probs, jitter(y_test), main = "Predicted probabilities vs true labels", xlab = "Predicted probability", ylab = "True label") # Sparsity (coef_min <- coef(cv_model, s = "lambda.min")) cat("Non-zero coefficients:", sum(coef_min[-1, 1] != 0), "\n") ``` # 2 - 2 multiclass classification ```{r 3-multiclass-classification, fig.width=7} set.seed(123) data(iris) X <- as.matrix(iris[, 1:4]) y <- as.integer(iris$Species) # factor with 3 classes # Train/test split n <- nrow(X) idx <- sample(1:n, size = round(0.8 * n)) X_train <- X[idx, ] y_train <- y[idx] X_test <- X[-idx, ] y_test <- y[-idx] # ------------------------- # Fit model # ------------------------- cv_model <- cv.rvflnet( X_train, y_train, n_hidden = 60, activation = "tanh", W_type = "sobol", family = "multinomial", nfolds = 5 ) # ------------------------- # Predictions # ------------------------- (probs <- predict(cv_model, X_test, type = "response")) # Convert probabilities to class #(pred_class <- apply(probs, 1, function(row) colnames(probs)[which.max(row)])) (pred_class <- predict(cv_model, X_test, type = "class")) # ------------------------- # Diagnostics # ------------------------- # Accuracy acc <- mean(pred_class == y_test) cat("Accuracy:", acc, "\n") # Confusion matrix table(Predicted = pred_class, Actual = y_test) # Sparsity (note: multinomial returns list per class) (coef_min <- coef(cv_model, s = "lambda.min")) ```