Skip to content

Commit 8d5dc9c

Browse files
Merge pull request #6 from wpgp/dev
Added a functions for working with raster files
2 parents e8fcc2a + a1627f9 commit 8d5dc9c

12 files changed

Lines changed: 876 additions & 1 deletion

DESCRIPTION

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: wpUtilities
22
Type: Package
33
Title: Data Analysis and Modeling Package from WorldPop
4-
Version: 0.1.0
4+
Version: 0.1.1
55
Author: Maksym Bondarenko <mb4@soton.ac.uk> and Chris Jochem <W.C.Jochem@soton.ac.uk>
66
Maintainer: The package maintainer Maksym Bondarenko <mb4@soton.ac.uk> and Chris Jochem <W.C.Jochem@soton.ac.uk>
77
Depends: R (>= 3.2.0), doParallel, raster, plyr, parallel

NAMESPACE

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,13 @@
11
# Generated by roxygen2: do not edit by hand
22

33
export(wpGetBlocksNeed)
4+
export(wpGetTotalNumberPx)
5+
export(wpGetValuesbyInds)
6+
export(wpGetindexesWhichValues)
47
export(wpProgressMessage)
58
export(wpRasterStackCalc)
69
export(wpRasterize)
10+
export(wpSetAllValuesTo)
11+
export(wpSetValueWhichindexes)
712
export(wpTimeDiff)
813
export(wpZonalStatistics)

R/wpGetIndexesWhichValues.R

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

R/wpGetTotalNumberPxl.R

Lines changed: 100 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,100 @@
1+
# Authors: Maksym Bondarenko mb4@soton.ac.uk
2+
# Date : March 2018
3+
# Version 0.1
4+
#
5+
#' wpGetTotalNumberPx get total number of not NA pixels
6+
#'
7+
#' @param x Raster* object
8+
#' @param cores Integer. Number of cores for parallel calculation
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 wpGetTotalNumberPx
15+
#' @return numerical
16+
#' @export
17+
#' @examples
18+
#' wpGetTotalNumberPx( x=raster("E:/asm_grid_100m_ccidadminl1.tif"), cores=4)
19+
wpGetTotalNumberPx <- function(r1,
20+
cores=NULL,
21+
minblocks=NULL,
22+
nl=1,
23+
silent=FALSE) {
24+
25+
tStart <- Sys.time()
26+
27+
# get real physical cores in a computer
28+
max.cores <- parallel:::detectCores(logical = TRUE)
29+
30+
if (is.null(cores)) {
31+
cores <- max.cores - 1
32+
}
33+
34+
if (is.null(minblocks)) {
35+
minblocks <- wpGetBlocksNeed(r1, cores=cores, n=nl)
36+
}
37+
38+
39+
40+
blocks <- blockSize(r1,minblocks=minblocks)
41+
nblocks <- blocks$n
42+
43+
cl <- makeCluster(cores)
44+
registerDoSNOW(cl)
45+
46+
clusterExport(cl, c("r1"), envir=environment())
47+
clusterExport(cl, "blocks", envir=environment())
48+
49+
50+
pb <- txtProgressBar(min = 1, max = blocks$n, style = 3, width = 80)
51+
progress <- function(n) {
52+
53+
ch.pb <- unlist(lapply(1:cores, function(i) {return(i*round(blocks$n/cores))}), use.names=FALSE)
54+
if (n %in% ch.pb & !silent) {
55+
setTxtProgressBar(pb, n)
56+
}else if(n==blocks$n & !silent){
57+
setTxtProgressBar(pb, n)
58+
}
59+
60+
}
61+
62+
opts <- list(progress = progress)
63+
64+
oper <- foreach(i=1: blocks$n , .combine='+', .packages=c('raster','dplyr'), .options.snow = opts) %dopar% {
65+
66+
67+
row_data_r1 <- getValues(r1, row=blocks$row[i], nrows=blocks$nrows[i])
68+
69+
70+
nncol <- ncol(r1)
71+
72+
if (i==1){
73+
start.df <- 1
74+
end.df <- blocks$nrows[i]*nncol
75+
}else{
76+
start.df <- nncol*blocks$row[i] - nncol + 1
77+
end.df <- (nncol*blocks$row[i] + blocks$nrows[i]*nncol) - nncol
78+
}
79+
80+
df <- data.frame(CellIndex = as.numeric(start.df:end.df) )
81+
df$r1 <- as.numeric(row_data_r1)
82+
83+
84+
nrow.df <- as.numeric(nrow(df[!is.na(df$r1),]))
85+
86+
87+
return(nrow.df)
88+
89+
}
90+
91+
stopCluster(cl)
92+
93+
close(pb)
94+
95+
tEnd <- Sys.time()
96+
97+
if (!silent) print(paste("Elapsed Processing Time. Calc total number pixel not NA::", wpTimeDiff(tStart,tEnd)))
98+
99+
return(oper)
100+
}

R/wpGetValuesbyInds.R

Lines changed: 116 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,116 @@
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

Comments
 (0)