使用Shiny

时间:2018-08-03 21:09:54

标签: r shiny r-leaflet shiny-reactivity

因为很多天我无法解决我的问题。一开始,我从API获取一些数据(我每5秒刷新一次API调用以获取最新数据)。数据包含有关位置(纬度和经度)的信息,以及一些写入这些位置的标签。我想创建一个selectInput对象,并使用分配给标签的选项。如果我从selectInput对象的下拉列表中选择标签,我想在5秒内同时过滤下一个API调用。主要任务是从下拉列表中选择一个值后,过滤地图上可见的数据。

标签每隔几分钟更改一次,但是位置坐标每隔几秒钟更改一次。

我在服务器端使用renderUI,在UI端使用uiOutput。希望获得帮助,谢谢。

library("httr")
library("jsonlite")
library("shiny")
library("leaflet")
library("dplyr")


ui <- shinyUI(fluidPage(
  navbarPage("Title",
             tabPanel("MAP",

                      leafletOutput("mymap", width = "auto", height = "560px")
             )
  ),
  uiOutput("loc")
  )
  )

server <- shinyServer(function(input, output) {

  autoInvalidate <- reactiveTimer(5000)

  reData <- eventReactive(autoInvalidate(), {

    # # example data
    # lat <- c(20.51,20.52,20.65)
    # long <- c(10.33,13.43,23.54)
    # labels <- c('John','Peter','Jolie')
    # data <- data.frame(lat, long, labels)

    # API call #1 response
    get_data <- GET(call1)
    get_data_text <- content(get_data, "text")
    get_data_json <- fromJSON(get_data_text, flatten = TRUE)
    data <- get_data_json$result

    # handling empty API response
    while(class(data) == "list"){
      Sys.sleep(1)
      get_trams <- GET(call1)
      get_data_text <- content(get_data, "text")
      get_data_json <- fromJSON(get_data_text, flatten = TRUE)
      data <- get_data_json$result
    }


    # saving data before filtering - purpose of getting labels for the drop-down list and
    # creating a sorted list for selectInput function
    list_of_vals <- data
    uniq_first_lines <- c("all", unique(as.character(sort(as.numeric(list_of_vals$FirstLine)))))
    sorted_factor <- factor(uniq_first_lines, levels=uniq_first_lines)
    my_new_list <- split(uniq_first_lines, sorted_factor)


    # filter data
    if(input$loc != "all") {
      data <- data %>%
      filter_at(
        vars(one_of("FirstLine")),
        any_vars(.==input$loc))
    }

    rownames(data) <- NULL


    return(list(data=data, my_new_list=my_new_list))
  }, ignoreNULL = FALSE)


  output$loc <-renderUI({
    selectInput("loc", label = h4("Choose location"),
                choices = reData()$my_new_list ,selected = "all"
    )
  })


  points <- eventReactive(autoInvalidate(), {
    cbind(reData()$trams_data$Lon, reData()$trams_data$Lat)
  },ignoreNULL = FALSE)

  labels <- eventReactive(autoInvalidate(), {
    paste("line: ", reData()$trams_data$FirstLine)
  },ignoreNULL = FALSE)

  output$mymap <- renderLeaflet({
    leaflet() %>%
      addTiles()
  })

  observeEvent(autoInvalidate(), {
    leafletProxy("mymap") %>%
      clearMarkers() %>%
      addMarkers(
        data = points(),
        label = labels()
      )
  },ignoreNULL = FALSE)
})


shinyApp(ui, server)

1 个答案:

答案 0 :(得分:0)

我将使用一个最小的示例以及您提供的小型数据集。您可以根据需要调整我的示例,但我想向您展示使用反应式数据集,以便您可以按标签进行过滤。

您是否正在寻找类似的东西:

library("httr")
library("jsonlite")
library("shiny")
library("leaflet")
library("dplyr")


# # example data
lat <- c(20.51,20.52,20.65)
long <- c(10.33,13.43,23.54)
labels <- c('John','Peter','Jolie')
data <- data.frame(lat, long, labels)


ui <- shinyUI(fluidPage(
  navbarPage("Title",
             tabPanel("MAP",
                      leafletOutput("mymap", width = "auto", height = "560px")
             )
  ),
  uiOutput("labels")
)
)

server <- shinyServer(function(input, output) {


  output$labels <- renderUI({
       selectInput("labels", label = h4("Choose label"), choices = c("John", "Peter", "Jolie") ,selected = "John")

  })


  reData <- reactive({

    autoInvalidate <- reactiveTimer(5000)
    data <- data %>% dplyr::filter(input$labels == labels)

  })

  output$mymap <- renderLeaflet({
    leaflet(reData()) %>%
      setView(10, 20, zoom = 5) %>%
      addTiles() %>%
    addMarkers()
  })

#  observeEvent(autoInvalidate(), {
 #   leafletProxy("mymap") %>%
  #    clearMarkers() %>%
   #   addMarkers(
    #    data = points(),
     #   label = labels()
    #  )
#  },ignoreNULL = FALSE)


})


shinyApp(ui, server)