I want to have my numericInputIcon labels inline with the input boxes, and at the same time have the labels like the main and sub categories :
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(HTML("div#inline label { width: 52%; }
div#inline input { display: inline-block; width: 68%;}"))),
tags$head(
tags$style(type="text/css", "#inline label{ display: table-cell; text-align: left; vertical-align: middle; }
#inline .form-group { display: table-row;}")),
box(
title = "Shiny Box",
status = "success",
solidHeader = TRUE,
div(id="inline", style="width:35vw;",
div(HTML("<b>TEST </b>")),
br(),
column(12,
numericInputIcon("A", h5("test1"), value = 20, icon = icon("percent"))) ,
column(12,offset = 1,
numericInputIcon("B", h5("test1A"), value = 40, icon = icon("percent")) ,
numericInputIcon("C", h5("test1AA"), value = 60, icon = icon("percent"))) ,
column(12,
numericInputIcon("D", h5("test2"), value = 20, icon = icon("percent"))) ,
column(12,offset = 1,
numericInputIcon("E", h5("test2A"), value = 40, icon = icon("percent")) ,
numericInputIcon("F", h5("test2AA"), value = 60, icon = icon("percent"))) ,
currencyInput("X", "Total", value = 0.3, format = "percentageUS2dec")
)
)
)
),
server = function(input, output) { }
)
How should I correct the code to have all the input boxes aligned in one column ?!
Instead of using offset add a class to the subcategory h5 tags which could be used to set the left margin for the label without affecting the placement of the input box. In the code below I added a class indent and set left margin via h5.indent {margin-left: 40px}.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(HTML("div#inline label { width: 52%; }
div#inline input { display: inline-block; width: 68%;}"))),
tags$head(
tags$style(type="text/css",
"
#inline label{ display: table-cell; text-align: left; vertical-align: middle; }
#inline .form-group { display: table-row;}
h5.indent {margin-left: 40px}
")),
box(
title = "Shiny Box",
status = "success",
solidHeader = TRUE,
div(id="inline", style="width:35vw;",
div(HTML("<b>TEST </b>")),
br(),
column(12,
numericInputIcon("A", h5("test1"), value = 20, icon = icon("percent"))) ,
column(12,
numericInputIcon("B", h5("test1A", class = 'indent'), value = 40, icon = icon("percent")) ,
numericInputIcon("C", h5("test1AA", class = 'indent'), value = 60, icon = icon("percent"))) ,
column(12,
numericInputIcon("D", h5("test2"), value = 20, icon = icon("percent"))) ,
column(12,
numericInputIcon("E", h5("test2A", class = 'indent'), value = 40, icon = icon("percent")) ,
numericInputIcon("F", h5("test2AA", class = 'indent'), value = 60, icon = icon("percent"))) ,
currencyInput("X", "Total", value = 0.3, format = "percentageUS2dec")
)
)
)
),
server = function(input, output) { }
)
I want to change the name of the photo in front of the photo by changing each photo from the slide.
But using the following codes, the input id is not displayed at all. The codes are as follow
library(shinydashboardPlus)
ui<- dashboardPagePlus(title="Sample",
dashboardHeaderPlus(title="Sample"),
dashboardSidebar(),
dashboardBody(
fluidRow(column(width=6,
carousel(
id = "AA",
carouselItem(
caption = "Image1",
tags$img(src = "https://cdn.sstatic.net/Sites/stackoverflow/company/Img/logos/so/so-logo.svg?v=a010291124bf", height = 400, width = 400, align="center")
),
carouselItem(
caption = "Image2",
tags$img(src = "https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png", height = 400, width = 400, align="center")
))),
column(width=6, uiOutput("Text"))
)
)
)
server<- function(input, output, session) {
output$Text<-renderText({
Text<-input$AA
as.character(Text)
})
}
shinyApp(ui, server) ```
I do see them showing up. It's easier to see if you change the font size and color:
library(shinydashboardPlus)
library(shinydashboard)
ui<- dashboardPagePlus(title="Sample",
dashboardHeaderPlus(title="Sample"),
dashboardSidebar(),
dashboardBody(
htmltools::tags$style(
".carousel-caption{
font-size: 48px;
color: black;
}"
),
fluidRow(column(width=6,
carousel(
id = "AA",
carouselItem(
caption = "Image1",
tags$img(src = "https://cdn.sstatic.net/Sites/stackoverflow/company/Img/logos/so/so-logo.svg?v=a010291124bf", height = 400, width = 400, align="center")
),
carouselItem(
caption = "Image2",
tags$img(src = "https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png", height = 400, width = 400, align="center")
))),
column(width=6, uiOutput("Text"))
)
)
)
server<- function(input, output, session) {
output$Text<-renderText({
Text<-input$AA
as.character(Text)
})
}
shinyApp(ui, server)
As you are using uiOutput, try renderUI on the server side. Also, to show different text in each image, you need to define renderText and output it in carouselItem. Try this code
library(shinydashboardPlus)
library(shinydashboard)
ui<- dashboardPagePlus(title="Sample",
dashboardHeaderPlus(title="Sample"),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(HTML("
#AA{
width:900px;
height:600px;
}
.carousel-control{
color:#FF0000;
}
.carousel-caption{
font-size: 48px;
color: red;}
"))
),
fluidRow(column(width=6,
carousel(
id = "AA",
carouselItem(
caption = "Image1",
textOutput("text1"),
tags$img(src = "https://cdn.sstatic.net/Sites/stackoverflow/company/Img/logos/so/so-logo.svg?v=a010291124bf", height = 400, width = 400, align="center")
),
carouselItem(
caption = "Image2",
textOutput("text2"),
tags$img(src = "https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png", height = 400, width = 400, align="center")
))),
column(width=6, uiOutput("Text"))
)
)
)
server<- function(input, output, session) {
output$Text<-renderUI({
#Text<-as.character(input$AA)
tagList(
p("I like to print something over all images", style = "color:blue")
)
})
output$text1 <- renderText("Print something in image 1")
output$text2 <- renderText("Print something in image 2")
}
shinyApp(ui, server)
I have a shiny app that looks like this:
I would like to add a Box 3 and Box 4 beneath the mouse logo, but cannot seem to figure out how to do this without messing the page up. The result is below:
i am using two fluidRow functions to make these boxes, but I am not sure how I can keep the entire page intact while doing so. Any help is appreciated! Code is below:
#require packages
rqrd_Pkg = c('shiny','plotly','plyr','tidyverse',
'uuid', 'devtools', 'gtools', 'inline', 'shiny',
'shinydashboard', 'plotly', 'shinythemes',
'shinycssloaders', 'shinyjs',
'DT', 'tictoc',
'data.table', 'htmlwidgets')
require(shiny)
for(p in rqrd_Pkg){
if(!require(p,character.only = TRUE))
install.packages(p, Ncpus=8);
library(p,character.only = TRUE)
}
#include style for header
head.style <- "
/* old shiny progress indicators */
.shiny-progress-container {
position: fixed;
top: 0px;
width: 100%;
z-index: 4000;
}
.shiny-progress .progress-text {
color: #020202;
background-colort: #FF0000;
width: 225px;
left: calc(50% - 125px);
}
.progress-text {
/* Copy the below to vertically center the progress bar text box in the shiny dashboard header */
/* !important is crucial here otherwise it gets overridden by the dreaded element.style */
top: 15px !important;
text-align: center;
}
"
#initiate dashboard attributes and colors
dashboardPage(
skin = "purple",
dashboardHeader(
title = HTML("Title"),
dropdownMenu(type = "notifications", icon = tagList(icon("question-circle"), "Help"), badgeStatus = NULL, headerText = "Links",
tags$li(a(icon("external-link"), "XYZ", href = "http://info.com", target = "blank")),
tags$li(a(icon("external-link"), "ABC", href = "http://info.com", target = "blank")))
),
dashboardSidebar(sidebarMenu(
menuItem("Target Dashboard", tabName = "dashboard_tab", icon = icon("dashboard"))
)),
#################################################################################
#################################################################################
#################################################################################
#################################################################################
#Configure dashboard body.
dashboardBody(
tags$head(
tags$link(rel = "shortcut icon", href = "favicon.ico"),
tags$link(rel = "apple-touch-icon", sizes = "180x180", href = "favicon.ico"),
tags$link(rel = "icon", type = "image/png", sizes = "32x32", href = "favicon-32x32.png"),
tags$link(rel = "icon", type = "image/png", sizes = "16x16", href = "favicon-16x16.png"),
tags$style(head.style)
),
#h1(paste0("<b>","Gene summary:","</b>")),
titlePanel(div(HTML("<b>Gene summary</b>"), align = "left")),
tabItems(
tabItem(tabName = "dashboard_tab",
tags$style(HTML("
#first {
border: 4px double red;
}
#second {
border: 2px dashed blue;
}
")),
fluidRow(
valueBoxOutput("valueGeneName"),
valueBoxOutput("valueGeneRank"),
valueBoxOutput("gtexSpec"),
valueBoxOutput("valueHuman"),
valueBoxOutput("valueMouse"),
valueBoxOutput("valueNHP"),
valueBoxOutput("exprCompartment")
),
h2(paste0("Header 1"), align="left"),
#insert human logo
mainPanel(
img(src='man_log.png', height="10%", width="10%", align="left"),
),
#create boxes
fluidRow(
box(
title = "Box 1",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput("roc", height = "300px")
),
box(
title = "Box 2"
,status = "primary"
,solidHeader = TRUE
,collapsible = TRUE
,plotOutput("sensDNAProt", height = "300px")
)),
mainPanel(
img(src='mouse.png', height="10%", width="10%", align="left")
),
h2(paste0("Header 2"), align="left"),
#ADDING THIS CAUSES PROBLEMS!!!
fluidRow(
box(
title = "Box 3",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput("roc", height = "300px")
),
box(
title = "Box 4",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput("roc", height = "300px")
)
)
)
)
)
)
`
You should get the desired output with this.
### include style for header
head.style <- "
/* old shiny progress indicators */
.shiny-progress-container {
position: fixed;
top: 0px;
width: 100%;
z-index: 4000;
}
.shiny-progress .progress-text {
color: #020202;
background-colort: #FF0000;
width: 225px;
left: calc(50% - 125px);
}
.progress-text {
/* Copy the below to vertically center the progress bar text box in the shiny dashboard header */
/* !important is crucial here otherwise it gets overridden by the dreaded element.style */
top: 15px !important;
text-align: center;
}
"
#initiate dashboard attributes and colors
ui <- dashboardPage(
skin = "purple",
dashboardHeader(
title = HTML("Title"),
dropdownMenu(type = "notifications", icon = tagList(icon("question-circle"), "Help"), badgeStatus = NULL, headerText = "Links",
tags$li(a(icon("external-link"), "XYZ", href = "http://info.com", target = "blank")),
tags$li(a(icon("external-link"), "ABC", href = "http://info.com", target = "blank")))
),
dashboardSidebar(sidebarMenu(
menuItem("Target Dashboard", tabName = "dashboard_tab", icon = icon("dashboard"))
)),
#################################################################################
#################################################################################
#################################################################################
#################################################################################
#Configure dashboard body.
dashboardBody(
tags$head(
tags$link(rel = "shortcut icon", href = "favicon.ico"),
tags$link(rel = "apple-touch-icon", sizes = "180x180", href = "favicon.ico"),
tags$link(rel = "icon", type = "image/png", sizes = "32x32", href = "favicon-32x32.png"),
tags$link(rel = "icon", type = "image/png", sizes = "16x16", href = "favicon-16x16.png"),
tags$style(head.style)
),
#h1(paste0("<b>","Gene summary:","</b>")),
titlePanel(div(HTML("<b>Gene summary</b>"), align = "left")),
tabItems(
tabItem(tabName = "dashboard_tab",
tags$style(HTML("
#first {
border: 4px double red;
}
#second {
border: 2px dashed blue;
}
")),
fluidRow(width=12,
tabBox(id = "tabset1", height = "2250px", width=12, title = " ",
tabPanel(
br(),br(),
fluidRow(h2(paste0("Header 0"), align="left")),
fluidRow(
shinydashboard::valueBoxOutput("myvaluebox1", width=4),
shinydashboard::valueBoxOutput("myvaluebox2", width=4),
shinydashboard::valueBoxOutput("myvaluebox3", width=4)
),
fluidRow(
shinydashboard::valueBoxOutput("myvaluebox4", width=4),
shinydashboard::valueBoxOutput("myvaluebox5", width=4),
shinydashboard::valueBoxOutput("myvaluebox6", width=4)
),
fluidRow(
shinydashboard::infoBoxOutput("myvaluebox7", width=4),
shinydashboard::valueBoxOutput("myvaluebox8", width=4)
),
br(),
fluidRow(h2(paste0("Header 1"), align="left")),
#br(),
fluidRow(img(src='man_log.png', height="5%", width="5%", align="left")),
br(),
fluidRow(
column(6,
box( height="300px", width=NULL,
collapsible = TRUE,
title = "Box 1",
status = "primary",
solidHeader = TRUE,
plotOutput("plot1", height = "210px", width="350px")
), style='width: 500px; height: 400px' ),
column(6,
box(height="300px", width="450px",
title = "Box 2",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot2", height = "230px", width="380px")
), style='width: 500px; height: 400px')
),
br(),# br(),
img(src='mouse.png', height="10%", width="10%", align="left"),
br(),
h2(paste0("Header 2"), align="left"),
br(),
fluidRow(
column(6,
box(height="300px", width="450px",
title = "Box 3",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot3", height = "220px", width="350px")
), style='width: 500px; height: 400px' ),
column(6,
box(height="300px", width="450px",
title = "Box 4",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot4", height = "220px", width="350px")
), style='width: 500px; height: 400px')
)
) ## end of tabPanel
) ## end of tabBox
)
) ## end of tabItem
)
)
)
server <- function(input, output, session){
output$plot1 <- renderPlot(qplot(rnorm(500),fill=I("red"),binwidth=0.2,title="plotgraph1"))
output$plot2 <- renderPlot(qplot(rnorm(500),fill=I("green"),binwidth=0.2,title="plotgraph2"))
output$plot3 <- renderPlot(qplot(rnorm(500),fill=I("blue"),binwidth=0.2,title="plotgraph3"))
output$plot4 <- renderPlot(qplot(rnorm(500),fill=I("orange"),binwidth=0.2,title="plotgraph4"))
output$myvaluebox1 <- shinydashboard::renderValueBox({
shinydashboard::valueBox('2000',subtitle = "blah blah blah1",icon = icon("car"),
color = "green"
)
})
output$myvaluebox2 <- shinydashboard::renderValueBox({
shinydashboard::valueBox('2001',subtitle = "blah blah blah2",icon = icon("car"),
color = "green"
)
})
output$myvaluebox3 <- shinydashboard::renderValueBox({
shinydashboard::valueBox('2002',subtitle = "blah blah blah3",icon = icon("car"),
color = "green"
)
})
output$myvaluebox4 <- shinydashboard::renderValueBox({
shinydashboard::valueBox('2009',subtitle = "blah blah blah4",icon = icon("car"),
color = "red"
)
})
output$myvaluebox5 <- shinydashboard::renderValueBox({
shinydashboard::valueBox('2010',subtitle = "XYZ1",icon = icon("car"),
color = "red"
)
})
output$myvaluebox6 <- shinydashboard::renderValueBox({
shinydashboard::valueBox('2011',subtitle = "XYZ2",icon = icon("car"),
color = "green"
)
})
output$myvaluebox7 <- shinydashboard::renderInfoBox({
shinydashboard::infoBox('2020',subtitle = "This is infobox",icon = icon("car"),
color = "blue"
)
})
output$myvaluebox8 <- shinydashboard::renderValueBox({
shinydashboard::valueBox('2021',subtitle = "This is valuebox",icon = icon("car"),
color = "blue"
)
})
}
shinyApp(ui = ui, server = server)
I would like to display Shinydashboard input fields as a type of menuSubItem, however I'm finding it difficult to write the solution.
Household Penetration(dropdown on click)
Store-filters
Button
Sales(Household Penetration Menu collapses on click and Sales Menu drops)
filter x
Do you have any solution for this?
ui.R
library(shiny)
library(shinydashboard)
library(leaflet)
source("R/load_metadata.R", chdir=TRUE)
# Header of the dashboard
header <- dashboardHeader(
title = "x",
titleWidth = 350,
dropdownMenuOutput("task_menu")
)
# Sidebar of the dashboard
sidebar <- dashboardSidebar(
sidebarMenu(
id = "menu_tabs",
menuItem("Household Penetration", tabName = "menutab1", icon = icon("percent")),
selectInput("storeInput", label = "Store",
choices = STOREFILTER$STORE_NAME,
selected = STOREFILTER$STORE_NAME[1]),
actionButton("Button", "Filter Map"),
menuItem("Sales", tabName = "menutab2", icon = icon("euro"))
)
)
# Body of the dashboard
body <- dashboardBody(
tabItems(
tabItem(
tabName = "menutab1",
tags$style(type = "text/css", "#mymap {height: calc(100vh - 80px) !important;}"),
leafletOutput("mymap")),
tabItem(
tabName = "menutab2",
tags$style(type = "text/css", "#mymap {height: calc(100vh - 80px) !important;}"),
h2("Dashboard tab content")
)
)
)
# Shiny UI
ui <- dashboardPage(
header,
sidebar,
body,
tags$head(
tags$style(HTML(type='text/css', "#Button { width:40%; margin-left: 30%; margin-right: 30%; background-color: #3C8DBC; color: black; font-weight: bold; border: 0px}")))
)
You can show/hide your inputs fields with a conditionalPanel according to the selected menu:
conditionalPanel(
condition = "input.menu_tabs == 'menutab1'",
selectInput("storeInput", label = "Store",
choices = STOREFILTER$STORE_NAME,
selected = STOREFILTER$STORE_NAME[1]),
actionButton("Button", "Filter Map")
)