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

Question

I am rather new to R and really could need the help of the community with the following problem. I am trying to solve for the variable r in the following equation: (EPS2 + r*DPS1-EPS1)/r^2)-PRC . Here is my (unsuccessful) attempt on solving the problem (using the uniroot function):

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", ...

I am grateful for any tips and hints you guys could give me in regard to this problem. Or whether a different function/package would be better in this case.

Added a reprex (?) in case that helps anybody in helping me with this issue:

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

I don't think you can use uniroot if all coefficients are vectors rather than scalars. In this case, a straightforward approach is solving them in a math way, ie,

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

and

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

where r1 and r2 are two roots.

Answer 2

Disclaimer : I have no experience with uniroot() and have not idea if the following makes sense, but it runs! The idea was to basically call uniroot for each row of the data frame.

Note that I modified the function f1 slightly so each of the additional parameters has are to be passed as arguments of the function and do not rely on finding the objects with the same name in the parent environment. I also use with to avoid calling df$... for every variable.

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

^{Created on 2021-06-20 by the reprex package (v2.0.0)}