Linked Click для карт в Plotly R

Данные :

https://www.kaggle.com/wood2174/mapkickstarter

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

Это моя карта после того, как я нажал на состояние:

Я почти уверен, что неправильно передаю аргументы между ними, используя аргумент event_data. Аргумент, который я передаю, будет названием штата, и это имя будет введено в мою функцию под названием CT в качестве символа для вызова имени штата, чтобы я мог найти данные округа из щелкнутого по штату, другой, data и pop — два других фрейма данных, которые передаются в функцию. Это то, что функция обливает за пределами блестящего сервера, и она создает интерактивную карту наведения:

Код:

ui <- fluidPage(mainPanel(
  navbarPage(
    "Kickstarter",
    navbarMenu(
      "Maps",
      tabPanel("US Map", plotlyOutput(
        "plotMap", height = 900, width = 1200
      )),
      tabPanel("County Map",
               plotlyOutput("Smap"),
               plotlyOutput("Cmap"))
    ),
    tabPanel(
      "Interaction",
      plotlyOutput("plotInt", height = 900, width = 1200)
    ),
    navbarMenu(
      "Barplots",
      tabPanel("Citys", plotlyOutput(
        "plotBar1", height = 900, width = 1200
      )),
      tabPanel(
        "Catigories",
        plotlyOutput("plotBar2", height = 900, width = 1200)
      )
    )
  )
))


     server <- function(input, output, session) {
  #add reactive data information. Dataset = built in diamonds data
  H <- read_csv("C:/Users/clint/Documents/R/Personal work/Masters Project/MasterKickstarter.csv")
  M <- read_csv("C:/Users/clint/Documents/R/Personal work/Masters Project/data sets/Mapping.csv")
  C <- read_csv("C:/Users/clint/Documents/R/Personal work/Masters Project/data sets/County.csv")

  H <- as.data.frame(H)
  M <- as.data.frame(M)
  C <- as.data.frame(C)

  ### Plotting top twenty citys for a kick ###
  # calculate frequencies
  tab <- table(H$City)
  # sort
  tab_s <- sort(tab)
  # extract 10 most frequent nationalities
  top10 <- tail(names(tab_s), 25)
  # subset of data frame
  d_s <- subset(H, City %in% top10)
  # order factor levels
  d_s$City <- factor(d_s$City, levels = rev(top10))

  #function for capitalization
  simpleCap <- function(x) {
    s <- strsplit(x, " ")[[1]]
    paste(toupper(substring(s, 1, 1)),
          substring(s, 2),
          sep = "",
          collapse = " ")
  }



  M$code <- state.abb[match(M$State, state.name)]

  #making temp sets that fit for interactive maps
  H = H[!duplicated(H[, "City"], fromLast = T), ]
  H$State <- sapply(as.character(H$State), simpleCap)
  H$code <- state.abb[match(H$State, state.name)]

  H$City <- factor(H$City)

  #making quartiles for plotting size
  H$q <-
    with(H, cut(All_Time_Backers_city, quantile(All_Time_Backers_city)))
  levels(H$q) <-
    paste(c("1st", "2nd", "3rd", "4th", "5th"), "Quantile")
  H$q <- as.ordered(H$q)


  CT <- function(r,data,pop){

    cali <- map_data("county") %>%
      filter(region == r)

    cali_pop <- left_join(cali, pop, by = c("subregion","region"))

    cali_pop$pop_cat <- with(cali_pop,
                             (paste0(cali_pop$subregion, "<br />",
                                     round(cali_pop$MedianBackers), "Median Backers ||",round(cali_pop$MedianUSD),"MedianUSD","<br />",
                                     round(cali_pop$MeanBackers), "Mean Backers ||",round(cali_pop$MeanUSD),"MeanUSD","<br />",
                                     (cali_pop$TotalBackers), "Total Backers ||",(cali_pop$TotalUSD), "TotalUSD")))
    cali_pop[is.na(cali_pop)] <- 0
    cali_pop$pop_cat <- as.factor(cali_pop$pop_cat)

    p <- cali_pop %>%
      group_by(group) %>%
      plot_ly(x = ~long, y = ~lat, color = ~pop_cat, colors = c('#ffeda0','#f03b20')) %>%
      add_polygons(line = list(width = 0.4),showlegend = FALSE) %>%
      add_polygons(
        fillcolor = 'transparent',
        line = list(color = 'black', width = 0.5),
        showlegend = FALSE
      ) %>%
      layout(
        title = "Backers by County",
        titlefont = list(size = 10),
        xaxis = list(title = "", showgrid = FALSE,
                     zeroline = FALSE, showticklabels = FALSE),
        yaxis = list(title = "", showgrid = FALSE,
                     zeroline = FALSE, showticklabels = FALSE)
      )
    p

  }  

  output$Smap <- renderPlotly({
    M$hover <- with(M, paste(State))
    # give state boundaries a white border
    l <- list(color = toRGB("white"), width = 2)
    # specify some map projection/options
    g <- list(
      scope = 'north america',
      showland = TRUE,
      landcolor = toRGB("grey83"),
      subunitcolor = toRGB("white"),
      countrycolor = toRGB("white"),
      showlakes = TRUE,
      lakecolor = toRGB("white"),
      showsubunits = TRUE,
      showcountries = TRUE,
      resolution = 50,
      projection = list(type = 'conic conformal',
                        rotation = list(lon = -100)),
      lonaxis = list(
        showgrid = TRUE,
        gridwidth = 0.5,
        range = c(-140,-55),
        dtick = 5
      ),
      lataxis = list(
        showgrid = TRUE,
        gridwidth = 0.5,
        range = c(15, 70),
        dtick = 5
      )
    )

    # Plotting a US interactive map
    p <- plot_geo(source = "CCM") %>%
      add_trace(M,
        z = ~ M$`Mean Bakers`,
        text = ~ M$hover,
        x = ~M$State,
        locations = ~ M$code,
        locationmode = "USA-states"
      ) %>%
      colorbar(title = "Money") %>%
      layout(
        title = 'Kickstarter USA',
        geo = g
      )
    p
  })

  output$Cmap <- renderPlotly({
    s <- event_data("plotly_click", source = "CCM")

    if (length(s)){

      var <- s[["x"]]
      d <- setNames(M[var], "x")
      CT(d,H,C)
    }
  })

  output$plotBar1 <- renderPlotly({
    p1 <- d_s %>% count(City, status) %>%
      plot_ly(x = ~ City,
              y = ~ n,
              color = ~ status)
    p1

  })

  output$plotBar2 <- renderPlotly({
      p2 <- H %>% count(Categories, status) %>%
        plot_ly(x = ~ Categories,
                y = ~ n,
                color = ~ status)

      p2
    })

  output$plotMap <- renderPlotly({
    #preparing the hover text
    M$hover <- with(
      M,
      paste(
        State,
        '<br>',
        "Pledges_total",
        M$`Total Pledged`,
        "Backers_total",
        M$`Total Backers`,
        "<br>",
        "Mean_pledges",
        M$`Mean Campaign USD`,
        "Mean_backers",
        M$`Mean Bakers`,
        "<br>",
        "Median Goal %",
        M$`Median Percent of Goal`,
        "Number of projects",
        M$`Projects Per`
      )
    )

    g <- list(
      scope = 'north america',
      showland = TRUE,
      landcolor = toRGB("grey83"),
      subunitcolor = toRGB("white"),
      countrycolor = toRGB("white"),
      showlakes = TRUE,
      lakecolor = toRGB("white"),
      showsubunits = TRUE,
      showcountries = TRUE,
      resolution = 50,
      projection = list(type = 'conic conformal',
                        rotation = list(lon = -100)),
      lonaxis = list(
        showgrid = TRUE,
        gridwidth = 0.5,
        range = c(-140,-55),
        dtick = 5
      ),
      lataxis = list(
        showgrid = TRUE,
        gridwidth = 0.5,
        range = c(15, 70),
        dtick = 5
      )
    )

    #plotting an interactive map for states and cities
    p <- plot_geo(H, sizes = c(5, 250)) %>%
      add_markers(
        x = ~ H$Longitude,
        y = ~ H$Latitude,
        size = ~ H$All_Time_Backers_city,
        color = ~ q,
        text = ~ paste(H$City, "<br />",
                       H$All_Time_Backers_city, "Backers")
      ) %>%
      add_trace(M,
                z = ~ M$`Mean Campaign USD`,
                text = ~ M$hover,
                locations = ~ M$code
                ,
                locationmode = "USA-states"
      ) %>%
      layout(title = 'Backers City All Time', geo = g)
    p

  })

  output$plotInt <- renderPlotly({
    p <- H %>%
      plot_ly() %>%
      add_trace(
        type = 'parcoords',
        line = list(
          color = ~ backers_count,
          colorscale = 'Jet',
          showscale = TRUE,
          reversescale = TRUE,
          cmin = 2,
          cmax = 1500
        ),
        dimensions = list(
          list(
            range = c(0, 92),
            constrantrange = c(0, 30),
            label = 'Time',
            values = ~ Length_of_kick
          ),
          list(
            range = c(0, 2000),
            constraintrange = c(0, 1000),
            label = 'Pledge USD',
            values = ~ Pledge_per_person
          ),
          list(
            range = c(0, 8000000),
            constrantrange = c(0, 3000000),
            label = 'Population',
            values = ~ MasterKickstarter$City_Pop
          ),
          list(
            range = c(0, 1600),
            constraintrange = c(0, 500),
            label = 'Days Making',
            values = ~ Days_spent_making_campign
          ),
          list(
            tickvals = c(1, 2, 3, 4, 5),
            ticktext = c('cancled', 'failed', 'live', 'successful', 'suspended'),
            label = 'Status',
            values = ~ as.integer(as.factor(status))
          ),
          list(
            range = c(0, 1000000),
            constraintrange = c(0, 300000),
            label = 'Goal',
            values = ~ goal
          ),
          list(
            tickvals = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15),
            ticktext = c(
              'art',
              'comics',
              'crafts',
              'dance',
              'design',
              'fasion',
              'film',
              'food',
              'games',
              'journalism',
              'music',
              'photogaphy',
              'publishing',
              'technology',
              'theator'
            ),
            label = 'Catigories',
            values = ~ as.integer(as.factor(Categories))
          ),
          list(
            range = c( ~ min(Prct_goal), 1200),
            constraintrange = c(0, 500),
            label = 'Prct goal',
            values = ~ Prct_goal
          )
        )
      )
    p
  })

}

shinyApp(ui, server)