-
Notifications
You must be signed in to change notification settings - Fork 300
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Unable to create header messages server-side (renderUI) - bug? #1
Comments
Hm, the source of the problem is that I think the way to fix this will be to add a new function like |
I just wish to stress how impressed by this product. Do you think this template would be ok for the "complex" shiny app (>1,000 lines of code!) I'm developing? |
Glad you like it! Much of the credit belongs to the creator of the AdminLTE theme. I don't see any reason why it wouldn't be good for a large app. |
Hey Winston, While you're building future features, please consider to incorporate some UI modules in packages like shinyBS. For example, collapse panel, toggle button, and most importantly, toggle modal. Appreciate the good work! |
wch, when do you think your change in Shiny can be merged to master? In urgent need for the feature. Thank you. |
hi, I have the same problems. I can not create header messages via server. Is there a fix available? |
@schmidb Hopefully we'll be merge in the fix in the main Shiny development branch in the next couple of days. Then you'll be able to install the dev version of Shiny with If you need the fix now, you can install the branch, with |
Hi, I updated to your branch. Now I am getting the following error and the dashboard is not starting: Error in .getReactiveEnvironment()$currentContext() : any ideas what is wrong? |
@schimdb Did you restart with a clean R session after installing? |
:-) clean R session removes the error. I now do in server.R 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)
}) and in ui.R dashboardHeader(
title = "IoT Sensor Demo",
uiOutput("dropdownMenu", replace = TRUE)
), and I get the error: Error in FUN(X[[1L]], ...) : Expected tag to be of type li |
@schmidb I just pushed a fix to shinydashboard that should fix that issue. |
great, works. Only one small issue: If I move with the mouse over the icon in the header the number (in my case a 2) jumps a little bit to the top. Probably a css issue? |
For better or worse, the moving number is part of the design from AdminLTE. |
thanks for feedback and fast bug-fix |
I updated
|
Hi all, we decided to take a different route to fix this issue. This should work with the CRAN version of Shiny, 0.11. Now there are two functions, 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) I'll also update the shinydashboard web site to reflect this. @hrbrmstr I think the bug in your example is that you misspelled it as 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) |
Hi Winston, I have this Observe inside of ShinyDashBoard app, it look like to: observe({ But sendCustomMessage don´t work (not create header messages via server), so I try to install "devtools::install_github('wch/shiny@html-replace')" and follow the steps mentioned above by schmidb but when I try to do it show to me this error:
Have any idea why it's happening? thanks for your help. |
You don't need the html-replace branch anymore; you can just run |
HI Winston, I ran 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")}
})
})
}) Apparently Any idea why ? |
Oh sorry, I don't think that shinydashboard will work reliably with shinygridster. shinygridster was an early experiment with using a grid layout with shiny, but we're not supporting it now. |
OK Wiston, I changed the code and removed the 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
})
})
|
Oh, I think you're missing the javascript code to receive the message. For this example: http://shiny.rstudio.com/gallery/server-to-client-custom-messages.html You need to see the full source code, including the contents of the www directory: https://github.com/rstudio/shiny-examples/tree/master/061-server-to-client-custom-messages |
Thanks you so much, it now is working, |
First of all congratulations for yet another great piece of software.
I tried to follow the instructions here.
Unfortunately, while I get the envelope icon on the navbar, I do not get the actual messages.
This is the code:
I've tried different things, but nothing managed to work on the server side.
Maybe there is something missing either in the web doc or in the code?
The text was updated successfully, but these errors were encountered: