r - 将 R 中的多个表达式组合成一个大表达式

Question

我是 R 表达式处理的新手。我遇到了以下问题。感谢任何输入。

我正在尝试生成两个单独的方程式并将它们组合成一个表达式并将其传递给算法以找到最优值。

   OLD_PRICE    ELAST      Units    
 1  59.98        1.3        151     
 2  59.98        1.3        230     

代码:

for(i in 1:nrow(df)){
    o[i] = df$OLD_PRICE[i]
    el[i] = df$ELAST[i]
    u[i] = df$Units[i]
    assign(paste0("l",i),(substitute((x)*(1-(x-o)*el/o)*u,     list(o=o[i],el=el[i],u=u[i]))))
}

我能够生成以下两个方程

l1 = (x) * (1 - (x - 59.98) * 1.3/59.98) * 151
l2 = (x) * (1 - (x - 59.98) * 1.3/59.98) * 230

我的目标函数应该是这样的

eval_obj_f <- function(x){eval(l1)+eval(l2)}

我正在尝试弄清楚如何动态地执行此操作。就像如果我有一个包含 4 个观察值的不同数据集，我怎样才能动态生成如下所示的目标函数？

eval(l1)+eval(l2)+eval(l3)+eval(l4)

Answer 1

您需要使用真正的 R expression，目前这些不是表达式，而是 call。 (检查 is.expression 或 class)。我不喜欢数据帧的名称“df”，因为它也是一个函数名称，所以我使用了“prdat”:

 o <- el <- u <- numeric(2)  # if they don't exist, then the loop errors out
 for(i in 1:nrow(prdat)){
     o[i] = prdat$OLD_PRICE[i]
     el[i] = prdat$ELAST[i]
     u[i] = prdat$Units[i]
     assign(paste0("l",i), as.expression(substitute(x*(1-(x-o)*el/o)*u, 
                                                   list(o=o[i],el=el[i],u=u[i]))))
                        }

l1
#expression(x * (1 - (x - 59.98) * 1.3/59.98) * 151) # how expressions appear when printed.
l2
#expression(x * (1 - (x - 59.98) * 1.3/59.98) * 230)
exprlist <- list(l1,l2)

eval_obj_f <- function(x){sum( sapply( exprlist, eval, envir=list(x=x) ) )}
eval_obj_f(2)
#[1] 1719.569

这看起来很笨拙。我可能会在该数据帧上 apply 编辑一个函数并对结果求和。我想尝试“语言计算”方法可能会很有趣，但请看下面的代码，我认为它更符合“R 方式”。看起来更紧凑……更有表现力:

func <- function(x) {apply(prdat, 1, function(z) x*(1-
                                (x-z["OLD_PRICE"])*z["ELAST"]/z["OLD_PRICE"])*z["Units"] )}
> sum( func(x=2))
[1] 1719.569

这可能比仅使用您的代码更好(但仍然比第二种方法 IMO 笨重得多):

exprvec <- expression()
o <- el <- u <- numeric(2)  
 for(i in 1:nrow(prdat)){
     o[i] = prdat$OLD_PRICE[i]
     el[i] = prdat$ELAST[i]
     u[i] = prdat$Units[i]
     exprvec[[i]] <- substitute(x*(1-(x-o)*el/o)*u, 
                                list(o=o[i],el=el[i],u=u[i]))
                        }  #substitute-value gets coerced to mode-expression
# Test
> eval_obj_f <- function(x){sum( sapply( exprvec, eval, envir=list(x=x) ) )}
> eval_obj_f(2)
[1] 1719.569