Unable to create header messages server-side (renderUI) - bug? about shinydashboard HOT 23 CLOSED

  output$dropdownMenu <- renderUI({
    streamdata <- connectToStream()
    messageData <- data.frame(text=c("test","fsfdfs"), icon=c("truck","truck"), 
                              status=c("success", "success"))
    msgs <- apply(messageData, 1, function(row) {
      notificationItem(text = row[["text"]], status = row[["status"]])
    })

    dropdownMenu(type = "notifications", .list = msgs)
  })

  dashboardHeader(
    title = "IoT Sensor Demo",
    uiOutput("dropdownMenu", replace = TRUE)
    ),

library(shiny)
library(shinydashboard)

# Example message data in a data frame
messageData <- data.frame(
  from = c("Admininstrator", "New User", "Support"),
  message = c(
    "Sales are steady this month.",
    "How do I register?",
    "The new server is ready."
  ),
  stringsAsFactors = FALSE
)

ui <- dashboardPage(
  dashboardHeader(
    title = "Dynamic menus",
    dropdownMenuOutput("messageMenu")
  ),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      box(
        title = "Controls",
        sliderInput("slider", "Number of observations:", 1, 100, 50)
      )
    )
  )
)

server <- function(input, output) {
  output$messageMenu <- renderUI({
    # Code to generate each of the messageItems here, in a list. messageData
    # is a data frame with two columns, 'from' and 'message'.
    # Also add on slider value to the message content, so that messages update.
    msgs <- apply(messageData, 1, function(row) {
      messageItem(
        from = row[["from"]],
        message = paste(row[["message"]], input$slider)
      )
    })

    dropdownMenu(type = "messages", .list = msgs)
  })
}

shinyApp(ui, server)

  library(shiny)
  library(shinydashboard)

  # start of minimal test app -----------------------------------------------

  msgItem <- messageItem("Support Team", "This is the content of a message.",
                         time = "5 mins")
  nfyItem <- notificationItem(icon = icon("users"),
                             status = "info", "5 new members joined today")

  server <- function(input, output) {

    # for methods 2 & 2a
    output$messagesMenu <- renderDropdownMenu({
      dropdownMenu(type = "messages", msgItem)
    })

    output$notificationsMenu <- renderDropdownMenu({
      dropdownMenu(type = "notifications", nfyItem)
    })

  }

  sidebar <- dashboardSidebar()
  body <- dashboardBody()

  # method 1: static, but CSS works -----------------------------------------

  header <- dashboardHeader(dropdownMenu(type = "messages", msgItem),
                            dropdownMenu(type = "notification", nfyItem),
                            title="CYBER Dashboard")
  ui <- dashboardPage(header, sidebar, body, skin="black")
  shinyApp(ui, server)


  # method 2 - based on example - only one menu shows up & CSS is off -------

  header <- dashboardHeader(dropdownMenuOutput("messagesMenu"),
                            dropdownMenuOutput("notificationsMenu"),
                            title="CYBER Dashboard")
  ui <- dashboardPage(header, sidebar, body, skin="black")
  shinyApp(ui, server)


  # method 2a - using .list still doesn’t get 2 menus -----------------------

  header <- dashboardHeader(.list=list(dropdownMenuOutput("messagesMenu"),
                                       dropdownMenuOutput("notificationsMenu")),
                            title="CYBER Dashboard")
  ui <- dashboardPage(header, sidebar, body, skin="black")
  shinyApp(ui, server)

library(shiny)
library(shinydashboard)
library(ShinyDash)
library(rCharts)
library(shinyGridster)
shinyUI(bootstrapPage(
            dashboardPage(
                            dashboardHeader(title = "Expert's Judgment"),
                            dashboardSidebar( 
                                            sidebarUserPanel(subtitle ="Andrés",name="Hi!",image="foo.png"),
                                            sidebarMenu(                                      
                                                        menuItem("Introduction", tabName = "intro", icon = icon("file-text-o")),
                                                        )
                                            ),
                            dashboardBody(
                                        gridster(width = 270, height = 250,marginx = 3,marginy = 3,
                                                    gridsterItem(col = 4, row = 1, sizex = 2, sizey = 1,
                                                                        conditionalPanel(condition = "output.id > 0",
                                                                                           div(   div(style="float:left",tableOutput("ActualizaN")),
                                                                                           div(style="float:right; margin-top: -10px; margin-right: 60px;",
                                                                                           uiOutput("NHipoActualiza"),actionButton("ActualizaElicita", "Update",icon=icon("table"))))
                                                                                        ),
                                                                        conditionalPanel(condition = "output.id == 0",
                                                                                            "¡There are not values!"
                                                                                        )                                                                                   
                                                                )
                                                )           
                                     )
                         )
        ))

shinyServer(function(input, output, session){

# 1. Save the values inside of a input##

observe({
  output$ActualizaN<-renderTable({
    db <- dbConnect(SQLite(), dbname="database.sqlite")
    CateQuery<-paste0("SELECT N FROM variable WHERE id = ",input$variableFR)
    NomQuery<-paste0("SELECT nombre FROM nivel WHERE idVar = ",input$variableFR)
    QC<-dbGetQuery(db, CateQuery)
    NQ<-dbGetQuery(db, NomQuery)
    AA<- numeric(QC$N)        
    for(i in 1:QC$N){
      AA[i] <- c((paste0("<input class='span9' id='A",i,
                         "' class='shiny-bound-input' type='number' value='' name='Cat",1,"'>")))
    }

    data.frame(Name=NQ$nombre,Value=AA)                                                                         
  }, sanitize.text.function = function(x) x)
})


### 2. Are extracted the values from the inputs and those are saved inside of a variable##                              
Valupdate<-reactive({
  if (input$ActualizaElicita == 0)
    return() 
  isolate({
    db <- dbConnect(SQLite(), dbname="database.sqlite")
    CateQuery<-paste0("SELECT N FROM variable WHERE id = ",input$variableFR)
    QC<-dbGetQuery(db, CateQuery)                       
    ValL<-(unlist(reactiveValuesToList(input)[paste0("A",1:QC$N)]))
    return(ValL)                
  })
  input$ActualizaElicita
})
# 3. The ruleta table is updated#                   
observe({
  if (input$ActualizaElicita == 0)
    return()                                
  isolate({
    if(!is.na(sum(Valupdate()))){
      if(sum(Valupdate())==input$ActilizaN_Hipo)
      {
        db <- dbConnect(SQLite(), dbname="database.sqlite")
        N.Id<-dbGetQuery(db,paste0("SELECT Num_N FROM (SELECT SUM(ValNivel) as Ns , Num_N FROM ruleta WHERE IdVariable=",input$variableUpdate,
                                   " AND IdExperto=",input$expertUpdate," AND IdElicita=",input$elicitaUpdate," GROUP BY Num_N) WHERE Ns=",input$ActilizaN_Hipo) )
        Nivel<-dbGetQuery(db,paste0("SELECT idNivel FROM ruleta WHERE IdVariable=",input$variableUpdate," AND IdExperto=",input$expertUpdate,
                                    " AND IdElicita=",input$elicitaUpdate," AND Num_N=",N.Id$Num_N ))
        ##The values are updated##
        for(j in 1:length(Nivel$idNivel))
        {                  
          dbGetQuery(db,paste0("UPDATE ruleta SET ValNivel=",Valupdate()[j], " WHERE IdVariable=",input$variableUpdate,
                               " AND IdExperto=",input$expertUpdate," AND idNivel=",Nivel$idNivel[j]," AND Num_N=",N.Id$Num_N,
                               " AND IdElicita=",input$elicitaUpdate))
        }
        for(i in 1:length(Nivel$idNivel))
        {updateNumericInput(session,paste0("A",i), "", value="",min =1, max = 100000000)}
      }
      else{ session$sendCustomMessage(type = 'testmessage', message ="La suma de los valores de cada nivel debe  ser igual al N hipotetico")}
    }
    else{ session$sendCustomMessage(type = 'testmessage', message ="No se pueden actualizar campos en blanco")}
  })

})

})  

library(shiny)
library(shinydashboard)
library(ShinyDash)
library(rCharts)
library(shinyGridster)
#### -------UI.R------- 
shinyUI(bootstrapPage(
            dashboardPage(
                            dashboardHeader(title = "Expert's Judgment"),
                            dashboardSidebar( 
                                            sidebarUserPanel(subtitle ="Andrés",name="Hi!",image="foo.png"),
                                            sidebarMenu(                                      
                                                        menuItem("Introduction", tabName = "intro", icon = icon("file-text-o")),
                                                        )),
                            dashboardBody(
                                            tabItems(
                                                     tabItem(tabName = "Tab1",
                                                              fluidRow(
                                                                        column(4,offset = 1,
                                                                                tags$section(class="content",
                                                                                  div(class="form-box",
                                                                                  div(class="header", 'Register a new '),
                                                                                  tags$form( method="post",
                                                                                  div(class="body bg-gray",
                                                                                             div(class="form-group",
                                                                                             numericInput("CodElicita", "Elicitation ID:", value="",min =1, max = 100000000)),
                                                                                             div(class="form-group",
                                                                                             textInput("NomElicita", "Elictation Name:"))                                                    
                                                                                     ),
                                                                                    div(class="footer",
                                                                                    actionButton("ElicitaButton", "Send",icon=icon("table")))))    
                                                                                ))
                                                                     )
                                                             )
                                                    )           
                                     )
                         )
        ))

#### -------Server.R-------     

shinyServer(function(input, output, session){
observe({
    if (input$ElicitaButton == 0)
      return()      
    db <- dbConnect(SQLite(), dbname="database.sqlite")
    isolate({
      if(!is.na(input$NomElicita) && !is.na(input$CodElicita)){
        tab1<-paste("INSERT INTO elicitacion VALUES (",input$CodElicita,",","'",input$NomElicita,"'",")",sep="")
        dbSendQuery(conn = db, tab1)
        x<-data.frame(
          Name = c(input$NomElicita,"Decimal"),
          Value = as.character(c(tab1,input$CodElicita)), 
          stringsAsFactors=FALSE
        )
        dat1<-dbGetQuery(db, "SELECT id FROM elicitacion")                                      
        updateNumericInput(session,"CodElicita", "Codigo Elicitacion:", value="",min =1, max = 100000000)
        updateTextInput(session,"NomElicita", "Nombre Elicitacion:",value="")
        updateSelectInput(session, "elicita", label ="Seleccione el codigo de la Elicitacion", choices =(dat1$id),selected =dat1$id[1])
        return(x)
      }
      else{ session$sendCustomMessage(type = 'testmessage', message ="No se pueden guardar campos en blanco")} 
    })
   input$ElicitaButton                           
  })
})