修复了神经网络界面的bug

radiant.model/NAMESPACE

@@ -112,6 +112,7 @@ export(repeater)
 export(rforest)
 export(rig)
 export(scale_df)
+export(scale_sv)
 export(sdw)
 export(sensitivity)
 export(sim_cleaner)

radiant.model/R/nn.R

@@ -182,7 +182,6 @@ scale_df <- function(dataset, center = TRUE, scale = TRUE,
     return(dataset)
   }
   cn <- names(isNum)[isNum]
-
   ## remove set_attr calls when dplyr removes and keep attributes appropriately
   descr <- attr(dataset, "description")
   if (calc) {
@@ -225,6 +224,7 @@ scale_df <- function(dataset, center = TRUE, scale = TRUE,
   } else if (scale) {
     icn <- intersect(names(sds), cn)
     dataset[icn] <- lapply(icn, function(var) dataset[[var]] / (sf * sds[[var]]))
+    dataset %>%
       set_attr("radiant_sds", sds) %>%
       set_attr("radiant_sf", sf) %>%
       set_attr("description", descr)
@@ -545,13 +545,29 @@ predict.nn <- function(object, pred_data = NULL, pred_cmd = "",
   
   pfun <- function(model, pred, se, conf_lev) {
     pred_val <- try(sshhr(predict(model, pred)), silent = TRUE)
-
     if (!inherits(pred_val, "try-error")) {
-      pred_val %<>% as.data.frame(stringsAsFactors = FALSE) %>%
-        select(1) %>%
-        set_colnames("Prediction")
+      if (is.vector(pred_val)) {
+        pred_val <- data.frame(Prediction = pred_val, stringsAsFactors = FALSE)
+      } else if (is.matrix(pred_val) || is.array(pred_val)) {
+        pred_val <- as.data.frame(pred_val, stringsAsFactors = FALSE)
+        if (ncol(pred_val) > 0) {
+          if (ncol(pred_val) == 1) {
+            colnames(pred_val) <- "Prediction"
+          } else {
+            pred_val <- pred_val[, 1, drop = FALSE]
+            colnames(pred_val) <- "Prediction"
+          }
+        } else {
+          pred_val <- data.frame(Prediction = numeric(0))
+        }
+      } else {
+        pred_val <- as.data.frame(pred_val, stringsAsFactors = FALSE)
+        if (ncol(pred_val) > 0) {
+          pred_val <- pred_val[, 1, drop = FALSE]
+          colnames(pred_val) <- "Prediction"
+        }
+      }
     }
-
     pred_val
   }
   

radiant.model/R/svm.R

@@ -60,7 +60,7 @@ svm <- function(dataset, rvar, evar,
   
   # 标准化
   if ("standardize" %in% check) {
-    dataset <- scale_df(dataset)
+    dataset <- scale_sv(dataset)
   }
   
   ## ---- 3. 分类任务的响应变量 ----
@@ -135,7 +135,7 @@ svm <- function(dataset, rvar, evar,
 
 #' Center or standardize variables in a data frame
 #' @export
-scale_df <- function(dataset, center = TRUE, scale = TRUE,
+scale_sv <- function(dataset, center = TRUE, scale = TRUE,
                      sf = 2, wts = NULL, calc = TRUE) {
   isNum <- sapply(dataset, function(x) is.numeric(x))
   if (length(isNum) == 0 || sum(isNum) == 0) {

radiant.model/man/scale_df.Rd

 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/nn.R, R/svm.R
+% Please edit documentation in R/nn.R
 \name{scale_df}
 \alias{scale_df}
 \title{Center or standardize variables in a data frame}
 \usage{
-scale_df(dataset, center = TRUE, scale = TRUE, sf = 2, wts = NULL, calc = TRUE)
-
 scale_df(dataset, center = TRUE, scale = TRUE, sf = 2, wts = NULL, calc = TRUE)
 }
 \arguments{
@@ -25,7 +23,5 @@ scale_df(dataset, center = TRUE, scale = TRUE, sf = 2, wts = NULL, calc = TRUE)
 Scaled data frame
 }
 \description{
-Center or standardize variables in a data frame
-
 Center or standardize variables in a data frame
 }

radiant.model/man/scale_sv.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/svm.R
+\name{scale_sv}
+\alias{scale_sv}
+\title{Center or standardize variables in a data frame}
+\usage{
+scale_sv(dataset, center = TRUE, scale = TRUE, sf = 2, wts = NULL, calc = TRUE)
+}
+\description{
+Center or standardize variables in a data frame
+}