#get longnames of varaibles
longnames <- function(nc){
l = names(nc$var)
names(l) = sapply(nc$var,function(x) x$longname)
l
}
#for var return dim names
getVar <- function(nc,name){nc$var[[name]]}
dimi <- function(var,name) which(vardims(var)==name)
dimunits <- function(var,name) {var$dim[[dimi(var,name)]]$units}
dimmin <- function(var,name) min(var$dim[[dimi(var,name)]]$vals)
dimmax <- function(var,name) max(var$dim[[dimi(var,name)]]$vals)
dimres <- function(var,name) ggplot2::resolution(var$dim[[dimi(var,name)]]$vals)
dateRange<-function(var) c(datelist(var)[1],tail(datelist(var),1))
vardims <- function(var) sapply(var$dim,function(x) x$name)
hasTime <- function(var) T%in%grepl('time',vardims(var))
hasVert<-function(var) as.logical(length(var$varsize)-(hasTime(var)+2))
vertid <- function(var) ifelse(hasTime(var),length(var$dim)-1,length(var$dim))
coordmatch <- function(x,y) which(abs(x-y)==min(abs(x-y)))[1]
dimvals <- function(var,start,count){
i <- 1:length(start)#which(count!=1)
names(i)=vardims(var)#[i]
lapply(i,function(x) var$dim[[x]]$vals[start[x]:(start[x]+(count[x]-1))])
}
datelist <- function(var){
#var
units=var$dim[[length(var$dim)]]$units
if(grepl('seconds since',units)){
t=as.POSIXct(var$dim[[length(var$dim)]]$vals,origin=gsub('seconds since','',units))
}
if(grepl('days since',units)){
t=as.POSIXct(var$dim[[length(var$dim)]]$vals*86400,origin = gsub('days since','',units))
}
#t=as.Date(t)
names(t)=var$dim[[length(var$dim)]]$vals
t
}
buildQuery <- function(var,xr,yr,vr=NULL,tr=NULL,nc=NULL){
# xr <- c(stndf$lon[1],stndf$lon[1])
# yr <- c(stndf$lat[1],stndf$lat[1])
# vr <- NULL#c(1,25)
# tr <-as.Date(dateRange(s1))
# var = v1
###############################
if(length(xr)==1){
xr <- rep(xr,2)}
if(length(yr)==1){
yr <- rep(yr,2)}
if(length(vr)==1){
vr <- rep(vr,2)}
if(length(tr)==1){
tr <- rep(tr,2)}
if(class(var)=="character"){var <- nc$var[[var]]}
bbox = list(x=xr,y=yr)
dateR <- tr
# print(bbox)
# print(dateR)
var.dims <- var%>%vardims()
var.ndims <- length(var.dims)
var.hasTime <- var%>%hasTime()
var.hasVert<-var%>%hasVert()
start1 <- rep(1,var.ndims)
start1[1] <- coordmatch(var$dim[[1]]$vals,bbox$x[1])
start1[2] <- coordmatch(var$dim[[2]]$vals,bbox$y[1])
end1 <- rep(1,var.ndims)
end1[1] <- coordmatch(var$dim[[1]]$vals,bbox$x[2])
end1[2] <- coordmatch(var$dim[[2]]$vals,bbox$y[2])
if(var.hasTime){
var.dl <- as.Date(datelist(var))
di=var.dl>=dateR[1]&var.dl<=dateR[2]
start1[length(start1)] = min(which(di == TRUE))#which(cumsum(di)==1)
end1[length(end1)] = max(which(di == TRUE))#which(cumsum(di)==max(cumsum(di)))[1]
}
if(var.hasVert){
var.vid <-var%>%vertid()
vdim <- var$dim[[var.vid]]
start1[var.vid]=coordmatch(vdim$vals,vr[1])
end1[var.vid]=coordmatch(vdim$vals,vr[2])
}
count1=(end1-start1)+1
start<-apply(cbind(start1,end1),1,min)
count<-abs(count1)
#print(start)
#print(count)
dimV <- dimvals(var,start,count)
if(var.hasTime){
dimV$time <- as.character(var.dl[di])#[as.character(dimV$time)]
names(dimV$time) <- NULL
}
list(start=start,count=count,dimV=dimV)
}
getQuery <- function(nc,var,qry){
v1 <- get.var.ncdf(nc,var,start=qry$start,count = qry$count)
dimnames(v1) <- qry$dimV[qry$count!=1]
df <- melt(v1)%>%filter(!is.na(value))
if(nrow(df)==0){return(NULL)}
if(1%in%qry$count){
df <- cbind(df,as.data.frame(qry$dimV[qry$count==1]))
}
df[,c(names(qry$dimV),'value')]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.