Merge pull request #48 from BalintKomjati/master

Added 3D elevation plot - Fixes #47

.github/workflows/check.yaml

@@ -15,12 +15,12 @@ jobs:
           - {os: windows-latest, r: 'release'}
           - {os: macOS-latest, r: 'release'}
           - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
-          - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest", http-user-agent: "R/4.1.0 (ubuntu-20.04) R (4.1.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" }
 
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
       RSPM: ${{ matrix.config.rspm }}
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      RGL_USE_NULL: true
 
     steps:
       - uses: actions/checkout@v2
@@ -34,15 +34,11 @@ jobs:
       - name: Install system dependencies
         if: runner.os == 'Linux'
         run: |
-          sudo apt-get install -y libicu-dev libxml2-dev libcurl4-openssl-dev
+          sudo apt-get install -y libicu-dev libxml2-dev libcurl4-openssl-dev libmagick++-dev libgdal-dev libgeos-dev libproj-dev
 
-      - name: "Install dependencies"
-        run: |
-          install.packages("remotes")
-          remotes::install_github("AtherEnergy/ggTimeSeries", dependencies = TRUE)
-          remotes::install_deps(dependencies = TRUE)
-          remotes::install_cran("rcmdcheck")
-        shell: Rscript {0}
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: rcmdcheck
 
       - uses: r-lib/actions/check-r-package@v1
 

DESCRIPTION

@@ -13,7 +13,11 @@ Authors@R:
     person(given = "Megan",
            family = "Beckett",
            role = c("ctb"),
-           email = "[email protected]"))
+           email = "[email protected]"),
+    person(given = "Bálint",
+           family = "Komjáti",
+           role = c("ctb"),
+           email = "[email protected]"))
 Description: Creates artistic visualisations with Strava data.
 Depends: 
     R (>= 3.4.3),
@@ -34,7 +38,12 @@ Imports:
     packcircles,
     ggforce,
     tidyr,
-    viridis
+    viridis,
+    rayshader,
+    geoviz,
+    magick,
+    raster,
+    terra
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true

NAMESPACE

@@ -2,6 +2,7 @@
 
 export("%>%")
 export(gpx_example)
+export(plot_3D)
 export(plot_calendar)
 export(plot_elevations)
 export(plot_facets)
@@ -10,11 +11,18 @@ export(plot_packed_circles)
 export(plot_ridges)
 export(process_data)
 import(dplyr)
+import(geoviz)
 import(ggplot2)
 import(gtools)
+import(magick)
 import(mapproj)
+import(rayshader)
 importFrom(ggTimeSeries,ggplot_calendar_heatmap)
 importFrom(magrittr,"%>%")
+importFrom(raster,extent)
+importFrom(raster,extract)
+importFrom(raster,raster)
+importFrom(raster,writeRaster)
 importFrom(stats,end)
 importFrom(stats,start)
 importFrom(stats,time)

R/plot_3D.R

@@ -0,0 +1,149 @@
+#' Create 3D interactive elevation map from gpx tracklogs
+#'
+#' @param tracklog_file A path to a gpx file to be read by strava::process_data.
+#' If the file covers a big area plot_3D() can slow down significantly.
+#' @param cache_folder Directory to store the downloaded elevation data and overlay image for reuse
+#' @param elevation_scale Horizontal vs vertical ratio of the plot. Could be estimated with geoviz::raster_zscale(dem).
+#' @param elevation_scale_tracklog_corr Raises elevation_scale for the tracklog by the specified percentage.
+#' Useful if tracklog occasionally disappears into the ground.
+#' @param buffer_around_tracklog_km Buffer distance around the tracklog in km. Scene is cut outside this.
+#' @param render_high_quality If set to TRUE the function downloads higher resolution elevation and overlay data.
+#' All steps are very time and resource consuming.
+#' @param sunangle The direction of the light source of the scene
+#' @param sunaltitude The angle, in degrees (as measured from the horizon) from which the light originates.
+#' @param color_tracklog Color of the tracklog on the scene.
+#' @param color_background Color of the scene's background.
+#' @param water_detect If set to TRUE rayshader will look for flat surfaces in the scene and render them in blue
+#'
+#' @export
+#' @import geoviz rayshader magick
+#' @importFrom raster raster writeRaster extract extent
+#'
+#' @examples
+#' \dontrun{
+#' # Generate a built in demo by simply running
+#' strava::plot_3D()
+#' }
+plot_3D <- function(
+                     tracklog_file = "gpx/mtb",
+                     cache_folder = "~/cache_plot_3D",
+                     elevation_scale = 6, #
+                     elevation_scale_tracklog_corr = .01,
+                     buffer_around_tracklog_km = 1,
+                     render_high_quality = FALSE,
+                     sunangle = 250,
+                     sunaltitude = 75,
+                     color_tracklog = 'blue',
+                     color_background = 'lightskyblue1',
+                     water_detect = FALSE
+                    ) {
+
+  if (!file.exists(cache_folder)) dir.create(cache_folder)
+  dem_file     <- paste0(cache_folder, "/dem"          ,if(render_high_quality) "_hq")
+  overlay_file <- paste0(cache_folder, "/overlay_image",if(render_high_quality) "_hq", ".rds")
+
+
+  message("Reading the tracklog")
+  tracklog <- strava::process_data(system.file(tracklog_file, package = "strava"))
+
+
+  if( paste0(dem_file,".gri") %>% file.exists() ) {
+
+    message("Loading Digital Elevation Model (DEM) from disk")
+    dem <- raster::raster(dem_file)
+
+  } else {
+
+    message("Downloading Digital Elevation Model (DEM)")
+    dem <- geoviz::mapzen_dem(lat  = tracklog$lat,
+                              long = tracklog$lon,
+                              max_tiles = if(render_high_quality) 100 else 10)
+
+    # Downloaded DEM tiles cover a larger area so we crop them to fit the tracklog
+    message("Cropping DEM")
+    dem <- geoviz::crop_raster_track(dem,
+                                     lat  = tracklog$lat,
+                                     long = tracklog$lon,
+                                     width_buffer = buffer_around_tracklog_km)
+
+    message("Saving DEM to disk")
+    raster::writeRaster(x = dem, filename = dem_file, overwrite = TRUE)
+
+  }
+
+
+  message("Calculating elevation matrix")
+  elmat <- matrix(
+    raster::extract(dem, raster::extent(dem), method = 'bilinear'),
+    nrow = ncol(dem),
+    ncol = nrow(dem)
+    )
+
+
+  if( overlay_file %>% file.exists() ) {
+
+    message("Loading overlay image from disk")
+    overlay_image <- readRDS(overlay_file)
+
+  } else {
+
+    message("Downloading overlay image")
+    overlay_image <- geoviz::slippy_overlay(
+      dem,
+      image_source = "stamen",
+      image_type = "terrain",
+      max_tiles = if(render_high_quality) 500 else 10,
+      return_png = T,
+      png_opacity = 0.5)
+    saveRDS(overlay_image, overlay_file)
+  }
+
+
+  message("Calculating the scene")
+
+  scene <- elmat %>%
+    rayshader::sphere_shade(sunangle = sunangle) %>%
+    { if (water_detect) rayshader::add_water(rayshader::detect_water(elmat), color = "lightblue") else . } %>%
+    rayshader::add_shadow(rayshader::ray_shade(elmat,
+                                               sunangle = sunangle,
+                                               sunaltitude = sunaltitude,
+                                               zscale = elevation_scale,
+                                               multicore = FALSE),
+                          max_darken = 0.2) %>%
+    rayshader::add_shadow(rayshader::lamb_shade(elmat,zscale = elevation_scale, sunaltitude = 3),
+                          max_darken = 0.5) %>%
+    rayshader::add_overlay(overlay_image, alphalayer = .6)
+
+
+  message("Plotting the scene")
+
+  rayshader::plot_3d(
+    scene,
+    elmat,
+    zscale = elevation_scale,
+    #baseshape = 'circle',
+    zoom = 0.8,
+    fov = 10,
+    mouseMode = c("none", "trackball", "zoom", "none", "zoom"),
+    #windowsize = c(854,480),
+    shadowcolor = 'grey10',
+    background = color_background,
+    triangulate = F
+    )
+
+
+  message("Adding tracklog to the scene")
+
+  geoviz::add_gps_to_rayshader(
+    dem,
+    tracklog$lat,
+    tracklog$lon,
+    #tracklog$ele,
+    clamp_to_ground = TRUE,
+    line_width = 3,
+    lightsaber = FALSE,
+    alpha = .9,
+    colour = color_tracklog,
+    zscale = elevation_scale/(1+elevation_scale_tracklog_corr)
+  )
+}