Related
I want to use a custom color for box in shinydashboard. the following css does the trick, but when I have the collapsible = TRUE it does not looks consistant :
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$style(HTML("
.box.box-solid.box-success>.box-header {
color:#2071B5;
background:#ABD7E9
}
.box.box-solid.box-success{
border-bottom-color:#ABD7E9;
border-left-color:#ABD7E9;
border-right-color:#ABD7E9;
border-top-color:#ABD7E9;
background:#ABD7E9
}
")),
box(
title = "Shiny Box",
status = "success",
solidHeader = TRUE,
collapsible = TRUE,
collapsed = TRUE,
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;}")),
div(id="inline", style="width:35vw;",
div(HTML("<b>TEST </b>")),
br(),
numericInputIcon("A", h5("test1"), value = 20, icon = icon("percent")) ,
numericInputIcon("B", h5("test2"), value = 40, icon = icon("percent")) ,
numericInputIcon("C", h5("test3"), value = 60, icon = icon("percent")) ,
currencyInput("X", "Total", value = 0.3, format = "percentageUS2dec")
)
)
)
),
server = function(input, output) { }
)
Adding the following CSS did not help as well :
.box.box-solid.box-success>.box-header>.box-tools.pull-right {
color:#2071B5;
background:#ABD7E9
}
I would like to have all the background color as #ABD7E9 including the numericinput backgrounds !
Since the parent div (with class box) has the bg color #ABD7E9, we can simply set the bg color as transparent of the elements with class form-control and classe input-group-addon to get the consistent bg color for whole box.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$style(
HTML(
"
.box.box-solid.box-success>.box-header {
color: #2071B5;
background:#ABD7E9;
}
.box.box-solid.box-success {
border-bottom-color:#ABD7E9;
border-left-color:#ABD7E9;
border-right-color:#ABD7E9;
border-top-color:#ABD7E9;
background: #ABD7E9;
}
.box .btn-success {
background: #ABD7E9;
}
.box .form-control,
.box .input-group-addon {
background-color: transparent;
border: transparent;
}
"
)
),
box(
title = "Shiny Box",
status = "success",
solidHeader = TRUE,
collapsible = TRUE,
collapsed = TRUE,
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;}"
)
),
div(
id = "inline",
style = "width:35vw;",
div(HTML("<b>TEST </b>")),
br(),
numericInputIcon(
"A",
h5("test1"),
value = 20,
icon = icon("percent")
) ,
numericInputIcon(
"B",
h5("test2"),
value = 40,
icon = icon("percent")
) ,
numericInputIcon(
"C",
h5("test3"),
value = 60,
icon = icon("percent")
) ,
currencyInput("X", "Total", value = 0.3, format = "percentageUS2dec")
)
)
)
),
server = function(input, output) {
}
)
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 try to run shiny app and get error:
fluidRow(column(3, : argument is missing, with no default
I have two tabPanel. I check code and there is no missing argument, no additional comma etc. when I run some portion of this code it works. I can't guess source of this error. How to deal with this problem?
Bellow you can see one part of UI-side code of this shiny app:
ui <- fluidPage(
theme = shinytheme("slate"),
tabsetPanel(
tabPanel(h4("TOP N' financial"),
fluidRow(
column(3,
selectInput("bank", "Choose Bank", choices = unique(BANKS$BANK)),
numericInput("Number", "Choose top N borrower", value = 10, min = 1),
tags$style(type='text/css', ".selectize-input { font-size: 10px; line-height: 1px;}
.selectize-dropdown { font-size: 10px; line-height: 10px; }"),
selectizeInput("excl","SELECT Columns", colname, multiple=T)
),
column(9,
div(dataTableOutput("topNtable"), style = "font-size: 75%; width: 75%")
)
),
br(),
fluidRow(style = "background-color:#4d3a7d;",
h4("Ratio Calculation and plotting"),
column(7,
style = "border: 4px ridge #01B392;",
fluidRow(
textInput("client_ID", "Insert Client ID", value = '204885044'),
uiOutput("ID_table")
),
fluidRow(style = "border: 4px ridge #FF8902;",
plotlyOutput('coef_plot'))
),
column(5,
style = "border: 4px double red;",
h4('simple calculator'),
fluidRow(
tags$style(type='text/css', ".selectize-input { font-size: 10px; line-height: 1px;}
.selectize-dropdown { font-size: 10px; line-height: 10px; }"),
column(6,
selectInput("num", "Numerator", num_cols, selected = 'TOTAL_ASSETS')),
column(6,
selectInput("denum", "denumerator", num_cols, selected = 'TOTAL_LIABILITIES'))
),
fluidRow(
column(6, align = "center",
div(tableOutput("coefficient"))#,style = "font-size: 75%; width: 75%")
)
)
)
),
This is server code (whole)
server <- function(input, output, session){
react_fin <- reactive(get_top_N_financial(input$bank,input$Number, input$excl)%>%
group_by(CLIENT_ID)%>%
filter(DATE == max(DATE))%>%
head(n=input$Number))
output$topNtable <- renderDataTable(react_fin())
#CALCULATOR
calc_d <- reactive(get_top_N_financial(input$bank,input$Number, c(num_cols,'DATE')))
coef_d <- reactive({
req(input$client_ID)
filter(calc_d(), CLIENT_ID == input$client_ID)
})
coef_df <- reactive({
req(input$num)
req(input$denum)
ratio <- round(coef_d()[[input$num]]/coef_d()[[input$denum]], 4)
data.frame(cbind(ratio, coef_d()$DATE))%>%
rename('Date'=V2)%>%
arrange(desc(Date))
})
output$coefficient <- renderTable(coef_df()%>%
slice_head(n = 6))
output$coef_plot <-renderPlotly(plot_ly(coef_df(), x = ~Date,
y = ~ratio, type = 'scatter', mode = 'lines',
height = 300, width = 500))
Client <- reactive((get_name(input$bank, input$client_ID)))
output$ID_table <- renderUI(Client()$CLIENT_NAME)
pd_dt <- reactive(get_debt(input$client_ID))
output$ecl_pl <- renderPlot(plot_pd_lgd(pd_dt()))
## create ind_table
observeEvent(pd_dt(), {
choices <- unique(pd_dt()$DATE)
updateSelectInput(inputId = "ind_date", choices = choices)
})
output$ind_table <-function()(ind_sum_tbl(pd_dt(), input$ind_date))
################# PAGE2 #################
d_PD_PTI <- reactive(get_PD_PTI(input$N, input$start, input$end, input$stage))
output$reg_pl <- renderPlot(PD_PTI_Bank(d_PD_PTI()))
d_PD_Box <- reactive(get_PD_Box(input$N,input$stage))
output$Box_pd <- renderPlot(PD_Box(d_PD_Box()))
output$PTI_PD <- renderPlot(PD_PTI_heat(d_PD_PTI()))
d_LGD_LTV <- reactive(get_LGD_LTV(input$N, input$start, input$end,input$stage))
output$LTV_LGD <- renderPlot(LGD_LTV_heat(d_LGD_LTV()))
output$PD_Client_scatter <- renderPlotly(PD_diff_banks_scatter(input$start, input$end, input$N))
df <- reactive(PD_CLIENT_DF(input$start, input$end,input$N))
output$PD_scat <- renderPlot(PD_CLIENT_plot(df()))
output$brush_tbl <-renderTable({
brushedPoints(df(), input$brush) %>%
select()
})
}
Thanks in advance
My guess: Issue of parentheses: Here is a working example with your UI code.
library(shiny)
library(shinythemes)
BANKS
ui <- fluidPage(
theme = shinytheme("slate"),
tabsetPanel(
tabPanel(h4("TOP N' financial"),
fluidRow(
column(3,
selectInput("bank", "Choose Bank", choices = unique(BANKS$BANK)),
numericInput("Number", "Choose top N borrower", value = 10, min = 1),
tags$style(type='text/css', ".selectize-input { font-size: 10px; line-height: 1px;}
.selectize-dropdown { font-size: 10px; line-height: 10px; }"),
selectizeInput("excl","SELECT Columns", colname, multiple=T)
),
column(9,
div(dataTableOutput("topNtable"), style = "font-size: 75%; width: 75%")
)
)
)
)
),
server <- function(input, output, session) {
}
shinyApp(ui, server)
I am current developing a shiny application and I need to hide login page and show shiny dashboard upon successful login. If not, the login page should be displayed.
I came upon few sites and I decided to use shinyjs package for showing and hiding of the fluid page / dashboard page.
The global function used is as follows:
`%AND%` <- function (x, y) {
if (!is.null(x) && !anyNA(x))
if (!is.null(y) && !anyNA(y))
return(y)
return(NULL)
}
passwordInputAddon <- function (inputId, label, value = "", placeholder = NULL, addon, width = NULL)
{
value <- shiny::restoreInput(id = inputId, default = value)
htmltools::tags$div(
class = "form-group shiny-input-container",
label %AND% htmltools::tags$label(label, `for` = inputId),
style = if (!is.null(width)) paste0("width: ", htmltools::validateCssUnit(width), ";"),
htmltools::tags$div(
style = "margin-bottom: 5px;", class="input-group",
addon %AND% htmltools::tags$span(class="input-group-addon", addon),
htmltools::tags$input(
id = inputId, type = "password", class = "form-control",
value = value, placeholder = placeholder
)
)
)
}
The UI code used is as follows:
ui <- shinyUI(fluidPage(
tags$div(id = "login_page_ui",
shinyjs::useShinyjs(),
tags$style(".container-fluid {margin-top: 13%}"),
setBackgroundColor(color = "#2d3c44"),
fluidRow(
column(8, align = "center", offset = 2,
textInputAddon("name", label = "", placeholder = "Username", addon = icon("user"),width = "25%"),
tags$style(type="text/css", "#string { height: 50px; width: 50%; text-align:center;
font-size: 30px; display: block;}")
)
),
fluidRow(
column(8, align = "center", offset = 2,
passwordInputAddon("password", label = "", placeholder = "Password", addon = icon("key"),width = "25%"),
tags$style(type="text/css", "#string { height: 50px; width: 50%; text-align:center;
font-size: 30px; display: block;}")
)
),
fluidRow(
column(12, div(style = "height:20px;background-color: #2d3c44;")
)
),
fluidRow(
column(6, align = "center", offset = 3,
actionButton("login",label = "Login", width = "35%", style = "color: #fff; background-color: #1bc3d7; border-color: #1bc3d7;")))
)
),
shinyjs::hidden(
tags$div(
id = "dashboard_page_ui",
dashboardPage(
dashboardHeader(
title="Shiny Dashboard",
tags$li(
class="dropdown"
)
),
dashboardSidebar(
sidebarMenu(
id = 'dashboard_menu',
sidebarMenuOutput("menu")
)
),
dashboardBody(
tabItems(
tabItem(tabName="Item1"),
tabItem(tabName="Item2"),
tabItem(tabName="Item3")
)
)
)
)
)
)
The server code used is as follows:
server <- function(input, output,session){
observeEvent(input$login,{
if((input$name == "test") & (input$password == "test123")){
shinyjs::show("dashboard_page_ui")
shinyjs::hide("login_page_ui")
}
})
}
When I execute this code I am getting this error message
Error in shinyUI(fluidPage(tags$div(id = "login_page_ui", shinyjs::useShinyjs(), :
unused argument (shinyjs::hidden .....
I don't know what's the exact issue is. Can anyone help me to sort this issue?
shinyUI takes a single argument ui (The user interace definition). However, you provided two arguments: see the comma before shinyjs::hidden(...) in your code.
Please check the following:
library(shiny)
library(shinydashboard)
`%AND%` <- function (x, y) {
if (!is.null(x) && !anyNA(x))
if (!is.null(y) && !anyNA(y))
return(y)
return(NULL)
}
passwordInputAddon <-
function (inputId,
label,
value = "",
placeholder = NULL,
addon,
width = NULL)
{
value <- shiny::restoreInput(id = inputId, default = value)
htmltools::tags$div(
class = "form-group shiny-input-container",
label %AND% htmltools::tags$label(label, `for` = inputId),
style = if (!is.null(width))
paste0("width: ", htmltools::validateCssUnit(width), ";"),
htmltools::tags$div(
style = "margin-bottom: 5px;",
class = "input-group",
addon %AND% htmltools::tags$span(class = "input-group-addon", addon),
htmltools::tags$input(
id = inputId,
type = "password",
class = "form-control",
value = value,
placeholder = placeholder
)
)
)
}
ui <- fluidPage(
tags$div(
id = "login_page_ui",
shinyjs::useShinyjs(),
tags$style(".container-fluid {margin-top: 13%}"),
setBackgroundColor(color = "#2d3c44"),
fluidRow(
column(
8,
align = "center",
offset = 2,
textInputAddon(
"name",
label = "",
placeholder = "Username",
addon = icon("user"),
width = "25%"
),
tags$style(
type = "text/css",
"#string { height: 50px; width: 50%; text-align:center;
font-size: 30px; display: block;}"
)
)
),
fluidRow(
column(
8,
align = "center",
offset = 2,
passwordInputAddon(
"password",
label = "",
placeholder = "Password",
addon = icon("key"),
width = "25%"
),
tags$style(
type = "text/css",
"#string { height: 50px; width: 50%; text-align:center;
font-size: 30px; display: block;}"
)
)
),
fluidRow(column(
12, div(style = "height:20px;background-color: #2d3c44;")
)),
fluidRow(column(
6,
align = "center",
offset = 3,
actionButton(
"login",
label = "Login",
width = "35%",
style = "color: #fff; background-color: #1bc3d7; border-color: #1bc3d7;"
)
))
),
shinyjs::hidden(tags$div(
id = "dashboard_page_ui",
dashboardPage(
dashboardHeader(title = "Shiny Dashboard",
tags$li(class = "dropdown")),
dashboardSidebar(sidebarMenu(id = 'dashboard_menu',
sidebarMenuOutput("menu"))),
dashboardBody(tabItems(
tabItem(tabName = "Item1"),
tabItem(tabName = "Item2"),
tabItem(tabName = "Item3")
))
)
))
)
server <- function(input, output, session) {
observeEvent(input$login, {
if ((input$name == "test") & (input$password == "test123")) {
shinyjs::show("dashboard_page_ui")
shinyjs::hide("login_page_ui")
}
})
}
shinyApp(ui, server)
I am currently developing a shiny application. I need to have a login module at the beginning of the application. I have a desired output.
But I don't get the output as shown above.
This is the code used in ui.R
library(shiny)
library(shinyWidgets)
shinyUI(
fluidPage(
setBackgroundColor(color = "#29667a"),
fluidRow(
column(8, align = "center", offset = 2,
textInput("name", label = " ", value = " ",width = "45%"),
tags$style(type="text/css", "#string { height: 50px; width: 100%; text-align:center;
font-size: 30px; display: block;}")
)
),
fluidRow(
column(8, align = "center", offset = 2,
textInput("password", label = " ", value = " ",width = "45%"),
tags$style(type="text/css", "#string { height: 50px; width: 100%; text-align:center;
font-size: 30px; display: block;}")
)
),
fluidRow(
column(6, align = "center", offset = 3,
actionButton("login",label = "Login", width = "60%")),
tags$style(type = 'text/css',"#button { vertical-align: middle; height: 50px;
width: 100%; font-size: 30px;}"))
)
)
Can anyone say how to add the icons to the username and password boxes and have an hyperlink at the bottom of the action button. In addition to it, the input boxes are to be displayed at the middle of the page. But it gets displayed at the top of the page.
Please give a solution for this requirements.
Thanks in advance!!
Updated Answer. Based on the comment. The source code of shinyWidgets has been used to create a custom function that accepts both Icon and Password.
library(shiny)
library(shinyWidgets)
library(fontawesome)
## Modifying inbuilt textInputAddon to accept password of shinyWidgets
## blantantly copied: https://github.com/dreamRs/shinyWidgets/blob/master/R/utils.R
`%AND%` <- function (x, y) {
if (!is.null(x) && !anyNA(x))
if (!is.null(y) && !anyNA(y))
return(y)
return(NULL)
}
## blantantly copied: https://github.com/dreamRs/shinyWidgets/blob/master/R/input-textaddon.R
passwordInputAddon <- function (inputId, label, value = "", placeholder = NULL, addon, width = NULL)
{
value <- shiny::restoreInput(id = inputId, default = value)
htmltools::tags$div(
class = "form-group shiny-input-container",
label %AND% htmltools::tags$label(label, `for` = inputId),
style = if (!is.null(width)) paste0("width: ", htmltools::validateCssUnit(width), ";"),
htmltools::tags$div(
style = "margin-bottom: 5px;", class="input-group",
addon %AND% htmltools::tags$span(class="input-group-addon", addon),
htmltools::tags$input(
id = inputId, type = "password", class = "form-control",
value = value, placeholder = placeholder
)
)
)
}
ui <- shinyUI(
fluidPage(
tags$style(".container-fluid {margin-top: 20%}"),
setBackgroundColor(color = "#29667a"),
fluidRow(
column(8, align = "center", offset = 2,
textInputAddon("name", label = "", placeholder = "Username", addon = icon("user"),width = "45%"),
tags$style(type="text/css", "#string { height: 50px; width: 100%; text-align:center;
font-size: 30px; display: block;}")
)
),
fluidRow(
column(8, align = "center", offset = 2,
passwordInputAddon("password", label = "", placeholder = "Password", addon = icon("key"),width = "45%"), tags$style(type="text/css", "#string { height: 50px; width: 100%; text-align:center;
font-size: 30px; display: block;}")
)
),
fluidRow(
column(6, align = "center", offset = 3,
actionButton("login",label = "Login", width = "60%")) ),
fluidRow(
column(6, align = "center", offset = 3,
tags$div(HTML("<a href='https://www.github.com'> Forgot Password? </a>"))
))
)
)
server <- function(input, output){
}
shinyApp(ui,server)