I have an issue while creating a shiny web app using semantic.dashboard library.
Below is the code for my app.
library(semantic.dashboard)
# Define UI
header <- dashboardHeader(
)
sidebar <- dashboardSidebar(
side = "left",
sidebarMenu(
menuItem(tabName = "overview", text = "Overview", icon = icon("home")),
menuItem(tabName = "analysis", text = "Analysis", icon = icon("chart bar"))
)
)
body <- dashboardBody(
dateRangeInput("datepicker", NULL, start = Sys.Date()-30, end = Sys.Date()-1)
)
tabItems(
tabItem(
tabName = "overview",
fluidRow(
)
),
tabItem(
tabName = "analysis",
fluidRow(
)
)
)
ui <- dashboardPage(
header,
sidebar,
body,
title = "My Dashboard",
theme = "lumen"
)
# Define server logic
server <- function(input, output, session) {
session$onSessionEnded(stopApp)
}
# Run the application
shinyApp(ui = ui, server = server)
The result is in the screenshot below:
The main problem is that the dates inside the daterangeinput widget are just like simple text inside textbox.
I can't click on them to change the dates.
Using fluidPage() would resolve the problem, but the whole web page isn't filled totally by the app (and for this app, responsiveness isn't really useful).
Below is the screenshot of the app when I use fluidPage(), you can see that there's so much space between the sidebar and the border, and beetween the sidebar and the body.
app with fluidPage()
I'd like to know if it's possible to use daterangeinput without using fluidPage() or, if not possible, know how to remove the padding between the border and the sidebar when using fluidPage.
Thanks in advance for your help.
Above example doesn't work because it uses bootstrap framework styles - contrary to shiny.semantic or semantic.dashboard packages.
Please check my PR to shiny.semantic package. I've implemented there simple date input with usage of semantic-ui components. You can also use it to create simple date range (added quick example in PR).
Related
What is the parameter to control the right side bar on a Shiny bs4Dash dashboard. My reading of the dashboardControlbar function at https://rinterface.github.io/bs4Dash/articles/step-by-step.html, which I understand to be the sidebar to the right of the page, is to set disable = T, in a similar way to how the dashboardSidebar(disable = T) controls the appearance sidebar to the left.
I have set controlbar = dashboardControlbar(disable = T) however on the Shiny App below and the right sidebar still opens when pressing the button at the top. Thanks for any suggestions in advance.
Edit (in response to dashboardHeader comment ):
This question is in reference to bs4Dash V2.0.0 available via github.
https://github.com/RinteRface/bs4Dash
Please note that the github page also recommends github versions of htmltools and shiny.
library(shiny)
library(bs4Dash)
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
disable = T
),
body = dashboardBody(),
controlbar = dashboardControlbar(
disable = T
),
title = ""
)
server <- function(input, output, session) {}
shinyApp(ui, server)
You can remove controlbar argument to disable it.
library(shiny)
library(bs4Dash)
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
disable = T
),
body = dashboardBody(),
title = ""
)
server <- function(input, output, session) {}
shinyApp(ui, server)
If shinydashboard was a person I would like to meet him in a dark alley with a baseball bat. I am simply trying show a data frame as a table in my shiny app so I looked online at a bunch websites and questions on stack exchange and this is what I got.
UI
library(shiny)
library(shinydashboard)
library(data.table)#For fread.
library(tidyverse)
library(htmlwidgets)
library(DT)#For the interactive table.
# Header -----------------------------------------------------------------------|
header<-dashboardHeader( title = "Marketing Dashboard"
)
# Sidebar ----------------------------------------------------------------------|
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabname ="overview", icon = icon("dashboard")),
menuItem("Weather", tabname ="weather", icon = icon("bolt"))
)
)
# Body -------------------------------------------------------------------------|
body<-dashboardBody(
tabItems(
tabItem(tabName = 'overview',
DT::dataTableOutput("overviewtable")
),
tabItem(tabName = 'weather',
fluidRow(
)
)
)
)
# UI ---------------------------------------------------------------------------|
ui = dashboardPage(
header,
sidebar,
body
)
shinyApp(ui,server)
Server
server <- function(input,output){
#Table for overview
output$overviewtable<- DT::renderDataTable({
DT::datatable(tib1)
})
}
I have tried using tableOutput and renderTable
I have tried to see if my tib1 was somehow the problem so I tried using the data set mpg. That didnt work. I tried placing DT::dataTableOutput("overviewtable") in a column(), in a fluidRow. I tried reinstalling the packages for DT and refreshing R but that didnt work. I looked at the gallery website from R here. I took that code and ran it and I was able to see their table they made but when I ran my code I cant see my table at all or other tables for that matter. I have a feeling it has something to do with shinydashboard because it seems that when I ran the code from the website above that was just using shiny it worked.
The problem is a typo in the tabName = argument:
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName ="overview", icon = icon("dashboard")),
menuItem("Weather", tabName ="weather", icon = icon("bolt"))
)
)
I was trying to add website information on my shiny dashboard and for the "About" section (See image) I want few lines to be displayed on the dashboard body when clicked on that tab. how could i possibly achieve it? I could successfully add href for the "contact" section.
Maybe I do not understand your question properly, but what about:
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("About", icon = icon("info"), tabName = "about"),
menuItem("Contact", icon = icon("phone"), tabName = "contact")
)
)
)
body <- dashboardBody(
tabItems(
tabItem("about",
h1("About")),
tabItem("contact",
h1("Contact"))
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) { }
)
When you click on About you get a new tab in the dashboardBody where you can display whatever you want.
Update
Based on your clarification you can use shinyjs to hide/show the relevant part:
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("About", icon = icon("info"), tabName = "about"),
menuItem("Contact", icon = icon("phone"), tabName = "contact")
)
)
)
body <- dashboardBody(
useShinyjs(),
fluidPage(
fluidRow(id = "mainContent",
column(12, h1("Main Content"))
),
hidden(fluidRow(id = "contact", h1("Contact Info")))
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) {
observe({
if (input$tabs == "contact") {
hideElement("mainContent")
showElement("contact")
} else {
hideElement("contact")
showElement("mainContent")
}
})
}
)
When you now click on Contact the main part is hidden and the contact is shown. I have, however, the feeling that is a bit mis-using the idea of shinydashboard.
#thothal, it did not allow me to add as a comment coz of the length, hence posting my comment(below) as an answer.
I am sorry if I was unclear. However, your answer helped me partially. I have incorporated tabItems part in my dashboardBody section, as shown below:
dashboardBody(
fluidPage(
fluidRow(
column(12, div(dataTableOutput("dataTable")))
)
),
tabItems(
tabItem("About", h1("text to be displayed"))
)
)
but the "text to be displayed" shows up below the table.
What I want is, About section (when clicked) should display only the text and not the table. I understand this is just formatting of the code in dashboardBody section but I don't know how to do it.
Just to be more clear, my dashboard's section should display the datatable at all times and the about section when clicked should show up the text and not the datatable. I really hope this is clear. Thanks a ton for your help :)
I'm Building a dashboard using the packages shiny and shinydashboard, The issue I am having is when I try to include a math symbol inline with text when the app is launched it always smaller than its surrounding text. When the app is launched and right click on a math symbol and navigate to
Math Setting>Math Render> the switch from HTML-CSS to HTML Preview it becomes the correct size. Wondering why this is the case and how I can make appear as the correct size by default so I don't have users switch HTML preview when they launch the app.
I tried adding the follow to change my Mathjax configuration upon the apps launch but it didn't seem to have any effect:
tags$div(HTML("<script type='text/x-mathjax-config' >
MathJax.Hub.Config({
showProcessingMessages: true,
jax: ['input/TeX', 'output/PreviewHTML'],
});
</script >
"))
Here is a basic version of what I'm dealing with when ran the Mu symbol is much smaller than the other text.
header <- dashboardHeader(
#Set the title and title size of the dashboard. This will be located in top left coner of app.
title = "My Dashboard",
titleWidth = 400
)
# Sidebar Layout
# Contains the design for collapsable sidebar of the dashboard which allows users to navigate to its differnt pages.
sidebar <- dashboardSidebar(
sidebarMenu(
# Each item navigates the dashboard to its corresponding page
menuItem("Inputs", tabName = "inputs",icon = icon("angle-right"))
)
)
#Boday Layout
# Contains the design for each indivual page listed within the side bar
body <- dashboardBody(
withMathJax(),
tags$div(HTML("<script type='text/x-mathjax-config' >
MathJax.Hub.Config({
showProcessingMessages: true,
jax: ['input/TeX', 'output/PreviewHTML'],
});
</script >
")),
dashboardBody(
# TabItemS refrences theset of dashboard pages as whole
tabItems(
# First Pages contents
tabItem(
tabName = "inputs",
h1("Here is the Problem"),
fluidRow(
box(width = 4,
h3("This symobl \\(\\mu\\) is much smaller")
)
)
)
)
)
)
ui <- dashboardPage(header,sidebar,body)
server <- function(input, output) {
}
shinyApp(ui, server)
In RShiny is there any way to send an array or list of menuItems to sidebarMenu?
dashboardSidebar(width = 180,
sidebarMenu(
menuItem("server1", tabName = "server1", icon = icon("server")),
menuItem("server2", tabName = "server2", icon = icon("server")),
menuItem("server3", tabName = "server3", icon = icon("server"))
)
)
I actually have to add about 30 or menuItems to add and the names will change over time. This is also an issue with sending multiple fluidRows to a tabItem. Hopefully, the same solution can apply to both.
There is the possibility to use uiOutput, but personally, I am not a fan. However, there is not a single solution for all dynamic element additions, especially when not using uiOutput.
Here is a minimal solution that does what you said you wanted, but I guess this is only the first step for you (since I don't think you really just want to add menuItems). If you are looking for a more customized answer, please edit your original post with your actual problems.
You can add menuItems to the sidebar very easily, if you use JavaScript/jQuery. This is mainly because menuItems are not really "connected" to the Shiny-App but merely toggle buttons. It gets more difficult if you wanted to add complex reactive elements.
There is basically the trick that you give the target element (sidebar) an Id for easy selection and add the HTML that is generated by the shiny ui functions. The customMessageHandler gets both components and tells the browser to create the element.
More on customMessageHandlers can be found here.
Sample code below:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(width = 180,
sidebarMenu(id = "nice",
menuItem("server1", tabName = "server1", icon = icon("server")),
menuItem("server2", tabName = "server2", icon = icon("server")),
menuItem("server3", tabName = "server3", icon = icon("server"))
)
),
dashboardBody(
actionButton("button", "Add MenuItem"),
tags$script("
Shiny.addCustomMessageHandler('addMenuItem', function(message){
$('#' + message[0]).append(message[1]);
})
")
)
)
server <- function(input, output, session){
addMenuItem <- function(item, sidebarId){
session$sendCustomMessage(type = "addMenuItem", message = list(sidebarId, as.character(item)))
}
observeEvent(input$button, {
newId <- as.numeric(input$button) + 3
newMenuItem <- menuItem(paste0("server", newId), tabName = paste0("server", newId), icon = icon("server"))
addMenuItem(newMenuItem, "nice")
})
}
shinyApp(ui, server)