Comments (23)
Hm, the source of the problem is that uiOutput
returns a container div
or span
, which gets in between the ul
and li
in the DOM hierarchy.
I think the way to fix this will be to add a new function like menuOutput
, and the corresponding Javascript bindings.
from shinydashboard.
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?
from shinydashboard.
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.
from shinydashboard.
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!
from shinydashboard.
wch, when do you think your change in Shiny can be merged to master? In urgent need for the feature. Thank you.
from shinydashboard.
hi, I have the same problems. I can not create header messages via server. Is there a fix available?
from shinydashboard.
@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 devtools::install_github('rstudio/shiny')
and have the fix.
If you need the fix now, you can install the branch, with devtools::install_github('wch/shiny@html-replace')
.
from shinydashboard.
Hi, I updated to your branch. Now I am getting the following error and the dashboard is not starting:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Warning: Unhandled error in observer: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
observe({
session$sendCustomMessage("ggvis_vega_spec", list(plotId = id,
spec = r_spec()))
})
Warning: Unhandled error in observer: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
observe({
for (obs in data_observers) obs$suspend()
data_table <- c(attr(r_spec(), "data_table", TRUE), attr(r_spec(),
"scale_data_table", TRUE))
data_observers <<- lapply(names(data_table), function(data_name) {
force(data_name)
obs <- shiny::observe(suspended = TRUE, {
data_reactive <- data_table[[data_name]]
session$sendCustomMessage("ggvis_data", list(plotId = id,
name = data_name, value = as.vega(data_reactive(),
data_name)))
})
sync_with_hidden_state(obs, id, session)
obs
})
data_observers[[length(data_observers) + 1]] <<- shiny::observe(suspended = TRUE,
{
for (name in names(data_table)) {
data_table[name]
}
[... truncated]
any ideas what is wrong?
from shinydashboard.
@schimdb Did you restart with a clean R session after installing?
from shinydashboard.
:-) 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
and app is not starting. Any ideas?
from shinydashboard.
@schmidb I just pushed a fix to shinydashboard that should fix that issue.
from shinydashboard.
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?
from shinydashboard.
For better or worse, the moving number is part of the design from AdminLTE.
from shinydashboard.
thanks for feedback and fast bug-fix
from shinydashboard.
I updated shinydashboard
and shiny
(the alt branch from above) and restarted R/RStudio before posting. How does one get more than one dynamic menu? And, even with a single dynamic menu, the CSS seems off (placement of icon). Test bed code:
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 <- renderUI({
dropdownMenu(type = "messages", msgItem)
})
output$notificationsMenu <- renderUI({
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(uiOutput("messagesMenu"),
uiOutput("notificationeMenu"),
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(uiOutput("messagesMenu"),
uiOutput("notificationeMenu")),
title="CYBER Dashboard")
ui <- dashboardPage(header, sidebar, body, skin="black")
shinyApp(ui, server)
from shinydashboard.
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, dropdownMenuOutput
and renderDropdownMenu
. Here's an example (this is in the help for renderDropdownMenu
):
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 notificationeMenu
. A modified version of your app, using the new system, looks like this:
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)
from shinydashboard.
Hi Winston, I have this Observe inside of ShinyDashBoard app, it look like to:
observe({
if (input$SaveElicita == 0)
return()
isolate({
##Validamos que no haya valores en blanco##
if(!is.na(sum(ValLevel())) && !is.na(input$Nhipote))
{
code
if(sum(ValLevel())==input$Nhipote && !(input$Nhipote%in%(ValidaN.Hipo$SumVal)))
{
Code
}
else{ session$sendCustomMessage(type = 'testmessage', message ="La suma de los valores de cada nivel no es igual al N hipotetico o el N hipotetico ya fue elicitado")}
}
else{ session$sendCustomMessage(type = 'testmessage', message ="No se pueden guardar campos en blanco")}
})
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:
devtools::install_github('wch/shiny@html-replace')
Downloading github repo wch/shiny@html-replace
Error in download(dest, src, auth) : client error: (404) Not Found
Have any idea why it's happening?
thanks for your help.
from shinydashboard.
You don't need the html-replace branch anymore; you can just run devtools::install_github('rstudio/shiny')
.
from shinydashboard.
HI Winston, I ran devtools::install_github('rstudio/shiny')
, then I restart Rstudio, but the same problem still happening. I think that it is happening buecause Im using "gridster" function from "shinyGridster" package, something like this:
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 session$sendCustomMessage
does not work when it is within of a gridsterItem
Any idea why ?
from shinydashboard.
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.
from shinydashboard.
OK Wiston, I changed the code and removed the gridsterItem
function, but even so don't get to make that it work, the new code look like this:
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
})
})
updateNumericInput
is working but session$sendCustomMessage
not
from shinydashboard.
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
from shinydashboard.
Thanks you so much, it now is working,
from shinydashboard.
Related Issues (20)
- can not see my second tabitem after clicking action button HOT 1
- Error with publication of a Shiny App with R
- [Update request] The default icon for menuSubItem() "angle-double-right" is now "angles-right" in Font Awesome 6.0.0 HOT 5
- dynamic footer HOT 6
- FYI copyright on the shinydashboard website HOT 1
- dashboardPage shouldn't create <title> HTML tags if title = NULL HOT 1
- dashboardBody not showing when conditionalPanel is used HOT 1
- Toggling boxes to collapse has unexpected results with nested boxes HOT 1
- ShinyDash fails to render since R4.3 added to computer. HOT 3
- `shinydashboard::updateTabItems` not matching `shiny::updateTabsetPanel` HOT 2
- Why use unsecure AdminLTE? HOT 4
- Remove/hide footer from dashboard HOT 3
- Collapsible box not responding in my navbarPage Rshiny
- shinydashboard - "Get started" Tab [1 Link + 1 Typo] HOT 1
- shinydashboard - "Appearance" Tab [1 Punctuation]
- shinydashboard - "Behavior" Tab [1 Typo]
- I am using the R Package shinydashboard, now the dashboardSidebar is NOT showing in black background HOT 8
- `updateTabItems` not working when selecting dynamically rendered `menuSubItem` HOT 2
- sidebar id is not in input inside a RMarkdown HOT 3
- Mention this package is not meant to be used in conjunction with {bslib}
Recommend Projects
-
React
A declarative, efficient, and flexible JavaScript library for building user interfaces.
-
Vue.js
🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
-
Typescript
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
-
TensorFlow
An Open Source Machine Learning Framework for Everyone
-
Django
The Web framework for perfectionists with deadlines.
-
Laravel
A PHP framework for web artisans
-
D3
Bring data to life with SVG, Canvas and HTML. 📊📈🎉
-
Recommend Topics
-
javascript
JavaScript (JS) is a lightweight interpreted programming language with first-class functions.
-
web
Some thing interesting about web. New door for the world.
-
server
A server is a program made to process requests and deliver data to clients.
-
Machine learning
Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.
-
Visualization
Some thing interesting about visualization, use data art
-
Game
Some thing interesting about game, make everyone happy.
Recommend Org
-
Facebook
We are working to build community through open source technology. NB: members must have two-factor auth.
-
Microsoft
Open source projects and samples from Microsoft.
-
Google
Google ❤️ Open Source for everyone.
-
Alibaba
Alibaba Open Source for everyone
-
D3
Data-Driven Documents codes.
-
Tencent
China tencent open source team.
from shinydashboard.