Есть ли способ, чтобы формы виджетов листовки можно было кликать с привязкой к статическому HTML-выводу в R? - PullRequest
0 голосов
/ 29 апреля 2019

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

1 Ответ

1 голос
/ 29 апреля 2019

Я рекомендую использовать комбинацию flexdashboard и crosstalk в тандеме с leaflet и DT.Приведенный ниже пример может быть передан в виде статического html-файла при привязке к flex_dashboard:

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

##

### 

Получить дополнительную информацию / см. Дополнительные примеры здесь:

Flex: https://rmarkdown.rstudio.com/flexdashboard/index.html

перекрестные помехи: https://rstudio.github.io/crosstalk/index.html

...