我试图创建一个Rmarkdown文件，最终可以将其编织到HTML文档中以进行共享。 目标是拥有一个可点击的地图（提供示例），用户可以在其中单击地图形状，然后将这些选择添加到摘要数据表中。我还包括了复选框，以便用户可以取消选择选项。 我可以使用Shiny来运行它，但是我无法根据需要编织到HTML文档。
我的理解是，这里的问题是使用Shiny。有人可以帮助我找到一种无需使用Shiny即可拥有这些功能的方法吗？我可以自己编织传单，但不确定我需要的所有其他物品。
---
title: "Sample"
runtime: shiny
output: html_document
---
library(leaflet) # For map plotting
library(dplyr)
library(shiny)
library(DT) # Interactive HTML tables
server <- function(input, output, session) {
full_list <- list(matrix(c(0,0,50,0,50,50,0,50),ncol=2,byrow = TRUE),
matrix(c(0,50,0,100,50,100,50,50),ncol=2,byrow = TRUE),
matrix(c(50,0,50,25,75,25,75,75,100,75,100,0),ncol=2,byrow = TRUE),
matrix(c(50,25,50,75,75,75,75,25),ncol=2,byrow = TRUE),
matrix(c(50,75,50,100,100,100,100,75),ncol=2,byrow = TRUE))
full_colors <- c("blue","green","grey","yellow","orange")
full_namen <- c("blue","green","grey","yellow","orange")
color_info <- data.frame(Color=c(rep("Blue",100),rep("Green",200),rep("Grey",300),rep("Yellow",400),rep("Orange",500)),
Variable=rnorm(1500,mean=5,sd=1))
output$Map <- renderLeaflet({
leaflet(options = leafletOptions(crs = leafletCRS(crsClass = "L.CRS.Simple"))
)%>% addPolygons(
(full_list[[1]][,1]),
(full_list[[1]][,2]),layerId="Blue",
stroke = TRUE, color="black", smoothFactor = 1,
fillOpacity=1,
fillColor = "blue"
)%>% addPolygons(
(full_list[[2]][,1]),
(full_list[[2]][,2]),layerId="Green",
stroke = TRUE, color="black", smoothFactor = 1,
fillOpacity=1,
fillColor = "green"
)%>% addPolygons(
(full_list[[3]][,1]),
(full_list[[3]][,2]),layerId="Grey",
stroke = TRUE, color="black", smoothFactor = 1,
fillOpacity=1,
fillColor = "grey"
)%>% addPolygons(
(full_list[[4]][,1]),
(full_list[[4]][,2]),layerId="Yellow",
stroke = TRUE, color="black", smoothFactor = 1,
fillOpacity=1,
fillColor = "yellow"
)%>% addPolygons(
(full_list[[5]][,1]),
(full_list[[5]][,2]),layerId="Orange",
stroke = TRUE, color="black", smoothFactor = 1,
fillOpacity=1,
fillColor = "orange"
) %>% addLabelOnlyMarkers(25,25,label="Blue",labelOptions = labelOptions(noHide = T, textOnly = TRUE,
direction="center",
style=list("color"="white",
"font-style"="bold",
"font-size"="16px"))
)%>% addLabelOnlyMarkers(25,75,label="Green",labelOptions = labelOptions(noHide = T, textOnly = TRUE,
direction="center",
style=list("color"="white",
"font-style"="bold",
"font-size"="16px"))
)%>% addLabelOnlyMarkers(75,12.5,label="Grey",labelOptions = labelOptions(noHide = T, textOnly = TRUE,
direction="center",
style=list("color"="white",
"font-style"="bold",
"font-size"="16px"))
)%>% addLabelOnlyMarkers(62.5,50,label="Yellow",labelOptions = labelOptions(noHide = T, textOnly = TRUE,
direction="center",
style=list("color"="black",
"font-style"="bold",
"font-size"="16px"))
)%>% addLabelOnlyMarkers(75,87.5,label="Orange",labelOptions = labelOptions(noHide = T, textOnly = TRUE,
direction="center",
style=list("color"="black",
"font-style"="bold",
"font-size"="16px"))
)
})
selctd <- reactive(unlist(input$mult))
observeEvent(input$Map_shape_click, {
p <- input$Map_shape_click
#print(p$id)
#print(selctd())
updateCheckboxGroupInput(session, "mult", choices = sort(unique(c(p$id,c("Blue","Green","Grey","Yellow","Orange")))), selected = unique(c(p$id,selctd())))
})
observe({
id_select <- input$mult
tabel <- color_info[color_info$Color %in% id_select,]
if(nrow(tabel)>0){
totals <- c(apply(tabel[,2,drop=FALSE],2,function(x) c(Mean=round(mean(x),2),StdDev=round(sd(x),2),N=round(length(x),0))))
tabel <- aggregate(.~ Color, data=tabel, FUN=function(x) c(Mean=round(mean(x),2),StdDev=round(sd(x),2),N=round(length(x),0)))
tabelkeep <- as.data.frame(tabel$Variable)
tabel$Color <- as.character(tabel$Color)
tabelkeep <- cbind(tabel$Color,tabelkeep)
names(tabelkeep)[1] <- "Color"
tabelkeep$Color <- as.character(tabelkeep$Color)
tabelkeep <- rbind(tabelkeep,c("Total",totals))
tabel <- tabelkeep
}
#print(tabel)
output$Table <- renderDataTable({ tabel %>%
datatable() %>%
formatStyle(
0,
target = "row",
fontWeight = styleEqual(nrow(tabel), "bold")
) })
})
}
ui <- fluidPage(
leafletOutput("Map", "100%", 650),
wellPanel(checkboxGroupInput("mult","Regions:",choices=c("Blue"="Blue","Green"="Green","Grey"="Grey","Yellow"="Yellow","Orange"="Orange"))),
dataTableOutput("Table")
)
shinyApp(ui, server)
当前，我可以将输出另存为.Rmd。我希望能够将文档编织为HTML。任何想法表示赞赏。
答案 0 :(得分：1)
我的建议是结合使用flexdashboard和crosstalk与leaflet和DT的组合。编织到flex_dashboard时，以下示例可以作为静态html文件共享：
---
title: "Flexdashboard with Crosstalk, Leaflet and DT"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(crosstalk)
library(leaflet)
library(dplyr)
library(DT)
```
# Page 1
##
### Map and Filter
```{r}
# Wrap data frame in SharedData
sd <- SharedData$new(quakes[sample(nrow(quakes), 100), ])
# Create a filter input
filter_slider("mag", "Magnitude", sd, column = ~mag, step = 0.1, width = 250)
# Use SharedData like a dataframe with Crosstalk-enabled widgets
leaflet(sd) %>%
addTiles() %>%
addMarkers()
```
### DataTable
```{r}
datatable(sd,
extensions = "Scroller", style = "bootstrap", class = "compact", width = "100%",
options = list(deferRender = TRUE, scrollY = 300, scroller = TRUE)
)
```
# Page 2
##
###
获取更多信息/在此处查看更多示例：