R - Перевод рекурсивно разделенных областей в координаты XY для ggplot2 хлороплета

Question

Я разработал решение для этого, но это уродливо, ad hoc и не поддается генерализации; Я предполагаю, что должен быть лучший способ. Наша область исследования разделена на сетку блоков размером 100 х 100 м, столбцы с именами от 3 до 8 и строки с именами CJ. Каждый блок делится на четыре квадрата, а каждый квадрат - на четыре субквадрата, поэтому имя субкадра будет примерно таким: "4F23"; шаблон деления выглядит следующим образом:

11 12 21 22

13 14 23 24

31 32 41 42

33 34 43 44

Различные наборы данных используют любое из трех разрешений, поэтому я хочу что-то, что может иметь дело с "4F", "4F1" и "4F34". Чтобы показать значения в тепловой карте / хлороплете области, мне нужен способ представить эту вложенную схему более ортогонально ggplot - или лучше сказать ggplot что-то, чтобы он знал, как интерпретировать метки разделов сам. То, что я хочу, - это простой способ составить карту любого из наших исследований. Лучшее, что я мог придумать, - это использовать функцию перевода для генерации XY и связывания их с фреймом данных.

toyDF <- tibble(SECT = c('3E1', '5G3', '8H4'), HT = c(22,6,15))
# Translator function
SACoords <- function(sqr) {
    sqVec <- substring(sqr, seq(1, nchar(sqr), 1), seq(1, nchar(sqr), 1))
    rws <- 'JIHGFEDC'
    cl <- (as.integer(sqVec[1]) - 3) * 100
    rw <- (as.integer(gregexpr(sqVec[2], rws)) - 1) * 100
    qd <- ifelse(!is.na(sqVec[3]), 
        list(c(0,50), c(50,50), c(0,0), c(50,0))[as.integer(sqVec[3])],
        c(0,0))
    sq <- ifelse(!is.na(sqVec[4]), 
        list(c(0,25), c(25,25), c(0,0), c(25,0))[as.integer(sqVec[4])],
        c(0,0))
    coords <- data.frame(c(cl, rw), qd, sq)
    rowSums(coords, na.rm=TRUE)
}
#> SACoords('8C24')  # Test
#[1] 575 750  # Yes

# Mash in the coordinates (as lists)
toyXY <- toyDF %>% 
    mutate(coords = sapply(SECT, SACoords, simplify=FALSE))
# Got the coords in, but as lists -- difficult to work with;
# but can't mutate() into two columns with one operation, so
# redo it this ungainly way:
toyXY[,4:5] <- matrix(unlist(sapply(toyDF$SECT, SACoords)), 
    ncol=2, byrow=TRUE)
names(toyXY)[4:5] <- c('Xcoor', 'Ycoor')

# And finally to plot (in reality many observations per SECT)
toyXY %>% group_by(SECT) %>%
    mutate(MHT = mean(HT)) %>%
    ggplot(aes(xmin=Xcoor, xmax=Xcoor + 50, ymin=Ycoor, ymax=Ycoor+50)) +
        geom_rect(aes(fill = MHT))

С полным набором данных это производит именно то, что я хочу, но это ужасно. Что я хотел бы больше всего (я думаю) для моего SACoords() быть преобразованием, которое я могу подключить к ggplot(aes()) позвоните, чтобы он будет эффективно понимать SECT ярлыки, надеюсь, позволив мне использовать geom_raster вместо geom_rect и избегайте xmin/xmax и его неуклюжих констант, которые должны быть скорректированы в зависимости от разрешения данного исследования. Следующим лучшим вариантом может быть шаблонное представление учебной карты - 2d матрица, 24x32? 6x8 матрица списков списков? - но я не знаю, как сказать ggplot, чтобы прочитать его. Или я должен просто обернуть все это в большую функцию, которая может справиться со всем?

Answer 1

Было бы яснее, если бы вы включили иллюстрацию вашей учебной области, но вот мое лучшее предположение о том, что вы ищете. Если мое понимание верно, вы можете выполнить все переводы в течение dplyr конвейерные операции пакета, которые упрощают интерпретацию того, что происходит на каждом этапе кода.

Обратите внимание, что я использовал разные SECT значения для иллюстрации. Пояснения в комментариях в пределах:

library(dplyr)
library(ggplot2)

# modify toyDF to include sections of different sizes
toyDF <- tibble::tibble(SECT = c("3E", "5G3", "8C24"), 
                HT = c(22, 6, 15))

toyDF %>%
  mutate(sqr = stringr::str_pad(SECT, 4, side = "right", pad = " ")) %>%
  tidyr::separate(sqr, into = c("x", "y", "quadrat", "subquadrat"), sep = 1:3) %>%

  # convert the first two letters of SECT into x/y coordinates for the centre of the area
  mutate(x = factor(x, levels = as.character(3:8)),
         y = factor(y, levels = LETTERS[10:3])) %>%
  mutate_at(vars(x, y),
            function(i) as.integer(i) * 100 - 50) %>%

  # adjust coordinates for quadrat, if applicable
  mutate(x = case_when(quadrat %in% c("1", "3") ~ x - 25,
                       quadrat %in% c("2", "4") ~ x + 25,
                       TRUE ~ x),
         y = case_when(quadrat %in% c("1", "2") ~ y + 25,
                       quadrat %in% c("3", "4") ~ y - 25,
                       TRUE ~ y)) %>%

  # further adjust coordinates for subquadrat, if applicable
  mutate(x = case_when(subquadrat %in% c("1", "3") ~ x - 12.5,
                       subquadrat %in% c("2", "4") ~ x + 12.5,
                       TRUE ~ x),
         y = case_when(subquadrat %in% c("1", "2") ~ y + 12.5,
                       subquadrat %in% c("3", "4") ~ y - 12.5,
                       TRUE ~ y)) %>%

  # specify appropriate width for each cell, depending on whether
  # subquadrat / quadrat has been defined
  mutate(width = case_when(subquadrat != " " ~ 25,
                           quadrat != " " ~ 50,
                           TRUE ~ 100)) %>%

  ggplot(aes(x = x, y = y, fill = HT)) +
  geom_tile(aes(height = width, width = width)) +
  scale_x_continuous(breaks = seq(50, 550, by = 100),
                     labels = as.character(3:8),
                     expand = c(0, 0)) +
  scale_y_continuous(breaks = seq(50, 750, by = 100),
                     labels = LETTERS[10:3],
                     expand = c(0, 0)) +
  coord_equal(xlim = c(0, 600), ylim = c(0, 800)) +
  theme_bw() +
  theme(panel.grid.major = element_blank(),
        axis.ticks = element_blank())