for (i in 1:n_new) {
for (j in 1:n_train) {
# 计算X_new_mat的第i行与X_train_mat的第j行之间的平方欧氏距离
diff_sq <- sum((X_new_mat[i, , drop = FALSE] - X_train_mat[j, , drop = FALSE])^2)
K_pred[i, j] <- exp(-1 * diff_sq / sigma)
}
}
return(K_pred)
}
# multdiag_cv.R
# 函数功能：将一个方阵X与一个对角矩阵diag(d)相乘
multdiag <- function(X, d){
R <- matrix(NA, nrow = dim(X)[1], ncol = dim(X)[2])
for (i in 1:ncol(X)){ # 遍历X的列
R[,i] <- X[,i] * d[i]
}
return(R)
}
# solveforc_krls_cv.R
# source("multdiag_cv.R") # 假设multdiag已加载
solveforc_krls_cv <- function(y_scaled, K_eigen_obj, lambda, eigtrunc = NULL) {
n_eigen <- length(K_eigen_obj$values)
active_eigenvalues <- K_eigen_obj$values
active_eigenvectors <- K_eigen_obj$vectors
if (!is.null(eigtrunc) && eigtrunc > 0 && eigtrunc < 1) {
max_eigenvalue <- K_eigen_obj$values[1] # 假设特征值已排序
if (max_eigenvalue > .Machine$double.eps) {
min_val_to_keep <- eigtrunc * max_eigenvalue
# 确保至少保留一个特征值，如果所有特征值都小于阈值
num_to_keep <- sum(K_eigen_obj$values >= min_val_to_keep)
lastkeeper <- max(1, num_to_keep)
active_eigenvalues <- K_eigen_obj$values[1:lastkeeper]
active_eigenvectors <- K_eigen_obj$vectors[, 1:lastkeeper, drop = FALSE]
}
}
# Ginv_diag_part = 1 / (Lambda_k + lambda)
# 确保分母远大于机器精度，避免数值问题
denominator <- active_eigenvalues + lambda
denominator[denominator < .Machine$double.eps] <- .Machine$double.eps
Ginv_diag_part <- 1 / denominator
# Ginv = V * diag(Ginv_diag_part) * V^T
# multdiag(active_eigenvectors, Ginv_diag_part) 计算 V * diag(...)
Ginv <- tcrossprod(multdiag(X = active_eigenvectors, d = Ginv_diag_part), active_eigenvectors)
# coeffs = Ginv * y_scaled
coeffs <- Ginv %*% y_scaled
return(list(coeffs = coeffs))
}
# lambda_search_kfold_cv.R
# 需要 gausskernel, gausskernel_predict, solveforc_krls_cv
lambda_search_kfold_cv <- function(X_scaled, y_scaled, k_folds, lambda_candidates,
whichkernel, sigma, eigtrunc,
kernel_func_train, # e.g., gausskernel
kernel_func_predict, # e.g., gausskernel_predict
solver_func, # e.g., solveforc_krls_cv
print_level = 1) {
n <- nrow(X_scaled)
# 打乱数据并创建k折的索引
shuffled_indices <- sample(1:n)
fold_labels <- cut(seq(1, n), breaks = k_folds, labels = FALSE)
fold_indices <- fold_labels[shuffled_indices] # 将打乱的索引分配到各折
mse_results <- numeric(length(lambda_candidates))
names(mse_results) <- as.character(lambda_candidates)
if (print_level > 0) cat("开始K折交叉验证选择lambda...\n")
for (i in 1:length(lambda_candidates)) {
lambda <- lambda_candidates[i]
if (print_level > 1) cat(paste0("  测试 lambda = ", lambda, "\n"))
fold_mses <- numeric(k_folds)
for (k in 1:k_folds) {
if (print_level > 2) cat(paste0("    Fold ", k, "\n"))
val_idx <- which(fold_indices == k)
train_idx <- which(fold_indices != k)
X_train_fold <- X_scaled[train_idx, , drop = FALSE]
y_train_fold <- y_scaled[train_idx, , drop = FALSE]
X_val_fold <- X_scaled[val_idx, , drop = FALSE]
y_val_fold <- y_scaled[val_idx, , drop = FALSE]
if (nrow(X_train_fold) < 2 || nrow(X_val_fold) == 0) { # 需要至少2个点计算dist，验证集不能为空
fold_mses[k] <- NA # 无法计算，标记为NA
next
}
K_train_fold <- NULL
if (whichkernel == "gaussian") {
K_train_fold <- kernel_func_train(X_train_fold, sigma = sigma)
} else if (whichkernel == "linear") {
K_train_fold <- tcrossprod(X_train_fold)
} # 可以按需添加其他核函数
if (is.null(K_train_fold) || any(dim(K_train_fold) == 0)) {
fold_mses[k] <- NA; next
}
K_eigen_fold <- eigen(K_train_fold, symmetric = TRUE)
solver_output <- solver_func(y_scaled = as.matrix(y_train_fold),
K_eigen_obj = K_eigen_fold,
lambda = lambda, eigtrunc = eigtrunc)
alpha_train_fold <- solver_output$coeffs
K_val_train_fold <- NULL
if (whichkernel == "gaussian") {
K_val_train_fold <- kernel_func_predict(X_val_fold, X_train_fold, sigma = sigma)
} else if (whichkernel == "linear") {
K_val_train_fold <- X_val_fold %*% t(X_train_fold)
} # 可以按需添加其他核函数
if (is.null(K_val_train_fold) || any(dim(K_val_train_fold) == 0) || any(dim(alpha_train_fold) == 0)) {
fold_mses[k] <- NA; next
}
y_val_pred <- K_val_train_fold %*% alpha_train_fold
fold_mses[k] <- mean((y_val_fold - y_val_pred)^2, na.rm = TRUE)
}
mse_results[i] <- mean(fold_mses, na.rm = TRUE)
if (print_level > 1) cat(paste0("  lambda = ", lambda, " 的平均MSE: ", mse_results[i], "\n"))
}
if (all(is.na(mse_results))) stop("所有lambda的MSE都无法计算，请检查数据或参数。")
optimal_lambda_idx <- which.min(mse_results)
optimal_lambda <- lambda_candidates[optimal_lambda_idx]
min_mse <- mse_results[optimal_lambda_idx]
if (print_level > 0) cat(paste0("最优lambda: ", optimal_lambda, ", 对应最小MSE: ", min_mse, "\n"))
return(list(optimal_lambda = optimal_lambda, mse_results = mse_results))
}
# krls_cv.R
# 假设 gausskernel_cv.R, multdiag_cv.R, solveforc_krls_cv.R, lambda_search_kfold_cv.R 已加载
krls_cv <- function(X, y,
whichkernel = "gaussian",
sigma = NULL,
lambda = NULL,
lambda_candidates = 10^seq(-4, 1, length.out = 15),
k_folds = 5,
eigtrunc = NULL,
print_level = 1) {
y_mat <- as.matrix(y)
X_mat <- as.matrix(X)
if (!is.numeric(X_mat)) stop("X必须是数值型")
if (!is.numeric(y_mat)) stop("y必须是数值型")
if (sd(y_mat) < .Machine$double.eps) stop("y是常数")
if (nrow(X_mat) != nrow(y_mat)) stop("X的行数与y的行数不相等")
constant_cols <- which(apply(X_mat, 2, function(col) sd(col) < .Machine$double.eps))
if (length(constant_cols) > 0) {
stop(paste("X中存在常数列，请移除:", colnames(X_mat)[constant_cols]))
}
n <- nrow(X_mat)
d <- ncol(X_mat)
if (whichkernel == "gaussian" && is.null(sigma)) {
sigma <- d
if (print_level > 0) cat(paste0("高斯核带宽sigma默认设置为特征维度d = ", d, "\n"))
}
if (whichkernel == "gaussian" && (!is.numeric(sigma) || sigma <= 0)) {
stop("高斯核的sigma必须是正数")
}
if (!is.null(eigtrunc) && (!is.numeric(eigtrunc) || eigtrunc <= 0 || eigtrunc >= 1)) {
stop("eigtrunc (如果使用) 必须是0到1之间的数值 (不包含0和1).")
}
# 数据标准化
X_scaled_means <- colMeans(X_mat)
X_scaled_sds <- apply(X_mat, 2, sd)
y_scaled_mean <- mean(y_mat)
y_scaled_sd <- sd(y_mat)
X_scaled <- scale(X_mat, center = X_scaled_means, scale = X_scaled_sds)
y_scaled <- scale(y_mat, center = y_scaled_mean, scale = y_scaled_sd)
# --- Lambda选择 ---
final_lambda <- lambda
if (is.null(lambda)) {
if (print_level > 0) cat("lambda为NULL，开始K折交叉验证寻找最优lambda。\n")
if (is.null(lambda_candidates) || length(lambda_candidates) == 0) {
stop("当lambda为NULL时，必须提供lambda_candidates进行CV。")
}
# 根据核类型选择传递给CV的核函数
kf_train <- NULL; kf_pred <- NULL
if(whichkernel == "gaussian"){
kf_train <- gausskernel
kf_pred <- gausskernel_predict
} else if(whichkernel == "linear"){
# 线性核可以直接在CV函数内计算，或传递一个简单函数
kf_train <- function(X_s, sigma_dummy=NULL) tcrossprod(X_s)
kf_pred <- function(X_n, X_t, sigma_dummy=NULL) X_n %*% t(X_t)
} else {
stop(paste("当前CV实现仅支持 'gaussian' 和 'linear' 核, 或需扩展lambda_search_kfold_cv内的核处理。"))
}
cv_results <- lambda_search_kfold_cv(
X_scaled = X_scaled, y_scaled = y_scaled,
k_folds = k_folds, lambda_candidates = lambda_candidates,
whichkernel = whichkernel, sigma = sigma, eigtrunc = eigtrunc,
kernel_func_train = kf_train,
kernel_func_predict = kf_pred,
solver_func = solveforc_krls_cv,
print_level = print_level
)
final_lambda <- cv_results$optimal_lambda
if (print_level > 0) cat(paste0("CV得到的最优lambda: ", final_lambda, "\n"))
} else {
if (print_level > 0) cat(paste0("使用用户提供的lambda: ", final_lambda, "\n"))
}
if (!is.numeric(final_lambda) || final_lambda < 0) { # lambda可以等于0（无正则化）
stop("lambda必须是非负数。")
}
# --- 使用选定的lambda在全部数据上训练模型 ---
K_full <- NULL
if (whichkernel == "gaussian") {
K_full <- gausskernel(X_scaled, sigma = sigma)
} else if (whichkernel == "linear") {
K_full <- tcrossprod(X_scaled)
} # 可以按需添加其他核
if (is.null(K_full)) stop("无法为全数据计算核矩阵。")
K_eigen_full <- eigen(K_full, symmetric = TRUE)
solver_output_full <- solveforc_krls_cv(
y_scaled = y_scaled, K_eigen_obj = K_eigen_full,
lambda = final_lambda, eigtrunc = eigtrunc
)
alpha_coeffs <- solver_output_full$coeffs
# --- 计算拟合值并转换回原始尺度 ---
fitted_scaled <- K_full %*% alpha_coeffs
fitted_original_scale <- (fitted_scaled * y_scaled_sd) + y_scaled_mean
# --- R方 ---
R2 <- 1 - (sum((y_mat - fitted_original_scale)^2) / sum((y_mat - y_scaled_mean)^2))
if (print_level > 0) cat(paste0("R-squared: ", R2, "\n"))
# --- 返回结果对象 ---
result <- list(
coeffs = alpha_coeffs,
fitted_values = as.vector(fitted_original_scale),
X_original = X_mat,
y_original = as.vector(y_mat),
X_scaled_means = X_scaled_means,
X_scaled_sds = X_scaled_sds,
y_scaled_mean = y_scaled_mean,
y_scaled_sd = y_scaled_sd,
X_scaled_train = X_scaled, # 用于预测时计算新数据与训练数据的核
sigma = if (whichkernel == "gaussian") sigma else NULL,
lambda = final_lambda,
whichkernel = whichkernel,
eigtrunc = eigtrunc,
R2 = R2
)
class(result) <- "krls_cv_model"
return(result)
}
# predict_krls_cv.R
# 假设 gausskernel_cv.R 中的 gausskernel_predict 已加载
predict.krls_cv_model <- function(object, newdata, ...) {
if (!inherits(object, "krls_cv_model")) {
stop("输入对象不是 'krls_cv_model' 类型")
}
newdata_mat <- as.matrix(newdata)
if (ncol(newdata_mat) != length(object$X_scaled_means)) {
stop("新数据的列数与训练模型时的X列数不一致")
}
# 使用训练时的参数标准化新数据
newdata_scaled <- scale(newdata_mat, center = object$X_scaled_means, scale = object$X_scaled_sds)
# 计算新数据(已标准化)与原始训练数据(已标准化)之间的核矩阵
K_new_train <- NULL
if (object$whichkernel == "gaussian") {
if (is.null(object$sigma)) stop("模型对象中缺少高斯核的sigma参数")
K_new_train <- gausskernel_predict(newdata_scaled, object$X_scaled_train, sigma = object$sigma)
} else if (object$whichkernel == "linear") {
K_new_train <- newdata_scaled %*% t(object$X_scaled_train)
} # 可以按需添加其他核
if (is.null(K_new_train)) stop("无法为新数据计算核矩阵。")
# 进行预测 (alpha_coeffs 是针对标准化y的系数)
predictions_scaled <- K_new_train %*% object$coeffs
# 将预测结果转换回原始y的尺度
predictions_original_scale <- (predictions_scaled * object$y_scaled_sd) + object$y_scaled_mean
return(as.vector(predictions_original_scale))
}
library(MASS)
library(glmnet)
library(Matrix)
library(foreach)
library(doParallel)
library(doRNG)
library(KRLS)
setwd("C:/Users/76790/Desktop/博士阶段/科研/程序/Paper1/第三版/Simulation")
set.seed(521)
N1=10000 # 训练集样本量
N2=2000 # 测试集样本量
n<-c(500)
p<-4
c = 0.01 ##LGS 的参数
d = 1## LGS的参数
a = b = 1
q=0.1# 0.1,0.2,0.3,0.4
burn=300
M <-5# 实验重复次数
source_file_path <- "C:/Users/76790/Desktop/博士阶段/科研/程序/Paper1/第三版/Simulation/function.R"
# Set up parallel backend
cl <- makeCluster(detectCores() - 3)  # Use one less core than available
registerDoParallel(cl)
# 初始化一个列表来存储所有结果
all_results <- list()
for (n_val in n) {
results <- foreach(m = 1:M, .combine = 'rbind',.packages = c('MASS','glmnet','Matrix','kernlab','KRLS')) %dorng% {
source(source_file_path)
train_clean <- clean_data(N1, p)
X_train    <- train_clean$X
Y_train    <- train_clean$Y
#污染
outliers <- sample(1:N1, N1*q) # 随机产生N1*q个污染的下标
corr <- corrupted_data(X_train, Y_train, outliers, N1, p, q)
X_train_tilde <- corr$X_tilde
Y_train_tilde <- corr$Y_tilde
#干净的测试集
test_clean <- clean_data(N2, p)
X_test<-test_clean$X
Y_test<-test_clean$Y
# 假设 p=列数
##############################训练集中抽样##################################
###########################基于核的方法################
######################均匀抽样################
idx <- sample(1:N1, n_val, replace = FALSE)
# 使用相同的索引来选取X0和Y0
X_UNIF = X_train_tilde[idx, ]
Y_UNIF = Y_train_tilde[idx]
# 定义高斯核
rbf_kernel  <- rbfdot(sigma = p)
#均匀采样干净比例
ps_UNIF <- intersect(idx, outliers)
psr_UNIF <- 1-length(ps_UNIF)/n_val
fit_final_f0 <- krls(X = X_UNIF, y = Y_UNIF, derivative = FALSE, vcov= FALSE)
# 使用 predict 函数进行预测
Yhat_train_tilde <- predict(fit_final_f0, newdata = X_train_tilde)$fit
## 计算残差
res<-abs(Y_train_tilde-Yhat_train_tilde)
res_2<-res^2
##计算训练集在初始模型下的核矩阵
K_train_tilde<-kernelMatrix(rbf_kernel,X_train_tilde,X_UNIF)
# 计算每个样本的核范数，即计算每行的L2范数
K_norms_train_tilde <-sqrt(rowSums( K_train_tilde^2))
rm(K_train_tilde) # 删除核矩阵
#######################2014################
# 抽样概率
GK<-exp(res_2)
max_iter <- 1 #（迭代次数）
iter <- 0
while(iter < max_iter) {
iter <- iter + 1
## 开始抽样 小梯度markov
L2MS_result<-LGMS(X_train_tilde,Y_train_tilde, GK, 1, burn, n_val)
X_L2MS<-L2MS_result$X_selected
Y_L2MS<-L2MS_result$Y_selected
indices_L2MS<-L2MS_result$indices
# 拟合最终模型
fit_final_L2MS <- krls(X = X_L2MS, y = Y_L2MS,derivative=FALSE,vcov=FALSE)
# 子样本污染数据比例
ps_L2MS <- intersect(indices_L2MS, outliers)
psr_L2MS <- 1-length(ps_L2MS)/n_val
}
################ 我们的方法##################
# 抽样概率
G_KRMS<-res/K_norms_train_tilde
max_iter <- 3 #（迭代次数）
tolerance <- 0.001
iter <- 0
diff_norm<-Inf
while(iter < max_iter & diff_norm > tolerance) {
iter <- iter + 1
KRMS_result<-LGMS(X_train_tilde,Y_train_tilde, G_KRMS, 1, burn, n_val)
X_KRMS<-KRMS_result$X_selected
Y_KRMS<-KRMS_result$Y_selected
indices_KRMS<-KRMS_result$indices
# 拟合最终模型
fit_final_KRMS<-krls(X = X_KRMS, y = Y_KRMS,derivative = FALSE, vcov= FALSE)
#更新训练集的核以及二范数
K_train_tilde<-kernelMatrix(rbf_kernel,X_train_tilde,X_KRMS)
K_norms_train_tilde <-sqrt(rowSums( K_train_tilde^2))
rm(K_train_tilde) # 释放内存
# 用干净样本得到的模型预测预测训练集实现迭代
Yhat_train_tilde_new <- predict(fit_final_KRMS, newdata =X_train_tilde)$fit
#更新残差
res<-abs(Y_train_tilde-Yhat_train_tilde_new)
#更新抽样概率
G_KRMS<-res/K_norms_train_tilde
#迭代停止条件
diff_norm<- mean((Yhat_train_tilde-Yhat_train_tilde_new)^2)
# 在循环内部计算差异后更新
Yhat_train_tilde <- Yhat_train_tilde_new
# 子样本污染数据比例
ps_KRMS <- intersect(indices_KRMS, outliers)
psr_KRMS <- 1-length(ps_KRMS)/n_val
}
#####################线性模型方法##########################
######用线性回归模型拟合均匀抽样的结果来获得初始beta####
colnames(X_train_tilde) <- paste0("X", 1:ncol(X_train_tilde))
colnames(X_test)        <- paste0("X", 1:ncol(X_test))
#合并Y和X的数据
train_UNIF <- data.frame(Y = Y_UNIF,  X_UNIF )
########均匀抽样拟合线性回归模型#########
model_UNIF <- lm(Y ~ ., data = train_UNIF)
X_train_tilde_df<- as.data.frame(X_train_tilde)
Y_train_hat_UNIF <- predict(model_UNIF, newdata = X_train_tilde_df)
############ GMS ###########
# 计算梯度
G <- gradient(X_train_tilde, Y_train_tilde, Y_train_hat_UNIF, p)$G
GMS_result <- GMS(X_train_tilde, Y_train_tilde, G, 1,burn, n_val)
X_GMS <- GMS_result$X_selected
Y_GMS <- GMS_result$Y_selected
train_GMS <- data.frame(Y = Y_GMS,  X_GMS )
model_GMS <- lm(Y ~ ., data = train_GMS)
indices_GMS<-GMS_result$indices
ps_GMS <- intersect(indices_GMS, outliers)
psr_GMS <- 1-length(ps_GMS)/n_val
########## LGS  #############
iter <- 0
diff_norm <- Inf
max_iter <- 5
tolerance <- 0.0001
Y_hat_prev_LGS <-Y_train_hat_UNIF# 上一次迭代的系数估计值
nu <- rep(0, p)
Gradient_result <- gradient( X_train_tilde, Y_train_tilde, Y_hat_prev_LGS, p)
G<-Gradient_result$G
while(iter < max_iter & diff_norm > tolerance) {
iter <- iter + 1
# LGS
LGS_result <- LGS(X_train_tilde, Y_train_tilde, G, 0,  n_val,N1)
X_LGS <- LGS_result$X_selected
Y_LGS <- LGS_result$Y_selected
train_LGS <- data.frame(Y = Y_LGS,  X_LGS )
model_LGS<- lm(Y ~ ., data = train_LGS)
Y_hat_new_LGS<-predict(model_LGS, newdata = X_train_tilde_df)
#更新梯度矩阵
Gradient_result <- gradient(X_train_tilde, Y_train_tilde, Y_hat_new_LGS, p)
G<-Gradient_result$G
G_matrix<-Gradient_result$G_matrix
#求梯度矩阵的均值
mu <- G_matrix |> apply(2, mean)
#更新nu
nu <- c * (iter / log(1+abs(mu)))^d
# 计算差的二范数
diff_norm <- mean((Y_hat_prev_LGS - Y_hat_new_LGS)^2)
# 更新估计值
Y_hat_prev_LGS <-Y_hat_new_LGS
# 基于当前迭代的参数估计值评估TP和FP
# 使用当前迭代的样本来计算干净样本的比例
indices_LGS<-LGS_result$indices
ps_LGS <- intersect(indices_LGS, outliers)
psr_LGS <- 1-length(ps_LGS)/n_val
}
#核方法下的均匀抽样在测试集的MSE
Y_test_hat_UNIF<-predict(fit_final_f0, newdata = X_test)$fit
mse_UNIF_kernel  <- mean((Y_test-Y_test_hat_UNIF)^2)
#2014年方法的MSE
Y_test_hat_L2MS<-predict(fit_final_L2MS, newdata = X_test)$fit
mse_L2MS  <- mean((Y_test-Y_test_hat_L2MS)^2)
# 我们方法测试集的MSE
Y_test_hat_KRMS<-predict(fit_final_KRMS, newdata = X_test)$fit
mse_KRMS  <- mean((Y_test-Y_test_hat_KRMS)^2)
##############线性模型下的#############
X_test_df<-as.data.frame(X_test)
#均匀抽样在测试集上的MSE
Y_test_hat_UNIF<-predict(model_UNIF, newdata = X_test_df)
mse_UNIF<-mean((Y_test-Y_test_hat_UNIF)^2)
#GMS在测试集上的MSE
Y_test_hat_GMS<-predict(model_GMS, newdata = X_test_df)
mse_GMS  <- mean((Y_test-Y_test_hat_GMS)^2)
#LGS在测试集上的MSE
Y_test_hat_LGS<-predict(model_LGS, newdata = X_test_df)
mse_LGS  <- mean((Y_test-Y_test_hat_LGS)^2)
# 返回结果作为一行数据
data.frame(n_val = n_val, m = m,
mse_UNIF_kernel=mse_UNIF_kernel, mse_L2MS = mse_L2MS, mse_KRMS = mse_KRMS,mse_UNIF=mse_UNIF,mse_GMS = mse_GMS,mse_LGS = mse_LGS,
psr_UNIF_kernel=psr_UNIF        ,psr_L2MS = psr_L2MS, psr_KRMS = psr_KRMS,psr_UNIF=psr_UNIF,psr_GMS = psr_GMS,psr_LGS = psr_LGS)
}
# 计算M次重复实验的均值和标准差
mse_mean_UNIF_kernel <- mean(results$mse_UNIF_kernel)
mse_sd_UNIF_kernel <- sd(results$mse_UNIF_kernel)
psr_mean_UNIF_kernel <- mean(results$psr_UNIF_kernel)
mse_mean_L2MS <- mean(results$mse_L2MS)
mse_sd_L2MS <- sd(results$mse_L2MS)
psr_mean_L2MS <- mean(results$psr_L2MS)
mse_mean_KRMS <- mean(results$mse_KRMS)
mse_sd_KRMS <- sd(results$mse_KRMS)
psr_mean_KRMS <- mean(results$psr_KRMS)
mse_mean_UNIF <- mean(results$mse_UNIF)
mse_sd_UNIF <- sd(results$mse_UNIF)
psr_mean_UNIF <- mean(results$psr_UNIF)
mse_mean_GMS <- mean(results$mse_GMS)
mse_sd_GMS <- sd(results$mse_GMS)
psr_mean_GMS <- mean(results$psr_GMS)
mse_mean_LGS <- mean(results$mse_LGS)
mse_sd_LGS <- sd(results$mse_LGS)
psr_mean_LGS <- mean(results$psr_LGS)
# 创建汇总数据框
summary_df <- data.frame(
n_val = n_val,
mse_mean_UNIF_kernel=mse_mean_UNIF_kernel,
mse_sd_UNIF_kernel=mse_sd_UNIF_kernel,
psr_mean_UNIF_kernel=psr_mean_UNIF_kernel,
mse_mean_L2MS=mse_mean_L2MS,
mse_sd_L2MS=mse_sd_L2MS,
psr_mean_L2MS=psr_mean_L2MS,
mse_mean_KRMS=mse_mean_KRMS,
mse_sd_KRMS=mse_sd_KRMS,
psr_mean_KRMS=psr_mean_KRMS,
mse_mean_UNIF=mse_mean_UNIF,
mse_sd_UNIF=mse_sd_UNIF,
psr_mean_UNIF=psr_mean_UNIF,
mse_mean_GMS=mse_mean_GMS,
mse_sd_GMS=mse_sd_GMS,
psr_mean_GMS=psr_mean_GMS,
mse_mean_LGS=mse_mean_LGS,
mse_sd_LGS=mse_sd_LGS,
psr_mean_LGS=psr_mean_LGS
)
# 将详细结果和汇总结果存储在all_results列表中
all_results[[as.character(n_val)]] <- list(
individual = results,
summary = summary_df)
# 可选：将每个n_val的结果保存为CSV文件
write.csv(results, file = paste0("results_n_", n_val, ".csv"), row.names = FALSE)
write.csv(summary_df, file = paste0("summary_n_", n_val, ".csv"), row.names = FALSE)
}
stopCluster(cl)
registerDoSEQ()
# 可选：将所有结果保存为RData文件
save(all_results, file = "simulation_results.RData")
# 打印汇总结果
for (n_val in n) {
cat("\nSummary for n =", n_val, ":\n")
print(all_results[[as.character(n_val)]]$summary)
}
