在传单的标题中添加选定点的摘要

Question

我正在尝试使用 R 显示传单地图（我无法使用 ShinyApp 包）。我想在传单标题（或地图中的任何地方）中显示所选点的列的平均值，如下图所示：

这是我的尝试：

library(dplyr)
library(leaflet) 
library(DT)
library(crosstalk)

data_2 <- data.frame(ID=c(1:8),
                 Name1 = c("A", "A", "A", "C", "B", "B", "A", "B"),
                 Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
                 Value1 = c(12,43,54,34,23,77,44,22),
                 Value2 = c(6,5,2,7,5,6,4,3),
                 Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 54.3, 60.4, 49.2),
                 Lon = c(5, -3, -2, -1, 4, 3, -5, 0))
data_2<-data_2 %>%
  mutate(
lab_DB = case_when(
  Name1 == unique(data_2$Name1)[1]  ~ "blue",
  Name1 == unique(data_2$Name1)[2]  ~ "green",
  Name1 == unique(data_2$Name1)[3]  ~  "red"
  
    )
  )
data_2$ID <- as.character(data_2$ID)
sdf <- SharedData$new(data_2, ~data_2$ID)
ltlf5<- leaflet(sdf) %>% 
  #addProviderTiles(providers$CartoDB.Positron) %>%
  addTiles() %>%
  addCircleMarkers(
               lng = ~Lat,
               lat = ~Lon,
               group = ~Name1,popup = ~paste(Name1, '   <br/>  ',
                                                Name2,'   <br/>  ' ),
               color =~lab_DB ,
               radius = 3
 )   %>%
 addLayersControl(

overlayGroups = c('A','B','C')
,options = layersControlOptions(collapsed = FALSE)
  ) %>%
  addLegend(
position = 'bottomleft',
labels = c('Group A','Group B','Group C'),
colors = c("blue","red", "green"),
title = "number of observation"
  ) 
bscols(ltlf5 ,
datatable(sdf , width = "100%",editable=TRUE,caption = paste("mean of Value1:",mean(sdf$data()$Value1)))
)

但不幸的是，它显示的是列 'Value1' 的平均值，而不是选定点的列 'Value1' 的平均值。那怎么办呢？

Answer 1

您要查找的包是 SummaryWidget：

https://kent37.github.io/summarywidget

安装方式：

devtools::install_github("kent37/summarywidget")

如果您不想将汇总统计信息放在 Rmarkdown 文档段落中，这非常好用，如上文 link 所示。但是把它放在数据表的标题中有点困难。

老实说，我发现相声是一个工作的噩梦。它似乎从来没有像我想要的那样工作，并且没有您期望的灵活性。下面是在数据表的标题中获取此内容的令人作呕的技巧。不要试图去理解它，我不会。你必须安装 shiny 才能工作，因为我们需要它的功能。

如果其他人想尝试 XD，几乎可以肯定有更好的方法来做到这一点

library(dplyr)
library(leaflet) 
library(DT)
library(crosstalk)
library(summarywidget)
library(shiny) # <- SHINY 

data_2 <- data.frame(ID=c(1:8),
                     Name1 = c("A", "A", "A", "C", "B", "B", "A", "B"),
                     Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
                     Value1 = c(12,43,54,34,23,77,44,22),
                     Value2 = c(6,5,2,7,5,6,4,3),
                     Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 54.3, 60.4, 49.2),
                     Lon = c(5, -3, -2, -1, 4, 3, -5, 0))
data_2<-data_2 %>%
  mutate(
    lab_DB = case_when(
      Name1 == unique(data_2$Name1)[1]  ~ "blue",
      Name1 == unique(data_2$Name1)[2]  ~ "green",
      Name1 == unique(data_2$Name1)[3]  ~  "red"
      
    )
  )
data_2$ID <- as.character(data_2$ID)
sdf <- SharedData$new(data_2, ~ID)
ltlf5<- leaflet(sdf) %>% 
  #addProviderTiles(providers$CartoDB.Positron) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~Lat,
    lat = ~Lon,
    group = ~Name1,popup = ~paste(Name1, '   <br/>  ',
                                  Name2,'   <br/>  ' ),
    color =~lab_DB ,
    radius = 3
  )   %>%
  addLayersControl(
    
    overlayGroups = c('A','B','C')
    ,options = layersControlOptions(collapsed = FALSE)
  ) %>%
  addLegend(
    position = 'bottomleft',
    labels = c('Group A','Group B','Group C'),
    colors = c("blue","red", "green"),
    title = "number of observation"
  ) 
bscols(widths=c(6,6,0),ltlf5 ,
       datatable(sdf , width = "100%",editable=TRUE, caption=tags$caption("Mean of Value1: ",summarywidget(sdf, statistic='mean', column='Value1'))), 
       htmltools::p(summarywidget(sdf, statistic='mean', column='Value1'), style="display:none;")
      )

在传单的标题中添加选定点的摘要

Add summary of selected points in the caption in leaflet

javascript

r

leaflet