ऐसा लगता है कि आप एक पूर्वानुमान के उत्तर की तलाश में हैं, इसलिए मैंने आर में दो दृष्टिकोणों का एक छोटा प्रदर्शन एक साथ रखा
- एक चर को समान आकार के कारकों में लाना।
- प्राकृतिक घन विभाजन।
नीचे, मैंने एक फ़ंक्शन के लिए कोड दिया है जो किसी भी दिए गए सच्चे सिग्नल फ़ंक्शन के लिए दो तरीकों की स्वचालित रूप से तुलना करेगा
test_cuts_vs_splines <- function(signal, N, noise,
range=c(0, 1),
max_parameters=50,
seed=154)
यह फ़ंक्शन एक दिए गए सिग्नल से शोर प्रशिक्षण और परीक्षण डेटासेट बनाएगा, और फिर नए प्रकारों के प्रशिक्षण के लिए रैखिक प्रतिगमन की एक श्रृंखला फिट करेगा
cutsमॉडल binned भविष्यवक्ताओं, बराबर आकार आधे खुले अंतराल में डेटा की श्रेणी के आधार पर विभाजन, और उसके बाद जो के अंतराल प्रत्येक प्रशिक्षण बिंदु अंतर्गत आता है यह दर्शाता है द्विआधारी भविष्यवक्ताओं बनाकर गठन भी शामिल है।splinesसाथ समुद्री मील समान रूप से भविष्यवक्ता की सीमा में स्थान दिया गया है मॉडल, एक प्राकृतिक घन पट्टी आधार विस्तार शामिल है।
तर्क हैं
signal: अनुमानित होने वाले सत्य का प्रतिनिधित्व करने वाला एक परिवर्तनशील कार्य।N: प्रशिक्षण और परीक्षण डेटा दोनों में शामिल करने के लिए नमूनों की संख्या।noise: प्रशिक्षण और परीक्षण सिग्नल को जोड़ने के लिए यादृच्छिक गाऊसी शोर का अम्बार।range: प्रशिक्षण और परीक्षण xडेटा की सीमा , डेटा यह इस सीमा के भीतर समान रूप से उत्पन्न होता है।max_paramters: एक मॉडल में अनुमान लगाने के लिए अधिकतम पैरामीटर। यह cutsमॉडल में खंडों की अधिकतम संख्या , और मॉडल में समुद्री मील की अधिकतम संख्या है splines।
ध्यान दें कि splinesमॉडल में अनुमानित मापदंडों की संख्या समुद्री मील की संख्या के समान है, इसलिए दोनों मॉडल की तुलना काफी अच्छी है।
फ़ंक्शन से वापसी ऑब्जेक्ट में कुछ घटक होते हैं
signal_plot: सिग्नल फ़ंक्शन का एक प्लॉट।data_plot: प्रशिक्षण और परीक्षण डेटा का एक बिखरा हुआ भूखंड।errors_comparison_plot: एस्ट्रिमेटेड मापदंडों की संख्या की एक सीमा से अधिक दोनों मॉडल के लिए चुकता त्रुटि दर के योग के विकास को दर्शाता एक भूखंड।
मैं दो सिग्नल कार्यों के साथ प्रदर्शित करूँगा। पहली एक बढ़ती हुई रैखिक प्रवृत्ति के साथ एक पाप लहर है
true_signal_sin <- function(x) {
x + 1.5*sin(3*2*pi*x)
}
obj <- test_cuts_vs_splines(true_signal_sin, 250, 1)
यहां बताया गया है कि त्रुटि दर कैसे विकसित होती है
दूसरा उदाहरण एक अखरोट का कार्य है जो मैं इस तरह की चीज़ के लिए चारों ओर रखता हूं, इसे प्लॉट करता हूं और देखता हूं
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)
और मनोरंजन के लिए, यहाँ एक उबाऊ रैखिक कार्य है
obj <- test_cuts_vs_splines(function(x) {x}, 250, .2)
आप वह देख सकते हैं:
- जब मॉडल जटिलता को दोनों के लिए ठीक से ट्यून किया जाता है, तो स्प्लिनेस बेहतर समग्र परीक्षण प्रदर्शन देता है।
- स्प्लिन बहुत कम अनुमानित मापदंडों के साथ इष्टतम परीक्षण प्रदर्शन देते हैं ।
- कुल मिलाकर स्प्लिन का प्रदर्शन बहुत अधिक स्थिर है क्योंकि अनुमानित मापदंडों की संख्या विविध है।
इसलिए स्प्लिन को हमेशा भविष्य कहनेवाला दृष्टिकोण से पसंद किया जाता है।
कोड
यहाँ कोड मैं इन तुलनाओं का उत्पादन करने के लिए प्रयोग किया जाता है। मैंने इसे एक फ़ंक्शन में लपेटा है ताकि आप इसे अपने स्वयं के सिग्नल कार्यों के साथ आज़मा सकें। आपको ggplot2और splinesआर पुस्तकालयों को आयात करने की आवश्यकता होगी ।
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
}