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

Question

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

#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,
                           group = "myMarkers",
                           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:",
                                             min = min, max = max, value = c(min, max)),
                                 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
'
        }

Answer 1

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

在 filtered_df 反应函数中，根据需要操纵 data.frame。我更喜欢使用 dplyr，但我显示的是 base R。

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

传单实例化中不需要addCircles()。一旦 filtered_df() 准备就绪，observe 反应式将负责显示圆圈，之后每次更改时。

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

    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
            )
    })

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

Highlight marker from user input in leaflet - R Shiny

r

shinydashboard

r-leaflet

shiny-reactivity