我想在函数中提供数据和变量名称。这是因为用户可能会提供相同变量具有不同名称的数据集。以下是引发错误的可重现示例。请参考相关资源来解决此问题。
\n另外，请让我知道编写此类函数的最佳实践是什么？在文档中，我应该要求用户重命名其列还是提供仅包含所需列的数据集？
\nlibrary(dplyr)\n#> \n#> Attaching package: \'dplyr\'\n#> The following objects are masked from \'package:stats\':\n#> \n#> filter, lag\n#> The following objects are masked from \'package:base\':\n#> \n#> intersect, setdiff, setequal, union\n\ndataset1 <- mtcars %>%\n select(mpg, disp, wt)\n\ndataset2 <- mtcars %>%\n select(miles_per_gallon = mpg, displacement_cu_in = disp, weight = wt)\n \n\n\nmy_func <- function(data, var_mileage, var_volume, var_weight){\n \n var_mileage_km_l <- 0.43 * data$var_mileage\n var_volume_l <- 0.016 * data$var_volume\n var_weight_kg <- 0.45 * data$var_weight\n \n m <- lm(var_mileage_km_l ~ var_volume_l + var_weight_kg)\n \n summary(m)\n}\n\n\nmy_func(dataset1, mpg, disp, wt)\n#> Error in lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...): 0 (non-NA) cases\n由reprex 包于 2021 年 4 月 12 日创建(v1.0.0)
\n我希望该函数创建以下输出，无论用户是否提供dataset1或dataset2具有相应的变量名称。
Call:\nlm(formula = var_mileage_km_l ~ var_volume_l + var_weight_kg)\n\nResiduals:\n Min 1Q Median 3Q Max \n-1.4657 -0.9994 -0.3304 0.7620 2.7298 \n\nCoefficients:\n Estimate Std. Error t value Pr(>|t|) \n(Intercept) 15.0330 0.9308 16.151 4.91e-16 ***\nvar_volume_l -0.4764 0.2470 -1.929 0.06362 . \nvar_weight_kg -3.2019 1.1124 -2.878 0.00743 ** \n---\nSignif. codes: \n0 \xe2\x80\x98***\xe2\x80\x99 0.001 \xe2\x80\x98**\xe2\x80\x99 0.01 \xe2\x80\x98*\xe2\x80\x99 0.05 \xe2\x80\x98.\xe2\x80\x99 0.1 \xe2\x80\x98 \xe2\x80\x99 1\n\nResidual standard error: 1.254 on 29 degrees of freedom\nMultiple R-squared: 0.7809, Adjusted R-squared: 0.7658 \nF-statistic: 51.69 on 2 and 29 DF, p-value: 2.744e-10\n我知道上述可以通过{{var}}在数据框上下文中使用来完成。但正如你所看到的，我不想在数据框中进行计算。这只是一个例子，我的真正问题无法在数据框中解决。
以下是我原来的功能。在函数体内，你可以看到我使用了data$几次。如果用户没有与我在这里使用的列名称相同的列名称，则该函数将无法工作。这就是为什么我要求提供变量名称（列名称）以及参数data。
apply_wiedemann <- function(data,\n V_DESIRED,\n FAKTORVmult,\n BMAXmult,\n BNULLmult,\n AXadd,\n BXadd,\n angular_vel_threshold,\n EXadd,\n OPDVadd\n){\n \n \n \n ## Parameters --------------------------------------------------------------------\n V_MAX <- 44\n \n L <- na.omit(unique(data$LV_length_m))\n W <- na.omit(unique(data$LV_width_m))\n \n angular_vel_threshold <- angular_vel_threshold\n CX = sqrt(W / angular_vel_threshold)\n \n BMIN = -8\n AX = L + AXadd \n \n \n ## Time--------------------------------------------------------------------------\n delta_T <- (data$frames[2] - data$frames[1])/60\n last_time <- (nrow(data) - 1) * delta_T\n Time <- seq(from = 0, to = last_time, by = delta_T)\n \n \n \n \n ## Empty vectors\n BMAX <- rep(NA_real_, times = length(Time)) ### an empty vector \n vn_complete <- rep(NA_real_, times = length(Time))\n vn_complete[1] <- data$ED_speed_mps[1]\n \n vn1_complete <- data$LV_speed_mps\n dv <- rep(NA_real_, times = length(Time))\n dv[1] <- data$LV_DV_mps[1]\n \n \n xn_complete <- rep(NA_real_, times = length(Time))\n xn_complete[1] <- data$ED_position_m[1]\n \n \n xn1_complete <- data$LV_position_m\n \n \n bn_complete <-rep(NA_real_, times = length(Time))\n \n sn_complete <- rep(NA_real_, times = length(Time))\n sn_complete[1] <- data$LV_spacing_m[1]\n \n \n \n BX <- rep(NA_real_, times = length(Time)) ### an empty vector \n ABX <- rep(NA_real_, times = length(Time)) ### an empty vector \n \n SDV <- rep(NA_real_, times = length(Time)) ### an empty vector \n B_App <- rep(NA_real_, times = length(Time)) ### an empty vector \n \n bl <- data$LV_acc_mps2\n \n B_Emg <- rep(NA_real_, times = length(Time))\n \n SDX <- rep(NA_real_, times = length(Time))\n \n CLDV <- rep(NA_real_, times = length(Time))\n \n OPDV <- rep(NA_real_, times = length(Time))\n \n cf_state_sim <- rep(NA_character_, times = length(Time))\n \n \n \n ## Unintentional Acceleration and Deceleration when the car is at V_DESIRED\n # BNULL = BNULLmult * (RND4 + NRND) \n BNULL = BNULLmult \n \n \n FaktorV = V_MAX / (V_DESIRED + FAKTORVmult * (V_MAX - V_DESIRED))\n \n \n # EX = EXadd + EXmult * (NRND - RND2)\n EX = EXadd\n \n \n for (t in 1:(length(Time)-1)) { \n \n ## Speed-dependent part of Minimum following distance\n # BX = (BXadd + (BXmult * RND1)) * sqrt(v)\n BX[t] = BXadd * sqrt(min(c(vn_complete[t], vn1_complete[t]), na.rm = TRUE)) ###0.8 | 0.886\n \n ## Minimum following distance\n ABX[t] = AX + BX[t] ### 16.91 | 16.996\n \n \n ## Speed-difference at which driver perceives that the lead vehicle is slow\n SDV[t] = ((sn_complete[t] - AX)/CX)^2 ###0.34 |\n \n \n ## Maximum following distance\n SDX[t] = AX + (EX * BX[t])\n \n \n ## Speed-difference when driver perceives that lead vehicle is slower\n CLDV[t] = SDV[t] * EX^2\n \n \n ## Speed-difference when driver perceives that lead vehicle is faster\n # OPDV = CLDV * (((-1) * OPDVadd) - (OPDVmult * NRND))\n OPDV[t] = CLDV[t] * ((-1) * OPDVadd)\n \n \n \n if (is.na(sn_complete[t]) | is.na(dv[t])) {\n \n BMAX[t] <- BMAXmult * (V_MAX - (vn_complete[t] * FaktorV)) \n \n bn_complete[t] <- BMAX[t]\n \n cf_state_sim[t] <- "free_driving" \n \n } else if (sn_complete[t] <= ABX[t]) {\n \n B_Emg[t] = 0.5 * ((dv[t])^2 / (AX - sn_complete[t])) + bl[t] + \n (BMIN * ((ABX[t] - sn_complete[t]) / (ABX[t] - AX)))\n \n bn_complete[t] <- ifelse(B_Emg[t] < BMIN | B_Emg[t] > 0, BMIN, B_Emg[t])\n \n cf_state_sim[t] <- "emergency_braking"\n \n } else if (sn_complete[t] < SDX[t]) {\n \n if ( dv[t] > CLDV[t]) {\n \n bn_complete[t] <- BNULL\n \n cf_state_sim[t] <- "following"\n \n } else if (dv[t] > OPDV[t]) {\n \n bn_complete[t] <- BNULL\n \n cf_state_sim[t] <- "following"\n \n } else {\n \n BMAX[t] <- BMAXmult * (V_MAX - (vn_complete[t] * FaktorV)) \n \n bn_complete[t] <- BMAX[t]\n \n cf_state_sim[t] <- "free_driving"\n \n }\n \n } else {\n \n if (dv[t] > SDV[t]) { \n \n B_App[t] = 0.5 * ((dv[t])^2 / (ABX[t] - sn_complete[t])) + bl[t]\n \n bn_complete[t] <- ifelse(B_App[t] < BMIN, BMIN, B_App[t])\n \n cf_state_sim[t] <- "approaching"\n \n } else {\n \n BMAX[t] <- BMAXmult * (V_MAX - (vn_complete[t] * FaktorV)) ###2.19\n \n bn_complete[t] <- BMAX[t]\n \n cf_state_sim[t] <- "free_driving"\n \n }\n }\n \n vn_complete[t+1] <- vn_complete[t] + (bn_complete[t] * delta_T)\n \n vn_complete[t+1] <- ifelse(vn_complete[t+1] < 0, 0, vn_complete[t+1])\n \n xn_complete[t+1] <- xn_complete[t] - (vn_complete[t] * delta_T) + (0.5 * bn_complete[t] * (delta_T)^2)\n \n sn_complete[t+1] <- xn_complete[t+1] - xn1_complete[t+1]\n \n dv[t+1] <- vn_complete[t+1] - vn1_complete[t+1]\n \n\n \n \n }\n \n frspacing_pred <- sn_complete - L\n \n \n SSE <- sum(((frspacing_pred - data$LV_frspacing_m)^2)/ abs(data$LV_frspacing_m), na.rm = TRUE)/sum(abs(data$LV_frspacing_m), na.rm = TRUE)\n \n return(SSE)\n}\n希望现在每个人都清楚这个问题无法在数据框上下文中解决。感谢@MrFlick，我知道现在该做什么了。我也尝试过enquoand data %>% pull(!! var_name)，它似乎做了什么eval(substitute())。
这看起来是一种非常不寻常的编写 R 函数的方法，但你可以这样做
my_func <- function(data, var_mileage, var_volume, var_weight){
eval(substitute({
var_mileage_km_l <- 0.43 * var_mileage
var_volume_l <- 0.016 * var_volume
var_weight_kg <- 0.45 * var_weight
m <- lm(var_mileage_km_l ~ var_volume_l + var_weight_kg)
summary(m)
}), envir = data)
}
将substitute()您作为列名传递的符号注入到表达式中。然后您可以在 data.frame 的上下文中对其进行评估。
或者你可以做类似的事情
my_func <- function(data, var_mileage, var_volume, var_weight){
var_mileage <- eval(substitute(var_mileage), data)
var_volume <- eval(substitute(var_volume), data)
var_weight <- eval(substitute(var_weight), data)
var_mileage_km_l <- 0.43 * var_mileage
var_volume_l <- 0.016 * var_volume
var_weight_kg <- 0.45 * var_weight
m <- lm(var_mileage_km_l ~ var_volume_l + var_weight_kg)
summary(m)
}
或者另一种常见技巧是将列名称转换为字符串。
my_func <- function(data, var_mileage, var_volume, var_weight){
var_mileage_km_l <- 0.43 * data[[var_mileage]]
var_volume_l <- 0.016 * data[[var_volume]]
var_weight_kg <- 0.45 * data[[var_weight]]
m <- lm(var_mileage_km_l ~ var_volume_l + var_weight_kg)
summary(m)
}
my_func(dataset1, "mpg", "disp", "wt")