Wiederkehrender Fehler mit RenderMenu mit R

Question

Ich lerne derzeit zu verwenden R und genauer Shinydashboards zu erstellen ... nun, Dashboards. Da ich ein R Anfänger bin, habe ich durch das Shinydashboard Tutorial (https://rstudio.github.io/shinydashboard/structure.html) gearbeitet, versuche es zu reproduzieren und an meine Bedürfnisse anzupassen. Es ging alles gut bis zum Code-Teil bezüglich dynamischem Inhalt und vor allem dynamischem Nachrichten-Menü. Als ich den Tutorial-Code für ein interaktives Nachrichten-Menü kopiert und das gesamte Skript ausgeführt habe, tauchte das glänzende Fenster auf und wurde sofort mit einer Fehlermeldung geschlossen (siehe unten für Codes und Nachrichten). Ich versuchte dann im Internet nach anderen Beispielen für dynamische Menüs zu suchen, fand aber nur wenige und stellte fest, dass jedes Mal, wenn die Funktion renderMenu verwendet wurde, dieselbe Fehlermeldung mit einem glänzenden Fenster, das schnell knallte und schloss.

Hier ist der Code ich auf den problematischen Teil hatte bis (alle gut zu funktionieren scheinen, erhalte ich ein glänzendes Fenster mit einigen beschreibenden und interaktiven Inhalten):

library(shiny) 
library(shinydashboard) 

ui <- dashboardPage(
    dashboardHeader(title="AQUILAIR PLUS", 
       dropdownMenu(type = "messages", 
          messageItem(
          from = "Sales Dept", 
          message = "Sales are steady this month." 
          ), 
          messageItem(
          from = "New User", 
          message = "How do I register?", 
          icon = icon("question"), 
          time = "13:45" 
          ), 
          messageItem(
          from = "Support", 
          message = "The new server is ready.", 
          icon = icon("life-ring"), 
          time = "2014-12-01" 
          )), 
       dropdownMenu(type = "notifications", 
             notificationItem(
              text = "5 new users today", 
              icon("users") 
             ), 
             notificationItem(
              text = "12 items delivered", 
              icon("truck"), 
              status = "success" 
             ), 
             notificationItem(
              text = "Server load at 86%", 
              icon = icon("exclamation-triangle"), 
              status = "warning" 
             ) 
          )    
      ), 
    dashboardSidebar(
    sidebarMenu(
     menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), 
     menuItem("Widgets", tabName = "widgets", icon = icon("th")) 
) 
), 

    dashboardBody(
    tabItems(
     # First tab content 
     tabItem(tabName = "dashboard", 
       h2("Graphes de suivi"), 
    fluidRow(
     box(title = "Graphiques", status = "primary", 
      plotOutput("plot1", height = 250), 
      plotOutput("plot2", height = 250) 
    ), 

     box(title= "Informations", status = "info", 
    "Texte descriptif", br(), "blablabla", 
    sliderInput("slider", "Number of observations:", 1, 100, 50), 
    sliderInput("slider2", "Curseur 2:", 1, 200, 25), 
    textInput("text", "Commentaire :") 
), 
     box(title = "Commentaires éventuels", status="success", 
     solidHeader = TRUE, 
     collapsible = TRUE, 
    "Commentaire :", 
    textOutput("text") 
    ) 
    ) 
), 
    # Second tab content 
    tabItem(tabName = "widgets", 
     h2("Widgets tab*** content") 
) 
) 
) 
) 

server <- function(input, output) { 
    set.seed(122) 
    histdata <- rnorm(500) 
    output$text <- renderText({ 
    print(input$text) 
    }) 
    output$plot1 <- renderPlot({ 
    data <- histdata[seq_len(input$slider)] 
    hist(data) 
    }) 
    output$plot2 <- renderPlot({ 
    data2 <- histdata[seq_len(input$slider2)] 
    hist(data2) 
    }) 

    } 

shinyApp(ui, server) 

Dann das Tutorial zu kopieren versuchte ich einfügen

im ui Teil:

dashboardHeader(dropdownMenuOutput("messageMenu")) 

im Server-Teil: ein dynamisches Nachrichtenmenü erhalten

output$messageMenu <- renderMenu({ 
    # Code to generate each of the messageItems here, in a list. This assumes 
    # that messageData is a data frame with two columns, 'from' and 'message'. 
    msgs <- apply(messageData, 1, function(row) { 
    messageItem(from = row[["from"]], message = row[["message"]]) 
    }) 

    # This is equivalent to calling: 
    # dropdownMenu(type="messages", msgs[[1]], msgs[[2]], ...) 
    dropdownMenu(type = "messages", .list = msgs) 
}) 

Es kommt das Schließen des Fensters mit der folgenden Fehlermeldung:

Warning: Error in markRenderFunction: unused argument (outputArgs =  outputArgs) 
Stack trace (innermost first): 
45: markRenderFunction 
44: renderMenu 
43: server [#15] 
4: <Anonymous> 
3: do.call 
2: print.shiny.appobj 
1: <Promise> 
Error in markRenderFunction(uiOutput, renderFunc, outputArgs = outputArgs) : 
    unused argument (outputArgs = outputArgs)" 

Ich fand heraus, zuerst, dass message wurde nicht definiert, so fügte ich am Anfang des Codes:

messageData = data.frame('from' = c('me', 'you', 'them'), 'message' = c('first message' ,'second','third')) 

aber es hat das Verhalten des Fensters und die Fehlermeldung nicht geändert. Hier ist mein ganzer „errored Code“:

library(shiny) 
library(shinydashboard) 
messageData = data.frame('from' = c('me', 'you', 'them'), 'message' = c('first message' ,'second','third')) 

ui <- dashboardPage(
    dashboardHeader(title="AQUILAIR PLUS", 
       dropdownMenu(type = "messages", 
          messageItem(
          from = "Sales Dept", 
          message = "Sales are steady this month." 
          ), 
          messageItem(
          from = "New User", 
          message = "How do I register?", 
          icon = icon("question"), 
          time = "13:45" 
          ), 
          messageItem(
          from = "Support", 
          message = "The new server is ready.", 
          icon = icon("life-ring"), 
          time = "2014-12-01" 
          )), 
       dropdownMenuOutput("messageMenu"), 
       dropdownMenu(type = "notifications", 
             notificationItem(
              text = "5 new users today", 
              icon("users") 
             ), 
             notificationItem(
              text = "12 items delivered", 
              icon("truck"), 
              status = "success" 
             ), 
             notificationItem(
              text = "Server load at 86%", 
              icon = icon("exclamation-triangle"), 
              status = "warning" 
             ) 
          )    
      ), 
    dashboardSidebar(
    sidebarMenu(
     menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), 
     menuItem("Widgets", tabName = "widgets", icon = icon("th")) 
    )), 

    dashboardBody(
    tabItems(
     # First tab content 
     tabItem(tabName = "dashboard", 
      h2("Graphes de suivi"), 
    fluidRow(
     box(title = "Graphiques", status = "primary", 
     plotOutput("plot1", height = 250), 
     plotOutput("plot2", height = 250) 
    ), 

     box(title= "Informations", status = "info", 
     "Texte descriptif", br(), "blablabla", 
     sliderInput("slider", "Number of observations:", 1, 100, 50), 
     sliderInput("slider2", "Curseur 2:", 1, 200, 25), 
     textInput("text", "Commentaire :") 
    ), 
     box(title = "Commentaires éventuels", status="success", 
      solidHeader = TRUE, 
      collapsible = TRUE, 
     "Commentaire :", 
     textOutput("text") 
    ) 
    ) 
), 
     # Second tab content 
     tabItem(tabName = "widgets", 
      h2("Widgets tab*** content") 
) 
) 
) 
) 

server <- function(input, output) { 
    set.seed(122) 
    histdata <- rnorm(500) 
    output$text <- renderText({ 
    print(input$text) 
    }) 
    output$plot1 <- renderPlot({ 
    data <- histdata[seq_len(input$slider)] 
    hist(data) 
    }) 
    output$plot2 <- renderPlot({ 
    data2 <- histdata[seq_len(input$slider2)] 
    hist(data2) 
    }) 
    output$messageMenu <- renderMenu({ 
    msgs <- apply(messageData, 1, function(row) { 
     messageItem(from = row[["from"]], message = row[["message"]]) 

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

shinyApp(ui, server) 

für andere Beispiele von dynamischen Menüs Sehen, wie ich sagte, ich einige Dinge gefunden, wobei viele Beispiele genau den gleichen Code, der nicht helfen wird ... aber ich habe diese in der renderMenu-Hilfe:

# ========== Dynamic sidebarMenu ========== 
ui <- dashboardPage(
    dashboardHeader(title = "Dynamic sidebar"), 
    dashboardSidebar(
    sidebarMenuOutput("menu") 
), 
    dashboardBody() 
) 

server <- function(input, output) { 
    output$menu <- renderMenu({ 
    sidebarMenu(
     menuItem("Menu item", icon = icon("calendar")) 
    ) 
    }) 
} 

shinyApp(ui, server) 

... und es gibt mir exakt die gleiche Fenster Verhalten und die Fehlermeldung, das heißt, ich denke, dass ich ein ernstes Problem mit der renderMenu Funktion habe. Ich habe versucht, outputArgs in meinen Code einzufügen, aber während ich bekomme, muss es eine Liste sein, ich verstehe nicht wirklich, wie und wo es verwendet werden soll.

Ich entschuldige mich im Voraus, wenn ich etwas enormes verpasst habe; Ich weiß, dass es für viele grundlegenden Code scheinen kann, aber ich bin ein Anfänger und würde einige Hilfe/Erläuterungen wirklich schätzen, da ich dort mit meinen nicht dynamischen Menüs feststecke :(

Answer 1

Ich denke, MessageData sollte in der Form sein:

messageData = data.frame('from' = c('me', 'you'), 'message' = c('first message' ,'second')) 

Sie können auch in Ihrem render-Code überprüfen, ob Nachrichtendaten gültig ist wie unten etwas verwenden, die keinen Eingang zur Verfügung stellen, es sei denn message gut.

output$messageMenu <- renderMenu({ 
    req(messageData, cancelOutput = TRUE) 
    msgs <- apply(messageData, 1, function(row) { 
     messageItem(from = row[["from"]], message = row[["message"]]) 
    }) 
    dropdownMenu(type = "messages", .list = msgs) 
    }) 

ich habe jsut bemerkt haben, haben Sie etwas fehl am Platz Klammern, die ich korrigiert habe, ohne es dir zu sagen.In Ihrem letzten Codeblock haben Sie:

output$messageMenu <- renderMenu({ 
    msgs <- apply(messageData, 1, function(row) { 
     messageItem(from = row[["from"]], message = row[["message"]]) 
    dropdownMenu(type = "messages", .list = msgs) # this should be outside the fucntion in the apply call. 
    }) 
    }) 
    } 

EDIT: Hier ist eine vollständige Kopie und Einfügen des Codes, den ich erfolgreich ausgeführt habe. Wechseln Sie den Kommentar zum ersten, um zu sehen, wie der req() - Code hilft, wenn messageData ungültig ist.

library(shiny) 
library(shinydashboard) 
messageData = data.frame("from" = c('me', 'you'), "message" = c('first message' ,'second')) 
#messageData = NULL 

ui <- dashboardPage(
    dashboardHeader(title="AQUILAIR PLUS", 
        dropdownMenu(type = "messages", 
           messageItem(
           from = "Sales Dept", 
           message = "Sales are steady this month." 
           ), 
           messageItem(
           from = "New User", 
           message = "How do I register?", 
           icon = icon("question"), 
           time = "13:45" 
           ), 
           messageItem(
           from = "Support", 
           message = "The new server is ready.", 
           icon = icon("life-ring"), 
           time = "2014-12-01" 
           )), 
        dropdownMenuOutput("messageMenu"), 
        dropdownMenu(type = "notifications", 
           notificationItem(
           text = "5 new users today", 
           icon("users") 
           ), 
           notificationItem(
           text = "12 items delivered", 
           icon("truck"), 
           status = "success" 
           ), 
           notificationItem(
           text = "Server load at 86%", 
           icon = icon("exclamation-triangle"), 
           status = "warning" 
           ) 
       )    
), 
    dashboardSidebar(
    sidebarMenu(
     menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), 
     menuItem("Widgets", tabName = "widgets", icon = icon("th")) 
    )), 

    dashboardBody(
    tabItems(
     # First tab content 
     tabItem(tabName = "dashboard", 
       h2("Graphes de suivi"), 
       fluidRow(
       box(title = "Graphiques", status = "primary", 
        plotOutput("plot1", height = 250), 
        plotOutput("plot2", height = 250) 
       ), 

       box(title= "Informations", status = "info", 
        "Texte descriptif", br(), "blablabla", 
        sliderInput("slider", "Number of observations:", 1, 100, 50), 
        sliderInput("slider2", "Curseur 2:", 1, 200, 25), 
        textInput("text", "Commentaire :") 
       ), 
       box(title = "Commentaires éventuels", status="success", 
        solidHeader = TRUE, 
        collapsible = TRUE, 
        "Commentaire :", 
        textOutput("text") 
       ) 
      ) 
    ), 
     # Second tab content 
     tabItem(tabName = "widgets", 
       h2("Widgets tab*** content") 
    ) 
    ) 
) 
) 

server <- function(input, output) { 
    set.seed(122) 
    histdata <- rnorm(500) 
    output$text <- renderText({ 
    print(input$text) 
    }) 
    output$plot1 <- renderPlot({ 
    data <- histdata[seq_len(input$slider)] 
    hist(data) 
    }) 
    output$plot2 <- renderPlot({ 
    data2 <- histdata[seq_len(input$slider2)] 
    hist(data2) 
    }) 
    output$messageMenu <- renderMenu({ 
    req(messageData, cancelOutput = TRUE) 
    msgs <- apply(messageData, 1, function(row) { 
     messageItem(from = row[["from"]], message = row[["message"]]) 
    }) 
    dropdownMenu(type = "messages", .list = msgs) 
    }) 
} 

shinyApp(ui, server) 

Answer 2

Das Problem ist in den folgenden Zeilen:

messageData<-data.frame(from = character(), message = character()) 

und

output$messageMenu <- renderMenu({ 
    msgs <- apply(messageData, 1, function(row) { 
     messageItem(from = row[["from"]], message = row[["message"]]) 
     dropdownMenu(type = "messages", .list = msgs) 
    }) 
    }) 

Sie versuchen, etwas zu wählen, der nicht existiert. So Sie meesageData mit einigen Daten und ändern, um eine Zeile des Codes durch sie bewegen sich wie folgt füllen sollten:

output$messageMenu <- renderMenu({ 
     msgs <- apply(messageData, 1, function(row) { 
      messageItem(from = row[["from"]], message = row[["message"]]) 

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