দেখে মনে হচ্ছে আপনিও ভবিষ্যদ্বাণীমূলক অবস্থান থেকে উত্তর খুঁজছেন, তাই আমি আর এ দুটি পদ্ধতির সংক্ষিপ্ত প্রদর্শন একসাথে রেখেছি
- একটি আকারকে সমান আকারের কারণগুলিতে বিন্যস্ত করা।
- প্রাকৃতিক ঘন splines
নীচে, আমি কোনও ফাংশনের জন্য কোড দিয়েছি যা কোনও প্রদত্ত সত্য সংকেত ফাংশনের জন্য স্বয়ংক্রিয়ভাবে দুটি পদ্ধতির তুলনা করবে
test_cuts_vs_splines <- function(signal, N, noise,
range=c(0, 1),
max_parameters=50,
seed=154)
এই ফাংশনটি প্রদত্ত সংকেত থেকে কোলাহলপূর্ণ প্রশিক্ষণ এবং টেস্টিং ডেটাসেট তৈরি করবে এবং তারপরে দুটি প্রকারের প্রশিক্ষণের ডেটাতে লিনিয়ার রেগ্রেশনগুলির একটি সিরিজ ফিট করবে
cutsমডেল হাজার প্রতি ভবিষ্যতবক্তা, সমান আকারের অর্ধেক খোলা অন্তর ডেটা পরিসীমা segmenting, এবং তারপর যা ব্যবধান প্রতিটি প্রশিক্ষণ বিন্দু জন্যে ইঙ্গিত বাইনারি ভবিষ্যতবক্তা তৈরি করে গঠিত অন্তর্ভুক্ত করা হয়েছে।splinesসঙ্গে নট সমানভাবে predictor পরিসীমা জুড়ে ব্যবধানে মডেল, একটি প্রাকৃতিক কিউবিক স্প্লাইন ভিত্তিতে সম্প্রসারণ অন্তর্ভুক্ত করা হয়েছে।
যুক্তিগুলি হল
signal: সত্যটি অনুমান করা যায় এমন একটি পরিবর্তনশীল ফাংশন।N: প্রশিক্ষণ এবং পরীক্ষার উভয় ডেটাতে অন্তর্ভুক্ত করার জন্য নমুনার সংখ্যা।noise: প্রশিক্ষণ এবং পরীক্ষার সংকেত যোগ করতে এলোমেলো গাউসী আওয়াজের পরিমাণ oundrange: প্রশিক্ষণের পরিসীমা এবং পরীক্ষার 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
}