inst/shiny_app/app.R

In thomasblanchet/gpinter: Generalized Pareto Interpolation

# Simple moving average function
movavg <- function(x, k) {
    n <- length(x)
    x_smooth <- vector(mode="numeric", length=n)
    for (i in 1:n) {
        i_min <- max(1, i - k)
        i_max <- min(n, i + k)
        x_smooth[i] <- mean(x[i_min:i_max], na.rm=TRUE)
    }
    return(x_smooth)
}

library(shiny)
library(shinyBS)
library(shinyjs)
library(evaluate)
library(openxlsx)
library(readxl)
library(gpinter)

# Increased max upload size to 50MB
options(shiny.maxRequestSize=50*1024^2)

# Set the zip command on Unix for shinyapps.io
if (.Platform$OS.type == "unix") {
    Sys.setenv(R_ZIPCMD = file.path("/", "usr", "bin", "zip"))
}

source(file.path("server", "parse-input.R"), local=TRUE)
source(file.path("server", "plot-text.R"), local=TRUE)

server <- function(input, output, session) {
    # g-percentiles: fractiles to show to the user
    gperc <- c(
        seq(0, 0.99, 0.01), seq(0.991, 0.999, 0.001),
        seq(0.9991, 0.9999, 0.0001), seq(0.99991, 0.99999, 0.00001)
    )

    # Reactive values for the input data and the results
    data <- reactiveValues(
        files_all         = NULL, # Files and Excel sheets in the uploaded files
        files_selected    = NULL, # Files and Excel sheets selected by the user
        input_data        = NULL, # Input data to be processed
        input_data_size   = NULL, # Number of tabulations to be processed
        input_errors      = NULL, # Errors generated during the import process
        input_years       = NULL, # Years in the selected input data
        input_countries   = NULL, # Countries in the selected input data
        input_components  = NULL, # Components in the selected input data
        output_dist       = NULL, # Distribution object generated by the programs
        output_tables     = NULL, # Output tables
        output_years      = NULL, # Years in the output data
        output_countries  = NULL, # Countries in the output data
        output_components = NULL, # Components in the output data
        years_merged      = NULL, # Years with merged distributions, if any
        components_merged = NULL  # Components with merged distributions, if any
    )

    observeEvent(input$go_to_help, {
        updateNavbarPage(session, "main_navbar", selected="Help")
    })

    source(file.path("server", "reset-clear.R"), local=TRUE)$value
    source(file.path("server", "import-data.R"), local=TRUE)$value
    source(file.path("server", "display-input-data.R"), local=TRUE)$value
    source(file.path("server", "run-program.R"), local=TRUE)$value
    source(file.path("server", "render-output-tables.R"), local=TRUE)$value
    source(file.path("server", "render-plot.R"), local=TRUE)$value
    source(file.path("server", "download-sample.R"), local=TRUE)$value
    source(file.path("server", "extra-tables.R"), local=TRUE)$value
}

ui <- tagList(
    useShinyjs(),
    tags$head(tags$script(src="notify.js")),
    tags$head(tags$script(src="set-up-notifications.js")),
    navbarPage(
        title = actionLink("main_logo", tagList(
            tags$span("generalized Pareto interpolation")
        )),
        source(file.path("ui", "tab-input-data.R"), local=TRUE)$value,
        source(file.path("ui", "tab-output-tables.R"), local=TRUE)$value,
        source(file.path("ui", "tab-plots.R"), local=TRUE)$value,
        source(file.path("ui", "tab-sample.R"), local=TRUE)$value,
        source(file.path("ui", "tab-settings.R"), local=TRUE)$value,
        source(file.path("ui", "tab-help.R"), local=TRUE)$value,
        id = "main_navbar",
        selected = "Input data",
        position = "static-top",
        inverse = TRUE,
        theme = "style.css",
        windowTitle = "WID - Generalized Pareto interpolation"
    )
)

shinyApp(ui=ui, server=server)