inst/shinyApps/paramGUI/app.R

In paramGUI: A Shiny GUI for some Parameter Estimation Examples

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

## paramGUI dependencies
library(TIMP)
library(paramGUI)

## Shiny app.R dependencies ##
library(shiny)
library(shinydashboard)
# Potentially useful but unused libraries
# library(shinyjs)
# library(DT) # https://yihui.shinyapps.io/DT-rows/
# library(shinyBS)

#' Compile a list of spectral parameters (location, width, skewness)
#'
#' @param spec_loc
#' @param spec_wid
#' @param spec_b
#'
#' @return
#'
newSpecList <- function(spec_loc, spec_wid, spec_b) {
  specvec <- vector("list", length(spec_loc))
  for (i in 1:length(spec_loc)) {
    specvec[[i]][1] <- as.double(spec_loc[i])
    specvec[[i]][2] <- as.double(spec_wid[i])
    specvec[[i]][3] <- as.double(spec_b[i])
  }
  specvec
}

ui <- dashboardPage(
  dashboardHeader(title = "paramGUI"), # Remove ), from this line an uncomment the next to enable notifcation menu.
  # dropdownMenuOutput("messageMenu"),dropdownMenuOutput("notificationMenu")),

  dashboardSidebar(

    tags$head(tags$style(HTML("
                              /* Change padding of sub-menu items */
                              .row {
                              margin-right: 5px;
                              margin-left: 1px;
                              }
                              .sidebar {
                              padding-right: 5px;
                              }
                              section.sidebar .shiny-input-container {
                              padding: 0px 4px 0px 4px;
                              }
                              .col-sm-4, .col-sm-8 {
                              min-height: 1px;
                              padding-right: 0px;
                              padding-left: 1px;
                              }
                              .col-sm-6 {
                              min-height: 1px;
                              padding-right: 0px;
                              padding-left: 1px;
                              }
                              .col-sm-12 {
                              min-height: 1px;
                              padding-right: 0px;
                              padding-left: 10px;
                              }
                              .form-control {
                              display: block;
                              width: 100%;
                              height: 22px;
                              padding: 0px 4px;
                              }
                              .form-group {
                              margin-bottom: 5px;
                              margin-left: 5px;
                              }


                              "))),
    tabsetPanel(
      tabPanel(
        "Simulate",
        textInput("simDecayRates", label = "Decay rates: ", value = "0.055,0.005"),
        textInput("simAmplitudes", label = "Amplitudes: ", value = "1.,1."),
        textInput("simSpecLoc", label = div(HTML("Location (mean) of spectra (cm<sup>-1</sup>):")), value = "22000,20000"),
        textInput("simSpecWidth", label = div(HTML("Width of spectra (cm<sup>-1</sup>):")), value = "4000,3500"),
        textInput("simSpecSkew", label = "Skewness of spectra:", value = "0.1, -0.1"),
        fluidRow(
          column(8, textInput("simMaxTime", label = "Timepoints, max:", value = "80")),
          column(4, textInput("simTimeStep", label = "stepsize:", value = "1"))
        ),
        fluidRow(
          column(12, HTML("<b>Wavelength (nm):</b>"))
        ),
        fluidRow(
          column(
            4,
            textInput("simMinWavelength", label = "Min:", value = "400")
          ),
          column(
            4,
            textInput("simMaxWavelength", label = "Max:", value = "600")
          ),
          column(
            4,
            textInput("simWavelengthStepSize", label = "Stepsize:", value = "5")
          )
        ),
        fluidRow(
          column(6, textInput("simFracNoise", label = "Stdev. noise:", value = "1E-2")),
          column(6, numericInput("simSeed", label = "Seed:", value = "123", min = 0, step = 1))
        ),
        checkboxInput("simEnableIRF", label = "Add Gaussian IRF", value = FALSE, width = NULL),
        conditionalPanel(
          condition = "(input.simEnableIRF== true)",
          fluidRow(
            column(6, textInput("simLocIRF", label = "IRF Location:", value = "2.0")),
            column(6, textInput("simWidthIRF", label = "IRF Width:", value = "1.0"))
          )
        ),
        checkboxInput("simSeqmod", label = "Use a sequential scheme", value = FALSE, width = NULL),
        actionButton("simButton", "Simulate")
      ), # end of Simulate tab

      tabPanel(
        "Fitting",
        selectInput("modelType",
          label = h5("Select a model type"),
          choices = list("Kinetic" = "kin", "Spectral" = "spec", "Spectrotemporal" = "spectemp"),
          selected = "kin"
        ),
        conditionalPanel(
          condition = "(input.modelType=='kin' || input.modelType=='spectemp')",
          textInput("fitDecayRates", label = "Decay rates: ", value = "0.055,0.005")
        ),
        conditionalPanel(
          condition = "(input.modelType=='spec' || input.modelType=='spectemp')",
          textInput("fitSpecLoc", label = "Location (mean) of spectra:", value = "22000,20000"),
          textInput("fitSpecWidth", label = "Width of spectra:", value = "4000,3500"),
          textInput("fitSpecSkew", label = "Skewness of spectra:", value = "0.1, -0.1")
        ),
        conditionalPanel(
          condition = "(input.modelType=='kin' || input.modelType=='spectemp')",
          fluidRow(
            column(6, checkboxInput("fitEnableIRF", label = "Gaussian IRF", value = FALSE, width = NULL)),
            column(6, checkboxInput("fitEnableStreak", label = "Backsweep?", value = FALSE))
          ),
          conditionalPanel(
            condition = "(input.fitEnableIRF== true)",
            fluidRow(
              column(6, textInput("fitLocIRF", label = "IRF Location:", value = "2.0")),
              column(6, textInput("fitWidthIRF", label = "IRF Width:", value = "1.0"))
            )
          ),
          checkboxInput("fitSeqmod", label = "Use a sequential scheme", value = FALSE, width = NULL),
          checkboxInput("fitPosDec", label = "Force positive decay rates", value = FALSE, width = NULL)
        ),
        conditionalPanel(
          condition = "(input.modelType=='spectemp')",
          checkboxInput("fitKroncol", label = "Single amplitude per component", value = FALSE, width = NULL)
        ),
        numericInput("fitLinAxis", label = "Linear-Log axis (0 for linear):", value = 0, min = 0),
        numericInput("fitNumIters", label = "Max. number of iterations:", value = "7", min = 0, max = 99, step = 1),

        # uiOutput("specControls"),
        # conditionalPanel(condition = '!input.fitButton',
        # helpText("Note: you might need to increase the number of iterations to reach convergence")
        # )
        # ,
        fluidRow(
          column(6, actionButton("fitButton", "Fit model")),
          column(6, conditionalPanel(
            condition = "input.fitButton",
            actionButton("updateModelButton", "Update model")
          ))
        ),
        conditionalPanel(
          condition = "input.fitButton",
          helpText("Update model updates the input field with the results from your last fit.")
        )
      ),
      tabPanel(
        "I/O",
        h4("Load data"),
        fileInput("loadData", label = NULL),
        tags$script('$( "#loadData" ).on( "click", function() { this.value = null; });'),
        tags$script('$(document).on("keypress", function (e) { Shiny.onInputChange("keyPressed", [e.which,e.timeStamp]); });'),
        # http://stackoverflow.com/questions/34441584/re-upload-same-file-shiny-r
        # TODO: http://stackoverflow.com/questions/17352086/how-can-i-update-a-shiny-fileinput-object
        actionButton("loadDefaultDataButton", label = "Load Default Data"),
        h4("Save data"),
        conditionalPanel(
          condition = "!input.simButton",
          helpText("Note: once you have simulated data the option to save your data locally or export (download) your data will appear here.")
        ),
        conditionalPanel(
          condition = "input.simButton",
          textInput("simFilename", label = "Base filename:", value = "sim"),
          fluidRow(
            column(6, actionButton("saveDataButton", label = "Save")),
            column(6, downloadButton("downloadData", label = "Download"))
          ),
          helpText("The save button will save your data to your home/documents folder, the download button will allow your to download the file (but only in a real browser).")
        )
      )
    ),
    width = 300
  ),
  dashboardBody(
    # Boxes need to be put in a row (or column)
    tags$head(tags$style(HTML("
                              /* Change padding of sub-menu items */
                              .sidebar .sidebar-menu .treeview-menu>li>a {
                              padding: 5px 5px 5px 8px;
                              }

                              /* Hide icons in sub-menu items */
                              .sidebar .sidebar-menu .treeview-menu>li>a>.fa {
                              display: none;
                              }
                              pre {
                              height: 80vh;
                              overflow-y: auto;
                              overflow-x: auto;
                              word-wrap: normal;
                              }
                              "))),
    fluidRow(
      tabBox(
        title = "RESULTS",
        id = "outputTabs", height = "700px", width = "670px",
        tabPanel(
          "Data",
          plotOutput("dataPlot", height = 650, width = 900)
          # ,checkboxInput("advPlotting", NULL, value = FALSE, width = NULL)
        ),
        tabPanel(
          "Fit progression",
          verbatimTextOutput("fitProgressOutput")
        ),
        tabPanel(
          "Fit results",
          plotOutput("fitPlot", height = 650, width = 900)
        ),
        # http://stackoverflow.com/questions/19470426/r-shiny-add-tabpanel-to-tabsetpanel-dynamicaly-with-the-use-of-renderui
        # conditionalPanel(condition = 'input.fitButton',
        tabPanel(
          "Diagnostics",
          verbatimTextOutput("consoleOutput"),
          actionButton("printSummaryButton", "Print summary")
        )
        # )
      )
    )
  )
)

server <- function(input, output, session) {
  rvs <- reactiveValues()
  rvs$guessIRF <- FALSE
  rvs$nosiminfo <- TRUE
  rvs$DEBUG <- FALSE

  # output$specControls <- renderUI({
  #  if((input$modelType == "kin" || input$modelType == "spectemp")) {
  #
  #  }
  # })

  output$downloadData <- downloadHandler(
    filename = function() {
      timestamp <- format(Sys.time(), "%Y%m%d_%H%M")
      paste0(isolate(input$simFilename), "-", timestamp, ".rds", sep = "")
    },
    content = function(file) {
      sim <- isolate(rvs$simData)
      save(sim, file = file)
      # saveRDS(isolate(rvs$simData), file)
    }
  )



  output$messageMenu <- renderMenu({
    # Code to generate each of the messageItems here, in a list. This assumes
    # that messageData is a data frame with two columns, 'from' and 'message'.
    # msgs <- apply(messageData, 1, function(row) {
    #  messageItem(from = row[["from"]], message = row[["message"]])
    # })

    # This is equivalent to calling:
    #   dropdownMenu(type="messages", msgs[[1]], msgs[[2]], ...)
    dropdownMenu(
      type = "messages",
      messageItem(
        from = "Administrator",
        message = "Please register"
      )
      # .list = msgs
    )
  })

  output$notificationMenu <- renderMenu({
    dropdownMenu(
      type = "notifications",
      messageItem(
        from = "New User",
        message = "How do I register?",
        icon = icon("question"),
        time = "13:45"
      ),
      notificationItem(
        text = "Server load at 86%",
        icon = icon("exclamation-triangle"),
        status = "warning"
      )
      # .list = msgs
    )
  })


  observeEvent(input$simButton, {
    updateTabsetPanel(session, "outputTabs", selected = "Data")

    set.seed(isolate(input$simSeed))

    validInput <- TRUE
    kinpar <- as.double(strsplit(isolate(input$simDecayRates), ",")[[1]])
    amplitudes <- as.double(strsplit(input$simAmplitudes, ",")[[1]])
    spec_loc <- strsplit(isolate(input$simSpecLoc), ",")[[1]]
    spec_wid <- strsplit(isolate(input$simSpecWidth), ",")[[1]]
    spec_b <- strsplit(isolate(input$simSpecSkew), ",")[[1]]
    tmax <- as.double(isolate(input$simMaxTime))
    deltat <- as.double(isolate(input$simTimeStep))
    lmin <- as.double(isolate(input$simMinWavelength))
    lmax <- as.double(isolate(input$simMaxWavelength))
    linAxis <- isolate(input$fitLinAxis)
    linr <- if (is.na(linAxis)) {
      NA
    } else {
      if (linAxis < 0.1) {
        NA
      } else {
        linAxis
      }
    }
    deltal <- as.double(isolate(input$simWavelengthStepSize))
    sigma <- as.double(gsub(",", ".", isolate(input$simFracNoise)))
    irf <- isolate(input$simEnableIRF)
    irfloc <- as.double(isolate(input$simLocIRF))
    irfwidth <- as.double(isolate(input$simWidthIRF))
    seqmod <- isolate(input$simSeqmod)
    specvec <- newSpecList(spec_loc, spec_wid, spec_b)

    if (rvs$DEBUG) {
      cat("# Simulating data with function call: \n")
      cat(
        "simndecay_gen_paramGUI(kinpar =", deparse(kinpar), ",",
        "amplitudes = ", deparse(amplitudes), ",",
        "tmax = ", tmax, ",",
        "deltat= ", deltat, ",",
        "specpar= ", deparse(specvec), ",",
        "lmin= ", lmin, ",",
        "lmax= ", lmax, ",",
        "deltal= ", deltal, ",",
        "sigma= ", sigma, ",",
        "irf = ", irf, ",",
        "irfpar = c(", irfloc, ",", irfwidth, ")", ",",
        "seqmod =", seqmod, ")\n"
      )
    }

    if (is.na(lmin) || is.na(lmax) || is.na(tmax) || is.na(deltal)) {
      validInput <- FALSE
      output$dataPlot <- renderPlot({
        plotMessage("Error: invalid timepoints or wavelength specification", "red")
      })
    }

    inputList <- list(kinpar, amplitudes, spec_loc, spec_wid, spec_b)
    if (!length(unique(sapply(inputList, length))) == 1) {
      validInput <- FALSE
      output$dataPlot <- renderPlot({
        plotMessage("Error: parameter fields of unequal length", "red")
      })
    }

    if (validInput) {
      rvs$simData <- simndecay_gen_paramGUI(
        kinpar = kinpar,
        amplitudes = amplitudes,
        tmax = tmax,
        deltat = deltat,
        specpar = specvec,
        lmin = lmin,
        lmax = lmax,
        deltal = deltal,
        sigma = sigma,
        irf = irf, irfpar = c(irfloc, irfwidth),
        seqmod = seqmod,
        nosiminfo = isolate(rvs$nosiminfo)
      )

      # assign(".sim", isolate(rvs$simData) , globalenv())
      updateDataPlot(irfloc, linr)
    } else {
      cat("Invalid simulation input. No data was generated!", file = stderr())
    }
  })

  observeEvent(input$fitButton, {
    withProgress(
      {
        ## This works with a function like message
        ## withCallingHandlers({
        ## shinyjs::html("fitProgressOutput","")
        ##

        updateTabsetPanel(session, "outputTabs", selected = "Fit progression")

        kinpar <- as.double(strsplit(isolate(input$fitDecayRates), ",")[[1]])
        spec_loc <- strsplit(isolate(input$fitSpecLoc), ",")[[1]]
        spec_wid <- strsplit(isolate(input$fitSpecWidth), ",")[[1]]
        spec_b <- strsplit(isolate(input$fitSpecSkew), ",")[[1]]
        specvec <- newSpecList(spec_loc, spec_wid, spec_b)
        kroncol <- input$fitKroncol
        irf <- input$fitEnableIRF
        irfloc <- as.double(isolate(input$fitLocIRF))
        irfwidth <- as.double(isolate(input$fitWidthIRF))
        irfpar <- c(irfloc, irfwidth)
        seqmod <- input$fitSeqmod
        positivepar <- input$fitPosDec
        streak <- input$fitEnableStreak
        rvs$modelType <- input$modelType
        linAxis <- isolate(input$fitLinAxis)
        linr <- if (is.na(linAxis)) {
          NA
        } else {
          if (linAxis < 0.1) {
            NA
          } else {
            linAxis
          }
        }
        iters <- isolate(input$fitNumIters)

        isolate({
          if ((isolate(rvs$modelType) == "kin")) {
            output$fitProgressOutput <- renderPrint({
              rvs$kinModel <- initModel(
                mod_type = "kin", kinpar = kinpar, irf = irf,
                irfpar = if (irf) irfpar else vector(),
                streak = streak,
                streakT = 13164.8235,
                positivepar = if (positivepar) c("kinpar") else vector(),
                seqmod = seqmod
              )

              rvs$kinFit <- fitModel(data = list(isolate(rvs$simData)), modspec = list(isolate(rvs$kinModel)), opt = kinopt(iter = iters, plot = FALSE))
              rvs$kinFitSummary <- summary(isolate(rvs$kinFit)$currModel@fit@nlsres[[1]],
                currModel = isolate(rvs$kinFit)$currModel,
                currTheta = isolate(rvs$kinFit)$currTheta,
                correlation = TRUE
              )
              updateConsole(isolate(rvs$modelType))
              updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr))
            })
          } else if (isolate(rvs$modelType) == "spec") {
            output$fitProgressOutput <- renderPrint({
              rvs$specModel <- initModel(mod_type = "spec", specpar = specvec, nupow = 1)

              rvs$specFit <- fitModel(data = list(isolate(rvs$simData)), modspec = list(isolate(rvs$specModel)), opt = kinopt(iter = iters, plot = FALSE))

              rvs$specFitSummary <- summary(isolate(rvs$specFit)$currModel@fit@nlsres[[1]],
                currModel = isolate(rvs$specFit)$currModel,
                currTheta = isolate(rvs$specFit)$currTheta,
                correlation = TRUE
              )
              updateConsole(isolate(rvs$modelType))
              updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$specModel), isolate(rvs$specFit), linr = isolate(linr))
            })
            # Currently the kin and spectemp models are treated the same
          } else if (isolate(rvs$modelType) == "spectemp") {
            output$fitProgressOutput <- renderPrint({
              rvs$spectempModel <- initModel(
                mod_type = "kin", kinpar = kinpar, irf = irf,
                irfpar = if (irf) irfpar else vector(),
                streak = streak,
                streakT = 13164.8235,
                positivepar = positivepar,
                seqmod = seqmod
              )
              isolate({
                rvs$spectempModel@specpar <- isolate(specvec)
                rvs$spectempFit <- spectemp(isolate(rvs$simData), isolate(rvs$spectempModel), iter = iters, kroncol = kroncol, lin = linr, l_posk = positivepar)
                rvs$spectempFitSummary <- summary(isolate(rvs$spectempFit$onls))
                rvs$spectempFitTheta <- isolate(rvs$spectempFit$theta)
                updateConsole(isolate(rvs$modelType))

                updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$spectempModel), isolate(rvs$spectempFit$onls), isolate(rvs$spectempFitTheta), linr = isolate(linr))
              })
            })
          } else {
            setProgress(value = 0, message = "failed.")
            print("model not implemented", file = stderr())
          }
        }) ## end of isolate
      },
      message = "fitting data ..."
    ) ## end of withProgress
  })

  observeEvent(input$saveDataButton, {
    tryFilename <- paste(isolate(input$simFilename), "-", format(Sys.time(), "%Y%m%d_%H%M"), ".rds", sep = "")
    tryFullFilename <- file.path(path.expand("~"), tryFilename)
    # saveRDS(isolate(rvs$simData), tryFullFilename)
    sim <- isolate(rvs$simData)
    save(sim, file = tryFullFilename)
    cat("File was saved to:\n", tryFullFilename, "\n", file = stdout())
  })

  observeEvent(input$updateModelButton, {
    # # fitDecayRates, fitLocIRF, fitWidthIRF
    isolate({
      if (rvs$modelType == "kin" && !is.null(isolate(rvs$kinFit))) {
        updateTextInput(session, "fitDecayRates", value = toString(signif(rvs$kinFit$currTheta[[1]]@kinpar, digits = 4)))
        if (length(rvs$kinFit$currTheta[[1]]@irfpar) > 0) {
          updateTextInput(session, "fitLocIRF", value = toString(signif(rvs$kinFit$currTheta[[1]]@irfpar[[1]], digits = 4)))
          updateTextInput(session, "fitWidthIRF", value = toString(signif(rvs$kinFit$currTheta[[1]]@irfpar[[2]], digits = 4)))
        }
        # updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr))
      }
      # # fitSpecLoc fitSpecWidth  fitSpecSkew
      if (rvs$modelType == "spec" && !is.null(isolate(rvs$specFit))) {
        nsc <- length(rvs$specFit$currTheta[[1]]@specpar) # numberOfSpectralComponents
        if (nsc > 0) {
          spectralParameterVector <- do.call(c, rvs$specFit$currTheta[[1]]@specpar)
          updateTextInput(session, "fitSpecLoc", value = toString(signif(spectralParameterVector[seq(1, 3 * nsc, 3)], digits = 4)))
          updateTextInput(session, "fitSpecWidth", value = toString(signif(spectralParameterVector[seq(2, 3 * nsc, 3)], digits = 4)))
          updateTextInput(session, "fitSpecSkew", value = toString(signif(spectralParameterVector[seq(3, 3 * nsc, 3)], digits = 4)))
        }
        # updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$specModel), isolate(rvs$specFit), linr = isolate(linr))
      }
      if (rvs$modelType == "spectemp" && !is.null(isolate(rvs$spectempFit))) {
        updateTextInput(session, "fitDecayRates", value = toString(signif(rvs$spectempFit[[1]]@kinpar, digits = 4)))
        if (length(rvs$spectempFit[[1]]@irfpar) > 0) {
          updateTextInput(session, "fitLocIRF", value = toString(signif(rvs$spectempFit[[1]]@irfpar[[1]], digits = 4)))
          updateTextInput(session, "fitWidthIRF", value = toString(signif(rvs$spectempFit[[1]]@irfpar[[2]], digits = 4)))
        }
        nsc <- (length(rvs$spectempFit[[1]]@specpar[[1]]) / 3) # numberOfSpectralComponents
        if (nsc > 0) {
          spectralParameterVector <- rvs$spectempFit[[1]]@specpar[[1]]
          updateTextInput(session, "fitSpecLoc", value = toString(signif(spectralParameterVector[seq(1, 3 * nsc, 3)], digits = 4)))
          updateTextInput(session, "fitSpecWidth", value = toString(signif(spectralParameterVector[seq(2, 3 * nsc, 3)], digits = 4)))
          updateTextInput(session, "fitSpecSkew", value = toString(signif(spectralParameterVector[seq(3, 3 * nsc, 3)], digits = 4)))
        }
      }
    })
  })

  observeEvent(input$printSummaryButton, {
    resultToPrint <- switch(input$modelType,
      kin = rvs$kinFitSummary,
      spec = rvs$specFitSummary,
      spectemp = rvs$spectempFitSummary
    )
    print(resultToPrint,
      file = stdout()
    )
  })

  updatePlots <- function(modType = "kin", data, model = NULL, result = NULL, theta = NULL, linr = NA) {
    output$fitPlot <- renderPlot(
      {
        plotterforGUI(modtype = modType, data = data, model = model, result = result, theta = theta, lin = linr, guessIRF = isolate(rvs$guessIRF))
      },
      res = 96
    )
  }

  updateDataPlot <- function(irfloc, linr) {
    # Plot the simulated data, and render it to the dataPlot field in output.
    output$dataPlot <- renderPlot(
      {
        plotterforGUI(modtype = "kin", data = isolate(rvs$simData), model = NULL, result = NULL, mu = irfloc, lin = linr, guessIRF = isolate(rvs$guessIRF))
      },
      res = 96
    )
  }

  plotMessage <- function(plotmsg = "An arror occured", msgcolor = "black") {
    par(mar = c(0, 0, 0, 0))
    plot(c(0, 1), c(0, 1), ann = F, bty = "n", type = "n", xaxt = "n", yaxt = "n")
    usr <- par("usr")
    text(
      x = usr[1], y = usr[4], paste(plotmsg), adj = c(0, 1),
      cex = 1.6, col = msgcolor
    )
  }

  updateConsole <- function(modelType) {
    resultToPrint <- switch(modelType,
      kin = isolate(rvs$kinFitSummary),
      spec = isolate(rvs$specFitSummary),
      spectemp = isolate(rvs$spectempFitSummary)
    )
    output$consoleOutput <- renderPrint({
      print(resultToPrint, width = 100)
    })
  }

  observe({
    linAxis <- input$fitLinAxis
    linr <- if (is.na(linAxis)) {
      NA
    } else {
      if (linAxis < 0.1) {
        NA
      } else {
        linAxis
      }
    }
    irfloc <- 0 # as.double(isolate(input$simLocIRF))
    if (!is.null(isolate(rvs$simData))) {
      updateDataPlot(irfloc, linr)
    }
    # updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr))
    if (!is.null(isolate(rvs$simData))) {
      if (rvs$modelType == "kin" && !is.null(isolate(rvs$kinFit))) updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$kinModel), isolate(rvs$kinFit), linr = isolate(linr))
      if (rvs$modelType == "spec" && !is.null(isolate(rvs$specFit))) updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$specModel), isolate(rvs$specFit), linr = isolate(linr))
      if (rvs$modelType == "spectemp" && !is.null(isolate(rvs$spectempFit))) updatePlots(isolate(rvs$modelType), isolate(rvs$simData), isolate(rvs$spectempModel), isolate(rvs$spectempFit$onls), isolate(rvs$spectempFitTheta), linr = isolate(linr))
    }
  })

  observe({
    infile <- input$loadData
    if (is.null(infile)) {
      return(NULL)
    } else {
      if (paramGUI::is_rdata(infile$datapath)) {
        load(infile$datapath)
        rvs$simData <- sim
        # assign(".sim", sim,globalenv())
      } else {
        # First check if the file is readable by TIMP
        testHeader <- scan(file = infile$datapath, skip = 2, nlines = 2, what = " ")
        matchedKeywords <- length(grep(paste(c("Time", "Wavelength", "explicit", "Intervalnr"), collapse = "|"), testHeader, ignore.case = TRUE, value = TRUE))
        if (matchedKeywords > 2) {
          rvs$simData <- TIMP::readData(infile$datapath)
        } else {
          print("# Unable to load data.\n", file = stderr())
        }
      }
      updateTabsetPanel(session, "outputTabs", selected = "Data")
      output$dataPlot <- renderPlot(
        {
          plotterforGUI(modtype = "kin", data = isolate(rvs$simData), model = NULL, result = NULL, mu = 0)
        },
        res = 96
      )
    }
  })

  observeEvent(input$loadDefaultDataButton, {
    loadDefaultData()
  })

  loadDefaultData <- function() {
    print("\nLoading data representing the peridinin chlorophyll protein (PCP) excited with 490 nm laser light...\n", file = stdout())
    rvs$simData <- dat(
      psi.df = datamat, x2 = waves, x = times,
      nt = length(times), nl = length(waves), simdata = FALSE
    )
    updateTabsetPanel(session, "outputTabs", selected = "Data")
    output$dataPlot <- renderPlot(
      {
        plotterforGUI(modtype = "kin", data = isolate(rvs$simData), model = NULL, result = NULL, mu = 0, lin = 1)
      },
      res = 96
    )
  }

  # Function that listens to key presses
  observe({
    if (!is.null(input$keyPressed)) {
      # 4 # CTRL+SHIFT+D # Toggle debug
      # 9 # CTRL+SHIFT+I # Toggle simulation object info
      # 19 # CTRL+SHIFT+S # Something with save
      if (isolate(rvs$DEBUG)) {
        cat("You pressed: ", input$keyPressed[[1]], "\n", file = stderr())
      }
      if (input$keyPressed[[1]] == 192) { # 192 #ctrl+~
        if (isolate(rvs$DEBUG)) cat("Toggled guessIRF to: ", !isolate(rvs$guessIRF), "\n")
        rvs$guessIRF <- !isolate(rvs$guessIRF)
      }
      if (input$keyPressed[[1]] == 9) {
        if (isolate(rvs$DEBUG)) cat("Toggled nosiminfo to: ", !isolate(rvs$nosiminfo), "\n")
        rvs$nosiminfo <- !isolate(rvs$nosiminfo)
      }
      if (input$keyPressed[[1]] == 4) {
        cat("Toggled DEBUG to: ", !isolate(rvs$DEBUG), "\n")
        rvs$DEBUG <- !isolate(rvs$DEBUG)
      }
    }
  })
}

shinyApp(ui, server)