iNZightModules: iNZight GUI Modules

##' iNZight Time Series Module
##'
##' A GUI add-on for visualising and doing basic inference and prediction of time series data.
##'
##' @title iNZight Time Series Module
##'
##' @author Eric Lim
##'
##' @import iNZightTS
##'
##' @export iNZightTSMod
##' @exportClass iNZightTSMod
iNZightTSMod <- setRefClass(
    "iNZightTSMod",
    fields = list(
        GUI         = "ANY",
        mainGrp     = "ANY",
        activeData  = "data.frame",
        timeVarType = "ANY",
        timeVar     = "ANY",
        timePeriodList = "ANY",
        timeFreqList = "ANY", timeFreqNum = "ANY",
        timeStartPeriod = "ANY", timeStartSeason = "ANY",
        timePeriod = "ANY", timeFreq = "ANY", timeStart = "ANY",
        patternType = "numeric",
        smootherChk = "ANY", show.smoother = "logical",
        smthSlider  = "ANY", smoothness = "numeric",
        tsObj       = "ANY",
        yLab        = "ANY", xLab = "ANY",
        xlimLower   = "ANY", xlimUpper   = "ANY",
        modLimEqual = "ANY", modLimLower = "ANY", modLimUpper = "ANY",
        plotType = "ANY", plottype = "numeric",
        compareChk = "ANY", compare = "numeric",
        animateBtn  = "ANY", pauseBtn = "ANY",
        recomposeBtn = "ANY", recomposeResBtn = "ANY", decomp = "ANY",
        recompProg = "ANY",
        forecastBtn = "ANY", forecasts   = "ANY",
        forecastError = "ANY",
        timer = "ANY", playTimer = "ANY",
        timeVarSelect = "ANY",
        varSelect = "ANY"
    ),
    methods = list(
        initialize = function(GUI) {
            initFields(
                GUI = GUI,
                patternType = 1,
                show.smoother = TRUE,
                smoothness = 15,
                tsObj = NULL,
                plottype = 1,
                compare = 1,
                timeFreq = NA,
                timeStart = c(1, 1),
                timePeriod = NULL,
                recompProg = c(0, 0),
                timer = NULL
            )

            dat = GUI$getActiveData()
            activeData <<- tsData(dat)
            timeVar <<- getTime(activeData, index = FALSE)

            modwin <- GUI$initializeModuleWindow(.self,
                title = "Time Series", scroll = TRUE)
            mainGrp <<- modwin$body

            ## playBtn <- iNZight:::gimagebutton(stock.id = "media-play",
            #       handler = function(h, ...) updatePlot(animate = TRUE))
            GUI$plotToolbar$update("export", refresh = "updatePlot")
                #, extra = list(playBtn))

            ################
            ###  fields  ###
            ################
            frameFont = list(weight = "bold")

            #################################
            ###  set up frame containers  ###
            #################################
            g1 = gframe("Time Information", pos = 0.5, horizontal = FALSE,
                        container = mainGrp)
            g2 = gframe("Model Settings", pos = 0.5, horizontal = FALSE,
                        container = mainGrp)
            # addSpring(mainGrp)

            midGrp <- ggroup(container = mainGrp, fill = TRUE)
            g3 = gframe("Series Variables", pos = 0.5, horizontal = FALSE,
                        container = midGrp, fill = TRUE)
            g5 = gframe("Plot Type Options", pos = 0.5, horizontal = FALSE,
                        container = midGrp, fill = TRUE, expand = TRUE)

            g4 = gexpandgroup("Customize Labels",
                # pos = 0.5,
                horizontal = FALSE,
                container = mainGrp
            )

            g6 = gexpandgroup("Adjust limits",
                horizontal = FALSE,
                container = mainGrp
            )


            g1$set_borderwidth(8)
            g2$set_borderwidth(8)
            g3$set_borderwidth(8)
            g4$set_borderwidth(8)

            g5$set_borderwidth(8)
            g6$set_borderwidth(8)

            ## bold-faced title for the frames
            frames = getToolkitWidget(mainGrp)$getChildren()
            mainGrp$set_rgtk2_font(frames[[1]]$getChildren()[[2]], frameFont)
            mainGrp$set_rgtk2_font(frames[[2]]$getChildren()[[2]], frameFont)
            midGrp$set_rgtk2_font(
                getToolkitWidget(midGrp)$getChildren()[[1]]$getChildren()[[2]],
                frameFont
            )
            midGrp$set_rgtk2_font(
                getToolkitWidget(midGrp)$getChildren()[[2]]$getChildren()[[2]],
                frameFont
            )
            mainGrp$set_rgtk2_font(
                frames[[4]]$getChildren()[[2]],
                frameFont
            )
            mainGrp$set_rgtk2_font(
                frames[[5]]$getChildren()[[2]],
                frameFont
            )

            ############
            ###  g1  ###
            ############
            ## FOR MAIN LAYOUT
            g1_layout = glayout(container = g1)
            timeVarType <<- gradio(
                c("Select time variable", "Provide time manually"),
                selected = 1,
                horizontal = FALSE
            )
            g1_layout[1, 1:2, expand = TRUE] = timeVarType

            ## FOR LAYOUT A
            g1a_layout = glayout(container = g1)
            ## g1a options

            timeVarSelect <<- gcombobox(names(activeData),
                selected = match(timeVar, names(activeData), nomatch = 0),
                handler = function(h, ...) {
                    timeVar <<- svalue(h$obj)
                    updatePlot()
                }
            )
            ## g1a labels
            g1a_lab1   = glabel("Select time variable:")
            ## g1a layout
            g1a_layout[2, 1, expand = TRUE, anchor = c(-1, 0)] = g1a_lab1
            g1a_layout[2, 2, expand = TRUE]   = timeVarSelect

            ## FOR LAYOUT B
            g1b_layout = glayout(container = g1, spacing = 2)
            visible(g1b_layout) = FALSE

            ## g1b options
            ii <- 1

            lbl <- glabel("Period :")
            timePeriodList <<- gcombobox(c("Year", "Week", "Day"),
                selected = 0,
                handler = function(h, ...) {
                    timePeriod <<- svalue(h$obj)
                    blockHandlers(varSelect)
                    timeFreqList$set_items(
                        c(names(freqOpts[[svalue(h$obj)]]), "Custom")
                    )
                    unblockHandlers(varSelect)
                    svalue(startlbl1) <- "Year"
                    varSelect$invoke_change_handler()
                }
            )
            g1b_layout[ii, 1, anchor = c(1, 0), expand = TRUE] <- lbl
            g1b_layout[ii, 2, expand = TRUE, fill = TRUE] <- timePeriodList
            ii <- ii + 1

            lbl <- glabel("Frequency* :")
            freqOpts <- list(
                "Year" = c(
                    "Yearly (1)" = 1,
                    "Quarterly (4)" = 4,
                    "Monthly (12)" = 12,
                    "Weekly (52)" = 52,
                    "Daily (365/366)" = 365.25
                ),
                "Week" = c(
                    "Daily (7)" = 7,
                    "Daily - work week (5)" = 5
                ),
                "Day"  = c(
                    "Hourly (24)" = 24
                )
            )
            timeFreqList <<- gcombobox(character(),
                selected = 0,
                handler = function(h, ...) {
                    blockHandlers(varSelect)
                    if (svalue(h$obj) == "Custom") {
                        enabled(timeFreqNum) <<- TRUE
                    } else {
                        enabled(timeFreqNum) <<- FALSE
                        svalue(timeFreqNum) <<-
                            freqOpts[[timePeriod]][svalue(h$obj)]
                    }
                    timeFreqNum$invoke_change_handler()
                    unblockHandlers(varSelect)
                    season.name <- svalue(h$obj)
                    if (season.name == "Custom") {
                        season.name <- "Season"
                    } else {
                        season.name <- gsub("ly$", "",
                            strsplit(season.name, " ")[[1]][1])
                        if (season.name == "Dai") season.name <- "Day"
                    }
                    svalue(startlbl2) <- season.name
                    varSelect$invoke_change_handler()
                }
            )
            timeFreqNum <<- gspinbutton(1, 1000, by = 1,
                value = 1,
                handler = function(h, ...) {
                    timeFreq <<- svalue(h$obj)
                    blockHandlers(varSelect)
                    svalue(timeStartSeason) <<-
                        min(svalue(timeStartSeason), timeFreq)
                    if (svalue(h$obj) == 1) {
                        enabled(timeStartSeason) <<- FALSE
                        visible(startlbl2) <- FALSE
                    } else {
                        enabled(timeStartSeason) <<- TRUE
                        visible(startlbl2) <- TRUE
                    }
                    unblockHandlers(varSelect)
                    varSelect$invoke_change_handler()
                }
            )
            g1b_layout[ii, 1, anchor = c(1, 0), expand = TRUE] <- lbl
            g1b_layout[ii, 2, expand = TRUE, fill = TRUE] <- timeFreqList
            g1b_layout[ii, 3, expand = TRUE, fill = TRUE] <- timeFreqNum
            ii <- ii + 1

            lbl <- glabel("*How many observations per period?")
            font(lbl) <- list(size = 9)
            g1b_layout[ii, 2:3, anchor = c(-1, 1), expand = TRUE] <- lbl
            ii <- ii + 1

            ii <- ii + 1

            lbl <- glabel("Start date : ")
            timeStartPeriod <<- gspinbutton(0, 1e5, by = 1, value = 1,
                handler = function(h, ...) {
                    timeStart <<- c(svalue(h$obj), svalue(timeStartSeason))
                    varSelect$invoke_change_handler()
                })
            timeStartSeason <<- gspinbutton(0, 1e5, by = 1, value = 1,
                handler = function(h, ...) {
                    if (svalue(h$obj) > timeFreq)
                        svalue(h$obj) <- timeFreq
                    timeStart <<- c(svalue(timeStartPeriod), svalue(h$obj))
                    varSelect$invoke_change_handler()
                })
            g1b_layout[ii, 1, anchor = c(1, 0), expand = TRUE] <- lbl
            g1b_layout[ii, 2, expand = TRUE, fill = TRUE] <- timeStartPeriod
            g1b_layout[ii, 3, expand = TRUE, fill = TRUE] <- timeStartSeason
            ii <- ii + 1

            startlbl1 <- glabel("Period")
            font(startlbl1) <- list(size = 9)
            startlbl2 <- glabel("Season")
            font(startlbl2) <- list(size = 9)
            g1b_layout[ii, 2, anchor = c(-1, 1), expand = TRUE] <- startlbl1
            g1b_layout[ii, 3, anchor = c(-1, 1), expand = TRUE] <- startlbl2
            ii <- ii + 1

            addHandlerChanged(timeVarType, handler = function(h,...) {
                if (svalue(h$obj, index = TRUE) == 1) {
                    visible(g1a_layout) = TRUE
                    visible(g1b_layout) = FALSE
                } else {
                    visible(g1a_layout) = FALSE
                    visible(g1b_layout) = TRUE
                }
                varSelect$invoke_change_handler()
            })

            ############
            ###  g2  ###
            ############
            g2_layout = glayout(container = g2, spacing = 5)
            g2_opt1   = gradio(c("Multiplicative", "Additive"),
                selected = patternType,
                horizontal = TRUE,
                handler = function(h, ...) {
                    patternType <<- svalue(h$obj, index = TRUE)
                    updatePlot()
                }
            )

            g2_layout[1, 1, anchor = c(1, 0), expand = TRUE] <-
                glabel("Seasonal pattern :")
            g2_layout[1, 2, expand = TRUE] = g2_opt1

            ## Smoother
            smthSlider <<- gslider(0, 100, by = 0.1,
                value = smoothness,
                handler = function(h, ...) {
                    smoothness <<- svalue(h$obj)
                    if (!is.null(timer))
                        if (timer$started)
                            timer$stop_timer()

                    timer <<- gtimer(200, function(...) updatePlot(),
                        one.shot = TRUE
                    )
                }
            )

            g2_layout[2, 1, anchor = c(1, 0), expand = TRUE] <-
                glabel("Smoothness :")
            g2_layout[2, 2, fill = TRUE, expand = TRUE] <- smthSlider

            ## Checkbox to hide/show smoother
            smootherChk <<- gcheckbox("Show smoother",
                checked = show.smoother,
                handler = function(h, ...) {
                    show.smoother <<- svalue(h$obj)
                    enabled(smthSlider) <<- show.smoother
                    updatePlot()
                }
            )
            g2_layout[3, 2, fill = TRUE, expand = TRUE] <- smootherChk

            ############
            ###  g3  ###
            ############
            ## NOTE:
            ##   need to change the variable selection widget for when there
            ##   are many variables which will expand the widget.
            g3_layout = glayout(container = g3)
            varSelect <<- gtable(
                names(activeData)[! names(activeData) %in% timeVar],
                multiple = TRUE
            )
            size(varSelect) <<- c(floor(size(GUI$leftMain)[1] * 0.5), 200)
            g3_layout[1, 1, anchor = c(-1, 0), expand = TRUE] <-
                glabel("Hold CTRL to select many")
            g3_layout[2, 1, expand = TRUE] = varSelect



            addHandlerSelectionChanged(varSelect, function(h, ...) {
                if (length(svalue(varSelect)) == 0) {
                    visible(novar) <- TRUE
                    return()
                }
                visible(novar) <- FALSE

                ## make dataset an iNZightTS object
                var_ind <- which(names(activeData) %in% svalue(h$obj))
                if (length(var_ind) == 1) {
                    visible(onevar) <- TRUE
                    visible(multivar) <- FALSE
                } else {
                    visible(onevar) <- FALSE
                    visible(multivar) <- TRUE
                }
                can_multiply <- all(sapply(var_ind, function(i) all(activeData[[i]] > 0)))
                enabled(g2_opt1) <- can_multiply
                if (!can_multiply) svalue(g2_opt1, index = TRUE) <- 2

                if ((svalue(timeVarType, TRUE) == 1 && !is.na(timeVar)) ||
                    (svalue(timeVarType, TRUE) == 2 && !is.null(timePeriod) && !is.na(timeFreq)) ) {
                    # tryCatch({
                        if (svalue(timeVarType, TRUE) == 1) {
                            tso <- iNZightTS::iNZightTS(
                                data = activeData,
                                var = var_ind,
                                time.col =
                                    which(colnames(activeData) == timeVar)
                            )
                        } else {
                            tso <- iNZightTS::iNZightTS(
                                data = activeData,
                                var = var_ind,
                                start = timeStart,
                                freq = timeFreq
                            )
                        }
                        tsObj <<- tso
                        updatePlot()
                    # },
                    # error = function(e) {
                    #     gmessage(
                    #         paste(sep="\n\n",
                    #             "Error creating Time Series object",
                    #             e$message
                    #         ),
                    #         title = "Error creating time series",
                    #         icon = "error",
                    #         parent = GUI$win
                    #     )
                    # },
                    # finally = {})

                    # if freq=1, disable seasonal/forecast/single-graph
                    if (tsObj$freq == 1) {
                        plotType$set_items(c("Standard", "Decomposition"))
                        compareChk$set_items("Separate graphs")
                    } else {
                        plotType$set_items(c("Standard", "Decomposition", "Seasonal", "Forecast"))
                        compareChk$set_items(c("Single graph", "Separate graphs"))
                    }

                } else {
                    # Something more helpful
                    tsObj <<- NULL

                }

            })

            addHandlerChanged(timeVarSelect, function(h, ...) {
                varSelect$set_items(
                    names(activeData)[! names(activeData) %in% timeVar]
                )
            })


            ############
            ###  g5  ###
            ############

            onevar <- gvbox(container = g5)
            addSpring(onevar)
            plotType <<- gradio(
                c("Standard", "Decomposition", "Seasonal", "Forecast"),
                selected = plottype,
                container = onevar,
                expand = TRUE,
                handler = function(h, ...) {
                    plottype <<- svalue(h$obj, index = TRUE)
                    visible(animateBtn) <<- svalue(h$obj, TRUE) == 1
                    visible(pauseBtn) <<- svalue(h$obj, TRUE) == 1
                    visible(recomposeBtn) <<- FALSE
                    visible(recomposeResBtn) <<- FALSE
                    visible(forecastBtn) <<- FALSE
                    updatePlot()
                }
            )

            tsenv <- new.env()
            assign("stopAnimation", FALSE, envir = tsenv)
            runAnimation <- gaction("Animate",
                icon = "gtk-media-play",
                handler = function(h, ...) {
                    assign("stopAnimation", FALSE, envir = tsenv)
                    enabled(animateBtn) <<- FALSE
                    enabled(pauseBtn) <<- TRUE
                    iNZightTS::rawplot(tsObj,
                        multiplicative = (patternType == 1),
                        ylab = svalue(yLab),
                        xlab = svalue(xLab),
                        animate = TRUE,
                        t = smoothness,
                        e = tsenv
                    )
                    enabled(pauseBtn) <<- FALSE
                    enabled(animateBtn) <<- TRUE
                }
            )
            pauseAnimation <- gaction("End Animation",
                icon = "gtk-media-stop",
                handler = function(h, ...) {
                    assign("stopAnimation", TRUE, envir = tsenv)
                }
            )

            animateBtn <<- gbutton(action = runAnimation, container = onevar)
            pauseBtn <<- gbutton(action = pauseAnimation, container = onevar)
            enabled(pauseBtn) <<- FALSE

            playTimer <<- NULL
            recomposeBtn <<- gbutton("Recompose",
                container = onevar,
                handler = function(h, ...) {
                    ## this button is _ if _
                    # - Recompose | is.null(playTimer)
                    # - Pause | !is.null(playTimer)
                    blockHandlers(recomposeBtn)
                    blockHandlers(recomposeResBtn)
                    on.exit(unblockHandlers(recomposeBtn))
                    on.exit(unblockHandlers(recomposeResBtn), add = TRUE)
                    if (is.null(playTimer) || !playTimer$started) {
                        if (all(recompProg == c(1, nrow(activeData)))) {
                            recompProg <<- c(0, 0)
                            updatePlot()
                            svalue(recomposeResBtn) <<- "Recompose result"
                        }
                        svalue(recomposeBtn) <<- "Pause"
                        playTimer <<- gtimer(10,
                            function(data) {
                                if (recompProg[2] >= nrow(activeData)) {
                                    if (recompProg[1] == 0)
                                        recompProg <<- c(1, 0)
                                    else {
                                        playTimer$stop_timer()
                                        blockHandlers(recomposeBtn)
                                        blockHandlers(recomposeResBtn)
                                        on.exit(unblockHandlers(recomposeBtn))
                                        on.exit(unblockHandlers(recomposeResBtn), add = TRUE)
                                        svalue(recomposeBtn) <<- "Replay"
                                        svalue(recomposeResBtn) <<- "Reset"
                                        return()
                                    }
                                } else {
                                    recompProg[2] <<- recompProg[2] + 1
                                }
                                updatePlot()
                            }
                        )
                    } else {
                        playTimer$stop_timer()
                        svalue(recomposeBtn) <<- "Recompose"
                    }

                }
            )
            visible(recomposeBtn) <<- FALSE
            recomposeResBtn <<- gbutton("Recompose Result", container = onevar)
            addHandlerClicked(recomposeResBtn,
                handler = function(h, ...) {
                    assign("stopAnimation", TRUE, envir = tsenv)
                    blockHandlers(h$obj)
                    on.exit(unblockHandlers(h$obj))
                    if (!is.null(playTimer))
                        if (playTimer$started) playTimer$stop_timer()
                    if (svalue(h$obj) == "Reset") {
                        recompProg <<- c(0, 0)
                        updatePlot()
                        svalue(recomposeResBtn) <<- "Recompose Result"
                    } else {
                        recompProg <<- c(1, nrow(activeData))
                        updatePlot()
                        svalue(recomposeResBtn) <<- "Reset"
                    }
                    blockHandlers(recomposeBtn)
                    on.exit(unblockHandlers(recomposeBtn), add = TRUE)
                    svalue(recomposeBtn) <<- "Recompose"
                }
            )
            visible(recomposeResBtn) <<- FALSE

            forecastBtn <<- gbutton("Forecasted Values",
                container = onevar,
                handler = function(h, ...) {
                    w <- gwindow("Time Series Forecasts", parent = GUI$win,
                                 width = 400, height = 300)
                    g <- gvbox(container = w)
                    t <- gtext(text = "",
                        container = g,
                        expand = TRUE,
                        wrap = FALSE,
                        font.attr = list(family = "monospace")
                    )
                    insert(t, capture.output(print(forecasts)))
                }
            )
            visible(forecastBtn) <<- FALSE
            forecastError <<- ggroup(container = onevar)
            glabel("Error fitting model ",
                container = forecastError)
            visible(forecastError) <<- FALSE
            iNZight:::gimagebutton(stock.id = "info",
                container = forecastError,
                handler = function(h, ...) {
                    gmessage(
                        paste(
                            "Sometimes the algorithm used (Holt Winters)",
                            "is unable to converge. This can be sensitive to",
                            "values in the data set. If you haven't already,",
                            "try unchecking the 'Use above limits' box under",
                            "'Adjust Limits', and then move the 'Fit model to data from'",
                            "sliders, which may help convergence."
                        ),
                        parent = GUI$win
                    )
                }
            )

            multivar <- ggroup(container = g5)
            compareChk <<- gradio(c("Single graph", "Separate graphs"),
                checked = compare,
                container = multivar,
                handler = function(h, ...) {
                    compare <<- svalue(h$obj, index = TRUE)
                    updatePlot()
                }
            )

            visible(onevar) <- FALSE
            visible(multivar) <- FALSE

            novar <- gvbox(container = g5)
            glabel("Select a Variable.", container = novar)
            lb <- glabel("(Hold CTRL to select multiple)", container = novar)
            font(lb) <- list(size = 8)



            ############
            ###  g4  ###
            ############
            g4_layout = glayout(container = g4)
            g4_lab1   = glabel("x-axis")
            g4_lab2   = glabel("y-axis")

            xLab <<- gedit(ifelse(!is.na(timeVar), timeVar, ""))
            yLab <<- gedit("")

            addHandlerKeystroke(xLab,
                handler = function(h, ...) {
                    if (!is.null(timer))
                        if (timer$started) timer$stop_timer()
                    timer <<- gtimer(200, function(...) {
                        updatePlot()
                    }, one.shot = TRUE)
                }
            )
            addHandlerKeystroke(yLab,
                handler = function(h, ...) {
                    if (!is.null(timer))
                        if (timer$started) timer$stop_timer()
                    timer <<- gtimer(200, function(...) {
                        updatePlot()
                    }, one.shot = TRUE)
                }
            )

            #size(xLab) <<- c(150, 21)
            #size(yLab) <<- c(150, 21)

            g4_layout[1, 1:2, expand = TRUE, anchor = c(-1, 0)] = g4_lab1
            g4_layout[2, 1:2, expand = TRUE, anchor = c(-1, 0)] = g4_lab2
            g4_layout[1, 3, expand = TRUE] = xLab
            g4_layout[2, 3, expand = TRUE] = yLab

            clearXlab <- iNZight:::gimagebutton(stock.id = "reset",
                handler = function(h, ...) {
                    svalue(xLab) <<- timeVar
                }
            )
            g4_layout[1, 4] <- clearXlab
            clearYlab <- iNZight:::gimagebutton(stock.id = "reset",
                handler = function(h, ...) {
                    svalue(yLab) <<- ""
                }
            )
            g4_layout[2, 4] <- clearYlab


            ############
            ###  g6  ###
            ############
            g6_layout = glayout(container = g6, homogeneous = TRUE)
            ii <- 1

            ## Control axis limits
            g6_layout[ii, 1, anchor = c(-1, 0), expand = TRUE] <-
                glabel("Display data from ... ")
            g6_layout[ii, 2, anchor = c(-1, 0), expand = TRUE] <-
                glabel("until ... ")
            ii <- ii + 1


            xlimLower <<- gslider(
                handler = function(h, ...) {
                    if (!is.null(timer))
                        if (timer$started)
                            timer$stop_timer()

                    timer <<- gtimer(200, function(...) updateLimits(),
                        one.shot = TRUE
                    )
                }
            )
            xlimUpper <<- gslider(
                handler = function(h, ...) {
                    if (!is.null(timer))
                        if (timer$started)
                            timer$stop_timer()

                    timer <<- gtimer(200, function(...) updateLimits(),
                        one.shot = TRUE
                    )
                }
            )
            g6_layout[ii, 1, expand = TRUE] <- xlimLower
            g6_layout[ii, 2, expand = TRUE] <- xlimUpper
            ii <- ii + 1

            updateLimits()

            ## Model limits
            modLimEqual <<- gcheckbox("Use above limits for fitting model",
                checked = TRUE)
            g6_layout[ii, 1:2, expand = TRUE] <- modLimEqual
            ii <- ii + 1

            modLimLower <<- gslider(
                handler = function(h, ...) {
                    if (!is.null(timer))
                        if (timer$started)
                            timer$stop_timer()

                    timer <<- gtimer(200, function(...) updateModLimits(),
                        one.shot = TRUE
                    )
                }
            )
            modLimUpper <<- gslider(
                handler = function(h, ...) {
                    if (!is.null(timer))
                        if (timer$started)
                            timer$stop_timer()

                    timer <<- gtimer(200, function(...) updateModLimits(),
                        one.shot = TRUE
                    )
                }
            )

            modlbl1 <- glabel("Fit model to data from ... ")
            modlbl2 <- glabel("until ... ")
            visible(modlbl1) <- visible(modlbl2) <- FALSE

            g6_layout[ii, 1, anchor = c(-1, 0), expand = TRUE] <- modlbl1
            g6_layout[ii, 2, anchor = c(-1, 0), expand = TRUE] <- modlbl2
            ii <- ii + 1

            g6_layout[ii, 1, expand = TRUE] <- modLimLower
            g6_layout[ii, 2, expand = TRUE] <- modLimUpper
            ii <- ii + 1

            updateModLimits()
            addHandlerChanged(modLimEqual,
                handler = function(h, ...) {
                    visible(modlbl1) <- visible(modlbl2) <- !svalue(h$obj)
                    updatePlot()
                }
            )


            ## Footer
            btmGrp <- modwin$footer

            helpButton <- gbutton("Help",
                expand = TRUE,
                fill = TRUE,
                cont = btmGrp,
                handler = function(h, ...) {
                    browseURL(
                        "https://www.stat.auckland.ac.nz/~wild/iNZight/user_guides/add_ons/?topic=time_series"
                    )
                }
            )
            homeButton <- gbutton("Home",
                expand = TRUE,
                fill = TRUE,
                cont = btmGrp,
                handler = function(h, ...) {
                    close()
                }
            )

            ## IF time series variable is chosen, plot first variable.
            svalue(varSelect, index = TRUE) <<- 1
        },

        # ========
        # METHODS
        # ========
        ## returns the time variable index
        getTime = function(data, index = TRUE) {
            ## look for time or date
            ind <- sapply(names(data),
                function(x) {
                    t <- try(iNZightTS:::get.ts.structure(data[[x]]), silent = TRUE)
                    if (inherits(t, "try-error")) return(FALSE)
                    return(!identical(t, list(start = NA, frequency = NA)))
                }
            )
            if (any(ind)) {
                ind <- which(ind)[1]
            } else {
                time_re <- "([Tt][Ii][Mm][Ee])|([Dd][Aa][Tt][Ee])"
                ind <- grep(time_re, names(data))
                ind <- if (length(ind) == 0) 1 else ind[1]
            }
            if (index) return(ind)
            return(names(data)[ind])
        },

        ## checks for a time variable in dataset
        isTS = function(data) {
            return(length(getTime(data)) != 0)
        },

        ## drops categorical variables (except the time variable)
        tsData = function(data) {
            time_index = getTime(data)
            num_index = sapply(data, is.numeric)
            num_index[time_index] <- TRUE
            data[, num_index]
        },

        ## update limit sliders
        updateLimits = function(react = TRUE) {
            if (is.null(tsObj)) {
                visible(xlimLower) <<- visible(xlimUpper) <<- FALSE
                return()
            }

            # store old values
            xr <- range(time(tsObj$tsObj))
            xby <- 1 / tsObj$freq
            xx <- seq(xr[1], xr[2], by = xby)
            xd <- as.character(tsObj$data[[timeVar]])

            xlim <- xr
            if (svalue(xlimLower) > 0)
                xlim[1] <- xx[xd == svalue(xlimLower)]
            if (svalue(xlimUpper) > 0)
                xlim[2] <- xx[xd == svalue(xlimUpper)]

            ## if upper limit gets too low, disable lower slider
            if (xlim[2] <= min(xx) + 2) {
                enabled(xlimLower) <<- FALSE
            } else {
                enabled(xlimLower) <<- TRUE
                blockHandlers(xlimLower)
                xlimLower$set_items(xd[xx <= xlim[2] - 2])
                xlimLower$set_value(xd[xx == xlim[1]])
                unblockHandlers(xlimLower)
            }

            ## if lower limit gets too high, disable upper slider
            if (xlim[1] >= max(xx) - 2) {
                enabled(xlimUpper) <<- FALSE
            } else {
                enabled(xlimUpper) <<- TRUE
                blockHandlers(xlimUpper)
                xlimUpper$set_items(xd[xx >= xlim[1] + 2])
                xlimUpper$set_value(xd[xx == xlim[2]])
                unblockHandlers(xlimUpper)
            }

            visible(xlimLower) <<- visible(xlimUpper) <<- TRUE
            # don't want to react when being called by updatePlot!
            if (react) updatePlot()
        },

        updateModLimits = function(react = TRUE) {
            if (is.null(tsObj)) {
                visible(modLimLower) <<- visible(modLimUpper) <<- FALSE
                return()
            }
            if (svalue(modLimEqual)) {
                svalue(modLimLower) <<- svalue(xlimLower)
                svalue(modLimUpper) <<- svalue(xlimUpper)
                visible(modLimLower) <<- visible(modLimUpper) <<- FALSE
                return()
            }

            # store old values
            xr <- range(time(tsObj$tsObj))
            xby <- 1 / tsObj$freq
            xx <- seq(xr[1], xr[2], by = xby)
            xd <- as.character(tsObj$data[[timeVar]])

            modlim <- xr
            if (svalue(modLimLower) > 0)
                modlim[1] <- xx[xd == svalue(modLimLower)]
            if (svalue(modLimUpper) > 0)
                modlim[2] <- xx[xd == svalue(modLimUpper)]

            ## if upper limit gets too low, disable lower slider
            if (modlim[2] <= min(xx) + 2) {
                enabled(modLimLower) <<- FALSE
            } else {
                enabled(modLimLower) <<- TRUE
                blockHandlers(modLimLower)
                modLimLower$set_items(xd[xx <= modlim[2] - 2])
                modLimLower$set_value(xd[xx == modlim[1]])
                unblockHandlers(modLimLower)
            }

            ## if lower limit gets too high, disable upper slider
            if (modlim[1] >= max(xx) - 2) {
                enabled(modLimUpper) <<- FALSE
            } else {
                enabled(modLimUpper) <<- TRUE
                blockHandlers(modLimUpper)
                modLimUpper$set_items(xd[xx >= modlim[1] + 2])
                modLimUpper$set_value(xd[xx == modlim[2]])
                unblockHandlers(modLimUpper)
            }

            visible(modLimLower) <<- visible(modLimUpper) <<- TRUE
            if (react) updatePlot()
        },

        ## draw the plot, depending on the settings
        updatePlot = function(animate = FALSE) {
            ## plot the TS object setup by the GUI

            if (animate) gmessage("Animation not yet implemented :(")
            animate <- FALSE

            decomp <<- NULL
            forecasts <<- NULL

            can.smooth <- TRUE
            smooth.t <- smoothness

            updateLimits(react = FALSE)
            updateModLimits(react = FALSE)

            xr <- range(time(tsObj$tsObj))
            xby <- 1 / tsObj$freq
            xx <- seq(xr[1], xr[2], by = xby)
            xd <- as.character(tsObj$data[[timeVar]])

            xlim <- xr
            if (svalue(xlimLower) > 0)
                xlim[1] <- xx[xd == svalue(xlimLower)]
            if (svalue(xlimUpper) > 0)
                xlim[2] <- xx[xd == svalue(xlimUpper)]

            modlim <- xlim
            if (!svalue(modLimEqual)) {
                if (svalue(modLimLower) > 0)
                    modlim[1] <- xx[xd == svalue(modLimLower)]
                if (svalue(modLimUpper) > 0)
                    modlim[2] <- xx[xd == svalue(modLimUpper)]
            }

            visible(forecastError) <<- FALSE

            if (is.null(tsObj)) {
                cat("Nothing to plot ...\n")
                plot.new()
            } else if (inherits(tsObj, "iNZightMTS")) { ## multiple vars
                p <- switch(compare,
                    plot(tsObj,
                        multiplicative = (patternType == 1),
                        xlab = svalue(xLab),
                        ylab = svalue(yLab),
                        t = smooth.t,
                        smoother = show.smoother,
                        xlim = xlim,
                        model.lim = modlim
                    ),
                    plot(tsObj,
                        multiplicative = (patternType == 1),
                        xlab = svalue(xLab),
                        ylab = svalue(yLab),
                        t = smooth.t,
                        smoother = show.smoother,
                        compare=FALSE,
                        xlim = xlim,
                        model.lim = modlim
                    )
                )
            } else { ## single var
                p <- switch(plottype,
                    {
                        ## 1 >> standard plot
                        ## patternType = 1 >> 'multiplicative'; 2 >> 'additive'
                        plot(tsObj,
                            multiplicative = (patternType == 1),
                            ylab = svalue(yLab),
                            xlab = svalue(xLab),
                            animate = animate,
                            t = smooth.t,
                            smoother = show.smoother,
                            xlim = xlim,
                            model.lim = modlim
                        )
                    },
                    {
                        ## 2 >> decomposed plot
                        decomp <<- plot(
                            iNZightTS::decompose(tsObj,
                                t = smooth.t,
                                multiplicative = (patternType == 1),
                                model.lim = modlim
                            ),
                            xlab = svalue(xLab),
                            ylab = svalue(yLab),
                            xlim = xlim,
                            recompose.progress = recompProg
                        )
                        visible(recomposeBtn) <<- TRUE
                        visible(recomposeResBtn) <<- TRUE
                        decomp
                    },
                    {
                        ## 3 >> season plot
                        iNZightTS::seasonplot(tsObj,
                            multiplicative = (patternType == 1),
                            xlab = svalue(xLab),
                            ylab = svalue(yLab),
                            t = smooth.t,
                            model.lim = modlim
                        )
                    },
                    {
                        ## 4 >> forecast plot
                        pl <- try(plot(tsObj,
                            multiplicative = (patternType == 1),
                            xlab = svalue(xLab),
                            ylab = svalue(yLab),
                            xlim = xlim,
                            model.lim = modlim,
                            forecast = tsObj$freq * 2
                        ), silent = TRUE)
                        if (inherits(pl, "try-error")) {
                            visible(forecastError) <<- TRUE
                            return()
                        }
                        forecasts <<- iNZightTS::pred(pl)
                        visible(forecastBtn) <<- TRUE
                        can.smooth <- FALSE
                        pl
                    }
                )

            }
            enabled(smthSlider) <<- can.smooth && show.smoother

            enabled(GUI$plotToolbar$exportplotBtn) <<-
                iNZightPlots::can.interact(p)

            invisible(p)
        },
        close = function() {
            ## delete the module window
            GUI$close_module()
            ## display the default view (data, variable, etc.)
            GUI$plotToolbar$restore()
            GUI$updatePlot()
        }
    )
)

## #iNZightTimeSeries()