R —将递归划分的区域转换为ggplot2氯盐的XY坐标

Question

I've worked out a solution for this but it's ugly, ad hoc and ungeneralizable; I assume there has to be a better way. Our study area is divided into a grid of 100mx100m blocks, columns named 3-8 and rows named CJ. Each block is divided into four quadrats and each quadrat into four subquadrats, so a subquad name would be something like '4F23'; the division pattern looks like this:

11 12 21 22

13 14 23 24

31 32 41 42

33 34 43 44

Different datasets use whichever of the three resolutions is appropriate so I want something that can deal with '4F', '4F1' and '4F34'. To show values in a heatmap/chloropleth of the area I need a way to represent that nested scheme more orthogonally to ggplot -- or better, to tell ggplot something so it knows how to interpret the section labels itself. What I want is a simple way to plot the map of any of our studies. The best I could come up with was using a translation function to generate XYs and bind those to the dataframe.

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))

With a full dataset this produces exactly what I want but it's terrible. What I'd like best (I think) is for my SACoords() to be a transformation that I can plug into the ggplot(aes()) call so it will effectively understand the SECT labels, hopefully allowing me to use geom_raster instead of geom_rect and avoid the xmin/xmax and its awkward constants that have to be adjusted depending on a given study's resolution. Next best might be a templated representation of the study map -- 2d matrix, 24x32? 6x8 matrix of lists of lists? -- but I don't know how to tell ggplot to read it. Or should I really just be wrapping all this up in a bigger function that can handle everything?

Answer 1

It would be clearer if you included an illustration of your study area, but here's my best guess at what you are looking for. If my understanding is correct, you can perform all the translations within dplyr package's pipe operations, which makes for easier interpretation of what's going on at each step in the code.

Do note that I used different SECT values for illustration purpose. Explanations in comments within:

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())