Skip to content

Instantly share code, notes, and snippets.

Avatar

Joe Cheng jcheng5

View GitHub Profile
@jcheng5
jcheng5 / README.md
Last active Feb 10, 2022
Accepting POST requests from Shiny
View README.md

Accepting POST requests from Shiny

(This post was motivated by a talk by @jnolis at CascadiaRConf 2021)

Recent versions of Shiny have an undocumented feature for handling POST requests that are not associated with any specific Shiny session. (Note that this functionality is missing our normal level of polish; it's a fairly low-level hook that I needed to make some things possible, but doesn't make anything easy.)

In a nutshell, it works by replacing your traditional ui object with a function(req), and then marking that function with an attribute indicating that it knows how to handle both GET and POST:

library(shiny)
View reentrancy-rhttpd.R
assign("msg", local({
i <- 0
function(url, ...) {
i <<- i + 1
on.exit(i <<- i - 1)
if (i > 1) {
message("reentrancy detected!")
return("reentrancy detected!")
}
cat("") # Calls R_ProcessEvents()
@jcheng5
jcheng5 / image_dimensions.R
Last active Apr 18, 2020
Determine file image size in R
View image_dimensions.R
jpeg_dimensions <- function(filename, bytes = 1024) {
bytes <- readBin(filename, "raw", n = bytes)
if (length(bytes) < 2 || bytes[[1]] != 0xFF || bytes[[2]] != 0xD8) {
stop("Couldn't decode jpeg")
}
ff <- which(bytes == 0xFF)
c0 <- which(bytes == 0xC0)
View enshadow_gt.Rmd
```{js echo=FALSE}
function enshadowGtTable(tableEl) {
var containerEl = tableEl.parentElement;
var styleEl = containerEl.previousElementSibling;
if (containerEl.tagName !== "DIV" || styleEl.tagName !== "STYLE") {
throw new Error("Unexpected document structure");
}
var shadowDiv = document.createElement("div");
shadowDiv.classList.add("gt-shadow-container");
containerEl.parentElement.insertBefore(shadowDiv, styleEl);
@jcheng5
jcheng5 / README.md
Last active Mar 10, 2021
Installing R-devel on Solaris 10 VM
View README.md

As far as CRAN is concerned, there are two flavors of R on Solaris: one that is built using the Solaris Studio compiler, and one that is built using the GNU/gcc toolchain. The latter is far more up-to-date, but if your package requires it, then your DESCRIPTION file must declare that with the line SystemRequirements: GNU make.

These instructions are for configuring, building, and installing R-devel using the GNU/gcc toolchain (only).

You'll need VMWare Fusion on Mac, or VMWare Workstation (?) on Windows/Linux.

Get Solaris VM

Download the Solaris VM provided by Jeroen Ooms: https://github.com/jeroen/solarisvm

View gist:34ef026bdefd3c9b558920b9a9804c01
590 pkgutil -i wget
603 pkgutil -i gcc5gfortran
609 pkgutil -i -y libiconv_dev
613 pkgutil -i -y zlib_dev
615 pkgutil -i -y libz_dev
620 pkgutil -i -y liblzma_dev
622 pkgutil -i -y libpcre_dev
624 pkgutil -i -y libcurl_dev
634 pkgutil -i -y libcurl4_dev
647 pkgutil -y -i gmake
@jcheng5
jcheng5 / app.R
Created Jul 5, 2019
Celsius <=> Fahrenheit
View app.R
library(shiny)
ui <- fluidPage(
numericInput("temp_c", "Celsius", NA),
numericInput("temp_f", "Fahrenheit", NA)
)
server <- function(input, output, session) {
c_to_f <- function(c, decimals = 1) {
round((c * 9 / 5) + 32, decimals)
View leaflet-mapbox-gl.R
# BE SURE TO set your Mapbox access token with:
# options(mapbox.accessToken = "...")
library(htmltools)
library(leaflet)
mapboxgl_deps <- list(
htmlDependency(
"mapbox-gl-js", "0.53.0", c(href = "https://api.mapbox.com/mapbox-gl-js/v0.53.0/"),
script = "mapbox-gl.js",
View gist:5a90fd10eb255e978944b319ac850959
num_suffix <- function(x, base = 1000, suffixes = c("K", "M", "B", "T")) {
if (length(suffixes) == 0) {
tibble(
scale_by = rep_len(1, length(x)),
suffix = rep_len("", length(x))
)
}
i <- floor(log(abs(x), base = base))
@jcheng5
jcheng5 / addDynamicTiles.R
Created Jan 19, 2019
Leaflet dynamic tiles
View addDynamicTiles.R
library(shiny)
library(leaflet)
#' Add a tile layer whose source is an R function
#'
#' @param tileFunc A function(x, y, z) that returns a 256x256 image object
#' suitable for passing to `png::writePNG`.
#' @seealso [leaflet::addTiles()] for other parameters
addDynamicTiles <- function(map, tileFunc,
layerId = paste0("leafletRaster", sample.int(9999999, 1)),