R Shiny Создание реактивного одиночного полигонального графика из нескольких переменных

Question

Цель состоит в том, чтобы создать интерактивный (одиночный) график в Shiny, в котором пользователь может выбрать любую из требуемых переменных кадра данных. А пока переменная freq_prov_tot построена. Сам сюжет работает, но я не знаю, как включить другие переменные для «выбора» в интерактивном режиме. Также имеется всплывающая подсказка. Я использую ggiraph из-за возможности довольно легко интегрировать эту интерактивную карту полигонов в Shiny.

Если у вас есть идеи, как это можно исправить, помощь очень ценится.

Фрейм данных, который я использую, выглядит следующим образом. Для защиты используемых данных всем провинциям присваивается значение 1 для переменной freq_prov_tot.

counties_e<- fortify(Iran3, region = "NAME_1")
counties_e$freq_prov_tot<- ifelse(counties_e$id == "Alborz",1,
                       ifelse(counties_e$id == "Ardebil",1,  
                       ifelse(counties_e$id == "Bushehr",1,
                       ifelse(counties_e$id == "Chahar Mahall and Bakhtiari",1,
                       ifelse(counties_e$id == "East Azarbaijan",1,
                       ifelse(counties_e$id == "Esfahan",1,
                       ifelse(counties_e$id == "Fars",1,
                       ifelse(counties_e$id == "Gilan",1,
                       ifelse(counties_e$id == "Golestan",1,
                       ifelse(counties_e$id == "Hamadan",1,
                       ifelse(counties_e$id == "Hormozgan",1,
                       ifelse(counties_e$id == "Ilam",1,
                       ifelse(counties_e$id == "Kerman",1,
                       ifelse(counties_e$id == "Kermanshah",1,
                       ifelse(counties_e$id == "Khuzestan",1,
                       ifelse(counties_e$id == "Kohgiluyeh and Buyer Ahmad",1,
                       ifelse(counties_e$id == "Kordestan",1,
                       ifelse(counties_e$id == "Lorestan",1,
                       ifelse(counties_e$id == "Markazi",1,
                       ifelse(counties_e$id == "Mazandaran",1,
                       ifelse(counties_e$id == "North Khorasan",1,
                       ifelse(counties_e$id == "Qazvin",1,
                       ifelse(counties_e$id == "Qom",1,
                       ifelse(counties_e$id == "Razavi Khorasan",1,
                       ifelse(counties_e$id == "Semnan",1,
                       ifelse(counties_e$id == "Sistan and Baluchestan",1,
                       ifelse(counties_e$id == "South Khorasan",1,
                       ifelse(counties_e$id == "Tehran",1,
                       ifelse(counties_e$id == "West Azerbaijan",1,
                       ifelse(counties_e$id == "Yazd",1,
                       ifelse(counties_e$id == "Zanjan",1, 0)))))))))))))))))))))))))))))))

Код для всплывающей подсказки

provinces_e <- sprintf("<p>%s</p>",
                       as.character(counties_e$id) )
table_e <- paste0(
  "<table><tr><td>Total Number of Environmental Issues:</td>",
  sprintf("<td>%.0f</td>", counties_e$freq_prov_tot),
  "</tr></table>"
)

counties_e$labs <- paste0(provinces_e, table_e)

код для интерфейса пользователя и сервера

ui_e <- fluidPage(

  # Application title
  titlePanel("Spatial Distribution of Environmental Issues in Iran during 1930 - 2018"),
  fluidRow(column(12,
                  ggiraph::ggiraphOutput("county_map")))
)

server_e <- function(input, output) {

  output$county_map<- renderggiraph({
    p<- ggplot(counties_e, aes(x=long, y=lat, group = group, fill = freq_prov_tot)) +
      xlab("Longitude") + ylab("Lattitude") + labs(fill = "Number of Environmental Issues") +
      coord_map("polyconic" ) +
      geom_polygon_interactive(aes(tooltip = labs))

    ggiraph(code = print(p))
  })

}

shinyApp(ui = ui_e, server = server_e)

Counties_e можно скачать по следующей ссылке:

https://drive.google.com/file/d/1TOyZIADTCnRFyWLehxS7Td9v-BOZXARS/view?usp=sharing

Answer 1

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

Это, однако, не работает, так как он отказывается отвечать на функцию selectInput.

Это измененный пользовательский интерфейс и код сервера, который я использовал для этого

ui <- fluidPage(

  # Application title
  titlePanel("Spatial Distribution of Protest Events in Iran during 2005 - 2017"),

  sidebarPanel(
    selectInput(
      inputId = "counties",
      label   = "counties",
      choices = c("freq_prov_tot", "freq_prov_air")
    )
  ), 
  fluidRow(column(12,
                  ggiraph::ggiraphOutput("county_map")))
)


server <- function(input, output) {

  data2 <- observeEvent(input$choices, {counties}) 

  output$county_map<- renderggiraph({
    p<- ggplot(data2, aes(x=long, y=lat, group = group, fill = data2)) +
      xlab("Longitude") + ylab("Lattitude") + labs(fill = "Number of Protest Events\n regarding Air Quality") +
      coord_map("polyconic" ) +
      geom_polygon_interactive(aes(tooltip = labs))

    ggiraph(code = print(p)) 

})} 

shinyApp(ui = ui, server = server)

Это выдает следующую ошибку: "data должен быть фреймом данных, или другой объект может быть изменен с помощью fortify(), а не объект S3 с классом Observer / R6 "

У кого-нибудь есть идея, чтобы это исправить?

Answer 2

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

counties_e <- read.csv("~/Downloads/counties_e.csv", row.names=1, stringsAsFactors=FALSE)
library(ggiraph)
library(shiny)
library(ggplot2)
library(rlang)

ui_e <- fluidPage(

  # Application title
  titlePanel("Spatial Distribution of Environmental Issues in Iran during 1930 - 2018"),
  fluidRow(column(
    12,
    ggiraph::ggiraphOutput("county_map")
  ))
)

min_ann_y <- min(counties_e$lat, na.rm = TRUE)
max_ann_y <- max(counties_e$lat, na.rm = TRUE)
y_pos <- seq(from = min_ann_y, to = max_ann_y, along.with = colnames(counties_e))

server_e <- function(input, output) {
  rv <- reactiveValues(column = tail(colnames(counties_e), n = 1))
  observeEvent(input$county_map_selected, {
    rv$column <- input$county_map_selected
  })
  output$county_map <- renderggiraph({
    tooltip_col <- sym(rv$column)

    p <- ggplot(counties_e, aes(x = long, y = lat, group = group, fill = freq_prov_tot)) +
      xlab("Longitude") + ylab("Lattitude") + labs(fill = "Number of Environmental Issues") +
      coord_map("polyconic") +
      scale_x_continuous(limits = c(40, NA)) + 
      geom_polygon_interactive(aes(tooltip = format(!!tooltip_col, trim = TRUE))) +
      annotate_interactive(
        "label", hjust = 0,
        x = 40,
        y = y_pos, fill = "#FF000009",
        data_id = colnames(counties_e),
        label = colnames(counties_e)
      )

    girafe_options(
      girafe(ggobj = p),
      opts_selection(
        type = "single", selected = rv$column,
        css = girafe_css(
          css = "fill:purple;stroke:black;",
          text = "stroke:none;fill:red;"
        )
      ),
      opts_hover(css = "stroke:none;fill:red;")
    )
  })
}

print(shinyApp(ui = ui_e, server = server_e))