update

radiant.model/inst/app/tools/analysis/svm_ui.R

@@ -135,9 +135,14 @@ output$ui_svm_wts <- renderUI({
 
 ## 存储预测值UI
 output$ui_svm_store_pred_name <- renderUI({
-  init <- state_init("svm_store_pred_name", "pred_svm") %>%
-    sub("\\d{1,}$", "", .) %>%
-    paste0(., ifelse(is.empty(input$svm_kernel), "", input$svm_kernel))
+  base_name <- "pred_svm"
+  kernel_name <- input$svm_kernel  # 获取当前选中的核函数
+  init <- if (is.empty(kernel_name)) {
+    base_name
+  } else {
+    paste0(base_name, "_", kernel_name)
+  }
+  init <- state_init("svm_store_pred_name", init)
   textInput(
     "svm_store_pred_name",
     i18n$t("Store predictions:"),
@@ -145,6 +150,16 @@ output$ui_svm_store_pred_name <- renderUI({
   )
 })
 
+observeEvent(input$svm_kernel, {
+  current_value <- tryCatch(isolate(input$svm_store_pred_name), error = function(e) "")
+  if (!is.null(current_value) && length(current_value) > 0 && nzchar(current_value)) {
+    if (grepl("^pred_svm(_[a-z]+)?$", current_value)) {
+      new_value <- paste0("pred_svm", "_", input$svm_kernel)
+      updateTextInput(session, "svm_store_pred_name", value = new_value)
+    }
+  }
+}, ignoreInit = TRUE, ignoreNULL = TRUE)
+
 ## 数据集/模型类型切换时重置预测与绘图
 observeEvent(input$dataset, {
   updateSelectInput(session = session, inputId = "svm_predict", selected = "none")
@@ -414,40 +429,52 @@ svm_available <- reactive({
 
 ## 存储预测值
 observeEvent(input$svm_store_pred, {
-  req(
-    pressed(input$svm_run),
-    !is.empty(input$svm_pred_data),
-    !is.empty(input$svm_store_pred_name),
-    inherits(.predict_svm(), "svm.predict")
-  )
+  # 只有最基本的检查，不满足就静默退出
+  if (!pressed(input$svm_run) || is.empty(input$svm_pred_data) || is.empty(input$svm_store_pred_name)) {
+    return()
+  }
+  
+  # 获取预测结果（不管成功失败）
   pred_result <- .predict_svm()
   target_data <- r_data[[input$svm_pred_data]]
   base_col_name <- fix_names(input$svm_store_pred_name)
-  meta <- attr(pred_result, "svm_meta")
   
-  pred_cols <- if (meta$model_type %in% c("classification", "regression")) {
-    colnames(pred_result)[colnames(pred_result) == "Prediction"]
-  } else {
-    NULL
-  }
-  new_col_names <- if (length(pred_cols) == 1) base_col_name else {
-    suffix <- gsub("^Prediction", "", pred_cols)
-    paste0(base_col_name, ifelse(suffix == "", "", paste0("_", suffix)))
-  }
-  colnames(pred_result)[match(pred_cols, colnames(pred_result))] <- new_col_names
+  # 如果预测返回的是错误字符串，直接创建NA列
+  if (is.character(pred_result)) {
+    target_data[[base_col_name]] <- rep(NA_real_, nrow(target_data))
+    attr(target_data[[base_col_name]], "error") <- pred_result
+    r_data[[input$svm_pred_data]] <- target_data
     
-  merged_data <- merge(
-    target_data,
-    pred_result[, c(meta$evar, new_col_names), drop = FALSE],
-    by = meta$evar, all.x = TRUE
-  )
-  r_data[[input$svm_pred_data]] <- merged_data
     showNotification(
-    sprintf(i18n$t("SVM predictions stored as: %s (in '%s')"),
-            paste(new_col_names, collapse = ", "), input$svm_pred_data),
-    type = "message"
+      sprintf("预测失败，已添加NA列 '%s'", base_col_name),
+      type = "warning"
     )
-  updateTextInput(session, "svm_store_pred_name", value = base_col_name)
+  } else {
+    # 正常情况：直接提取Prediction列
+    if ("Prediction" %in% colnames(pred_result)) {
+      # 用cbind逻辑，更简单直接
+      pred_values <- pred_result$Prediction
+      
+      # 处理长度不匹配
+      n_target <- nrow(target_data)
+      n_pred <- length(pred_values)
+      
+      if (n_pred < n_target) {
+        # 预测值少，用NA填充
+        pred_values <- c(pred_values, rep(NA_real_, n_target - n_pred))
+      } else if (n_pred > n_target) {
+        # 预测值多，截断
+        pred_values <- pred_values[1:n_target]
+      }
+      target_data[[base_col_name]] <- pred_values
+      r_data[[input$svm_pred_data]] <- target_data
+    } else {
+      target_data[[base_col_name]] <- rep(NA_real_, nrow(target_data))
+      r_data[[input$svm_pred_data]] <- target_data
+    }
+  }
+  # 重置输入框
+  updateTextInput(session, "svm_store_pred_name", value = "pred_svm")
 })
 
 ## 下载处理