当sharedData指向尚未加载的文件时,如何在Shiny中使用串扰?

时间:2019-01-24 15:18:05

标签: r shiny

我想要一个Shiny应用程序,该应用程序可以导入文件,在该文件的列上进行过滤,然后根据该文件中的数据显示数据表和Plotly图表。我想使用串扰库使用户能够从这些对象(选择过滤器,图表,表)中进行选择,从而动态更新其他对象。串扰依赖于shared_df <- SharedData$new(myreactive_importfile())

形式的sharedData对象

这对于预先存在的数据帧(例如here)是可行的,在该数据帧中,可以在ui和服务器功能之外(因为它存在)来设置sharedData对象。当依靠共享文件时,如何设置sharedData对象?总结一下:

  • 我无法在ui和服务器外部设置sharedData对象,因为该文件尚未导入。

  • 我不能将其放在ui内,因为它不是ui对象

  • 我无法将其放在服务器内部,因为ui需要filter_select()函数允许的选项的sharedData对象。

对于已经存在的数据帧(虹膜,火山等),然后在UI和服务器上方放置一个诸如sd <- SharedData$new(iris)之类的sharedData语句即可。问题是使用反应性数据框架来存储上载的文件。

以下代码很长,但是重要的变量是shared_df,df和从input $ file1导入的文件。

library(shiny)
library(DT)
library(leaflet)
library(crosstalk)

shared_df <- SharedData$new(df)

ui <- fluidPage(
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(width = 2,

      # Input: Select a file ----
      fileInput("file1", "Choose CSV File",
                multiple = FALSE,
                accept = c("text/csv",
                           "text/comma-separated-values,text/plain",
                           ".csv")),

      # Horizontal line ----
      tags$hr(),

      #select by asset - cross-talk
      filter_select("asset", "Select Asset:",
                    shared_df,
                    ~AssetID,
                    multiple = TRUE),
    mainPanel(width = 10,
      tabsetPanel(
        tabPanel("Map",
                 leafletOutput("map")
        ),

        tabPanel("Chart"

        ),
        tabPanel("Tables",
        # Output: Data file ----
        DTOutput("contents")
        )

        )
      )
    )

  )
)

server <- function(input, output, session) {

df <- eventReactive(input$file1, {  
  req(input$file1)  
  # when reading semicolon separated files,
  # having a comma separator causes `read.csv` to error
  tryCatch(
    {
        df <- read.csv(input$file1$datapath,
                       header = TRUE,
                       sep = ",",
                       stringsAsFactors = TRUE,
                       row.names = NULL) %>%
          spread(2, 3)
    },
    error = function(e) {
      # return a safeError if a parsing error occurs
      stop(safeError(e))
    }
  )
})



#>> Asset select choices update ----
observeEvent(input$file1,{
  updateSelectInput(session, "asset",
                    choices = unique(df()[[1]]))
})

  output$contents <- renderDT({

    datatable(data = df(),
    # if(input$disp == "head") {
    #   return(head(df()))
    # }
    # else {
    #   return(df())
    # },
    rownames = FALSE,
    style = "bootstrap"
    )
  })

  # Compare edits with original file. Store in "changes"
  dtchange <- reactive({
    df() %>% slice(input$contents_rows_selected)
  })

   output$changes <- renderDT({
     req(input$contents_rows_selected)
     datatable(dtchange(), editable = TRUE,
               rownames = FALSE,
               extensions = c("Buttons"),
                                 options = list(dom = "Bfrtip",
                                                buttons = c("copy", "csv", "excel"))
              )
     }, server = FALSE)
#> Mapping ----
   sheffield <- geocode("sheffield", source = "dsk")
   sites <- eventReactive(input$file1, {
     data.frame(ID = unique(df()$AssetId), 
                lon = rnorm(n_distinct(df()$AssetId), sheffield$lon, 0.01),
                lat = rnorm(n_distinct(df()$AssetId), sheffield$lat, 0.01))
   }
   )

      output$map <- renderLeaflet(
        leaflet(sites()) %>%
          #addTiles() %>%
          addProviderTiles(providers$Stamen.TonerLite) %>% 
          setView(sheffield$lon, sheffield$lat, zoom = 12) %>%
          addMarkers()
      )

   #>> store asset selection here
      asset.list <- reactive({
        input$asset
      })

      #>>  map proxy to store incremental changes ----
      observe({
          sites.selected <- sites() %>%
            filter(ID %in% asset.list())

          leafletProxy("map", data = sites()) %>%
            clearShapes() %>%
            addCircles(fillColor = "burlywood",
                       color = "goldenrod",
                       label = sites()$ID,
                       labelOptions = labelOptions(noHide = TRUE,
                                                   direction = "top",
                                                   textOnly = TRUE,
                                                   style = list("color" = "goldenrod",
                                                                "font-size" = "10px",
                                                                "font-style" = "bold")
                       )
            ) %>%
            addCircles(data = sites.selected,
                       fillColor = "red",
                       color = "black"
                      )
        })
}

shinyApp(ui, server)

0 个答案:

没有答案