RStudio session crashes on demo example

[leungi]

RStudio crashes when running demo example (from https://www.r-spatial.org//r/2017/06/09/mapedit_0-2-0.html/).

Tried to get trace with options(shiny.fullstacktrace = TRUE), but RStudio crashing doesn't allow inspecting trace.

Demo example:

# make the coordinates a numeric matrix
qk_mx <- data.matrix(quakes[,2:1])
# convert the coordinates to a multipoint feature
qk_mp <- st_multipoint(qk_mx)
# convert the multipoint feature to sf
qk_sf <- st_sf(st_cast(st_sfc(qk_mp), "POINT"), quakes, crs=4326)

# make a grid
grd <- st_set_crs(st_make_grid(qk_sf), 4326)
# only keep grid polygons that contain at least one quake point
grd <- grd[which(sapply(st_contains(st_sf(grd), qk_sf),length)>0)]

ui <- fluidPage(
  fluidRow(
    column(
      6,
      h3("Select Grid"),
      # our new select module ui
      selectModUI("selectmap")
    ),
    column(
      6,
      h3("Selected Quakes"),
      plotOutput("selectplot")
    )
  ),
  fluidRow(
    h3("Magnitude Distribution of Selected Quakes"),
    plotOutput("quakestat", height=200)
  )
)
server <- function(input, output, session) {
  # our new select module
  g_sel <- callModule(
    selectMod,
    "selectmap",
    leaflet() %>%
      addTiles() %>%
      addFeatures(st_sf(grd), layerId = ~seq_len(length(grd)))
  )
  
  rv <- reactiveValues(intersect=NULL, selectgrid=NULL)
  
  observe({
    # the select module returns a reactive
    #   so let's use it to find the intersection
    #   of selected grid with quakes points
    gs <- g_sel()
    rv$selectgrid <- st_sf(
      grd[as.numeric(gs[which(gs$selected==TRUE),"id"])]
    )
    if(length(rv$selectgrid) > 0) {
      rv$intersect <- st_intersection(rv$selectgrid, qk_sf)
    } else {
      rv$intersect <- NULL
    }
  })
  
  output$selectplot <- renderPlot({
    plot(qk_mp, col="gray")
    if(!is.null(rv$intersect)) {
      plot(rv$intersect, pch=19, col="black", add=TRUE)      
    }
    plot(st_union(rv$selectgrid), add=TRUE)
  })
  
  output$quakestat <- renderPlot({
    plot(
      stats::density(qk_sf$mag), col="gray30", ylim=c(0,1.2),
      main = NA
    )
    if(!is.null(rv$intersect) && nrow(rv$intersect) > 0) {
      lines(stats::density(rv$intersect$mag), col="red", lwd=2)
    }
  })
}
shinyApp(ui, server)

SessionInfo:

#> R version 3.5.1 (2018-07-02)
#> Platform: x86_64-w64-mingw32/x64 (64-bit)
#> Running under: Windows 10 x64 (build 17134)
#> 
#> Matrix products: default
#> 
#> locale:
#> [1] LC_COLLATE=English_United States.1252 
#> [2] LC_CTYPE=English_United States.1252   
#> [3] LC_MONETARY=English_United States.1252
#> [4] LC_NUMERIC=C                          
#> [5] LC_TIME=English_United States.1252    
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#> [1] leaflet_2.0.2 sf_0.7-4      shiny_1.3.2   mapedit_0.5.0 mapview_2.7.1
#> 
#> loaded via a namespace (and not attached):
#>  [1] Rcpp_1.0.1.3       compiler_3.5.1     later_0.8.0       
#>  [4] highr_0.8          class_7.3-15       base64enc_0.1-3   
#>  [7] tools_3.5.1        digest_0.6.19      viridisLite_0.3.0 
#> [10] satellite_1.0.1    evaluate_0.14      lattice_0.20-38   
#> [13] png_0.1-7          DBI_1.0.0          crosstalk_1.0.0   
#> [16] yaml_2.2.0         xfun_0.7           e1071_1.7-2       
#> [19] stringr_1.4.0      knitr_1.22.8       raster_2.9-5      
#> [22] htmlwidgets_1.3    webshot_0.5.1      stats4_3.5.1      
#> [25] classInt_0.3-3     grid_3.5.1         R6_2.4.0          
#> [28] rmarkdown_1.13     sp_1.3-1           magrittr_1.5      
#> [31] units_0.6-3        scales_1.0.0       promises_1.0.1    
#> [34] codetools_0.2-16   htmltools_0.3.6    mime_0.6          
#> [37] xtable_1.8-4       colorspace_1.4-1   httpuv_1.5.1      
#> [40] KernSmooth_2.23-15 stringi_1.4.3      munsell_0.5.0