{"id":346963,"date":"2023-09-21T14:00:00","date_gmt":"2023-09-21T20:00:00","guid":{"rendered":"https:\/\/r.iresmi.net\/posts\/2023\/mountains\/index.html"},"modified":"2023-09-21T14:00:00","modified_gmt":"2023-09-21T20:00:00","slug":"mountains","status":"publish","type":"post","link":"https:\/\/www.r-bloggers.com\/2023\/09\/mountains\/","title":{"rendered":"Mountains"},"content":{"rendered":"\r\n\r\n
\r\n[This article was first published on r.iresmi.net<\/a><\/strong>, and kindly contributed to R-bloggers<\/a>]. (You can report issue about the content on this page here<\/a>)\r\n
Want to share your content on R-bloggers? click here<\/a> if you have a blog, or here<\/a> if you don't.\r\n<\/div>\n \n\n\n\n\n
\n
\n

\"A<\/p>\n

Aconcagua – 6991 m<\/figcaption>\n<\/figure>\n<\/div>\n

If you like mountains, R and T-shirts, I got you covered. Here we use {elevatr} to get a DEM around some well known summits and make a map consisting only of isohypses<\/a>. It produces (sometimes) very nice visualizations.<\/p>\n

And from these designs we can make nice T-shirts. You can buy some on https:\/\/shirt.iresmi.net\/<\/a> and if your favorite mountain is not there, ask me<\/a> and I\u2019ll add it (or make it yourself, of course).<\/p>\n

I intended to automate the process but sadly the Spreadshirt API doesn\u2019t have an upload feature (!?). If you know a better shop, let me know\u2026<\/p>\n

\n
# Config ------------------------------------------------------------------\n\nlibrary(tidyverse)\nlibrary(elevatr)\nlibrary(sf)\n# remotes::install_github("clauswilke\/ggisoband")\nlibrary(ggisoband)\nlibrary(terra)\nlibrary(tidyterra)\nlibrary(glue)\nlibrary(janitor)\nlibrary(memoise)\n\n\n# Parameters --------------------------------------------------------------\n\n# Opentopo API\n# https:\/\/portal.opentopography.org\/myopentopo\n# elevatr::set_opentopo_key("xxx")\n\n\n# Data --------------------------------------------------------------------\n\n# Locations (decimal degrees, WGS84)\nlocations <- tribble(\n  ~name,                     ~lon,       ~lat, ~alti, ~radius, ~iso_interval, ~source,\n  "Aconcagua",         -70.017650, -32.658564,  6961,   10000,           150, "aws",\n  "\u042d\u043b\u044c\u0431\u0440\u0443\u0441",            42.437876,  43.352404,  5643,   10000,           150, "aws",\n  "Macizo Vinson",     -85.617388, -78.525399,  4892,   20000,           150, "aws",\n  "Puncak Jaya",       137.158613,  -4.078606,  4884,   10000,           150, "aws",\n  "Mount Kosciuszko",  148.263510, -36.455832,  2228,   15000,           100, "aws",\n  "K2",                 76.513739,  35.881869,  8611,    5000,           180, "alos")\n \n\n# Area of interest --------------------------------------------------------\n\nbuild_target <- function(lon, lat, radius) {\n    tibble(x = lon, \n           y = lat) |> \n    st_as_sf(coords = c("x", "y"), \n             crs = "EPSG:4326") |> \n    st_buffer(radius) |>\n    st_convex_hull() \n}\n\n#' Get elevation data\n#' \n#' This function is memoised, so that we won't request the data if it has \n#' already been downloaded\n#'\n#' @param target (sf) : area of interest\n#' @param zoom (int) : zoom level ; z = 10 is good, z = 14 max resolution\n#' @param source (char) : \n#'\n#' @return (df) : with x, y, z, coords\nget_elevation <- memoise(\n  function(target, zoom = 10, source = "aws") {\n    get_elev_raster(target, z = zoom, src = source) |> \n      rast() |> \n      fortify() |> \n      rename(z = 3)\n})\n\n#' convert decimal degrees to DMS\n#'\n#' @param coord (vector of num, length=2)\n#'\n#' @return (char) : DD\u00b0MM'SS.SSH\n#'\n#' @examples dec_to_sex(c(1.23, 2.55))\ndec_to_sex <- function(coord) {\n  conv_dec_to_sex <- function(deg_dec, type) {\n    deg <- abs(trunc(deg_dec))\n    min_dec <- (abs(deg_dec) - deg) * 60\n    min <- trunc(min_dec)\n    sec <- round(((min_dec - min) * 60), 2)\n    h <- case_when(deg_dec < 0  & type == "lon" ~ "W",\n                   deg_dec >= 0 & type == "lon" ~ "E",\n                   deg_dec < 0  & type == "lat" ~ "S",\n                   deg_dec >= 0 & type == "lat" ~ "N")\n    sprintf("%02i\u00b0%02i\u2032%.2f\u2033%s", deg, min, sec, h)\n  }\n  glue("{conv_dec_to_sex(coord[2], type = 'lat')} {conv_dec_to_sex(coord[1], type = 'lon')}")\n} \n\n\n# Final plot --------------------------------------------------------------\n\nplot_isolines <- function(name, lon, lat, alti, radius, iso_interval, \n                          zoom = 10, source = "aws") {\n  target <- build_target(lon, lat, radius)\n  target_bbox <- st_bbox(target)\n  \n  p <- get_elevation(target, zoom, source) |> \n    ggplot() +\n    geom_sf(data = target, fill = NA, color = NA) +\n    geom_isobands(aes(x, y, z = z, fill = z),\n                  binwidth = iso_interval, fill = NA) +\n    coord_sf(xlim = target_bbox[c(1, 3)],\n             ylim = target_bbox[c(2, 4)]) +\n    labs(title = glue("{name} \u2014 {alti} m"),\n         subtitle = dec_to_sex(c(lon, lat)),\n         caption = "https:\/\/shirt.iresmi.net\/") +\n    theme_void() +\n    theme(plot.title = element_text(family = "Arial narrow", \n                                    face = "bold", size = 22),\n          plot.title.position = "plot",\n          plot.subtitle = element_text(family = "Arial narrow",\n                                       face = "bold", size = 12),\n          plot.caption = element_text(family = "Arial", size = 9))\n  \n    ggsave(glue("{janitor::make_clean_names(name)}_{alti}_m.png"), p,\n           dpi = 300, width = 20, height = 20, units = "cm")\n}\n\nlocations |> \n  pwalk(plot_isolines, .progress = TRUE)<\/pre>\n<\/div>\n\n\n\n\n\n \n
\r\n
To leave a comment<\/strong> for the author, please follow the link and comment on their blog:  r.iresmi.net<\/a><\/strong>.<\/div>\r\n
\r\nR-bloggers.com<\/a> offers daily e-mail updates<\/a><\/strong> about R<\/a> news and tutorials about learning R<\/a> and many other topics. Click here if you're looking to post or find an R\/data-science job<\/a>.\r\n\r\n
Want to share your content on R-bloggers? click here<\/a> if you have a blog, or  here<\/a> if you don't.\r\n<\/div>","protected":false},"excerpt":{"rendered":"
\n
Aconcagua – 6991 m<\/p>\n
If you like mountains, R and T-shirts, I got you covered. Here we use {elevatr} to get a DEM around some well known summits and make a map consisting only of isohypses. It produces (sometimes) very nice visualizations.
\nAnd…<\/p><\/div>\n
<\/div>\n
<\/div>\n","protected":false},"author":80,"featured_media":0,"comment_status":"closed","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":[],"categories":[4],"tags":[],"aioseo_notices":[],"jetpack-related-posts":[],"amp_enabled":true,"_links":{"self":[{"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/posts\/346963"}],"collection":[{"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/users\/80"}],"replies":[{"embeddable":true,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/comments?post=346963"}],"version-history":[{"count":23,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/posts\/346963\/revisions"}],"predecessor-version":[{"id":377666,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/posts\/346963\/revisions\/377666"}],"wp:attachment":[{"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/media?parent=346963"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/categories?post=346963"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.r-bloggers.com\/wp-json\/wp\/v2\/tags?post=346963"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}