hollorol/RBBGCMuso
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

update soilGrids

Browse Source
This commit is contained in:
Roland Hollós 2020-09-29 15:21:58 +02:00
parent ca11375ba9
commit 1100f94ae3
1 changed files with 30 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
RBBGCMuso/R/soilQuery.R
View File

@ -7,18 +7,13 @@
#' @importFrom glue glue #' @importFrom glue glue
#' @importFrom httr config with_config GET content #' @importFrom httr config with_config GET content
getSoilDataFull <- function(lat, lon, apiURL, port) { getSoilDataFull <- function(lat, lon, apiURL) {
if(missing(apiURL)){ if(missing(apiURL)){
apiURL <- "https://81.169.232.36" apiURL <- "https://81.169.232.36"
} }
if(missing(port)){ apiString <- glue("{apiURL}/query?lon={lon}&lat={lat}")
port <- "" soilREST <- #with_config(config(ssl_verifypeer=0L, ssl_verifyhost=0L),
} else{ GET(apiString) # ) # This is temporary solution ssl_verification wont bypass
port = glue(":{port}")
}
apiString <- glue("{apiURL}{port}/query?lon={lon}&lat={lat}")
soilREST <- with_config(config(ssl_verifypeer=0L, ssl_verifyhost=0L),
GET(apiString)) # This is temporary solution ssl_verification wont bypass
content(soilREST) content(soilREST)
} }
@ -36,31 +31,43 @@ getSoilDataFull <- function(lat, lon, apiURL, port) {
createSoilFile <- function(lat,lon, createSoilFile <- function(lat,lon,
outputFile="recent.soi", outputFile="recent.soi",
method="constant",apiURL, method="constant",apiURL,
apiPort,template=system.file("examples/hhs/hhs.soi",package="RBBGCMuso")) { template=system.file("examples/hhs/hhs.soi",package="RBBGCMuso")) {
if(missing(apiURL)){ if(missing(apiURL)){
apiURL <- "https://rest.soilgrids.org/soilgrids/v2.0/properties" apiURL <- "https://rest.soilgrids.org/soilgrids/v2.0/properties"
} }
if(missing(apiPort)){
apiPort <- ""
}
outFile <- suppressWarnings(readLines(template)) outFile <- suppressWarnings(readLines(template))
outFile[1] <- sprintf("SOILPROP FILE - lat: %s, lon: %s, created in: %s",lat,lon,date()) outFile[1] <- sprintf("SOILPROP FILE - lat: %s, lon: %s, created in: %s",lat,lon,date())
musoCenters <- c(1.5,6.5,20.0,45.0,75.0,105.0,135.0,175.0,300.0,700.0) musoCenters <- c(1.5,6.5,20.0,45.0,75.0,105.0,135.0,175.0,300.0,700.0)
soilGridDepths <- c(0,5,15,30,60,100,200) # soilGridDepths <- c(0,5,15,30,60,100,200)
rest<- getSoilDataFull(lat,lon, apiURL, apiPort) soilGridDepths <- c(2.5, 10, 22.5, 45, 80, 150)
if(rest$properties$soilmask=="nodata"){ Reduce(function(x,y){(y-x)/2+x},soilGridDepths,accumulate=TRUE)
stop("There is no data for the given coordinates"); rest<- getSoilDataFull(lat,lon, apiURL)
}
createMusoLayers <- function(values,depths=soilGridDepths,centers=musoCenters,intMethod=method){ createMusoLayers <- function(values,depths=soilGridDepths,centers=musoCenters,intMethod=method){
approx(x=depths,y=values, xout = centers, method=intMethod,rule=2)$y %>% approx(x=depths,y=values, xout = centers, method=intMethod,rule=2)$y %>%
paste(.,collapse="\t") %>% paste0(.," ") paste(.,collapse="\t") %>% paste0(.," ")
} }
soilDepth <- unlist(rest$properties$BDRICM$M)/100
outFile[42] <- sub("([0-9.]*\\s+){1}",paste0(soilDepth," "),outFile[42], outFile[42]) soilDepth <- tryCatch(getMeanSoil(rest,"bdod")/100,error=function(e){stop("There is no data for the given coordinates")})
outFile[48] <- sub("([0-9.]*\\s+){10}",createMusoLayers(unlist(rest$properties$SNDPPT$M)),outFile[48]) outFile[47] <- sprintf("%s (m) soil depth",paste(soilDepth,collapse="\t"))
outFile[49] <- sub("([0-9.]*\\s+){10}",createMusoLayers(unlist(rest$properties$SLTPPT$M)),outFile[49]) outFile[55] <- sprintf("%s (%%) percentage of sand by volume in rock free soil",
outFile[50] <- sub("([0-9.]*\\s+){10}",createMusoLayers(unlist(rest$properties$PHIHOX$M)/10),outFile[50]) paste(createMusoLayers(getMeanSoil(rest,"sand")/10), collapse="\t"))
outFile[56] <- sprintf("%s (%%) percentage of silt by volume in rock free soil",
paste(createMusoLayers(getMeanSoil(rest,"silt")/10), collapse="\t"))
outFile[57] <- sprintf("%s (dimless) soil PH",
paste(createMusoLayers(getMeanSoil(rest,"phh2o")/10), collapse="\t"))
writeLines(outFile,outputFile) writeLines(outFile,outputFile)
} }
# createSoilFile(60,50) # createSoilFile(60,50)
getMeanSoil <- function(rest, name){
sapply(
rest$properties$layers[sapply(rest$properties$layers,function(x){
x$name == name
})][[1]]$depths,
function(s){
s$values$mean
}
)
}