Parece que también estás en busca de una respuesta desde un punto de vista predictivo, así que puse una breve demostración de los dos enfoques en R
- Binning una variable en el mismo tamaño de factores.
- Natural de splines cúbicos.
A continuación, le he dado el código de una función que compara los dos métodos automáticamente para cualquier verdadera función de la señal
test_cuts_vs_splines <- function(signal, N, noise,
range=c(0, 1),
max_parameters=50,
seed=154)
Esta función creará ruidoso de entrenamiento y de prueba de los conjuntos de datos de una señal dada, y, a continuación, ajuste de una serie de regresiones lineales a los datos de entrenamiento de dos tipos
- El
cuts incluye el modelo discretizado predictores, formado por segmentar el rango de los datos en el mismo tamaño de la mitad de abrir los intervalos, y luego la creación de binario predictores lo que indica que el intervalo de cada punto pertenece.
- El
splines modelo incluye un natural cubic spline base de expansión, con nudos equidistantes a lo largo del rango de la predictor.
Los argumentos son
-
signal: Una función de variable que representa la verdad para ser estimado.
-
N: El número de muestras que se incluyen tanto en el entrenamiento y datos de prueba.
-
noise: La cantidad de azar de ruido gaussiano para agregar a la formación y las pruebas de la señal.
-
range: El alcance de la formación y las pruebas x datos de datos, esta se genera de manera uniforme dentro de este rango.
-
max_paramters: El número máximo de parámetros a estimar en el modelo. Este es el número máximo de segmentos en el cuts modelo, y el número máximo de nodos en el splines modelo.
Tenga en cuenta que el número de parámetros estimados en la splines modelo es el mismo que el número de nudos, de modo que los dos modelos son bastante comparación.
El objeto de retorno de la función tiene un par de componentes
-
signal_plot: Un gráco de la función de señal.
-
data_plot: Gráfico de dispersión de la formación y las pruebas de los datos.
-
errors_comparison_plot: Un gráco que muestra la evolución de la suma de cuadrados de la tasa de error para ambos modelos en un rango del número de estiamted parámetros.
Voy a demostrar con dos funciones de la señal. La primera es una onda seno con una creciente tendencia lineal superpuestas
true_signal_sin <- function(x) {
x + 1.5*sin(3*2*pi*x)
}
obj <- test_cuts_vs_splines(true_signal_sin, 250, 1)
Aquí es cómo las tasas de error evolucionar
![grouping vs splines train and test performance with varying degree of freedom for increasing sin wave]()
El segundo ejemplo es el de una nuez función guardo todo para este tipo de cosa, la trama y ver
true_signal_weird <- function(x) {
x*x*x*(x-1) + 2*(1/(1+exp(-.5*(x-.5)))) - 3.5*(x > .2)*(x < .5)*(x - .2)*(x - .5)
}
obj <- test_cuts_vs_splines(true_signal_weird, 250, .05)
![grouping vs splines train and test performance with varying degree of freedom for increasing bizarro function]()
Y para la diversión, aquí es un aburrido función lineal
obj <- test_cuts_vs_splines(function(x) {x}, 250, .2)
![grouping vs splines train and test performance with varying degree of freedom for linear function]()
Se puede ver que:
- Estrías de forma general un mejor rendimiento general de la prueba cuando la complejidad del modelo está correctamente ajustado para ambos.
- Splines dar un óptimo rendimiento de la prueba con mucho menor número de parámetros estimados.
- En general, el rendimiento de splines es mucho más estable a medida que el número de parámetros estimados es muy variada.
Así splines son siempre preferible desde un punto de vista predictivo.
Código
Aquí está el código que he usado para producir estas comparaciones. He envuelto todo en una función de modo que usted puede probar con su propia señal de funciones. Usted necesitará importar el ggplot2 y splines R bibliotecas.
test_cuts_vs_splines <- function(signal, N, noise,
range=c(0, 1),
max_parameters=50,
seed=154) {
if(max_parameters < 8) {
stop("Please pass max_parameters >= 8, otherwise the plots look kinda bad.")
}
out_obj <- list()
set.seed(seed)
x_train <- runif(N, range[1], range[2])
x_test <- runif(N, range[1], range[2])
y_train <- signal(x_train) + rnorm(N, 0, noise)
y_test <- signal(x_test) + rnorm(N, 0, noise)
# A plot of the true signals
df <- data.frame(
x = seq(range[1], range[2], length.out = 100)
)
df$y <- signal(df$x)
out_obj$signal_plot <- ggplot(data = df) +
geom_line(aes(x = x, y = y)) +
labs(title = "True Signal")
# A plot of the training and testing data
df <- data.frame(
x = c(x_train, x_test),
y = c(y_train, y_test),
id = c(rep("train", N), rep("test", N))
)
out_obj$data_plot <- ggplot(data = df) +
geom_point(aes(x=x, y=y)) +
facet_wrap(~ id) +
labs(title = "Training and Testing Data")
#----- lm with various groupings -------------
models_with_groupings <- list()
train_errors_cuts <- rep(NULL, length(models_with_groupings))
test_errors_cuts <- rep(NULL, length(models_with_groupings))
for (n_groups in 3:max_parameters) {
cut_points <- seq(range[1], range[2], length.out = n_groups + 1)
x_train_factor <- cut(x_train, cut_points)
factor_train_data <- data.frame(x = x_train_factor, y = y_train)
models_with_groupings[[n_groups]] <- lm(y ~ x, data = factor_train_data)
# Training error rate
train_preds <- predict(models_with_groupings[[n_groups]], factor_train_data)
soses <- (1/N) * sum( (y_train - train_preds)**2)
train_errors_cuts[n_groups - 2] <- soses
# Testing error rate
x_test_factor <- cut(x_test, cut_points)
factor_test_data <- data.frame(x = x_test_factor, y = y_test)
test_preds <- predict(models_with_groupings[[n_groups]], factor_test_data)
soses <- (1/N) * sum( (y_test - test_preds)**2)
test_errors_cuts[n_groups - 2] <- soses
}
# We are overfitting
error_df_cuts <- data.frame(
x = rep(3:max_parameters, 2),
e = c(train_errors_cuts, test_errors_cuts),
id = c(rep("train", length(train_errors_cuts)),
rep("test", length(test_errors_cuts))),
type = "cuts"
)
out_obj$errors_cuts_plot <- ggplot(data = error_df_cuts) +
geom_line(aes(x = x, y = e)) +
facet_wrap(~ id) +
labs(title = "Error Rates with Grouping Transformations",
x = ("Number of Estimated Parameters"),
y = ("Average Squared Error"))
#----- lm with natural splines -------------
models_with_splines <- list()
train_errors_splines <- rep(NULL, length(models_with_groupings))
test_errors_splines <- rep(NULL, length(models_with_groupings))
for (deg_freedom in 3:max_parameters) {
knots <- seq(range[1], range[2], length.out = deg_freedom + 1)[2:deg_freedom]
train_data <- data.frame(x = x_train, y = y_train)
models_with_splines[[deg_freedom]] <- lm(y ~ ns(x, knots=knots), data = train_data)
# Training error rate
train_preds <- predict(models_with_splines[[deg_freedom]], train_data)
soses <- (1/N) * sum( (y_train - train_preds)**2)
train_errors_splines[deg_freedom - 2] <- soses
# Testing error rate
test_data <- data.frame(x = x_test, y = y_test)
test_preds <- predict(models_with_splines[[deg_freedom]], test_data)
soses <- (1/N) * sum( (y_test - test_preds)**2)
test_errors_splines[deg_freedom - 2] <- soses
}
error_df_splines <- data.frame(
x = rep(3:max_parameters, 2),
e = c(train_errors_splines, test_errors_splines),
id = c(rep("train", length(train_errors_splines)),
rep("test", length(test_errors_splines))),
type = "splines"
)
out_obj$errors_splines_plot <- ggplot(data = error_df_splines) +
geom_line(aes(x = x, y = e)) +
facet_wrap(~ id) +
labs(title = "Error Rates with Natural Cubic Spline Transformations",
x = ("Number of Estimated Parameters"),
y = ("Average Squared Error"))
error_df <- rbind(error_df_cuts, error_df_splines)
out_obj$error_df <- error_df
# The training error for the first cut model is always an outlier, and
# messes up the y range of the plots.
y_lower_bound <- min(c(train_errors_cuts, train_errors_splines))
y_upper_bound = train_errors_cuts[2]
out_obj$errors_comparison_plot <- ggplot(data = error_df) +
geom_line(aes(x = x, y = e)) +
facet_wrap(~ id*type) +
scale_y_continuous(limits = c(y_lower_bound, y_upper_bound)) +
labs(
title = ("Binning vs. Natural Splines"),
x = ("Number of Estimated Parameters"),
y = ("Average Squared Error"))
out_obj
}
