Skip to content

Commit

Permalink
fix temporal exports
Browse files Browse the repository at this point in the history
  • Loading branch information
Alejandro Ruete committed Nov 13, 2020
1 parent 65665d5 commit b1d0a3c
Showing 1 changed file with 54 additions and 17 deletions.
71 changes: 54 additions & 17 deletions R/exportBirds.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -270,13 +270,20 @@ exportTemporal <- function(sb, timeRes, variable, method){
if (timeRes %in% c("yearly", "monthly", "daily")){
if (method != "sum") stop("This combination of variable and time resolution only accepts 'sum' as summary method")
resVar <- pull(res, !!sym(variable))
names(resVar) <- lubridate::ymd(switch(timeRes,
"yearly" = paste0(yearsAll, "-01-01"),
"monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
"daily" = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day)))
# names(resVar) <- lubridate::ymd(switch(timeRes,
# "yearly" = paste0(yearsAll, "-01-01"),
# "monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
# "daily" = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day)))
# )
dates <- lubridate::ymd(switch(timeRes,
"yearly" = paste0(yearsAll, "-01-01"),
"monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
"daily" = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day)))
)
# MAKE RESVAR to xts::as.xts()
resVar <- xts::as.xts(resVar)

str(zoo::zoo(resVar, dates))
resVar <- xts::as.xts(zoo::zoo(resVar, dates))

} else { #month
if (!(method %in% c("sum", "median", "mean"))) stop("This combination of variable and time resolution only accepts 'sum', 'median' or 'mean' as summary method")
Expand All @@ -298,18 +305,29 @@ exportTemporal <- function(sb, timeRes, variable, method){

} else if (variable == "avgSll"){
## Group also by visit
res <- getTemporalAvgSll(obsData, timeRes, visitCol, yearsAll)
if (timeRes %in% c("yearly", "monthly", "daily")){
if (method != "median") stop("This combination of variable and time resolution only accepts 'median' as summary method")
res <- getTemporalAvgSll(obsData, timeRes, visitCol, yearsAll)
resVar <- pull(res, .data$avgSll)
names(resVar) <- lubridate::ymd(switch(timeRes,
"yearly" = paste0(yearsAll, "-01-01"),
"monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
"daily" = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day))))
resVar <- xts::as.xts(resVar)
# names(resVar) <- lubridate::ymd(switch(timeRes,
# "yearly" = paste0(yearsAll, "-01-01"),
# "monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
# "daily" = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day))))

dates <- lubridate::ymd(switch(timeRes,
"yearly" = paste0(yearsAll, "-01-01"),
"monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
"daily" = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day)))
)
# MAKE RESVAR to xts::as.xts()

# str(zoo::zoo(resVar, dates))
resVar <- xts::as.xts(zoo::zoo(resVar, dates))
# resVar <- xts::as.xts(zoo::zoo(resVar, names(resVar)))

} else { #month
if (!(method %in% c("median", "mean"))) stop("This combination of variable and time resolution only accepts 'median' or 'mean' as summary method")
res <- getTemporalAvgSll(obsData, timeRes, visitCol, yearsAll)
gpby <- group_by(res, .data$month)
if (method == "mean") resMon <- summarise(gpby, var = round(mean(.data$avgSll),2))
if (method == "median") resMon <- summarise(gpby, var = median(.data$avgSll))
Expand All @@ -322,14 +340,18 @@ exportTemporal <- function(sb, timeRes, variable, method){
if(method != "sum" && timeRes != "month") stop("This combination of variable and time resolution only accepts 'sum' as summary method")

resRowNames <- rownames(sb$spatial@data)
singleGrid <- ifelse(length(resRowNames)==1, TRUE, FALSE)
singleGrid <- ifelse(length(resRowNames) == 1, TRUE, FALSE)

if (timeRes == c("yearly")){
if (singleGrid) {
resVar <- countIfHigher(sb$spatioTemporal[,,13,1], thr=1)
} else {
resVar <- apply(sb$spatioTemporal[,,13,1], 2, countIfHigher, thr=1)}
resVar <- apply(sb$spatioTemporal[,,13,1], 2, countIfHigher, thr=1)
}
names(resVar) <- paste0(yearsAll, "-01-01")
# resVar <- zoo::zoo(unname(resVar),
# lubridate::ymd(names(resVar)))
# resVar <- xts::as.xts(resVar)
}

if (timeRes %in% c("monthly", "month")){
Expand All @@ -341,15 +363,22 @@ exportTemporal <- function(sb, timeRes, variable, method){
if (timeRes == "monthly"){
resVar <- as.vector(t(ncellsM))
names(resVar) <- paste0(rep(yearsAll, each=12), "-", 1:12, "-01")
# resVar <- zoo::zoo(unname(resVar),
# lubridate::ymd(names(resVar)))
# resVar <- xts::as.xts(resVar)

} else {
resVar <- apply(ncellsM, 2, method)
names(resVar) <- month.abb
}
}

if (timeRes == c("daily")){
daygrid<-lapply(sb$overlaid, function(x) unique(paste0(x$year, "-", x$month, "-", x$day)))
dayGridP<-as.character(as.Date(unlist(daygrid)))
daygrid <- lapply(sb$overlaid, function(x){
unique(paste0(x$year, "-", x$month, "-", x$day))
} )
daygrid <- daygrid[daygrid != "--"]
dayGridP <- as.character(as.Date(unlist(daygrid)))

all.Days <- as.character(sort(as.Date(unique(unlist(daygrid)))))
resVar <- unlist(
Expand All @@ -358,10 +387,18 @@ exportTemporal <- function(sb, timeRes, variable, method){
})
)
names(resVar) <- all.Days
# resVar <- zoo::zoo(unname(resVar),
# lubridate::ymd(all.Days))
# resVar <- xts::as.xts(resVar)
}

if (timeRes != "month") resVar <- xts::as.xts(resVar)

if (timeRes != "month") {
# str(zoo::zoo(unname(resVar), lubridate::ymd(names(resVar))))
resVar <- zoo::zoo(unname(resVar),
lubridate::ymd(names(resVar)))
# resVar <- xts::as.xts(zoo::zoo(resVar, dates))
resVar <- xts::as.xts(resVar)
}
} else {
stop(paste0("variable = ", variable, " is not a valid input"))
}
Expand Down

0 comments on commit b1d0a3c

Please sign in to comment.