inst/ModelBuild/svrSelect.R

In waternumbers/FloodForT: Flood Forecasting Toolbox

## ##############
## Plots data on the Selection tab
## ##############
output$plotCalData <- renderDygraph({
    vars <- c(input$selInputVar,input$selOutputVar)
    tmp <- analysisRecord$baseData[,vars]
    if(is.null(tmp)){
        return(NULL)
    }else{
        dygraph(tmp) %>%
            dyOptions(useDataTimezone = TRUE) %>%
            dyShading(from = as.POSIXct(input$selCalibStrt,tz='GMT'),
                      to = as.POSIXct(input$selCalibFnsh,tz='GMT'),
                      color="#FFE6E6") %>%
             dyShading(from = as.POSIXct(input$selValidStrt,tz='GMT'),
                       to = as.POSIXct(input$selValidFnsh,tz='GMT'),
                       color="#FFF380")
    }
})

###################################################
# reactive function to populate calibration data table
observe({
    if (input$bttnCalibData == 0) return(NULL)
    
    isolate({
        ## sanity checks
        if(input$selInputVar=="" |
           input$selOutputVar == ""){
            str <- "Please select an input and output series"
            session$sendCustomMessage("messageBox", str)
            return(NULL)
        }
        
        
                        
        ## create a local version of mdlData
        tmp <- data.frame(start = c(input$selCalibStrt,input$selValidStrt),
                          finish = c(input$selCalibFnsh,input$selValidFnsh),stringsAsFactors=FALSE)
        rownames(tmp) <- c("Calib","Valid")
        mdlData <- list(Variables = c(input = input$selInputVar,output = input$selOutputVar),
                        Periods = tmp,
                        lvl = c(warning=input$wrnlvl,danger=input$dnglvl))
        
        ## compare to that in dynamic record...
        tmp <- analysisRecord$mdlData
        ## see if current status is NULL
        if(length(tmp)==0){
            theSame <- FALSE
        }else{
            theSame <- TRUE
            if( length(setdiff(names(tmp$Variables),names(mdlData$Variables))) > 0){
                theSame <- FALSE
            }else{
                if( !all(mdlData$Variables[names(tmp$Variables)]==tmp$Variables) ){
                    theSame <- FALSE
                }
            }
            if(length(setdiff(colnames(tmp$Periods),colnames(mdlData$Periods))) > 0){
                theSame <- FALSE
            }else{
                if( !all(mdlData$Periods[rownames(tmp$Periods),colnames(tmp$Periods)]==tmp$Periods) ){
                    theSame <- FALSE
                }
            }
        }
        ## actions if the selected values have changed
        if( !theSame ){
            ## remove model results if theSame is not true
            analysisRecord$mdlData <- mdlData
            analysisRecord$mdlTbl <- NULL
            analysisRecord$mdl <- NULL
            
            ## update the values of minima avaialbe
            tmp <- analysisRecord$baseData
            tmp <- tmp[, input$selOutputVar]
            tmp <- max(tmp,na.rm=TRUE)
            updateSliderInput(session,"sliderMinima",
                              min=0,max= round(tmp,2),
                              step=0.01)

        }
    })
})