R如何从内部Web数据库中提取数据到闪亮的应用程序

Question

我已经构建了一些 ShinyApps，但现在遇到了新的障碍。具体来说，我无法从托管在 URL 上的内部数据库中提取数据。到目前为止，我已经能够构建一个脚本来从 JSON 文件中提取数据（从 Firefox 的开发人员工具中获取 URL）。解析和清理后，我可以获得所需的信息来“renderPrint”。但是，我无法让反应部分正常工作。

我希望用户从下拉框中选择一个输入（例如 1-5）并让用户输入响应，更新 GET 请求（httr）。我已经在维基百科等其他网站上做到了这一点，但是，这是通过反应文本完成的。是否可以通过输入更新 URL？我目前拥有的（注意：无论输入如何，这都会提取相同的基本 URL - 但是，如果我手动更改数字，我会得到相关页面（例如 =1 [pg.1]、=2[pg.2]） .

开始 R 脚本

url<-GET('https://somewebsite.com/results_json /11111?page=1),add_headers("user-agent"-'Firefox/60.0')) 

url_content<-content(web3)

url_summary<-list(url_content[[2]])

results-capture.output(url_summary %>% modify_depth(2,'hostName') %>% str())

results<-as.data.frame(results)

results(as.data.frame(gsub("[[:punct:]]","",as.matrix(results))

results<-as.character(results$results)

results<-as.data.frame(results,stringAsFactors=FALSE)

END R 脚本

正如我所说，这很有效，但我想让用户输入（下拉列表）更新 URL。我已经进行了测试，并且无论页码如何，后续代码都可以正常工作。但是，只是无法让它更新...

BEGIN ShinyApp

ui<-pageWithSidebar(
  titlePanel("Data Pool"),

  sidebarPanel(
    selectInput(inputID="pg",
    label="page",
    choices=c("1"="1","2"="2","3"="3"),
    selected="1"),
  actionButton('submit','Submit')
),
mainPanel(
  verbatimTextOutput("data_ids")
) )

server<-(function(input,output) {
  observeEvent(input$submit,{
    x<-as.character(input$pg)
    url<-GET(paste0('https://somewebsite.com/results_json/11111?page=',x), add_headers("user-agent"="Firefox/60.0))})

其中“x”是用户输入（例如“1”），这会将 url 更新为 .../11111?page=1

#here I run the same code as I did in the RScript above#

results<-as.data.frame(gsub("chr","",as.matrix(results)))
results<-as.data.frame(results[-1])

  output$data_ids<-renderPrint({
    as.matrix(results)})
})

shinyApp(ur=ur,server=server)

*END APP

Answer 1

您可以在服务器中使用以下内容

server<-function(input,output) {

  results <- reactive({
    x<-as.character(input$pg)
    address <- paste0('https://somewebsite.com/results_json/11111?page=',x)
    # url<-GET(address, add_headers("user-agent"="Firefox/60.0"))
    # results<-as.data.frame(gsub("chr","",as.matrix(results)))
    # results<-as.data.frame(results[-1])
    address
  })

  output$data_ids<-renderPrint({
    as.matrix(results())
  })
}

注意results-reactive 的最后一行应该是你想要作为结果传递的东西。我没有要测试的网站地址，所以我只打印了地址，这似乎是通缉的形式。