R ++在C ++中使用Rcpp包的optim函数

时间:2017-09-29 06:50:35

标签: c++ r rcpp

我有一个看起来像这样的数据(几个观察结果)

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

0 个答案:

没有答案