Shinyのループ内出力の場合

Question

私は同様の質問をここで見つけました：How to make for loop reactive in shiny server in R?、しかし正しく答えられていません。

私はRバージョン3.3.1を使用しています。光沢があります。私は光沢のあるループを作ろうとしています。ここに短縮コードバージョンがあります：

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) 

私は単純化したいので、コードの大きな塊です。私は1つのテキスト入力引数textInput(inputId = "oib", label = "OIB")を持っています。この議論では、誰かが何らかのID番号をタイプしなければならない。次に、コードのリアクティブ部分では、この入力を使用してREST APIからデータを取得します（このリアクティブオブジェクトは単純なデータフレームの最後です）。行が1つしかない場合は、出力に反応対象オブジェクトを追加することができます。しかし、私は、出力の内部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>')) 
    } 
    }) 

Answer 1

をたぶんこの例は、役立ちます：

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()) 

    ) 


    })