Как добавить границам карты меньше шероховатостей, чем заливке карты

После этих вопросов и ответов (Как заштриховать фигуры ) и ( Невозможно повторить этот график ggplot2 ), скажите, что я получаю ggrough ( https://xvrdm.github.io/ggrough/index.html) запущено и работает:

#install.packages("devtools") # if you have not installed "devtools" package
#devtools::install_github("xvrdm/ggrough")

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

trace(ggrough:::parse_rough, edit=TRUE)
#In the popup window, paste this so that parse_rough will use parse_sf for GeomSf.
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))
}

#Create the function 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))

options <- list(GeomSf=list(fill_style = "hachure", 
                            angle=60,
                            angle_noise=1,
                            gap_noise=0,
                            gap=6,
                            fill_weight=2, 
                            bowing=5,
                            roughness=30))
get_rough_chart(b, options)

Это производит:

Если я хочу 1) сохранить настройку roughness (заливки) на уровне 30 и 2) я хочу отображать границы (а не удалять их с помощью опции lwd=0 в geom_sf или чего-то подобного), как я могу самостоятельно контролировать шероховатость границы? На самом деле границы вышли из-под контроля. Я хочу, чтобы у них была некоторая шероховатость, чтобы казалось, будто они нарисованы от руки, но лишь немного. (Если это невозможно, как я могу включить границу, на которую не влияет ggrough, хотя на заливку все еще влияет?)

Я попробовал следующее:

b <- ggplot(nc) +
    geom_sf(aes(fill = AREA), lwd=0) +
    geom_sf(fill = "transparent", color = "yellow", size = 1)   

options <- list(GeomSf=list(fill_style = "hachure", 
                            angle=60,
                            angle_noise=1,
                            gap_noise=0,
                            gap=6,
                            fill_weight=2, 
                            bowing=5,
                            roughness=30),
                GeomSf=list(fill_style = "hachure", 
                            angle=60,
                            angle_noise=1,
                            gap_noise=0,
                            gap=6,
                            fill_weight=2, 
                            bowing=5,
                            roughness=1))
get_rough_chart(b, options)

Я надеялся, что если я включу два элемента GeomSf в список параметров, возможно, первый будет соответствовать первому geom_sf (без границ), а второй — с roughness, установленным на 1 — будет соответствовать второму geom_sf . Но это не сработало:

Рассматривали ли вы вместо этого пакет roughsf? Кажется, это может лучше подойти для ваших целей.

Kat 23.08.2024 23:14

Спасибо за комментарий @Kat. Мне бы хотелось разобраться с этим ggrough, но roughsf тоже возможно. Я только что попробовал создать карту Германии roughsf, используя почти точный код с github.com/schochastics/roughsf, за исключением того, что я изменил параметр roughness на 50. Интересно, что у меня возникла точно такая же проблема, как и у меня. добираюсь с ggrough - что границы тоже выходят из-под контроля. Поэтому было бы очень полезно, если бы существовал способ независимо контролировать шероховатость заливки и границ.

bill999 23.08.2024 23:35

Ну, это не помогло! Итак, я еще раз взглянул на ваш вопрос и просто ради удовольствия (на основе вашего комментария о заливке и прозрачности) я установил прозрачный цвет и заливку... У вас все еще есть нацарапанный вид, но ничего не выходит за рамки самые внешние границы. Будет еще интереснее, если вы удалите fill (прозрачный) и назначите цвет только прозрачному. Вы уже это сделали?

Kat 24.08.2024 00:51

Я согласен, что интересно посмотреть, что происходит в различных сценариях, например: b <- ggplot(nc) + geom_sf(aes(fill = AREA)) И тогда это удаляет границы (не знаю почему): b <- ggplot(nc) + geom_sf(aes(fill = AREA), color = "transparent") vs. b <- ggplot(nc) + geom_sf(aes(fill = AREA), lwd=0) + geom_sf(color = "transparent", fill = "transparent") vs. b <- ggplot(nc) + geom_sf(aes(fill = AREA), lwd=0) + geom_sf(color = "transparent") Но я не могу понять, как получить нацарапанное затенение округа, хотя и имеют вполне нормальные на вид границы.

bill999 24.08.2024 06:27

Это громоздко, но у меня есть обходной путь, который вам может понравиться. Это не лучший ответ, поэтому я решил сначала спросить. Если я добавлю ответ, маловероятно, что кто-то еще попытается ответить на ваш вопрос. BLUF (или более новый, более модный TLDR) заключается в том, что я создаю только границу и накладываю на нее график ggrough.

Kat 24.08.2024 17:56

Это было бы здорово!

bill999 24.08.2024 20:47
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
0
6
73
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

В этом методе используются два отдельных графика: один для приложения с ggrough и для вашей настройки, другой не использует ggrough, но вводит традиционную границу.

Для этого требуются 2 дополнительные библиотеки. Один превращает ggplot2 в HTML. Другой используется для наложения двух графиков.

library(ggiraph)
library(htmltools)

Поскольку в вашем вопросе есть несколько разных графиков, вот точный код построения, который я использовал. Я добавил ограничения темы. Это сделает панели и текст невидимыми, но не удалит их. Это они должны быть там, чтобы сюжеты можно было выровнять.

b <- ggplot(nc) + geom_sf(color = "black") + theme_minimal() +
  theme(panel.grid = element_line(color = NA),  # not resized or removed! (keep spacing)
        axis.text = element_text(color = NA))

Опции не были изменены. Скажу, что я использовал первый вариант (только с одним GeomSf).

После вас get_rough_chart у меня есть UDF, который изменяет панель и текстовые поля. Похоже, что по умолчанию используется черный цвет, и он добавляет текст оси обратно на график. Это удалит текст без ущерба для интервалов.

(xx <- get_rough_chart(b, options))  # from your question
fixer <- function(ggr) {          # where ggr is the ggrough graph
  nd <- lapply(1:length(ggr$x$data), function(j) {
    if (!is.null(ggr$x$data[[j]]$lengthAdjust)) { # if a text element (axis label)
      ggr$x$data[[j]]$content <- ""              # remove text, but keep spacing
      ggr$x$data[[j]]                            # return modified data element
    } else {
      ggr$x$data[[j]]                            # not text, return orig data
    }
  })
  ggr$x$data <- nd                               # add mod data to graph
  ggr                                            # return mod graph
}
xx2 <- xx %>% fixer()  # modify the plot, to hide text

Затем создайте график только с границей. На этом графике тема используется для удаления белого фона и установки размера шрифта так, чтобы он соответствовал значениям по умолчанию в ggrough.

(g2 <- ggplot(nc) +
    geom_sf(fill = "transparent", color = "black", linewidth = 2) +
    theme_minimal() +
    theme(plot.background = element_rect(fill = NA, color = "transparent"), # no white background
          panel.background = element_rect(fill = NA, color = "transparent"),
          text = element_text(size = 9)))      # text size to match defaults in ggrough

gg <- girafe(ggobj = g2, width_svg = 7, height_svg = 5)  # h/w default w/ ggrough

И последнее, но не менее важное: сборка.

browsable(div( # parent div, size matches ggrough's default
  style = css(width = "960px", height = "500px", position = "relative"),
  div(xx2, style = css(display = "block")),                           # ggrough graph
  div(gg, style = css(position = "absolute", top = 0, padding.top = "54.2px", # layer behind
                      width = "610px", height = "500px", z.index = -2))
              )) # size and padding found by trial and error with defaults for graph sizes

Хотя в приведенном выше коде не назначен fill в geom_sf, если я изменю его и добавлю, например, fill = "blue", вы все равно получите те же результаты.



Вот весь используемый код вместе

(проще скопировать + вставить)

# uncommented code is likely unchanged code from your question

library(magrittr)
library(ggplot2)
library(ggrough)
library(sf)
library(htmltools)    # <- I'm new!
library(ggiraph)      # <- I'm new!

trace(ggrough:::parse_rough, edit=TRUE)
#In the popup window, paste this so that parse_rough will use parse_sf for GeomSf.
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))
}

# Create the function 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(color = "black") + theme_minimal() +
  theme(panel.grid = element_line(color = NA),  # not resized or removed! (keep spacing)
        axis.text = element_text(color = NA))

options <- list(GeomSf = list(fill_style = "hachure", angle = 60, angle_noise = 1,
                              gap_noise = 0, gap = 6, fill_weight = 2, bowing = 5,
                              roughness = 30))

(xx <- get_rough_chart(b, options))  # from your question
fixer <- function(ggr) {          # where ggr is the ggrough graph
  nd <- lapply(1:length(ggr$x$data), function(j) {
    if (!is.null(ggr$x$data[[j]]$lengthAdjust)) { # if a text element (axis label)
      ggr$x$data[[j]]$content <- ""              # remove text, but keep spacing
      ggr$x$data[[j]]                            # return modified data element
    } else {
      ggr$x$data[[j]]                            # not text, return orig data
    }
  })
  ggr$x$data <- nd                               # add mod data to graph
  ggr                                            # return mod graph
}
xx2 <- xx %>% fixer()  # modify the plot, to hide text

(g2 <- ggplot(nc) +
    geom_sf(fill = "transparent", color = "black", linewidth = 2) +
    theme_minimal() +
    theme(plot.background = element_rect(fill = NA, color = "transparent"), # no white background
          panel.background = element_rect(fill = NA, color = "transparent"),
          text = element_text(size = 9)))      # text size to match defaults in ggrough

gg <- girafe(ggobj = g2, width_svg = 7, height_svg = 5)  # h/w default w/ ggrough

browsable(div( # parent div, size matches ggrough's default
  style = css(width = "960px", height = "500px", position = "relative"),
  div(xx2, style = css(display = "block")),                           # ggrough graph
  div(gg, style = css(position = "absolute", top = 0, padding.top = "54.2px", # layer behind
                      width = "610px", height = "500px", z.index = -2))
              )) # size and padding found by trial and error with defaults for graph sizes

Вау, спасибо, что все это делаешь!!! Мой я задаю два вопроса? 1) как я могу настроить код, чтобы границы появлялись поверх каракулей? 2) Когда я точно запускаю ваш код, слой границы точно такой же, как у вас, но слой каракулей находится не в том месте. Я думаю, что он слишком велик и находится к югу и востоку от другого слоя (с большим количеством перекрытий). Что я должен попытаться изменить, чтобы получить его там, где он должен быть?

bill999 25.08.2024 03:14

Другие вопросы по теме

Похожие вопросы

Как подсчитать, сколько единиц в каждой строке по заданному количеству столбцов в зависимости от количества отсутствующих/NA, присутствующих в каждой строке в R?
Str_replace_all ведет себя странно при передаче именованного вектора с общими ключами и значениями; что делать?
Скользящее среднее по сгруппированным датам
Преобразование регулярного выражения с набором чисел в вектор строк
Как правильно транспонировать фрейм данных в R
Как предотвратить выбор строки при нажатии значка в ячейке DT?
Как сделать цикл самым быстрым в R?
R и запись в JSON
Как создать график пловца с двумя независимыми осями, основная из которых представляет продолжительность наблюдения, а второстепенная — календарное время
Рекурсивное преобразование фрейма данных во вложенный список, где уровень вложенности списка равен количеству столбцов в фрейме данных