在R公式中使用函数

Question

Any help with this would be greatly appreciated. I am optimising parameters of a lognormal distribution so that the proportion of estimates matches a set of target values (distances). The proportions are calculated using the following functions:

adj_sumifs <- function(sum_array, condition_array, f, m=1){
n <- length(condition_array)
sm = 0
if (n == length(condition_array)){
  fun <- function(x,i){if (f (condition_array[i])){sum_array[i] + x}else{x} }
  sm <- Reduce(fun,1:n,0)
} 
ifelse(m <= 0, sm , sm/m)

}

and

estimate.inrange <- function(vals,dist,lower,upper,total){
  n <- length(lower)
  if (n == length(upper)){
    sapply(1:n, function(i){ ifelse(i < n ,
                                adj_sumifs(vals,dist, (function(x) x >= lower[i] && x < upper[i]),total) ,
                                adj_sumifs(vals,dist, (function(x) x >= lower[i]) , total)
                             ) }
          )
  }else{
    # for a failure in the process
    as.numeric()
  }
}

And the function I would like to optimise is:

calculate_Det_ptns <- function(alpha, beta, pxa, low,up, distances, eF){
  temp <- numeric()
  if ( length(pxa) == length(distances) && length(low) == length(up) )
  {
    ln_values <- as.numeric(Map(function(pa,d) eF * pa * dlnorm(d, meanlog = alpha, sdlog = beta),pxa,distances))
    temp <- estimate.inrange (ln_values,distances,low,up, total = sum(ln_values))
  }
  temp
}

Optimisation is done using the Levenberg-Marquardt algorithm

lnVals <- nlsLM(target  ~ calculate_Det_ptns(alpha = a,beta = b, pxa = odab,low = low, up = up, distances = dist, eF = expF),
                          start = list(a = mu, b = sd ), 
                          trace = T) 

where up,low and target are extracted from the same data file, e,g,

low, up, target
1,2,0.1
2,3,0.4
3,4,0.6
4,5,0.6
5,6,0.9

while odab and distance are vectors of arbitrary lengths (usually much longer than target,etc). The process works well when the target file has anout 150 rows, and distances and odab have about 500000 values. However, for reasons I cannot fathom, is fails when the target file has about 16 rows. The error message is:

Error in model.frame.default(formula = ~target + odab + low + up + dist) : 
  variable lengths differ (found for 'odab')

which suggests that the function is not being evaluated in the formula. Can anyone suggest a solution or explanation? It is important that the proportions are re-estimated for every new mu and sd.

Answer 1

You could try surrounding the function with I(), which will evaluate it as is before evaluating the formula; however, I could not replicate your problem with the code provided because I am missing some of the referenced objects (a, b, odab, dist, expF, mu, sd) so I could not confirm whether or not this works. nVals <- nlsLM(target ~ I(calculate_Det_ptns(alpha = a,beta = b, pxa = odab,low = low, up = up, distances = dist, eF = expF)), start = list(a = mu, b = sd ), trace = T)