1

Currently, i am trying to output multiple tables i managed to retrieve with an api call onto a dashboard page with a single uiOutput().

took some reference from this post: R Shiny - Display multiple plots selected with checkboxGroupInput

however, while i was succesful in putting it into a list for the overall layout and output it into uioutput(), i was not able to acheive the desired results as all the tables were the same, in reality it should be different as i have already tagged a unique dataframe to each renderdatatable() below shows the screen shot and the code. would appreciate some help here thank you! [1]: https://i.stack.imgur.com/W0B26.png

library(httr)
library(jsonlite)
library(plyr)
library(data.table)
library(rlist)
library(shiny)
###########  UI   ############
ui <- fluidPage(uiOutput('datatables'))


#########  SERVER  ###########3
server <- function(input, output, session){
  output$datatables <- renderUI({
    link <- 'https://api.zapper.fi/v1/protocols/balances/supported?addresses%5B%5D=0x58bbae0159117a75225e72d941dbe35ffd99f894&api_key=96e0cc51-a62e-42ca-acee-910ea7d2a241'
    
    test <- GET(link)
    test <- fromJSON(rawToChar(test$content))

    counter1 <- 0
    out <- list()
    df <- list()
    for (i in seq(from = 1, to = length(test$network))){
      network <- test$network[i]
      #counter <- counter + 1
      out <- list(out, h2(paste0(str_to_title(network),' Network')))
      for (e in ldply(test$protocols[i], data.frame)$protocol){
        link1 <- paste0(paste0('https://api.zapper.fi/v1/protocols/',e),paste0(paste0('/balances?addresses%5B%5D=0x58bbae0159117a75225e72d941dbe35ffd99f894&network=',network),'&api_key=96e0cc51-a62e-42ca-acee-910ea7d2a241'))
        data <- fromJSON(rawToChar(GET(link1)$content))
        wallet <- '0x58bbae0159117a75225e72d941dbe35ffd99f894'
        #info <- ldply(eval(parse(text=sprintf("data$'%s'$products$assets",wallet))),data.frame)
        out <- list(out, h3(paste0(str_to_title(e),' Protocol')))
        counter1 <- counter1 + 1
        df[[counter1]] <- ldply(eval(parse(text=sprintf("data$'%s'$products$assets",wallet))),data.frame)
        out<- list(out, renderDataTable(df[[counter1]]))
}
}
return(out)
})
}
shinyApp(ui, server)

UPDATE: I ALSO TRIED TO WRAP IT IN AN OBSERVE() AND LOCAL () FOR THE DIFFERENT OUTPUTS, STILL DIDNT ACHEIVE THE DESIRED RESULTS, ALL SAME TABLES WHICH IS WRONG

1 Answers1

0

I almost achieved the desired result with the following code:

library(httr)
library(jsonlite)
library(plyr)
library(data.table)
library(rlist)
library(shiny)
# added :
library(DT)
library(stringr)
###########  UI   ############
ui <- fluidPage(
  uiOutput('datatables')
  )


#########  SERVER  ###########
server <- function(input, output, session){
  link <- 'https://api.zapper.fi/v1/protocols/balances/supported?addresses%5B%5D=0x58bbae0159117a75225e72d941dbe35ffd99f894&api_key=96e0cc51-a62e-42ca-acee-910ea7d2a241'
  
  test <- GET(link)
  test <- fromJSON(rawToChar(test$content))
  
  output$datatables <- renderUI({
    
    outputlist <- lapply(1:length(test$network), function(i) {
      network <- test$network[i]
      networkTitle <- paste0("networktitle", i)
      
      lapply(seq_along(ldply(test$protocols[i], data.frame)$protocol), function(j) {
      
      protocolTitle <- paste0("protocoltitle", i, j)
      outputId <- paste0("network", i, "protocol", j)
      
      tagList(
        #uiOutput(networkTitle),
        uiOutput(protocolTitle),
        DTOutput(outputId)
      )
      })
    })
  })
  
  lapply(1:length(test$network), function(i) {
    network <- test$network[i]
    my_i <- i
    networkTitle <- paste0("networktitle", my_i)
      
    #local({
    #  my_network <- network
    #  output[[networkTitle]] <- renderUI({
    #    tags$h2(paste0(str_to_title(my_network),' Network'))
    #  })
    #})
    
      lapply(seq_along(ldply(test$protocols[my_i], data.frame)$protocol), function(j) {
        
        e <- ldply(test$protocols[my_i], data.frame)$protocol[[j]]
        
        local({
          my_network <- network
          my_e <- e
          my_j <- j
          protocolTitle <- paste0("protocoltitle", my_i, my_j)
          outputId <- paste0("network", my_i, "protocol", my_j)
          link1 <- paste0(paste0('https://api.zapper.fi/v1/protocols/',my_e),paste0(paste0('/balances?addresses%5B%5D=0x58bbae0159117a75225e72d941dbe35ffd99f894&network=',my_network),'&api_key=96e0cc51-a62e-42ca-acee-910ea7d2a241'))
          data <- fromJSON(rawToChar(GET(link1)$content))
          wallet <- '0x58bbae0159117a75225e72d941dbe35ffd99f894'

          output[[protocolTitle]] <- renderUI({
            tags$h3(paste0(str_to_title(my_network),' Network - ', str_to_title(my_e),' Protocol'))
          })
          
          output[[outputId]] <- renderDT({
            ldply(eval(parse(text=sprintf("data$'%s'$products$assets",wallet))),data.frame)
          })
        })
      })

  })

  }
  
shinyApp(ui, server)

I used two nested lapply but this might work with for loops as well (using local()).

As you mentioned, we have several difficulties here:

  1. the need to use local() to get unique IDs for each protocol title and datatable (see this)
  2. the need to use one renderUI in the server part to generate several types of outputs dynamically (uiOutput for titles, DTOutput for datatables), all contained in a tagList(). See this and this again.
  3. The need to use two nested for loops/lapply functions to render the shiny outputs used in the renderUI() part.

I combined the network and protocol titles because I was not able to get network titles as unique h2 titles as shown in your example figure. Duplicate output IDs were still generated for h2 titles when using the commented code. I let the commented code as reference if someone wants to try improve it.

julien.leroux5
  • 969
  • 7
  • 17