基于 URL 参数的初始 R Shiny 数据帧加载

Question

R 和 Shiny 的新手，正在开发我的第一个小应用程序。下面的代码可以按我的意愿工作，但现在我需要对其进行扩展，以便在加载它时在 URL 中有一个参数（类似于http://127.0.0.1:6804/?Sta_ID=1ABIR000.76），该参数在第一个查询中用于设置 wqmdata 数据帧。我已经知道如何使用 parseQueryString 函数从服务器代码块中的 URL 中获取该参数，但我不知道如何在 wqmdata 数据帧的初始数据加载中使用它？该数据框用于填充 UI 中基于特定站点的一堆内容（即每个站点可以有不同的监测水质参数列表）。

关于我正在尝试做的事情的一些背景知识。最终，pl45_wqm_data.csv 文件将被替换为调用 SQL 服务器数据库以获取应用程序的数据。该数据库有数千个监测站和数百万个观测值，所以我显然只是想带回最初调用所需的数据。这个想法是有一个可以从 ArcGIS Portal 应用程序调用的 URL，这样用户就可以使用交互式地图（带有一堆其他数据）找到一个监测站，然后单击该站以启动 R Shiny 应用程序以可视化该站的监测数据。

有什么想法可以尝试吗？

library(shiny)
library(ggplot2)
library(tidyverse)

#Get monitoring data
wqmdata <- arrange(subset(read.csv(file="~\\R\\ShinyApps\\WQMGraphURL\\pl45_wqm_data.csv"
           , fileEncoding="UTF-8-BOM"),Sta_ID == "1ABIR000.76"),Parameter,Fdt_Date_Time)

# Define UI for application that allows user to select a Parameter then get a graph
ui <- fluidPage(
    
    tags$style(type='text/css', 
               ".selectize-input {font-size: 12px; line-height: 12px;} 
        .selectize-dropdown {font-size: 11px; line-height: 11px;}"),
    
    # Give the page a title
    titlePanel(paste("DEQ Water Quality Monitoring Station Data for ",unique(wqmdata$Sta_ID))),
    hr(),
    
    # Generate a row with a sidebar
    sidebarLayout(      
        
        # Define the sidebar with one input
        sidebarPanel(
            #dropdown to select parameter to be graphed
            selectInput("SelectedParameter", "Select Parameter for Graph:", 
                        choices=unique(wqmdata$Parameter)),
            hr(),
            # Button
            downloadButton("downloadData", "Download Station Data"),
            
            helpText("Download file contains all monitoring data including field data parameters")
        ),
        
        # Create a spot for the barplot
        mainPanel(
            plotOutput("ParameterPlot")  
        )
    )
)

# Define server logic required to draw graph
server <- function(input, output, session) {
    
       GraphRecords <- reactive({
        filter(wqmdata, Parameter == input$SelectedParameter)
    })
    
    GraphRecordsRows <- reactive({nrow(filter(wqmdata, Parameter == input$SelectedParameter))})
    
    # Fill in the spot we created for a plot
    output$ParameterPlot <- 
        renderPlot({
            # Render the graph
            graph.title <- "Parameter Data Graph"
            yaxis.label <- paste(unique(GraphRecords()$Parameter)," Value")
            
            if (GraphRecordsRows() == 1) 
            { ggplot(GraphRecords(), aes(Fdt_Date_Time, Parameter_Value, group = 1)) +
                    geom_point() +
                    labs(x = "Sample Date", y = yaxis.label, title = graph.title) +
                    theme(axis.text.x = element_text(angle = 90,vjust = 0.5, hjust = 1)) +
                    geom_text(aes(label = Parameter_Value), angle = 70, hjust = 0, vjust = -0.5, size = 3) }
            else
            { ggplot(GraphRecords(), aes(Fdt_Date_Time, Parameter_Value, group = 1)) +
                    geom_point() +
                    geom_line()+
                    labs(x = "Sample Date", y = yaxis.label, title = graph.title) +
                    theme(axis.text.x = element_text(angle = 90,vjust = 0.5, hjust = 1)) +
                    geom_text(aes(label = Parameter_Value), angle = 70, hjust = 0, vjust = -0.5, size = 3) }
        })
    
    
    # Downloadable csv of selected dataset ----
    output$downloadData <- downloadHandler(
        filename = function() {
            paste(unique(wqmdata$Sta_ID), "_StationData.csv", sep = "")
        },
        content = function(file) {
            write.csv(wqmdata, file, row.names = FALSE)
        }
    )
    
}
# Run the application
shinyApp(ui = ui, server = server)

Answer 1

或多或少想通了。我在页面首次加载时收到“警告：错误：美学必须是长度 1 或与数据 (1) 相同：x，y”错误（我猜是因为 plotOutput 在提供任何数据之前运行) 但我会弄清楚如何解决这个问题。 R 中响应式数据的整个想法对我来说非常陌生，但非常酷。

这是更新的代码。我仍然需要清理一下，但这有效：

library(shiny)
library(ggplot2)
library(tidyverse)

# Define UI for application that allows user to select a Parameter then get a graph
ui <- fluidPage(
    
    tags$style(type='text/css', 
               ".selectize-input {font-size: 12px; line-height: 12px;} 
        .selectize-dropdown {font-size: 11px; line-height: 11px;}"),
    
    # Give the page a title
    titlePanel(textOutput("titleText")),
    hr(),

    # Generate a row with a sidebar
    sidebarLayout(
         
    #     # Define the sidebar with one input
        sidebarPanel(
            #dropdown to select parameter to be graphed
            selectInput("graphParameters","Select Parameter for Graph:","graphParameters"),
            hr(),
            # Button
            downloadButton("downloadData", "Download Station Data"),

            helpText("Download file contains all monitoring data including field data parameters")
        ),

    #     # Create a spot for the barplot
        mainPanel(
            plotOutput("ParameterPlot")
        )
    )
)

# Define server logic required to draw graph
server <- function(input, output, session) {
    
    stationidParameter <- reactive({
        query <- parseQueryString(session$clientData$url_search)
        query[["stationid"]]
    })
    
    wqmdata <- reactive({arrange(subset(read.csv(file="~\\R\\ShinyApps\\WQMGraphURL2\\pl45_wqm_data.csv"
                     , fileEncoding="UTF-8-BOM"),Sta_ID == stationidParameter()),Parameter,Fdt_Date_Time)})
    
    output$titleText <- renderText({paste("DEQ Water Quality Monitoring Station Data for ",unique(wqmdata()$Sta_ID))})    
    
    observe({updateSelectInput(session, "graphParameters", choices = unique(wqmdata()$Parameter))})
    
    GraphRecords <- reactive({filter(wqmdata(), Parameter == input$graphParameters)})

    GraphRecordsRows <- reactive({nrow(filter(wqmdata(), Parameter == input$graphParameters))})

    # Fill in the spot we created for a plot
    output$ParameterPlot <-
        renderPlot({
            # Render the graph
            graph.title <- "Parameter Data Graph"
            yaxis.label <- paste(unique(GraphRecords()$Parameter)," Value")

            if (GraphRecordsRows() == 1)
            { ggplot(GraphRecords(), aes(Fdt_Date_Time, Parameter_Value, group = 1)) +
                    geom_point() +
                    labs(x = "Sample Date", y = yaxis.label, title = graph.title) +
                    theme(axis.text.x = element_text(angle = 90,vjust = 0.5, hjust = 1)) +
                    geom_text(aes(label = Parameter_Value), angle = 70, hjust = 0, vjust = -0.5, size = 3) }
            else
            { ggplot(GraphRecords(), aes(Fdt_Date_Time, Parameter_Value, group = 1)) +
                    geom_point() +
                    geom_line()+
                    labs(x = "Sample Date", y = yaxis.label, title = graph.title) +
                    theme(axis.text.x = element_text(angle = 90,vjust = 0.5, hjust = 1)) +
                    geom_text(aes(label = Parameter_Value), angle = 70, hjust = 0, vjust = -0.5, size = 3) }
        })


    # Downloadable csv of selected dataset ----
    output$downloadData <- downloadHandler(
        filename = function() {
            paste(unique(wqmdata()$Sta_ID), "_StationData.csv", sep = "")
        },
        content = function(file) {
            write.csv(wqmdata(), file, row.names = FALSE)
        }
    )
    
}
# Run the application
shinyApp(ui = ui, server = server)