Skip to content

Instantly share code, notes, and snippets.

@mdsumner
Created February 19, 2020 20:52
Show Gist options
  • Save mdsumner/da1cec89b3f190e6714a0fec54eee7c8 to your computer and use it in GitHub Desktop.
Save mdsumner/da1cec89b3f190e6714a0fec54eee7c8 to your computer and use it in GitHub Desktop.
tm <- quadmesh::triangmesh(volcano)
xyzg <- tibble::tibble(x = tm$vb[1, tm$it], 
                       y = tm$vb[2, tm$it], 
                       z = tm$vb[3, tm$it], 
                       g = rep(seq_len(ncol(tm$it)), each = nrow(tm$it)))
library(ggplot2)
ggplot(xyzg, aes(x, y, group = g, fill = z)) + 
  geom_polygon()

Created on 2020-02-19 by the reprex package (v0.3.0)

@mdsumner
Copy link
Author

  u <- "http://www.ifremer.fr/web-com/nraillard/files/example.RData"
f <- "example.RData"
download.file(u,f,mode= "wb")

## should really be named .rds
x <- readRDS("example.RData")
plot(x$lon, x$lat, pch = ".", col = colourvalues::colour_values(x$hs))
## we can plot raw polygons, but it's not very gratifying
polygon(cbind(x$lon, x$lat)[rbind(x$tri, NA), ])

library(ggplot2)

library(dplyr)

d <- tibble::tibble(lon = x$lon, lat = x$lat, 
                    hs = x$hs) %>% 
  dplyr::slice(as.vector(x$tri)) %>% 
  dplyr::mutate(g = (dplyr::row_number() - 1) %/% 3)



## do a bit of filtering so we can see quickly (some triangles will be broken)
ggplot(d %>% dplyr::filter(between(lon, -4, -2), 
                           between(lat, 46, 48)))  + 
  geom_polygon(aes(lon, lat, group = g, fill= hs))

## get brave, draw everything
#ggplot(d)  + 
#  geom_polygon(aes(lon, lat, group = g, fill= hs))

Created on 2020-02-20 by the reprex package (v0.3.0)

@mdsumner
Copy link
Author

with rgl

x <- readRDS("example.RData")
library(rgl)
tm <- tmesh3d(rbind(x$lon, x$lat, x$hs, 1), x$tri)
wire3d(tm)
aspect3d(1, 1, 0.1)

## add colour
tm$material$color <- colourvalues::colour_values(tm$vb[3, ])
shade3d(tm)  ## adds to the wire plot

image

@mdsumner
Copy link
Author

A bit more fancy with a background map

u <- "http://www.ifremer.fr/web-com/nraillard/files/example.RData"
f <- "example.RData"
download.file(u,f,mode= "wb")

## should really be named .rds
x <- readRDS("example.RData")

library(rgl)
im <- ceramic::cc_location(raster::extent(range(x$lon), range(x$lat)) + 20, type = "mapbox.light", zoom = 7)
xy <- reproj::reproj(cbind(x$lon, x$lat), source = 4326, target = raster::projection(im))[,1:2]

qm <- quadmesh::quadmesh(raster::aggregate(im[[1]] * 0, fact = 10), texture = im)
qm$material$color <- "white"
tm <- tmesh3d(rbind(xy[,1], xy[,2], x$hs, 1), x$tri)
tm$material$color <- colourvalues::colour_values(tm$vb[3, ])
clear3d()
shade3d(tm)
shade3d(qm)
aspect3d(1, 1, 0.02)

image

@NRaillard
Copy link

capabilities()

jpeg png tiff tcltk X11 aqua http/ftp sockets libxml fifo cledit iconv NLS profmem cairo ICU long.double libcurl
TRUE TRUE TRUE TRUE FALSE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE

@NRaillard
Copy link

x <- readRDS(url("http://www.ifremer.fr/web-com/nraillard/files/example.rds"))
library(rgl)
im <- ceramic::cc_location(raster::extent(range(x$lon), range(x$lat)) + 20, type = "mapbox.light", zoom = 7)
xy <- reproj::reproj(cbind(x$lon, x$lat), source = 4326, target = raster::projection(im))[,1:2]

qm <- quadmesh::quadmesh(raster::aggregate(im[[1]] * 0, fact = 10), texture = im)
qm$material$color <- "white"
tm <- tmesh3d(rbind(xy[,1], xy[,2], x$hs, 1), x$tri)
tm$material$color <- colourvalues::colour_values(tm$vb[3, ])
clear3d()
shade3d(tm)
shade3d(qm)
aspect3d(1, 1, 0.02)

Warning messages:
1: In rgl.material(...) : RGL: Pixmap load: file format unsupported
2: In rgl.material(...) : RGL: Pixmap load: failed

@mdsumner
Copy link
Author

thanks for this, that's definitely new to me - can you check the file that is created by

qm <- quadmesh::quadmesh(raster::aggregate(im[[1]] * 0, fact = 10), texture = im)

there's a message when you run it, and it's available as

qm$material$texture

Can you view that file?

BTW, the zoom arg in ceramic really needs a warning - it should only be used interactively, i.e. don't set it the first time, then do set it but increase the value a, by 1 or 2 (not 5 or 6) (To avoid massive downloads).

It's different for DEMs vs images, and I really don't know how to arrange the use properly ...

@NRaillard
Copy link

Yes I can see the file, which is quite big !

file51ac3801d1d

@mdsumner
Copy link
Author

Ah that might be the problem, I should have warned about the ceramic download problem - basically, don't set zoom (one will be chosen), but then go back and increase the value by 1 or 2 (to get more detail in the texture).

It might work if you turn off the zoom setting, though it will be simplistic image

@NRaillard
Copy link

I still have the same error, without the zoom option (defaulting to 4) and when inceasing to 5 ou 6...

However, it's not that important, I already have what I wanted... and even beyond !

@mdsumner
Copy link
Author

Cool, appreciated!

(Great data!)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment