diff --git a/.RData b/.RData new file mode 100644 index 0000000..d17abb1 Binary files /dev/null and b/.RData differ diff --git a/.github/workflows/docker-publish.yml b/.github/workflows/docker-publish.yml new file mode 100644 index 0000000..6f252d4 --- /dev/null +++ b/.github/workflows/docker-publish.yml @@ -0,0 +1,98 @@ +name: Docker + +# This workflow uses actions that are not certified by GitHub. +# They are provided by a third-party and are governed by +# separate terms of service, privacy policy, and support +# documentation. + +on: + schedule: + - cron: '24 21 * * *' + push: + branches: [ "master" ] + # Publish semver tags as releases. + tags: [ 'v*.*.*' ] + pull_request: + branches: [ "master" ] + +env: + # Use docker.io for Docker Hub if empty + REGISTRY: ghcr.io + # github.repository as / + IMAGE_NAME: ${{ github.repository }} + + +jobs: + build: + + runs-on: ubuntu-latest + permissions: + contents: read + packages: write + # This is used to complete the identity challenge + # with sigstore/fulcio when running outside of PRs. + id-token: write + + steps: + - name: Checkout repository + uses: actions/checkout@v4 + + # Install the cosign tool except on PR + # https://github.com/sigstore/cosign-installer + - name: Install cosign + if: github.event_name != 'pull_request' + uses: sigstore/cosign-installer@59acb6260d9c0ba8f4a2f9d9b48431a222b68e20 #v3.5.0 + with: + cosign-release: 'v2.2.4' + + # Set up BuildKit Docker container builder to be able to build + # multi-platform images and export cache + # https://github.com/docker/setup-buildx-action + - name: Set up Docker Buildx + uses: docker/setup-buildx-action@f95db51fddba0c2d1ec667646a06c2ce06100226 # v3.0.0 + + # Login against a Docker registry except on PR + # https://github.com/docker/login-action + - name: Log into registry ${{ env.REGISTRY }} + if: github.event_name != 'pull_request' + uses: docker/login-action@343f7c4344506bcbf9b4de18042ae17996df046d # v3.0.0 + with: + registry: ${{ env.REGISTRY }} + username: ${{ github.actor }} + password: ${{ secrets.GITHUB_TOKEN }} + + # Extract metadata (tags, labels) for Docker + # https://github.com/docker/metadata-action + - name: Extract Docker metadata + id: meta + uses: docker/metadata-action@96383f45573cb7f253c731d3b3ab81c87ef81934 # v5.0.0 + with: + images: ${{ env.REGISTRY }}/${{ env.IMAGE_NAME }} + + # Build and push Docker image with Buildx (don't push on PR) + # https://github.com/docker/build-push-action + - name: Build and push Docker image + id: build-and-push + uses: docker/build-push-action@0565240e2d4ab88bba5387d719585280857ece09 # v5.0.0 + with: + context: . + push: ${{ github.event_name != 'pull_request' }} + tags: ${{ steps.meta.outputs.tags }} + labels: ${{ steps.meta.outputs.labels }} + cache-from: type=gha + cache-to: type=gha,mode=max + + # Sign the resulting Docker image digest except on PRs. + # This will only write to the public Rekor transparency log when the Docker + # repository is public to avoid leaking data. If you would like to publish + # transparency data even for private images, pass --force to cosign below. + # https://github.com/sigstore/cosign + - name: Sign the published Docker image + if: ${{ github.event_name != 'pull_request' }} + env: + # https://docs.github.com/en/actions/security-guides/security-hardening-for-github-actions#using-an-intermediate-environment-variable + TAGS: ${{ steps.meta.outputs.tags }} + DIGEST: ${{ steps.build-and-push.outputs.digest }} + # This step uses the identity token to provision an ephemeral certificate + # against the sigstore community Fulcio instance. + run: echo "${TAGS}" | xargs -I {} cosign sign --yes {}@${DIGEST} diff --git a/BoxPlotR_functions.R b/BoxPlotR_functions.R new file mode 100644 index 0000000..e162deb --- /dev/null +++ b/BoxPlotR_functions.R @@ -0,0 +1,60 @@ +# Specifies the arrangement of data points (normal or jittered). +# point_type: 0 = normal, 2 = jittered +jittered_points <- function(data_matrix, my_horizontal = FALSE, point_type, + point_colors, point_transparency, point_size) { + # normal boxplots + if (my_horizontal) { + for (i in seq_len(ncol(data_matrix))) { + alpha_val <- 255 * (point_transparency / 100) + col_rgb <- rgb( + t(col2rgb(point_colors[i])), + maxColorValue = 255, + alpha = alpha_val + ) + if (point_type == 0) { + points( + data_matrix[, i], + rep(i, nrow(data_matrix)), + col = col_rgb, + pch = 16, + cex = point_size + ) + } else { + points( + data_matrix[, i], + jitter(rep(i, nrow(data_matrix)), amount = 0.25), + col = col_rgb, + pch = 16, + cex = point_size + ) + } + } + } else { + # horizontal boxplots + for (i in seq_len(ncol(data_matrix))) { + alpha_val <- 255 * (point_transparency / 100) + col_rgb <- rgb( + t(col2rgb(point_colors[i])), + maxColorValue = 255, + alpha = alpha_val + ) + if (point_type == 0) { + points( + rep(i, nrow(data_matrix)), + data_matrix[, i], + col = col_rgb, + pch = 16, + cex = point_size + ) + } else { + points( + jitter(rep(i, nrow(data_matrix)), amount = 0.25), + data_matrix[, i], + col = col_rgb, + pch = 16, + cex = point_size + ) + } + } + } +} diff --git a/Boxplot_testData3.xlsx b/Boxplot_testData3.xlsx new file mode 100644 index 0000000..c5a7942 Binary files /dev/null and b/Boxplot_testData3.xlsx differ diff --git a/Dockerfile b/Dockerfile new file mode 100644 index 0000000..5fac614 --- /dev/null +++ b/Dockerfile @@ -0,0 +1,20 @@ +# Use the official lightweight rocker shiny image +FROM rocker/shiny:latest + + +RUN R -e "install.packages(c('beeswarm', 'vioplot', 'beanplot', 'RColorBrewer', 'readxl', 'sm', 'testthat', 'ggplot2'), repos='https://cloud.r-project.org/')" + +# Remove default Shiny apps +RUN rm -rf /srv/shiny-server/* + +# Copy the application files to the container +COPY . /srv/shiny-server/ + +# Ensure proper ownership +RUN chown -R shiny:shiny /srv/shiny-server/ + +# Expose the shiny server port +EXPOSE 3838 + +# Run the Shiny server +CMD ["/usr/bin/shiny-server"] diff --git a/MyVioplot.R b/MyVioplot.R index f3ac400..e1ffa67 100644 --- a/MyVioplot.R +++ b/MyVioplot.R @@ -1,102 +1,125 @@ -vioplot<-function (x, range = 1.5, h = NULL, ylim = NULL, names = NULL, - horizontal = FALSE, col = "cornflowerblue", border = "black", lty = 1, - lwd = 1, rectCol = "black", colMed = "white", pchMed = 19, - at, add = FALSE, wex = 1, drawRect = TRUE, cex.axis=1) -{ - datas <- x - n <- length(datas) - if (missing(at)) - at <- 1:n - upper <- vector(mode = "numeric", length = n) - lower <- vector(mode = "numeric", length = n) - q1 <- vector(mode = "numeric", length = n) - q3 <- vector(mode = "numeric", length = n) - med <- vector(mode = "numeric", length = n) - base <- vector(mode = "list", length = n) - height <- vector(mode = "list", length = n) - baserange <- c(Inf, -Inf) - args <- list(display = "none") - if (!(is.null(h))) - args <- c(args, h = h) - for (i in 1:n) { - datas[[i]]<-datas[[i]][!is.na(datas[[i]])] - data <- datas[[i]] - data.min <- min(data) - data.max <- max(data) - q1[i] <- quantile(data, 0.25) - q3[i] <- quantile(data, 0.75) - med[i] <- median(data) - iqd <- q3[i] - q1[i] - upper[i] <- min(q3[i] + range * iqd, data.max) - lower[i] <- max(q1[i] - range * iqd, data.min) - est.xlim <- c(min(lower[i], data.min), max(upper[i], - data.max)) - smout <- do.call("sm.density", c(list(data, xlim = est.xlim), - args)) - hscale <- 0.4/max(smout$estimate) * wex - base[[i]] <- smout$eval.points - height[[i]] <- smout$estimate * hscale - t <- range(base[[i]]) - baserange[1] <- min(baserange[1], t[1]) - baserange[2] <- max(baserange[2], t[2]) +vioplot <- function(x, range = 1.5, h = NULL, ylim = NULL, names = NULL, + horizontal = FALSE, col = "cornflowerblue", border = "black", lty = 1, + lwd = 1, rectCol = "black", colMed = "white", pchMed = 19, + at, add = FALSE, wex = 1, drawRect = TRUE, cex.axis = 1, log = "") { + datas <- x + n <- length(datas) + if (missing(at)) { + at <- 1:n + } + upper <- rep(NA_real_, n) + lower <- rep(NA_real_, n) + q1 <- rep(NA_real_, n) + q3 <- rep(NA_real_, n) + med <- rep(NA_real_, n) + base <- vector(mode = "list", length = n) + height <- vector(mode = "list", length = n) + baserange <- c(Inf, -Inf) + args <- list(display = "none") + if (!(is.null(h))) { + args <- c(args, h = h) + } + for (i in seq_len(n)) { + datas[[i]] <- datas[[i]][!is.na(datas[[i]])] + data <- datas[[i]] + if (length(data) < 2) next + data.min <- min(data) + data.max <- max(data) + q1[i] <- quantile(data, 0.25) + q3[i] <- quantile(data, 0.75) + med[i] <- median(data) + iqd <- q3[i] - q1[i] + upper[i] <- min(q3[i] + range * iqd, data.max) + lower[i] <- max(q1[i] - range * iqd, data.min) + est.xlim <- c(min(lower[i], data.min), max( + upper[i], + data.max + )) + smout <- do.call("sm.density", c( + list(data, xlim = est.xlim), + args + )) + hscale <- 0.4 / max(smout$estimate) * wex + base[[i]] <- smout$eval.points + height[[i]] <- smout$estimate * hscale + t <- range(base[[i]]) + baserange[1] <- min(baserange[1], t[1]) + baserange[2] <- max(baserange[2], t[2]) + } + if (!add) { + xlim <- if (n == 1) { + at + c(-0.5, 0.5) + } else { + range(at) + min(diff(at)) / 2 * c(-1, 1) } - if (!add) { - xlim <- if (n == 1) - at + c(-0.5, 0.5) - else range(at) + min(diff(at))/2 * c(-1, 1) - if (is.null(ylim)) { - ylim <- baserange - } + if (is.null(ylim)) { + ylim <- baserange } - if (is.null(names)) { - label <- 1:n + } + if (is.null(names)) { + label <- 1:n + } else { + label <- names + } + boxwidth <- 0.05 * wex + if (!add) { + plot.new() + } + if (!horizontal) { + if (!add) { + plot.window(xlim = xlim, ylim = ylim, log = log) + axis(2, cex.axis = cex.axis) + axis(1, at = at, labels = label, cex.axis = cex.axis) } - else { - label <- names + # box() + for (i in seq_len(n)) { + if (is.na(med[i])) next + polygon(c(at[i] - height[[i]], rev(at[i] + height[[i]])), + c(base[[i]], rev(base[[i]])), + col = ifelse(length(col) > 1, col[1 + (i - 1) %% length(col)], col), + border = border, lty = lty, lwd = lwd + ) + if (drawRect) { + lines(at[c(i, i)], c(lower[i], upper[i]), + lwd = lwd, + lty = lty + ) + rect(at[i] - boxwidth / 2, q1[i], at[i] + boxwidth / 2, + q3[i], + col = rectCol + ) + points(at[i], med[i], pch = pchMed, col = colMed) + } } - boxwidth <- 0.05 * wex - if (!add) - plot.new() - if (!horizontal) { - if (!add) { - plot.window(xlim = xlim, ylim = ylim) - axis(2, cex.axis=cex.axis) -# axis(1, at = at, label = label, cex.axis=cex.axis) - } - box() - for (i in 1:n) { - polygon(c(at[i] - height[[i]], rev(at[i] + height[[i]])), - c(base[[i]], rev(base[[i]])), col = col, border = border, - lty = lty, lwd = lwd) - if (drawRect) { - lines(at[c(i, i)], c(lower[i], upper[i]), lwd = lwd, - lty = lty) - rect(at[i] - boxwidth/2, q1[i], at[i] + boxwidth/2, - q3[i], col = rectCol) - points(at[i], med[i], pch = pchMed, col = colMed) - } - } + } else { + if (!add) { + plot.window(xlim = ylim, ylim = xlim, log = log) + axis(1, cex.axis = cex.axis) + axis(2, at = at, labels = label, cex.axis = cex.axis) } - else { - if (!add) { - plot.window(xlim = ylim, ylim = xlim) - axis(1, cex.axis=cex.axis) -# axis(2, at = at, label = label) - } - box() - for (i in 1:n) { - polygon(c(base[[i]], rev(base[[i]])), c(at[i] - height[[i]], - rev(at[i] + height[[i]])), col = col, border = border, - lty = lty, lwd = lwd) - if (drawRect) { - lines(c(lower[i], upper[i]), at[c(i, i)], lwd = lwd, - lty = lty) - rect(q1[i], at[i] - boxwidth/2, q3[i], at[i] + - boxwidth/2, col = rectCol) - points(med[i], at[i], pch = pchMed, col = colMed) - } - } + # box() + for (i in seq_len(n)) { + if (is.na(med[i])) next + polygon(c(base[[i]], rev(base[[i]])), c( + at[i] - height[[i]], + rev(at[i] + height[[i]]) + ), + col = ifelse(length(col) > 1, col[1 + (i - 1) %% length(col)], col), + border = border, lty = lty, lwd = lwd + ) + if (drawRect) { + lines(c(lower[i], upper[i]), at[c(i, i)], + lwd = lwd, + lty = lty + ) + rect(q1[i], at[i] - boxwidth / 2, q3[i], at[i] + + boxwidth / 2, col = rectCol) + points(med[i], at[i], pch = pchMed, col = colMed) + } } - invisible(list(upper = upper, lower = lower, median = med, - q1 = q1, q3 = q3)) + } + invisible(list( + upper = upper, lower = lower, median = med, + q1 = q1, q3 = q3 + )) } diff --git a/README.md b/README.md index 911253c..b7b57c4 100644 --- a/README.md +++ b/README.md @@ -1,48 +1,128 @@ -BoxPlotR -======== - -This is the repository for the Shiny application presented in "BoxPlotR: a web tool for generation of box plots" (Spitzer at al. 2014). - -Installation ------------- - -You have two options for running shiny-boxplot: - -1) Launch directly from R and GitHub: - - Before running the app you will need to have R and RStudio installed (tested with R 3.0.2 and RStudio 0.97.449). - - Launch the R console - -- Please run these lines in R: - - install.packages("shiny") - - install.packages("devtools") - - devtools::install_github("shiny-incubator","rstudio") - - install.packages("beeswarm") - - install.packages("vioplot") - - install.packages("beanplot") - - install.packages("RColorBrewer") - -- Then start the app: - - shiny::runGitHub("BoxPlotR.shiny", "VizWizard") - -Your web browser will open the web app. - -2) Install the shiny-server and implement shiny-boxplot as a web application and service: - - In Ubuntu 12.04+ - - sudo apt-get install gdebi-core - - wget http://download3.rstudio.org/ubuntu-12.04/x86_64/shiny-server-1.0.0.42-amd64.deb (may need to change ubuntu or server version number) - - sudo gdebi shiny-server-1.0.0.42-amd64.deb - - edit: /opt/shiny-server/config/default.config in a text editor - - Change these lines to suit your environment - - listen **SHINY_PORT**; (change **SHINY_PORT** to match the port you want) - - site_dir **SHINY_APP_HOME**; (change **SHINY_APP_HOME** to the location for your shiny apps) - - make sure **SHINY_PORT** is open on your firewall - - Go to your **SHINY_APP_HOME** - - cd **SHINY_APP_HOME** - - Get the latest shiny-boxplot code from github: - - wget https://github.com/jwildenhain/shiny-boxplot/archive/master.zip - - unzip master.zip - - mv shiny-boxplot-master shiny-boxplot - - Restart shiny-server service: - - sudo service shiny-server restart - -You should now be able to access shiny-boxplot at: http://YOURSITE:**SHINY_PORT**/shiny-boxplot +# BoxPlotR + +[![R Version](https://img.shields.io/badge/R-v4.6.0-blue.svg)](https://www.r-project.org/) +[![Shiny Version](https://img.shields.io/badge/Shiny-v1.13.0-blue.svg)](https://shiny.posit.co/) +[![Docker Environment](https://img.shields.io/badge/Docker-rocker/shiny:latest-blue.svg)](https://hub.docker.com/r/rocker/shiny) +[![Model Context Protocol](https://img.shields.io/badge/MCP-Compliant-success.svg)](https://modelcontextprotocol.io) +[![Whiskers](https://img.shields.io/badge/Whiskers-Tukey%20%7C%20Spear%20%7C%20Altman-green.svg)](#advanced-statistical-capabilities) +[![Confidence Intervals](https://img.shields.io/badge/CI-Median%20Notches%20%7C%20Mean%20CI-blue.svg)](#advanced-statistical-capabilities) + +This is the repository for the Shiny application presented in **"BoxPlotR: a web tool for generation of box plots"** (Spitzer et al. 2014). + +![BoxPlotR Modernized Preview](assets/boxplotr_preview.png) + +Advanced Statistical Capabilities +--------------------------------- + +BoxPlotR v2.0.0 is engineered for biostatistics and rigorous exploratory data analysis, automating standard publication-quality data summaries: + +### 1. Robust Whisker Calculations +* **Tukey Whiskers (`range = 1.5`):** Whiskers extend to the most extreme data point within $1.5 \times \text{IQR}$ (Interquartile Range) from the box hinges. Outliers are plotted individually. +* **Spear Whiskers (`range = 0`):** Whiskers span the absolute minimum and maximum data values, treating no data points as outliers. +* **Altman Percentiles (`range > 0`):** Whiskers represent symmetric percentiles (e.g. 5th and 95th, or 2.5th and 97.5th percentiles) directly from the sample distributionโ€”ideal for larger clinical datasets. + +### 2. Precise Median Notches (Confidence Intervals) +Notches represent the $95\%$ confidence interval around the median, calculated using: +$$\text{Median} \pm 1.58 \times \frac{\text{IQR}}{\sqrt{n}}$$ +If the notches of two box plots do not overlap, their medians differ with strong statistical evidence (approx. $95\%$ confidence level). + +### 3. Sample-Size Weighted Box Widths (`varwidth`) +Align box widths proportionally to the square root of the number of observations ($\sqrt{n}$) to immediately alert reviewers to sample size variations across groups. + +### 4. Mean & Confidence Interval Overlays +Superimpose sample means as high-contrast red diamonds, with customizable error bars showing $83\%$, $90\%$, or $95\%$ confidence intervals of the mean. + +### 5. Multi-Modal Density Estimation +Toggle from standard summaries to **Violin Plots** or **Beanplots** to inspect kernel density bandwidths, skewness, and multimodal distributions. + +--- + +Installation and Run Options +---------------------------- + +### 1) Run Natively via Docker (Recommended Isolated Deployment) + +Deploy the fully-configured modern version natively without installing R dependencies directly onto your host system: + +```bash +# Build the Docker image +docker build -t boxplotr:latest . + +# Run the container (maps the container server to port 3838) +docker run -d -p 3838:3838 boxplotr:latest +``` +Access the application in your web browser at: `http://localhost:3838` + +### 2) Running the Isolated Test Suite +The container comes equipped with `testthat` to run the project's automated test suite inside the same isolated sandbox: + +```bash +docker run --rm boxplotr:latest Rscript -e "library(testthat); test_dir('/srv/shiny-server/tests')" +``` + +--- + +### 3) Launch Natively from R and GitHub + +Before running natively, ensure you have the latest versions of R and RStudio installed: + +1. Launch R / RStudio Console. +2. Install the necessary packages: + ```R + install.packages(c("shiny", "beeswarm", "vioplot", "beanplot", "RColorBrewer", "readxl", "sm", "testthat")) + ``` +3. Start the application directly: + ```R + shiny::runGitHub("BoxPlotR.shiny", "jwildenhain") + ``` + +--- + +### 4) Install Natively on Shiny Server + +To run BoxPlotR as a service on a dedicated Linux host (e.g. Ubuntu): + +1. Install Shiny Server system dependencies: + ```bash + sudo apt-get update + sudo apt-get install gdebi-core R-base + ``` +2. Download and install POSIT's Shiny Server from [posit.co/download/shiny-server/](https://posit.co/download/shiny-server/). +3. Pull the BoxPlotR repository into your Shiny server apps directory (e.g., `/srv/shiny-server/` or your custom `SHINY_APP_HOME`). +4. Install all required R packages system-wide: + ```bash + sudo R -e 'install.packages(c("shiny", "beeswarm", "vioplot", "beanplot", "RColorBrewer", "readxl", "sm"), repos="https://cloud.r-project.org/")' + ``` +5. Restart the server service: + ```bash + sudo systemctl restart shiny-server + ``` + +--- + +### 5) Model Context Protocol (MCP) Server Integration + +This repository includes a native, stdio-compliant **Model Context Protocol (MCP) server** (`boxplotr_mcp_server.py`) written in Python with no external library dependencies. It allows large language models (LLMs) to call BoxPlotR's plotting engine directly via standard JSON-RPC tools! + +#### Running the MCP Server Natively +Make sure you have `Python 3` and `Rscript` installed on your machine: +```bash +./boxplotr_mcp_server.py +``` + +#### Integrating with Claude Desktop / LLM Clients +To configure the BoxPlotR MCP Server in Claude Desktop, add the following entry to your `claude_desktop_config.json` (usually located at `~/.config/Claude/claude_desktop_config.json` on Linux/macOS or `%APPDATA%/Claude/claude_desktop_config.json` on Windows): + +```json +{ + "mcpServers": { + "boxplotr": { + "command": "python3", + "args": ["/home/jw/Source/BoxPlotR.shiny/boxplotr_mcp_server.py"] + } + } +} +``` + +Once integrated, any LLM configured with MCP can generate publication-grade box plots, violin plots, and bean plots automatically by processing user commands and passing data directly to BoxPlotR! + diff --git a/RELEASE_v2.0.0.md b/RELEASE_v2.0.0.md new file mode 100644 index 0000000..a669a96 --- /dev/null +++ b/RELEASE_v2.0.0.md @@ -0,0 +1,39 @@ +# Release Notes - BoxPlotR v2.0.0 (Modernized) + +We are proud to announce the official release of **BoxPlotR v2.0.0**. This milestone release fully modernizes the classic 13-year-old BoxPlotR codebase, bringing state-of-the-art **ggplot2 integration**, a **Model Context Protocol (MCP) server** for AI coding assistants, robust statistical overlays, and strict reactive stability. + +--- + +## ๐ŸŒŸ What's New in v2.0.0 + +### ๐Ÿ“Š 1. Modern ggplot2 Rendering Engine +* **ggplot2 Integration**: Introduced a brand-new **Modern (ggplot2)** plotting engine, allowing users to toggle between Base R vector plots and modern ggplot2 layouts. +* **Premium Theme Presets**: Added professional journal-style preset themes, including **Nature**, **Science**, **The Economist**, and the **Financial Times (FT)**, making plot export ready for publication. +* **Smart Grid Customization**: Users can now selectively toggle background grid lines on both axis orientations (`x`, `y`, or `both`) to optimize scannability. + +### ๐Ÿ“ 2. High-Fidelity Overlays & Notch Fixes +* **Advanced Point Arrangements**: Seamlessly overlay individual data points using **normal**, **jittered**, or high-fidelity **beeswarm** point arrangements. +* **Sample Means & Confidence Intervals**: Added the option to compute and display sample means as red diamonds, complete with customizable confidence interval error bars (83%, 90%, or 95%). +* **Safe Logarithmic Scale Support**: Fixed a critical R layout flare-up distortion on logarithmic scales. Non-standard aesthetics (such as `notchlower` and `notchupper` under base R custom whisker calculations) are now manually pre-transformed (`log10(pmax(1e-10, val))`) to ensure flawless vector rendering. + +### ๐Ÿ”Œ 3. Model Context Protocol (MCP) Server Integration +* **Dynamic AI Assistance**: Native Python implementation of an **MCP server** (`boxplotr_mcp_server.py`) working over line-by-line standard input/output (`stdio`). +* **Structured JSON Schema Specification**: Implements a clean, nested schema layout (`data_config`, `visualization`, `styling`, `overlays`, `output_path`) for robust code validation while preserving full flat-argument backward compatibility. +* **Verified Local Testing**: The Shiny application's **FAQ tab** has been expanded with clear command-line minified JSON-RPC testing sequences. + +### ๐Ÿ”’ 4. Stability, Safety, & Formats +* **Zero-Length Reactive Protection**: Integrated safe input validators at the top of the reactive engine, completely resolving the infamous Shiny `argument is of length zero` startup crash during transitions. +* **Native Excel Support**: Seamlessly parse, upload, and visualize modern `.xlsx` sheets without requiring external server conversions. +* **Automated Unit Testing**: Implemented a comprehensive `testthat` verification suite (`tests/test_ggplot_boxplot.R`) covering ggplot2 layouts, notch safety, and overlays under linear and log scales. + +--- + +## ๐Ÿš€ Getting Started with testing the MCP Server + +You can execute the newly-documented, fully-validated test sequence directly from your terminal to verify standard I/O (NDJSON) plotting: + +```bash +echo '{"jsonrpc": "2.0", "id": 1, "method": "tools/call", "params": {"name": "generate_boxplot", "arguments": {"data_config": {"values": "SampleA,SampleB\n12.5,8.9\n14.2,10.1\n15.8,11.5\n13.1,9.4"}, "visualization": {"plot_type": "boxplot", "plot_engine": "ggplot2", "style_guide": "economist", "orientation": "vertical", "log_scale": false}, "styling": {"title": "Comparison of Sample A and Sample B", "xlab": "Group", "ylab": "Value", "colors": ["#0ea5e9", "#ef4444"], "add_grid": "y"}, "overlays": {"show_points": true, "point_type": "jittered", "point_size": 1.2, "point_transparency": 30, "add_means": true, "notch": true}, "output_path": "assets/mcp_test_plot.png"}}}' | python3 boxplotr_mcp_server.py +``` + +This will output a successful JSON-RPC response confirming that the output image is generated at `assets/mcp_test_plot.png`! diff --git a/assets/boxplotr_preview.png b/assets/boxplotr_preview.png new file mode 100644 index 0000000..3b8464d Binary files /dev/null and b/assets/boxplotr_preview.png differ diff --git a/assets/ggplot2_altman_whiskers.png b/assets/ggplot2_altman_whiskers.png new file mode 100644 index 0000000..90a637d Binary files /dev/null and b/assets/ggplot2_altman_whiskers.png differ diff --git a/assets/ggplot2_bean_plot_rendered.png b/assets/ggplot2_bean_plot_rendered.png new file mode 100644 index 0000000..f75a6b6 Binary files /dev/null and b/assets/ggplot2_bean_plot_rendered.png differ diff --git a/assets/ggplot2_spear_whiskers.png b/assets/ggplot2_spear_whiskers.png new file mode 100644 index 0000000..5fd7181 Binary files /dev/null and b/assets/ggplot2_spear_whiskers.png differ diff --git a/assets/mcp_generated_plot.png b/assets/mcp_generated_plot.png new file mode 100644 index 0000000..ba58d14 Binary files /dev/null and b/assets/mcp_generated_plot.png differ diff --git a/assets/modern_ggplot2_bean_plot.png b/assets/modern_ggplot2_bean_plot.png new file mode 100644 index 0000000..cadf6a5 Binary files /dev/null and b/assets/modern_ggplot2_bean_plot.png differ diff --git a/assets/modern_ggplot2_boxplot_jittered.png b/assets/modern_ggplot2_boxplot_jittered.png new file mode 100644 index 0000000..bd86f6a Binary files /dev/null and b/assets/modern_ggplot2_boxplot_jittered.png differ diff --git a/boxplotr_mcp_server.py b/boxplotr_mcp_server.py new file mode 100755 index 0000000..41ca876 --- /dev/null +++ b/boxplotr_mcp_server.py @@ -0,0 +1,760 @@ +#!/usr/bin/env python3 +import sys +import json +import os +import subprocess +import tempfile + +def log(msg): + sys.stderr.write(f"LOG: {msg}\n") + sys.stderr.flush() + +def generate_plot(arguments): + # Extract nested sections (supporting the new JSON Schema spec) + data_config = arguments.get("data_config", {}) + visualization = arguments.get("visualization", {}) + styling = arguments.get("styling", {}) + overlays = arguments.get("overlays", {}) + + # Fallback to old flat structure if present (for backward compatibility) + data_str = data_config.get("values", arguments.get("data", "")) + output_path = arguments.get("output_path", "") + + plot_type = visualization.get("plot_type", arguments.get("plot_type", "boxplot")) + plot_engine = visualization.get("plot_engine", arguments.get("plot_engine", "classic")) + style_guide = visualization.get("style_guide", arguments.get("style_guide", "none")) + orientation = visualization.get("orientation", arguments.get("orientation", "vertical")) + log_scale = visualization.get("log_scale", arguments.get("log_scale", False)) + + title = styling.get("title", arguments.get("title", "")) + subtitle = styling.get("subtitle", arguments.get("subtitle", "")) + xlab = styling.get("xlab", arguments.get("xlab", "")) + ylab = styling.get("ylab", arguments.get("ylab", "")) + colors = styling.get("colors", arguments.get("colors", [])) + add_grid = styling.get("add_grid", arguments.get("add_grid", "none")) + + show_points = overlays.get("show_points", arguments.get("show_points", False)) + point_type = overlays.get("point_type", arguments.get("point_type", "jittered")) + point_size = overlays.get("point_size", arguments.get("point_size", 1.0)) + point_transparency = overlays.get("point_transparency", arguments.get("point_transparency", 50)) + add_means = overlays.get("add_means", arguments.get("add_means", False)) + add_mean_ci = overlays.get("add_mean_ci", arguments.get("add_mean_ci", False)) + mean_ci_level = overlays.get("mean_ci_level", arguments.get("mean_ci_level", 95)) + varwidth = overlays.get("varwidth", arguments.get("varwidth", False)) + notch = overlays.get("notch", arguments.get("notch", False)) + + # Validation + if not data_str: + raise ValueError("Missing 'data' or 'data_config.values' argument") + if not output_path: + raise ValueError("Missing 'output_path' argument") + + # Resolve absolute paths + output_path = os.path.abspath(output_path) + os.makedirs(os.path.dirname(output_path), exist_ok=True) + + # Create R list for colors + if colors: + colors_r = "c(" + ", ".join(f'"{c}"' for c in colors) + ")" + else: + colors_r = "NULL" + + # R Template code supporting both Classic R and ggplot2 along with style guides + r_code_template = """ +source("/home/jw/Source/BoxPlotR.shiny/BoxPlotR_functions.R") +source("/home/jw/Source/BoxPlotR.shiny/boxplot_stats_Function.R") +library(beeswarm) +library(vioplot) +library(beanplot) +library(sm) + +# Load data +data_str <- __DATA_STR__ +plot_data <- read.csv(text = data_str, header = TRUE, check.names = FALSE) +plot_data_m <- as.matrix(plot_data) + +# Colors +my_colours <- __COLORS_R__ +if (is.null(my_colours) || length(my_colours) < ncol(plot_data)) { + library(RColorBrewer) + my_colours <- brewer.pal(max(3, ncol(plot_data)), "Pastel1")[1:ncol(plot_data)] +} + +my_orientation <- __ORIENTATION__ +my_log_val <- __LOG_SCALE__ + +if ("__PLOT_ENGINE__" == "ggplot2") { + library(ggplot2) + + # Convert plot_data to long format + df_long <- data.frame( + Value = unlist(plot_data, use.names = FALSE), + Group = rep(colnames(plot_data), each = nrow(plot_data)) + ) + df_long <- na.omit(df_long) + df_long$Group <- factor(df_long$Group, levels = colnames(plot_data)) + + # Prepare recycled colors vector + plot_colours <- rep(my_colours, length.out = ncol(plot_data)) + + if ("__PLOT_TYPE__" == "boxplot") { + # Calculate boxplot stats using overridden boxplot() + bp_stats <- boxplot(plot_data, range = 1.5, plot = FALSE) + + notchlower_val <- bp_stats$conf[1, ] + notchupper_val <- bp_stats$conf[2, ] + if (my_log_val) { + notchlower_val <- log10(pmax(1e-10, notchlower_val)) + notchupper_val <- log10(pmax(1e-10, notchupper_val)) + } + + df_stats <- data.frame( + Group = factor(bp_stats$names, levels = colnames(plot_data)), + ymin = bp_stats$stats[1, ], + lower = bp_stats$stats[2, ], + middle = bp_stats$stats[3, ], + upper = bp_stats$stats[4, ], + ymax = bp_stats$stats[5, ], + notchlower = notchlower_val, + notchupper = notchupper_val, + fill = bp_stats$names + ) + + p <- ggplot(df_stats, aes(x = Group, fill = Group)) + + suppressWarnings(geom_boxplot( + aes( + ymin = ymin, lower = lower, middle = middle, upper = upper, ymax = ymax, + notchlower = notchlower, notchupper = notchupper + ), + stat = "identity", + varwidth = __VARWIDTH__, + notch = __NOTCH__, + width = 0.6 + )) + + # Identify outliers matching the calculated whiskers + df_outliers <- df_long + df_outliers$ymin <- df_stats$ymin[match(df_outliers$Group, df_stats$Group)] + df_outliers$ymax <- df_stats$ymax[match(df_outliers$Group, df_stats$Group)] + df_outliers <- df_outliers[df_outliers$Value < df_outliers$ymin | df_outliers$Value > df_outliers$ymax, ] + + if (!__SHOW_POINTS__ && nrow(df_outliers) > 0) { + p <- p + geom_point( + data = df_outliers, + aes(x = Group, y = Value), + color = "black", + size = 1.5, + shape = 19, + inherit.aes = FALSE + ) + } + } else if ("__PLOT_TYPE__" == "violin") { + p <- ggplot(df_long, aes(x = Group, y = Value, fill = Group)) + + geom_violin(color = "black", width = 0.8) + } else if ("__PLOT_TYPE__" == "beanplot") { + p <- ggplot(df_long, aes(x = Group, y = Value, fill = Group)) + + geom_violin(color = "black", width = 0.8, alpha = 0.7) + + stat_summary( + fun = "median", + geom = "crossbar", + width = 0.4, + color = "black", + middle.linewidth = 0.8 + ) + + geom_segment( + aes( + x = as.numeric(Group) - 0.15, + xend = as.numeric(Group) + 0.15, + y = Value, + yend = Value + ), + color = "#1e293b", + linewidth = 0.4, + alpha = 0.4 + ) + } + + # Apply colors + p <- p + scale_fill_manual(values = plot_colours) + + # Points overlay + if (__SHOW_POINTS__) { + pt_trans <- 1 - (__POINT_TRANSPARENCY__ / 100) + pt_sz <- __POINT_SIZE__ + pt_col <- "#334155" + points_data <- if ("__PLOT_TYPE__" == "boxplot") df_long else NULL + points_aes <- if ("__PLOT_TYPE__" == "boxplot") aes(y = Value) else NULL + + if ("__POINT_TYPE__" == "beeswarm" || "__POINT_TYPE__" == "jittered") { + p <- p + geom_jitter( + data = points_data, + mapping = points_aes, + width = if ("__POINT_TYPE__" == "beeswarm") 0.05 else 0.2, + height = 0, + color = pt_col, size = pt_sz, alpha = pt_trans + ) + } else { + p <- p + geom_point( + data = points_data, + mapping = points_aes, + position = position_nudge(x = 0), + color = pt_col, size = pt_sz, alpha = pt_trans + ) + } + } + + # Add means + if (__ADD_MEANS__ && "__PLOT_TYPE__" == "boxplot") { + p <- p + stat_summary( + data = df_long, + aes(x = Group, y = Value), + fun = mean, + geom = "point", + shape = 18, + size = 4, + color = "red", + inherit.aes = FALSE + ) + if (__ADD_MEAN_CI__) { + ci_fun <- function(x) { + n <- sum(!is.na(x)) + if (n <= 1) return(c(ymin = NA, ymax = NA)) + se <- sd(x, na.rm = TRUE) / sqrt(n) + ci_level <- __MEAN_CI_LEVEL__ / 100 + t_val <- qt((1 + ci_level) / 2, df = n - 1) + me <- t_val * se + m <- mean(x, na.rm = TRUE) + c(ymin = m - me, ymax = m + me) + } + p <- p + stat_summary( + data = df_long, + aes(x = Group, y = Value), + fun.data = ci_fun, + geom = "errorbar", + width = 0.2, + color = "red", + linewidth = 0.8, + inherit.aes = FALSE + ) + } + } + + # Log scale + if (my_log_val) { + p <- p + scale_y_log10() + } + + # Labels + p <- p + labs( + title = "__TITLE__", + subtitle = "__SUBTITLE__", + x = "__XLAB__", + y = "__YLAB__" + ) + + # Orientation / flipped coordinates + if (my_orientation) { + p <- p + coord_flip() + } + + # Resolve style guide defaults for ggplot + style_font <- "Inter" + bg_fill <- "white" + panel_bg_fill <- "white" + grid_color <- "#e2e8f0" + axis_line_color <- "#475569" + plot_title_hjust <- 0.5 + + if ("__STYLE_GUIDE__" == "nature") { + style_font <- "sans" + } else if ("__STYLE_GUIDE__" == "science") { + style_font <- "serif" + } else if ("__STYLE_GUIDE__" == "economist") { + style_font <- "sans" + bg_fill <- "#e4eef2" + panel_bg_fill <- "#e4eef2" + grid_color <- "white" + axis_line_color <- "#1e293b" + plot_title_hjust <- 0 + } else if ("__STYLE_GUIDE__" == "ft") { + style_font <- "serif" + bg_fill <- "#fff1e5" + panel_bg_fill <- "#fff1e5" + grid_color <- "#e2d6ca" + axis_line_color <- "#1e293b" + plot_title_hjust <- 0 + } + + # Theme minimal base + p <- p + theme_minimal(base_family = style_font) + + theme( + plot.title = element_text(size = 14, face = "bold", hjust = plot_title_hjust), + plot.subtitle = element_text(size = 11, hjust = plot_title_hjust, color = "#475569"), + axis.title.x = element_text(size = 12), + axis.title.y = element_text(size = 12), + axis.text = element_text(size = 10), + legend.position = "none", + panel.background = element_rect(fill = panel_bg_fill, color = NA), + plot.background = element_rect(fill = bg_fill, color = NA), + axis.line = element_line(color = axis_line_color, linewidth = 0.6), + axis.ticks = element_line(color = axis_line_color, linewidth = 0.6) + ) + + # Gridlines + if ("__ADD_GRID__" == "none") { + p <- p + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + } else if ("__ADD_GRID__" == "x") { + p <- p + theme(panel.grid.major.y = element_blank(), panel.grid.minor = element_blank(), panel.grid.major.x = element_line(color = grid_color)) + } else if ("__ADD_GRID__" == "y") { + p <- p + theme(panel.grid.major.x = element_blank(), panel.grid.minor = element_blank(), panel.grid.major.y = element_line(color = grid_color)) + } else { + p <- p + theme( + panel.grid.major = element_line(color = grid_color), + panel.grid.minor = element_blank() + ) + } + + # Print / Save plot + png("__OUTPUT_PATH__", width = 800, height = 600, res = 120) + print(p) + dev.off() + +} else { + # Classic Base R drawing code with style guides + bg_fill <- "white" + style_font <- "" + + if ("__STYLE_GUIDE__" == "nature") { + style_font <- "sans" + } else if ("__STYLE_GUIDE__" == "science") { + style_font <- "serif" + } else if ("__STYLE_GUIDE__" == "economist") { + style_font <- "sans" + bg_fill <- "#e4eef2" + } else if ("__STYLE_GUIDE__" == "ft") { + style_font <- "serif" + bg_fill <- "#fff1e5" + } + + my_log <- if (my_log_val) (if (my_orientation) "x" else "y") else "" + + # Ranges + r <- range(plot_data, na.rm = TRUE) + if (my_log_val) { + shared_lim <- c(r[1], r[2] * (10^(diff(log10(r[r > 0])) * 0.15))) + } else { + padding <- diff(r) * 0.15 + shared_lim <- c(r[1] - (diff(r) * 0.04), r[2] + padding) + } + + png("__OUTPUT_PATH__", width = 800, height = 600, res = 120) + par(bg = bg_fill, family = style_font) + par(mar = c(5, 5, 4, 2) + 0.1) + + # Drawing + if ("__PLOT_TYPE__" == "boxplot") { + boxplot( + plot_data, + main = "__TITLE__", + sub = "__SUBTITLE__", + xlab = "__XLAB__", + ylab = "__YLAB__", + col = my_colours, + horizontal = my_orientation, + varwidth = __VARWIDTH__, + notch = __NOTCH__, + outline = __OUTLINE__, + range = 1.5, + log = my_log, + ylim = if (!my_orientation) shared_lim else NULL, + xlim = if (my_orientation) shared_lim else NULL, + frame.plot = FALSE + ) + } else if ("__PLOT_TYPE__" == "violin") { + vioplot( + as.list(plot_data), + col = my_colours, + horizontal = my_orientation, + border = "black", + ylim = shared_lim, + names = colnames(plot_data), + log = my_log + ) + title( + main = "__TITLE__", + sub = "__SUBTITLE__", + xlab = "__XLAB__", + ylab = "__YLAB__" + ) + } else if ("__PLOT_TYPE__" == "beanplot") { + beanplot( + plot_data, + xlim = c(0.5, ncol(plot_data) + 0.5), + ylim = shared_lim, + col = as.list(my_colours), + horizontal = my_orientation, + border = "black", + names = colnames(plot_data), + frame.plot = FALSE, + log = my_log + ) + title( + main = "__TITLE__", + sub = "__SUBTITLE__", + xlab = "__XLAB__", + ylab = "__YLAB__" + ) + } + + # Add grid + if ("__ADD_GRID__" == "both") { + grid() + } else if ("__ADD_GRID__" == "x") { + grid(nx = NULL, ny = NA) + } else if ("__ADD_GRID__" == "y") { + grid(nx = NA, ny = NULL) + } + + # Add data points + if (__SHOW_POINTS__) { + point_style <- if ("__POINT_TYPE__" == "jittered") 2 else if ("__POINT_TYPE__" == "beeswarm") 1 else 0 + if (point_style == 1) { + beeswarm( + plot_data, + add = TRUE, + col = "#334155", + horizontal = my_orientation, + cex = __POINT_SIZE__, + pch = 16 + ) + } else { + jittered_points( + plot_data_m, + my_horizontal = my_orientation, + point_type = point_style, + point_colors = rep("#334155", ncol(plot_data)), + point_transparency = __POINT_TRANSPARENCY__, + point_size = __POINT_SIZE__ + ) + } + } + + # Add means + if (__ADD_MEANS__ && "__PLOT_TYPE__" == "boxplot") { + boxplot_means <- colMeans(plot_data, na.rm = TRUE) + if (my_orientation) { + points(boxplot_means, seq_along(boxplot_means), pch = 18, col = "red", cex = 1.5) + } else { + points(seq_along(boxplot_means), boxplot_means, pch = 18, col = "red", cex = 1.5) + } + + if (__ADD_MEAN_CI__) { + for (i in seq_along(plot_data)) { + my_sample <- na.omit(plot_data[[i]]) + n <- length(my_sample) + if (n > 1) { + standard_error <- sd(my_sample) / sqrt(n) + ci_level <- __MEAN_CI_LEVEL__ / 100 + t_value <- qt((1 + ci_level) / 2, df = n - 1) + margin_error <- t_value * standard_error + lower_ci <- boxplot_means[i] - margin_error + upper_ci <- boxplot_means[i] + margin_error + + if (my_orientation) { + lines(c(lower_ci, upper_ci), c(i, i), col = "red", lwd = 2) + lines(c(lower_ci, lower_ci), c(i - 0.1, i + 0.1), col = "red", lwd = 2) + lines(c(upper_ci, upper_ci), c(i - 0.1, i + 0.1), col = "red", lwd = 2) + } else { + lines(c(i, i), c(lower_ci, upper_ci), col = "red", lwd = 2) + lines(c(i - 0.1, i + 0.1), c(lower_ci, lower_ci), col = "red", lwd = 2) + lines(c(i - 0.1, i + 0.1), c(upper_ci, upper_ci), col = "red", lwd = 2) + } + } + } + } + } + + dev.off() +} +""" + + r_code = r_code_template + r_code = r_code.replace("__DATA_STR__", json.dumps(data_str)) + r_code = r_code.replace("__COLORS_R__", colors_r) + r_code = r_code.replace("__ORIENTATION__", "TRUE" if orientation == "horizontal" else "FALSE") + r_code = r_code.replace("__LOG_SCALE__", "TRUE" if log_scale else "FALSE") + r_code = r_code.replace("__OUTPUT_PATH__", output_path) + r_code = r_code.replace("__PLOT_TYPE__", plot_type) + r_code = r_code.replace("__TITLE__", title) + r_code = r_code.replace("__SUBTITLE__", subtitle) + r_code = r_code.replace("__XLAB__", xlab) + r_code = r_code.replace("__YLAB__", ylab) + r_code = r_code.replace("__VARWIDTH__", "TRUE" if varwidth else "FALSE") + r_code = r_code.replace("__NOTCH__", "TRUE" if notch else "FALSE") + r_code = r_code.replace("__OUTLINE__", "FALSE" if show_points else "TRUE") + r_code = r_code.replace("__ADD_GRID__", add_grid) + r_code = r_code.replace("__SHOW_POINTS__", "TRUE" if show_points else "FALSE") + r_code = r_code.replace("__POINT_TYPE__", point_type) + r_code = r_code.replace("__POINT_SIZE__", str(point_size)) + r_code = r_code.replace("__POINT_TRANSPARENCY__", str(point_transparency)) + r_code = r_code.replace("__ADD_MEANS__", "TRUE" if add_means else "FALSE") + r_code = r_code.replace("__ADD_MEAN_CI__", "TRUE" if add_mean_ci else "FALSE") + r_code = r_code.replace("__MEAN_CI_LEVEL__", str(mean_ci_level)) + + r_code = r_code.replace("__PLOT_ENGINE__", plot_engine) + r_code = r_code.replace("__STYLE_GUIDE__", style_guide) + + with tempfile.NamedTemporaryFile(suffix=".R", mode="w", delete=False) as f: + f.write(r_code) + temp_script_path = f.name + + try: + log(f"Running Rscript on {temp_script_path}") + result = subprocess.run( + ["Rscript", temp_script_path], + capture_output=True, + text=True + ) + if result.returncode != 0: + log(f"Rscript failed: {result.stderr}") + raise RuntimeError(f"R plotting failed: {result.stderr}") + log(f"Plot successfully generated and saved to {output_path}") + return output_path + finally: + if os.path.exists(temp_script_path): + os.remove(temp_script_path) + +def main(): + log("BoxPlotR MCP Server starting...") + while True: + try: + line = sys.stdin.readline() + if not line: + break + + message = json.loads(line) + method = message.get("method") + msg_id = message.get("id") + + if method == "initialize": + response = { + "jsonrpc": "2.0", + "id": msg_id, + "result": { + "protocolVersion": "2024-11-05", + "capabilities": { + "tools": {} + }, + "serverInfo": { + "name": "boxplotr-mcp-server", + "version": "1.0.0" + } + } + } + sys.stdout.write(json.dumps(response) + "\n") + sys.stdout.flush() + + elif method == "notifications/initialized": + pass + + elif method == "tools/list": + response = { + "jsonrpc": "2.0", + "id": msg_id, + "result": { + "tools": [ + { + "name": "generate_boxplot", + "description": "Generates a highly-customizable box plot, violin plot, or bean plot using the BoxPlotR backend and saves it as an image.", + "inputSchema": { + "type": "object", + "properties": { + "data_config": { + "type": "object", + "description": "Input data configurations", + "properties": { + "values": { + "type": "string", + "description": "The input data as CSV or TSV string where columns represent different samples/conditions" + } + }, + "required": ["values"] + }, + "visualization": { + "type": "object", + "description": "Plot rendering and engine structural parameters", + "properties": { + "plot_type": { + "type": "string", + "enum": ["boxplot", "violin", "beanplot"], + "description": "The type of plot to generate" + }, + "plot_engine": { + "type": "string", + "enum": ["classic", "ggplot2"], + "description": "Plotting engine: 'classic' for Base R or 'ggplot2' for modern rendering (default: classic)" + }, + "style_guide": { + "type": "string", + "enum": ["none", "nature", "science", "economist", "ft"], + "description": "Visual preset style guide: 'none', 'nature', 'science', 'economist', or 'ft' (default: none)" + }, + "orientation": { + "type": "string", + "enum": ["vertical", "horizontal"], + "description": "Orientation of the plot (default: vertical)" + }, + "log_scale": { + "type": "boolean", + "description": "Whether to use a logarithmic scale (log10) for the numeric axis" + } + }, + "required": ["plot_type"] + }, + "styling": { + "type": "object", + "description": "Custom aesthetic and text properties", + "properties": { + "title": { "type": "string", "description": "Main title of the plot" }, + "subtitle": { "type": "string", "description": "Subtitle of the plot" }, + "xlab": { "type": "string", "description": "X-axis label" }, + "ylab": { "type": "string", "description": "Y-axis label" }, + "colors": { + "type": "array", + "items": { "type": "string" }, + "description": "Array of HEX colors for each sample/condition" + }, + "add_grid": { + "type": "string", + "enum": ["none", "both", "x", "y"], + "description": "Background grid: 'none', 'both', 'x', or 'y' (default: none)" + } + } + }, + "overlays": { + "type": "object", + "description": "Raw data point and statistical overlay properties", + "properties": { + "show_points": { "type": "boolean", "description": "Whether to display individual data points on top of the plot" }, + "point_type": { + "type": "string", + "enum": ["normal", "jittered", "beeswarm"], + "description": "The arrangement style for data points (default: jittered)" + }, + "point_size": { "type": "number", "description": "Size factor of the plotted data points (e.g. 1.0)" }, + "point_transparency": { "type": "number", "description": "Transparency level of the plotted points from 0 to 100 (default: 50)" }, + "add_means": { "type": "boolean", "description": "For boxplots, whether to plot the mean of each sample as a red diamond" }, + "add_mean_ci": { "type": "boolean", "description": "For boxplots, whether to add confidence intervals for the sample means" }, + "mean_ci_level": { + "type": "integer", + "enum": [83, 90, 95], + "description": "The confidence level percentage for the means CI (default: 95)" + }, + "varwidth": { "type": "boolean", "description": "For boxplots, whether box widths should be proportional to square-roots of observations counts" }, + "notch": { "type": "boolean", "description": "For boxplots, whether to add notches showing 95% CI of medians" } + } + }, + "output_path": { + "type": "string", + "description": "Absolute path where the resulting PNG plot image should be saved" + } + }, + "required": ["data_config", "visualization", "output_path"] + }, + "examples": [ + { + "arguments": { + "data_config": { + "values": "Group,Value\nSampleA,12.5\nSampleA,14.2\nSampleA,15.8\nSampleB,8.9\nSampleB,10.1\nSampleB,11.5" + }, + "visualization": { + "plot_type": "boxplot", + "plot_engine": "ggplot2", + "style_guide": "economist", + "orientation": "vertical", + "log_scale": false + }, + "styling": { + "title": "Comparison of Sample A and Sample B", + "xlab": "Group", + "ylab": "Value", + "colors": ["#0ea5e9", "#ef4444"], + "add_grid": "y" + }, + "overlays": { + "show_points": true, + "point_type": "jittered", + "point_size": 1.2, + "point_transparency": 30, + "add_means": true, + "notch": true + }, + "output_path": "/home/jw/Source/BoxPlotR.shiny/assets/example_plot.png" + }, + "description": "Generates a publication-quality ggplot2 boxplot with notches, sample means, and jittered data points using the Economist style guide." + } + ] + } + ] + } + } + sys.stdout.write(json.dumps(response) + "\n") + sys.stdout.flush() + + elif method == "notifications/initialized": + pass + + elif method == "tools/call": + params = message.get("params", {}) + tool_name = params.get("name") + arguments = params.get("arguments", {}) + + if tool_name == "generate_boxplot": + try: + out_path = generate_plot(arguments) + response = { + "jsonrpc": "2.0", + "id": msg_id, + "result": { + "content": [ + { + "type": "text", + "text": f"Success! BoxPlotR generated the plot successfully and saved it to: {out_path}" + } + ], + "isError": False + } + } + except Exception as e: + response = { + "jsonrpc": "2.0", + "id": msg_id, + "result": { + "content": [ + { + "type": "text", + "text": f"Error generating plot: {str(e)}" + } + ], + "isError": True + } + } + sys.stdout.write(json.dumps(response) + "\n") + sys.stdout.flush() + else: + if msg_id is not None: + response = { + "jsonrpc": "2.0", + "id": msg_id, + "error": { + "code": -32601, + "message": f"Method not found: {method}" + } + } + sys.stdout.write(json.dumps(response) + "\n") + sys.stdout.flush() + except Exception as e: + log(f"Unhandled error in loop: {str(e)}") + +if __name__ == "__main__": + main() diff --git a/log_scale_example.csv b/log_scale_example.csv new file mode 100644 index 0000000..9ba360b --- /dev/null +++ b/log_scale_example.csv @@ -0,0 +1,101 @@ +"Baseline","Treated","Knockout" +394,60584,4 +57,47929,12 +144,2221,18 +188,160021,28 +150,3678,5 +90,11715,6 +453,5308,7 +91,8323,6 +753,13262,7 +94,11957,9 +369,9631,5 +984,11760,28 +25,4828,11 +76,4694,10 +88,828,13 +189,5635,10 +75,4635,9 +7,575605,21 +9,1296,9 +374,12286,5 +74,1064,12 +17,1102,8 +84,12057,8 +337,2243,6 +665,9973,12 +65,5260,9 +77,3983,13 +17,480,9 +158,1593,7 +53,13090,19 +158,23430,9 +202,4774,16 +282,10001,5 +54,53889,8 +166,86693,9 +18,1929,8 +46,8386,20 +43,60633,10 +9,4943,11 +104,9243,6 +123,8788,7 +70,2641,16 +213,5132,19 +48,9568,19 +25,5375,5 +154,53126,28 +44,4860,17 +424,5222,10 +65,28442,14 +193,2050,6 +138,9408,6 +46,976,10 +483,57589,5 +190,6633,11 +109,4957,19 +132,1561,6 +197,9884,7 +109,3011,10 +5,4492,6 +133,68999,8 +69,7685,15 +120,2004,16 +179,12774,12 +405,5804,4 +48,24230,10 +368,85731,17 +140,2256,15 +282,19778,9 +251,11358,3 +206,38319,10 +35,7085,13 +91,35076,10 +187,730,11 +39,126062,12 +58,36589,8 +179,7976,19 +216,1138,13 +159,26235,5 +41,20643,20 +33,9905,18 +454,12551,15 +129,4164,4 +109,17388,8 +89,15558,14 +30,6578,10 +184,1347,12 +80,28609,34 +83,22963,7 +254,2852,3 +227,915,11 +402,13599,7 +62,5959,12 +192,14607,7 +402,1436,30 +33,2372,9 +42,50971,8 +32,18325,9 +23,24103,15 +108,152235,10 +192,12132,4 diff --git a/server.R b/server.R index b16b8ae..9285ebc 100644 --- a/server.R +++ b/server.R @@ -1,394 +1,1125 @@ +options(shiny.maxRequestSize = 200 * 1024^2) + +# Pre-load example datasets so they don't hit the disk constantly +sample_data_1_cache <- read.table( + "Boxplot_testData2.csv", + sep = ",", header = TRUE, fill = TRUE, + check.names = FALSE +) +sample_data_2_cache <- read.table( + "Boxplot_testData.txt", + sep = ",", header = TRUE, + check.names = FALSE +) +sample_data_3_cache <- as.data.frame( + readxl::read_excel("Boxplot_testData3.xlsx") +) + +# Helper function to prevent redundant color parsing +parse_colours <- function(col_strings) { + if (is.null(col_strings) || length(col_strings) == 0 || col_strings == "") { + return(c("grey")) + } + my_colours <- gsub("\\s", "", strsplit(col_strings, ",")[[1]]) + my_colours <- gsub("0x", "#", my_colours) + if (length(my_colours) == 0) { + return(c("grey")) + } + return(my_colours) +} + shinyServer(function(input, output, session) { + library(RColorBrewer) + library(beeswarm) + library(vioplot) + source("MyVioplot.R") + library(beanplot) + library(readxl) + source("boxplot_stats_Function.R") + source("BoxPlotR_functions.R") - library(RColorBrewer) - library(beeswarm) - library(vioplot) - source("MyVioplot.R") - library(beanplot) - source("boxplot_stats_Function.R") - - observe({ - if (input$clearText_button == 0) return() - isolate({ updateTextInput(session, "myData", label = ",", value = "") }) - }) - # *** Read in data matrix *** - dataM <- reactive({ - if(input$dataInput==1){ - if(input$sampleData==1){ - data<-read.table("Boxplot_testData2.csv", sep=",", header=TRUE, fill=TRUE) - } else { - data<-read.table("Boxplot_testData.txt", sep=",", header=TRUE) - } - } else if(input$dataInput==2){ - inFile <- input$upload - # Avoid error message while file is not uploaded yet - if (is.null(input$upload)) {return(NULL)} - # Get the separator - mySep<-switch(input$fileSepDF, '1'=",",'2'="\t",'3'=";", '4'="") #list("Comma"=1,"Tab"=2,"Semicolon"=3) - if(file.info(inFile$datapath)$size<=10485800){ - data<-read.table(inFile$datapath, sep=mySep, header=TRUE, fill=TRUE) - } else print("File is bigger than 10MB and will not be uploaded.") - } else { # To be looked into again - for special case when last column has empty entries in some rows - if(is.null(input$myData)) {return(NULL)} - tmp<-matrix(strsplit(input$myData, "\n")[[1]]) - mySep<-switch(input$fileSepP, '1'=",",'2'="\t",'3'=";") - myColnames<-strsplit(tmp[1], mySep)[[1]] - data<-matrix(0, length(tmp)-1, length(myColnames)) - colnames(data)<-myColnames - for(i in 2:length(tmp)){ - myRow<-as.numeric(strsplit(paste(tmp[i],mySep,mySep,sep=""), mySep)[[1]]) - data[i-1,]<-myRow[-length(myRow)] - } - data<-data.frame(data) - } - return(data) - }) - - # *** The plot dimensions *** - heightSize <- reactive ({ input$myHeight }) - widthSize <- reactive ({ input$myWidth }) - - # *** Determine extent of whisker range *** - # whiskerDefinition 0 - Tukey (default), 1 - Spear (min/max, range=0), 2 - Altman (5% and 95% quantiles) - # radioButtons("whiskerType", "", list("Tukey"=0, "Spear"=1, "Altman"=2)), - myRange <- reactive({ - if(input$whiskerType==0){myRange<-c(-1.5)} - else if(input$whiskerType==1){myRange<-c(0)} - else if (input$whiskerType==2){myRange<-c(5)} - return(myRange) - }) - - # *** Get boxplot statistics *** - boxplotStats <- reactive({ - return(boxplot(dataM(), na.rm=TRUE, range=myRange(), plot=FALSE)) - }) - - # *** Generate the box plot *** - generateBoxPlot<-function(plotData){ - par(mar=c(5,8,4,2)) # c(bottom, left, top, right) - myColours<-gsub("\\s","", strsplit(input$myColours,",")[[1]]) - myColours<-gsub("0x","#", myColours) - - myColours2<-gsub("\\s","", strsplit(input$myOtherPlotColours,",")[[1]]) - myColours2<-gsub("0x","#", myColours2) - - - nrOfSamples<-ncol(plotData) - # generate colour vector - if(length(myColours)==1){ - myColours<-rep(myColours, nrOfSamples) - } else if(length(myColours) < nrOfSamples){ - myColours<-rep(myColours,times=(round(nrOfSamples/length(myColours)))+1) - } - plotPoints<-c() # vector for indices of samples that are to be plotted as points, not as boxplots - notPlotPoints <- seq(1:nrOfSamples) # samples to plot as boxes/violins/beans - plotDataM<-plotData - # Determine plot range - if(as.numeric(input$myOrientation)==0){ - if(input$ylimit==""){myLim<-range(plotData,na.rm=TRUE)+c(-1,+1)} else {myLim<-as.numeric(strsplit(input$ylimit,",")[[1]])} - } else { - if(input$xlimit==""){myLim<-range(plotData,na.rm=TRUE)+c(-1,+1)} else {myLim<-as.numeric(strsplit(input$xlimit,",")[[1]])} - } - # Data point count for each sample - datapointCounts<-apply(!apply(plotData, 2, is.na),2,sum) # Count number of valid data points for each sample - # Check if columns with few data points should be plotted as points - - # minimum number of points is 4 -> check that nrOfDataPoints is larger than that - mnp<-max(4,input$nrOfDataPoints) - - if(input$plotDataPoints==TRUE){ - #toPlot <- seq(1:ncol(plotData))[datapointCounts>=input$nrOfDataPoints] # samples to barplot - plotPoints <- seq(1:nrOfSamples)[datapointCounts=mnp] # samples to plot as boxes/violins/beans - } - - # Generate plotDataM matrix such that columns that should be plotted as points are filled with data points outside of visible plot area to 'reserve' spot for points - for(i in plotPoints){ - plotDataM[,i]<-c(rep(myLim[2]+10, nrow(plotData)-1),myLim[2]+20) - } - - # Angle the sample names - if(input$xaxisLabelAngle){ - xaxisLabelAngleNr<-45 - labelPos<-2 - } else { - xaxisLabelAngleNr<-0 - labelPos<-1 - } - - par(mar=c(12.1, 11.1, 4.1, 2.1)) - - # *** 1) Vertical boxplots *** - par(las=1) - if(as.numeric(input$myOrientation)==0){ - # *** Generate boxplot *** - if(input$plotType=='0'){ - boxplot(plotDataM, col=myColours, ylab=input$myYlab, xlab=input$myXlab, ylim=myLim, - cex.lab=input$cexAxislabel/10, cex.axis=input$cexAxis/10, cex.main=input$cexTitle/10, - main=input$myTitle, sub=input$mySubtitle, horizontal=as.numeric(input$myOrientation), frame=F, - na.rm=TRUE, xaxt="n", range=myRange(), varwidth=input$myVarwidth, notch=input$myNotch) #notch=TRUE - axis(1,at=c(1:nrOfSamples), labels=FALSE, cex.axis=input$cexAxis/10) # - text(x=c(1:nrOfSamples), y=rep(myLim[1]-3,nrOfSamples), labels=colnames(plotData), - pos=labelPos, xpd=TRUE, srt=xaxisLabelAngleNr, cex=input$cexAxis/10) - # * Add data points to plot if selected * - if(input$showDataPoints==TRUE){ - if(length(plotPoints)==0){ # all samples are box plots --> add points for all of them - if(input$datapointType==0){ - for(i in c(1:nrOfSamples)){ points(rep(i, nrow(plotData)), plotData[,i], col="black") } - } else { beeswarm(plotData, add=TRUE) } - } else { # remove the ones that are already plotted as points - if(input$datapointType==0){ - for(i in c(1:nrOfSamples)[-plotPoints]){ points(rep(i, nrow(plotData)), plotData[,i], col="black") } - } else { beeswarm(plotData, add=TRUE) } -# } else { beeswarm(plotData[,-plotPoints], at=c(1:nrOfSamples)[-plotPoints], add=TRUE) } - } - } - } else { # *** Generate violin or bean plot *** - if(input$otherPlotType==0){ # Violin plot - vioplot(as.list(data.frame(plotDataM)), col=myColours2, ylim=myLim, cex.axis=input$cexAxis/10, - horizontal=as.numeric(input$myOrientation), range=myRange(), border=input$violinBorder) - title(main=input$myTitle, ylab=input$myYlab, xlab=input$myXlab, cex.main=input$cexTitle/10, cex.lab=input$cexAxislabel/10) -# axis(1,at=c(1:nrOfSamples), labels=colnames(plotData), cex.axis=input$cexAxis/10, sub=input$mySubtitle) - axis(1,at=c(1:nrOfSamples), labels=FALSE, cex.axis=input$cexAxis/10) # - text(x=c(1:nrOfSamples), y=rep(myLim[1]-3,nrOfSamples), labels=colnames(plotData), - pos=labelPos, xpd=TRUE, srt=xaxisLabelAngleNr, cex=input$cexAxis/10) - - } else { - beanplot(data.frame(plotDataM[,notPlotPoints]), at=notPlotPoints, ylim=myLim, - horizontal=as.numeric(input$myOrientation), xlim=c(0.5, ncol(plotDataM)+0.5), - col=myColours2, border=input$beanBorder) - title(main=input$myTitle, ylab=input$myYlab, xlab=input$myXlab, cex.main=input$cexTitle/10, cex.lab=input$cexAxislabel/10) - # axis(1,at=c(1:nrOfSamples), labels=colnames(plotData), cex.axis=input$cexAxis/10) - axis(1,at=c(1:nrOfSamples), labels=FALSE, cex.axis=input$cexAxis/10) # -# text(x=c(1:nrOfSamples), y=rep(myLim[1]-3,nrOfSamples), labels=colnames(plotData), -# pos=labelPos, xpd=TRUE, srt=xaxisLabelAngleNr, cex=input$cexAxis/10) - } - } - # * Add points for samples with less then mnp data points * - # replace "white" with "black" otherwise data points will not be visible - for(i in plotPoints){ - if(input$datapointType==0 | input$plotType==1 | (input$datapointType==1 & input$showDataPoints==FALSE)){ - if(myColours[i]!="white"){ - points(rep(i, nrow(plotData)), plotData[,i], col=myColours[i]) - } else { - points(rep(i, nrow(plotData)), plotData[,i], col="black") - } - } - } - if(input$showNrOfPoints==TRUE){text(x=1:ncol(dataM()), y=myLim[1], labels=boxplotStats()$n)} - # Add mean and CIs for mean - if(input$addMeans==TRUE & input$plotType=='0'){ - boxplotMeans<-apply(dataM(), 2, mean, na.rm=TRUE) - points(x=1:ncol(dataM()), y=boxplotMeans, pch="+", cex=2) - if(input$addMeanCI==TRUE){ - # Calculate the error using the quartile function * Standard error; SE=sd/sqrt(n) - myQuartile<-1-((1-(as.numeric(input$meanCI)/100))/2) - myError<-qt(myQuartile, df=(boxplotStats()$n)-1)*(apply(dataM(), 2, sd, na.rm=TRUE)/sapply(boxplotStats()$n, sqrt)) - for(ii in 1:ncol(dataM())) { -# lines(y=c(ii,ii), x=c(boxplotMeans[ii]-myError[ii], boxplotMeans[ii]+myError[ii]), col="red") - rect(ii-0.05, boxplotMeans[ii]-myError[ii], ii+0.05, boxplotMeans[ii]+myError[ii], col="darkgrey", border="darkgrey") - } - points(x=1:ncol(dataM()), y=boxplotMeans, pch="+", cex=2) - } - } - - - # *** 2) Horizontal boxplots *** - } else { - if(input$plotType=='0'){ - boxplot(plotDataM, col=myColours, ylab=input$myYlab, xlab=input$myXlab, las=1, ylim=myLim, - cex.lab=input$cexAxislabel/10, cex.axis=input$cexAxis/10, cex.main=input$cexTitle/10, - main=input$myTitle, sub=input$mySubtitle, horizontal=as.numeric(input$myOrientation), frame=F, - na.rm=TRUE, yaxt="n", range=myRange(), varwidth=input$myVarwidth, notch=input$myNotch) #notch=TRUE - axis(2,at=c(1:nrOfSamples), labels=colnames(plotData), cex.axis=input$cexAxis/10) - # Add data points if option has been selected - if(input$showDataPoints==TRUE){ - if(length(plotPoints)==0){ # all samples are boxplots --> add points for all of them - if(input$datapointType==0){ - for(i in c(1:nrOfSamples)){ points(plotData[,i], rep(i, nrow(plotData)), col="black") } - } else { beeswarm(plotData, add=TRUE, horizontal=TRUE) } - } else { # remove the ones that are already plotted as points - if(input$datapointType==0){ - for(i in c(1:nrOfSamples)[-plotPoints]){ points(plotData[,i], rep(i, nrow(plotData)), col="black") } - } else { beeswarm(plotData, add=TRUE, horizontal=TRUE) } - } - } - } else { - if(input$otherPlotType==0){ # Violin plot - vioplot(as.list(data.frame(plotDataM)), col=myColours2[1], ylim=myLim, cex.axis=input$cexAxis/10, - horizontal=as.numeric(input$myOrientation), range=myRange(), border=input$violinBorder) - title(main=input$myTitle, ylab=input$myYlab, xlab=input$myXlab, cex.main=input$cexTitle/10, cex.lab=input$cexAxislabel/10) - axis(2,at=c(1:nrOfSamples), labels=colnames(plotData), cex.axis=input$cexAxis/10) - - } else { # Bean plot - beanplot(data.frame(plotDataM[,notPlotPoints]), at=notPlotPoints, ylim=myLim, - horizontal=as.numeric(input$myOrientation), xlim=c(0.5, ncol(plotDataM)+0.5), - col=myColours2, border=input$beanBorder) - title(main=input$myTitle, ylab=input$myYlab, xlab=input$myXlab, cex.main=input$cexTitle/10, cex.lab=input$cexAxislabel/10) - axis(2,at=c(1:nrOfSamples), labels=FALSE, cex.axis=input$cexAxis/10) # labels=colnames(plotData) - } - } - - # if there are columns with less than x data points, then add the points - for(i in plotPoints){ - if(input$datapointType==0){ - if(myColours[i]!="white"){ - points(plotData[,i], rep(i, nrow(plotData)), col=myColours[i]) - } else { - points(plotData[,i], rep(i, nrow(plotData)), col="white") - } - } - } - if(input$showNrOfPoints==TRUE){text(y=1:ncol(dataM()), x=myLim[1], labels=boxplotStats()$n)} - # Add mean and CIs for mean - if(input$addMeans==TRUE & input$plotType=='0'){ - boxplotMeans<-apply(dataM(), 2, mean, na.rm=TRUE) - points(y=1:ncol(dataM()), x=boxplotMeans, pch="+", cex=2) - if(input$addMeanCI==TRUE){ - # Calculate the error using the quartile function * Standard error; SE=sd/sqrt(n) - myQuartile<-1-((1-(as.numeric(input$meanCI)/100))/2) - myError<-qt(myQuartile, df=(boxplotStats()$n)-1)*(apply(dataM(), 2, sd, na.rm=TRUE)/sapply(boxplotStats()$n, sqrt)) - for(ii in 1:ncol(dataM())) { -# lines(y=c(ii,ii), x=c(boxplotMeans[ii]-myError[ii], boxplotMeans[ii]+myError[ii]), col="red") - rect(boxplotMeans[ii]-myError[ii], ii-0.05, boxplotMeans[ii]+myError[ii], ii+0.05, col="darkgrey", border="darkgrey") - } - points(y=1:ncol(dataM()), x=boxplotMeans, pch="+", cex=2) - } - } - - } - # Add grid based on option selected - if(input$addGrid==0){} - else if(input$addGrid==1){grid()} - else if (input$addGrid==2){grid(ny=NA)} - else if (input$addGrid==3){grid(NA, ny=NULL)} - } - - ## *** Data in table *** - output$filetable <- renderTable({ - print(nrow(dataM())) - if(nrow(dataM())<500){ - return(dataM()) - } else {return(dataM()[1:100,])} - }) - - # *** Boxplot (using 'generateBoxPlot'-function) *** - output$boxPlot <- renderPlot({ - print(class(dataM())) - generateBoxPlot(dataM()) - }, height = heightSize, width = widthSize) - - ## *** Download EPS file *** - output$downloadPlotEPS <- downloadHandler( - filename <- function() { paste('Boxplot.eps') }, - content <- function(file) { - postscript(file, horizontal = FALSE, onefile = FALSE, paper = "special", width = input$myWidth/72, height = input$myHeight/72) - ## --------------- - generateBoxPlot(dataM()) - ## --------------- - dev.off() - }, - contentType = 'application/postscript' - ) - ## *** Download PDF file *** - output$downloadPlotPDF <- downloadHandler( - filename <- function() { paste('Boxplot.pdf') }, - content <- function(file) { - pdf(file, width = input$myWidth/72, height = input$myHeight/72) - ## --------------- - generateBoxPlot(dataM()) - ## --------------- - dev.off() - }, - contentType = 'application/pdf' # MIME type of the image - ) - ## *** Download SVG file *** - output$downloadPlotSVG <- downloadHandler( - filename <- function() { paste('Boxplot.svg') }, - content <- function(file) { - svg(file, width = input$myWidth/72, height = input$myHeight/72) - ## --------------- - generateBoxPlot(dataM()) - ## --------------- - dev.off() - }, - contentType = 'image/svg' - ) - - # *** Output boxplot statistics in table below plot *** - output$boxplotStatsTable <- renderTable({ - if(input$addMeans){ - M<-rbind(boxplotStats()$stats[c(5,4,3,2,1),],boxplotStats()$n) - M<-rbind(M, apply(dataM(), 2, mean, na.rm=TRUE)) - rownames(M)<-c("Upper whisker","3rd quartile","Median","1st quartile","Lower whisker", "Nr. of data points", "Mean") - colnames(M)<-colnames(dataM()) - } else { - M<-rbind(boxplotStats()$stats[c(5,4,3,2,1),],boxplotStats()$n) - rownames(M)<-c("Upper whisker","3rd quartile","Median","1st quartile","Lower whisker", "Nr. of data points") - colnames(M)<-colnames(dataM()) - } - M - }) - - # *** Print figure legend *** - output$FigureLegend <- renderPrint({ - # Center lines show the medians; box limits indicate the 25th and 75th percentiles as determined by R software; whiskers extend to minimum and maximum values; crosses represent means; bars indicate 95% confidence intervals. n = 100, 76, 16, 76, 41 sample points. - # Generate vector with pieces of the legend based on user selections - FL<-vector() - # Figure legend for boxplot - if(input$plotType=='0'){ - FL<-c("Center lines show the medians; box limits indicate the 25th and 75th percentiles as determined by R software") - # one of these three, depending on whisker definition choice: - # - Spear: "; whiskers extend to minimum and maximum values." - # - Tukey: "; whiskers extend 1.5 times the interquartile range from the 25th and 75th percentiles; outliers are represented by dots." - # - Altman: " and whiskers the 5th and 95th percentiles; outliers are represented by dots." - if(input$whiskerType==0){ - FL<-append(FL, paste("; whiskers extend 1.5 times the interquartile range from the 25th and 75th percentiles, outliers are represented by dots", sep="")) - } else if(input$whiskerType==1){ - FL<-append(FL, "; whiskers extend to minimum and maximum values") - } else { - FL<-append(FL, paste("; whiskers extend to 5th and 95th percentiles, outliers are represented by dots", sep="")) - } - # Means are added as crosses - if(input$addMeans & input$plotType=='0'){ FL<-append(FL, c("; crosses represent sample means")) } - # Confidence intervals of means are displayed as grey bars - if(input$addMeans & input$addMeanCI & input$plotType=='0'){ FL<-append(FL, paste("; bars indicate ", input$meanCI,"% confidence intervals of the means", sep="")) } - # Variable width of boxplots - if(input$myVarwidth){ FL<-append(FL, c("; width of the boxes is proportional to the square root of the sample size")) } - # Points are plotted on top of boxplots - if(input$showDataPoints){ FL<-append(FL, c("; data points are plotted as open circles")) } - # Sample size - sampleSizes<-boxplotStats()$n - if(length(unique(sampleSizes))==1){ FL<-append(FL, paste(". n = ", sampleSizes[1], " sample points", sep="")) } - else { FL<-append(FL, paste(". n = ",paste(sampleSizes, collapse=", "), " sample points", sep="")) } - FL<-append(FL, ".") - } else { - # radioButtons("otherPlotType", "", list("Violin plot"=0, "Bean plot"=1)), - if (input$otherPlotType=='0'){ # Violin plot - FL<-c("White circles show the medians; - box limits indicate the 25th and 75th percentiles as determined by R software; - whiskers extend 1.5 times the interquartile range from the 25th and 75th percentiles; - polygons represent density estimates of data and extend to extreme values.") - } else if (input$otherPlotType=='1') { # Bean plot - FL<-c("Black lines show the medians; - white lines represent individual data points; - polygons represent the estimated density of the data.") - #if(input$beanplotOverall){FL<-append(FL, c("dotted line represents overall "))} - } - } # END: other plot types - cat(paste(FL, collapse="")) - #- I am not sure what to put for the notches because we don't add '*'s to the box plots. - }) - - # *** Download boxplot data in csv format *** - output$downloadBoxplotData <- downloadHandler( - filename = function() { "BoxplotData.csv" }, - content = function(file) { - write.csv(dataM(), file, row.names=FALSE) - }) ### + observe({ + if (input$clearText_button == 0) { + return() + } + isolate({ + updateTextInput(session, "myData", label = ",", value = "") + }) + }) -}) + # *** Preset Style Guides Observer *** + observeEvent(input$styleGuide, { + if (input$styleGuide == "none") { + return() + } + + # 1. Nature Journal + if (input$styleGuide == "nature") { + updateTextInput(session, "myColours", value = "light grey, white") + updateTextInput(session, "myOtherPlotColours", value = "light grey, white") + updateRadioButtons(session, "addGrid", selected = "0") + updateCheckboxInput(session, "fontSizes", value = TRUE) + updateNumericInput(session, "cexTitle", value = 14) + updateNumericInput(session, "cexAxislabel", value = 12) + updateNumericInput(session, "cexAxis", value = 10) + updateTextInput(session, "violinBorder", value = "grey") + updateTextInput(session, "beanBorder", value = "grey") + updateTextInput(session, "pointColors", value = "black") + } + # 2. Science Journal + else if (input$styleGuide == "science") { + updateTextInput(session, "myColours", value = "#0A2540, #FF6B6B, #4D96FF, #6BCB77, #F9D976") + updateTextInput(session, "myOtherPlotColours", value = "#0A2540, #FF6B6B, #4D96FF") + updateRadioButtons(session, "addGrid", selected = "0") + updateCheckboxInput(session, "fontSizes", value = TRUE) + updateNumericInput(session, "cexTitle", value = 14) + updateNumericInput(session, "cexAxislabel", value = 12) + updateNumericInput(session, "cexAxis", value = 10) + updateTextInput(session, "violinBorder", value = "black") + updateTextInput(session, "beanBorder", value = "black") + updateTextInput(session, "pointColors", value = "black") + } + # 3. The Economist + else if (input$styleGuide == "economist") { + updateTextInput(session, "myColours", value = "#005A9C, #7D7D7D, #E50011, #FFD100, #00A4E4") + updateTextInput(session, "myOtherPlotColours", value = "#005A9C, #7D7D7D, #E50011") + updateRadioButtons(session, "addGrid", selected = "3") # Y only + updateCheckboxInput(session, "fontSizes", value = TRUE) + updateNumericInput(session, "cexTitle", value = 16) + updateNumericInput(session, "cexAxislabel", value = 12) + updateNumericInput(session, "cexAxis", value = 11) + updateTextInput(session, "violinBorder", value = "white") + updateTextInput(session, "beanBorder", value = "white") + updateTextInput(session, "pointColors", value = "#E50011") + } + # 4. Financial Times + else if (input$styleGuide == "ft") { + updateTextInput(session, "myColours", value = "#0F5499, #990F3D, #3F3F3F, #D9A752, #5C88BF") + updateTextInput(session, "myOtherPlotColours", value = "#0F5499, #990F3D, #3F3F3F") + updateRadioButtons(session, "addGrid", selected = "3") # Y only + updateCheckboxInput(session, "fontSizes", value = TRUE) + updateNumericInput(session, "cexTitle", value = 16) + updateNumericInput(session, "cexAxislabel", value = 12) + updateNumericInput(session, "cexAxis", value = 11) + updateTextInput(session, "violinBorder", value = "#1e293b") + updateTextInput(session, "beanBorder", value = "#1e293b") + updateTextInput(session, "pointColors", value = "#990F3D") + } + }) + + # *** Read in data matrix *** + data_m <- reactive({ + if (input$dataInput == 1) { + if (input$sampleData == 1) { + data <- sample_data_1_cache + } else if (input$sampleData == 2) { + data <- sample_data_2_cache + } else { + data <- sample_data_3_cache + } + } else if (input$dataInput == 2) { + in_file <- input$upload + # Avoid error message while file is not uploaded yet + if (is.null(input$upload)) { + return(NULL) + } + # Get the separator and extension + ext <- tolower(tools::file_ext(in_file$name)) + + if (ext %in% c("xls", "xlsx")) { + data <- as.data.frame(readxl::read_excel(in_file$datapath)) + } else { + my_sep <- switch(input$fileSepDF, + "1" = ",", + "2" = "\t", + "3" = ";", + "4" = "" + ) + data <- read.table( + in_file$datapath, + sep = my_sep, header = TRUE, fill = TRUE, + check.names = FALSE + ) + } + } else { + # For special case when last column has empty entries in some rows + if (is.null(input$myData) || input$myData == "") { + return(NULL) + } + my_sep <- switch(input$fileSepP, + "1" = ",", + "2" = "\t", + "3" = ";" + ) + data <- read.table( + text = input$myData, sep = my_sep, header = TRUE, fill = TRUE, + check.names = FALSE + ) + } + return(data) + }) + + # *** The plot dimensions *** + height_size <- reactive({ + input$myHeight + }) + width_size <- reactive({ + input$myWidth + }) + + # *** Determine extent of whisker range *** + # whiskerDefinition 0 - Tukey (default), 1 - Spear (min/max, range=0), + # 2 - Altman (5% and 95% quantiles) + my_range <- reactive({ + if (input$whiskerType == 0) { + my_range <- c(-1.5) + } else if (input$whiskerType == 1) { + my_range <- c(0) + } else if (input$whiskerType == 2) { + my_range <- c(5) + } + return(my_range) + }) + + # *** Get boxplot statistics *** + boxplot_stats <- reactive({ + if (is.null(data_m())) { + return(NULL) + } + return(boxplot(data_m(), na.rm = TRUE, range = my_range(), plot = FALSE)) + }) + + # *** Helper function for stats table *** + get_stats_matrix <- function(data, stats, add_means) { + stats_matrix <- rbind( + as.matrix(stats$stats[c(5, 4, 3, 2, 1), ]), + stats$n + ) + + if (add_means) { + stats_matrix <- rbind(stats_matrix, colMeans(data, na.rm = TRUE)) + rownames(stats_matrix) <- c( + "Upper whisker", "3rd quartile", "Median", "1st quartile", + "Lower whisker", "Nr. of data points", "Mean" + ) + } else { + rownames(stats_matrix) <- c( + "Upper whisker", "3rd quartile", "Median", "1st quartile", + "Lower whisker", "Nr. of data points" + ) + } + colnames(stats_matrix) <- colnames(data) + return(stats_matrix) + } + + # *** Helper function for figure legend *** + generate_figure_legend <- function(stats, plot_type, other_plot_type, + whisker_type, add_means, add_mean_ci, + mean_ci_val, my_varwidth, + bean_plot_center_type) { + fl <- "Center lines show the medians; " + + if (plot_type == "0") { # Boxplot + fl <- paste0( + fl, + "box limits indicate the 25th and 75th percentiles ", + "as determined by R software" + ) + + if (whisker_type == 0) { + fl <- paste0( + fl, + "; whiskers extend 1.5 times the interquartile range ", + "from the 25th and 75th percentiles, outliers are ", + "represented by dots" + ) + } else if (whisker_type == 1) { + fl <- paste0(fl, "; whiskers extend to minimum and maximum values") + } else { + fl <- paste0( + fl, + "; whiskers extend to 5th and 95th percentiles, ", + "outliers are represented by dots" + ) + } + + if (add_means) { + fl <- paste0(fl, "; crosses represent sample means") + if (add_mean_ci) { + fl <- paste0( + fl, "; bars indicate ", mean_ci_val, + "% confidence intervals of the means" + ) + } + } + + if (my_varwidth) { + fl <- paste0( + fl, "; width of the boxes is proportional to the square root ", + "of the sample size" + ) + } + } else { + if (other_plot_type == "0") { # Violin plot + fl <- paste0( + "White circles show the medians; box limits indicate the 25th ", + "and 75th percentiles; whiskers extend 1.5 times the interquartile ", + "range; polygons represent density estimates." + ) + } else { # Bean plot + center_label <- if (bean_plot_center_type == 0) "median" else "mean" + fl <- paste0( + "Black lines show the ", center_label, + "s; white lines represent individual data points; ", + "polygons represent density estimates." + ) + } + } + + fl <- paste0( + fl, ". n = ", + paste(stats$n, collapse = ", "), + " sample points." + ) + return(fl) + } + + # *** Generate the box plot *** + generate_box_plot <- function(plot_data) { + # Safe input resolvers to prevent "argument is of length zero" or NULL crashes during reactive updates + plot_engine <- if (is.null(input$plotEngine) || length(input$plotEngine) == 0) "classic" else input$plotEngine + plot_type <- if (is.null(input$plotType) || length(input$plotType) == 0) "0" else input$plotType + other_plot_type <- if (is.null(input$otherPlotType) || length(input$otherPlotType) == 0) "0" else input$otherPlotType + bean_plot_median_mean <- if (is.null(input$beanPlotMedianMean) || length(input$beanPlotMedianMean) == 0) 0 else as.numeric(input$beanPlotMedianMean) + my_varwidth <- if (is.null(input$myVarwidth) || length(input$myVarwidth) == 0) FALSE else (input$myVarwidth == TRUE) + my_notch <- if (is.null(input$myNotch) || length(input$myNotch) == 0) FALSE else (input$myNotch == TRUE) + show_data_points <- if (is.null(input$showDataPoints) || length(input$showDataPoints) == 0) FALSE else (input$showDataPoints == TRUE) + datapoint_type <- if (is.null(input$datapointType) || length(input$datapointType) == 0) 0 else as.numeric(input$datapointType) + add_means <- if (is.null(input$addMeans) || length(input$addMeans) == 0) FALSE else (input$addMeans == TRUE) + add_mean_ci <- if (is.null(input$addMeanCI) || length(input$addMeanCI) == 0) FALSE else (input$addMeanCI == TRUE) + mean_ci <- if (is.null(input$meanCI) || length(input$meanCI) == 0) 95 else as.numeric(input$meanCI) + log_scale <- if (is.null(input$logScale) || length(input$logScale) == 0) FALSE else (input$logScale == TRUE) + my_orientation <- if (is.null(input$myOrientation) || length(input$myOrientation) == 0) FALSE else (input$myOrientation == 1) + add_grid <- if (is.null(input$addGrid) || length(input$addGrid) == 0) 0 else as.numeric(input$addGrid) + show_nr_of_points <- if (is.null(input$showNrOfPoints) || length(input$showNrOfPoints) == 0) FALSE else (input$showNrOfPoints == TRUE) + style_guide <- if (is.null(input$styleGuide) || length(input$styleGuide) == 0) "none" else input$styleGuide + plot_data_points <- if (is.null(input$plotDataPoints) || length(input$plotDataPoints) == 0) FALSE else (input$plotDataPoints == TRUE) + nr_of_data_points <- if (is.null(input$nrOfDataPoints) || length(input$nrOfDataPoints) == 0) 5 else as.numeric(input$nrOfDataPoints) + xaxis_label_angle <- if (is.null(input$xaxisLabelAngle) || length(input$xaxisLabelAngle) == 0) FALSE else (input$xaxisLabelAngle == TRUE) + + cex_title <- if (is.null(input$cexTitle) || length(input$cexTitle) == 0) 14 else as.numeric(input$cexTitle) + cex_axislabel <- if (is.null(input$cexAxislabel) || length(input$cexAxislabel) == 0) 14 else as.numeric(input$cexAxislabel) + cex_axis <- if (is.null(input$cexAxis) || length(input$cexAxis) == 0) 12 else as.numeric(input$cexAxis) + + my_title <- if (is.null(input$myTitle) || length(input$myTitle) == 0) "" else input$myTitle + my_subtitle <- if (is.null(input$mySubtitle) || length(input$mySubtitle) == 0) "" else input$mySubtitle + my_xlab <- if (is.null(input$myXlab) || length(input$myXlab) == 0) "" else input$myXlab + my_ylab <- if (is.null(input$myYlab) || length(input$myYlab) == 0) "" else input$myYlab + + ylimit_val <- if (is.null(input$ylimit) || length(input$ylimit) == 0) "" else input$ylimit + xlimit_val <- if (is.null(input$xlimit) || length(input$xlimit) == 0) "" else input$xlimit + + my_colours_val <- if (is.null(input$myColours) || length(input$myColours) == 0) "light grey, white" else input$myColours + my_other_colours_val <- if (is.null(input$myOtherPlotColours) || length(input$myOtherPlotColours) == 0) "light grey, white" else input$myOtherPlotColours + point_colors_val <- if (is.null(input$pointColors) || length(input$pointColors) == 0) "black" else input$pointColors + + violin_border <- if (is.null(input$violinBorder) || length(input$violinBorder) == 0) "grey" else input$violinBorder + bean_border <- if (is.null(input$beanBorder) || length(input$beanBorder) == 0) "grey" else input$beanBorder + + point_transparency <- if (is.null(input$pointTransparency) || length(input$pointTransparency) == 0) 50 else as.numeric(input$pointTransparency) + point_size <- if (is.null(input$pointSize) || length(input$pointSize) == 0) 10 else as.numeric(input$pointSize) + + if (plot_engine == "ggplot") { + library(ggplot2) + + # Convert plot_data to long format + df_long <- data.frame( + Value = unlist(plot_data, use.names = FALSE), + Group = rep(colnames(plot_data), each = nrow(plot_data)) + ) + df_long <- na.omit(df_long) + + # Make sure Group is a factor with original order + df_long$Group <- factor(df_long$Group, levels = colnames(plot_data)) + + # Parse colours + my_colours <- parse_colours(my_colours_val) + my_colours_2 <- parse_colours(my_other_colours_val) + point_colors <- parse_colours(point_colors_val) + + nr_of_samples <- ncol(plot_data) + # Always recycle color vectors to match exact number of samples so ggplot manual scale never errors + my_colours <- rep(my_colours, length.out = nr_of_samples) + my_colours_2 <- rep(my_colours_2, length.out = nr_of_samples) + point_colors <- rep(point_colors, length.out = nr_of_samples) + + plot_colours <- if (plot_type == "0") my_colours else my_colours_2 + + # Initialize ggplot and Plot Types + if (plot_type == "0") { # Boxplot + # Get natively calculated boxplot statistics matching the whiskerType (Tukey, Spear, Altman) + bp_stats <- boxplot_stats() + + notchlower_val <- bp_stats$conf[1, ] + notchupper_val <- bp_stats$conf[2, ] + if (log_scale) { + # Safely transform to log10 space since scale_y_log10 doesn't automatically transform custom aesthetics + notchlower_val <- log10(pmax(1e-10, notchlower_val)) + notchupper_val <- log10(pmax(1e-10, notchupper_val)) + } + + df_stats <- data.frame( + Group = factor(bp_stats$names, levels = colnames(plot_data)), + ymin = bp_stats$stats[1, ], + lower = bp_stats$stats[2, ], + middle = bp_stats$stats[3, ], + upper = bp_stats$stats[4, ], + ymax = bp_stats$stats[5, ], + notchlower = notchlower_val, + notchupper = notchupper_val, + fill = bp_stats$names + ) + + p <- ggplot(df_stats, aes(x = Group, fill = Group)) + + suppressWarnings(geom_boxplot( + aes( + ymin = ymin, lower = lower, middle = middle, upper = upper, ymax = ymax, + notchlower = notchlower, notchupper = notchupper + ), + stat = "identity", + varwidth = my_varwidth, + notch = my_notch, + width = 0.6 + )) + + # Identify outliers matching the calculated whiskers + df_outliers <- df_long + df_outliers$ymin <- df_stats$ymin[match(df_outliers$Group, df_stats$Group)] + df_outliers$ymax <- df_stats$ymax[match(df_outliers$Group, df_stats$Group)] + df_outliers <- df_outliers[df_outliers$Value < df_outliers$ymin | df_outliers$Value > df_outliers$ymax, ] + + # Overlay outliers if they are NOT already showing all points + if (!show_data_points && nrow(df_outliers) > 0) { + p <- p + geom_point( + data = df_outliers, + aes(x = Group, y = Value), + color = "black", + size = 1.5, + shape = 19, + inherit.aes = FALSE + ) + } + } else { + # Initialize ggplot for Violin/Bean plot + p <- ggplot(df_long, aes(x = Group, y = Value, fill = Group)) + + if (other_plot_type == "0") { # Violin + p <- p + geom_violin( + color = violin_border, + width = 0.8 + ) + } else { # Beanplot + p <- p + geom_violin( + color = bean_border, + width = 0.8, + alpha = 0.7 + ) + + # Median/Mean crossbar + center_fun <- if (bean_plot_median_mean == 0) "median" else "mean" + p <- p + stat_summary( + fun = center_fun, + geom = "crossbar", + width = 0.4, + color = "black", + middle.linewidth = 0.8 + ) + + # Add individual horizontal data line segments inside the bean density shape + p <- p + geom_segment( + aes( + x = as.numeric(Group) - 0.15, + xend = as.numeric(Group) + 0.15, + y = Value, + yend = Value + ), + color = "#1e293b", + linewidth = 0.4, + alpha = 0.4 + ) + } + } + + # Apply custom fill colors + p <- p + scale_fill_manual(values = plot_colours) + + # Data points overlay + if (show_data_points) { + pt_trans <- 1 - (point_transparency / 100) + pt_sz <- point_size / 10 + pt_col <- point_colors[1] + + # Specify data and mapping for Boxplot type since p uses df_stats as default + points_data <- if (plot_type == "0") df_long else NULL + points_aes <- if (plot_type == "0") aes(y = Value) else NULL + + if (datapoint_type == 1) { # Beeswarm / Minimal jitter + p <- p + geom_jitter( + data = points_data, + mapping = points_aes, + width = 0.05, height = 0, + color = pt_col, size = pt_sz, alpha = pt_trans + ) + } else if (datapoint_type == 2) { # Jittered + p <- p + geom_jitter( + data = points_data, + mapping = points_aes, + width = 0.2, height = 0, + color = pt_col, size = pt_sz, alpha = pt_trans + ) + } else { # Normal/Centered stripchart + p <- p + geom_point( + data = points_data, + mapping = points_aes, + position = position_nudge(x = 0), + color = pt_col, size = pt_sz, alpha = pt_trans + ) + } + } + + # Means and CIs for Boxplot + if (add_means && plot_type == "0") { + p <- p + stat_summary( + data = df_long, + aes(x = Group, y = Value), + fun = mean, + geom = "point", + shape = 18, + size = 4, + color = "red", + inherit.aes = FALSE + ) + + if (add_mean_ci) { + ci_fun <- function(x) { + n <- sum(!is.na(x)) + if (n <= 1) return(c(ymin = NA, ymax = NA)) + se <- sd(x, na.rm = TRUE) / sqrt(n) + ci_level <- mean_ci / 100 + t_val <- qt((1 + ci_level) / 2, df = n - 1) + me <- t_val * se + m <- mean(x, na.rm = TRUE) + c(ymin = m - me, ymax = m + me) + } + p <- p + stat_summary( + data = df_long, + aes(x = Group, y = Value), + fun.data = ci_fun, + geom = "errorbar", + width = 0.2, + color = "red", + linewidth = 0.8, + inherit.aes = FALSE + ) + } + } + + # Log Scale + if (log_scale) { + p <- p + scale_y_log10() + } + + # Labels & Font sizes + p <- p + labs( + title = my_title, + subtitle = my_subtitle, + x = my_xlab, + y = my_ylab + ) + + # Resolve Y limits + ymin <- NA + ymax <- NA + xmin <- NA + xmax <- NA + + if (ylimit_val != "" && !my_orientation) { + ymin <- as.numeric(gsub("\\s", "", strsplit(ylimit_val, ",")[[1]][1])) + ymax <- as.numeric(gsub("\\s", "", strsplit(ylimit_val, ",")[[1]][2])) + } + if (xlimit_val != "" && my_orientation) { + xmin <- as.numeric(gsub("\\s", "", strsplit(xlimit_val, ",")[[1]][1])) + xmax <- as.numeric(gsub("\\s", "", strsplit(xlimit_val, ",")[[1]][2])) + } + + lims <- if (!my_orientation && !is.na(ymin)) { + c(ymin, ymax) + } else if (my_orientation && !is.na(xmin)) { + c(xmin, xmax) + } else { + NULL + } + + if (my_orientation) { + p <- p + coord_flip(ylim = lims) + } else { + if (!is.null(lims)) { + p <- p + coord_cartesian(ylim = lims) + } + } + + # Resolve style guide defaults for ggplot + style_font <- "Inter" + bg_fill <- "white" + panel_bg_fill <- "white" + grid_color <- "#e2e8f0" + axis_line_color <- "#475569" + plot_title_hjust <- 0.5 + + if (style_guide == "nature") { + style_font <- "sans" + } else if (style_guide == "science") { + style_font <- "serif" + } else if (style_guide == "economist") { + style_font <- "sans" + bg_fill <- "#e4eef2" + panel_bg_fill <- "#e4eef2" + grid_color <- "white" + axis_line_color <- "#1e293b" + plot_title_hjust <- 0 + } else if (style_guide == "ft") { + style_font <- "serif" + bg_fill <- "#fff1e5" + panel_bg_fill <- "#fff1e5" + grid_color <- "#e2d6ca" + axis_line_color <- "#1e293b" + plot_title_hjust <- 0 + } + + # Theme + p <- p + theme_minimal(base_family = style_font) + + theme( + plot.title = element_text(size = cex_title * 1.5, face = "bold", hjust = plot_title_hjust), + plot.subtitle = element_text(size = cex_title * 1.1, hjust = plot_title_hjust, color = "#475569"), + axis.title.x = element_text(size = cex_axislabel * 1.2), + axis.title.y = element_text(size = cex_axislabel * 1.2), + axis.text = element_text(size = cex_axis * 1.1), + legend.position = "none", + panel.background = element_rect(fill = panel_bg_fill, color = NA), + plot.background = element_rect(fill = bg_fill, color = NA), + axis.line = element_line(color = axis_line_color, linewidth = 0.6), + axis.ticks = element_line(color = axis_line_color, linewidth = 0.6) + ) + + # Gridlines + if (add_grid == 0) { + p <- p + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + } else if (add_grid == 2) { # X only (perpendicular to X) + p <- p + theme(panel.grid.major.y = element_blank(), panel.grid.minor = element_blank(), panel.grid.major.x = element_line(color = grid_color)) + } else if (add_grid == 3) { # Y only (perpendicular to Y) + p <- p + theme(panel.grid.major.x = element_blank(), panel.grid.minor = element_blank(), panel.grid.major.y = element_line(color = grid_color)) + } else { + p <- p + theme( + panel.grid.major = element_line(color = grid_color), + panel.grid.minor = element_blank() + ) + } + + # Display N count text at top/right if requested + if (show_nr_of_points) { + # Calculate stats for the labels + nr_points <- sapply(plot_data, function(x) sum(!is.na(x))) + df_labels <- data.frame( + Group = factor(colnames(plot_data), levels = colnames(plot_data)), + y_pos = if (log_scale) { + 10^(log10(max(plot_data, na.rm = TRUE)) + 0.1) + } else { + max(plot_data, na.rm = TRUE) * 1.05 + }, + label = paste0("n=", nr_points) + ) + + # Overlay standard text labels + p <- p + geom_text( + data = df_labels, + aes(x = Group, y = y_pos, label = label), + inherit.aes = FALSE, + size = cex_axis * 0.35, + color = "#475569", + vjust = 0 + ) + } + + print(p) + return() + } + + # Resolve style guide defaults for Classic R + bg_fill <- "white" + style_font <- "" + + if (style_guide == "nature") { + style_font <- "sans" + } else if (style_guide == "science") { + style_font <- "serif" + } else if (style_guide == "economist") { + style_font <- "sans" + bg_fill <- "#e4eef2" + } else if (style_guide == "ft") { + style_font <- "serif" + bg_fill <- "#fff1e5" + } + + if (style_font != "") { + par(mar = c(5, 8, 4, 2), bg = bg_fill, family = style_font) + } else { + par(mar = c(5, 8, 4, 2), bg = bg_fill) + } + + nr_of_samples <- ncol(plot_data) + + plot_data_m <- plot_data + not_plot_points <- seq_len(nr_of_samples) + plot_points <- integer(0) + + if (plot_data_points) { + nr_needed <- nr_of_data_points + not_plot_points <- integer(0) + for (i in seq_len(nr_of_samples)) { + if (sum(!is.na(plot_data[[i]])) < nr_needed) { + plot_data_m[[i]] <- NA + plot_points <- c(plot_points, i) + } else { + not_plot_points <- c(not_plot_points, i) + } + } + } + my_colours <- parse_colours(my_colours_val) + my_colours_2 <- parse_colours(my_other_colours_val) + point_colors <- parse_colours(point_colors_val) + # Replicate colors if only one is provided + if (length(my_colours) == 1) { + my_colours <- rep(my_colours, nr_of_samples) + } + if (length(my_colours_2) == 1) { + my_colours_2 <- rep(my_colours_2, nr_of_samples) + } + if (length(point_colors) == 1) { + point_colors <- rep(point_colors, nr_of_samples) + } + point_t <- 1 - (point_transparency / 100) + point_c <- NA + if (point_t < 1) { + point_c <- rgb( + t(col2rgb(point_colors)), + alpha = 255 * point_t, + maxColorValue = 255 + ) + } else { + point_c <- point_colors + } + my_log <- "" + xmin <- NA + xmax <- NA + ymin <- NA + ymax <- NA + + if (log_scale) { + my_log <- if (my_orientation) "x" else "y" + } + + if (ylimit_val != "" && !my_orientation) { + ymin <- as.numeric(gsub("\\s", "", strsplit(ylimit_val, ",")[[1]][1])) + ymax <- as.numeric(gsub("\\s", "", strsplit(ylimit_val, ",")[[1]][2])) + } + if (xlimit_val != "" && my_orientation) { + xmin <- as.numeric(gsub("\\s", "", strsplit(xlimit_val, ",")[[1]][1])) + xmax <- as.numeric(gsub("\\s", "", strsplit(xlimit_val, ",")[[1]][2])) + } + + # Calculate a shared default range for consistent axes across plot types + shared_lim <- if (all(is.na(plot_data))) { + NULL + } else { + r <- range(plot_data, na.rm = TRUE) + if (show_nr_of_points) { + if (log_scale && length(r[r > 0]) > 0) { + # Log scale requires multiplicative expansion to prevent negatives + c(r[1], r[2] * (10^(diff(log10(r[r > 0])) * 0.15))) + } else { + # Expand top geometrically to make space for data counts + padding <- diff(r) * 0.15 + c(r[1] - (diff(r) * 0.04), r[2] + padding) + } + } else { + r + } + } + + vals_lim <- if (!my_orientation && ylimit_val != "") { + c(ymin, ymax) + } else if (my_orientation && xlimit_val != "") { + c(xmin, xmax) + } else { + shared_lim + } + + par(las = if (xaxis_label_angle) 2 else 1) + + if (plot_type == "0") { # Boxplot + boxplot( + plot_data_m, + main = my_title, + sub = my_subtitle, + xlab = my_xlab, + ylab = my_ylab, + col = my_colours, + horizontal = my_orientation, + varwidth = my_varwidth, + notch = my_notch, + outline = !show_data_points, + range = my_range(), + log = my_log, + ylim = vals_lim, + las = if (xaxis_label_angle) 2 else 1, + frame.plot = FALSE, + # Font sizes + cex.main = cex_title / 10, + cex.lab = cex_axislabel / 10, + cex.axis = cex_axis / 10 + ) + } else { + if (other_plot_type == "0") { # Violin plot + if (length(not_plot_points) > 0) { + vioplot( + as.list(data.frame(plot_data_m)), + col = my_colours_2, + horizontal = my_orientation, + border = violin_border, + cex.axis = cex_axis / 10, + ylim = vals_lim, + names = colnames(plot_data_m), + log = my_log + ) + } else { + plot( + 1, + type = "n", axes = FALSE, xlab = "", ylab = "", + xlim = if (my_orientation) { + shared_lim + } else { + c(0.5, nr_of_samples + 0.5) + }, + ylim = if (!my_orientation) { + shared_lim + } else { + c(0.5, nr_of_samples + 0.5) + } + ) + axis(if (my_orientation) 1 else 2, cex.axis = cex_axis / 10) + axis( + if (my_orientation) 2 else 1, + at = seq_len(nr_of_samples), + labels = colnames(plot_data), + cex.axis = cex_axis / 10 + ) + } + title( + main = my_title, + sub = my_subtitle, + xlab = my_xlab, + ylab = my_ylab, + cex.main = cex_title / 10, + cex.lab = cex_axislabel / 10 + ) + } else { # Bean plot + my_beanplot_center <- if (bean_plot_median_mean == 0) { + "median" + } else { + "mean" + } + if (length(not_plot_points) > 0) { + beanplot( + data.frame(plot_data_m[, not_plot_points, drop = FALSE]), + at = not_plot_points, + xlim = c(0.5, nr_of_samples + 0.5), + ylim = vals_lim, + col = if (length(my_colours_2) > 1) { + as.list(my_colours_2) + } else { + my_colours_2 + }, + horizontal = my_orientation, + border = bean_border, + what = c(1, 1, 1, as.logical(bean_plot_median_mean)), + cex.axis = cex_axis / 10, + overallline = my_beanplot_center, + names = colnames(plot_data)[not_plot_points], + frame.plot = FALSE, + log = my_log + ) + axis( + if (my_orientation) 2 else 1, + at = seq_len(nr_of_samples), + labels = colnames(plot_data), + cex.axis = cex_axis / 10 + ) + } else { + plot( + 1, + type = "n", axes = FALSE, xlab = "", ylab = "", + xlim = if (my_orientation) { + shared_lim + } else { + c(0.5, nr_of_samples + 0.5) + }, + ylim = if (!my_orientation) { + shared_lim + } else { + c(0.5, nr_of_samples + 0.5) + } + ) + axis(if (my_orientation) 1 else 2, cex.axis = cex_axis / 10) + axis( + if (my_orientation) 2 else 1, + at = seq_len(nr_of_samples), + labels = colnames(plot_data), + cex.axis = cex_axis / 10 + ) + } + title( + main = my_title, + sub = my_subtitle, + xlab = my_xlab, + ylab = my_ylab, + cex.main = cex_title / 10, + cex.lab = cex_axislabel / 10 + ) + } + } + + # Add grid + if (add_grid == 1) { + grid() + } else if (add_grid == 2) { + grid(nx = NULL, ny = NA) + } else if (add_grid == 3) { + grid(nx = NA, ny = NULL) + } + + # Samples means + if (add_means && plot_type == "0") { + boxplot_means <- colMeans(plot_data, na.rm = TRUE) + if (my_orientation) { + points(boxplot_means, seq_along(boxplot_means), pch = 18, col = "red") + } else { + points(seq_along(boxplot_means), boxplot_means, pch = 18, col = "red") + } + + # Add CI of means + if (add_mean_ci) { + for (i in seq_along(plot_data)) { + my_sample <- na.omit(plot_data[[i]]) + n <- length(my_sample) + if (n > 1) { + standard_error <- sd(my_sample) / sqrt(n) + ci_level <- mean_ci / 100 + t_value <- qt((1 + ci_level) / 2, df = n - 1) + margin_error <- t_value * standard_error + lower_ci <- boxplot_means[i] - margin_error + upper_ci <- boxplot_means[i] + margin_error + + if (my_orientation) { + lines(c(lower_ci, upper_ci), c(i, i), col = "red", lwd = 2) + lines( + c(lower_ci, lower_ci), c(i - 0.1, i + 0.1), + col = "red", lwd = 2 + ) + lines( + c(upper_ci, upper_ci), c(i - 0.1, i + 0.1), + col = "red", lwd = 2 + ) + } else { + lines(c(i, i), c(lower_ci, upper_ci), col = "red", lwd = 2) + lines( + c(i - 0.1, i + 0.1), c(lower_ci, lower_ci), + col = "red", lwd = 2 + ) + lines( + c(i - 0.1, i + 0.1), c(upper_ci, upper_ci), + col = "red", lwd = 2 + ) + } + } + } + } + } + + # Add numbers of data points + if (show_nr_of_points) { + nr_points <- boxplot_stats()$n + if (my_orientation) { + pos_x <- if (log_scale) 10^par("usr")[2] else par("usr")[2] + text( + x = pos_x, + y = seq_along(nr_points), + labels = nr_points, + pos = 2 + ) + } else { + pos_y <- if (log_scale) 10^par("usr")[4] else par("usr")[4] + text( + x = seq_along(nr_points), + y = pos_y, + labels = nr_points, + pos = 1 + ) + } + } + + # Add data points if selected or if forced by plotDataPoints limit + if (show_data_points || length(plot_points) > 0) { + plot_data_points <- plot_data + if (!show_data_points && length(plot_points) > 0) { + # Only plot points for samples below the limit + plot_data_points[, not_plot_points] <- NA + } + + if (datapoint_type == 1) { # Bee swarm + beeswarm( + plot_data_points, + add = TRUE, + col = point_c, + horizontal = my_orientation, + cex = point_size / 10, + pch = 16 + ) + } else { # Jittered or Default + jittered_points( + plot_data_points, + my_orientation, + datapoint_type, + point_colors, + point_transparency, + point_size / 10 + ) + } + } + } + + ## *** Data in table *** + output$filetable <- renderTable({ + if (is.null(data_m())) { + return(NULL) + } + if (nrow(data_m()) < 500) { + return(data_m()) + } else { + return(data_m()[1:100, ]) + } + }) + + # *** Boxplot (using 'generate_box_plot'-function) *** + output$boxPlot <- renderPlot( + { + if (is.null(data_m())) { + return(NULL) + } + generate_box_plot(data_m()) + }, + height = function() { + input$myHeight + }, + width = function() { + input$myWidth + } + ) + + ## *** Download EPS file *** + output$downloadPlotEPS <- downloadHandler( + filename = function() { + "Boxplot.eps" + }, + content = function(file) { + postscript( + file, + horizontal = FALSE, onefile = FALSE, paper = "special", + width = input$myWidth / 72, height = input$myHeight / 72 + ) + generate_box_plot(data_m()) + dev.off() + }, + contentType = "application/postscript" + ) + + ## *** Download PDF file *** + output$downloadPlotPDF <- downloadHandler( + filename = function() { + "Boxplot.pdf" + }, + content = function(file) { + pdf(file, width = input$myWidth / 72, height = input$myHeight / 72) + generate_box_plot(data_m()) + dev.off() + }, + contentType = "application/pdf" + ) + + ## *** Download SVG file *** + output$downloadPlotSVG <- downloadHandler( + filename = function() { + "Boxplot.svg" + }, + content = function(file) { + svg(file, width = input$myWidth / 72, height = input$myHeight / 72) + generate_box_plot(data_m()) + dev.off() + }, + contentType = "image/svg" + ) + + # *** Output boxplot statistics in table below plot *** + output$boxplotStatsTable <- renderTable( + { + if (is.null(data_m()) || is.null(boxplot_stats())) { + return(NULL) + } + get_stats_matrix(data_m(), boxplot_stats(), input$addMeans) + }, + rownames = TRUE + ) + + # *** Print figure legend *** + output$FigureLegend <- renderPrint({ + if (is.null(data_m()) || is.null(boxplot_stats())) { + return(invisible()) + } + fl <- generate_figure_legend( + stats = boxplot_stats(), + plot_type = input$plotType, + other_plot_type = input$otherPlotType, + whisker_type = input$whiskerType, + add_means = input$addMeans, + add_mean_ci = input$addMeanCI, + mean_ci_val = input$meanCI, + my_varwidth = input$myVarwidth, + bean_plot_center_type = input$beanPlotMedianMean + ) + cat(fl, "\n") + }) + + + # *** Download boxplot data in csv format *** + output$downloadBoxplotData <- downloadHandler( + filename = function() { + "BoxplotData.csv" + }, + content = function(file) { + write.csv(data_m(), file, row.names = FALSE) + } + ) +}) diff --git a/tests/test_ggplot_boxplot.R b/tests/test_ggplot_boxplot.R new file mode 100644 index 0000000..d61d65c --- /dev/null +++ b/tests/test_ggplot_boxplot.R @@ -0,0 +1,123 @@ +library(testthat) +library(ggplot2) + +context("BoxPlotR ggplot2 Boxplot Tests") + +test_that("ggplot2 boxplot rendering works with notches and overlays", { + # Mock dataset + plot_data <- list( + Sample1 = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), + Sample2 = c(5, 5, 6, 7, 8, 8, 9, 10, 11, 12) + ) + + # Calculate boxplot stats using our custom myboxplot.stats + source("../boxplot_stats_Function.R") + + bp_stats <- boxplot(plot_data, na.rm = TRUE, range = 1.5, plot = FALSE) + + df_stats <- data.frame( + Group = factor(bp_stats$names, levels = names(plot_data)), + ymin = bp_stats$stats[1, ], + lower = bp_stats$stats[2, ], + middle = bp_stats$stats[3, ], + upper = bp_stats$stats[4, ], + ymax = bp_stats$stats[5, ], + notchlower = bp_stats$conf[1, ], + notchupper = bp_stats$conf[2, ], + fill = bp_stats$names + ) + + df_long <- data.frame( + Value = unlist(plot_data, use.names = FALSE), + Group = rep(names(plot_data), each = 10) + ) + + # Verify that building the ggplot with notches works + test_notches <- tryCatch({ + p <- ggplot(df_stats, aes(x = Group, fill = Group)) + + suppressWarnings(geom_boxplot( + aes(ymin = ymin, lower = lower, middle = middle, upper = upper, ymax = ymax, + notchlower = notchlower, notchupper = notchupper), + stat = "identity", + varwidth = FALSE, + notch = TRUE, + width = 0.6 + )) + ggplot_build(p) + TRUE + }, error = function(e) { + FALSE + }) + expect_true(test_notches) + + # Verify that building with data points overlay works + test_data_points <- tryCatch({ + p <- ggplot(df_stats, aes(x = Group, fill = Group)) + + suppressWarnings(geom_boxplot( + aes(ymin = ymin, lower = lower, middle = middle, upper = upper, ymax = ymax, + notchlower = notchlower, notchupper = notchupper), + stat = "identity", + varwidth = FALSE, + notch = TRUE, + width = 0.6 + )) + + geom_jitter( + data = df_long, + mapping = aes(y = Value), + width = 0.05, height = 0, + color = "black", size = 1, alpha = 0.5 + ) + ggplot_build(p) + TRUE + }, error = function(e) { + FALSE + }) + expect_true(test_data_points) + + # Verify that building with means and CI overlays works + test_means_ci <- tryCatch({ + ci_fun <- function(x) { + n <- sum(!is.na(x)) + if (n <= 1) return(c(ymin = NA, ymax = NA)) + se <- sd(x, na.rm = TRUE) / sqrt(n) + t_val <- qt(0.975, df = n - 1) + me <- t_val * se + m <- mean(x, na.rm = TRUE) + c(ymin = m - me, ymax = m + me) + } + p <- ggplot(df_stats, aes(x = Group, fill = Group)) + + suppressWarnings(geom_boxplot( + aes(ymin = ymin, lower = lower, middle = middle, upper = upper, ymax = ymax, + notchlower = notchlower, notchupper = notchupper), + stat = "identity", + varwidth = FALSE, + notch = TRUE, + width = 0.6 + )) + + stat_summary( + data = df_long, + aes(x = Group, y = Value), + fun = mean, + geom = "point", + shape = 18, + size = 4, + color = "red", + inherit.aes = FALSE + ) + + stat_summary( + data = df_long, + aes(x = Group, y = Value), + fun.data = ci_fun, + geom = "errorbar", + width = 0.2, + color = "red", + linewidth = 0.8, + inherit.aes = FALSE + ) + ggplot_build(p) + TRUE + }, error = function(e) { + FALSE + }) + expect_true(test_means_ci) +}) diff --git a/tests/test_vioplot_edge_cases.R b/tests/test_vioplot_edge_cases.R new file mode 100644 index 0000000..cad8f36 --- /dev/null +++ b/tests/test_vioplot_edge_cases.R @@ -0,0 +1,68 @@ +library(testthat) +library(sm) + +context("BoxPlotR Plotting Edge Cases") + +# Source the custom plot functions +source("../MyVioplot.R") + +test_that("MyVioplot handles all-NA data gracefully", { + # Create a dataset where one sample is completely NA + plot_data <- list( + Sample1 = c(1, 2, 3, 4, 5), + Sample2 = c(NA_real_, NA_real_, NA_real_), + Sample3 = c(5, 6, 7, 8, 9) + ) + + # vioplot should execute without crash / 'missing value where TRUE/FALSE needed' + test_result <- tryCatch({ + pdf(file = NULL) # sink output to avoid creating Rplots.pdf + vioplot(plot_data, at = 1:3, col = "blue") + dev.off() + TRUE + }, error = function(e) { + message("Failed with error: ", e$message) + FALSE + }) + + expect_true(test_result) +}) + +test_that("MyVioplot handles data below minimum threshold (length < 2)", { + # Create a dataset where one sample has only 1 valid value + plot_data <- list( + Sample1 = c(1, 2, 3, 4, 5), + Sample2 = c(10, NA, NA), + Sample3 = c(5, 6, 7, 8, 9) + ) + + test_result <- tryCatch({ + pdf(file = NULL) + vioplot(plot_data, at = 1:3, col = "blue") + dev.off() + TRUE + }, error = function(e) { + FALSE + }) + + expect_true(test_result) +}) + +test_that("MyVioplot limits logic works in horizontal mode", { + plot_data <- list( + Sample1 = c(1, 2, 3, 4, 5), + Sample2 = c(2, 3, 4, 5, 6) + ) + + test_result <- tryCatch({ + pdf(file = NULL) + # Horizontal means ylim is the values scale + vioplot(plot_data, at = 1:2, col = "blue", horizontal = TRUE, ylim = c(0, 10)) + dev.off() + TRUE + }, error = function(e) { + FALSE + }) + + expect_true(test_result) +}) diff --git a/ui.R b/ui.R index f71b3f3..b81bc80 100644 --- a/ui.R +++ b/ui.R @@ -1,207 +1,772 @@ - -shinyUI(pageWithSidebar( - - headerPanel("BoxPlotR: a web-tool for generation of box plots", - tags$head(tags$style(type="text/css", "label.radio { display: inline-block; }", ".radio input[type=\"radio\"] { float: none; }"), - tags$style(type="text/css", "select { max-width: 200px; }"), - tags$style(type="text/css", "textarea { max-width: 185px; }"), - tags$style(type="text/css", ".jslider { max-width: 200px; }"), - tags$style(type='text/css', ".well { max-width: 330px; }"), - tags$style(type='text/css', ".span4 { max-width: 330px; }")) - ), - - sidebarPanel( - conditionalPanel(condition="input.tabs1=='About'", - h4("Introduction") - ), - conditionalPanel(condition="input.tabs1=='Data upload'", - h4("Enter data"), - radioButtons("dataInput", "", list("Load sample data"=1,"Upload file"=2,"Paste data"=3)), - conditionalPanel(condition="input.dataInput=='1'", - h5("Load sample data:"), - radioButtons("sampleData", "Load sample data", list("Example 1 (100,76,16,76,41 data points)"=1,"Example 2 (3 columns with 100 data points)"=2)) - ), - conditionalPanel(condition="input.dataInput=='2'", - h5("Upload delimited text file: "), - fileInput("upload", "", multiple = FALSE), - radioButtons("fileSepDF", "Delimiter:", list("Comma"=1,"Tab"=2,"Semicolon"=3)),#, "Space"=4)) - HTML('

Data in delimited text files can be separated by comma, tab or semicolon. - For example, Excel data can be exported in .csv (comma separated) or .tab (tab separated) format.

') - ), - conditionalPanel(condition="input.dataInput=='3'", - h5("Paste data below:"), - tags$textarea(id="myData", rows=10, cols=5, ""), - actionButton('clearText_button','Clear data'), - radioButtons("fileSepP", "Separator:", list("Comma"=1,"Tab"=2,"Semicolon"=3)) - ) - ), - conditionalPanel(condition="input.tabs1=='Data visualization'", - - radioButtons("plotType", "", list("Boxplot"=0, "Other"=1)), - conditionalPanel(condition="input.plotType=='1'", - radioButtons("otherPlotType", "", list("Violin plot"=0, "Bean plot"=1)), - textInput("myOtherPlotColours", "Colour(s):", value=c("light grey, white")), - conditionalPanel(condition="input.otherPlotType=='0'", - helpText("Colour of the 'violin area'"), - textInput("violinBorder", "Border colour:", value=c("grey")) - ), - conditionalPanel(condition="input.otherPlotType=='1'", - helpText("up to 4 colours can be specified: area of the beans, lines inside the bean, lines outside the bean, and average line per bean"), - textInput("beanBorder", "Border colour:", value=c("grey")) - ) - ), - - h4("Plot options"), - checkboxInput("plotDataPoints", "Minimum number of data points", FALSE), - conditionalPanel(condition="input.plotDataPoints", - numericInput("nrOfDataPoints", "Data point limit: ", value=5, min=5) - ), - - conditionalPanel(condition="input.plotType=='0'", - checkboxInput("showDataPoints", "Add data points", FALSE), - conditionalPanel(condition="input.showDataPoints", - radioButtons("datapointType", "", list("Default"=0, "Bee swarm"=1)) - ), - checkboxInput("whiskerDefinition", "Definition of whisker extent", FALSE), - conditionalPanel(condition="input.whiskerDefinition", - radioButtons("whiskerType", "", list("Tukey"=0, "Spear"=1, "Altman"=2)), -# conditionalPanel(condition="input.whiskerType=='0'", -# numericInput("TukeyRange", "Define whisker extent (x IQR):", min=0, step=0.5, value=1.5) -# ), -# conditionalPanel(condition="input.whiskerType=='1'", -# HTML('

Spear - Whiskers extend to minimum and maximum values.

') -# ), -# conditionalPanel(condition="input.whiskerType=='2'", -# numericInput("AltmanRange", "Define whisker extent in percentiles (ie, '5' means that whiskers extend to 5th and 95th percentile):", min=0, step=0.5, value=5) -# ), - HTML('

Tukey - whiskers extend to data points that are less than 1.5 x IQR away from 1st/3rd quartile; - Spear - whiskers extend to minimum and maximum values; - Altman - whiskers extend to 5th and 95th percentile (use only if n>40)

') - ), - checkboxInput("showNrOfPoints", "Display number of data points", FALSE), - checkboxInput("addMeans", "Add sample means", FALSE), - conditionalPanel(condition="input.addMeans", - checkboxInput("addMeanCI", "Add confidence intervals of means", FALSE), - conditionalPanel(condition="input.addMeanCI", - radioButtons("meanCI", "Define confidence interval of means:", list("83%"=83, "90%"=90, "95%"=95)) - ) - ), - - checkboxInput("myVarwidth", "Variable width boxes", FALSE), - helpText("Widths of boxes are proportional to square-roots of the number of observations."), - checkboxInput("myNotch", "Add notches", FALSE), - HTML('

+/-1.58*IQR/sqrt(n) - gives roughly 95% confidence that two medians differ (Chambers et al., 1983)

'), - conditionalPanel(condition="input.myNotch", - HTML('

The notches are defined as +/-1.58*IQR/sqrt(n) and represent the 95% confidence interval for each median. - Non-overlapping notches give roughly 95% confidence that two medians differ, ie, in 19 out of 20 cases the population - medians (estimated based on the samples) are in fact different (Chambers et al., 1983).

') - ), - textInput("myColours", "Colour(s):", value=c("light grey, white")), - helpText("Colours in HEX format can be chosen on http://colorbrewer2.org/") - ), - - checkboxInput("labelsTitle", "Modify labels and title", FALSE), - conditionalPanel(condition="input.labelsTitle", - checkboxInput("xaxisLabelAngle", "Rotate sample names", FALSE), - textInput("myXlab", "X-axis label:", value=c("")), - textInput("myYlab", "Y-axis label:", value=c("")), - textInput("myTitle", "Boxplot title:", value=c("")), - textInput("mySubtitle", "Boxplot subtitle:", value=c("")) - ), - checkboxInput("plotSize", "Adjust plot size", FALSE), - conditionalPanel(condition="input.plotSize", - numericInput("myHeight", "Plot height:", value=550), - numericInput("myWidth", "Plot width:", value=750) - ), - checkboxInput("fontSizes", "Change font sizes", FALSE), - conditionalPanel(condition="input.fontSizes", - numericInput("cexTitle", "Title font size:", value=14), - numericInput("cexAxislabel", "Axis label size:", value=14), - numericInput("cexAxis", "Axis font size:", value=12) - ), - h5("Orientation of box plots:"), - radioButtons("myOrientation", "", list("Vertical"=0, "Horizontal"=1)), - conditionalPanel(condition="input.myOrientation=='0'", - h5("Y-axis range (eg., '0,10'):"), - textInput("ylimit", "", value="") - ), - conditionalPanel(condition="input.myOrientation=='1'", - h5("X-axis range (eg., '0,10'):"), - textInput("xlimit", "", value="") - ), - h5("Add grid: "), - radioButtons("addGrid", "", list("None" = 0, "X & Y"= 1, "X only" = 2, "Y only" = 3)) -# numericInput("boxWidth", "Width of boxes:", value=1), - ) - ), - - mainPanel( - tabsetPanel( - # Welcome tab - tabPanel("About", - HTML('

This application allows users to generate customized box plots in a number of variants based on their data. A data matrix - can be uploaded as a file or pasted into the application. Basic box plots are generated based on the data and can be modified to include - additional information. Additional features become available when checking that option. Information about sample sizes can be represented - by the width of each box where the widths are proportional to the square roots of the number of observations n. Notches can be added to the - boxes. These are defined as +/-1.58*IQR/sqrt(n) which gives roughly 95% confidence that two medians are different. It is also possible to define - the whiskers based on the ideas of Spear and Tukey. Additional options of data visualization (violin and bean plots) reveal more information - about the underlying data distribution. Plots can be labeled, customized (colors, dimensions, orientation) and exported as eps, pdf and svg files.

'), - h5("Software references"), - HTML('

R Development Core Team. R: A Language and Environment for Statistical Computing. R Foundation for Statistical Computing, Vienna (2013)
- RStudio and Inc. shiny: Web Application Framework for R. R package version 0.5.0 (2013)
- Adler, D. vioplot: Violin plot. R package version 0.2 (2005)
- Eklund, A. beeswarm: The bee swarm plot, an alternative to stripchart. R package version 0.1.5 (2012)
- Kampstra, P. Beanplot: A Boxplot Alternative for Visual Comparison of Distributions. Journal of Statistical Software, Code Snippets 28(1). 1-9 (2008)
- Neuwirth, E. RColorBrewer: ColorBrewer palettes. R package version 1.0-5. (2011)

'), - h5("Further references"), - HTML('

Hadley Wickham and Lisa Stryjewski: 40 years of boxplots

'), - HTML('

Kristin Potter: Methods for Presenting Statistical Information: The Box Plot

'), - h6("This application was created by the ", a("Tyers", href="http://tyers.iric.ca/"), " and ", a("Rappsilber", href="http://rappsilberlab.org/"), - " labs. Please send bugs and feature requests to Michaela Spitzer (michaela.spitzer(at)gmail.com) and Jan Wildenhain (jan.wildenhain(at)gmail.com). This application uses the ", - a("shiny package from RStudio", href="http://www.rstudio.com/shiny/"), ".") - ), - # Data upload tab - tabPanel("Data upload", tableOutput("filetable"), - h6("This application was created by the ", a("Tyers", href="http://tyers.iric.ca/"), " and ", a("Rappsilber", href="http://rappsilberlab.org/"), - " labs. Please send bugs and feature requests to Michaela Spitzer (michaela.spitzer(at)gmail.com) and Jan Wildenhain (jan.wildenhain(at)gmail.com). This application uses the ", - a("shiny package from RStudio", href="http://www.rstudio.com/shiny/"), ".") - ), - # Boxplot tab - tabPanel("Data visualization", downloadButton("downloadPlotEPS", "Download eps-file"), - downloadButton("downloadPlotPDF", "Download pdf-file"), - downloadButton("downloadPlotSVG", "Download svg-file"), - plotOutput("boxPlot", height='100%', width='100%'), - h4("Box plot statistics"), tableOutput("boxplotStatsTable"), - h6("This application was created by the ", a("Tyers", href="http://tyers.iric.ca/"), " and ", a("Rappsilber", href="http://rappsilberlab.org/"), - " labs. Please send bugs and feature requests to Michaela Spitzer (michaela.spitzer(at)gmail.com) and Jan Wildenhain (jan.wildenhain(at)gmail.com). This application uses the ", - a("shiny package from RStudio", href="http://www.rstudio.com/shiny/"), ".") - ), - # Figure legend - tabPanel("Figure legend template", h5("Box plot description for figure legend:"), textOutput("FigureLegend"), - h5("Further information to be added to the figure legend:"), p("What do the box plots show, explain colours if used."), - downloadButton("downloadBoxplotData", "Download box plot data as .CSV file"), - h6("This application was created by the ", a("Tyers", href="http://tyers.iric.ca/"), " and ", a("Rappsilber", href="http://rappsilberlab.org/"), - " labs. Please send bugs and feature requests to Michaela Spitzer (michaela.spitzer(at)gmail.com) and Jan Wildenhain (jan.wildenhain(at)gmail.com). This application uses the ", - a("shiny package from RStudio", href="http://www.rstudio.com/shiny/"), ".") - ), - # FAQ - tabPanel("FAQ", - h5("Q: I have trouble editing the graphic files."), - p("A: For EPS files make sure to 'ungroup' all objects so they can be edited independently. - In Adobe Illustrator you will also need to use the 'release compound path' command. For PDF - files you should 'release clipping mask'. SVG import appears to have problems in Adobe Illustrator - and Corel Draw and should be avoided. EPS, PDF and SVG import all work with Inkscape http://www.inkscape.org/.") -# h5("Further information to be added to the figure legend:"), -# p("What do the box plots show, explain colours if used.") - ), - id="tabs1" - ) - ) +shinyUI(fluidPage( + style = "padding: 30px; max-width: 1400px; margin: 0 auto;", + div( + class = "header-bar", + h1("BoxPlotR", span("a web-tool for generation of box plots", class = "subtitle")), + span("v2.1 Modernized", class = "version-badge") + ), + tags$head( + tags$style(HTML( + " + @import url('https://fonts.googleapis.com/css2?family=Inter:wght@400;500;600;700&display=swap'); + + body, h1, h2, h3, h4, h5, h6, .shiny-text-output, label { + font-family: 'Inter', sans-serif !important; + } + + body { + background: linear-gradient(135deg, #f0f7ff 0%, #f8fafc 100%); + background-attachment: fixed; + min-height: 100vh; + } + + .header-bar { + display: flex; + align-items: center; + justify-content: space-between; + background: rgba(255, 255, 255, 0.7); + backdrop-filter: blur(20px); + -webkit-backdrop-filter: blur(20px); + border: 1px solid rgba(255, 255, 255, 0.4); + padding: 18px 28px; + border-radius: 20px; + margin-top: 10px; + margin-bottom: 28px; + box-shadow: 0 10px 30px rgba(0, 0, 0, 0.04); + } + + .header-bar h1 { + font-size: 26px; + font-weight: 700; + margin: 0; + background: linear-gradient(135deg, #0f172a 0%, #0369a1 100%); + -webkit-background-clip: text; + -webkit-text-fill-color: transparent; + display: flex; + align-items: baseline; + gap: 12px; + } + + .header-bar .subtitle { + font-size: 15px; + font-weight: 400; + color: #64748b; + -webkit-text-fill-color: #64748b; + } + + .version-badge { + background: linear-gradient(135deg, #0ea5e9 0%, #0284c7 100%); + color: white; + font-size: 12px; + font-weight: 600; + padding: 4px 12px; + border-radius: 99px; + box-shadow: 0 4px 10px rgba(14, 165, 233, 0.2); + } + + label.radio { display: inline-block; } + .radio input[type=\"radio\"] { float: none; } + + /* Glassmorphism Sidebar */ + .well { + max-width: 330px; + background: rgba(255, 255, 255, 0.7) !important; + backdrop-filter: blur(16px) !important; + -webkit-backdrop-filter: blur(16px) !important; + border: 1px solid rgba(255, 255, 255, 0.5) !important; + border-radius: 20px !important; + box-shadow: 0 15px 35px rgba(15, 23, 42, 0.04) !important; + padding: 24px !important; + } + .span4 { max-width: 330px; } + + /* Inputs and Form Controls */ + input[type=\"text\"], input[type=\"number\"], select, textarea { + background: rgba(255, 255, 255, 0.9) !important; + border: 1px solid #cbd5e1 !important; + border-radius: 10px !important; + padding: 8px 12px !important; + font-size: 14px !important; + transition: all 0.2s ease-in-out !important; + box-shadow: inset 0 2px 4px rgba(0, 0, 0, 0.02) !important; + color: #1e293b !important; + } + input[type=\"text\"]:focus, input[type=\"number\"]:focus, select:focus, textarea:focus { + border-color: #0ea5e9 !important; + box-shadow: 0 0 0 4px rgba(14, 165, 233, 0.15), inset 0 2px 4px rgba(0, 0, 0, 0.02) !important; + outline: none !important; + } + + /* Premium Selectize styling to remove default blue focus bubble and match 34px height */ + .selectize-control .selectize-input { + background: rgba(255, 255, 255, 0.9) !important; + border: 1px solid #cbd5e1 !important; + border-radius: 10px !important; + padding: 6px 12px !important; + font-size: 14px !important; + transition: all 0.2s ease-in-out !important; + box-shadow: inset 0 2px 4px rgba(0, 0, 0, 0.02) !important; + color: #1e293b !important; + height: 34px !important; + min-height: 34px !important; + line-height: 20px !important; + box-sizing: border-box !important; + } + /* Prevent custom input[type='text'] styles from bloating the selectize inline search box */ + .selectize-control .selectize-input > input[type='text'] { + background: transparent !important; + border: none !important; + box-shadow: none !important; + padding: 0 !important; + margin: 0 !important; + height: auto !important; + min-height: 0 !important; + line-height: inherit !important; + box-sizing: border-box !important; + } + .selectize-control .selectize-input.focus { + border-color: #0ea5e9 !important; + box-shadow: 0 0 0 4px rgba(14, 165, 233, 0.15), inset 0 2px 4px rgba(0, 0, 0, 0.02) !important; + outline: none !important; + border-radius: 10px !important; + } + .selectize-dropdown { + border-radius: 12px !important; + border: 1px solid rgba(0, 0, 0, 0.05) !important; + box-shadow: 0 10px 25px rgba(15, 23, 42, 0.08) !important; + overflow: hidden !important; + background: #ffffff !important; + padding: 6px 0 !important; + } + .selectize-dropdown .selected { + background: linear-gradient(135deg, #0ea5e9 0%, #0284c7 100%) !important; + color: white !important; + font-weight: 600 !important; + } + .selectize-dropdown .active { + background: rgba(14, 165, 233, 0.08) !important; + color: #0284c7 !important; + font-weight: 500 !important; + } + + label { + font-weight: 600 !important; + color: #334155 !important; + font-size: 13.5px !important; + margin-bottom: 6px !important; + } + + /* Tabs Container */ + .nav-tabs { + border-bottom: 2px solid #e2e8f0 !important; + margin-bottom: 24px !important; + display: flex; + gap: 6px; + } + .nav-tabs > li { + margin-bottom: -2px !important; + } + .nav-tabs > li > a { + border: none !important; + border-radius: 12px 12px 0 0 !important; + padding: 10px 18px !important; + color: #64748b !important; + font-weight: 600 !important; + background: transparent !important; + transition: all 0.25s ease !important; + font-size: 14.5px !important; + } + .nav-tabs > li > a:hover { + color: #0f172a !important; + background: rgba(14, 165, 233, 0.05) !important; + } + .nav-tabs > li.active > a, + .nav-tabs > li.active > a:focus, + .nav-tabs > li.active > a:hover { + color: #ffffff !important; + background: linear-gradient(135deg, #0ea5e9 0%, #0284c7 100%) !important; + box-shadow: 0 8px 20px rgba(14, 165, 233, 0.2) !important; + } + + /* Buttons */ + .btn-default { + background: linear-gradient(135deg, #0ea5e9 0%, #0284c7 100%) !important; + color: #ffffff !important; + border: none !important; + border-radius: 12px !important; + padding: 10px 18px !important; + font-weight: 600 !important; + font-size: 13.5px !important; + box-shadow: 0 4px 14px rgba(14, 165, 233, 0.3) !important; + transition: all 0.25s cubic-bezier(0.4, 0, 0.2, 1) !important; + margin-bottom: 5px; + } + .btn-default:hover { + background: linear-gradient(135deg, #0284c7 0%, #0369a1 100%) !important; + color: #ffffff !important; + transform: translateY(-1.5px) !important; + box-shadow: 0 6px 20px rgba(14, 165, 233, 0.4) !important; + } + .btn-default:active { + transform: translateY(0.5px) !important; + } + + /* Card Layout for Plots */ + .plot-card { + background: #ffffff !important; + border-radius: 24px !important; + padding: 28px !important; + box-shadow: 0 20px 40px rgba(15, 23, 42, 0.05) !important; + margin-top: 15px; + margin-bottom: 28px; + border: 1px solid rgba(226, 232, 240, 0.8) !important; + transition: transform 0.3s ease; + } + .plot-card:hover { + transform: translateY(-2px); + } + + .table-card { + background: #ffffff !important; + border-radius: 20px !important; + padding: 24px !important; + box-shadow: 0 10px 30px rgba(15, 23, 42, 0.03) !important; + border: 1px solid rgba(226, 232, 240, 0.8) !important; + } + + .table-card table { + width: 100%; + border-collapse: separate; + border-spacing: 0; + margin-top: 12px; + } + .table-card th { + background: #f8fafc; + color: #475569; + font-weight: 700; + text-transform: uppercase; + font-size: 11px; + letter-spacing: 0.05em; + padding: 12px 16px; + border-bottom: 2px solid #e2e8f0; + } + .table-card td { + padding: 12px 16px; + border-bottom: 1px solid #f1f5f9; + color: #334155; + font-size: 13.5px; + } + .table-card tr:last-child td { + border-bottom: none; + } + + .controls-row { + display: flex; gap: 10px; margin-top: 15px; flex-wrap: wrap; + } + + h4 { + font-size: 18px !important; + font-weight: 700 !important; + color: #0f172a !important; + margin-top: 0 !important; + margin-bottom: 16px !important; + } + h5 { + font-size: 15px !important; + font-weight: 600 !important; + color: #1e293b !important; + margin-top: 18px !important; + margin-bottom: 10px !important; + } + p { + color: #475569 !important; + line-height: 1.6 !important; + font-size: 14px !important; + } + + /* Beautiful custom sliders */ + .irs-bar { + background: linear-gradient(90deg, #0ea5e9 0%, #0284c7 100%) !important; + border-top: 1px solid #0284c7 !important; + border-bottom: 1px solid #0284c7 !important; + height: 8px !important; + } + .irs-single { + background: #0284c7 !important; + font-weight: 600 !important; + border-radius: 6px !important; + } + .irs-slider { + background: #f8fafc !important; + border: 2px solid #0284c7 !important; + box-shadow: 0 4px 8px rgba(0,0,0,0.1) !important; + width: 18px !important; + height: 18px !important; + border-radius: 99px !important; + } + .irs-line { + height: 8px !important; + border-radius: 4px !important; + } + " + )) + ), + sidebarLayout( + sidebarPanel( + conditionalPanel( + condition = "input.tabs1=='About'", + h4("Introduction") + ), + conditionalPanel( + condition = "input.tabs1=='Data upload'", + h4("Enter data"), + radioButtons( + "dataInput", "", + list("Load sample data" = 1, "Upload file" = 2, "Paste data" = 3) + ), + conditionalPanel( + condition = "input.dataInput=='1'", + h5("Load sample data:"), + radioButtons( + "sampleData", "Load sample data", + list( + "Example 1 (100,76,16,76,41 data points)" = 1, + "Example 2 (3 columns with 100 data points)" = 2, + "Example 3 (Log scale, Excel format)" = 3 + ) + ) + ), + conditionalPanel( + condition = "input.dataInput=='2'", + h5("Upload data file: "), + fileInput( + "upload", "", multiple = FALSE, + accept = c( + "text/csv", "text/comma-separated-values", + "text/tab-separated-values", "text/plain", + ".csv", ".tsv", ".xls", ".xlsx" + ) + ), + radioButtons( + "fileSepDF", "Delimiter (ignored for Excel files):", + list("Comma" = 1, "Tab" = 2, "Semicolon" = 3) + ), + HTML(paste( + "

Supports .csv, .tab, .txt, .xls, and .xlsx. ", + "Data in delimited text files can be ", + "separated by comma, tab or semicolon. Excel files will be read ", + "automatically from the first sheet.

", + sep = "" + )) + ), + conditionalPanel( + condition = "input.dataInput=='3'", + h5("Paste data below:"), + tags$textarea(id = "myData", rows = 10, cols = 5, ""), + actionButton("clearText_button", "Clear data"), + radioButtons( + "fileSepP", "Separator:", + list("Comma" = 1, "Tab" = 2, "Semicolon" = 3) + ) + ) + ), + conditionalPanel( + condition = "input.tabs1=='Data visualization'", + radioButtons("plotType", "", list("Boxplot" = 0, "Other" = 1)), + conditionalPanel( + condition = "input.plotType=='1'", + radioButtons( + "otherPlotType", "", + list("Violin plot" = 0, "Bean plot" = 1) + ), + HTML(paste( + "

Violin plots are generated with the ", + "vioplot package. Bean plots are generated ", + "with the beanplot package.

", + sep = "" + )), + textInput( + "myOtherPlotColours", "Colour(s):", + value = c("light grey, white") + ), + conditionalPanel( + condition = "input.otherPlotType=='0'", + helpText("Colour of the 'violin area'"), + textInput("violinBorder", "Border colour:", value = c("grey")) + ), + conditionalPanel( + condition = "input.otherPlotType=='1'", + helpText(paste( + "up to 4 colours can be specified: area of the beans, lines ", + "inside the bean, lines outside the bean, and average line ", + "per bean", + sep = "" + )), + textInput("beanBorder", "Border colour:", value = c("grey")), + radioButtons( + "beanPlotMedianMean", "Display: ", + list("Median" = 0, "Mean" = 1) + ) + ) + ), + selectInput( + "styleGuide", "Preset Style Guide:", + list( + "Custom / None" = "none", + "Nature Journal" = "nature", + "Science Journal" = "science", + "The Economist" = "economist", + "Financial Times" = "ft" + ), + selected = "none" + ), + radioButtons( + "plotEngine", "Plot rendering engine:", + list("Classic (Base R)" = "classic", "Modern (ggplot2)" = "ggplot") + ), + h4("Plot options"), + checkboxInput("plotDataPoints", "Minimum number of data points", FALSE), + conditionalPanel( + condition = "input.plotDataPoints", + numericInput( + "nrOfDataPoints", "Data point limit: ", + value = 5, min = 5 + ) + ), + checkboxInput("showDataPoints", "Add data points", FALSE), + conditionalPanel( + condition = "input.showDataPoints", + radioButtons( + "datapointType", "", + list("Default" = 0, "Bee swarm" = 1, "Jittered" = 2) + ), + sliderInput( + "pointTransparency", "Transparency of data points", + min = 0, max = 99, value = 50 + ), + sliderInput( + "pointSize", "Size of data points", + min = 1, max = 20, value = 10 + ), + HTML(paste( + "

Using the beeswarm package.

", + sep = "" + )), + textInput("pointColors", "Colour(s):", value = c("black")) + ), + checkboxInput("showNrOfPoints", "Display number of data points", FALSE), + conditionalPanel( + condition = "input.plotType=='0'", + checkboxInput( + "whiskerDefinition", "Definition of whisker extent", FALSE + ), + conditionalPanel( + condition = "input.whiskerDefinition", + radioButtons( + "whiskerType", "", + list("Tukey" = 0, "Spear" = 1, "Altman" = 2) + ), + HTML(paste( + "

Tukey - whiskers extend to data ", + "points that are less than 1.5 x IQR away from 1st/3rd ", + "quartile", + "; Spear - whiskers extend to minimum and maximum values; ", + "Altman - whiskers extend to 5th and 95th percentile ", + "(use only if n>40)

", + sep = "" + )) + ), + checkboxInput("addMeans", "Add sample means", FALSE), + conditionalPanel( + condition = "input.addMeans", + checkboxInput( + "addMeanCI", "Add confidence intervals of means", FALSE + ), + conditionalPanel( + condition = "input.addMeanCI", + radioButtons( + "meanCI", "Define confidence interval of means:", + list("83%" = 83, "90%" = 90, "95%" = 95) + ) + ) + ), + checkboxInput("myVarwidth", "Variable width boxes", FALSE), + helpText(paste( + "Widths of boxes are proportional to square-roots of the ", + "number of observations.", + sep = "" + )), + checkboxInput("myNotch", "Add notches", FALSE), + HTML(paste( + "

+/-1.58*IQR/sqrt(n) - gives roughly ", + "95% confidence that two medians differ (Chambers et al., 1983)", + "

", + sep = "" + )), + conditionalPanel( + condition = "input.myNotch", + HTML(paste( + "

The notches are defined as +/-1.58*IQR/sqrt(n) and ", + "represent the 95% confidence interval for each median. ", + "Non-overlapping notches give roughly 95% confidence that two ", + "medians differ, ie, in 19 out of 20 cases the population ", + "medians (estimated based on the samples) are in fact ", + "different (Chambers et al., 1983).

", + sep = "" + )) + ), + textInput("myColours", "Colour(s):", value = c("light grey, white")), + helpText(paste( + "Colours in HEX format can be chosen on ", + "http://colorbrewer2.org/", + sep = "" + )) + ), + checkboxInput("labelsTitle", "Modify labels and title", FALSE), + conditionalPanel( + condition = "input.labelsTitle", + checkboxInput("xaxisLabelAngle", "Rotate sample names", FALSE), + textInput("myXlab", "X-axis label:", value = c("")), + textInput("myYlab", "Y-axis label:", value = c("")), + textInput("myTitle", "Boxplot title:", value = c("")), + textInput("mySubtitle", "Boxplot subtitle:", value = c("")) + ), + checkboxInput("plotSize", "Adjust plot size", FALSE), + conditionalPanel( + condition = "input.plotSize", + numericInput("myHeight", "Plot height:", value = 550), + numericInput("myWidth", "Plot width:", value = 750) + ), + checkboxInput("fontSizes", "Change font sizes", FALSE), + conditionalPanel( + condition = "input.fontSizes", + numericInput("cexTitle", "Title font size:", value = 14), + numericInput("cexAxislabel", "Axis label size:", value = 14), + numericInput("cexAxis", "Axis font size:", value = 12) + ), + h5("Orientation of box plots:"), + radioButtons( + "myOrientation", "", + list("Vertical" = 0, "Horizontal" = 1) + ), + conditionalPanel( + condition = "input.myOrientation=='0'", + h5("Y-axis range (eg., '0,10'):"), + textInput("ylimit", "", value = "") + ), + conditionalPanel( + condition = "input.myOrientation=='1'", + h5("X-axis range (eg., '0,10'):"), + textInput("xlimit", "", value = "") + ), + checkboxInput( + "logScale", "Change to log scale (only for data >0)", FALSE + ), + h5("Add grid: "), + radioButtons( + "addGrid", "", + list("None" = 0, "X & Y" = 1, "X only" = 2, "Y only" = 3) + ) + ) + ), + mainPanel( + tabsetPanel( + tabPanel( + "About", + HTML(paste( + "

This application was developed with Nature Methods and ", + "you can find the publication here. ", + "The BoxPlotR has also been mentioned in this ", + "editorial and this ", + "blog entry. Nature methods also dedicated a Points of View and a Points of Significance", + " column to box plots. We hope that you find the BoxPlotR useful and we welcome suggestions for ", + "additional features by our users.

", + sep = "" + )), + h5("Support BoxPlotR"), + HTML(paste( + "

Please consider supporting the development and maintenance ", + "of BoxPlotR with a donation.

", + sep = "" + )), + h5("Software references"), + HTML(paste( + "

R Development Core Team. R: A Language and Environment for Statistical ", + "Computing. R Foundation for Statistical Computing, Vienna ", + "(2013)
RStudio and Inc. shiny: Web Application Framework for R. R ", + "package version 0.5.0 (2013)
Adler, D. vioplot", + ": Violin plot. R package version 0.2 (2005)
Eklund, ", + "A. beeswarm: The bee swarm plot, an alternative ", + "to stripchart. R package version 0.1.5 (2012)
Kampstra, ", + "P. Beanplot: A Boxplot Alternative for Visual ", + "Comparison of Distributions. Journal of Statistical ", + "Software, Code Snippets 28(1). 1-9 (2008)
Neuwirth, E. ", + "RColorBrewer: ColorBrewer palettes. R ", + "package version 1.0-5. (2011)

", + sep = "" + )), + h6(paste( + "This application was created by the Tyers and Rappsilber labs. ", + "Please send bugs and feature requests to Michaela Spitzer ", + "(michaela.spitzer(at)gmail.com) and Jan Wildenhain ", + "(jan.wildenhain(at)gmail.com). This application uses the shiny ", + "package from RStudio.", + sep = "" + )) + ), + tabPanel( + "Data upload", + tableOutput("filetable"), + h6("This application was created by the Tyers and Rappsilber labs.") + ), + tabPanel( + "Data visualization", + div( + class = "controls-row", + downloadButton("downloadPlotEPS", "Download eps-file"), + downloadButton("downloadPlotPDF", "Download pdf-file"), + downloadButton("downloadPlotSVG", "Download svg-file") + ), + div( + class = "plot-card", + plotOutput("boxPlot", height = "100%", width = "100%") + ), + div( + class = "table-card", + h4("Box plot statistics"), + tableOutput("boxplotStatsTable") + ), + br(), + h6("This application was created by the Tyers and Rappsilber labs.") + ), + tabPanel( + "Figure legend template", + h5("Box plot description for figure legend:"), + textOutput("FigureLegend"), + h5("Further information to be added to the figure legend:"), + p("What do the box plots show, explain colours if used."), + downloadButton( + "downloadBoxplotData", "Download box plot data as .CSV file" + ), + h6("This application was created by the Tyers and Rappsilber labs.") + ), + tabPanel( + "News", + h5("May 30, 2026"), + HTML(paste( + "

Introduced support for the Modern (ggplot2) rendering engine! ", + "Users can now seamlessly toggle between Classic (Base R) and Modern (ggplot2) plot rendering. ", + "Implemented stunning ggplot2 box plots, violin plots, and bean plots with real-time customized fill colors, ", + "alpha levels, jittered raw data point overlays, red sample means, and error bars showing confidence intervals.

", + sep = "" + )), + h5("May 29, 2026"), + HTML(paste( + "

Upgraded the application environment and Docker container configurations to fully support ", + "the latest R version 4.6.0 and Shiny version 1.13.0, ensuring long-term compatibility, stability, ", + "and security. In addition, the application's user interface has been fully modernized with a premium ", + "glassmorphic theme, responsive page layouts, customized form controls, and improved plot statistics tables.

", + sep = "" + )), + h5("April 16, 2026"), + HTML("

Number of sessions increased to 50.

"), + h5("April 8, 2026"), + HTML(paste( + "

The shiny server backend has been updated. The number of ", + "concurrent sessions has been limited to 15 and the session ", + "idle timeout set to 10 minutes. We are currently reworking ", + "the code to support the latest R and shiny versions.

", + sep = "" + )), + h5("January 17, 2021"), + HTML(paste( + "

There are several recent updates. The jitter of points is ", + "now consistent for all samples. When data points are added to ", + "the plot, the size can now be modified with sliders.

", + sep = "" + )) + ), + tabPanel( + "FAQ", + h5("Q: I have trouble editing the graphic files."), + p(paste( + "A: For EPS files make sure to 'ungroup' all objects so they ", + "can be edited independently. In Adobe Illustrator you will ", + "also need to use the 'release compound path' command.", + sep = "" + )), + h5("Q: How do I install Docker, clone BoxPlotR from GitHub, and run it in a container?"), + HTML(paste( + "

A: Here is the step-by-step guide to installing Docker, pulling the repository from GitHub, and running BoxPlotR inside a container:

", + "
    ", + "
  1. Install Docker:", + "
      ", + "
    • Windows / macOS: Download and install Docker Desktop.
      • ", + "
    • Linux (Ubuntu/Debian): Run these terminal commands to install and start Docker:
      ", + "
      sudo apt-get update\nsudo apt-get install -y docker.io\nsudo systemctl start docker\nsudo systemctl enable docker
      • ", + "
    2. ", + "
  2. Clone the Repository from GitHub:
    ", + "
    git clone https://github.com/jwildenhain/BoxPlotR.shiny.git\ncd BoxPlotR.shiny
    3. ", + "
  3. Build the pre-configured Docker image:
    ", + "
    docker build -t boxplotr .
    4. ", + "
  4. Run the container:
    ", + "
    docker run -d -p 3838:3838 --name boxplotr-app boxplotr
    ", + "

    Now you can open http://localhost:3838 in your browser to run the full glassmorphic web app!

    5. ", + "
", + sep = "" + )), + h5("Q: Does BoxPlotR support integration with AI coding assistants (e.g. Claude Desktop, Cursor, Antigravity)?"), + HTML(paste( + "

A: Yes! BoxPlotR now includes a pre-configured Model Context Protocol (MCP) server (boxplotr_mcp_server.py). ", + "This enables AI assistants to programmatically generate and customize high-quality box plots, violin plots, and bean plots ", + "using both R engines directly through automated tools. It works over standard I/O (stdio).

", + sep = "" + )), + h5("Q: How can I make the MCP server available and run it inside a Docker container?"), + HTML(paste( + "

A: You can easily route MCP commands to run inside the active BoxPlotR Docker container. ", + "First, make sure the Dockerfile installs Python 3 (e.g., RUN apt-get update && apt-get install -y python3). ", + "Then, add the following configuration to your AI assistant's configuration file (e.g., claude_desktop_config.json) ", + "to execute the server via standard input/output redirection:

", + "
{\n  \"mcpServers\": {\n    \"boxplotr-docker\": {\n      \"command\": \"docker\",\n      \"args\": [\n        \"exec\",\n        \"-i\",\n        \"boxplotr-container-name\",\n        \"python3\",\n        \"/srv/shiny-server/boxplotr_mcp_server.py\"\n      ]\n    }\n  }\n}
", + "

This maps standard stdio streams directly into the running R environment in the container without exposing ports!

", + sep = "" + )), + h5("Q: How can I test the MCP server locally with a JSON-RPC request?"), + HTML(paste( + "

A: You can test the stdio MCP server from your command line by piping a standard JSON-RPC 2.0 tools/call request directly into the Python script. Since the server operates over line-by-line stdio (readline()), the JSON-RPC request payload must be sent as a single line (no newlines within the JSON string itself). Here is a concrete JSON example using a wide-format dataset (where columns represent samples) to generate a ggplot2 box plot with the Economist style preset:

", + "
{\n  \"jsonrpc\": \"2.0\",\n  \"id\": 1,\n  \"method\": \"tools/call\",\n  \"params\": {\n    \"name\": \"generate_boxplot\",\n    \"arguments\": {\n      \"data_config\": {\n        \"values\": \"SampleA,SampleB\\n12.5,8.9\\n14.2,10.1\\n15.8,11.5\\n13.1,9.4\"\n      },\n      \"visualization\": {\n        \"plot_type\": \"boxplot\",\n        \"plot_engine\": \"ggplot2\",\n        \"style_guide\": \"economist\",\n        \"orientation\": \"vertical\",\n        \"log_scale\": false\n      },\n      \"styling\": {\n        \"title\": \"Comparison of Sample A and Sample B\",\n        \"xlab\": \"Group\",\n        \"ylab\": \"Value\",\n        \"colors\": [\"#0ea5e9\", \"#ef4444\"],\n        \"add_grid\": \"y\"\n      },\n      \"overlays\": {\n        \"show_points\": true,\n        \"point_type\": \"jittered\",\n        \"point_size\": 1.2,\n        \"point_transparency\": 30,\n        \"add_means\": true,\n        \"notch\": true\n      },\n      \"output_path\": \"/absolute/path/to/output_plot.png\"\n    }\n  }\n}
", + "

Run the following command in your terminal (with the JSON payload minified onto a single line) to test execution:

", + "
echo '{\"jsonrpc\": \"2.0\", \"id\": 1, \"method\": \"tools/call\", \"params\": {\"name\": \"generate_boxplot\", \"arguments\": {\"data_config\": {\"values\": \"SampleA,SampleB\\n12.5,8.9\\n14.2,10.1\\n15.8,11.5\\n13.1,9.4\"}, \"visualization\": {\"plot_type\": \"boxplot\", \"plot_engine\": \"ggplot2\", \"style_guide\": \"economist\", \"orientation\": \"vertical\", \"log_scale\": false}, \"styling\": {\"title\": \"Comparison of Sample A and Sample B\", \"xlab\": \"Group\", \"ylab\": \"Value\", \"colors\": [\"#0ea5e9\", \"#ef4444\"], \"add_grid\": \"y\"}, \"overlays\": {\"show_points\": true, \"point_type\": \"jittered\", \"point_size\": 1.2, \"point_transparency\": 30, \"add_means\": true, \"notch\": true}, \"output_path\": \"assets/mcp_test_plot.png\"}}}' | python3 boxplotr_mcp_server.py
", + "

This command runs the Python server, triggers the R script dynamically, and outputs a clean JSON-RPC response confirming that the output image was generated at assets/mcp_test_plot.png!

", + sep = "" + )) + ), + id = "tabs1" + ) + ) + ) )) - - - - - - -