来自传单中用户输入的突出显示标记 - R Shiny

问题描述

我正在尝试根据用户输入滑块突出显示地图中的点。如果该点在某个日期范围内，请更改颜色，如果不在，则默认为黑色。

#server
    shinyServer(function(input,output,session) {
   
        output$myMap <- renderLeaflet({
    
            leaflet() %>%
                addTiles()%>%
                addCircles(data=df,# ~Longitude,# ~Latitude,group = "myMarkers",label = ~htmlEscape(date))
        })
        
        observeEvent(input$selectvariable,{
        mydat$col_format<- ifelse(mydat$Date >= input$falltime[1] & mydat$Date <= input$falltime [2],'blue',ifelse(mydat$Date >= input$springtime[1] & mydat$Date <= input$springtime [2],'black',ifelse (mydat$Date,'yellow')) )

            leafletProxy("myMap") %>%
                clearGroup("myMarkers") %>%
                addCircles(data = df[df$AnimlID == input$selectvariable,],#~ mydat$Longitd,#~ mydat$Latitud,col = mydat$col_format,label = ~htmlEscape(date)
                         )
        })
    })

#ui shinyUI(dashboardPage(#skin = "black",dashboardHeader(title = "Mapping Test",titleWidth = 350
),dashboardSidebar(width = 350,selectInput("selectvariable",label = h4("Select an D:"),choices =  unique(df$id)),sliderInput("falltime","NSD Fall Slider:",min = min,max = max,value = c(min,max)),verbatimtextoutput("dateText"),sliderInput("springtime","NSD Spring Slider:",actionButton("submit",("Submit"))),dashboardBody(fluidPage(
           Box( plotOutput("plotlraj")),Box( leafletoutput("myMap")),Box(DT::dataTableOutput("Table"),)
                
        ),)
))

使用上面的代码，我没有收到任何错误，但地图加载速度非常慢，而且无论滑块输入设置为什么日期范围，点始终为蓝色。

我也尝试添加这个反应块，但同样，即使我更改滑块日期范围，所有点都是蓝色的

    colorpal<- reactive({
    
        if(mydat$Date >= input$falltime[1] & mydat$Date <= input$falltime [2]){
            mydat[,'seasonColor']<-'#626262'
        }
        if(mydat$Date >= input$springtime[1] & mydat$Date <= input$springtime [2]){
            mydat[,'seasonColor']<-'#BAF218
'
        }

解决方法

使用 quakes 以便其他人可以复制。

在 filtered_df 反应式函数中，根据您的喜好操作您的 data.frame。我更喜欢使用 dplyr，但显示的是基础 R。

req() 用于确保这些输入具有值。

传单实例化中不需要 addCircles()。 observe 响应式将负责在 filtered_df() 准备好后以及此后每次更改时显示圆圈。

为简洁起见，仅显示服务器代码。

    output$myMap <- renderLeaflet({
        leaflet() %>%
            addTiles()
    })
    
    filtered_df <- reactive({
        req(input$depth_slider,input$mag_slider)
        
        filtered_df <- quakes[quakes$depth <= input$depth_slider,]
        filtered_df[filtered_df$mag <= input$mag_slider,'Strength'] <- 'Weak'
        filtered_df[filtered_df$mag > input$mag_slider,'Strength'] <- 'Strong'
        return(filtered_df)
    })
    
    observe({
        filtered_df <- filtered_df()
        pal <- colorFactor(c('Green','Red'),domain = filtered_df$Strength)
        
        leafletProxy('myMap') %>%
            clearGroup('myMarkers') %>%
            clearControls() %>%
            addCircles(
                data = filtered_df,lng = ~long,lat = ~lat,group = 'myMarkers',color = ~pal(Strength)
            ) %>%
            addLegend(
                pal = pal,values = filtered_df$Strength
            )
    })