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)
Related
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!
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 use shiny with shinydashboard. I have one tabbox with two tabPanels. Then there is another box which should display either textOutput("a") if tab1 in tabbox is selected or textOutput("b") if tab2 is selected.
I provide whole code for reproducibility but watch out for comments which show where the important part is.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
skin = "red",
dashboardHeader(title = "lalala", titleWidth = 450),
sidebar <- dashboardSidebar(width = 400,
sidebarMenu(
menuItem(
text = strong("First tab"),
tabName = "first",
icon = icon("dashboard")
)
)),
body <- dashboardBody(fluidRow(
tabBox(
title = "First tabBox",
id = "tabset1",
height = "250px",
############## based on which of this tab is selected
tabPanel("Tab1", "First tab content"),
tabPanel("Tab2", "Tab content 2")
),
box(
title = "Selection criteria for chart",
height = "700px",
width = 4,
solidHeader = TRUE,
status = "danger",
############## I want in this box to display either textouput "a" or "b"
textOutput("a")
)
))
)
server <- function(input, output) {
output$a <- renderText(a <- "ahoj")
output$b <- renderText(b <- "cau")
}
input$tabset1 returns the id of the currently selected tab (so either Tab1 or Tab2). Then you can use an if/else statement to print the content you like depending on this return value.
I am working with shinydashboard and using tabsetPanel, however strange name/number appears on the each tabPanel in the upper-left corner (like: tab-4750-1 and the number changes).
Does anyone know how i can remove it?
Hint: The problem appears in the menuItem: Tabelle & Plots
Code:
library(shiny)
library(shinydashboard)
library(ggplot2)
library(scales)
library(reshape2)
library(plyr)
library(dplyr)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Tabelle & Plots", icon = icon("area-chart"), tabName = "tabelle")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard"
),
tabItem(tabName = "tabelle",
tabsetPanel(id="tabs",width = NULL, height = "800px", selected = 1,
tabPanel(value=1,title="Tabelle filtern",
fluidRow(
column(12,
box(width = NULL, div(style = 'overflow-y: scroll; overflow-x: scroll;max-height: 650px; position:relative;',
dataTableOutput("tabelle")))))),
tabPanel("Plots", value = 2,
fluidRow(
column(12,
box(width = NULL, plotOutput("plot", height=650)),
box(status = "danger",width = NULL,div(style = 'overflow-x: scroll;position:relative;',
dataTableOutput("tabelle2")))))))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Thanks for help!
Cheers
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"