I am new to Shiny and Shinydashboard. Please consider the following code snippet (small part of huge code):
dbsidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Rank List", icon = icon("th"), tabName = "Widgets1", badgeColor = "green"),
menuItem("Build Your", icon = icon("th"), tabName = "Widgets2", badgeColor = "green"),
menuItem("Groups", icon = icon("th"), tabName = "Widgets3", badgeColor = "green")
)
)
dbBody <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
fluidRow(
#Pie Charts
splitLayout(
#cellWidths = c("50%", "50%"),
style = "border: 1px solid silver;",
cellWidths = 450,
cellArgs = list(style = "padding: 6px"),
plotlyOutput("Piechart1", width = "400px", height = "200px"),
plotlyOutput("Piechart2", width = "400px", height = "200px"),
plotlyOutput("Piechart3", width = "400px", height = "200px")
)
)
),
tabItem(tabName = "Widgets1",
#Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("TCScore","TCScore:",min = 0, max = 100, value = c(0,100))
),
# Show a plot of the generated distribution
mainPanel(
tabPanel("Heading", plotlyOutput("tbTable"))
)
),
downloadButton('downloadData', 'Download')
),
tabItem(tabName = "Widgets2", "XX"
# #Data Table
# sidebarLayout(
# sidebarPanel(
# sliderInput("TCCScore","TCCScore:",min = 0, max = 100, value = c(0,100)),
# ),
#
# # Show a plot of the generated distribution
# mainPanel(
# tabPanel("Heading", dataTableOutput("tbTable1"))
# )
#
# ),
# downloadButton('downloadData', 'Download')
),
tabItem(tabName = "Widgets3", "third"
)
)
)
On the dashboardSidebar, I have added 4 tabs - dashboard, Widget1, Widget2, Widget3. Initially for each of these tabs, I used simple text to render the UI dashboardBody and I got the display correctly. I started filling in each of these sections - "dashboard", "Widget1" and the display worked correctly for me. Unfortunately, for "Widget2 - when I removed the "XX" and uncommented the code shown above, the UI got completely distorted. It looks like the main UI elements in the dashboardBody did not get rendered? Can anyone tell me what I am doing wrong? Please help. I am sorry I have not posted the entire working code, but it is far too long, hence I had to put up only a small code snippet.
Thanks in advance! Cheer!
Related
I have an R shiny app with different download buttons as illustrated in the code below. The issue is that the position of the download button within fluidRow is not automatically aligned with the positions of other input elements like dateInput below.
ui <- dashboardPage(
title = "Test Dashboard", # this is the name of the tab in Chrome browserr
dashboardHeader(title = "Web Portal"),
dashboardSidebar(
sidebarMenu(
menuItem('Retail', tabName = "retail", icon = icon("th"),
menuItem('Dashboard', tabName = 'retail_dashboard'))
)
),
dashboardBody(
tabItem(tabName = "retail_dashboard",
tabsetPanel(type = "tabs",
tabPanel("Dashboard",
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt", label = "Start Date:", value = Sys.Date()-10)), # 1yr ago
column(2,
dateInput("idx_muni_tot_ret_end_dt", label = "End Date:", value = Sys.Date())),
column(2,
downloadButton("download_idx_muni_TR_data","Download Data"))
)
)
)
)
)
)
server <- function(input, output, session) {
# code...
}
cat("\nLaunching 'shinyApp' ....")
shinyApp(ui, server)
I found similar questions here How do I align downloadButton and ActionButton in R Shiny app? and here Change download button position in a tab panel in shiny app but they don't seem to answer my questions. I also attach a screenshot with the current button position as well as the expected one.
A workaround is to simulate a label on top of the download button and add 5px of margin-bottom.
column(
width = 2,
div(tags$label(), style = "margin-bottom: 5px"),
div(downloadButton("download_idx_muni_TR_data", "Download Data"))
)
A bit of css does the trick:
ui <- dashboardPage(
title = "Test Dashboard",
dashboardHeader(title = "Web Portal"),
dashboardSidebar(
),
dashboardBody(
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt",
label = "Start Date:", value = Sys.Date() - 10)),
column(2,
dateInput("idx_muni_tot_ret_end_dt",
label = "End Date:", value = Sys.Date())),
column(2,
div(style = "margin-bottom:15px",
downloadButton("download_idx_muni_TR_data","Download Data")))
, style = "display:flex;align-items:end")
)
)
Update
If you want to add a selectInput you need yet some new css tweaks to get the input on the same line:
ui <- dashboardPage(
title = "Test Dashboard",
dashboardHeader(title = "Web Portal"),
dashboardSidebar(),
dashboardBody(
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt",
label = "Start Date:", value = Sys.Date() - 10)),
column(2,
dateInput("idx_muni_tot_ret_end_dt",
label = "End Date:", value = Sys.Date())),
column(2,
tagAppendAttributes(selectInput("slc", "Select", LETTERS), style="margin-bottom:10px")),
column(2,
div(style = "margin-bottom:15px",
downloadButton("download_idx_muni_TR_data","Download Data"))),
style = "display:flex;align-items:end")
)
)
The Shiny dashboard fails to show data it once did when a slider input is added
The code runs perfectly if I remove menuSubItem from the histogram menu item when its added however it only shows me the linegraphs even when on the histogram menu item.
library(ggplot2)
library(shiny)
library(shinydashboard)
longdata1 <- read.csv("longdata1.csv", stringsAsFactors = FALSE)
# Define UI for application that draws a histogram
dashboardPage(
dashboardHeader(title = "My Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Histograms", tabName = "Histograms", icon = icon("bar-chart-o"),
menuSubItem(icon=NULL,
sliderInput("bars",
"Number of Bars",
min = 3,
max = 40,
value = 10) )
),
menuItem("Linegraphs",tabName = "Linegraphs", icon = icon("line-chart")),
varSelectInput("variable", "Variable:", longdata1),
sliderInput("bars",
"Number of Bars:",
min = 3,
max = 40,
value = 10)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "Histograms",
h2(plotOutput("dist3Plot"),plotOutput("dist4Plot"))
),
tabItem(tabName = "Linegraphs",
h2( plotOutput("dist10Plot"))
)
)
),
skin = "black"
)
So I need to create action buttons in R shiny based on the number of rows in dataframe, upon googling for the solution now able to create the action buttons dynamically but I was not able to label it according to the values in the data frame.
Here is my UI.R
library(shiny)
library(shinydashboard)
library(DT)
shinyUI(
dashboardPage(
dashboardHeader(title = div(img(src="new.png", height = 40, width = 200),"IPT dashboard",width = 300)),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Vehicle Data", tabName = "VehicleData", icon = icon("table")),
menuItem("Driver Behaviour", tabName = "DriverBehaviour", icon = icon("th")),
menuItem("Vehicle Information", tabName = "Vehicleinfo", icon = icon("th")),
menuItem("Crash Report", tabName = "crashreport", icon = icon("th")),
menuItem("Emission Report", tabName = "Emissionreport", icon = icon("th")),
menuItem("Fuel Economy", tabName = "FuelEconomy", icon = icon("th")),
menuItem("View Location", tabName = "viewloc", icon = icon("th")),
menuItem("detctest", tabName = "dtctest", icon = icon("th"))
),
width = "200px"
),
dashboardBody(
tabItems(
tabItem("dashboard",
tabsetPanel(
tabPanel( title = "Real Time",
br(),
fluidRow(
box(
tags$head(
tags$style(HTML("
.box { overflow-y: auto; }
" )
)
),
height = "300px",
width =2,
h3("Trouble Code(s)", align="left"),
column(1, uiOutput("go_buttons"))
)
)#tabitemsclose
)#dashbodyclose
)#pageclose
)#uiclose
Server.R
library(shiny)
library(DT)
shinyServer(function(input,output)
{
options(digits = 22)
output$go_buttons <- renderUI({
mat <- as.data.frame(c("P01","p02","p03"))
buttons <- as.list(1:ncol(mat))
buttons <- lapply(buttons, function(i)
{
btName <- paste0(mat[i])
fluidRow(
br(),
column(2,actionButton(btName,paste(mat[i])))
)
})
})
When I execute the above scripts, It shows only one action button with the values as in the dataframe.
Expected output
Here in Server.R I am creating dataframe but in real time I will be fetching it through other calculation where the number of rows is not fixed which implies the number of action buttons are also not predefined, Number of action button will be equal to the number of rows in the data frame also, the label of action button should be same as the values in the data frame.
You only get one action button out, because your apply loop only has one number in it. You take 1:ncol(mat) eventhough your data.frame has only one column.
I changed two things:
I replaced buttons inside the lapply-function with 1:nrow(mat)
I used mat[i,1] because your values are in the rows. If in your data the values you want on the action buttons are in one vector you can keep using [i]
The app.r:
library(shiny)
library(shinydashboard)
library(DT)
### ui.r
ui <- shinyUI(dashboardPage(
dashboardHeader(title = div(img(src="new.png", height = 40, width = 200),"IPT dashboard",width = 300)),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Vehicle Data", tabName = "VehicleData", icon = icon("table")),
menuItem("Driver Behaviour", tabName = "DriverBehaviour", icon = icon("th")),
menuItem("Vehicle Information", tabName = "Vehicleinfo", icon = icon("th")),
menuItem("Crash Report", tabName = "crashreport", icon = icon("th")),
menuItem("Emission Report", tabName = "Emissionreport", icon = icon("th")),
menuItem("Fuel Economy", tabName = "FuelEconomy", icon = icon("th")),
menuItem("View Location", tabName = "viewloc", icon = icon("th")),
menuItem("detctest", tabName = "dtctest", icon = icon("th"))
),
width = "200px"
),
dashboardBody(tabItems(
tabItem("dashboard",
tabsetPanel(
tabPanel( title = "Real Time",
br(),
fluidRow(
box(
tags$head(
tags$style(HTML("
.box { overflow-y: auto; }
" )
)
),
height = "300px",
width =2,
h3("Trouble Code(s)", align="left"),
column(1, uiOutput("go_buttons"))
)))))
) #tabitemsclose
)#dashbodyclose
)#pageclose
) #uiclose
### server.r
server <- function(input, output, session){
options(digits = 22)
output$go_buttons <- renderUI({
mat <- as.data.frame(c("P01","p02","p03"),stringsAsFactors = FALSE)
buttons <- lapply(1:nrow(mat), function(i)
{
btName <- paste0(mat[i,1])
fluidRow(
br(),
column(2,actionButton(btName,paste(mat[i,1])))
)
})
return(buttons)
})
}
shinyApp(ui, server)
I have a shiny application, where in I am trying to provide a checkbox on top of a graph for the user to select. Currently, the check box is rendered below the title, whereas I want the title on the left hand side and the check box on the right hand side in the same line. I am sure it can be achieved through recoding CSS, but don't know how. The current code looks as follows:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "MODULE",titleWidth = 225
),
dashboardSidebar(
width = 225,
sidebarMenu(id = "tabs",
menuItem("TOPLINES", tabName = "tplines", icon = shiny::icon("dashboard"))
)),
dashboardBody(
tabItems(
tabItem(
tabName = "tplines",
fluidRow(
box(
checkboxInput(inputId = "inventorytop8metrocheck", "Add to reports", value = FALSE),
width = 6, status = "info", title = "Inventory information",
div(plotlyOutput("inventorytop8metro"), width = "100%", height = "400px", style = "font-size:80%;")
)
)))))
server <- function(session,input,output){
}
shinyApp(ui,server)
Maybe you are just looking for the standard row partition with columns. The title arguement takes any ui elements, so we input a row that is half your original title and half the checkbox input. Thus, they are in line. Of course, the checkbox then has the same style as the title. If you don't want that, you can alter the style by setting a style parameter in the checkbox column.
library(shiny)
library(shinydashboard)
library(plotly)
ui <- dashboardPage(
dashboardHeader(
title = "MODULE",titleWidth = 225
),
dashboardSidebar(
width = 225,
sidebarMenu(id = "tabs",
menuItem("TOPLINES", tabName = "tplines", icon = shiny::icon("dashboard"))
)),
dashboardBody(
tabItems(
tabItem(
tabName = "tplines",
fluidRow(
box(
width = 6, status = "info", title = fluidRow(
column(6, "Inventory information"),
column(6, checkboxInput(inputId = "inventorytop8metrocheck", "Add to reports", value = FALSE))
),
div(plotlyOutput("inventorytop8metro"), width = "100%", height = "400px", style = "font-size:80%;")
)
)
)
)
)
)
server <- function(session,input,output){}
shinyApp(ui,server)
Given below the code i used for displying selectizeInput and absolutePanel. selectizeInput is not getting merged with the page background. it is displaying above the absolutePanel. please help me to fix.
ui.r
library(shinydashboard)
shinyUI(
fluidPage(
dashboardPage(skin = c("blue"),
dashboardHeader(title = "R Tools"
),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
box(
title = "Tools", status = "primary", solidHeader = TRUE,
collapsible = TRUE,width = 4,
uiOutput("showtxttruevalue"),
uiOutput("showddllalternate")
),
absolutePanel(
bottom = 20, right = 60,top=200, width = "auto",
draggable = TRUE,
wellPanel(
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
aa")
), style = "opacity: 0.9"
)
)
))
server.r
library(shiny)
library(ggplot2)
library(googleVis)
shinyServer(function(input, output, session) {
output$showtxttruevalue <- renderUI({
numericInput(inputId="txttruevalue", label="TrueValue", value = 0)
})
output$showddllalternate <- renderUI({
selectizeInput("ddllalternate", "Alternate:",c('unequal','less','greater'), selected='<>')
})
})
To fix it, use the 'left' parameter while positioning the absolutePanel(). Use the following to position it.
absolutePanel(
left = 500, bottom = 20, right = 60,top=200, width = "auto",
draggable = TRUE,
wellPanel(
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
aa")
), style = "opacity: 0.9"