วิธีการแรเงารูปร่าง

Question

เป็นไปได้ไหมที่จะใช้ggrough(https://xvrdm.github.io/ggrough/index.html) เพื่อแรเงารูปทรงที่สร้างขึ้นโดยgeom_sf(ต้องการ) หรืออาจgeom_polygon? ดูคำถามนี้สำหรับคำถามก่อนหน้านี้ที่ให้รูปลักษณ์ของพล็อตที่ฉันคิดไว้และคำตอบที่มาพร้อมกันโดย Z.Lin ที่ปรับเปลี่ยนแพ็คเกจเพื่อให้เข้ากันได้กับเวอร์ชันปัจจุบันของggplot2: ไม่สามารถจำลองพล็อต ggplot2 นี้ได้

นี่คือ MWE ของแผนที่ที่สร้างขึ้นโดยใช้geom_sfที่ฉันต้องการแรเงา (แต่ละเขต) โดยใช้ggrough:

library(tidyverse)
library(magrittr)
library(ggplot2)
library(ggrough)
library(RColorBrewer)
library(tidycensus)
library(viridis)
#install.packages("devtools") # if you have not installed "devtools" package
#devtools::install_github("xvrdm/ggrough")
library(hrbrthemes)

#get nevada shapefile
counties <- get_acs(
    geography = "county", year = 2018, geometry = TRUE,
    variables = "B19013_001", keep_geo_vars=TRUE
) %>% filter(STATEFP=="32")
counties$GEOID <- as.integer(counties$GEOID)
#############

a <- ggplot() +
    geom_sf(data = counties, aes(fill = estimate)) + 
    scale_fill_viridis(discrete=FALSE, name="", guide=FALSE) +  
    theme_bw() +
    theme(legend.position = c(0.15, .15)) +
    theme(plot.subtitle = element_text(hjust = 0.8, vjust=-10, size=30)) +  
    theme(panel.background = element_rect(fill = 'white')) +
    theme(panel.grid = element_blank(),axis.title = element_blank(),
          axis.text = element_blank(),axis.ticks = element_blank(),
          panel.border = element_blank())+
    theme(legend.position = c(0.25, .15), legend.key.size = unit(2,"line"),
          legend.title=element_text(size=16), 
          legend.text=element_text(size=14), 
          legend.direction = "vertical", 
          legend.box = "horizontal") +
    labs(caption = "")
a 

สิ่งนี้ก่อให้เกิดสิ่งต่อไปนี้:

ฉันจะแรเงามณฑลของแผนที่นี้โดยใช้ggroughหรือไม่ได้อย่างไร โปรดทราบว่าฉันคิดว่าggroughสามารถจัดการgeom_col, geom_bar, geom_tile, geom_geom_area, geom_ribbon, geom_violin, geom_point, geom_jitter, geom_dotplot, geom_line, and geom_smoothได้ แต่ฉันไม่แน่ใจเกี่ยวกับgeom_sfหรือgeom_polygon; ถ้าไม่สามารถเพิ่มเข้าไปได้ง่ายไหม

*** อัปเดตนี่คืออีกตัวอย่างหนึ่งที่นำมาจาก https://ggplot2.tidyverse.org/reference/ggsf.html:

nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
b <- ggplot(nc) +
    geom_sf(aes(fill = AREA))
b

สิ่งนี้ก่อให้เกิด:

*** สิ้นสุดการอัปเดต

(นี่คือตัวอย่างที่สร้างขึ้นด้วยggroughของวิธีการที่ฉันต้องการแรเงาของมณฑลที่จะดู:

)

นี่คือความพยายามที่ล้มเหลว (อาศัยรหัสอีกครั้งจากคำตอบของ Z.Lin ที่นี่: ไม่สามารถจำลองพล็อต ggplot2 นี้ได้ ):

parse_polygons <- function (svg) {
    shape <- "polygon" # was "polyline" in ggrough:::parse_areas
    keys <- NULL
    ggrough:::parse_shape(svg, shape, keys) %>% {
        purrr::map(., 
                   ~purrr::list_modify(.x, 
                                    points = stringr::str_squish(.x$points) %>% 
                                        {stringr::str_glue("M{.}Z")}, 
                                    shape = "path"))
    }
}

trace(ggrough:::parse_rough, edit = TRUE)

# paste the following function into the pop-up window
function (svg, geom) {
    rough_els <- list()
    if (geom %in% c("GeomCol", "GeomBar", "GeomTile", "Background")) {
        rough_els <- append(rough_els, parse_rects(svg))
    }
    if (geom %in% c("GeomSmooth", "Background")) {   # removed GeomArea / GeomViolin from here
        rough_els <- append(rough_els, parse_areas(svg))
    }
    if (geom %in% c("GeomArea", "GeomRibbon", "GeomViolin")) {  # new condition here
        rough_els <- append(rough_els, parse_polygons(svg))
    }
    if (geom %in% c("GeomPoint", "GeomJitter", "GeomDotPlot", "Background")) {
        rough_els <- append(rough_els, parse_circles(svg))
    }
    if (geom %in% c("GeomLine", "GeomSmooth", "Background")) {
        rough_els <- append(rough_els, parse_lines(svg))
    }
    if (geom %in% c("Background")) {
        rough_els <- append(rough_els, parse_texts(svg))
    }
    purrr::map(rough_els, ~purrr::list_modify(.x, geom = geom))
}

options <- list(GeomSf=list(fill_style="hachure", 
                              angle_noise=0.5,
                              gap_noise=0.2,
                              gap=1.5,
                              fill_weight=1))
get_rough_chart(a, options)

สิ่งนี้ทำให้เกิดข้อความแสดงข้อผิดพลาด:

Error in `*tmp*`[[i]] : subscript out of bounds

*** อัพเดท

หรือด้วยตัวอย่างที่สอง:

options <- list(GeomSf=list(fill_style="hachure", 
                          angle_noise=0.5,
                          gap_noise=0.2,
                          gap=1.5,
                          fill_weight=1))
get_rough_chart(b, options)

ข้อผิดพลาดเดียวกัน

*** สิ้นสุดการอัปเดต

โปรดทราบว่าเป็นไปได้ที่จะสร้างแผนที่โดยใช้geom_polygonซึ่งเป็นที่สนใจเช่นกันแม้ว่าจะgeom_sfเป็นที่ต้องการก็ตาม

Answer 1

library(magrittr)
library(ggplot2)
library(ggrough)

แทนที่parse_roughโดยใช้trace

trace(ggrough:::parse_rough, edit=TRUE)

ในหน้าต่างป๊อปอัพวางนี้เพื่อให้parse_roughจะใช้สำหรับparse_sfGeomSf

function (svg, geom) 
{
  rough_els <- list()
  if (geom %in% c("GeomCol", "GeomBar", "GeomTile", 
                  "Background")) {
    rough_els <- append(rough_els, parse_rects(svg))
  }
  if (geom %in% c("GeomArea", "GeomViolin", "GeomSmooth", 
                  "Background")) {
    rough_els <- append(rough_els, parse_areas(svg))
  }
  if (geom %in% c("GeomPoint", "GeomJitter", "GeomDotPlot", 
                  "Background")) {
    rough_els <- append(rough_els, parse_circles(svg))
  }
  if (geom %in% c("GeomLine", "GeomSmooth", "Background")) {
    rough_els <- append(rough_els, parse_lines(svg))
  }
  if (geom %in% c("Background")) {
    rough_els <- append(rough_els, parse_texts(svg))
  }
  if (geom %in% c("GeomSf")) {
    rough_els <- append(rough_els, parse_sf(svg))
  }
  purrr::map(rough_els, ~purrr::list_modify(.x, geom = geom))
}

parse_sfสร้างฟังก์ชั่น

parse_sf <- function (svg) {
  shape <- "path"
  keys <- NULL
  ggrough:::parse_shape(svg, shape, keys) %>% {
    purrr::map(., 
               ~purrr::list_modify(.x, 
                                   points = .x$d, 
                                   shape = "path"
               ))
  }
}

สร้างพล็อตที่ต้องการ

nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
b <- ggplot(nc) +
  geom_sf(aes(fill = AREA))
b


options <- list(GeomSf=list(fill_style="hachure", 
                            angle_noise=0.5,
                            gap_noise=0.2,
                            gap=1.5,
                            fill_weight=1))
get_rough_chart(b, options)