Skip to content

Instantly share code, notes, and snippets.

@helgasoft
Last active Sep 12, 2022
Embed
What would you like to do?
Bathymetry demo with echarty
#' echarty demo for marmap
library(shiny)
library(shinydashboard)
library(shinybusy)
library(echarty) # v.1.4.7+
library(marmap)
ui = dashboardPage(title='marmap', dashboardHeader(title='Bathymetry Demo'),
sidebar = dashboardSidebar(
fluidRow( column(12,
selectInput('locat', 'Load data',
choices = c("Choose one"='','Hawaii','NW.Atlantic','NW + metallo','Florida','Aleutians','Celt')),
checkboxInput('amp', 'add marmap 2D plot', value=FALSE),
radioButtons('proj', '3D projection',
choices=c('orthographic','perspective')),
radioButtons('type', 'Chart type',
choices=c('surface','scatter3D')),
selectInput('elev', 'Land elev. max',
choices = c('cut to:'='',50,100,500,1000))
)),
fluidRow( column(12, align = "center",
htmlOutput("nrow"), br(),br(),
actionButton("info", label=tags$img(src ="https://img.icons8.com/metro/2x/info.png", alt='Help', width= '30')),
div(span('Made with '),tags$a(href="https://github.com/ericpante/marmap", "marmap"),
br(),span('and '), tags$a(href="https://github.com/helgasoft/echarty", "echarty"))
)
)
),
body = dashboardBody(
ecs.output('bathy3D', height='480px'),
add_busy_spinner(spin = "fading-circle", margins=c(100, 100)), #position='full-page'),
plotOutput("mmp")
)
)
server = function(input, output, session) {
lolarat <- function(df) {
# ratio longitude/latitude for cartesian display
if (is.null(df)) return(NULL)
lon <- range(df$x)
lat <- range(df$y)
dx <- lon[2]-lon[1]
dy <- lat[2]-lat[1]
dx/dy # ratio
}
arg <- NULL
datu <- reactive({
arg$ztop <<- 9999
amp <- isolate(input$amp)
elev <- isolate(input$elev)
choice <- tolower(input$locat)
if (startsWith(choice, 'nw')) choice <- 'nw'
tmp <- switch(choice,
hawaii = { arg$ztop <<- 100; data(hawaii);
fortify.bathy(hawaii) },
#tt <- fortify.bathy(hawaii); tt[1:8970,] }, # or 14950 = faster
florida = { arg$ztop <<- 1; data(florida);
fortify.bathy(florida) },
celt = { arg$ztop <<- 21; data(celt);
fortify.bathy(celt) },
aleutians = { data(aleutians);
fortify.bathy(aleutians) },
nw = { arg$ztop <<- 5; data(nw.atlantic);
tt <- nw.atlantic; colnames(tt) <- c('x','y','z');
tt } # [10000:20000,]
)
arg$ratio <<- lolarat(tmp)
if (!is.null(tmp)) {
output$nrow <- renderUI({
HTML(paste(input$locat,'=', nrow(tmp), 'points',
'<br/>lon/lat ratio =',round(arg$ratio,3)) ) })
if (amp) output$mmp <- renderPlot({
mmplot(tmp, input$locat)
})
if (elev!='') {
mm <- as.numeric(elev)
tmp[which(tmp$z > mm),]$z <- mm # cut some land elevations as inaccurate
}
}
tmp
})
mmplot <- function(tmp, choice) {
if (grepl('metal', choice)) {
# from ?metallo example:
plot(as.bathy(tmp), deep=c(-8000,-4000,0), shallow=c(-4000,-500,0), step=c(500,500,0),
lwd=c(0.5,0.5,1.5),lty=c(1,1,1),
col=c("grey80", "grey20", "blue"),
drawlabels=c(FALSE,FALSE,FALSE) )
points(metallo, cex=1.5, pch=19,col=rgb(0,0,1,0.5))
} else
plot(as.bathy(tmp), image=TRUE)
}
output$bathy3D <- ecs.render({
tmp <- datu()
if (is.null(tmp)) return(NULL)
afor <- htmlwidgets::JS("function(val){ return Math.round(val * 100) / 100;}")
dname <- isolate(input$locat)
series <- list(
list(type=input$type, wireframe=list(show=FALSE), symbolSize=2, data= ec.data(tmp))
)
if (grepl('metal', dname)) {
data(metallo); tt <- metallo;
colnames(tt) <- c('x','y','z'); tt$z <- -tt$z
series <- append(series, list(list(
type='scatter3D', symbolSize=10,
# color taken by visualMap, set border instead
itemStyle = list(borderWidth=3, borderColor='magenta',opacity=1),
data = ec.data(tt) )))
}
ec.init(load='3D', title=list(text= dname),
xAxis3D= list(scale=TRUE, name='Longitude',axisLabel=list(formatter=afor),
min=round(min(tmp$x)), max=round(max(tmp$x))),
yAxis3D= list(scale=TRUE, name='Latitude', axisLabel=list(formatter=afor),
min=round(min(tmp$y)), max=round(max(tmp$y))),
zAxis3D= list(name='Depth'), # min=min(tmp$z)-1000, max=max(tmp$z)+1000, # flatten somewhat, too excessive
grid3D= list( viewControl=list(projection = input$proj),
boxWidth = 100 * arg$ratio, boxHeight=100, boxDepth=100),
visualMap= list(inRange=list(color=rev(rainbow(7))), calculable=TRUE,
min=min(tmp$z), max=max(tmp$z), dimension=2,
itemHeight=380, itemWidth=18, range=c(min(max(tmp$z),arg$ztop), min(tmp$z))),
toolbox= list(feature= list(saveAsImage= list(backgroundColor= '#111'))),
series= series
)
})
observeEvent(input$amp, {
if (input$amp) {
if (!is.null(datu()))
output$mmp <- renderPlot({ mmplot(datu(), input$locat) })
} else
output$mmp <- renderPlot({ NULL })
})
observeEvent(input$info, {
showModal(modalDialog(
title = "Bathymetry in 3D interactive",
tags$div("Presenting ",strong('marmap')," bathymetry data in 3D with ",
tags$a(href="https://github.com/helgasoft/echarty", "echarty")," - a visualization library based on JavaScript library ",tags$a(href="https://echarts.apache.org","ECharts"),
br(),"3D plots support zoom in/out and XYZ rotation. Color bar shows current depth on mouse hover, and can show/hide depth levels.",
tags$ul(
tags$li("Dropdown ",tags$em('Load data')," contains all marmap datasets sorted by size."),
tags$li("Checkbox ",tags$em('add marmap 2D plot')," will display 2D plots for comparison."),
tags$li("Dropdown ",tags$em('Land elev.max'),", if used, has to be set before ",tags$em('Load data'),". It limits dry land elevations to the selected value. It also changes the coloring since less elevation values match the same amount of colors.")
#It is the only parameter which will not change the plot instantly
),
"Notes:",
br(),"When the ",strong('color slider')," overlaps a (zoomed) map, it does not respond to mouse clicks. Probably a bug in ECharts - workaround is to zoom out until the slider separates from the map.",
br(),"Dry land elevations in bathymetry data look random. In some examples we preset the color slider top to a certain value. This shows coastlines more clearly.",
br(),br(),"Comments are welcome here in the gist, or in ",tags$a(href="https://github.com/helgasoft/echarty/issues", "echarty"),"."
)
))
})
}
if (interactive()) shinyApp(ui,server)
@helgasoft
Copy link
Author

helgasoft commented Jan 20, 2022

Here is a simple 3D surface display (inquiry by @nvelden)

library(echarty)
data(volcano)
ec.init(load='3D',
   series= list(list(
	type = 'surface'
	,data = ec.data(as.data.frame(as.table(volcano)), 'values')
	,wireframe= list(show= FALSE)
	,shading= 'realistic', realisticMaterial= list(metalness= 0.5, roughness= 0.6)
   )),
   visualMap= list(calculable=TRUE, dimension=2, inRange=list(color= rev(rainbow(10))) ),
   grid3D= list(viewControl= list(autoRotate= TRUE))
)

image

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