data-raw/sf_brain_outer.R

#' Sagital view of an adult human brain.
#'
#' Ideal for visualizing gene expression data from the Brainspan developmental
#' transcriptome or GTEx.
#'
#' @format A simple feature collection with 16 features and 7 fields
#' \describe{
#'   \item{id}{short name of brain region}
#'   \item{lab_x}{x coordinate of manual region label}
#'   \item{lab_y}{y coordinate of manual region label}
#'   \item{line_x}{x coordinate of line pointing to manual region label}
#'   \item{line_y}{y coordinate of line pointing to manual region label}
#'   \item{line_xend}{x coordinate of line pointing to region}
#'   \item{line_yend}{y coordinate of line pointing to  region}
#'   \item{geometry}{the sf shape corresponding to the region}
#' }
#'
#' @source \href{https://www.gnu.org/licenses/gpl-3.0.en.html}{GPL-3.0} by \url{https://github.com/ethanbahl/cerebroViz}
#'
#' @concept brain
#' @concept human
#'
#' @family brains
#'
#' @examples
#' require(sf)
#' sf_brain <- sffs::sf_brain_outer
#' plot(sf_brain['id'], key.length = 1)
"sf_brain_outer"

require(devtools)
require(usethis)
require(tidyverse)
require(here)
require(xml2)
require(sf)

#### Path to svg ####
### Be sure to use `here()` ###
name <- "sf_brain_outer"
input_dir <- here("data-raw", name)
input_svg <- here("data-raw", name, str_c(name, ".svg"))

#### convert SVG to geoJSON ####
###  requires the external node-based application `svg2geojson` ###
sf <- paste0("svg2geojson -o ", input_svg) %>%
  system(intern = TRUE) %>%
  paste0(collapse = " ") %>%
  st_read()

###  and ensure it is valid ####
sf <- st_make_valid(sf)

#### extract geometry IDs         ####
#### could also be added manually ####
xml_file <- read_xml(input_svg) %>%
  xml_children()
ids <- xml_file[xml_name(xml_file) == 'path'] %>%
  xml_attr('class')

sf <- sf %>%
  mutate(id = ids) %>%
  select(id, geometry)

#### add label positions ####
sf_labels <- tribble(~id, ~lab_x, ~lab_y, ~line_x, ~line_y, ~line_xend, ~line_yend,
                     "M1C",  0.58,    1.02,  0.58,    1.00,      0.58,        0.80,
                     "OFC",  0.93,    0.33,  0.90,    0.34,      0.80,        0.48,
                     "VFC",  1.01,    0.58,  0.98,    0.58,      0.88,        0.58,
                     "DFC",  0.91,    0.89,  0.88,    0.88,      0.78,        0.70,
                     "V1C", -0.03,    0.54,  0.01,    0.54,      0.10,        0.54,
                     "IPC",  0.12,    0.84,  0.15,    0.84,      0.35,        0.75,
                     "S1C",  0.46,    1.00,  0.46,    0.98,      0.51,        0.78,
                     "A1C",  0.25,    0.95,  0.25,    0.93,      0.50,        0.65,
                     "ANG", -0.01,    0.64,  0.03,    0.64,      0.28,        0.64,
                     "ITC",  0.74,    0.28,  0.71,    0.28,      0.58,        0.38,
                     "STC",  0.04,    0.75,  0.07,    0.75,      0.38,        0.64,
                     "CB",  0.10,    0.20,  0.12,    0.21,      0.30,        0.32,
                     "MED",  0.56,    0.15,  0.52,    0.15,      0.40,        0.20,
                     "PON",  0.59,    0.26,  0.55,    0.26,      0.49,        0.33
)

sf <- left_join(sf, sf_labels)

#### write out the simple features ###
write_sf(sf, gsub(".svg", ".geojson", input_svg))

#### Final assignment and export of data ####
assign(name, sf)
usethis::use_data(sf_brain_outer, overwrite = TRUE)
tkoomar/sffs documentation built on July 6, 2020, 9:36 a.m.