Generator of a shiny app from a data.table -- time-series explorer; USE R PACKAGE https://github.com/alekrutkowski/tsShinyApp INSTEAD

README.md

write_ts_shiny_app

write_ts_shiny_app() generates a ready-to-run Shiny time-series explorer from a data.table.

Given a suitable input data.table, the function creates:

my-ts-app/
├── app.R
└── data.rds

The generated app provides:

• server-side, multiple-selection Selectize filters for every categorical column;
• one interactive Plotly chart for every numeric measure column;
• time-window selection;
• optional rebasing of every displayed series to 100 at a user-selected time point;
• optional point markers;
• independently resizable chart cards, including width, height, and corner resizing;
• full-screen chart mode;
• a working spinner while Shiny or Plotly is busy;
• automatic limiting to 10 displayed time series when the current filters select more than 10 series, with a prominent warning in the top bar;
• automatic WebGL rendering for sufficiently large individual charts.

Installation

The generator itself requires data.table. The generated application requires shiny, bslib, data.table, and plotly.

Install all required packages with:

install.packages(c(
  "data.table",
  "shiny",
  "bslib",
  "plotly"
))

Then source the generator:

source("write_ts_shiny_app.R")

Basic usage

library(data.table)

DT <- CJ(
  COUNTRY = c("A", "B"),
  AGE = c("15-24", "25-64"),
  time = c("2024-Q1", "2024-Q2", "2024-Q3", "2024-Q4")
)

set.seed(1)

DT[, `:=`(
  employment = runif(.N, 60, 80),
  unemployment = runif(.N, 3, 12)
)]

write_ts_shiny_app(
  DT,
  out_dir = "my-ts-app",
  title = "Labour-market indicators"
)

shiny::runApp("my-ts-app")

The application directory contains app.R and its RDS data file. Keep those files together.

Function signature

write_ts_shiny_app(
  dt,
  out_dir = "shiny-ts-app",
  app_file = "app.R",
  data_file = "data.rds",
  title = "Time-series explorer",
  overwrite = FALSE,
  compress = "gzip"
)

Argument requirements

Argument	Default	Requirements and meaning
dt	required	A non-empty data.table with unique column names. It must contain exactly one time column named time or time_period, matched case-insensitively. After excluding the time column, it must contain at least one numeric column. See Input data requirements.
out_dir	"shiny-ts-app"	One non-empty character string naming the output directory. The directory is created recursively if necessary.
app_file	"app.R"	One non-empty character string containing a file name only, not a path. Normally leave this as "app.R".
data_file	"data.rds"	One non-empty character string containing a file name only, not a path. The generated app.R expects this file to be in the same directory.
title	"Time-series explorer"	One non-NA character string used as the application title.
overwrite	FALSE	Only TRUE permits an existing app_file or data_file to be overwritten. Otherwise the function stops rather than replacing existing files.
compress	"gzip"	Passed directly to saveRDS(..., compress = compress). Common choices are TRUE, FALSE, "gzip", "bzip2", and "xz". Current R versions can also support "zstd"; zstd support was introduced in R 4.5.0 and depends on the R build.

See the R documentation for saveRDS() for compression details.

Input data requirements

1. dt must be a data.table

This is valid:

library(data.table)

DT <- data.table(
  country = c("A", "A", "A"),
  time = c(2022, 2023, 2024),
  value = c(10.2, 11.4, 12.1)
)

A plain data.frame is not accepted directly. Convert it first:

DT <- as.data.table(my_data_frame)

2. There must be exactly one time column

The time column must be named either:

time

or:

time_period

Matching is case-insensitive, so names such as TIME, Time, or TIME_PERIOD also work.

Do not provide both time and time_period in the same table.

The time column may itself be numeric, character, factor, ordered factor, Date, or another suitable atomic vector.

It must contain at least one usable, non-missing time value for the generated app to start.

3. Numeric columns are measures

Every numeric column other than the time column is treated as a measure and receives its own chart.

For example:

DT <- data.table(
  country = c("A", "A"),
  time = c("2024-Q1", "2024-Q2"),
  GDP = c(101.2, 102.7),
  unemployment = c(5.1, 4.9)
)

produces separate GDP and unemployment charts.

Important

If a categorical dimension is encoded numerically, convert it to character or factor before calling write_ts_shiny_app(). Otherwise it will be interpreted as a numeric measure.

For example:

DT[, region_code := factor(region_code)]

4. Non-numeric columns are categorical dimensions

Every non-numeric column other than the time column becomes:

1. a multiple-selection filter in the sidebar; and
2. part of the identity of a time series.

Categorical columns must be ordinary atomic vectors. Matrix/list-like columns, complex columns, and raw columns are not accepted as categorical dimensions.

Missing categorical values are supported and appear in filters as (Missing). Empty character strings appear as (Blank).

5. Time plus all categorical columns must uniquely identify rows

The function does not aggregate observations.

The combination

c(time_column, all_categorical_columns)

must uniquely identify every row of dt.

For example, with:

COUNTRY
AGE
SEX
time
value

the key is:

COUNTRY + AGE + SEX + time

There may be only one row for each such combination.

If duplicate combinations exist, write_ts_shiny_app() stops and prints example duplicate keys so they can be resolved before app creation.

You can check the condition yourself with:

key_cols <- c("time", "COUNTRY", "AGE", "SEX")

data.table::uniqueN(DT, by = key_cols) == nrow(DT)

If there are no categorical columns, the time column alone must uniquely identify each row.

Time ordering

The app creates an internal ordered time index while preserving the original time labels for display.

It directly handles numeric time values, ordered factors, Date values, and POSIX date-times. It also recognizes common textual period formats, including variants of:

2024
FY2024

2024-Q1
2024Q1
Q1-2024
Q12024

2024-H1
H1-2024

2024-M01
2024M1
202401

2024-W01
2024W1

2024-01-31
2024/01/31

Jan 2024
January 2024
2024 Jan
2024 January

Spaces and common separators are ignored when recognizing period labels.

If character/factor labels do not match a recognized period format, the app falls back to stable lexical ordering. For unusual time encodings, using an ordered factor is therefore a convenient way to specify the intended order explicitly:

DT[, time := factor(
  time,
  levels = c("Before", "During", "After"),
  ordered = TRUE
)]

Running the generated app

If the app was written to:

my-ts-app/

run:

shiny::runApp("my-ts-app")

runApp() accepts a directory containing an app.R file. See the official runApp() documentation.

The generated app checks its required R packages at startup and reports any that are missing.

Filtering

Each categorical column receives a multiple-selection Selectize control.

An empty selector means:

include all values

Selecting multiple values compares the corresponding time series.

The generated app uses server-side Selectize choices to avoid sending large categorical choice sets to the browser unnecessarily.

Time-series identity

A distinct time series is defined by the complete combination of all categorical columns.

For example, if the categorical columns are:

COUNTRY
AGE
SEX

then these are different time series:

COUNTRY = A | AGE = 15-24 | SEX = Female
COUNTRY = A | AGE = 15-24 | SEX = Male
COUNTRY = B | AGE = 15-24 | SEX = Female

There is no runtime aggregation or user-selectable grouping.

Limit of 10 displayed series

If the current categorical filters match 10 or fewer time series, all matching series are sent to Plotly.

If they match more than 10:

• the app randomly selects 10 matching series;
• the same sample is used across all numeric charts;
• a prominent warning appears in the top bar;
• changing only the time window, index setting, base period, or marker setting does not intentionally redefine the categorical filter selection.

This limit keeps heavily populated charts responsive and readable.

The row count shown in the sidebar refers to all rows matching the categorical filters, not merely to the sampled series displayed by Plotly.

Time window

The From and To selectors determine the time range shown in every chart.

The controls use the ordered time index inferred from the time column, so the same range is applied consistently to every numeric measure.

Index mode

Enable:

Show as index

to normalize every displayed time series independently to 100 at a selected base time.

For a series (s), value (x_{s,t}), and selected base period (t_0), the plotted value is:

[ 100 \times \frac{x_{s,t}}{x_{s,t_0}} ]

A series is shown as missing where its base-period value is missing or zero.

The base period does not have to lie inside the currently displayed From – To window.

Plot interaction

Each numeric measure has its own Plotly chart.

The generated charts support, among other Plotly interactions:

• hover information;
• zooming and panning;
• optional point markers;
• mode-bar controls;
• scroll zoom;
• full-screen card display.

Each chart's outer card can also be resized directly:

• drag the shaded right edge to change width;
• drag the shaded bottom edge to change height;
• drag the shaded bottom-right corner to change both.

The Plotly widget follows the resized card.

Busy indicator

The top bar displays a Working... spinner while Shiny is processing reactive work or Plotly is rendering/updating a chart.

This is especially useful when changing filters that affect several numeric charts at once.

Generated files

Suppose you call:

write_ts_shiny_app(
  DT,
  out_dir = "output",
  app_file = "app.R",
  data_file = "series.rds"
)

The result is:

output/
├── app.R
└── series.rds

The RDS contains a copy of the input data.table.

app.R stores the RDS file name and loads it when the application starts. Keep the two files in the same directory.

Return value

The function invisibly returns a list containing:

list(
  directory = ...,
  app = ...,
  data = ...,
  time_column = ...,
  numeric_columns = ...,
  categorical_columns = ...
)

This makes it convenient to capture the generated paths programmatically:

app_info <- write_ts_shiny_app(
  DT,
  out_dir = "my-ts-app"
)

app_info$directory
app_info$app
app_info$data
app_info$time_column
app_info$numeric_columns
app_info$categorical_columns

For example:

shiny::runApp(app_info$directory)

Overwriting an existing app

By default the function refuses to replace an existing generated app or data file.

To overwrite them intentionally:

write_ts_shiny_app(
  DT,
  out_dir = "my-ts-app",
  overwrite = TRUE
)

Example with several dimensions and measures

library(data.table)

DT <- CJ(
  COUNTRY = c("BE", "DE", "FR"),
  SEX = c("Female", "Male"),
  AGE = c("15-24", "25-64"),
  time_period = sprintf(
    "%d-Q%d",
    rep(2023:2025, each = 4),
    rep(1:4, 3)
  )
)

set.seed(42)

DT[, `:=`(
  employment_rate = round(runif(.N, 55, 85), 1),
  unemployment_rate = round(runif(.N, 2, 15), 1),
  activity_rate = round(runif(.N, 60, 90), 1)
)]

write_ts_shiny_app(
  DT,
  out_dir = "labour-market-app",
  title = "Labour-market time series",
  overwrite = TRUE
)

shiny::runApp("labour-market-app")

This creates:

• filters for COUNTRY, SEX, and AGE;
• one chart each for employment_rate, unemployment_rate, and activity_rate;
• a quarterly time axis based on time_period.

Common validation errors

No time column found

No time column found. Expected 'time' or 'time_period' (case-insensitive).

Rename the intended time column:

setnames(DT, "quarter", "time")

More than one time column

Keep exactly one column whose case-insensitive name is time or time_period.

No numeric measure columns

At least one numeric column other than the time column is required.

Duplicate time-series keys

If the function reports that the time column plus the categorical columns do not uniquely identify rows, inspect the duplicates rather than relying on implicit aggregation:

categorical_cols <- names(DT)[
  !vapply(DT, is.numeric, logical(1L)) &
    !tolower(names(DT)) %in% c("time", "time_period")
]

time_col <- names(DT)[
  tolower(names(DT)) %in% c("time", "time_period")
]

DT[, .N, by = c(time_col, categorical_cols)][N > 1L]

Resolve those duplicates according to the meaning of the source data, then generate the app again.

A numeric code appears as a chart

A numeric-coded dimension was interpreted as a measure.

Convert it first:

DT[, industry_code := factor(industry_code)]

The app cannot find its RDS file

Keep app.R and the generated RDS file together and run the application from its app directory, for example:

shiny::runApp("my-ts-app")

Notes on deployment

The generated app is an ordinary single-file Shiny application plus an RDS data file. When deploying it, deploy the whole generated directory so that both files are available to the application.

The deployment environment must provide:

shiny
bslib
data.table
plotly

The generated application does not need the original write_ts_shiny_app.R generator file at runtime.

References

• Shiny: runApp()
• Shiny basics and app.R structure
• R: saveRDS() / readRDS()
• data.table
• Plotly for R

write_ts_shiny_app.R

write_ts_shiny_app <- function(
    dt,
    out_dir = "shiny-ts-app",
    app_file = "app.R",
    data_file = "data.rds",
    title = "Time-series explorer",
    overwrite = FALSE,
    compress = "gzip"
) {
  if (!requireNamespace("data.table", quietly = TRUE))
    stop("Package 'data.table' is required.", call. = FALSE)

  if (!data.table::is.data.table(dt))
    stop("'dt' must be a data.table.", call. = FALSE)
  if (!nrow(dt))
    stop("'dt' has no rows.", call. = FALSE)
  if (anyDuplicated(names(dt)))
    stop("Column names must be unique.", call. = FALSE)
  if (!is.character(out_dir) || length(out_dir) != 1L || !nzchar(out_dir))
    stop("'out_dir' must be one non-empty character string.", call. = FALSE)
  if (!is.character(app_file) || length(app_file) != 1L || !nzchar(app_file))
    stop("'app_file' must be one non-empty character string.", call. = FALSE)
  if (!is.character(data_file) || length(data_file) != 1L || !nzchar(data_file))
    stop("'data_file' must be one non-empty character string.", call. = FALSE)
  if (dirname(app_file) != "." || dirname(data_file) != ".")
    stop("'app_file' and 'data_file' must be file names, not paths.", call. = FALSE)
  if (!is.character(title) || length(title) != 1L || is.na(title))
    stop("'title' must be one character string.", call. = FALSE)

  x <- data.table::copy(dt)
  nms_lower <- tolower(names(x))
  time_ix <- which(nms_lower %in% c("time", "time_period"))

  if (!length(time_ix))
    stop("No time column found. Expected 'time' or 'time_period' (case-insensitive).",
         call. = FALSE)
  if (length(time_ix) > 1L)
    stop(
      "More than one candidate time column was found: ",
      paste(names(x)[time_ix], collapse = ", "),
      ". Keep exactly one column named 'time' or 'time_period' (case-insensitive).",
      call. = FALSE
    )

  time_col <- names(x)[time_ix]
  if (!is.atomic(x[[time_col]]) || !is.null(dim(x[[time_col]])))
    stop("The time column must be an atomic vector.", call. = FALSE)

  numeric_cols <- setdiff(
    names(x)[vapply(x, is.numeric, logical(1L))],
    time_col
  )
  if (!length(numeric_cols))
    stop("No numeric measure columns were found after excluding the time column.",
         call. = FALSE)

  categorical_cols <- setdiff(
    names(x)[!vapply(x, is.numeric, logical(1L))],
    time_col
  )

  bad_cat <- categorical_cols[vapply(
    categorical_cols,
    function(nm) {
      z <- x[[nm]]
      !is.atomic(z) || !is.null(dim(z)) || is.complex(z) || is.raw(z)
    },
    logical(1L)
  )]
  if (length(bad_cat))
    stop(
      "These non-numeric columns cannot be used as categorical filters: ",
      paste(bad_cat, collapse = ", "),
      call. = FALSE
    )

  key_cols <- c(time_col, categorical_cols)
  if (data.table::uniqueN(x, by = key_cols) != nrow(x)) {
    dup_keys <- x[, .N, by = key_cols][N > 1L]
    example_keys <- utils::head(dup_keys, 8L)
    example_text <- paste(capture.output(print(example_keys)), collapse = "\n")
    stop(
      "The input data.table is not uniquely identified by the time column plus all categorical columns.\n",
      "Key columns: ", paste(key_cols, collapse = ", "), ".\n",
      "Found ", format(nrow(dup_keys), big.mark = ","),
      " duplicated key combination(s). Examples:\n", example_text,
      "\nResolve these duplicates before creating the app; the generated app does not aggregate coincident rows.",
      call. = FALSE
    )
  }

  dir.create(out_dir, recursive = TRUE, showWarnings = FALSE)
  app_path <- file.path(out_dir, app_file)
  data_path <- file.path(out_dir, data_file)

  existing <- c(app_path, data_path)[file.exists(c(app_path, data_path))]
  if (length(existing) && !isTRUE(overwrite))
    stop(
      "Refusing to overwrite existing file(s): ",
      paste(existing, collapse = ", "),
      ". Use overwrite = TRUE if intended.",
      call. = FALSE
    )

  saveRDS(x, data_path, compress = compress)

  r_literal <- function(z)
    paste(capture.output(dput(z)), collapse = "")

  app_template <- r"---[
# Generated by write_ts_shiny_app().
# Keep this app.R beside the RDS data file.

DATA_FILE <- @@DATA_FILE@@
APP_TITLE <- @@APP_TITLE@@

required_packages <- c("shiny", "bslib", "data.table", "plotly")
missing_packages <- required_packages[
  !vapply(required_packages, requireNamespace, logical(1L), quietly = TRUE)
]
if (length(missing_packages)) {
  stop(
    "Install the missing package(s) before running this app: ",
    paste(missing_packages, collapse = ", "),
    call. = FALSE
  )
}

library(shiny)
library(bslib)
library(data.table)
library(plotly)

`%||%` <- function(x, y) if (is.null(x) || !length(x)) y else x

if (!file.exists(DATA_FILE)) {
  stop(
    "Cannot find '", DATA_FILE,
    "'. Run the app from the directory containing app.R and the data file.",
    call. = FALSE
  )
}

DT <- readRDS(DATA_FILE)
setDT(DT)

if (anyDuplicated(names(DT)))
  stop("The data contains duplicated column names.", call. = FALSE)

nms_lower <- tolower(names(DT))
time_ix <- which(nms_lower %in% c("time", "time_period"))
if (length(time_ix) != 1L)
  stop("Expected exactly one time column named 'time' or 'time_period' (case-insensitive).",
       call. = FALSE)

time_col <- names(DT)[time_ix]
numeric_cols <- setdiff(
  names(DT)[vapply(DT, is.numeric, logical(1L))],
  time_col
)
categorical_cols <- setdiff(
  names(DT)[!vapply(DT, is.numeric, logical(1L))],
  time_col
)

if (!length(numeric_cols))
  stop("No numeric measure columns were found.", call. = FALSE)

key_cols <- c(time_col, categorical_cols)
if (uniqueN(DT, by = key_cols) != nrow(DT))
  stop(
    "The data file is no longer uniquely identified by the time column plus all categorical columns. ",
    "Regenerate the app after resolving duplicate keys.",
    call. = FALSE
  )

make_internal_name <- function(base, existing) {
  out <- base
  while (out %chin% existing)
    out <- paste0(out, "_")
  out
}

time_id_col <- make_internal_name(".tsapp_time_id", names(DT))
series_id_col <- make_internal_name(".tsapp_series_id", c(names(DT), time_id_col))

order_time_levels <- function(x) {
  x_chr <- as.character(x)
  u <- unique(x_chr[!is.na(x_chr)])
  if (!length(u)) return(character())

  if (is.ordered(x)) {
    lev <- levels(x)
    return(c(lev[lev %chin% u], u[!u %chin% lev]))
  }

  if (inherits(x, "Date")) {
    key <- as.numeric(as.Date(u))
    return(u[order(key, method = "radix")])
  }

  if (inherits(x, c("POSIXct", "POSIXlt"))) {
    src <- match(u, x_chr)
    key <- as.numeric(as.POSIXct(x[src]))
    return(u[order(key, method = "radix")])
  }

  if (is.numeric(x)) {
    src <- match(u, x_chr)
    key <- as.numeric(x[src])
    return(u[order(key, method = "radix")])
  }

  s <- trimws(u)
  numeric_key <- suppressWarnings(as.numeric(s))
  if (all(is.finite(numeric_key)))
    return(u[order(numeric_key, s, method = "radix")])

  iso_date <- grepl("^[0-9]{4}[-/.][0-9]{1,2}[-/.][0-9]{1,2}$", s)
  if (all(iso_date)) {
    date_key <- suppressWarnings(as.Date(gsub("[/.]", "-", s)))
    if (!anyNA(date_key))
      return(u[order(date_key, method = "radix")])
  }

  z <- toupper(gsub("[[:space:]_./-]", "", s))
  key <- rep(NA_real_, length(z))

  annual <- grepl("^(FY)?[12][0-9]{3}$", z)
  key[annual] <- suppressWarnings(as.numeric(sub("^FY", "", z[annual])))

  yq <- grepl("^[12][0-9]{3}Q[1-4]$", z)
  if (any(yq)) {
    key[yq] <- as.numeric(substr(z[yq], 1L, 4L)) +
      (as.numeric(substr(z[yq], 6L, 6L)) - 1) / 4
  }

  qy <- grepl("^Q[1-4][12][0-9]{3}$", z)
  if (any(qy)) {
    key[qy] <- as.numeric(substr(z[qy], 3L, 6L)) +
      (as.numeric(substr(z[qy], 2L, 2L)) - 1) / 4
  }

  yh <- grepl("^[12][0-9]{3}H[12]$", z)
  if (any(yh)) {
    key[yh] <- as.numeric(substr(z[yh], 1L, 4L)) +
      (as.numeric(substr(z[yh], 6L, 6L)) - 1) / 2
  }

  hy <- grepl("^H[12][12][0-9]{3}$", z)
  if (any(hy)) {
    key[hy] <- as.numeric(substr(z[hy], 3L, 6L)) +
      (as.numeric(substr(z[hy], 2L, 2L)) - 1) / 2
  }

  ym <- grepl("^[12][0-9]{3}M(0?[1-9]|1[0-2])$", z)
  if (any(ym)) {
    yr <- as.numeric(substr(z[ym], 1L, 4L))
    mo <- as.numeric(sub("^[12][0-9]{3}M", "", z[ym]))
    key[ym] <- yr + (mo - 1) / 12
  }

  compact_ym <- grepl("^[12][0-9]{3}(0[1-9]|1[0-2])$", z)
  if (any(compact_ym)) {
    yr <- as.numeric(substr(z[compact_ym], 1L, 4L))
    mo <- as.numeric(substr(z[compact_ym], 5L, 6L))
    key[compact_ym] <- yr + (mo - 1) / 12
  }

  yw <- grepl("^[12][0-9]{3}W(0?[1-9]|[1-4][0-9]|5[0-3])$", z)
  if (any(yw)) {
    yr <- as.numeric(substr(z[yw], 1L, 4L))
    wk <- as.numeric(sub("^[12][0-9]{3}W", "", z[yw]))
    key[yw] <- yr + (wk - 1) / 53
  }

  month_keys <- c(
    JAN = 1, FEB = 2, MAR = 3, APR = 4, MAY = 5, JUN = 6,
    JUL = 7, AUG = 8, SEP = 9, OCT = 10, NOV = 11, DEC = 12,
    JANUARY = 1, FEBRUARY = 2, MARCH = 3, APRIL = 4, JUNE = 6,
    JULY = 7, AUGUST = 8, SEPTEMBER = 9, OCTOBER = 10,
    NOVEMBER = 11, DECEMBER = 12
  )

  ymon <- grepl("^[12][0-9]{3}[A-Z]+$", z)
  if (any(ymon)) {
    yr <- as.numeric(substr(z[ymon], 1L, 4L))
    mn <- substr(z[ymon], 5L, nchar(z[ymon]))
    mo <- unname(month_keys[mn])
    ok <- !is.na(mo)
    idx <- which(ymon)[ok]
    key[idx] <- yr[ok] + (mo[ok] - 1) / 12
  }

  mony <- grepl("^[A-Z]+[12][0-9]{3}$", z)
  if (any(mony)) {
    yr <- as.numeric(substr(z[mony], nchar(z[mony]) - 3L, nchar(z[mony])))
    mn <- substr(z[mony], 1L, nchar(z[mony]) - 4L)
    mo <- unname(month_keys[mn])
    ok <- !is.na(mo)
    idx <- which(mony)[ok]
    key[idx] <- yr[ok] + (mo[ok] - 1) / 12
  }

  if (all(is.finite(key)))
    return(u[order(key, s, method = "radix")])

  u[order(tolower(u), u, method = "radix")]
}

time_levels <- order_time_levels(DT[[time_col]])
if (!length(time_levels))
  stop("The time column has no non-missing values.", call. = FALSE)

DT[, (time_id_col) := match(as.character(get(time_col)), time_levels)]
if (length(categorical_cols)) {
  DT[, (series_id_col) := .GRP, by = categorical_cols]
} else {
  DT[, (series_id_col) := 1L]
}
missing_time_rows <- sum(is.na(DT[[time_id_col]]))

encode_category <- function(x) {
  x_chr <- as.character(x)
  fifelse(is.na(x_chr), "na:", paste0("v:", x_chr))
}

category_choice_vector <- function(x) {
  x_chr <- as.character(x)
  observed <- unique(x_chr[!is.na(x_chr)])

  if (is.factor(x)) {
    lev <- levels(droplevels(x))
    observed <- c(lev[lev %chin% observed], observed[!observed %chin% lev])
  } else if (is.logical(x)) {
    observed <- intersect(c("FALSE", "TRUE"), observed)
  } else {
    observed <- sort(observed, na.last = TRUE, method = "radix")
  }

  values <- paste0("v:", observed)
  labels <- observed
  labels[labels == ""] <- "(Blank)"

  if (anyNA(x)) {
    values <- c(values, "na:")
    labels <- c(labels, "(Missing)")
  }

  stats::setNames(values, labels)
}

category_keys <- setNames(
  lapply(categorical_cols, function(nm) encode_category(DT[[nm]])),
  categorical_cols
)
category_choices <- setNames(
  lapply(categorical_cols, function(nm) category_choice_vector(DT[[nm]])),
  categorical_cols
)
filter_ids <- setNames(
  sprintf("filter_%03d", seq_along(categorical_cols)),
  categorical_cols
)
plot_ids <- setNames(
  sprintf("metric_%03d", seq_along(numeric_cols)),
  numeric_cols
)
time_choices <- stats::setNames(
  as.character(seq_along(time_levels)),
  time_levels
)

filter_controls <- if (length(categorical_cols)) {
  tagList(lapply(categorical_cols, function(nm) {
    selectizeInput(
      filter_ids[[nm]],
      nm,
      choices = NULL,
      multiple = TRUE,
      options = list(
        placeholder = "All values",
        closeAfterSelect = FALSE,
        plugins = list("remove_button")
      ),
      width = "100%"
    )
  }))
} else {
  tags$p(class = "sidebar-note", "No categorical columns were found.")
}

plot_cards <- tagList(lapply(numeric_cols, function(metric) {
  tags$div(
    class = "metric-card-scroll",
    bslib::card(
      class = "metric-card metric-card-resizable",
      full_screen = TRUE,
      height = "600px",
      bslib::card_header(
        tags$div(
          class = "metric-heading",
          tags$span(metric),
          tags$span(class = "metric-badge", "Drag shaded card edges or corner to resize")
        )
      ),
      bslib::card_body(
        class = "metric-plot-body",
        plotlyOutput(plot_ids[[metric]], width = "100%", height = "100%"),
        tags$div(
          class = "resize-handle resize-handle-right",
          `data-resize` = "x",
          title = "Drag the card edge to resize width",
          `aria-label` = "Resize chart card width"
        ),
        tags$div(
          class = "resize-handle resize-handle-bottom",
          `data-resize` = "y",
          title = "Drag the card edge to resize height",
          `aria-label` = "Resize chart card height"
        ),
        tags$div(
          class = "resize-handle resize-handle-corner",
          `data-resize` = "xy",
          title = "Drag the card corner to resize width and height",
          `aria-label` = "Resize chart card width and height"
        )
      )
    )
  )
}))

ui <- bslib::page_sidebar(
  title = tags$div(
    class = "app-topbar",
    tags$div(
      class = "app-heading",
      tags$div(class = "app-heading-main", APP_TITLE),
      tags$div(class = "app-heading-sub", "Filter, compare, index and zoom across time")
    ),
    uiOutput("series_warning_top", class = "app-top-warning-slot"),
    tags$div(
      id = "tsapp-busy-indicator",
      class = "tsapp-busy is-active",
      role = "status",
      `aria-live` = "polite",
      `aria-hidden` = "false",
      tags$div(class = "tsapp-spinner", `aria-hidden` = "true"),
      tags$span("Working...")
    )
  ),
  sidebar = bslib::sidebar(
    width = 360,
    tags$div(class = "sidebar-section-title", "Filters"),
    tags$p(
      class = "sidebar-note",
      "Leave a selector empty to include all values. Choose several values to compare them. You can type in the fields to search and use Backspace or Delete keys."
    ),
    filter_controls,
    tags$hr(),
    tags$div(class = "sidebar-section-title", "Time window"),
    tags$div(
      class = "two-col-controls",
      selectizeInput("time_from", "From", choices = NULL, width = "100%"),
      selectizeInput("time_to", "To", choices = NULL, width = "100%")
    ),
    tags$hr(),
    checkboxInput("indexed", "Show as index", value = FALSE),
    conditionalPanel(
      "input.indexed === true",
      selectizeInput("base_time", "Base time = 100", choices = NULL, width = "100%"),
      tags$p(
        class = "sidebar-note",
        "Each displayed series is divided by its value at the selected base time. A series is blank where that base value is missing or zero."
      )
    ),
    checkboxInput("markers", "Show point markers", value = TRUE),
    tags$hr(),
    uiOutput("selection_status")
  ),
  fillable = FALSE,
  theme = bslib::bs_theme(
    version = 5,
    bootswatch = "flatly",
    primary = "#2563eb",
    base_font = '"Segoe UI", system-ui, sans-serif'
  ),
  tags$style(HTML("\n    body { background: #f6f8fb; }\n    .bslib-sidebar-layout > .sidebar { background: #ffffff; border-right: 1px solid #e6eaf0; }\n    .app-topbar { width: 100%; min-width: 0; display: flex; align-items: center; gap: 18px; }\n    .app-heading { flex: 0 0 auto; padding: 2px 0; }\n    .app-heading-main { font-weight: 750; letter-spacing: -0.02em; }\n    .app-heading-sub { font-size: 0.83rem; opacity: 0.72; font-weight: 400; margin-top: 2px; }\n    .app-top-warning-slot { flex: 1 1 auto; min-width: 0; display: flex; justify-content: flex-end; align-items: center; }\n    .top-series-warning { display: inline-flex; align-items: center; max-width: 860px; padding: 8px 12px; border: 1px solid #f6d98b; border-radius: 9px; background: #fffbeb; color: #7c2d12; box-shadow: 0 2px 8px rgba(120,53,15,.10); font-size: .82rem; font-weight: 550; line-height: 1.3; }\n    .top-series-warning strong { font-weight: 800; margin-right: 4px; }\n    .sidebar-section-title { font-weight: 700; font-size: 0.84rem; text-transform: uppercase; letter-spacing: .055em; color: #475569; margin: 2px 0 8px; }\n    .sidebar-note { font-size: 0.79rem; line-height: 1.35; color: #64748b; margin-top: -3px; }\n    .two-col-controls { display: grid; grid-template-columns: 1fr 1fr; gap: 8px; }\n    .metric-card-scroll { overflow: auto; padding: 0 14px 16px 0; margin-bottom: 18px; }\n    .metric-card { position: relative; width: 100%; min-width: 420px; min-height: 320px; max-width: none; box-sizing: border-box; border: 1px solid #e5eaf0; border-right: 10px solid #cbd5e1; border-bottom: 10px solid #cbd5e1; border-radius: 14px; box-shadow: 0 6px 22px rgba(15, 23, 42, .075); margin-bottom: 0; overflow: hidden; }\n    .metric-card.is-resizing { user-select: none; }\n    .metric-plot-body { position: static !important; min-width: 0; min-height: 0; padding: 0 !important; overflow: visible; }\n    .metric-plot-body > .shiny-plot-output, .metric-plot-body > .plotly { width: 100% !important; height: 100% !important; min-width: 0; min-height: 0; }\n    .resize-handle { position: absolute; z-index: 50; touch-action: none; }\n    .resize-handle-right { top: 0; right: 0; bottom: 18px; width: 12px; cursor: ew-resize; }\n    .resize-handle-bottom { left: 0; right: 18px; bottom: 0; height: 12px; cursor: ns-resize; }\n    .resize-handle-corner { right: 0; bottom: 0; width: 20px; height: 20px; cursor: nwse-resize; background: #94a3b8; border-top-left-radius: 6px; }\n    .resize-handle-right:hover, .resize-handle-bottom:hover { background: rgba(100, 116, 139, .22); }\n    .resize-handle-corner:hover { background: #64748b; }\n    .metric-card .card-header { background: #fff; border-bottom: 1px solid #eef1f5; padding: 12px 16px; }\n    .metric-heading { display: flex; align-items: center; justify-content: space-between; gap: 12px; font-weight: 700; }\n    .metric-badge { font-size: 0.72rem; font-weight: 650; padding: 4px 8px; border-radius: 999px; background: #eff6ff; color: #1d4ed8; }\n    .status-box { background: #f8fafc; border: 1px solid #e8edf3; border-radius: 10px; padding: 10px 11px; font-size: .79rem; color: #475569; line-height: 1.45; }\n    .status-box strong { color: #0f172a; }\n    .tsapp-busy { flex: 0 0 auto; min-width: 108px; display: flex; align-items: center; justify-content: center; gap: 9px; padding: 8px 12px; border: 1px solid #dbe3ec; border-radius: 999px; background: rgba(255,255,255,.96); box-shadow: 0 3px 12px rgba(15,23,42,.12); color: #334155; font-size: .82rem; font-weight: 650; opacity: 0; visibility: hidden; transform: translateY(-3px); pointer-events: none; transition: opacity .12s ease, transform .12s ease, visibility .12s ease; }\n    .tsapp-busy.is-active { opacity: 1; visibility: visible; transform: translateY(0); }\n    .tsapp-spinner { width: 16px; height: 16px; border: 2px solid #cbd5e1; border-top-color: #2563eb; border-radius: 50%; animation: tsapp-spin .7s linear infinite; }\n    @keyframes tsapp-spin { to { transform: rotate(360deg); } }\n    @media (prefers-reduced-motion: reduce) { .tsapp-spinner { animation-duration: 1.5s; } }\n    .selectize-control.multi .selectize-input > div { border-radius: 6px; }\n    @media (max-width: 700px) {\n      .app-topbar { flex-wrap: wrap; gap: 8px 12px; }\n      .app-top-warning-slot { order: 3; flex: 1 0 100%; justify-content: flex-start; }\n      .top-series-warning { width: 100%; max-width: none; }\n      .tsapp-busy { margin-left: auto; }\n      .two-col-controls { grid-template-columns: 1fr; }\n      .metric-card { border-radius: 10px; }\n    }\n  ")),
  plot_cards,
  tags$script(HTML("
    (function() {
      var MIN_WIDTH = 420;
      var MIN_HEIGHT = 320;
      var MAX_WIDTH = 4000;
      var MAX_HEIGHT = 2400;
      var shinyBusy = true;
      var plotlyBusyCount = 0;

      function updateBusyIndicator() {
        var el = document.getElementById('tsapp-busy-indicator');
        if (!el) return;
        var active = shinyBusy || plotlyBusyCount > 0;
        el.classList.toggle('is-active', active);
        el.setAttribute('aria-hidden', active ? 'false' : 'true');
      }

      function finishPlotlyWork() {
        window.requestAnimationFrame(function() {
          window.requestAnimationFrame(function() {
            plotlyBusyCount = Math.max(0, plotlyBusyCount - 1);
            updateBusyIndicator();
          });
        });
      }

      function wrapPlotlyMethod(name) {
        if (!window.Plotly || typeof Plotly[name] !== 'function') return;
        var original = Plotly[name];
        if (original._tsappBusyWrapped) return;

        var wrapped = function() {
          plotlyBusyCount += 1;
          updateBusyIndicator();
          try {
            var result = original.apply(this, arguments);
            if (result && typeof result.then === 'function') {
              return result.then(
                function(value) { finishPlotlyWork(); return value; },
                function(error) { finishPlotlyWork(); throw error; }
              );
            }
            finishPlotlyWork();
            return result;
          } catch (error) {
            finishPlotlyWork();
            throw error;
          }
        };
        wrapped._tsappBusyWrapped = true;
        wrapped._tsappBusyOriginal = original;
        Plotly[name] = wrapped;
      }

      function hookPlotlyBusyState() {
        if (!window.Plotly) {
          window.setTimeout(hookPlotlyBusyState, 100);
          return;
        }
        ['newPlot', 'react', 'redraw'].forEach(wrapPlotlyMethod);
      }

      if (window.jQuery) {
        window.jQuery(document)
          .on('shiny:busy.tsapp', function() {
            shinyBusy = true;
            updateBusyIndicator();
          })
          .on('shiny:idle.tsapp', function() {
            shinyBusy = false;
            updateBusyIndicator();
          });
      }
      hookPlotlyBusyState();
      updateBusyIndicator();

      function clamp(x, lo, hi) {
        return Math.max(lo, Math.min(hi, x));
      }

      function resizePlot(box) {
        var plot = box.querySelector('.js-plotly-plot');
        if (plot && window.Plotly && Plotly.Plots && Plotly.Plots.resize) {
          Plotly.Plots.resize(plot);
        }
      }

      function attachHandle(box, handle) {
        if (handle.dataset.tsappHandleReady === '1') return;
        handle.dataset.tsappHandleReady = '1';

        handle.addEventListener('pointerdown', function(ev) {
          if (ev.button !== 0 && ev.pointerType === 'mouse') return;
          ev.preventDefault();

          var axis = handle.dataset.resize || '';
          var rect = box.getBoundingClientRect();
          var startX = ev.clientX;
          var startY = ev.clientY;
          var startWidth = rect.width;
          var startHeight = rect.height;

          box.classList.add('is-resizing');
          handle.setPointerCapture(ev.pointerId);

          function move(moveEv) {
            if (axis.indexOf('x') !== -1) {
              var width = clamp(startWidth + moveEv.clientX - startX, MIN_WIDTH, MAX_WIDTH);
              box.style.width = width + 'px';
            }
            if (axis.indexOf('y') !== -1) {
              var height = clamp(startHeight + moveEv.clientY - startY, MIN_HEIGHT, MAX_HEIGHT);
              box.style.height = height + 'px';
            }
          }

          function stop(stopEv) {
            handle.removeEventListener('pointermove', move);
            handle.removeEventListener('pointerup', stop);
            handle.removeEventListener('pointercancel', stop);
            if (handle.hasPointerCapture && handle.hasPointerCapture(stopEv.pointerId)) {
              handle.releasePointerCapture(stopEv.pointerId);
            }
            box.classList.remove('is-resizing');
            window.requestAnimationFrame(function() { resizePlot(box); });
          }

          handle.addEventListener('pointermove', move);
          handle.addEventListener('pointerup', stop);
          handle.addEventListener('pointercancel', stop);
        });
      }

      function observeBox(box) {
        if (box.dataset.tsappResizeObserved === '1') return;
        box.dataset.tsappResizeObserved = '1';

        box.querySelectorAll('.resize-handle').forEach(function(handle) {
          attachHandle(box, handle);
        });

        if ('ResizeObserver' in window) {
          var ro = new ResizeObserver(function() {
            window.requestAnimationFrame(function() { resizePlot(box); });
          });
          ro.observe(box);
          box._tsappResizeObserver = ro;
        }

        var mo = new MutationObserver(function() {
          if (box.querySelector('.js-plotly-plot')) {
            mo.disconnect();
            window.requestAnimationFrame(function() { resizePlot(box); });
          }
        });
        mo.observe(box, { childList: true, subtree: true });
        box._tsappMutationObserver = mo;
        resizePlot(box);
      }

      function initResizablePlots() {
        document.querySelectorAll('.metric-card-resizable').forEach(observeBox);
      }

      if (document.readyState === 'loading') {
        document.addEventListener('DOMContentLoaded', initResizablePlots, { once: true });
      } else {
        initResizablePlots();
      }
      document.addEventListener('shiny:connected', initResizablePlots);
    })();
  "))
)

server <- function(input, output, session) {
  session$onFlushed(function() {
    if (length(categorical_cols)) {
      invisible(lapply(categorical_cols, function(nm) {
        updateSelectizeInput(
          session,
          filter_ids[[nm]],
          choices = category_choices[[nm]],
          selected = character(),
          server = TRUE
        )
      }))
    }

    updateSelectizeInput(
      session, "time_from",
      choices = time_choices,
      selected = "1",
      server = TRUE
    )
    updateSelectizeInput(
      session, "time_to",
      choices = time_choices,
      selected = as.character(length(time_levels)),
      server = TRUE
    )
    updateSelectizeInput(
      session, "base_time",
      choices = time_choices,
      selected = "1",
      server = TRUE
    )
  }, once = TRUE)

  filter_mask <- reactive({
    valid_time <- !is.na(DT[[time_id_col]])
    if (!length(categorical_cols)) return(valid_time)

    selected <- setNames(
      lapply(categorical_cols, function(nm) input[[filter_ids[[nm]]]]),
      categorical_cols
    )
    active <- categorical_cols[lengths(selected) > 0L]
    if (!length(active)) return(valid_time)

    conditions <- lapply(
      active,
      function(nm) category_keys[[nm]] %chin% selected[[nm]]
    )
    Reduce(`&`, conditions, init = valid_time)
  })

  filtered_data <- reactive({
    DT[filter_mask()]
  })

  series_selection <- reactive({
    a <- filtered_data()
    ids <- unique(a[[series_id_col]])
    ids <- ids[!is.na(ids)]
    n_series <- length(ids)
    shown_ids <- if (n_series > 10L) sample(ids, 10L) else ids
    list(total = n_series, shown_ids = shown_ids)
  })

  plot_data <- reactive({
    a <- filtered_data()
    sel <- series_selection()
    if (sel$total > 10L) {
      a[get(series_id_col) %in% sel$shown_ids]
    } else {
      a
    }
  })

  safe_time_id <- function(x, default) {
    z <- suppressWarnings(as.integer(x %||% ""))
    if (length(z) != 1L || is.na(z)) z <- default
    max(1L, min(length(time_levels), z))
  }

  time_bounds <- reactive({
    from <- safe_time_id(input$time_from, 1L)
    to <- safe_time_id(input$time_to, length(time_levels))
    sort(c(from, to))
  })

  make_series_label <- function(d, vars) {
    if (!length(vars)) return(rep("Series", nrow(d)))

    parts <- lapply(vars, function(v) {
      z <- as.character(d[[v]])
      z[is.na(z)] <- "(Missing)"
      paste0(v, " = ", z)
    })
    do.call(paste, c(parts, sep = " | "))
  }

  metric_data <- function(metric) {
    groups <- categorical_cols
    a <- plot_data()
    validate(need(nrow(a), "No rows match the current filters."))
    d <- copy(a[, c(time_id_col, groups), with = FALSE])

    value_col <- make_internal_name(".tsapp_value", names(d))
    d[, (value_col) := a[[metric]]]

    indexed <- isTRUE(input$indexed)
    if (indexed) {
      base_id <- safe_time_id(input$base_time, 1L)
      base_col <- make_internal_name(".tsapp_base", c(names(d), value_col))

      if (length(groups)) {
        base <- d[
          get(time_id_col) == base_id,
          c(groups, value_col),
          with = FALSE
        ]
        setnames(base, value_col, base_col)
        d <- merge(d, base, by = groups, all.x = TRUE, sort = FALSE)
      } else {
        base <- d[get(time_id_col) == base_id, get(value_col)]
        d[, (base_col) := if (length(base)) base[[1L]] else NA_real_]
      }

      d[
        , (value_col) := fifelse(
          is.na(get(base_col)) | get(base_col) == 0,
          NA_real_,
          100 * get(value_col) / get(base_col)
        )
      ]
    }

    bounds <- time_bounds()
    d <- d[
      get(time_id_col) >= bounds[[1L]] &
        get(time_id_col) <= bounds[[2L]]
    ]

    out <- data.table(
      .ts_x = d[[time_id_col]],
      .ts_value = d[[value_col]],
      .ts_series = make_series_label(d, groups)
    )
    out[, .ts_time := time_levels[.ts_x]]
    setorder(out, .ts_series, .ts_x, na.last = TRUE)

    y_title <- if (indexed) {
      paste0("Index (", time_levels[safe_time_id(input$base_time, 1L)], " = 100)")
    } else {
      metric
    }

    shown_value <- ifelse(
      is.na(out$.ts_value),
      "NA",
      formatC(out$.ts_value, digits = 7, format = "fg", flag = "#")
    )
    out[, .ts_hover := paste0(
      "<b>", htmltools::htmlEscape(.ts_series), "</b><br>",
      htmltools::htmlEscape(time_col), ": ", htmltools::htmlEscape(.ts_time), "<br>",
      htmltools::htmlEscape(y_title), ": ", shown_value
    )]

    list(data = out, y_title = y_title)
  }

  make_plot <- function(metric) {
    md <- metric_data(metric)
    d <- md$data
    validate(need(nrow(d), "No observations fall inside the selected time window."))

    bounds <- time_bounds()
    tick_count <- min(12L, bounds[[2L]] - bounds[[1L]] + 1L)
    tick_vals <- unique(as.integer(round(seq(
      bounds[[1L]], bounds[[2L]], length.out = tick_count
    ))))
    tick_text <- time_levels[tick_vals]
    show_legend <- uniqueN(d$.ts_series) > 1L
    markers_on <- isTRUE(input$markers)
    trace_mode <- if (markers_on) "lines+markers" else "lines"

    p <- plotly::plot_ly(
      d,
      x = ~.ts_x,
      y = ~.ts_value,
      split = ~.ts_series,
      type = "scatter",
      mode = trace_mode,
      text = ~.ts_hover,
      hoverinfo = "text",
      marker = list(
        size = if (markers_on) 5 else 0,
        opacity = if (markers_on) 1 else 0
      ),
      line = list(width = 2)
    )

    if (nrow(d) > 5000L)
      p <- plotly::toWebGL(p)

    p <- p %>%
      plotly::layout(
        showlegend = show_legend,
        hovermode = "x",
        xaxis = list(
          title = "",
          tickmode = "array",
          tickvals = tick_vals,
          ticktext = tick_text,
          range = c(bounds[[1L]] - 0.2, bounds[[2L]] + 0.2),
          zeroline = FALSE,
          showgrid = FALSE
        ),
        yaxis = list(
          title = md$y_title,
          zeroline = FALSE,
          gridcolor = "#eef2f7",
          automargin = TRUE
        ),
        legend = list(
          orientation = "h",
          x = 0,
          y = -0.22,
          xanchor = "left",
          yanchor = "top"
        ),
        margin = list(l = 70, r = 24, t = 20, b = if (show_legend) 100 else 55),
        paper_bgcolor = "rgba(0,0,0,0)",
        plot_bgcolor = "rgba(0,0,0,0)"
      ) %>%
      plotly::config(
        displaylogo = FALSE,
        responsive = TRUE,
        scrollZoom = TRUE,
        modeBarButtonsToRemove = c("lasso2d", "select2d")
      )

    p
  }

  invisible(lapply(numeric_cols, function(metric) {
    local({
      metric_local <- metric
      output_id <- plot_ids[[metric_local]]
      output[[output_id]] <- renderPlotly(make_plot(metric_local))
    })
  }))

  output$series_warning_top <- renderUI({
    sel <- series_selection()
    if (sel$total <= 10L) return(NULL)

    tags$div(
      class = "top-series-warning",
      role = "status",
      `aria-live` = "polite",
      tags$strong("Warning:"),
      format(sel$total, big.mark = ","),
      " time series match the current filters. To keep the charts responsive, Plotly is showing a random sample of 10 of them."
    )
  })

  output$selection_status <- renderUI({
    d <- filtered_data()
    bounds <- time_bounds()
    tags$div(
      class = "status-box",
      tags$div(tags$strong(format(nrow(d), big.mark = ",")), " filtered rows"),
      tags$div(
        tags$strong(time_levels[bounds[[1L]]]),
        " to ",
        tags$strong(time_levels[bounds[[2L]]])
      ),
      if (missing_time_rows)
        tags$div(
          style = "margin-top:5px;",
          format(missing_time_rows, big.mark = ","),
          " row(s) with missing/unusable time are omitted."
        )
    )
  })
}

shinyApp(ui, server)
]---"

  app_text <- gsub(
    "@@DATA_FILE@@",
    r_literal(data_file),
    app_template,
    fixed = TRUE
  )
  app_text <- gsub(
    "@@APP_TITLE@@",
    r_literal(title),
    app_text,
    fixed = TRUE
  )

  writeLines(app_text, app_path, useBytes = TRUE)

  out_dir_abs <- normalizePath(out_dir, winslash = "/", mustWork = TRUE)
  message(
    "Created:\n  ", normalizePath(app_path, winslash = "/", mustWork = TRUE),
    "\n  ", normalizePath(data_path, winslash = "/", mustWork = TRUE),
    "\nRun with:\n  shiny::runApp(", r_literal(out_dir_abs), ")"
  )

  invisible(list(
    directory = out_dir_abs,
    app = normalizePath(app_path, winslash = "/", mustWork = TRUE),
    data = normalizePath(data_path, winslash = "/", mustWork = TRUE),
    time_column = time_col,
    numeric_columns = numeric_cols,
    categorical_columns = categorical_cols
  ))
}