Dynamic graph creation in shiny using plotly / dygraphs

Question

Im looking to create dynamic number of graphs based on a data set I don't know the length of. one day it will be 2 long another 20.. I want to utilise the same code for either dygraphs or plotly so don't want to use subplots in plotly as an option..

Ive created the below but it doesn't for loop the plotly aspects or if I enter a for loop in the ploty section in then does it all 4 X and then the plot names are an issue as it has duplicates.. when you run you can see the print statements that show the issue..

Any thoughts on how to get this code to create 1 graph per row of data ?

shinyServer(function(input, output) { 


     # Insert the right number of plot output objects into the web page 


    ############################# graph data###################

     observe({BRANDslotpcp()})
     BRANDslotpcp<-reactive({

        slot_id<-c("a-slot1","b-slot0")
     nga_diagnostic_code<-c("BT","XT")
     nga_color<-c("black","red")
     expr_1<-c(10,20)
     period_date<-c("2019-10-01","2019-10-01")

        a<-data.frame(slot_id,nga_diagnostic_code,nga_color,expr_1,period_date)

        return(a)

     })
  ############################slot options #########################   

     slotdrop<-eventReactive(BRANDslotpcp() ,{
        req(BRANDslotpcp())

        slot1a<- unique(BRANDslotpcp()$slot_id)
       # print(slot1a)
        # slot1<- slot1a[order(slot1a,decreasing=TRUE),]
        # print(slot1a)
        slot1<-data.frame(slot1a)
      #  print(slot1[2,1])
        return(slot1)
        #(slot1)
     })



     ###################################


     #observeEvent(slotdrop(),{

  observe({

     for (i in 1:nrow(slotdrop())){

             plotname2 <- paste0("pcpslotbrandenburgplot", slotdrop()[i,1])
     #


       print(i)
       print("i") 

       local({
             output[[plotname2]] <- renderPlotly ({

           myi<-i
               #for (i in 1:nrow(slotdrop())){
                 plotname1 <<- paste0("pcpslotbrandenburgplot", slotdrop()[myi,1])

                 print("test")
                 print(plotname1)

                  # plotname <- paste0("pcpslotbrandenburgplot", slotdrop()[i,1])

                 a<-slotdrop()[myi,1]
               print("a")
               print(a)
               #View(BRANDslotpcp())

               dataname<- BRANDslotpcp()[BRANDslotpcp()$slot_id == a,]



               print(dataname)
               print( "dataname")


                      plot_ly(dataname, x = substring(as.character(dataname$period_date),0,10), y = dataname$expr_1, 
                              type = 'bar',name=dataname$nga_diagnostic_code,
                              text =~paste(dataname$expr_1,"-",dataname$nga_diagnostic_code),
                              textposition = 'inside',
                              #textinfo = 'count', 
                              insidetextfont = list(color = '#000000'), 
                              marker = list(color = dataname$nga_color,line = list(color = '#FFFFFF', width = 1)),
                              showlegend = FALSE) %>%
                         config(displayModeBar = F)%>%
                         #layout(yaxis = list(title = 'Count'), barmode = 'stack')
                         layout(title = plotname1 ,margin = list(b = 160),xaxis = list(title = "", tickangle = 90), yaxis = list(title = 'Count'), barmode = 'stack')
              # }
                   })
         })


             output$plots <- renderUI({ 
               plot_output_list <- lapply(1:nrow(slotdrop()), function(i) { 
                 plotname <- paste0("pcpslotbrandenburgplot", slotdrop()[i,1]) 

                 print("plotname here")
                 print(plotname)
                 plotlyOutput(plotname, height = 280, width = 550)
               })

               print(plot_output_list)
               do.call(tagList, plot_output_list)

             })      

     }
     })





               })

You didn't provide any UI code - please edit and see [this](https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example). — ismirsehregal, Dec 05 '19 at 12:11

score 0 · Answer 1 · answered Dec 06 '19 at 13:57

ok fixed this .. here is the server code

library(shiny) library(plotly)

observe({BRANDslotpcp()})
BRANDslotpcp<-reactive({
  slot_id<-c("a-slot0","b-slot1","c-slot2")
  nga_diagnostic_code<-c("BT","XT","PPI")
  nga_color<-c("green","red","blue")
  expr_1<-c(10,20,30)
  period_date<-c("2019-10-01","2019-10-01","2019-10-01")
  a<-data.frame(slot_id,nga_diagnostic_code,nga_color,expr_1,period_date)
  #View(a)
  return(a)
})




slotdrop<-eventReactive(BRANDslotpcp() ,{
  req(BRANDslotpcp())
  slot1a<- unique(BRANDslotpcp()$slot_id)
  slot1<-data.frame(slot1a)
 # View(slot1)
  return(slot1)
})


shinyServer(function(input, output) {



  # Insert the right number of plot output objects into the web page
  output$plots <- renderUI({



    #  print(i)
    plot_output_list <- lapply(1:nrow(slotdrop()), function(i) {

      plotname <- paste("pcpslotbrandenburgplot", slotdrop()[i,1], sep="")


     # tags$div(class = "group-output",
      plotlyOutput(plotname, height = 280, width = 250)
    })

    #}

    print(plot_output_list)


    # Convert the list to a tagList - this is necessary for the list of items
    # to display properly.
  #  do.call(tagList, plot_output_list)

  })
  observe({
  # Call renderPlot for each one. Plots are only actually generated when they
  # are visible on the web page.
  for (i in 1:nrow(slotdrop())) {
    # Need local so that each item gets its own number. Without it, the value
    # of i in the renderPlot() will be the same across all instances, because
    # of when the expression is evaluated.
    local({
      tst<-slotdrop()[i,1]
     # View(tst)
      dataname<- BRANDslotpcp()[BRANDslotpcp()$slot_id == tst,]

      plotname <- paste("pcpslotbrandenburgplot",tst, sep="")
      output[[plotname]] <- renderPlotly({
        print(dataname$expr_1) 
      plot_ly(dataname, x= substring(as.character(dataname$period_date),0,10),y= dataname$expr_1,
                type = 'bar',name=dataname$nga_diagnostic_code,
                text =~paste(dataname$expr_1,"-",dataname$nga_diagnostic_code),
                textposition = 'inside',
                #textinfo = 'count',
                insidetextfont = list(color = '#000000'),
                marker = list(color = dataname$nga_color,line = list(color = '#FFFFFF', width = 1)),
                showlegend = FALSE) %>%
          config(displayModeBar = F)%>%
          #layout(yaxis = list(title = 'Count'), barmode = 'stack')
          layout(title = plotname ,margin = list(b = 160),xaxis = list(title = "", tickangle = 90), yaxis = list(title = 'Count'), barmode = 'stack')
       # plot(factor(dataname$period_date),dataname$expr_1, ylab="a",xlab="b",main = paste(plotname, sep = ""))
      })
    })
  }
})
})

ui is 

shinyUI(pageWithSidebar( 


     headerPanel("Dynamic number of plots"), 


     sidebarPanel(

       ),


     mainPanel( 
         # This is the dynamic UI for the plots 
         uiOutput("plots") 
       ) 
   ))

too long code. Can you reduce the size by including just the bare necessity? — Lazarus Thurston, Apr 03 '21 at 11:29

Dynamic graph creation in shiny using plotly / dygraphs

1 Answers1