0

I have found similar question here: How to make for loop reactive in shiny server in R?, but it is not answered correctly.

I am using R, version 3.3.1.In shiny. I am trying to make a loop in shiny. Here is my shortened code version:

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)

It is a big chunk of code so I would like to simplify. I have one text input argument textInput(inputId = "oib", label = "OIB"). In this argument someone has to type some id number. Then, in the reactive part of the code, this input is used to retrieve data from REST API (in the end this reactive object i s simple data frame). I can successfully add reactive object to output, if there is only one row. But if I want to use the for loop inside output, it doesn't give me an answer:

  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>'))
  }
  })
Community
  • 1
  • 1
Mislav
  • 1,533
  • 16
  • 37

1 Answers1

2

Maybe this example helps:

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

    )


    })
Valter Beaković
  • 3,140
  • 2
  • 20
  • 30
  • Thank you for answer. In the end, I have found the solution. It is very similar to yours. I have realized I have to make text object that will go inside `HTML` separately. Only difference is that I have done everything inside output, not reactive. But I thing this approach is even better. Thanks! – Mislav Oct 27 '16 at 12:19
  • It took me some time to find a way. Started with lapply but could make it work. Anyway glad it helped. – Valter Beaković Oct 27 '16 at 12:24