This R Markdown document is made interactive using Shiny. To learn more, see Interactive Documents.
library(geotopbricks) library(geotopOptim2) #if(!require("geotopbricks")) #{ # if(!require("devtools")) # { # install.packages(devtools) # require("devtools") # } # install_github("ecor/geotopbricks") # require("geotopbricks") #} # # #if(!require("geotopOptim2")) #{ # if(!require("devtools")) # { # install.packages(devtools) # require("devtools") # } # install_github("ecor/geotopOptim2") # require("geotopOptim2") #} if(!require("dygraphs")) { install.packages(dygraphs) require("dygraphs") } if(!require("hydroGOF")) { install.packages(hydroGOF) require("hydroGOF") } if(!require("ggplot2")) { install.packages(ggplot2) require("ggplot2") } #wpath <- '/home/ecor/activity/2016/eurac2016/idra/B2_BeG_017_DVM_001_test_1' #wpath <- '/home/ecor/Dropbox/activity/2016/geotop_simulation/Latsch1_Calib_001' #wpath <- "C:/Users/GBertoldi/Documents/Simulations_local/geotopOptim2_tests/DOMEF_1500_Optim_001_PSO" wpath <- "/home/ecor/temp/geotopOptim_tests/DOMEF_1500_Optim_005/xxfb21f1a553d/DOMEF_1500_Optim_005" alldata <- geotopLookUpTable(wpath = wpath) obsnames <- attr(alldata,"observation_var") simnames <- attr(alldata,"simulation_var") fun_names <- c("min","mean","max","sum")
inputPanel( # ##textInput(inputId = "simFolder", label = "Simulation folder", value = ""), selectInput(inputId = "variable", label = "discover variable", choices = obsnames,selected=obsnames[8]), # #####selectInput(inputId = "add_variable", label = "additional variable (sim)", choices = simnames, selected = simnames[2]), radioButtons(inputId = "aggregation", label = "aggregation", choices = c("hourly","daily","monthly"), selected = "hourly", inline = FALSE), selectInput(inputId = "aggregation_function_var", label = "Aggregation Function", choices = fun_names, selected = "mean") # selectInput(inputId = "aggregation_function_add_var", label = "Aggregation Function (add_var)", choices = fun_names, selected = "sum") # radioButtons(inputId = "flux_amount", label = "flux or amount", choices = c("flux","amount"), selected = "flux", inline = FALSE) # # radioButtons(inputId = "cum", label = "cumulated or time series", choices = c("time series","cumulated over time"), selected = "time series", inline = FALSE) )
Dynamic plots of observed vs simulated time series.
renderDygraph({ ## TO GO ON ..... iiv <- input$variable aggregation <- input$aggregation aggr_fun_1 <- input$aggregation_function_var aggr_fun_2 <- input$aggregation_function_add_var data <- aggregateVar(x=alldata,InputVar=iiv,aggregate=aggregation,aggregate_fun=c(aggr_fun_1)) unit <- attr(alldata,"var_unit")[iiv] ###add_unit <- attr(alldata,"var_unit")[aiiv] ## dygraph(data, ylab=paste(iiv,"[",unit,"]",sep="")) %>% dyRangeSelector() %>% dyRoller() # %>% # dySeries(name = "additional.var", axis = "y2", stepPlot = TRUE, fillGraph = TRUE, label = paste(aiiv,"[",add_unit,"]",sep="")) %>% # dyAxis(name="y2",label=paste("[",add_unit,"]",sep="")) # } })
Measures for GOF are given for seasons and for the whole data series. Calculations were performed with the hydroGOF R-Package. Type ?gof in the R console for information on specific GOFs.
renderDataTable({ #renderText({ # if (input$aggregation=="hour" | input$aggregation=="day") # { # observation <- obs[[input$aggregation]][,input$variable] # } else { # observation <- obs[["day"]][,input$variable] # } # # simulation <- varout[[input$variable]] # # if (input$aggregation=="day" & input$flux_amount=="flux") simulation <- aggregate(simulation, as.Date(time(simulation)), mean, na.rm=T) # if (input$aggregation=="day" & input$flux_amount=="amount") simulation <- aggregate(simulation, as.Date(time(simulation)), sum, na.rm=F) # if (input$aggregation=="month" & input$flux_amount=="flux") # { # simulation <- aggregate(simulation, as.yearmon(time(simulation)), mean, na.rm=T) # observation <- aggregate(observation, as.yearmon(time(observation)), mean, na.rm=T) # } # if (input$aggregation=="month" & input$flux_amount=="amount") # { # simulation <- aggregate(simulation, as.yearmon(time(simulation)), sum, na.rm=F) # observation <- aggregate(observation, as.yearmon(time(observation)), sum, na.rm=F) # } # time(observation) <- as.POSIXct(time(observation)) # time(simulation) <- as.POSIXct(time(simulation)) # data <- merge(observation, simulation) iiv <- input$variable nnn <- c("simulation","observation") aggregation <- input$aggregation aggr_fun_1 <- input$aggregation_function_var ####aggr_fun_2 <- input$aggregation_function_add_var # ######data <- extractGeotopVar(x=alldata,InputVar=iiv,Add_InputVar=aiiv,aggregate=aggregation,aggregate_fun=c(aggr_fun_1,aggr_fun_2)) data <- aggregateVar(x=alldata,InputVar=iiv,aggregate=aggregation,aggregate_fun=c(aggr_fun_1)) data <- data[,nnn] gofs <- gofg(sim = data$simulation, obs=data$observation, na.rm = TRUE) gofs <- as.data.frame(gofs) names(gofs) <- "YEAR" gofs$GOF <- dimnames(gofs)[[1]] mon <- as.numeric(as.character(index(data),format="%m")) ####as.numeric(format(time(data), "%m")) datadjf <- data[mon==12 | mon==1 | mon==2,] gofs$DJF <- c(gofg(sim = datadjf$simulation, obs=datadjf$observation, na.rm = TRUE)) datamam <- data[mon==3 | mon==4 | mon==5,] gofs$MAM <- c(gofg(sim = datamam$simulation, obs=datamam$observation, na.rm = TRUE)) datajja <- data[mon==6 | mon==7 | mon==8,] gofs$JJA <- c(gofg(sim = datajja$simulation, obs=datajja$observation, na.rm = TRUE)) datason <- data[mon==9 | mon==10 | mon==11,] gofs$SON <- c(gofg(sim = datason$simulation, obs=datason$observation, na.rm = TRUE)) gofs <- gofs[,c(2,3,4,5,6,1)] }, options = list(pageLength=5, lengthMenu=c(5, 10, 15, 20)))
renderPlot({ iiv <- input$variable aiiv <- input$add_variable nnn <- c("simulation","observation") aggregation <- input$aggregation aggr_fun_1 <- input$aggregation_function_var data <- aggregateVar(x=alldata,InputVar=iiv,aggregate=aggregation,aggregate_fun=c(aggr_fun_1))[,nnn] data <- data[,nnn] if (all(is.na(data$observation))==TRUE) { data$observation <- -9999 } if (all(is.na(data$simulation))==TRUE) { data$simulation <- -9999 } ##data <- merge(observation, simulation) ##names(data) <- c("observation", "simulation") data <- as.data.frame(data) ggplot(data = data, aes(x=observation, y=simulation)) + geom_point() + geom_abline(intercept=0, slope=1, col=rgb(1,0,0,.5), lwd=2) })
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.