我是新来的,所以希望我做得很好,提出了一个很好的问题!
可再现的代码将产生的是北卡罗莱纳州的地图,该地图平均分为四个地理“均匀”区域。想象一下,这是由销售经理分配给其销售人员的区域。
现在做什么:现在,此地图执行以下操作:允许您选择一个区域,然后创建两个表。第一个只是与该县相关联的附加功能的直接数据转储。然后,第二张表将这些数据分组在一起,以产生每个区域的数据总和。
我要执行的操作:假设使用此功能的人要分配新的区域。这些区域中的每一个都分配有一种颜色。 A是红色,B是蓝色,C是绿色,D是黄色。因此,他们为“ A”选择一个输入按钮,然后他开始单击变为红色的县,所有县都进行底部的所有表汇总。完成后,选择“ B”,依此类推。因此,底部的表格如下所示:
+-----------+--------------------+--------------------+
| Territory | Leads | Sales |
+-----------+--------------------+--------------------+
| A | selected agg value | selected agg value |
| B | selected agg value | selected agg value |
| C | selected agg value | selected agg value |
| D | selected agg value | selected agg value |
+-----------+--------------------+--------------------+
这有意义吗?
library(tigris)
library(mapview)
library(mapedit)
library(leaflet)
library(dplyr)
library(DT)
north_carolina <- counties("north carolina") %>% st_as_sf() %>% arrange(INTPTLON, INTPTLAT) %>% dplyr::select(NAMELSAD, geometry) %>% rename(county_name = NAMELSAD) %>%
mutate(territory = rep(letters[1:4], each = 25), leads = sample(100:1000, 100, replace = TRUE), sales = sample(100:1000, 100, replace = TRUE))
ui <- fluidPage(
h3("Map"),
selectModUI(id = "map_select"),
# Datatable Output
h3("Table"),
dataTableOutput(outputId = "BaseTable"),
h3("Reactive Output"),
dataTableOutput(outputId = "ReactTable")
)
server <- function(input, output) {
leafmap <- reactive({leaflet() %>%
addProviderTiles(providers$Stamen.Toner) %>%
addPolygons(data = north_carolina, fillOpacity = "red",
fillColor = "grey",
weight = 5,
opacity = 5,
color = "black") %>%
leafem::addFeatures(data=north_carolina,label = ~htmltools::htmlEscape(territory),
layerId = ~seq_len(length(st_geometry(north_carolina))))
})
selectMod <- function(input, output, session, leafmap,
styleFalse = list(fillOpacity = 0.2, weight = 1, opacity = 0.4),
styleTrue = list(fillOpacity = 0.7, weight = 3, opacity = 0.7))
{
print("*** custom selectMod")
output$map <- leaflet::renderLeaflet({
mapedit:::add_select_script(leafmap, styleFalse = styleFalse, styleTrue = styleTrue,
ns = session$ns(NULL))
})
id <- "mapedit"
select_evt <- paste0(id, "_selected")
df <- data.frame()
selections <- reactive({
id <- as.character(input[[select_evt]]$id)
if (length(df) == 0) {
# Initial case, first time module is called.
# Switching map, i.e. subsequent calls to the module.
# Note that input[[select_evt]] will always keep the last selection event,
# regardless of this module being called again.
df <<- data.frame(id = character(0), selected = logical(0),
stringsAsFactors = FALSE)
} else {
loc <- which(df$id == id)
if (length(loc) > 0) {
df[loc, "selected"] <<- input[[select_evt]]$selected
} else {
df[nrow(df) + 1, ] <<- c(id, input[[select_evt]]$selected)
}
}
return(df)
})
return(selections)
}
rval <- reactiveValues(
sel = reactive({}),
selectnum = NULL,
base_table = north_carolina %>%
st_set_geometry(NULL) %>%
dplyr::slice(0)
)
# Create selectMod
observeEvent(leafmap(),
rval$sel <- callModule(selectMod, "map_select", leafmap())
)
# Subset the table based on the selection
observeEvent(rval$sel(), {
# The select module returns a reactive
gs <- rval$sel()
# Filter for the county data
rval$selectnum <- as.numeric(gs[which(gs$selected == TRUE), "id"])
rval$base_table <- north_carolina %>%
st_set_geometry(NULL) %>%
dplyr::slice(rval$selectnum)
rval$react_table <- rval$base_table %>% group_by(territory) %>% summarise(leads = sum(leads), sales = sum(sales))
})
# Create a datatable
output$BaseTable <- renderDataTable({
datatable(rval$base_table, options = list(scrollX = TRUE))
})
output$ReactTable <- renderDataTable({
datatable(rval$react_table)
})
}