Anscheinend suchen Sie auch eine prädiktive Antwort. Deshalb habe ich in R eine kurze Demonstration von zwei Ansätzen zusammengestellt
- Unterteilung einer Variablen in gleich große Faktoren.
- Natürliche kubische Splines.
Im Folgenden habe ich den Code für eine Funktion angegeben, mit der die beiden Methoden automatisch für eine bestimmte wahre Signalfunktion verglichen werden
test_cuts_vs_splines <- function(signal, N, noise,
range=c(0, 1),
max_parameters=50,
seed=154)
Diese Funktion erstellt aus einem bestimmten Signal verrauschte Trainings- und Testdatensätze und passt dann eine Reihe linearer Regressionen an die Trainingsdaten zweier Typen an
- Das
cutsModell enthält gruppierte Prädiktoren, die durch Segmentieren des Datenbereichs in halboffene Intervalle gleicher Größe und anschließendes Erstellen von binären Prädiktoren gebildet werden, die angeben, zu welchem Intervall jeder Trainingspunkt gehört.
- Das
splinesModell enthält eine natürliche kubische Spline-Basiserweiterung mit Knoten, die über den gesamten Bereich des Prädiktors gleichmäßig verteilt sind.
Die Argumente sind
signal: Eine Funktion mit einer Variablen, die die zu schätzende Wahrheit darstellt.N: Die Anzahl der Proben, die sowohl in Trainings- als auch in Testdaten enthalten sein sollen.noise: Die Menge des zufälligen Gaußschen Rauschens, die dem Trainings- und Testsignal hinzugefügt wird.range: Der Bereich der Trainings- und Testdaten, xDaten, die innerhalb dieses Bereichs einheitlich erzeugt werden.max_paramters: Die maximale Anzahl von Parametern, die in einem Modell geschätzt werden sollen. Dies ist sowohl die maximale Anzahl von Segmenten im cutsModell als auch die maximale Anzahl von Knoten im splinesModell.
Beachten Sie, dass die Anzahl der im splinesModell geschätzten Parameter der Anzahl der Knoten entspricht, sodass die beiden Modelle fair verglichen werden.
Das Rückgabeobjekt aus der Funktion hat einige Komponenten
signal_plot: Eine Darstellung der Signalfunktion.data_plot: Ein Streudiagramm der Trainings- und Testdaten.errors_comparison_plot: Ein Diagramm, das die Entwicklung der Summe der quadratischen Fehlerrate für beide Modelle über einen Bereich der Anzahl der geschätzten Parameter zeigt.
Ich werde mit zwei Signalfunktionen demonstrieren. Die erste ist eine Sinuswelle mit einem sich überlagernden linearen Trend
true_signal_sin <- function(x) {
x + 1.5*sin(3*2*pi*x)
}
obj <- test_cuts_vs_splines(true_signal_sin, 250, 1)
So entwickeln sich die Fehlerraten
Das zweite Beispiel ist eine verrückte Funktion, die ich nur für diese Art von Dingen verwende, zeichne und sehe
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)
Und zum Spaß gibt es hier eine langweilige lineare Funktion
obj <- test_cuts_vs_splines(function(x) {x}, 250, .2)
Sie können sehen, dass:
- Splines bieten insgesamt eine bessere Gesamttestleistung, wenn die Modellkomplexität für beide Bereiche richtig abgestimmt ist.
- Splines bieten eine optimale Testleistung mit viel weniger geschätzten Parametern .
- Insgesamt ist die Leistung von Splines viel stabiler, da die Anzahl der geschätzten Parameter variiert.
So Splines ist immer von einem prädiktiven Gesichtspunkt wird bevorzugt.
Code
Hier ist der Code, mit dem ich diese Vergleiche erstellt habe. Ich habe alles in eine Funktion verpackt, damit Sie es mit Ihren eigenen Signalfunktionen ausprobieren können. Sie müssen die ggplot2und splinesR-Bibliotheken importieren .
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
}