Issue with showing multiple tables in a for loop in rshiny - r

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

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:
the need to use local() to get unique IDs for each protocol title and datatable (see this)
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.
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.

Related

R shiny retrieve tables from same output function & show in ui side by side

I have a cumbersome function inside a server output variable.
The function returns a list of 2 data frames.
I want to extract these tables and plot them side by side.
However I do not want to create two different outputs for them in server, as I don't want the heavy function to run twice.
For the sake of giving a reproducible code :
(my getListOfDataFrames function is much heavier than in this example)
I want df1 and df2 displayed side by side with scrollX = TRUE in options
library(shiny)
library(DT)
ui <- fluidPage(
dataTableOutput("output1")
)
server <- function(input, output){
getListOfDataFrames <- function(df){
return(list(df[1:5,], df[6:10,]))
}
output$output1 <- renderDataTable({
myList <- getListOfDataFrames(mtcars)
df1 <- as.data.frame(myList[1])
df2 <- as.data.frame(myList[2])
})
}
shinyApp(ui, server)
There are plenty of examples how to create dynamic content, like example below:
library(shiny)
library(DT)
ui <- fluidPage(
uiOutput("dt")
)
server <- function(input, output){
getListOfDataFrames <- function(df){
return(list(df[1:5,], df[6:10,]))
}
myList <- getListOfDataFrames(mtcars)
output$dt <- renderUI({
ntables <- seq(myList)
# we want to create the width depending how many tables we have
width <- paste0(99/max(ntables),"%;")
lapply(ntables, function(i) {
id <- paste0("dt", i)
div(style=paste0("display:inline-block;width:",width),DT::dataTableOutput(id))
})
})
observe({
# Dynamically creating 2 tables with separate ids
lapply(seq(myList), function(i){
id <- paste0("dt", i)
output[[id]] <- DT::renderDataTable(as.data.frame(myList[i]))
})
})
}
shinyApp(ui, server)

Filtering reactive data in an R Shiny App

I have a dataframe that has these columns:
document, user, month, views
I am using a selectInput to filter the data by document.
I want to plot a (Plotly) line chart of views per month, for each user, for the selected document.
E.g. If one filters to a document for which ten users exist, I want to display ten plots, each showing the relevant user's views per month.
At current:
- I filter the data to the selected document (dplyr).
- I pass the filtered data to a function.
- In the function, I loop through the current document's users.
- In each loop, I filter the data to the current user (dplyr), and append a Plotly output to a output list.
- At the end of the function, I return the output list.
- The result of the function is assigne to a UI output.
The app successfully runs, but where the plots should display, I get a Result must have length x, not y error.
How would you go about this? I appreciate any advice you can give me.
For security reasons I cannot share my existing code, sorry - I understand that it's not very useful.
Edit: I've created a minimal reproducible example, based on this.
The process has changed slightly from my original question, mainly that I'm not using a separate function.
library(plotly)
library(tidyverse)
# DATA
data <- data.frame(
document= c("doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc1","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2","doc2"),
user= c("user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user3","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user1","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user2","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4","user4"),
month= as.Date(c("2017-01-01","2017-02-01","2017-03-01","2017-04-01","2017-05-01","2017-06-01","2017-07-01","2017-08-01","2017-09-01","2017-10-01","2017-11-01","2017-12-01","2018-01-01","2018-02-01","2018-03-01","2018-04-01","2018-05-01","2018-06-01","2018-07-01","2017-01-01","2017-02-01","2017-03-01","2017-04-01","2017-05-01","2017-06-01","2017-07-01","2017-08-01","2017-09-01","2017-10-01","2017-11-01","2017-12-01","2018-01-01","2018-02-01","2018-03-01","2018-04-01","2018-05-01","2018-06-01","2018-07-01","2017-01-01","2017-02-01","2017-03-01","2017-04-01","2017-05-01","2017-06-01","2017-07-01","2017-08-01","2017-09-01","2017-10-01","2017-11-01","2017-12-01","2018-01-01","2018-02-01","2018-03-01","2018-04-01","2018-05-01","2018-06-01","2018-07-01","2017-01-01","2017-02-01","2017-03-01","2017-04-01","2017-05-01","2017-06-01","2017-07-01","2017-08-01","2017-09-01","2017-10-01","2017-11-01","2017-12-01","2018-01-01","2018-02-01","2018-03-01","2018-04-01","2018-05-01","2018-06-01","2018-07-01","2017-01-01","2017-02-01","2017-03-01","2017-04-01","2017-05-01","2017-06-01","2017-07-01","2017-08-01","2017-09-01","2017-10-01","2017-11-01","2017-12-01","2018-01-01","2018-02-01","2018-03-01","2018-04-01","2018-05-01","2018-06-01","2018-07-01","2017-01-01","2017-02-01","2017-03-01","2017-04-01","2017-05-01","2017-06-01","2017-07-01","2017-08-01","2017-09-01","2017-10-01","2017-11-01","2017-12-01","2018-01-01","2018-02-01","2018-03-01","2018-04-01","2018-05-01","2018-06-01","2018-07-01")),
views= c(19,39,34,3,25,5,1,16,37,21,46,34,23,0,8,10,46,3,47,16,32,4,44,42,12,8,27,39,28,30,26,45,49,38,32,32,1,16,23,34,41,46,37,0,23,44,10,3,43,43,22,38,1,33,11,15,8,21,37,17,7,29,1,33,47,45,37,20,9,41,37,18,30,46,24,45,48,42,49,3,10,17,46,6,12,29,13,6,4,44,37,26,43,5,19,28,44,20,35,40,32,20,41,46,25,47,35,3,25,25,41,5,26,32)
)
# SERVER
server <- shinyServer(function(input, output) {
output$plots <- renderUI({
doc_data <- filter(data, document == input$select_doc) # This is the breaking line
plot_output_list <- lapply(1:length(unique(doc_data$user)), function(i) {
plotname <- paste("plot", i, sep="")
plotlyOutput(plotname)
})
do.call(tagList, plot_output_list)
})
for (i in 1:length(unique(doc_data$user))) {
local({
local_i <- i
doc_users <- unique(doc_data$user)
plotname <- paste("plot", local_i, sep="")
plot_data <- filter(doc_data, user == doc_users[local_i]) %>%
arrange(month)
output[[plotname]] <- renderPlotly({
p <- plot_ly(x= plot_data$month, y= plot_data$views, type = 'scatter', mode = 'lines')
p$elementId <- NULL
p
})
})
}
})
# UI
ui <- shinyUI(pageWithSidebar(
headerPanel("Minimum reproducible example"),
sidebarPanel(
selectInput("select_doc", choices= unique(data$document), label="", selected= 'doc1')#,
),
mainPanel(
uiOutput("plots")
)
))
# RUN
shinyApp(ui, server)

R shiny table not rendering

I'm trying to make a table using renderTable but it's not rendering on the browser. Here's the ss
#imgur
Full table's code
This's the renderTable code:
library(shiny)
library(diceR)
output$clustensemble <- renderTable({
#load file
data <- data()
#consensus cluster
cc <- consensus_cluster(data, nk=3, reps=1, algorithms=c("km","hc"), progress=FALSE)
ce <- as.matrix(cc)
tce <- t(ce)
tce })
I've tried using
sanitize.text.function = function(x) x;
but it didn't work, as stated in here
I've also tried using renderUI, but instead it generate another error.
The table consist of number and string, but i think that's not the issue.
Still new at this kind of R project, so I didn't know any other solution. What should I do, and what is the cause of this problem? Thanks!
(EDIT)
Sample data csv
ui.R
server.R
app.R
Without seeing the data that you use and the ui, we can only guess.
Using the example data from diceR I am able to print out a table using base shiny or DT.
library(shiny)
library(DT)
library(diceR)
data(hgsc)
# Custom distance function
manh <- function(x) {
stats::dist(x, method = "manhattan")
}
# Custom clustering algorithm
agnes <- function(d, k) {
return(as.integer(stats::cutree(cluster::agnes(d, diss = TRUE), k)))
}
assign("agnes", agnes, 1)
ui <- fluidPage(
DT::dataTableOutput("tableDT"),
tableOutput("table")
)
server <- function(input, output){
data <- reactive({
dat <- hgsc[1:10, 1:50]
cc <- consensus_cluster(dat, reps = 6, algorithms = c("pam", "agnes"),
distance = c("euclidean", "manh"), progress = FALSE)
ce <- as.matrix(cc)
t(ce)
})
output$tableDT <- DT::renderDataTable({
data()
})
output$table <- renderTable({
data()
})
}
shinyApp(ui, server)

Dynamic number of plots in Shiny

I want to display a dynamic number of plots in Shiny according to some data rows that the user can pick from. I achieved this, however I keep getting the same plot. The right amount of times, but always with the wrong data.
I already tried debugging, but the loops seem to work. Three plots with the plot id's 'plot1' 'plot2' 'plot3' are created. I also checked the browser inside the loop where I create the plots...the x and y values are the right ones...
Anyone have a clue what I'm doing wrong?
ui <- bootstrapPage(
navbarPage("Anpassung Lastmodell",
tabPanel("Graph",
fluidRow(width=4,
uiOutput('alphaui'),
uiOutput('graphui')
)
)
)
)
server <- function(input, output, session) {
## Output Graphs
output$alphaui <- renderUI({
# Here I usually have a manually uploaded dataset, so that's why this part is in a dynamic UI
# The user selects the columns of the data he wants in the plots
alphacat <- beaver1
paramnames <- colnames(alphacat)
graphparam <- vector("list",length(paramnames))
for (i in 1:length(paramnames)) {
graphparam[[i]] <- list(checkboxInput(paste0("graphparam",i,sep=""),paramnames[i],value=FALSE))
}
graphparam[[i+1]] <- actionButton("graph_button", "Los!",width="200px")
return(graphparam)
})
output$graphui <- renderUI({
graph <- plots()
graph
})
plots <- eventReactive(input$graph_button, {
# Selecting data to be plotted
alphacat <- beaver1
paramnames <- colnames(alphacat)
paramnames_keep <- isolate(unlist(reactiveValuesToList(input)[paste0("graphparam",1:length(paramnames),sep="")]))
paramnames <- cbind(paramnames,paramnames_keep)
paramnames <- subset(paramnames,paramnames[,"paramnames_keep"]==TRUE,"paramnames")
graph <- list()
i <- 1
for (i in 1:length(paramnames)) {
plotname <- paste("plot",i, sep="")
x <- alphacat[,paramnames[i]]
y <- alphacat$time
output[[plotname]] <- renderPlot({
plot(x,y)
})
graph[[i]] <- plotOutput(plotname,height=330,width=300)
tagList(graph)
}
return(graph)
})
}
shinyApp(ui,server)
The issue in your code as it is posted right now, is that the y variable is not definedL
x <- alphacat[,paramnames[i]]
y <- alphacat$aq1
output[[plotname]] <- renderPlot({
plot(x,y)
})
y$aq1 does not exist. Therefore, right now your plotting statement plot(x,y) is the same as plot(x). (try print(y) after the statement where you define y)

How to return multiple values in R ShinyServer

I am doing the following:
using R ShinyUI, get client inputs on ranges of variables A, B, C;
in R ShinyServer, read in a csv file, and using the client inputs to slice the csv, and get the portion that I need;
Perform a loop calculation on the csv, calculate various statistics from the loop output, and plot all these statistics.
Pseudo code:
data = read.csv('file.csv')
shinyServer(function(input, output) {
data <- reactive({
data = data[data$A<INPUT1 & data$B> INPUT2 & data$C<INPUT3,]
})
for (i in 1:dim(data)[1]){
result1[i] = xxx
result2[i] = xxx
}
output$plot <- renderPlot({
plot(result1)
})
})
The above code does not work. I want to know:
How to correctly incorporate user input and get the variable "data,"
How to plot result1 and result2 from output$plot
Thanks!
The for loop should be inside a the renderPlot, so each time the input$month changes, the reactive data will change and then the for lop will update your variables. If you have the for loop outside a reactive expression, it will be executed only once when the app starts, but after changes in the input.
Below is simple example based on the pseudo code you provide in your original question to illustrate the possible solution.
library(shiny)
ui <- shinyUI( fluidPage(
fluidRow(
column(4,
numericInput("input1", "Speed >", 8),
numericInput("input2", "Dist >", 15)
),
column(8,
plotOutput("plot")
)
)
))
server <- shinyServer(function(input, output) {
dat0 <- cars
data <- reactive({
dat0[dat0$speed > input$input1 & dat0$dist > input$input2,]
})
output$plot <- renderPlot({
s <- dim(data())[1]
result1 <- numeric(s)
result2 <- numeric(s)
for (i in 1:s){
result1[i] <- data()[i, 1]
result2[i] <- data()[i, 2]
}
plot(result1, result2)
})
})
shinyApp(ui = ui, server = server)

Resources