将在线 xml 数据加载到 R 闪亮仪表板中的滑块

Question

我和我的朋友使用下载的数据构建了一个闪亮的 R 仪表板。代码如下：

library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyverse)
library(reshape)
library(scales)



ecd <- read.csv("ecd-figures.csv")

c(
  "No of case" = "no_of_case",
  "Minor Case" = "minor_case",
  "All Non Fatal Case" = "all_non_fatal_case",
  "Fatal Case" = "fatal_case"
) -> vec

ui <- fluidPage(sidebarLayout(
  sidebarPanel
  (
    checkboxGroupInput("feature",
                       "Feature",
                       vec),
    sliderInput(
      "year",
      "Year",
      min = min(ecd$year),
      max = max(ecd$year),
      value = range(ecd$year),
      sep = "",
      step = 1
    )
  ),
  
  mainPanel(tabsetPanel(
    tabPanel("Plot", plotOutput("correlation_plot")),
    tabPanel("Table", tableOutput("ecd"))
  ))
))



server <- function(input, output) {
  yearrange <- reactive({
    ecd %>%
      subset(year %in% input$year[1]:input$year[2]) %>%
      select(c(year, input$feature))
  })
  
  
  
  output$correlation_plot <- renderPlot({
    ecdsubset <- yearrange()
    
    ecdsubset <- melt(ecdsubset, id = "year")
    validate(need(input$feature, 'Check at least one item.'))
    ggplot(ecdsubset, aes(x = year, y = value, color = variable)) + geom_line(size = 1) + scale_x_continuous(breaks =
                                                                                                               seq(input$year[1], input$year[2], by = 1))
    
  })
  output$ecd <- renderTable({
    yearrange()
  })
  
}

shinyApp(ui, server)

简单的数据文件在这里：https://drive.google.com/file/d/1pZQe89wxw14lirW2mRIgi9h29yPyc7Fs/view?usp=sharing

然后，我想让一切都在线，即调用 api 而不是下载 csv 文件。看内容比较简单，如下：

library(xml2)

ecd_xml <-"https://www.labour.gov.hk/datagovhk/resource/ecd/ecd-figures.xml"
read_ecd <- read_xml(ecd_xml)
xml_find_all(read_ecd, ".//year")

{xml_nodeset (5)}
[1] <year>2015</year>
[2] <year>2016</year>
[3] <year>2017</year>
[4] <year>2018</year>
[5] <year>2019</year>

问题是：如何将xml内容中的每一条信息解析到dashboard上？

以滑动条为例。如何通过解析<year>标签并选择最大值和最小值来显示滑动条标签（即2015和2019）？

还有，你能推荐一些阅读材料让我学习从xml到dashboard的整个过程吗？非常感谢。

（P.S. 我尝试使用 xml 包代替，因为有一些标准参数可以找到属性的最大值、最小值和平均值。但我遇到了另一个大错误 -

Error in function (type, msg, asError = TRUE)  : 
  error:1407742E:SSL routines:SSL23_GET_SERVER_HELLO:tlsv1 alert protocol version

我该怎么办？我的 R 版本是 4.0.5 (2021-03-31)。）

Answer 1

您可以使用xml2::as_list 从 XML 树创建一个 tibble。 此外，您可以使用shiny::updateSliderInput 来更新 UI 滑块范围：

library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyverse)
library(reshape)
library(scales)
library(xml2)

vec <- c(
  "No of case" = "no_of_case",
  "Minor Case" = "minor_case",
  "All Non Fatal Case" = "all_non_fatal_case",
  "Fatal Case" = "fatal_case"
)

ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    checkboxGroupInput(
      "feature",
      "Feature",
      vec
    ),
    sliderInput(
      "year",
      "Year",
      min = 2000,
      max = 2001,
      value = c(2000, 2001),
      sep = "",
      step = 1
    )
  ),
  mainPanel(tabsetPanel(
    tabPanel("Plot", plotOutput("correlation_plot")),
    tabPanel("Table", tableOutput("table"))
  ))
))



server <- function(input, output, session) {
  xml <-
    "https://www.labour.gov.hk/datagovhk/resource/ecd/ecd-figures.xml" %>%
    read_xml()
  
  table <-
    xml %>%
    xml_find_all(".//item") %>%
    map(as_list) %>%
    map(~ .x %>% as_tibble()) %>%
    bind_rows() %>%
    unnest(everything()) %>%
    type_convert()
  
  years <- table$year %>% unique()
  
  updateSliderInput(
    session = session,
    inputId = "year",
    min = min(years),
    max = max(years),
    value = c(min(years), max(years)) # current selected range
  )
  
  sub_table <- reactive({
    table %>%
      filter(year %in% input$year[1]:input$year[2]) %>%
      select(c(year, input$feature))
  })
  
  
  output$correlation_plot <- renderPlot({
    validate(need(input$feature, "Check at least one item."))
    
    sub_table() %>%
      pivot_longer(-year) %>%
      ggplot(aes(x = year, y = value, color = name)) +
      geom_line(size = 1) +
      scale_x_continuous(
        breaks = seq(input$year[1], input$year[2], by = 1)
      )
  })
  output$table <- renderTable({
    sub_table()
  })
}

shinyApp(ui, server)