Как исправить искаженное интерактивное всплывающее окно фигуры ggplot на карте листовки - PullRequest
Новая
       109

Как исправить искаженное интерактивное всплывающее окно фигуры ggplot на карте листовки

0 голосов
/ 08 мая 2020

Нужна помощь / совет по исправлению искажения с помощью всплывающих графиков в файле html. Изменение параметров формы / размера в листовке не помогает. Я полагаю, что создание ShinyApp может работать лучше, но я предпочитаю выводить как html с другими результатами.

Хороший пример:

Я сделал интерактивный карта листовок, которая отлично смотрится в RStudio. Я не могу создать интерактивную функцию на SO, но график будет всплывать при нажатии для каждого интересующего округа.

map as viewed within RStudio Viewer pane

Пример проблемы

При генерации в виде html вывода (предпочтительный результат) всплывающие графики искажаются и не могут использоваться.

enter image description here

Пример воспроизводимого кода

Вот пример кода для создания простого примера: 

# leaflet map exapmple
library(tidyverse)
library(leaflet)
library(leafpop) # provides popup option for leaflet map
library(sf)
library(tigris) # US Census map data
library(lubridate)


TN_data <- tigris::counties(state = "TN", cb = TRUE) # downloads shapes- need internet access 
TN_data_sf <- sf::st_as_sf(TN_data)

class(TN_data_sf)
# generate a random time-series dataset for each county
county_plots <-
  as_tibble(TN_data_sf) %>% 
  mutate(data = map(NAME,
                    ~tibble(date = seq.Date(from = ymd("2020/01/01"), 
                                            to = ymd("2020/05/01"),
                                            by = 7),
                            events = rnorm(18)))) %>% 
  # generate a ggplot time series plot for each county
  mutate(ggp = map2(data, NAME,
                       ~ggplot(data = .x) +
                         geom_col(aes(date, events), fill = "steelblue", alpha = 0.5) + 
                         labs(x=NULL,
                              y="Results by day",
                              title = glue::glue("{.y} County"),
                              subtitle = "New Results by Date Reported") + 
                         # scale_fill_manual(values = c("Cases" = "steelblue"),
                         #                   labels = c(paste0("Latest events: ", .x$events[.x$date == max(.x$date)]))) +
                         scale_y_continuous(expand = c(0,0)) +
                         scale_x_date(date_breaks = "7 days", date_labels = "%m/%d" ) +
                         theme(axis.text.x =  element_text(angle = 45, hjust = 1),
                               legend.position = "bottom")))

leaflet() %>% 
  addPolygons(data = TN_data_sf,
              group = "name",
              weight = 1,
              highlight = highlightOptions(
                weight = 5,
                color = "red",
                bringToFront = TRUE)) %>% 
  leafpop::addPopupGraphs(county_plots$ggp, 
                          group = "name", 
                          width = 600, height = 300)

для блока Rmarkdown, я включил {r echo=TRUE, message=FALSE, warning=FALSE, out.width = '100%'}

1 Ответ

1 голос
/ 09 мая 2020

Быстрое исправление - использовать следующий CSS (например, в начале вашего RMarkdown): 

<style>
.leaflet-popup-content > img {
    max-width: unset;
}
</style>

Это свойство установлено на 100% при создании документа HTML. Когда вы запускаете код внутри RStudio, он не установлен. Зачем? Я не уверен ...

...