Popups不使用传单和&闪亮

时间:2015-04-23 08:03:20

标签: r leaflet shiny

我无法使用Leaflet包让弹出窗口在我的Shiny应用程序中工作。该应用程序也使用shinydashboard包。我基本上复制了SuperZip示例中的代码。该示例在本地工作正常,但不在我的应用程序中。在我的server.R文件下方。

有什么可能导致问题的线索?

谢谢!

  library(shiny)
  library(leaflet)

  function(input, output, session) {

    mapp <- createLeafletMap(session, "map")

    # Filter the dataset
    visit_data_f <- reactive({
      s <- as.POSIXct(input$period[1], format = "%Y-%m-%d")
      e <- as.POSIXct(input$period[2], format = "%Y-%m-%d")
      hour(s) <- 23; minute(s) <- 59; second(s) <- 59;
      hour(e) <- 23; minute(e) <- 59; second(e) <- 59;
      d <- filter(visit_data, started_on >= s, started_on <= e)
      if (input$district != "Tous") {
        d <- filter(d, district == input$district)
      }
      d
    })

    geo_data <- reactive({
      data <- visit_data_f()
      data$site_code <- factor(data$site_code)

      # Sync lag
      d <- data.frame(sync_lag(data, "site_code"))
      d <- cbind(rownames(d), d)
      colnames(d) <- c("site_code", "sync_lag")
      d <- mutate(d, sync_lag = round(as.numeric(sync_lag), 2))
      d <- arrange(d, site_code)

      # Consults
      consults <- data.frame(table(data$site_code))
      colnames(consults) <- c("site_code", "n_consults")
      consults <- arrange(consults, site_code)
      d <- mutate(d, n_consults = consults$n_consults)

      # Coordinates
      d <- merge(d, locations_data, by.x = "site_code", by.y = "site_code")
      d <- filter(d, !is.na(latitude))
      d$id <- seq(1:nrow(d))
      d
    })

    session$onFlushed(once = TRUE, function() {
      paintObs <- observe({
        data <- geo_data()

        mapp$clearShapes()
        mapp$clearMarkers()

        if (input$geo_data == "position") {
          mapp$addMarker(data$latitude, data$longitude)
        } else if (input$geo_data == "n_consults") {
          radius <- data$n_consults
          mapp$addCircle(data$latitude, data$longitude, radius * 5, data$id, list(stroke = F, fill = T, fillOpacity = 0.4))
        } else {
          radius <- data$sync_lag
          mapp$addCircle(data$latitude, data$longitude, radius * 150, data$id, list(stroke = F, fill = T, fillOpacity = 0.4))
        }
      })

      session$onSessionEnded(paintObs$suspend)
    })

    showInfoPopup <- function(id, lat, lng) {
      content <- paste("CSPS :", id)
      mapp$showPopup(lat, lng, content, id)
    }

    clickObs <- observe({
      mapp$clearPopups()
      event <- input$mapp_shape_click
      if (is.null(event)) {
        print("-- NULL")
        return()
      }
      isolate({
        showInfoPopup(event$id, event$lat, event$lng)
      })
    })

    session$onSessionEnded(clickObs$suspend)
  }

0 个答案:

没有答案