Created
March 16, 2019 15:27
-
-
Save rpodcast/1a7552d5c6269d2fe488ef072ce64cfb to your computer and use it in GitHub Desktop.
POC of rayshader in Shiny
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # Must be executed BEFORE rgl is loaded on headless devices. | |
| options(rgl.useNULL=TRUE) | |
| library(shiny) | |
| library(rgl) | |
| library(rayshader) | |
| library(magrittr) | |
| #Here, I load a map with the raster package. | |
| loadzip = tempfile() | |
| download.file("https://tylermw.com/data/dem_01.tif.zip", loadzip) | |
| localtif = raster::raster(unzip(loadzip, "dem_01.tif")) | |
| unlink(loadzip) | |
| #And convert it to a matrix: | |
| elmat = matrix(raster::extract(localtif,raster::extent(localtif),buffer=1000), | |
| nrow=ncol(localtif),ncol=nrow(localtif)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| xPts <- runif(1000, 0, 1) | |
| yPts <- runif(1000, 0, 1) | |
| zPts <- runif(1000, 0, 1) | |
| shinyServer(function(input, output, session) { | |
| # Expression that generates a rgl scene with a number of points corresponding | |
| # to the value currently set in the slider. | |
| output$sctPlot <- renderRglwidget({ | |
| try(rgl.close()) | |
| ambmat = ambient_shade(elmat) | |
| elmat_3d <- elmat %>% | |
| sphere_shade(texture = "desert") %>% | |
| add_water(detect_water(elmat), color="desert") %>% | |
| add_shadow(ray_shade(elmat,zscale=3,maxsearch = 300),0.5) %>% | |
| add_shadow(ambmat,0.5) %>% | |
| plot_3d(elmat,zscale=10,fov=0,theta=135,zoom=0.75,phi=45, windowsize = c(1000,800)) | |
| render_snapshot() | |
| rglwidget() | |
| }) | |
| }) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| shinyUI(pageWithSidebar( | |
| # Application title | |
| headerPanel("Shiny WebGL!"), | |
| # Sidebar with a slider input for number of points | |
| sidebarPanel( | |
| sliderInput("pts", | |
| "Number of points:", | |
| min = 10, | |
| max = 1000, | |
| value = 250) | |
| ), | |
| # Show the generated 3d scatterplot | |
| mainPanel( | |
| rglwidgetOutput("sctPlot") | |
| ) | |
| )) |
Hi it's great to hear from you! I really enjoyed your amazing talk at rstudio::conf this year 😄
I get that same message in the console when I run the app, but eventually the rendered plot appears in roughly 10 seconds (screenshot below). But it sure seems like the rayshader plot is using either a lot of memory or CPU to get the initial plot rendered. Below is my session info, and I'm running this within RStudio 1.2.1268 on Ubuntu 18.04. I began exploring this combo of rayshader and Shiny when creating my Shiny LEGO mosaic maker but the memory usage caused crashes on shinyapps.io, so I'm still looking for the most optimal solution. Let me know if you'd like any more diagnostics from my end.
> devtools::session_info()
─ Session info ──────────────────────────────────────────────────────────────────────────────────
setting value
version R version 3.6.1 (2019-07-05)
os Ubuntu 18.04.3 LTS
system x86_64, linux-gnu
ui RStudio
language (EN)
collate en_US.UTF-8
ctype en_US.UTF-8
tz America/Indiana/Indianapolis
date 2019-10-22
─ Packages ──────────────────────────────────────────────────────────────────────────────────────
package * version date lib source
assertthat 0.2.1 2019-03-21 [1] CRAN (R 3.5.3)
backports 1.1.5 2019-10-02 [1] CRAN (R 3.6.1)
bmp 0.3 2017-09-11 [1] CRAN (R 3.5.2)
callr 3.3.2 2019-09-22 [1] CRAN (R 3.6.1)
cli 1.1.0 2019-03-19 [1] CRAN (R 3.5.3)
codetools 0.2-16 2018-12-24 [4] CRAN (R 3.5.2)
colorspace 1.4-1 2019-03-18 [1] CRAN (R 3.5.3)
crayon 1.3.4 2017-09-16 [1] CRAN (R 3.5.1)
crosstalk 1.0.0 2016-12-21 [1] CRAN (R 3.5.1)
desc 1.2.0 2018-05-01 [1] CRAN (R 3.5.1)
devtools 2.2.1 2019-09-24 [1] CRAN (R 3.6.1)
digest 0.6.21 2019-09-20 [1] CRAN (R 3.6.1)
doParallel 1.0.15 2019-08-02 [1] CRAN (R 3.6.1)
dplyr 0.8.3 2019-07-04 [1] CRAN (R 3.6.1)
ellipsis 0.3.0 2019-09-20 [1] CRAN (R 3.6.1)
evaluate 0.14 2019-05-28 [1] CRAN (R 3.6.0)
fastmap 1.0.0 2019-08-20 [1] Github (r-lib/fastmap@b104c2c)
foreach 1.4.7 2019-07-27 [1] CRAN (R 3.6.1)
fs 1.3.1 2019-05-06 [1] CRAN (R 3.6.0)
ggplot2 3.2.1 2019-08-10 [1] CRAN (R 3.6.1)
glue 1.3.1 2019-03-12 [1] CRAN (R 3.6.0)
gtable 0.3.0 2019-03-25 [1] CRAN (R 3.5.3)
hms 0.5.1 2019-08-23 [1] CRAN (R 3.6.1)
htmltools 0.4.0 2019-10-04 [1] CRAN (R 3.6.1)
htmlwidgets 1.5 2019-10-04 [1] CRAN (R 3.6.1)
httpuv 1.5.2 2019-09-11 [1] CRAN (R 3.6.1)
igraph 1.2.4.1 2019-04-22 [1] CRAN (R 3.6.0)
imager 0.41.2 2019-01-23 [1] CRAN (R 3.5.2)
iterators 1.0.12 2019-07-26 [1] CRAN (R 3.6.1)
jpeg 0.1-8 2014-01-23 [1] CRAN (R 3.5.2)
jsonlite 1.6 2018-12-07 [1] CRAN (R 3.5.1)
knitr 1.25 2019-09-18 [1] CRAN (R 3.6.1)
later 1.0.0 2019-10-04 [1] CRAN (R 3.6.1)
lattice 0.20-38 2018-11-04 [4] CRAN (R 3.5.1)
lazyeval 0.2.2 2019-03-15 [1] CRAN (R 3.5.3)
magrittr * 1.5 2014-11-22 [1] CRAN (R 3.6.0)
manipulateWidget 0.10.0 2018-06-11 [1] CRAN (R 3.5.2)
markdown 1.1 2019-08-07 [1] CRAN (R 3.6.1)
memoise 1.1.0 2017-04-21 [1] CRAN (R 3.5.1)
mime 0.7 2019-06-11 [1] CRAN (R 3.6.0)
miniUI 0.1.1.1 2018-05-18 [1] CRAN (R 3.5.1)
munsell 0.5.0 2018-06-12 [1] CRAN (R 3.5.1)
packrat 0.5.0 2018-11-14 [1] CRAN (R 3.5.1)
pillar 1.4.2 2019-06-29 [1] CRAN (R 3.6.1)
pkgbuild 1.0.5 2019-08-26 [1] CRAN (R 3.6.1)
pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 3.6.1)
pkgload 1.0.2 2018-10-29 [1] CRAN (R 3.5.1)
plyr 1.8.4 2016-06-08 [1] CRAN (R 3.5.1)
png 0.1-7 2013-12-03 [1] CRAN (R 3.5.1)
prettyunits 1.0.2 2015-07-13 [1] CRAN (R 3.5.1)
processx 3.4.1 2019-07-18 [1] CRAN (R 3.6.1)
progress 1.2.2 2019-05-16 [1] CRAN (R 3.6.0)
promises 1.1.0 2019-10-04 [1] CRAN (R 3.6.1)
ps 1.3.0 2018-12-21 [1] CRAN (R 3.5.2)
purrr 0.3.2 2019-03-15 [1] CRAN (R 3.5.3)
R6 2.4.0 2019-02-14 [1] CRAN (R 3.5.2)
raster 3.0-7 2019-09-24 [1] CRAN (R 3.6.1)
rayshader * 0.11.5 2019-07-11 [1] CRAN (R 3.6.1)
Rcpp 1.0.2 2019-07-25 [1] CRAN (R 3.6.1)
readbitmap 0.1.5 2018-06-27 [1] CRAN (R 3.5.2)
remotes 2.1.0 2019-06-24 [1] CRAN (R 3.6.1)
rgdal 1.4-6 2019-10-01 [1] CRAN (R 3.6.1)
rgl * 0.100.30 2019-08-19 [1] CRAN (R 3.6.1)
rlang 0.4.0.9002 2019-09-29 [1] Github (r-lib/rlang@03bc5ed)
rmarkdown 1.16 2019-10-01 [1] CRAN (R 3.6.1)
rprojroot 1.3-2 2018-01-03 [1] CRAN (R 3.5.1)
rsconnect 0.8.15 2019-07-22 [1] CRAN (R 3.6.1)
rstudioapi 0.10 2019-03-19 [1] CRAN (R 3.5.3)
scales 1.0.0 2018-08-09 [1] CRAN (R 3.5.1)
sessioninfo 1.1.1 2018-11-05 [1] CRAN (R 3.5.1)
shiny * 1.3.2.9001 2019-08-20 [1] Github (rstudio/shiny@e3c1549)
sp 1.3-1 2018-06-05 [1] CRAN (R 3.5.2)
stringi 1.4.3 2019-03-12 [1] CRAN (R 3.6.0)
stringr 1.4.0 2019-02-10 [1] CRAN (R 3.6.0)
testthat 2.2.1 2019-07-25 [1] CRAN (R 3.6.1)
tibble 2.1.3 2019-06-06 [1] CRAN (R 3.6.0)
tidyselect 0.2.5 2018-10-11 [1] CRAN (R 3.5.1)
tiff 0.1-5 2013-09-04 [1] CRAN (R 3.5.2)
usethis 1.5.1 2019-07-04 [1] CRAN (R 3.6.1)
vctrs 0.2.0 2019-07-05 [1] CRAN (R 3.6.1)
webshot 0.5.1 2018-09-28 [1] CRAN (R 3.5.1)
withr 2.1.2 2018-03-15 [1] CRAN (R 3.5.1)
xfun 0.10 2019-10-01 [1] CRAN (R 3.6.1)
xtable 1.8-4 2019-04-21 [1] CRAN (R 3.6.0)
yaml 2.2.0 2018-07-25 [1] CRAN (R 3.6.0)
zeallot 0.1.0 2018-01-28 [1] CRAN (R 3.6.0)
[1] /home/eric/R/x86_64-pc-linux-gnu-library/3.6
[2] /usr/local/lib/R/site-library
[3] /usr/lib/R/site-library
[4] /usr/lib/R/library
I'm glad you liked the talk!!
I was having issues with "rgdal" missing (and it not being on CRAN for 3.6.1) so I couldn't use your rayshader example, so instead I used (from the rayshader GitHub repo):
output$sctPlot <- renderRglwidget({
try(rgl.close())
mtplot = ggplot(mtcars) +
geom_point(aes(x = mpg, y = disp, color = cyl)) +
scale_color_continuous(limits = c(0, 8))
par(mfrow = c(1, 1))
plot_gg(mtplot, width = 3.5, multicore = TRUE, windowsize = c(200, 200),
zoom = 0.85, phi = 35, theta = 30, sunangle = 225, soliddepth = -100)
render_snapshot()
rglwidget()
})It would take 10-20 seconds to render in RStudio but after several minutes still hasn't shown up in shiny. Interestingly if I swap options(rgl.useNULL = TRUE) to FALSE the rayshader image does render but in the wrong window.
I'll keep playing around with this to see what I can do, thanks for the help!
Hey @rpodcast,
I'm wondering if you can share any tips on rendering rayshader objects in Shiny apps more efficiently?
I'm trying to get a couple of maps of Hawaii, so I've adapted the method for {geoviz} and {rayshader} to match your example a bit closer.
However, I still think these objects are much larger than your example above, and when I've tried pushing to shinyapps.io with rsconnect() it's crashing on free tier due to memory.
library(shiny)
library(curl)
library(sf)
library(shinycssloaders)
library(geoviz)
library(rayshader)
library(rgl)
# Must be executed BEFORE rgl is loaded on headless devices.
options(rgl.useNULL=TRUE)
rayshader_layers <- tibble(
rayshader_layer = c("Hawaii", "Maui", "Oahu", "Kauai")
)
# Function for making island maps with Rayshader
rayshade_me <- function(lat = lat, lon = lon, square_km = square_km, max_tiles = max_tiles){
# Get elevation data. Increase max_tiles for a higher resolution image.
# Set max_tiles = 40 to reproduce the example above.
dem <- mapzen_dem(lat, lon, square_km, max_tiles) # for mapzen
# Get a stamen overlay (or a satellite overlay etc. by changing image_source)
overlay_image <-
slippy_overlay(dem,
image_source = "stamen",
image_type = "watercolor",
png_opacity = 0.3,
max_tiles = max_tiles)
# Render the 'rayshader' scene.
elmat = matrix(
raster::extract(dem, raster::extent(dem), buffer=1000),
nrow = ncol(dem),
ncol = nrow(dem)
)
ambmat = ambient_shade(elmat)
elmat %>%
sphere_shade(sunangle = 270, texture = "bw") %>%
add_water(detect_water(elmat), color="desert") %>%
add_shadow(ray_shade(elmat,zscale=3,maxsearch = 300),0.5) %>%
add_shadow(ambmat,0.5) %>%
add_overlay(overlay_image) %>%
plot_3d(elmat,
solid = T,
water = T,
waterdepth = 0,
wateralpha = 0.5,
watercolor = "lightblue",
waterlinecolor = "white",
waterlinealpha = 0.5,
zscale= raster_zscale(dem) / 3,
fov=0,theta=135,zoom=0.75,phi=45, windowsize = c(1000,800))
rglwidget()
}
## Section 2 ____________________________________________________
# set up the user interface
ui <- navbarPage("hinuhinu",
tabPanel("Intro",
fluidPage(
HTML('<meta name="viewport" content="width=1024">'),
h1("The Hawaiian Islands"),
br(),
p(strong(em("\"Eddie Would Go...\""), "Eddie Aikau - Polynesian Voyaging Society")),
br(),
p("There has been a rich history of map making in Hawaii ever since Polynesians rowed in on their outriggers."),
p("The European discovery of Hawaii occurred on January 18, 1778, when English ships under the command of Captain James Cook sighted the islands of Oahu an Kauai.",
"Cook was conducting one of the great exploratory voyages of history and ",
a("mapmaking was an integral part of his work.", href = "https://www.storyofhawaiimuseum.com/the-story-of-hawaii/")),
p("Today with new technological tools and ", a("open data ", href = "https://en.wikipedia.org/wiki/Open_data"), "stunning maps can be created at our fingertips easier then ever."),
p("Play with this interactive tool and find out!"),
br(),
br(),
div(img(src = "intro_figure.png", height = 420, width = 1000), style="text-align: center;"),
br(),
br(),
br(),
div(p(strong("Built by"), a("Matt.0", href = "https://twitter.com/mattoldach"), "using the power of Rstudio and Shiny."),
p(strong("Sources:"), a("State of Hawaii Office of Planning", href = "https://planning.hawaii.gov/gis/download-gis-data/"), "for shapefiles,", a("EarthWorks", href = "https://earthworks.stanford.edu/catalog/stanford-qh711pf3383"), "for rasters"),
style="text-align: right;")
)
),
tabPanel("Island Maps: Rayshader",
fluidPage(sidebarLayout(position = "right",
sidebarPanel( # designates location of following items
wellPanel(style = "background: #E5C595",
h4("Choose Island:"),
htmlOutput("rayshader_selector"))
),
mainPanel(
rglwidgetOutput("plot5") %>% withSpinner(color = "#ad1d28")
)
)
)
),
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
)
)
## Section 3 ____________________________________________________
# server controls what is displayed by the user interface
server <- shinyServer(function(input, output) {
## Sixth tab
output$rayshader_selector <- renderUI({ # creates relief select box object called in ui
data_available <- rayshader_layers
# creates a reactive list of available reliefs based on the island_basemap selection made
selectInput(
inputId = "rayshader_layer", # name of input
label = "", # label displayed in ui
choices = unique(data_available), # calls list of available reliefs
selected = unique(data_available)[1]
)
})
output$plot5 <- renderRglwidget({ # creates a the plot to go in the mainPanel
try(rgl.close())
#try(rgl.close())
max_tiles = 10
# load the basemap for four main islands
if (input$rayshader_layer == "Hawaii") {
# Coordinates for Hawaii
lat = 19.593335
lon = -155.4880287
square_km = 45
rayshade_me(lat = lat, lon = lon, square_km = square_km, max_tiles = max_tiles)
} else if(input$rayshader_layer == "Maui"){
lat = 20.7984
lon = -156.3319
square_km = 30
rayshade_me(lat = lat, lon = lon, square_km = square_km, max_tiles = max_tiles)
} else if(input$rayshader_layer == "Oahu"){
lat = 21.4389
lon = -158.0001
square_km = 30
rayshade_me(lat = lat, lon = lon, square_km = square_km, max_tiles = max_tiles)
} else if(input$rayshader_layer == "Kauai"){
lat = 22.0964
lon = -159.5261
square_km = 30
rayshade_me(lat = lat, lon = lon, square_km = square_km, max_tiles = max_tiles)
}
})
})
## Section 4____________________________________________________
shinyApp(ui = ui, server = server) # need this if combining ui and server into one file.
Any tips you could share would be greatly appreciated!
sessionInfo():
R version 3.6.1 (2019-07-05)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 18.04.3 LTS
Matrix products: default
BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1
locale:
[1] LC_CTYPE=en_CA.UTF-8 LC_NUMERIC=C LC_TIME=en_CA.UTF-8 LC_COLLATE=en_CA.UTF-8 LC_MONETARY=en_CA.UTF-8 LC_MESSAGES=en_CA.UTF-8
[7] LC_PAPER=en_CA.UTF-8 LC_NAME=C LC_ADDRESS=C LC_TELEPHONE=C LC_MEASUREMENT=en_CA.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] rgl_0.100.30 rayshader_0.13.1 geoviz_0.2.1 shinycssloaders_0.2.0 purrr_0.3.3 readr_1.3.1 stringr_1.4.0
[8] colorspace_1.4-1 showtext_0.7 showtextdb_2.0 sysfonts_0.8 ggplot2_3.2.1 dplyr_0.8.3 raster_3.0-7
[15] sp_1.3-2 here_0.1 tibble_2.1.3 sf_0.8-0 curl_4.2 shiny_1.4.0
loaded via a namespace (and not attached):
[1] jsonlite_1.6 foreach_1.4.7 assertthat_0.2.1 rayrender_0.4.2 tiff_0.1-5 yaml_2.2.0
[7] progress_1.2.2 pillar_1.4.2 backports_1.1.5 lattice_0.20-38 glue_1.3.1 digest_0.6.22
[13] manipulateWidget_0.10.0 promises_1.1.0 readbitmap_0.1.5 htmltools_0.4.0 httpuv_1.5.2 plyr_1.8.4
[19] slippymath_0.3.1 pkgconfig_2.0.3 xtable_1.8-4 scales_1.0.0 webshot_0.5.1 jpeg_0.1-8.1
[25] later_1.0.0 withr_2.1.2 lazyeval_0.2.2 magrittr_1.5 crayon_1.3.4 mime_0.7
[31] evaluate_0.14 doParallel_1.0.15 imager_0.41.2 class_7.3-15 tools_3.6.1 prettyunits_1.0.2
[37] hms_0.5.2 bmp_0.3 munsell_0.5.0 compiler_3.6.1 e1071_1.7-2 rlang_0.4.1
[43] classInt_0.4-2 units_0.6-5 grid_3.6.1 iterators_1.0.12 rstudioapi_0.10 htmlwidgets_1.5.1
[49] crosstalk_1.0.0 igraph_1.2.4.1 miniUI_0.1.1.1 rmarkdown_1.16 gtable_0.3.0 codetools_0.2-16
[55] abind_1.4-5 DBI_1.0.0 markdown_1.1 R6_2.4.1 knitr_1.26 rgdal_1.4-7
[61] rgeos_0.5-2 fastmap_1.0.1 zeallot_0.1.0 rprojroot_1.3-2 KernSmooth_2.23-16 stringi_1.4.3
[67] parallel_3.6.1 Rcpp_1.0.3 vctrs_0.2.0 png_0.1-7 tidyselect_0.2.5 xfun_0.11
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Hi! When I run this I get the error:
The shiny UI runs, but not rayshader is rendered. Do you have any idea what I might be doing incorrectly? Thanks!