I am trying to move an r-Shiny app onto a website using the shinylive package. The app is exported to HTML and it is functional, except that a leaflet map that is embedded in the site does not render visual elements.
The contents of the app.R file:
library(shiny) # 1.8.0
library(tidyverse) # 2.0.0
library(DT) # 0.31
library(leaflet) # 2.2.1
static_dat <- data.frame(
Name = letters,
Level = factor(sample(LETTERS[1:4], 26, replace = T)),
Var1 = runif(26, 0,10),
Attrib1 = sample(c(T,F), 26, replace = T),
Attrib2 = sample(c(T,F), 26, replace = T),
Attrib3 = sample(c(T,F), 26, replace = T),
longitude = -115:-90,
latitude = 26:51
)
# Define UI for app that draws a histogram ----
ui <- shinyUI(fluidPage(
# App title ----
titlePanel("Variables"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
position = "right",
# Sidebar panel for inputs ----
sidebarPanel(
sliderInput(inputId = "minVar1", label = "Minimum Var1:",
step = 0.5, min = 0, max = 10, value = 0),
checkboxGroupInput("attribs", label = "Select Attribs", inline = T,
choices = c("Attrib1", "Attrib2", "Attrib3")),
checkboxGroupInput("levs", "Select levels:",
choices = levels(static_dat$Level),
selected = levels(static_dat$Level)),
plotOutput('plot', height = "300px")
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel("Map", leafletOutput("map", width = "100%", height = "700px")),
tabPanel("Data", DTOutput("tbl"))
)
)
)
))
# Define server logic required to draw a histogram ----
server <- function(input, output, session) {
zoom <- reactive({
ifelse(is.null(input$map_zoom), 5, input$map_zoom)
})
center <- reactive({
if(is.null(input$map_center)){
return(c(40, -100))
}else{
return(input$map_center)
}
})
filt <- reactive({
{filt <- static_dat %>%
filter(Var1 >= input$minVar1,
Level %in% input$levs,
((Attrib1 & "Attrib1" %in% input$attribs) | !("Attrib1" %in% input$attribs)),
((Attrib2 & "Attrib2" %in% input$attribs) | !("Attrib2" %in% input$attribs)),
((Attrib3 & "Attrib3" %in% input$attribs) | !("Attrib3" %in% input$attribs)),
)
}
return(filt)
})
output$plot <- renderPlot({
hist_dat <- filt() %>%
pull(Var1) %>%
as.numeric(.)
hist(hist_dat, xlab = "Var1", main = "Distribution of Var1", xlim = c(0,10))
abline(v = mean(hist_dat), col = 'red', lwd = 1)
abline(v = median(hist_dat), col = 'red', lty = 2, lwd = 1)
legend("topleft", lty = c(1,2), col = 'red', bty = 'n',
legend= c(paste0("Mean = ",sprintf("%.1f", round(mean(hist_dat), 1))),
paste0("Median = ",sprintf("%.1f", round(median(hist_dat), 1)))))
legend("topright", lwd = 0, legend = paste0("n = ",length(hist_dat)),
bty = 'n')
})
output$map <- renderLeaflet({
leaflet(data = filt()) %>%
setView(zoom = zoom(), lat = center()[1], lng = center()[2]) %>%
addTiles() %>%
addMarkers(lng = ~longitude, lat = ~latitude, popup = ~Name) %>%
addProviderTiles("CartoDB.Positron", options = providerTileOptions(noWrap = TRUE))
})
output$tbl <- renderDT({
datatable(data = filt(),
options = list(scrollY = 500,
scrollX = 600,
deferRender = T,
scroller = T,
fixedColumns = F))
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
The whole app works, visuals and all, when running via runApp("./app_folder/")
However, porting to HTML from the console (after loading shinylive and httpuv):
export(appdir = "./app_folder/", destdir = "./docs")
runStaticServer("./docs")
Now the app works serverless, except the visual elements of the map, which just appears as an 'interactive' grey box.
I am perhaps missing a step in compiling this shinylive app or is there a problem with the leaflet tiles?
Update 2024-02-4:
Opening the inspector tool in the browser, there were errors The resource at “https://<street map tile>.png” was blocked due to its Cross-Origin-Resource-Policy header (or lack thereof). I then found this GitHub issue and included the following
Cross-Origin-Embedder-Policy: require-corp
Cross-Origin-Resource-Policy: cross-origin
to the HTML header -- still no success. I am not familiar with HTML or web-dev so any further guidance would be much appreciated. The issue on GitHub is still open and sounds like the developers are also thinking about this.