我有一个看起来像这样的数据(几个观察结果)
df <- data.frame(age1 = c(10, 20, 30), age2 = c(20, 30, 40), age3 = c(30, 40, 50),
dia1 = c(15, 20, 25), dia2 = c(20, 25, 30), dia3 = c(25, 30, 35))
我想计算数据框中每一行的增长函数系数,并使用optim
中的R
函数。运行它需要一些时间,因此我尝试开发Rcpp
函数来做同样的事情
library(Rcpp)
cppFunction('
List
computeIndex(
const NumericVector dia1,
const NumericVector dia2,
const NumericVector dia3,
const NumericVector age1,
const NumericVector age2,
const NumericVector age3)
{
int n = dia1.size();
NumericVector coef1(n), coef2(n), coef3(n), age(n), d(n), f(n);
for(int i = 0; i < n; ++i)
{
age[i] = (age1[i], age2[i], age3[i]);
d[i] = (dia1[i], dia2[i], dia3[i]);
f[i] = function(param) sum((d[i] - (param[1] * exp(-param[2] * exp(-param[3] * age[i]))))^2);
coef1[i] = optim(c(0, 0, 0), f, method = "BFGS")$par[1];
coef2[i] = optim(c(0, 0, 0), f, method = "BFGS")$par[2];
coef3[i] = optim(c(0, 0, 0), f, method = "BFGS")$par[3];
}
return List::create(Named("coef1") = coef1,
Named("coef2") = coef2, Named("coef3") = coef3);
}
')
很遗憾不知道如何在optim
函数中使用R
中的Rcpp
。我阅读了有关问题的帖子,但不明白那里提出了解决方案,
有效的R
代码
library(dplyr)
df1 <- df %>% rowwise() %>%
do({
age <- c(.$age1, .$age2, .$age3)
d <- c(.$dia1, .$dia2, .$dia3)
f <- function(param) sum((d - (param[1] * exp(-param[2] * exp(-param[3] * age))))^2)
data.frame(., coef1 = optim(c(0, 0, 0), f, method = "BFGS")$par[1], coef2 = optim(c(0, 0, 0), f, method = "BFGS")$par[2],
coef3 = optim(c(0, 0, 0), f, method = "BFGS")$par[3])
} )
答案是
age1 age2 age3 dia1 dia2 dia3 coef1 coef2 coef3
* <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 10 20 30 15 20 25 45.46349 1.514253 0.03086497
2 20 30 40 20 25 30 41.02628 1.647884 0.04097674
3 30 40 50 25 30 35 45.13945 2.078568 0.04149476