I've been trying to use shinyBS modals with dateInput. The problem is that the calendar widget is hidden behind the modal. Here is my example code:
library(shiny)
library(shinyBS)
shinyApp(
ui =fluidPage(
mainPanel(
actionButton("button", label = "Open Modal"),
bsModal("modalExample", "Data Table", "rowtogg", size = "small",
fluidPage(dateInput("dates", "Enter date")))
)
),
server = function(input, output, session) {
observeEvent({
input$button
},{
toggleModal(session, "modalExample", "open")
})
}
)
A screenshot of the problem can be found at: https://github.com/ebailey78/shinyBS/issues/46, where I already asked the question. However it seems to me like this is a more "general" problem, so I was hoping someone over here could help me out.
EDIT: Thanks to Yenne Info it works by adding:
tags$style(type = "text/css", ".datepicker{z-index: 1100 !important;}"),
Related
I found the bsModal works as expected with fluidPage but not without it. Just click "View Table" button to see the difference.
The version with fluidPage:
library(shiny)
library(shinyBS)
shinyApp(
ui =
fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("tabBut", "View Table")
),
mainPanel(
bsModal("modalExample", "Data Table", "tabBut", size = "large",
"distTable")
)
)
),
server =
function(input, output, session) {}
)
The version without fluidPage, the only change is that the fluidPage is replaced by tagList:
library(shiny)
library(shinyBS)
shinyApp(
ui =
tagList(
sidebarLayout(
sidebarPanel(
actionButton("tabBut", "View Table")
),
mainPanel(
bsModal("modalExample", "Data Table", "tabBut", size = "large",
"distTable")
)
)
),
server =
function(input, output, session) {}
)
Can anyboday help me explain what happened between bsModal and fluidPage?
Because fluidPage is much, much more than a simple tagList.
tagList simply takes it arguments and concatenates them (expecting each argument to be some sort of HTML tag). fluidPage literally generates an entire HTML document with bootstrap dependencies.
Your first example is figuratively "build a house with basement, floor plan and attic" with sidebarLayout explaining the layout of floors and fluidPage being the house. Remove the fluidPage and you're trying to build a house with basement, floor plan and attic, but without the foundation, walls or roof.
I successfully changed the text sizes in shiny dashboard interface by editing css file.
Or I use following structure:
div(DTOutput(outputId = "table"), style = "font-size:85%"))
However, I couldn't find the node name of shiny modals. Is it possible to change the text size in shiny modals through .css?
Are you looking for something like this?
shinyApp(
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
title = "Important message",
div("This is an important message!", style="font-size:160%")
))
})
}
)
ModalDialog takes as its first argument(s) UI elements. This appears to be the same kind of arguments accepted by other shiny elements. Compare for example: ?siderbarPanel and ?modalDialog. So if you can do it in the body of an app, you can probably do it in a modal.
For example, I stuck a sidebar layout inside a modal:
shinyApp(
ui = basicPage(
actionButton("show", "Show modal dialog")
),
server = function(input, output) {
observeEvent(input$show, {
showModal(modalDialog(
sidebarLayout(sidebarPanel("yeah"),mainPanel("cool"))
))
})
}
)
I would like to add a tooltip for navbarMenu in Shiny app. Similar question asked here but, there is no answer.Here is my reproducible code
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(tabsetPanel(
navbarMenu("Tab1",bsTooltip(id="Tab1", title="Short description for the tab", trigger = "hover"),
tabPanel("Tab1.1"),
tabPanel("Tab1.2")),
tabPanel("Tab2",tabsetPanel(
tabPanel("Tab2.1"),
tabPanel("Tab2.2"))),
tabPanel("Tab3",tabsetPanel(
tabPanel("Tab3.1"),
tabPanel("Tab3.2"),
tabPanel("Tab3.3")))
)))))
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
During my research I found this solution R Shiny: Use navbarPage with bsModal by shinyBS, but for bsModel.
Also, there is a procedure mentioned here which is based in java-script.I know both solutions are for tabpanel but I believe it's the same problem, which is navbarMenu and tabpanel don't have an id.
I'm statistician and I don't have background in HTML or java-script to rewrite the attribute for the tab title or navbarMenu.
I hope I phrase my question in a clear manner. Thanks in advance for your time and kind help.
you can use HTML wenn passing the Title of the Tabs. in this case I just pt the title in a span and added the attribute titlewhich is the attribute HTML uses default for mouse-overs. For me this is much sinpler the trying to add it over shinyBS.
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(tabsetPanel(
navbarMenu(span("Tab1",title="Short description for the tab" ),
tabPanel("Tab1.1"),
tabPanel("Tab1.2")),
tabPanel("Tab2",tabsetPanel(
tabPanel("Tab2.1"),
tabPanel("Tab2.2"))),
tabPanel("Tab3",tabsetPanel(
tabPanel("Tab3.1"),
tabPanel("Tab3.2"),
tabPanel("Tab3.3")))
)))))
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
hope this helps!
I found another solution using javascript. Perhaps it may be more useful.
library(shiny)
shinyApp(
ui = navbarPage(
tags$script(HTML('
$( document ).on("shiny:sessioninitialized", function(event) {
$(\'span[data-toggle="tooltip"]\').tooltip({
html: true
});
});'
)),
navbarMenu(
"Menu"
,tabPanel(span("navbarTitle 1",title="XXX",`data-toggle`="tooltip"),
tabsetPanel(
tabPanel(span("Tab 1", title = "aaa",`data-toggle`="tooltip")),
tabPanel(span("Tab 2",title="bbb",`data-toggle`="tooltip")),
tabPanel(span("Tab 3",title="ccc",`data-toggle`="tooltip"))
)
)
,tabPanel( "navbarTitle 2")
)
),
server = function(input, output) {
}
)
My objective is to create a ShinyApp that opens a new empty UI whenever user clicks on submitButton.
Currently this is my code below. If the user types something in the text box and press Submit. The app shows what the user typed in the main panel. However I dont want to see the text, instead when the user clicks on the submit button , it should open a new empty UI.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
textInput("text", "Text:", "text here"),
submitButton("Submit")
)),
verbatimTextOutput("text")
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({
hist(rnorm(input$n))
})
output$text <- renderText({
paste("Input text is:", input$text)
})
}
shinyApp(ui=ui, server=server)
Is this possible ? Any tips or pointers are appreciated.
Well, this is not yet very functional, but does what you asked for.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
uiOutput("newWindowContent", style = "display: none;"),
tags$script(HTML("
$(document).ready(function() {
if(window.location.hash != '') {
$('div:not(#newWindowContent)').hide();
$('#newWindowContent').show();
$('#newWindowContent').appendTo('body');
}
})
")),
a(href = "#NEW", target = "_blank",
actionButton("Submit", "Submit")
)
))
)
server = function(input, output) {
output$newWindowContent <- renderUI({
"Welcome to your new window!"
})
}
shinyApp(ui=ui, server=server)
The app is created, such that the ui created in newWindowContent is displayed in the new window. Sadly, new windows are somewhat cut off from the parent page, such that there is no easy way to configure each page independently. At the moment, all show the same content. None have reactivity features. I guess there can be initial configurations, if one uses the window's hash. But this works only client sided.
Nevertheless, it's a good start!
I am using R-3.2.0 hosted on Red Hat Linux version 6.5 with shiny package (version 0.12.0). I am trying to utilize shinydashboard functionality to design a few reports. The RStudio version is 0.98.1103
I have successfully setup ui.R and server.R
ui.R - :
ibrary(shinydashboard)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)
dashboardPage(
dashboardHeader(title="Reports",
dropdownMenu(type = "task",
messageItem(
from = "Download",
message = "test",
icon = icon("gear")
),
messageItem(
"Download",
message = "TEST",
icon = icon("life-ring"),
href= "http://www.google.com"
)
)
),
dashboardSidebar(
sidebarMenu(
menuItem("Srts", tabName = "ServiceItems", icon = icon("dashboard"))
)
),
dashboardBody(
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')
)
)
server.R -:
library(shiny)
library(ggplot2)
library(wordcloud)
library(devtools)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)
shinyServer(function(input, output) {
PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
output$PivotTable <- rpivotTable::renderRpivotTable({
rpivotTable(PivotTable, rows="Ar", col="DTM", aggregatorName="Count",
vals="Ar", rendererName="Table")})
tableFirst<-as.data.frame(sort(table(PivotTable$Area),decreasing=TRUE))
})
The following code to enable scrolling in the dashboard body was taken from https://github.com/smartinsightsfromdata/rpivotTable/issues/19 :-
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')
The issue I face is that the code added to help scrolling does not work. I have stripped my code of all tabs , layouts etc but I am still enable to get scrolling to work.
I have observed that if I remove the dashboardPage command, scrolling does work but the display is very awkward and not really presentable.
However, when I combine the codes as follows (in RStudio) and run the scrolling works just fine.
library(shiny)
library(shinydashboard)
library(rpivotTable)
library(ggplot2)
PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
header <- dashboardHeader(title="Reports",
dropdownMenu(type = "task",
messageItem(
from = "Download",
message = "test",
icon = icon("gear")
),
messageItem(
"Download",
message = "TEST",
icon = icon("life-ring"),
href= "http://www.google.com"
)
)
)
sidebar <- dashboardSidebar()
body <- dashboardBody(
tags$head(tags$style(HTML('
.skin-blue.main-header .logo {
background-color: #3c8dbc;
}
.skin-blue .main-header .logo:hover {
background-color: #3c8dbc;
}
'))
),
tags$head(tags$style(type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput("test")
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) {
output$test <- rpivotTable::renderRpivotTable({
rpivotTable(PivotTable, rows="Ar", col="DTM", aggregatorName="Count",vals="Ar", rendererName="Table")})
})
However, I cannot provide this as a final solution because the business users that need this are not adept at copying and pasting code on RStudio (If there is a possible way that I can use the combined code just like the usual one I can consider that as well).
Can someone please help me understand the issue with my original code that prevents scrolling.
Thanks a lot !
The problem is your CSS selector otherwise everything looks OK. Your setting the scroll-property on a element with ID test but I can't find a element with this ID in your example. Try something like this:
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
HTML("
#myScrollBox{
overflow-y: scroll;
overflow-x: hidden;
height:120px;
}
")
)
),
# Boxes need to be put in a row (or column)
fluidRow(
div(id="myScrollBox",
plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
You need to change the CSS selector to the element you want to put the scroll on, in the example this is "myScrollBox".
The only thing which you should be taking in to consideration is to pass the exact same id before CSS code, so in this code replace #test to #PivotTable and bingo... your code should work...
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')