我在这里找到了类似的问题:How to make for loop reactive in shiny server in R?,但没有正确回答。
我正在使用R,版本3.3.1.In闪亮。我试图在闪亮的循环。这是我缩短的代码版本:
library(shiny)
library(dplyr)
library(data.table)
library(dtplyr)
library(stringr)
library(jsonlite)
library(httr)
library(mongolite)
library(RCurl)
library(XML)
f1 <- function(lst) lapply(lst, function(x) if (is.list(x)) f1(x) else if (is.null(x)) NA_character_ else x)
ui <- fluidPage(
titlePanel(h1("FORENSIS")),
sidebarLayout(
sidebarPanel(h4("Upute za korištenje:"),
p("Podaci se prikupljaju iz javnih registara"),
br(),
br(),
em("Ukliko imate pitanja, slobodno nas kontaktirajte:")
),
mainPanel(h3("Upit"),
textInput(inputId = "oib", label = "OIB"),
actionButton("kreiraj", "Pretraži"),
br(),
br(),
htmlOutput(outputId = "oib_output"),
h4("STATUS OIB-A"),
htmlOutput(outputId = "oib_status"),
br(),
h4("OSNOVNI PODACI"),
htmlOutput(outputId = "oib_ime"),
htmlOutput(outputId = "oib_prezime"),
htmlOutput(outputId = "oib_spol"),
htmlOutput(outputId = "oib_dob"),
htmlOutput(outputId = "oib_adresa"),
htmlOutput(outputId = "oib_mjesto"),
htmlOutput(outputId = "oib_naselje"),
htmlOutput(outputId = "oib_zip"),
htmlOutput(outputId = "oib_zupanija"),
br(),
h4("PRAVNE FUNKCIJE U POSLOVNIM SUBJEKTIMA"),
htmlOutput(outputId = "oib_funkcija_funkcija")
)
)
)
server <- function(input, output) {
report_exe <- eventReactive(input$kreiraj, {
input$oib
})
output$oib_output <- renderUI({
HTML(paste0('<h3>', 'Upit za OIB: ', report_exe(), '</h3>'))
})
output$oib_status <- renderUI({
req <- list()
oib_status <- NULL
i <- 0
for (i in 1:length(report_exe())) {
reqOP <- rbind(fromJSON(toJSON(content(GET(url = "https://api.data-api.io/v1/oibstatus/",
add_headers('x-dataapi-key' = "xxxx"),
query = list(oib = report_exe())), type = "application/json"), null = "null"), flatten = TRUE))
req[[i]] <- reqOP
}
json <- do.call(rbind, req)
json <- as.data.frame(json)
oib_status <- as.data.frame(lapply(f1(json), unlist), stringsAsFactors=FALSE)
HTML(paste0('<h4>', 'Status: ', ifelse(oib_status$X_status[1] == 1, 'Aktivan', 'Neaktivan'), '</h4>'))
})
preb <- reactive({
req <- list()
my_get <- for (i in 1:length(report_exe())) {
reqOP <- rbind(fromJSON(toJSON(content(GET(url = "https://api.data-api.io/v1/prebivaliste/",
add_headers('x-dataapi-key' = "xxxx"),
query = list(oib = report_exe())), type = "application/json"), null = "null"), flatten = TRUE))
req[[i]] <- reqOP
}
json <- do.call(rbind, req)
json <- as.data.frame(json)
prebivaliste <- as.data.frame(lapply(f1(json), unlist), stringsAsFactors=FALSE)
return(prebivaliste)
})
funkcije <- reactive({
req <- list()
my_get <- for (i in 1:length(report_exe())) {
reqOP <- rbind(fromJSON(toJSON(content(GET(url = "https://api.data-api.io/v1/osobe/",
add_headers('x-dataapi-key' = "xxxxx"),
query = list(oib = report_exe())), type = "application/json"), null = "null"), flatten = TRUE))
req[[i]] <- reqOP
}
json <- do.call(rbind, req)
json <- as.data.frame(json)
povezani_subjekti <- json$povezaniSubjekti
json$povezaniSubjekti <- NULL
funkcije <- as.data.frame(lapply(f1(json), unlist), stringsAsFactors=FALSE)
funkcije <- funkcije[!duplicated(funkcije),]
oibreq_subjekti <- unique(funkcije$subjektOib)
req <- list()
if (is.null(oibreq_subjekti)) {
funkcije <- NULL
} else {
my_get <- for (i in 1:length(oibreq_subjekti)) {
reqOP <- rbind(fromJSON(toJSON(content(GET(url = "https://api.data-api.io/v1/subjekti/",
add_headers('x-dataapi-key' = "xxxxxx"),
query = list(oib = oibreq_subjekti[i])), type = "application/json"), null = "null"), flatten = TRUE))
req[[i]] <- reqOP
}
json <- do.call(rbind, req)
json <- as.data.frame(json)
subjekti <- as.data.frame(lapply(f1(json), unlist), stringsAsFactors=FALSE)
subjekti$isActive <- NULL
colnames(subjekti)[which(colnames(subjekti)=="adresa")] <- "adresa_subjekta"
funkcije <- merge(x = funkcije, y = subjekti, by.x = "subjektOib", by.y = "oib", all.x = TRUE, all.y=FALSE)
return(funkcije)
}
})
output$oib_ime <- renderUI({
HTML(paste0('<h4>', 'Ime: ', preb()$ime, '</h4>'))
})
output$oib_prezime <- renderUI({
HTML(paste0('<h4>', 'Prezime: ', preb()$prezime, '</h4>'))
})
output$oib_adresa <- renderUI({
HTML(paste0('<h4>', 'Adresa: ', preb()$adresa, '</h4>'))
})
output$oib_mjesto <- renderUI({
HTML(paste0('<h4>', 'Mjesto: ', preb()$mjesto, '</h4>'))
})
output$oib_naselje <- renderUI({
HTML(paste0('<h4>', 'Naselje: ', preb()$naselje, '</h4>'))
})
output$oib_naselje <- renderUI({
HTML(paste0('<h4>', 'Poštanski broj: ', preb()$posta, '</h4>'))
})
output$oib_zupanija <- renderUI({
HTML(paste0('<h4>', 'Županija: ', preb()$zupanija, '</h4>'))
})
output$oib_funkcija_funkcija <- renderUI({
for (j in 1:2) {
HTML(paste0('<h4>', 'Funkcija: ', funkcije()$funkcija[j], '</h4>',
'<h4>', 'Naziv tvrtke: ', funkcije()$naziv[j], '</h4>'))
}
})
}
shinyApp(ui = ui, server = server)
这是一大块代码,所以我想简化一下。我有一个文本输入参数textInput(inputId = "oib", label = "OIB")
。在这个论点中,有人必须键入一些id号。然后,在代码的反应部分,此输入用于从REST API检索数据(最后,此反应对象是简单的数据框)。如果只有一行,我可以成功地将反应对象添加到输出。但是如果我想在输出中使用for循环,它并没有给我一个答案:
output$oib_funkcija_funkcija <- renderUI({
for (j in 1:2) {
HTML(paste0('<h4>', 'Funkcija: ', funkcije()$funkcija[j], '</h4>',
'<h4>', 'Naziv tvrtke: ', funkcije()$naziv[j], '</h4>'))
}
})
答案 0 :(得分:2)
也许这个例子有帮助:
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("..."),
sidebarLayout(
sidebarPanel(
selectInput("funkcija12", "Funkcija", choices = c("f1", "f2"), selected = "f1"),
selectInput("naziv12", "Naziv", choices = c("n1", "n2"), selected = "n2"),
selectInput("funkcija34", "Funkcija", choices = c("f3", "f4"), selected = "f1"),
selectInput("naziv34", "Naziv", choices = c("n3", "n4"), selected = "n2")
),
mainPanel(
uiOutput("funcijeNaziv")
)
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
funkcije <- reactive({
list(funkcija = c(input$funkcija12, input$funkcija34),
naziv = c(input$naziv12, input$naziv34))
})
funkcijeHTML <- reactive({
tmp <- character()
for (j in 1:2) {
tmp[j] = paste0('<h4>', 'Funkcija: ', funkcije()$funkcija[j], '</h4>','<h4>', 'Naziv tvrtke: ', funkcije()$naziv[j], '</h4>')
}
tmp
})
output$funcijeNaziv <- renderUI(
HTML(funkcijeHTML())
)
})