R：求解变量（使用 uniroot 函数）

Question

我是 R 的新手，确实需要社区的帮助来解决以下问题。我正在尝试求解以下等式中的变量 r：(EPS2 + r*DPS1-EPS1)/r^2)-PRC。这是我（不成功）解决问题的尝试（使用 uniroot 函数）：

EPS2 = df_final$EPS2

DPS1 = df_final$DPS1

EPS1 = df_final$EPS1

PRC = df_final$PRC

f1 = function(r) {
    ((df_final_test$EPS2 + r * df_final_test$DPS1-df_final_test$EPS1)/r^2)-df_final_test$PRC 
}

uniroot(f1,interval = c(1e-8,100000),EPS2, DPS1, EPS1, PRC , extendInt="downX")$root

I then get the following error: Error in f(lower, ...) : unused arguments (c(" 1.39", " 1.39", ...

非常感谢你们就此问题给我的任何提示和提示。或者在这种情况下是否使用不同的 function/package 会更好。

添加了一个代表（？）以防有人帮助我解决这个问题：

df <- structure(list(EPS1 = c(6.53, 1.32, 1.39, 1.71, 2.13), DPS1 = c(2.53, 0.63,
0.81, 1.08, 1.33, 19.8), EPS2 = c(7.57,1.39,1.43,1.85,2.49), PRC = c(19.01,38.27,44.82,35.27,47.12)), .Names = c("EPS1", "DPS1", "EPS2", "PRC"), row.names = c(NA,
-5L), class = "data.frame")

Answer 1

如果所有系数都是向量而不是标量，我认为您不能使用 uniroot。在这种情况下，一种直接的方法是以数学方式解决它们，即

r1 <- (DPS1 + sqrt(DPS1^2-4*PRC*(EPS1-EPS2)))/(2*PRC)

和

r2 <- (DPS1 - sqrt(DPS1^2-4*PRC*(EPS1-EPS2)))/(2*PRC)

其中 r1 和 r2 是两个根。

Answer 2

免责声明：我没有使用 uniroot() 的经验，也不知道以下内容是否有意义，但它运行了！这个想法基本上是为数据框的每一行调用 uniroot。

请注意，我稍微修改了函数 f1，因此每个附加参数都必须作为函数的参数传递，而不依赖于在父环境中查找具有相同名称的对象。我还使用 with 来避免为每个变量调用 df$...。

library(tidyverse)
#> Warning: package 'ggplot2' was built under R version 4.1.0
library(furrr)
#> Loading required package: future


df <- structure(list(EPS1 = c(6.53, 1.32, 1.39, 1.71, 2.13),
                     DPS1 = c(2.53, 0.63, 0.81, 1.08, 1.33, 19.8),
                     EPS2 = c(7.57,1.39,1.43,1.85,2.49),
                     PRC = c(19.01,38.27,44.82,35.27,47.12)),
                .Names = c("EPS1", "DPS1", "EPS2", "PRC"),
                row.names = c(NA,-5L), class = "data.frame")
df
#> Warning in format.data.frame(if (omit) x[seq_len(n0), , drop = FALSE] else x, :
#> corrupt data frame: columns will be truncated or padded with NAs
#>   EPS1  DPS1 EPS2   PRC
#> 1 6.53  2.53 7.57 19.01
#> 2 1.32  0.63 1.39 38.27
#> 3 1.39  0.81 1.43 44.82
#> 4 1.71  1.08 1.85 35.27
#> 5 2.13  1.33 2.49 47.12

f1 = function(r, EPS2, DPS1, EPS1, PRC) {
  (( EPS2 + r *  DPS1 - EPS1)/r^2) - PRC 
}

# try for first row 
with(df, 
     uniroot(f1, 
             EPS2=EPS2[1], DPS1=DPS1[1], EPS1=EPS1[1], PRC=PRC[1],
             interval = c(1e-8,100000), 
             extendInt="downX")$root)
#> [1] 0.3097291
# it runs! 


# loop over each row
vec_sols <- rep(NA, nrow(df))
for (i in seq_along(1:nrow(df))) {
  
  sol <- with(df, uniroot(f1, 
                          EPS2=EPS2[i], DPS1=DPS1[i], EPS1=EPS1[i], PRC=PRC[i],
                          interval = c(1e-8,100000), 
                          extendInt="downX")$root)
  vec_sols[i] <- sol
}
vec_sols
#> [1] 0.30972906 0.05177443 0.04022946 0.08015686 0.10265226


# Alternatively, you can use furrr's future_map_dbl to use multiple cores.
# the following will basically do the same as the above loop. 
# here with 4 cores. 
plan(multisession, workers = 4)
vec_sols <- 1:nrow(df) %>% furrr::future_map_dbl(
  .f = ~with(df, 
             uniroot(f1, 
                     EPS2=EPS2[.x], DPS1=DPS1[.x], EPS1=EPS1[.x], PRC=PRC[.x],
                     interval = c(1e-8,100000), 
                     extendInt="downX")$root
  ))
vec_sols
#> [1] 0.30972906 0.05177443 0.04022946 0.08015686 0.10265226


# then apply the solutions back to the dataframe (each row to each solution)
df %>% mutate(
  root = vec_sols
)
#> Warning in format.data.frame(if (omit) x[seq_len(n0), , drop = FALSE] else x, :
#> corrupt data frame: columns will be truncated or padded with NAs
#>   EPS1  DPS1 EPS2   PRC       root
#> 1 6.53  2.53 7.57 19.01 0.30972906
#> 2 1.32  0.63 1.39 38.27 0.05177443
#> 3 1.39  0.81 1.43 44.82 0.04022946
#> 4 1.71  1.08 1.85 35.27 0.08015686
#> 5 2.13  1.33 2.49 47.12 0.10265226

^{由 reprex package (v2.0.0)}

于 2021-06-20 创建

R：求解变量（使用 uniroot 函数）

R: Solving for a variable (using the uniroot function)

r

equation-solving

nonlinear-equation

uniroot