uniroot gives multiple answers to equation with 1 unknown

Question

I want to create a column in a data frame in which each row is the solution to an equation with 1 unknown (x). The other variables in the equation are provided in the other columns. In another Stack Overflow question, @flodel provided a solution, which I have tried to adapt. However, the output data frame omits some observations entirely, and others have "duplicates" with two different solutions to the same equation.

Sample of my data frame:

Time	id	V1	V2	V3	V4
199304	79330	259.721	224.5090	0.040140442	0.08100474
201004	77520	5062.200	3245.6921	0.037812662	0.08509553
196804	23018	202.897	842.6852	0.154956206	0.12982818
197804	12319	181.430	341.4415	0.052389156	0.14196588
199404	18542	14807.000	16537.0873	-0.001394388	0.08758791

Code with the equation I want to solve. I have simplified the equation, but the issue relates to this simple equation too.

library(plyr)
library(rootSolve
set.seed(1) 
df <- adply(df, 1, summarize,
      x = uniroot.all(function(x) V1 * ((V4-V3)/(x-V3)) - V2,
                             interval = c(-10,10)))

How can I achieve this? If possible, it would be great to do this in an efficient manner, as my actual data frame has >1,000,000 rows

Answer 1

The previous answer by @StefanoBarbi was pointing in the right direction.

Here are the plots of the functions implied by each row of your example data frame, with the solution superimposed as a red vertical line (so that we can see that yes, you're right that there is a root in the interval ...) [code below]

The problem is that the algorithm underlying uniroot() is only guaranteed to find the root of a function that is continuous on the interval. Your functions have discontinuities/singularities. (Even for a continuous function I'm sure that the algorithm could be broken with a function that was sufficiently weird to cause problems with floating-point math ...)

Even a bisection algorithm, which is more robust than Brent's method (the algorithm underlying uniroot) since it makes fewer assumptions about continuity of the derivative, could easily fail on this kind of discontinuous function. (It could be made to work for a function that is discontinuous but monotonic, but your example is neither continuous nor monotonic ...)

Obviously your real problem is more complex than this (or you would just be using easy analytical solution you referred to); what this means is that you need to find some way to "tame" your function. In this example, if you rearrange the function to avoid dividing by x-V3 (but without completely solving the equation) then uniroot() should work ...

---

f1 <- function(L) with(L, (V1/V2)*(V4-V3) + V3)
f1(df[1,])

png("badfit.png")
par(mfrow = c(2,3), bty = "l", las = 1)
for (i in 1:nrow(df)) {
  with(df[i,],
       curve(V1 * ((V4-V3)/(x-V3)) - V2,
             from = -10, to = 10,
             ylab = "", xlab = ""))
  abline(v=f1(df[i,]), col = 2)
  abline(h=0, col = 4)
}
dev.off()