首页 文章

使用Shiny中的selectInput从API过滤数据

提问于
浏览
0

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

标签每隔几分钟更换一次,但位置坐标每隔几秒就会改变一次 .

我在服务器端使用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

    我将使用您提供的最小示例和小数据集 . 您可以根据需要调整我的示例,但我想向您展示反应数据集的使用,以便您可以按标签过滤 .

    你在寻找类似的东西:

    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)
    

相关问题