在R公式中使用函数

Question

任何帮助，将不胜感激。 我正在优化对数正态分布的参数，以使估计比例与一组目标值（距离）匹配。 使用以下函数计算比例：

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)

}

和

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()
  }
}

我想优化的功能是：

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
}

使用Levenberg-Marquardt算法进行优化

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) 

从相同的数据文件中提取上，下和目标，例如

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

而odab和distance是任意长度的向量（通常比目标长得多，等等）。 当目标文件有150行，并且distances和odab具有大约500000值时，该过程运行良好。 但是，由于我无法理解的原因，当目标文件具有约16行时，is失败。 错误消息是：

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

这表明该函数未在公式中求值。 谁能提出解决方案或解释？ 重要的是要重新估计每个新亩和标准房的比例。

Answer 1

您可以尝试用I（）包围该函数，该函数将在评估公式之前按原样对其进行评估； 但是，由于我缺少某些引用的对象（a，b，odab，dist，expF，mu，sd），因此我无法使用提供的代码来复制您的问题，因此我无法确认这是否可行。 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)