r - R Shiny 从多个变量创建反应性单多边形图

Question

目标是在 Shiny 中创建一个交互式（单个）图，用户可以在其中选择数据框的任何所需变量。现在绘制变量freq_prov_tot。该图本身正在运行，但我不知道如何以交互方式包含其他变量以“选择”。还包括一个工具提示。我正在使用 ggiraph，因为可以很容易地将这个交互式多边形地图集成到 Shiny 中。

如果您知道如何解决此问题，非常感谢您的帮助。

我使用的数据框如下。为了保护使用的数据，所有省份的变量 freq_prov_tot 的值都为 1。

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

我决定使用函数 observeEvent() 使用不同的格式。这包括以更好的方式将不同的列作为最终地图的输入。

然而，这不起作用，因为它拒绝响应 selectInput 函数。

这是我用于此的更改后的 ui 和服务器代码

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()，而不是具有类 Observer/R6 的 S3 对象”

有没有人有解决这个问题的想法？

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