Я пытаюсь создать файл 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.Любые идеи приветствуются.