时间戳

首页 > 解决方案 > 迭代地对每一行数据帧应用优化函数

r - 迭代地对每一行数据帧应用优化函数

问题描述

我有一个optim适用于单行的工作功能。

该optim函数通过最小化残差来估计化学数据中的矿物比例。

我想对数据框中的每一行应用相同的函数（实际上可能有大量的行）。

我试过使用 rowwise fromdplyr但它不正确。

数据：

理想矿物成分的数据框如下：

Min_comp <- tibble::tribble(
  ~SiO2, ~TiO2, ~Al2O3, ~Fe2O3, ~MnO, ~MgO, ~CaO, ~Na2O, ~K2O, ~P2O5, ~CO2,   ~S,
    100,     0,      0,      0,    0,    0,    0,     0,    0,     0,    0,    0,
   64.8,     0,   18.3,      0,    0,    0,    0,     0, 16.9,     0,    0,    0,
      0,     0,      0,      0,    0,    0, 54.7,     0,    0,  41.7,    0,    0,
      0,     0,      0, 103.45,    0,    0,    0,     0,    0,     0,    0,    0,
   51.4,     0,      0,   42.7,    0,    0,    0,   6.6,    0,     0,    0,    0,
      0,     0,      0,   17.9,    0, 10.1,   28,     0,    0,     0,    0,    0,
      0,     0,      0,   66.6,    0,    0,    0,     0,    0,     0,    0, 53.4
  )

矿物比例的初步估计

Min_Est <- tibble::tribble(
              ~Quartz, ~K.feldspar, ~Apatite, ~Magnetite, ~Riebeckite, ~Ankerite, ~Pyrite,
                 39.4,         4.3,        0,       25.4,         9.3,       4.9,       0
             )

实际化学成分：

Act_comp <- tibble::tribble(
              ~SiO2, ~TiO2, ~Al2O3, ~Fe2O3, ~MnO, ~MgO, ~CaO, ~Na2O, ~K2O, ~P2O5, ~CO2,   ~S, 
              46.91,  0.02,   0.88,   31.2, 0.05, 2.33, 0.73,  0.62, 0.61,  0.25,    0, 0.05
              )

待优化功能（单行工作）：

Mineral_Estimation_opt <- function(MinProp, par, Actual){

  return(sum(Actual-(colSums(as.matrix(MinProp/100*par[1:7]))))^2)
  
}

功能优化

# start parameters 

start <- c(40,5, 3, 30, 5, 1, 3) # estimate realistic parameters 
                                 # order of values qtz, k.feld, apatite, magnetite, riebeckite, ankerite, pyrite

result <- optim(par = start, fn = Mineral_Estimation_opt, MinProp = Min_comp, Actual = Act_comp,method = "L-BFGS-B", lower = c(0), upper = c(100), control = list(maxit = 1000))
 
result

上面的代码有效，现在是一个在 Act_comp 数据框中有不止一行数据的示例：

Act_comp_rows <- tibble::tribble(
   ~SiO2, ~TiO2, ~Al2O3, ~Fe2O3,  ~MnO,  ~MgO,  ~CaO, ~Na2O,  ~K2O, ~P2O5, ~CO2,    ~S,
  48.707, 0.027,  1.395,  27.81, 0.079, 3.577, 0.863, 0.297, 0.308,  0.15,   0L, 0.062,
  49.324, 0.018,  0.559,  30.98, 0.016, 2.115, 0.621, 0.567, 0.461,  0.31,   0L, 0.017,
  46.919, 0.021,  0.955,  31.35,  0.07, 2.688, 0.547, 0.566, 0.572, 0.303,   0L, 0.032
  )

我可以通过添加 rowSums 来获得数据帧每一行的数据残差：

Mineral_Estimation_opt <- function(MinProp, par, Actual){

  return(rowSums(Actual-(colSums(as.matrix(MinProp/100*par[1:7]))))^2)
  
}

result <- optim(par = start, fn = Mineral_Estimation_opt, MinProp = min_comp1, Actual = act_comp1,method = "L-BFGS-B", lower = c(0), upper = c(100), control = list(maxit = 1000))

但是，当尝试重新运行该optim函数时，它会返回错误

优化错误（par = start，fn = Mineral_Estimation_opt，MinProp = Min_comp，：优化中的目标函数评估为长度 3 而不是 1

由于它不按行计算。

为数据帧的每一行计算此函数的最佳方法是什么。

非常感谢

马特

标签： rloopsiterationvectorization

解决方案

您可以使用该函数purrr::map并遍历Min_comp.

results将是一个包含每行结果的列表。

results <- purrr::map(
        seq_len(nrow(Min_comp)),
           function(line_nb) {
                start <- c(40,5, 3, 30, 5, 1, 3)                        
                optim(par = start,
                      fn = Mineral_Estimation_opt,
                      MinProp = Min_comp,
                      Actual = Min_comp[line_nb,],
                      method = "L-BFGS-B",
                      lower = c(0),
                      upper = c(100),
                      control = list(maxit = 1000))})

该map函数作为一个循环工作，但同时它将每次迭代的输出收集为一个列表。

推荐阅读