对于Shiny中的循环输出

时间:2016-10-27 08:07:26

标签: r shiny

我在这里找到了类似的问题: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>'))
  }
  })

1 个答案:

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

    )


    })