Мне бы хотелось, чтобы приложение Shiny импортировало файл, отфильтровывало столбец этого файла и затем отображало диаграмму данных и диаграмму Plotly из данных в этом файле.Я хотел бы использовать библиотеку перекрестных помех, чтобы позволить пользователю сделать выбор из любого из этих объектов (фильтр выбора, диаграмма, таблица), который динамически обновляет другие объекты.Crosstalk опирается на объект sharedData в форме shared_df <- SharedData$new(myreactive_importfile())
Это возможно для уже существующего фрейма данных (например, здесь ), где установка объекта sharedData может быть выполнена внеПользовательский интерфейс и функции сервера (потому что он существует).Как установить объект sharedData, если он основан на импортированном файле?Подводя итог:
Я не могу установить объект sharedData вне пользовательского интерфейса и сервера, потому что файл еще не импортирован.
Я не могу поставитьэто внутри пользовательского интерфейса, потому что это не объект пользовательского интерфейса
Я не могу поместить его в сервер, потому что пользовательский интерфейс нуждается в объекте sharedData для параметров, разрешенных в функции filter_select ().
Для уже существующего фрейма данных (радужная оболочка, вулкан и т. Д.) Размещение оператора sharedData, например sd <- SharedData$new(iris)
над пользовательским интерфейсом, и сервер работает нормально.Проблема заключается в использовании реактивного фрейма данных, в котором хранится загруженный файл.
Следующий код длинный, но важными переменными являются shared_df, df и импортированный файл из входных данных $ 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)