带有簇的嵌套foreach

时间:2017-07-26 17:44:02

标签: r parallel-processing snow

我想要并行化我的代码。 R初始化集群,但它不会将工作分配给处理器。换句话说,我可以创建worker,但它不使用CPU容量。

给出了我的问题

我编辑完成表格

我需要运行来生成数据。

psim <- function(objects, vertices){
  if(vertices <= 2){
    stop("Insert a vertex number more than 2")
  }
  if(objects < 1){
    stop("Insert a valid objects number")
  }
  polygons <- NULL
  for(i in 1:objects) polygons[[i]] <- matrix(runif(vertices*2), ncol = 2)
  return(polygons)
}

出现问题的功能

更具体地说,在foreach

#parallel is used to decide to use parallelization or not.
pfreq <- function(polygons, parallel = F){
## Very fast ## 
  np <- length(polygons)
  nv <- nrow(polygons[[1]])

  polygons1 <- matrix(0,nrow = nv, ncol = np)
  polygons2 <- matrix(0,nrow = nv, ncol = np)
  for(temp in 1:np){
    polygons1[ ,temp] <- polygons[[temp]][,1]
    polygons2[ ,temp] <- polygons[[temp]][,2]
  }
  minX <- min(polygons1)
  maxX <- max(polygons1)
  minY <- min(polygons2)
  maxY <- max(polygons2)

  ratioX <- (maxX - minX)/np
  ratioY <- (maxY - minY)/np

  rectangles <- list()
  l <- 1
  for(j in 1:(np)){
    for(i in 1:(np)){
      rectangles[[l]] <- matrix(c(minX + (i-1)*ratioX, minY + (j-1)*ratioY, minX + (i-1)*ratioX, minY + j*ratioY,
                        minX + i*ratioX, minY + j*ratioY, minX + i*ratioX, minY + (j-1)*ratioY), ncol = 2, byrow = T)
      l <- l + 1
    }
  }
  polygons <- lapply(polygons, function(x) as(x, "gpc.poly"))
  rectangles <- lapply(rectangles, function(x) as(x, "gpc.poly"))
  polygons_area <- sapply(polygons, function(x) rgeos::area.poly(x))

  n_rectangles <- length(rectangles)
## Very slow ##
  if(parallel){
    cores <- getDoParWorkers()
    cl <- makeCluster(cores, type = "SOCK")
    registerDoSNOW(cl)

    frequency <- foreach(k = 1 : np, .combine = "cbind",
                         .packages = c("rgeos", "base")) %:%
      foreach(l = 1 : n_rectangles, .combine = 'c') %dopar% 
      (
        area.poly(intersect(polygons[[k]], rectangles[[l]]))/polygons_area[k]
      )
    stopCluster(cl)
  }
############################################################
  frequency <- matrix(0, ncol = n_rectangles, nrow = np)
  for(k in 1:np){
    for(l in 1:n_rectangles){
      frequency[i, j] <- area.poly(intersect(polygons[[k]], rectangles[[l]]))/polygons_area[k]
    }
  }

  frequency <- matrix(frequency, ncol = length(polygons), byrow = F) 
  frequency <- matrix(apply(frequency, 1, sum), ncol = length(polygons))
  relative_frequency_temp <- frequency/length(polygons)

  return(relative_frequency_temp)
}

test <- psim(50, 3)
pfreq(test, T)

感谢任何提示!

0 个答案:

没有答案
相关问题