Commit 6428476b authored by Franssen, Wietse's avatar Franssen, Wietse
Browse files

Some Simple additions

parent ab8933bc
Package: WF_rToolbox
Package: WFRTools
Type: Package
Title: What the package does (short line)
Title: Some usefull R-Functions
Version: 1.0
Date: 2015-02-16
Author: Who wrote it
Maintainer: Who to complain to <yourfault@somewhere.net>
Description: More about what it does (maybe more than one line)
License: What license is it under?
Author: Wietse Franssen
Maintainer: Wietse Franssen <wietse.franssen@wur.nl>
Depends: R (>= 3.0.0), ncdf4, fields
Description: Some usefull R-Functions
License: GPL
exportPattern("^[[:alpha:]]+")
# Generated by roxygen2 (4.1.0): do not edit by hand
export(ncLoad)
export(ncPlot)
\ No newline at end of file
#' blabla a test primt message
#'
#' @param none (yet)
#' @details The function
#' @return blabla
#' @author Wietse Franssen \email{wietse.franssen@@wur.nl}
#' @export
#' @argument title
#' @keywords internal
plotje <-function(data, title = " ") {
image.plot(data$xyCoords$x,data$xyCoords$y,data$Data[,,1], asp = 1, main = title, xlab = '', ylab = '')
world(add = TRUE)
}
#' Shows a test primt message
#'
#' @param none (yet)
#' @details The function
#' @return blabla
#' @author Wietse Franssen \email{wietse.franssen@wur.nl}
#' @export
#' @keywords internal
ncPlot <-function(file) {
data<-ncLoad(file)
plotje(data, title = paste0(data$Variable$varName, " (" ,data$Dates$start[1], ")"))
return(data)
}
#' Shows a test primt message
#'
#' @param none (yet)
#' @details The function
#' @return blabla
#' @author Wietse Franssen \email{wietse.franssen@wur.nl}
#' @export
#' @keywords internal
rDataStructure <-function() {
rData<-NULL
rData$Variable$varName<-NA
rData$Data<-NA
rData$xyCoords$x<-NA
rData$xyCoords$y<-NA
rData$Dates$start<-NA
rData$Dates$end<-NA
return(rData)
}
ncLoad <-function(file, varName = "pr") {
#dat<-ncLoad(file = "~/Desktop/gg/wfd_pr_1974.nc" )
data<-rDataStructure()
ncFile <- nc_open( file )
data$xyCoords$x <- ncFile$dim$lon$vals
data$xyCoords$y <- ncFile$dim$lat$vals
NCtime <- ncvar_get( ncFile, "time" )
NCtimeAtt <- ncatt_get( ncFile, "time", "units" )$value
firstTime<-unlist(strsplit(NCtimeAtt, split=' ', fixed=TRUE))[3]
firstTime<-strptime(firstTime, format = "%Y-%m-%d", tz = "GMT")
data$Dates$start <- format(firstTime + (86400 * (NCtime+0)), format="%Y-%m-%d %T %Z")
data$Dates$end <- format(firstTime + (86400 * (NCtime+1)), format="%Y-%m-%d %T %Z")
data$Data <- ncvar_get( ncFile, varName )
attr(data$Data,"dimensions") <- c("time","lat","lon")
data$Variable$varName <-varName
nc_close(ncFile)
return(data)
}
# rm(list=ls())
# library(ncdf4)
# library(fields) # e.g: using the fields library
#
# plotje <-function(plottitle) {
# image.plot(NClon,NClat,data, asp = 1, main = plottitle, xlab = '', ylab = '')
# world(add = TRUE)
# }
#
# domainName<-c( "GHA", "EU")
# lonmin<- c( 27.75, -24.75)
# lonmax<- c( 49.25, 39.75)
# latmin<- c(-12.25, 33.25)
# latmax<- c( 18.25, 71.75)
#
# iDomain<-1
#
# ## READ WFD NETCDF
# ncFile <- nc_open( "~/Desktop/gg/wfd_pr_1974.nc" )
# LonIdx <- which( ncFile$dim$lon$vals > lonmin[iDomain] | ncFile$dim$lon$vals < lonmax[iDomain])
# LatIdx <- which( ncFile$dim$lat$vals > latmin[iDomain] & ncFile$dim$lat$vals < latmax[iDomain])
# data <- ncvar_get( ncFile, "pr")[ LonIdx, LatIdx, 1]
# landmask<-data
# landmask[!is.na(landmask)] <- 1
# sum( !is.na( landmask ) )
# nc_close(ncFile)
#
# ## READ WFDEI NETCDF
# ncFile <- nc_open( "~/Desktop/gg/wfd_pr_1979.nc" )
# LonIdx <- which( ncFile$dim$lon$vals > lonmin[iDomain] | ncFile$dim$lon$vals < lonmax[iDomain])
# LatIdx <- which( ncFile$dim$lat$vals > latmin[iDomain] & ncFile$dim$lat$vals < latmax[iDomain])
# data <- ncvar_get( ncFile, "pr")[ LonIdx, LatIdx, 1]
# landmask[is.na(data)] <- NA
# sum( !is.na( landmask ) )
# nc_close(ncFile)
#
# ## READ SOIL NETCDF
# ncFile <- nc_open( "~/Desktop/gg/soil_GHA.nc" )
# LonIdx <- which( ncFile$dim$lon$vals > lonmin[iDomain] | ncFile$dim$lon$vals < lonmax[iDomain])
# LatIdx <- which( ncFile$dim$lat$vals > latmin[iDomain] & ncFile$dim$lat$vals < latmax[iDomain])
# data <- ncvar_get( ncFile, "stexture")[ LonIdx, LatIdx]
# landmask<-data
# landmask[!is.na(landmask)] <- 1
#
# landmask[is.na(data)] <- NA
# sum( !is.na( landmask ) )
# nc_close(ncFile)
#
# ## READ SOIL NETCDF
# nameFileNCin<-"~/Desktop/gg/soil_GHA.nc"
# ncid_in=nc_open(nameFileNCin)
# NCdata <- ncvar_get( ncid_in, "stexture")
# nc_close(ncid_in)
#
# ## Plot and add to LandMask
# data<-NCdata[,];plotje(plottitle = "WFDEI")
# landmask[is.na(data)] <- NA
# sum( !is.na( landmask ) )
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment