|
| 1 | +# Authors: Maksym Bondarenko mb4@soton.ac.uk |
| 2 | +# Date : March 2018 |
| 3 | +# Version 0.1 |
| 4 | +# |
| 5 | +#' wpGetValuesbyInds get values of pixels by indexes |
| 6 | +#' |
| 7 | +#' @param x Raster* object |
| 8 | +#' @param v indexes of the pixels to be replace with value v |
| 9 | +#' @param tp Type of the data to be return. Numberic or |
| 10 | +#' @param cores Integer. Number of cores for parallel calculation |
| 11 | +#' @param minblocks Integer. Minimum number of blocks. If NULL then it will be calculated automaticly |
| 12 | +#' @param nl Integer. param to controle min number of blocks during paralisation |
| 13 | +#' @param silent If FALSE then the progress will be shown |
| 14 | +#' @rdname wpGetValuesbyInds |
| 15 | +#' @return raster |
| 16 | +#' @export |
| 17 | +#' @examples |
| 18 | +#' wpGetValuesbyInds( x=raster("E:/asm_grid_100m_ccidadminl1.tif"),v=1, cores=4) |
| 19 | +wpGetValuesbyInds <- function(x, |
| 20 | + v, |
| 21 | + tp='numeric', |
| 22 | + cores=NULL, |
| 23 | + minblocks=NULL, |
| 24 | + nl=1, |
| 25 | + silent=TRUE) { |
| 26 | + |
| 27 | + tStart <- Sys.time() |
| 28 | + |
| 29 | + # get real physical cores in a computer |
| 30 | + |
| 31 | + if (is.null(cores)) { |
| 32 | + max.cores <- parallel:::detectCores(logical = TRUE) |
| 33 | + cores <- max.cores - 1 |
| 34 | + } |
| 35 | + |
| 36 | + x.table <- data.table(CellIndex=integer(), value=numeric(), stringsAsFactors=FALSE) |
| 37 | + |
| 38 | + if (is.null(minblocks)) { |
| 39 | + minblocks <- wpGetBlocksNeed(x,cores,n=nl) |
| 40 | + } |
| 41 | + |
| 42 | + blocks <- blockSize(x,minblocks=minblocks) |
| 43 | + |
| 44 | + if (!silent) { |
| 45 | + cat(paste0('\nTotal blocks ',blocks$n)) |
| 46 | + cat('\n') |
| 47 | + } |
| 48 | + |
| 49 | + cl <- makeCluster(cores) |
| 50 | + registerDoSNOW(cl) |
| 51 | + |
| 52 | + clusterExport(cl, c("x", "v","x.table"), envir=environment()) |
| 53 | + clusterExport(cl, "blocks", envir=environment()) |
| 54 | + |
| 55 | + |
| 56 | + pb <- txtProgressBar(min = 1, max = blocks$n, style = 3, width = 80) |
| 57 | + progress <- function(n) { |
| 58 | + |
| 59 | + ch.pb <- unlist(lapply(1:cores, function(i) {return(i*round(blocks$n/cores))}), use.names=FALSE) |
| 60 | + if (n %in% ch.pb & !silent) { |
| 61 | + setTxtProgressBar(pb, n) |
| 62 | + }else if(n==blocks$n & !silent){ |
| 63 | + setTxtProgressBar(pb, n) |
| 64 | + } |
| 65 | + |
| 66 | + } |
| 67 | + opts <- list(progress = progress) |
| 68 | + |
| 69 | + |
| 70 | + oper <- foreach(i=1: blocks$n , |
| 71 | + .combine=rbind, |
| 72 | + .inorder=TRUE, |
| 73 | + .packages=c('raster','data.table'), |
| 74 | + .multicombine=TRUE, |
| 75 | + .options.snow = opts) %dopar% { |
| 76 | + |
| 77 | + |
| 78 | + x_row_data <- getValues(x, row=blocks$row[i], nrows=blocks$nrows[i]) |
| 79 | + |
| 80 | + nncol <- ncol(x) |
| 81 | + |
| 82 | + if (i==1){ |
| 83 | + start.df <- 1 |
| 84 | + end.df <- blocks$nrows[i]*nncol |
| 85 | + }else{ |
| 86 | + start.df <- nncol*blocks$row[i] - nncol + 1 |
| 87 | + end.df <- (nncol*blocks$row[i] + blocks$nrows[i]*nncol) - nncol |
| 88 | + } |
| 89 | + |
| 90 | + df <- data.table(CellIndex = as.numeric(start.df:end.df) ) |
| 91 | + df$value <- as.numeric(x_row_data) |
| 92 | + |
| 93 | + |
| 94 | + x.table <- df[df$CellIndex %in% v,] |
| 95 | + |
| 96 | + return(x.table) |
| 97 | + |
| 98 | + } |
| 99 | + stopCluster(cl) |
| 100 | + |
| 101 | + |
| 102 | + close(pb) |
| 103 | + |
| 104 | + tEnd <- Sys.time() |
| 105 | + |
| 106 | + if (!silent) print(paste("Elapsed Processing Time:", wpTimeDiff(tStart,tEnd))) |
| 107 | + |
| 108 | + setnames(oper, c("CellIndex", "value")) |
| 109 | + |
| 110 | + if (tp =='numeric'){ |
| 111 | + return(oper$value) |
| 112 | + }else{ |
| 113 | + return(oper) |
| 114 | + } |
| 115 | + |
| 116 | +} |
0 commit comments