#####first import all files in a single folder as a list #####
rastlist <- list.files(path = ".", pattern='.tif$', all.files=TRUE, full.names=FALSE)
######load them in a stack ######
allrasters <- stack(rastlist)
input_stack1 <- stack(brick(allrasters))
####### create array #######
try <- array(input_stack1, dim=c(13056, 4846, 2,1))
####### replace -3000 with NA #######
try[try==-3000]<-NA
input_array<-aperm(try, c(2,1,3,4))
####### convert back #######
output_stack1<-stack(brick(array(input_array, c(4846, 13056, 2))))
>input_stack1
class : RasterStack
dimensions : 4846, 13056, 63269376, 2 (nrow, ncol, ncell, nlayers)
**resolution : 250, 250 (x, y)**
extent : -1253475, 2010525, 2211480, 3422980 (xmin, xmax, ymin, ymax)
**crs : +proj=utm +zone=51 +datum=WGS84 +units=m +no_defs**
names : MOSAIC_TMP_2019001.hdfout.250m_16_days_NDVI, MOSAIC_TMP_2019017.hdfout.250m_16_days_NDVI
min values : -3000, -3000
max values : 9996, 9996
>output_stack1
class : RasterStack
dimensions : 4846, 13056, 63269376, 2 (nrow, ncol, ncell, nlayers)
**resolution : 7.659314e-05, 0.0002063558 (x, y)**
extent : 0, 1, 0, 1 (xmin, xmax, ymin, ymax)
**crs : NA**
names : layer.1, layer.2
min values : -2000, -2000
max values : 9996, 9996
don't know why the resolution and crs in output_stack1 change. Can everyone tell me how to remain the resolution and crs in input_stack1 after replace -3000 as NA in output_stack1
I am not sure why you are doing what you are doing, but it suggests that you may want to look at the manual of the raster package or study the materials here
With a list of filenames create a RasterStack
library(raster)
f <- system.file("external/rlogo.grd", package="raster")
rastlist <- rep(f, 3)
s <- stack(rastlist)
(do not call stack(brick()) after that; that does not do anything useful, but could take a lot of time.)
Now reclassify the RasterStack. In this example using 255 instead of -3000.
r <- reclassify(s, cbind(255, NA))
r
#class : RasterBrick
#dimensions : 77, 101, 7777, 9 (nrow, ncol, ncell, nlayers)
#resolution : 1, 1 (x, y)
#extent : 0, 101, 0, 77 (xmin, xmax, ymin, ymax)
#crs : +proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs
#source : memory
#names : red.1, green.1, blue.1, red.2, green.2, blue.2, red.3, green.3, blue.3
#min values : 0, 0, 0, 0, 0, 0, 0, 0, 0
#max values : 254, 254, 254, 254, 254, 254, 254, 254, 254
Related
I downloaded worldclimate data and changed it into raster data.
There are names like wc2.1_5m_bio_1 until 19, and I want to rename these variables to bio_1 (start = 10, stop = 16) using substr function. However, I dont know how to make it permanent on the raster data.
substr(clim#ptr[[“names”]], start = 10, stop = 16)
It gives what I want but not permanent. So everytime I reload the raster data, it still has the original long name.
You can get and set the names like this:
library(terra)
s <- rast(system.file("ex/logo.tif", package="terra"))[[1:2]]
names(s)
#[1] "red" "green"
names(s) <- substr(names(s), 1, 1)
names(s)
#[1] "r" "g"
(you should never directly use the #ptr slot)
To make this permanent you need to write the data to a new file:
writeRaster(s, "test.tif", overwrite=TRUE)
rast("test.tif")
#class : SpatRaster
#dimensions : 77, 101, 2 (nrow, ncol, nlyr)
#resolution : 1, 1 (x, y)
#extent : 0, 101, 0, 77 (xmin, xmax, ymin, ymax)
#coord. ref. : +proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs
#source : test.tif
#names : r, g
#min values : 0, 0
#max values : 255, 255
I have been having some strange error messages from the rasterFromXYZ function in the R raster package. Here is an example
library(raster)
xyz <- data.frame(x = c(5.463636, 5.481818, 5.5), y = c(51.42727, 51.42727, 51.42727), z = c(1.2,1.3,1.6))
r <- rasterFromXYZ(xyz)
##error
Error in if (nc > (2^31 - 1)) return(FALSE) :
missing value where TRUE/FALSE needed
In addition: Warning message:
In min(dy) : no non-missing arguments to min; returning Inf
##specifying the resolution as 1
r <- rasterFromXYZ(xyz, res = 1)
##different error
Error in rasterFromXYZ(xyz, res = 1) : x cell sizes are not regular
The x coordinates are perfectly regular. What am I doing wrong?
The x-coordinates are OK, but there is only one unique y-coordinate value. So there is no way to guess the vertical resolution.
xyz
# [,1] [,2] [,3]
#[1,] 5.463636 51.42727 1.2
#[2,] 5.481818 51.42727 1.3
#[3,] 5.500000 51.42727 1.6
If you set the resultion to 1 that does not match the x-coordinates, but you can do
rasterFromXYZ(xyz, res=c(NA, 1))
#class : RasterLayer
#dimensions : 1, 3, 3 (nrow, ncol, ncell)
#resolution : 0.018182, 1 (x, y)
#extent : 5.454545, 5.509091, 50.92727, 51.92727 (xmin, xmax, ymin, ymax)
#crs : NA
#source : memory
#names : layer
#values : 1.2, 1.6 (min, max)
The development version now gives a better error message:
r <- rasterFromXYZ(xyz)
#Error in rasterFromXYZ(xyz) : more than one unique y value needed
I have a problem with the "stackApply" function from the raster-package. First I want to stack three raster layers (each layer has one band) - that works. And then I want to create a raster-object that shows in which of the three bands/layers the minimum value occurs (each pixel in the raster layers has a different value). But I get various error messages. Does anyone have an idea how I can solve the problem?
Thank you
stacktest<-stack(test,test1,test2)
min_which <- stackApply(stacktest, indices=1, fun=function(x, na.rm=NULL)which.min(x))
Error in setValues(out, v) : values must be a vector
Error in is.infinite(v) : not implemented standard method for type 'list'
Here is a minimal, self-contained, reproducible example:
Example data from ?stackApply
library(raster)
r <- raster(ncol=10, nrow=10)
values(r) <- 1:ncell(r)
s <- stack(r,r,r,r,r,r)
s <- s * 1:6
Now use these data with your function (I removed the na.rm=NULL as it is not used)
w <- stackApply(s, indices=1, fun=function(x, ...) which.min(x) )
w
#class : RasterLayer
#dimensions : 10, 10, 100 (nrow, ncol, ncell)
#resolution : 36, 18 (x, y)
#extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#crs : +proj=longlat +datum=WGS84 +no_defs
#source : memory
#names : index_1
#values : 1, 1 (min, max)
Same for which.max
w <- stackApply(s, indices=1, fun=function(x, na.rm=NULL) which.max(x) )
w
# (...)
#values : 6, 6 (min, max)
This suggest it works fine. In most cases that means that you probably have cells that are NA
s[1:10] <- NA
w <- stackApply(s, indices=1, fun=function(x, ...) which.min(x) )
# Error in setValues(out, v) : values must be numeric, logical or factor
It is easy to see why this error occurs
which.min(3:1)
#[1] 3
which.min(c(3:1, NA))
#[1] 3
which.min(c(NA, NA, NA))
#integer(0)
If all values are NA, which.min does not return NA as expected. Instead it returns an empty vector. That can be fixed like this
which.min(c(NA, NA, NA))[1]
#[1] NA
And you can do
w <- stackApply(s, indices=1, fun=function(x, ...) which.min(x)[1] )
However, using stackApply with indices=1 is not a good approach. You should generally use calc to compute cell values across all layers.
y <- calc(s, function(x) which.min(x)[1])
But in this case you can use the more straightforward
z <- which.min(s)
Problem description (think of a membership with different prices for adults and kids):
I am having two data sets, one containing age and a code. A second dataframe "decodes" the codes to numeric values dependent someone is a kid or adult. I know want to match the codes in both data sets and receive a vector that contains numeric values for each customer in the data set.
I can make this work with standard R-functionalities, but since my original data contains several million observations I would like to speed up computation using the Rcpp package.
Unfortunately I do not succeed, especially how to perform the subsetting based on a logical vector as I would do it in R. I am quite new to Rcpp and have no experience with C++ so I am maybe missing some very basic point.
I attached a minimum working example for R and appreciate any kind of help or explanation!
library(Rcpp)
raw_data = data.frame(
age = c(10, 14, 99, 67, 87, 54, 12, 44, 22, 8),
iCode = c("code1", "code2", "code3", "code1", "code4", "code3", "code2", "code5", "code5", "code3"))
decoder = data.frame(
code = c("code1","code2","code3","code4","code5"),
kid = c(0,0,0,0,100),
adult = c(100,200,300,400,500))
#-------- R approach (works, but takes ages for my original data set)
calc_value = function(data, decoder){
y = nrow(data)
for (i in 1:nrow(data)){
position_in_decoder = (data$iCode[i] == decoder$code)
if (data$age[i] > 18){
y[i] = decoder$adult[position_in_decoder]
}else{
y[i] = decoder$kid[position_in_decoder]
}
}
return(y)
}
y = calc_value(raw_data, decoder)
#--------- RCPP approach (I cannot make this one work) :(
cppFunction(
'NumericVector calc_Rcpp(DataFrame df, DataFrame decoder) {
NumericVector age = df["age"];
CharacterVector iCode = df["iCode"];
CharacterVector code = decoder["code"];
NumericVector adult = decoder["adult"];
NumericVector kid = decoder["kid"];
const int n = age.size();
LogicalVector position;
NumericVector y(n);
for (int i=0; i < n; ++i) {
position = (iCode[i] == code);
if (age[i] > 18 ) y[i] = adult[position];
else y[i] = kid[position];
}
return y;
}')
There is no need to go for C++ here. Just use R properly:
raw_data = data.frame(
age = c(10, 14, 99, 67, 87, 54, 12, 44, 22, 8),
iCode = c("code1", "code2", "code3", "code1", "code4", "code3", "code2", "code5", "code5", "code3"))
decoder = data.frame(
code = c("code1","code2","code3","code4","code5"),
kid = c(0,0,0,0,100),
adult = c(100,200,300,400,500))
foo <- merge(raw_data, decoder, by.x = "iCode", by.y = "code")
foo$res <- ifelse(foo$age > 18, foo$adult, foo$kid)
foo
#> iCode age kid adult res
#> 1 code1 10 0 100 0
#> 2 code1 67 0 100 100
#> 3 code2 14 0 200 0
#> 4 code2 12 0 200 0
#> 5 code3 54 0 300 300
#> 6 code3 99 0 300 300
#> 7 code3 8 0 300 0
#> 8 code4 87 0 400 400
#> 9 code5 44 100 500 500
#> 10 code5 22 100 500 500
That should also work for large data sets.
I have the following two shapefiles:
> summary(precincts1)
Object of class SpatialPolygonsDataFrame
Coordinates:
min max
x -74.25545 -73.70002
y 40.49613 40.91540
Precinct Shape_Leng Shape_Area
Min. : 1.00 Min. : 17083 Min. : 15286897
1st Qu.: 31.50 1st Qu.: 29900 1st Qu.: 37593804
Median : 64.50 Median : 46887 Median : 65891025
Mean : 62.57 Mean : 65720 Mean :111231564
3rd Qu.: 95.50 3rd Qu.: 76375 3rd Qu.:133644443
Max. :123.00 Max. :309518 Max. :781725787
and
> summary(bnd_nhd)
Object of class SpatialPolygonsDataFrame
Coordinates:
min max
x 871512.3 912850.5
y 982994.4 1070956.9
SHAPE_area SHAPE_len
Min. : 3173813 Min. : 7879
1st Qu.: 9687122 1st Qu.:13514
Median :14363449 Median :17044
Mean :19674314 Mean :19516
3rd Qu.:27161251 3rd Qu.:23821
Max. :68101106 Max. :49269
Their coordinate systems are different. I can overlay the shapes for "precincts1" on the map with leaflet, but I cannot do the same with for "bnd_nhd". I am using shiny, maptools, and leaflet. How can I convert the shapefile or change the setting on the map so that I can overlay the map for "bnd_nhd"?
This should work:
library("rgdal")
library("leaflet")
bnd_nhd <- readOGR("C:/data/BND_Nhd88_cw.shp",
layer="BND_Nhd88_cw")
pol_wrd <- readOGR("C:/data/POL_WRD_2010_Prec.shp",
layer="POL_WRD_2010_Prec")
bnd_nhd4326 <- spTransform(bnd_nhd, CRS("+init=epsg:4326"))
pol_wrd4326 <- spTransform(pol_wrd, CRS("+init=epsg:4326"))
m <- leaflet() %>%
addTiles() %>%
addPolygons(data=bnd_nhd4326, weight=2, color="red", group="bnd_nhd") %>%
addPolygons(data=pol_wrd4326, weight=2, color="blue", group="pol_wrd") %>%
addLayersControl(
overlayGroups = c("bnd_nhd", "pol_wrd"),
options = layersControlOptions(collapsed = FALSE)
)
m