加速从R中的网格创建三角形列表的功能

时间:2017-11-30 11:38:06

标签: r performance function

我在R中编写了一个函数mesh2listri(),它接受一个kxm矩阵和一个tringulation结构矩阵,并返回一个列表,其中每个元素是一个定义三角形的3xm矩阵。我真的想加快这个功能。但是,我无法弄清楚如何避免for循环。在此先感谢您的帮助。下面是一个完全可重复的例子。

mesh2listri <- function(mat, tri) {
  if (ncol(tri) > 3) {
    tri <- t(tri)
  }
  res <- NULL
  for (i in 1:nrow(tri)) {
    resi <- mat[tri[i, ], ]
    res <- c(res, list(resi))
    print(i)
  }
  res
}

mat <- matrix(rnorm(90000, 0, 1), ncol = 3)
tri <- matrix(sample(1:30000, replace = TRUE), ncol = 3)
system.time(mesh2listri(mat, tri))

3 个答案:

答案 0 :(得分:2)

快一点。

mesh2listri_byMinem <- function(mat, tri) {
  if (ncol(tri) > 3) tri <- t(tri)
  n <- nrow(tri)
  l <- vector(mode = "list", length = n)
  for (i in 1:n) {
    resi <- mat[tri[i, ], ]
    l[[i]] <- resi
  }
  l
}

# create larger data:
mat <- matrix(rnorm(6e6, 0, 1), ncol = 3)
tri <- matrix(sample(3e5, replace = T), ncol = 3)

b <- microbenchmark::microbenchmark(
  rez1 <- mesh2listri_new(mat, tri),
  rez2 <- mesh2listri_byMinem(mat, tri), times = 10, unit = "s"
)
options(digits = 2)
b
# Unit: seconds
#                                  expr   min   lq mean median   uq  max neval cld
#     rez1 <- mesh2listri_new(mat, tri) 0.630 0.85 0.94   0.85 0.92 1.86    10   b
# rez2 <- mesh2listri_byMinem(mat, tri) 0.092 0.10 0.11   0.10 0.10 0.15    10  a 

答案 1 :(得分:2)

只需使用:

mesh2listri <- function(mat, tri) {
  if (ncol(tri) > 3) tri <- t(tri)
  lapply(seq_len(nrow(tri)), function(i) mat[tri[i, ], ])
}

代码中的问题是你在每一步都在增长一个新的向量。

答案 2 :(得分:1)

这似乎更快:

mesh2listri_lap<-function(mat,tri){
if(ncol(tri)>3){tri<-t(tri)}
res <- apply(tri, 1, function(x) mat[x,])
lapply(as.data.frame(res), function(x) matrix(x, nrow = 3, ncol = ncol(tri)))
}

三个答案的新微基准:

mat <- matrix(rnorm(6e6, 0, 1), ncol = 3)
tri <- matrix(sample(3e5, replace = T), ncol = 3)

b <- microbenchmark::microbenchmark(
  rez1 <- mesh2listri_lap(mat, tri),
  rez2 <- mesh2listri_minem(mat, tri), 
  rez3 <- mesh2listri_prive(mat, tri),times = 10, unit = "s"
)
options(digits = 2)
b

> b
Unit: seconds
                                expr  min   lq mean median   uq  max neval cld
   rez1 <- mesh2listri_lap(mat, tri) 0.93 1.06 1.28   1.24 1.42 1.77    10   b
 rez2 <- mesh2listri_minem(mat, tri) 0.15 0.20 0.40   0.22 0.76 0.83    10  a 
 rez3 <- mesh2listri_prive(mat, tri) 0.22 0.29 0.31   0.30 0.35 0.45    10  a 

干得好@minem和@F。 Privé的!