inst/ModelBuild/svrUpdateSel.R

In waternumbers/FloodForT: Flood Forecasting Toolbox

## ###################
## Update variable selectors when data is loaded
## ###################
observe({
    ## tmp <- analysisRecord$readData
    ## nms <- names(tmp)
    tmp <- analysisRecord$varTbl
    nms <- rownames(tmp)
    
    isolate({
        if(is.null(nms)){ return() }
        
        ## select lists of variables
        selList <- c("selData","selInputVar","selOutputVar")
        for(ii in selList){
            updateSelectInput(session,ii,
                              label = NULL,
                              choices = nms,
                              selected = NULL)
        }
    })
})

## ###################
## Update model selections when models estimated
## ###################
observe({
    ## tmp <- analysisRecord$readData
    ## nms <- names(tmp)
    tmp <- analysisRecord$mdlTbl
    nms <- rownames(tmp)
    
    isolate({if(!is.null(nms)){ 
                 names(nms) <- fprettyNames(nms)
             }

        ## select lists of variables
        selList <- c("selMdl","selDAest")
        for(ii in selList){
            if( is.null(nms) ){
                updateSelectInput(session,ii,
                                  label = NULL,
                                  choices = "",
                                  selected = "")
            }else{
                updateSelectInput(session,ii,
                                  label = NULL,
                                  choices = nms,
                                  selected = NULL)
            }
        }
    })
})
## ###################
## Update model selections when model data assimilation estimated
## ###################
observe({
    ## tmp <- analysisRecord$readData
    ## nms <- names(tmp)
    tmp <- analysisRecord$mdlTbl
    tmp <- tmp[tmp[,'hasDA'],]
    nms <- rownames(tmp)
    
    isolate({
        if(length(nms)>0){
            names(nms) <- fprettyNames(nms)
        }
        
        ## select lists of variables
        selList <- c("selDAMdl","selSaveMdl")
        for(ii in selList){
            if(length(nms)==0){
                updateSelectInput(session,ii,
                                  label = NULL,
                                  choices = "",
                                  selected = "")
            }else{
                 updateSelectInput(session,ii,
                                   label = NULL,
                                   choices = nms,
                                   selected = NULL)
             }
        }
    })
})

##########################################
## update which variables can be plotted from the data assimilation
##########################################
observe(
    {
    mdl <- input$selDAMdl

    isolate(
        {
        if(length(mdl)==0){
            updateSelectInput(session,"selDAHorizon",
                              label = NULL,
                              choices = "",
                              selected = "")
        }else{
             nms <- NULL
             for(ii in mdl){
                 nms <- c(nms,names(analysisRecord$mdl[[ii]]$cal))
             }
             nms <- unique(nms)
#             tmp <- input$selDAHorizon
#             if(length(tmp)>0){
#                 tmp <- tmp[tmp %in% nms]
#             }
#             if(lenth(tmp)==0){tmp=""}
             updateSelectInput(session,"selDAHorizon",
                              label = NULL,
                              choices = nms,
                              selected = "")
         }
    })
})

######################################################
## update the dates that can be used for issued time of forecast
observe(
    {
    print("Are we being called")
    nms <- input$selDAMdl
    isVal <- input$ckValDataDA

    isolate(
        
        {if(is.null(nms)){
             return(NULL)
         }else{
              nms <- nms[1]
          }
         mdl <- analysisRecord$mdl[[nms]]$param
         tp <- analysisRecord$mdlData$Periods
         if(isVal){
             ts <- seq(as.POSIXct(tp['Valid','start'],tz='GMT'),
                       as.POSIXct(tp['Valid','finish'],tz='GMT'),
                       by=mdl$mdl[1,'dt'])
         }else{
              ts <- seq(as.POSIXct(tp['Calib','start'],tz='GMT'),
                        as.POSIXct(tp['Calib','finish'],tz='GMT'),
                        by=mdl$mdl[1,'dt'])
          }
#         ts <- format(ts,'%Y-%m-%d',tz="GMT")
         updateDateInput(session,"dtDAmovTime",
                         value=format(ts[1],'%Y-%m-%d',tz="GMT"),
                         min=format(ts[1],'%Y-%m-%d',tz="GMT"),
                         max=format(ts[length(ts)],'%Y-%m-%d',tz="GMT"))
         updateSliderInput(session,"sldDAmovTime",value=1,min=1,max=length(ts),step=1)
         
     })
})

#################################
## update slider on change of dates
observe(
    {
    dsel <- input$dtDAmovTime

    isolate(

        {tp <- analysisRecord$mdlData$Periods
         isVal <- input$ckValDataDA
         nms <- input$selDAMdl
         
         if(is.null(nms)){
              return(NULL)
          }else{
               nms <- nms[1]
           }
         mdl <- analysisRecord$mdl[[nms]]$param

         if(isVal){
             ts <- seq(as.POSIXct(tp['Valid','start'],tz='GMT'),
                       as.POSIXct(tp['Valid','finish'],tz='GMT'),
                       by=mdl$mdl[1,'dt'])
         }else{
              ts <- seq(as.POSIXct(tp['Calib','start'],tz='GMT'),
                        as.POSIXct(tp['Calib','finish'],tz='GMT'),
                        by=mdl$mdl[1,'dt'])
          }
             
         ts <- format(ts,'%Y-%m-%d',tz="GMT")
         idx <- which.max(ts %in% paste(dsel))
         updateSliderInput(session,"sldDAmovTime",value=idx,step=1)
     })
})