R Shiny 從多個變量創建反應性單多邊形 Plot

Question

The goal is to create an interactive (single) plot in Shiny in which the user can select any of the wanted variables of the dataframe. 現在繪制變量freq_prov_tot。 plot 本身正在工作，但我不知道如何以交互方式包含其他變量以“選擇”。 還包括一個工具提示。 我正在使用 ggiraph，因為可以很容易地將這個交互式多邊形 map 集成到 Shiny 中。

如果您知道如何解決此問題，非常感謝您的幫助。

我正在使用的dataframe如下。 為了保護使用的數據，所有省份的變量 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

以下代碼可能是一個解決方案。 添加了標簽注釋並用作基本菜單。 它不是很漂亮，需要做一些工作才能使它更好......

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

Answer 2

我決定使用 function observeEvent() 使用不同的格式。 這包括以更好的方式將不同的列作為最終 map 的輸入。

然而這不起作用，因為它拒絕響應 selectInput function。

這是我用於此的更改后的 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必須是一個數據幀，或者其他 object 可以通過fortify()強制執行，而不是 S3 object 和 class Observer/R6”

有沒有人有解決這個問題的想法？