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)
Related
Is there a way to clear the tectinput after clicking the button. I tried with below code but does not work.
Open the application and fill the textinput. But after clicking the button, it does not clear
library(shiny)
library(shinyjs)
runApp(
list(
ui = shinyUI(fluidPage(theme = "bootstrap.css",
fluidRow(
column(8, align="center", offset = 2,
# selectInput("sdf","Asdf", choices = c(1,2), selected = NULL),
textInput("string", label="Input",value = "", width = "100%"),
tags$style("#string { height: 50px; width: 100%; text-align:center; font-size: 15px; display: block;}")
)
),
fluidRow(
column(6, align="center", offset = 3,
actionButton("button",label = "Clear"),
tags$style(type='text/css', "#button { vertical-align: middle; height: 50px; width: 100%; font-size: 30px;}")
)
)
)
), server = shinyServer(function(input, output) {
observeEvent(input$button,{
shinyjs::runjs("document.getElementById('string').reset();")
})
})))
What about updateTextInput?:
library(shiny)
library(shinyjs)
runApp(list(ui = shinyUI(
fluidPage(theme = "bootstrap.css",
fluidRow(
column(
8,
align = "center",
offset = 2,
# selectInput("sdf","Asdf", choices = c(1,2), selected = NULL),
textInput(
"string",
label = "Input",
value = "",
width = "100%"
),
tags$style(
"#string { height: 50px; width: 100%; text-align:center; font-size: 15px; display: block;}"
)
)
),
fluidRow(
column(
6,
align = "center",
offset = 3,
actionButton("button", label = "Clear"),
tags$style(
type = 'text/css',
"#button { vertical-align: middle; height: 50px; width: 100%; font-size: 30px;}"
)
)
))
), server = shinyServer(function(input, output, session) {
observeEvent(input$button, {
updateTextInput(session, inputId = "string", value = "")
})
})))
I would like to have both a persistent sidebar (as in shinydashboard layout) and a navigation bar with tabs (as in shiny::navbarPage layout). I came across this answer that seems to correspond to what I want.
The problem is that inputs in the sidebar are not persistent through tabs, i.e when switching tabs, the inputs in the sidebar are not displayed anymore (at the contrary of shinydashboard sidebar for example). Here's an example I cannot really minimize more since a lot of it is CSS:
library(shiny)
library(bootstraplib)
# boot dash layout funs ---------------------------------------------------
boot_side_layout <- function(...) {
div(class = "d-flex wrapper", ...)
}
boot_sidebar <- function(...) {
div(
class = "bg-light border-right sidebar-wrapper",
div(class = "list-group list-group-flush", ...)
)
}
boot_main <- function(...) {
div(
class = "page-content-wrapper",
div(class = "container-fluid", ...)
)
}
# css ---------------------------------------------------------------------
css_def <- "
body {
overflow-x: hidden;
}
.container-fluid, .container-sm, .container-md, .container-lg, .container-xl {
padding-left: 0px;
}
.sidebar-wrapper {
min-height: 100vh;
margin-left: -15rem;
padding-left: 15px;
padding-right: 15px;
-webkit-transition: margin .25s ease-out;
-moz-transition: margin .25s ease-out;
-o-transition: margin .25s ease-out;
transition: margin .25s ease-out;
}
.sidebar-wrapper .list-group {
width: 15rem;
}
.page-content-wrapper {
min-width: 100vw;
padding: 20px;
}
.wrapper.toggled .sidebar-wrapper {
margin-left: 0;
}
.sidebar-wrapper, .page-content-wrapper {
padding-top: 20px;
}
.navbar{
margin-bottom: 0px;
}
.navbar-collapse {
font-size: 1.1rem
}
#media (max-width: 768px) {
.sidebar-wrapper {
padding-right: 0px;
padding-left: 0px;
}
}
#media (min-width: 768px) {
.sidebar-wrapper {
margin-left: 0;
position: fixed;
}
.page-content-wrapper {
min-width: 0;
width: 100%;
}
.wrapper.toggled .sidebar-wrapper {
margin-left: -15rem;
}
}
"
# app ---------------------------------------------------------------------
ui <- tagList(
tags$head(tags$style(HTML(css_def))),
bootstrap(),
navbarPage(
collapsible = TRUE,
title = "",
tabPanel(
"Statistics",
boot_side_layout(
boot_sidebar(
selectInput(
"variables",
"Variables",
NULL
)
),
boot_main(
fluidRow(
dataTableOutput("statistics")
)
)
)
),
tabPanel(
"Plots",
boot_side_layout(
boot_sidebar(
),
boot_main(
)
)
)
)
)
server <- function(input, output, session) {
output$statistics <- renderDataTable(mtcars[10, 10])
}
shinyApp(ui, server)
How can I make these inputs persistent through sidebar? (If somebody knows of another simple way to mix persistent sidebar with navbar, please show it as well).
Why not using a sidebarLayout with a navbarPage in mainPanel?
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("select", "Select", c("a", "b", "c"))
),
mainPanel(
navbarPage(
"App Title",
tabPanel("Plot"),
tabPanel("Summary"),
tabPanel("Table")
)
)
)
)
shinyApp(ui, server)
EDIT
Or something like this?
library(shiny)
library(ggplot2)
ui <- fluidPage(
div(
style = "display: flex; flex-direction: column;",
div( #~~ Main panel ~~#
navbarPage(
"Old Faithful Geyser Data",
tabPanel(
"Plot",
plotOutput("ggplot")
),
tabPanel("Summary"),
tabPanel("Table")
)
),
wellPanel( #~~ Sidebar ~~#
style = "width: 300px;",
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
)
)
)
server <- function(input, output) {
output[["ggplot"]] <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)
EDIT
Like this to have the sidebar on the left:
library(shiny)
library(shinyjs)
library(ggplot2)
CSS <- "
.sidebar {
min-width: 300px;
margin-right: 30px;
}
#sidebar {
width: 300px;
}
"
ui <- fluidPage(
useShinyjs(),
tags$head(tags$style(HTML(CSS))),
div( #~~ Main panel ~~#
navbarPage(
"Old Faithful Geyser Data",
tabPanel(
"Plot",
div(
style = "display: flex;",
div(class = "sidebar"),
plotOutput("ggplot")
)
),
tabPanel(
"Summary",
div(
style = "display: flex;",
div(class = "sidebar"),
verbatimTextOutput("summary")
)
),
tabPanel(
"Table",
div(
style = "display: flex;",
div(class = "sidebar"),
tableOutput("table")
)
),
id = "navbar"
)
),
wellPanel( #~~ Sidebar ~~#
id = "sidebar",
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
)
)
server <- function(input, output) {
output[["ggplot"]] <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output[["summary"]] <- renderPrint({
list(a = 1:10, b = 1:10)
})
output[["table"]] <- renderTable({
iris[1:10,]
})
observeEvent(input[["navbar"]], {
selector <-
sprintf("$('div.tab-pane[data-value=\"%s\"] div.sidebar')", input[["navbar"]])
runjs(paste0(selector, ".append($('#sidebar'));"))
})
}
shinyApp(ui = ui, server = server)
EDIT
Here is an improvement of the above way. I've made some convenient functions tabPanel2 and sidebar to help the user. And I use fluidRow and column instead of using a display: flex;. This allows to have a sidebar width relative to the screen size. The example below also shows how to not include the sidebar in a tab (simply use tabPanel and not tabPanel2.
library(shiny)
library(shinyjs)
library(ggplot2)
tabPanel2 <- function(title, ..., value = title, icon = NULL, sidebarWidth = 4){
tabPanel(
title = title,
fluidRow(
column(
width = sidebarWidth,
class = "sidebar"
),
column(
width = 12 - sidebarWidth,
...
)
)
)
}
sidebar <- function(...){
div(
style = "display: none;",
tags$form(
class = "well",
id = "sidebar",
...
)
)
}
ui <- fluidPage(
useShinyjs(),
div( #~~ Main panel ~~#
navbarPage(
"Old Faithful Geyser Data",
tabPanel2(
"Plot",
plotOutput("ggplot")
),
tabPanel2(
"Summary",
verbatimTextOutput("summary")
),
tabPanel(
"Table",
fluidRow(
column(
width = 4,
wellPanel(
tags$fieldset(
tags$legend(h3("About")),
p("This app is cool")
)
)
),
column(
width = 8,
tableOutput("table")
)
)
),
id = "navbar"
)
),
sidebar( #~~ Sidebar ~~#
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30)
)
)
server <- function(input, output) {
output[["ggplot"]] <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output[["summary"]] <- renderPrint({
list(a = 1:10, b = 1:10)
})
output[["table"]] <- renderTable({
iris[1:10,]
})
observeEvent(input[["navbar"]], {
selector <-
sprintf("$('div.tab-pane[data-value=\"%s\"] div.sidebar')", input[["navbar"]])
append <- "selector.append($('#sidebar'));"
js <- sprintf("var selector=%s; if(selector.length){%s;}", selector, append)
runjs(js)
})
}
shinyApp(ui = ui, server = server)
I have an app which looks like below:enter image description here
I would like to download datatable to pdf with that time period. but when i do it only table exports. enter image description here
here is ma ui.R code:
library(shiny)
jscode <- "shinyjs.closeWindow = function() { window.close(); }"
shinyUI(fluidPage(
tags$head(
tags$style(HTML("
#import url('//fonts.googleapis.com/css?family=Anton');
h2 {
font-family: 'Anton';
font-weight: 600;
line-height: 0.7;
color: #483D8B;
}
"))
),
titlePanel("ZESTAWIENIE 1 v 2"),
sidebarLayout(
sidebarPanel( tags$head(
tags$style(type="text/css", ".well { width: 150px; }"),
tags$style(type="text/css", ".col-sm-4 { width: 170px;}"),
# tags$style(type="text/css", "#close {font-size: 12px; background-color: #e6e6e6; }") ,
tags$style(type="text/css", "#get_data { font-size: 12px; background-color: #e6e6e6;}") ,
tags$style(type="text/css", "#last_month { font-size: 12px;background-color: #e6e6e6; }") ,
tags$style(type="text/css", ".control-label { line-height: 2 ; font-size: 12px; }") ,
tags$style(type="text/css", "#text { width: 390px ; font-size: 11px } "),
tags$style(type="text/css", "#DataTables_Table_0 td[text*='SAL']{ background:#DCDCDC; }")
),
# actionButton("close", "Zamknij raport" ,width = '100%' ),
actionButton("get_data", "Generuj report" ,width = '100%' ),
actionButton("last_month", "Ostatni miesiÄ…c", width = '100%' ),
dateInput('start_date', "Data poczÄ…tkowa", min = '2017-11-01', value= format(Sys.Date()-1, "%Y-%m-01")),
dateInput('end_date', "Data końcowa", min = '2017-11-01' ,value= format(Sys.Date()-1, "%Y-%m-%d"))
),
mainPanel(tags$head(
tags$style(type="text/css", ".col-sm-8 { width: 89%; }")
),
div(
verbatimTextOutput("text"), DT::dataTableOutput("results"), style = "font-size:80%" ),
tabsetPanel(
tabPanel(
HTML('<footer>
<h6> kontakt: kk </h6>
</footer>')
))
)
)
))
where shloud I put verbatimTextOutput("text") which is responsible for showing date range to have that date if pdf after downloading?
You can use caption
library(shiny)
library(DT)
ui <- fluidPage(
dateRangeInput("daterange1", "Date range:",
start = "2001-01-01",
end = "2010-12-31"),
DT::dataTableOutput('table')
)
server <- function(input, output, session) {
output$table <- renderDataTable(
head(iris),
caption = paste("Report Data:", input$daterange1[1], "to", input$daterange1[2] ),extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('pdf')
))
}
shinyApp(ui, server)
I have a shiny app (using navbarPage) with many tabs and would like to add a sidebarMenu that can be seen no matter which tab is selected. The input values in the sidebar have an impact on the content of all tabs.
Additionally, it should be possible to hide the sidebarMenu as it is in a shinydashboard.
I see two possible ways:
(A) Using shinydashboard and somehow adding a top navigation bar or
(B) using navbarPage and somehow adding a sidebar menu that can be hidden.
(A) Using shinydashboard, the closest to what I want is this (simplified MWE):
library("shiny")
library("shinydashboard")
cases <- list(A=seq(50,500, length.out=10), B=seq(1000,10000, length.out=10))
ui <- dashboardPage(
dashboardHeader(title = "dash w/ navbarMenu"),
dashboardSidebar(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE), numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1)),
dashboardBody(
tabsetPanel(
tabPanel(h4("Perspective 1"),
tabsetPanel(
tabPanel("Subtab 1.1", plotOutput("plot11")),
tabPanel("Subtab 1.2")
)),
tabPanel(h4("Perspective 2"),
tabsetPanel(
tabPanel("Subtab 2.1"),
tabPanel("Subtab 2.2")
))
)
)
)
server <- function(input, output) {
output$plot11 <- renderPlot({
hist(rnorm(cases[[input$case]][input$num]))
})
}
shinyApp(ui, server)
which is ugly because the navigation bar menu are tabsets which are not part of the menu. What I want is:
Based on this post, I guess it's not possible to include "Perspective 1" and "Perspective 2" tabs in the top menu at all, thus using shinydashboard seems not feasible.
(B) Using navbarPage, I tried using navlistPanel() but I didn't succeed to
(1) make it behave like a sidebarMenu, i.e. be overall visible on the left side of the page and
(2) add hide functionality. Here is my try:
library("shiny")
cases <- list(A=seq(50,500, length.out=10),
B=seq(1000,10000, length.out=10))
ui <- navbarPage(title = "nav w/ sidebarMenu",
tabPanel(h4("Perspective 1"),
tabsetPanel(
tabPanel("Subtab 1.1",
plotOutput("plot11")),
tabPanel("Subtab 1.2")
)),
tabPanel(h4("Perspective 2"),
tabsetPanel(
tabPanel("Subtab 2.1"),
tabPanel("Subtab 2.2")
)),
navlistPanel(widths = c(2, 2), "SidebarMenu",
tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
)
)
server <- function(input, output) {
output$plot11 <- renderPlot({
hist(rnorm(cases[[input$case]][input$num]))
})
}
shinyApp(ui, server)
Again, what I want is:
I know, there is flexDashboard. It does not solve the problem for three reasons:
(1) I think it is not possible to hide the sidebar menu, as it is a column and not a real sidebar menu,
(2) it is not reactive which I require in my app,
(3) I think dataTables don't work, which I also need.
Besides, I'd prefer to not have to change the code to Rmarkdown syntax.
Preferably, I'd use a navbarPage and add a sidebarMenu, because my app is already built using navbarPage.
You could use sidebarLayout and do something like this:
ui <- fluidPage(sidebarLayout(
sidebarPanel(navlistPanel(
widths = c(12, 12), "SidebarMenu",
tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
)),
mainPanel(navbarPage(title = "nav w/ sidebarMenu",
tabPanel(h4("Perspective 1"),
tabsetPanel(
tabPanel("Subtab 1.1",
plotOutput("plot11")),
tabPanel("Subtab 1.2")
)),
tabPanel(h4("Perspective 2"),
tabsetPanel(
tabPanel("Subtab 2.1"),
tabPanel("Subtab 2.2")
)))
)
))
You get something like this:
Another option would be using fluidRow function. Something like this:
ui <- fluidPage(
fluidRow(
column(3, navlistPanel(
widths = c(12, 12), "SidebarMenu",
tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
)),
column(9, navbarPage(title = "nav w/ sidebarMenu",
tabPanel(h4("Perspective 1"),
tabsetPanel(
tabPanel("Subtab 1.1",
plotOutput("plot11")),
tabPanel("Subtab 1.2")
)),
tabPanel(h4("Perspective 2"),
tabsetPanel(
tabPanel("Subtab 2.1"),
tabPanel("Subtab 2.2")
))))
)
)
To get this:
Hope it helps!
This is now possible using bootstraplib
Github Request to implement this:
https://github.com/rstudio/bootstraplib/issues/76
min reprex:
# package load ------------------------------------------------------------
library(shiny)
library(bootstraplib)
# boot dash layout funs ---------------------------------------------------
boot_side_layout <- function(...) {
div(class = "d-flex wrapper", ...)
}
boot_sidebar <- function(...) {
div(
class = "bg-light border-right sidebar-wrapper",
div(class = "list-group list-group-flush", ...)
)
}
boot_main <- function(...) {
div(
class = "page-content-wrapper",
div(class = "container-fluid", ...)
)
}
# title -------------------------------------------------------------------
html_title <-
'<span class="logo">
<div style="display:inline-block;">
<img src="https://jeroen.github.io/images/Rlogo.png" height="35"/>
<b>my company name</b> a subtitle of application or dashboard
</div>
</span>'
# css ---------------------------------------------------------------------
css_def <- "
body {
overflow-x: hidden;
}
.container-fluid, .container-sm, .container-md, .container-lg, .container-xl {
padding-left: 0px;
}
.sidebar-wrapper {
min-height: 100vh;
margin-left: -15rem;
padding-left: 15px;
padding-right: 15px;
-webkit-transition: margin .25s ease-out;
-moz-transition: margin .25s ease-out;
-o-transition: margin .25s ease-out;
transition: margin .25s ease-out;
}
.sidebar-wrapper .list-group {
width: 15rem;
}
.page-content-wrapper {
min-width: 100vw;
padding: 20px;
}
.wrapper.toggled .sidebar-wrapper {
margin-left: 0;
}
.sidebar-wrapper, .page-content-wrapper {
padding-top: 20px;
}
.navbar{
margin-bottom: 0px;
}
#media (max-width: 768px) {
.sidebar-wrapper {
padding-right: 0px;
padding-left: 0px;
}
}
#media (min-width: 768px) {
.sidebar-wrapper {
margin-left: 0;
}
.page-content-wrapper {
min-width: 0;
width: 100%;
}
.wrapper.toggled .sidebar-wrapper {
margin-left: -15rem;
}
}
"
# app ---------------------------------------------------------------------
ui <- tagList(
tags$head(tags$style(HTML(css_def))),
bootstrap(),
navbarPage(
collapsible = TRUE,
title = HTML(html_title),
tabPanel(
"Tab 1",
boot_side_layout(
boot_sidebar(
sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
boot_main(
fluidRow(column(6, h1("Plot 1")), column(6, h1("Plot 2"))),
fluidRow(
column(6, plotOutput(outputId = "distPlot")),
column(6, plotOutput(outputId = "distPlot2"))
)
)
)
),
tabPanel(
"Tab 2",
boot_side_layout(
boot_sidebar(h1("sidebar input")),
boot_main(h1("main output"))
)
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x,
breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
})
output$distPlot2 <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x,
breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
})
}
shinyApp(ui, server)
I am using the rnvd3 packadge to plot an interactive multibarchart in a Shiny App, and the tooltip of the chart has a big font size and I would like just to reduce it.
Here is my code:
library(shiny)
library(rCharts)
library(shinythemes)
library(shinydashboard)
ui <- navbarPage(title = "Information",
tabPanel(title = "Graph",
fluidRow(
column(2),
column(8,
tags$br(),
tags$h5("Chart", style="font-weight: bold; font-size:20px", align = "center"),
tags$br())
),
fluidRow(
column(1),
column(8,
tags$br(),
tags$h5("Exemple", style="font-weight: bold; font-size:14px", align = "center"),
tags$br(),
showOutput("bar","nvd3")),
column(1)
)
)
)
server <- function(input,output, session) {
output$bar <- renderChart2({
database2 <- cbind(cbind(c(100,110,140),c("2016-09-05","2016-09-05","2016-09-05")),c("Product A","Product B","Product C"))
database2[,1] <- as.numeric(database2[,1])
database2[,2] <- as.Date(database2[,2],origin="1899-12-30")
colnames(database2) <- c("Price","Date","Key")
database2 <- as.data.frame(database2)
m1net_eb <- nPlot(Price ~ Date, group = 'Key', data = database2, type='multiBarChart')
m1net_eb$chart(margin = list(left=60,bottom=110,right=60))
m1net_eb$chart(forceY = 0)
m1net_eb$set(lineWidth = 1, width=1100 , height = 700)
m1net_eb
})
}
shinyApp(ui=ui, server=server)
How could I reduce the font size of the tooltip in this packdge?
Please help
Just add
tags$head(tags$style(HTML("
.nvtooltip h3 {
font-size:14px;
}
")))
Here is the full code.
library(shiny)
library(rCharts)
library(shinythemes)
library(shinydashboard)
ui <- navbarPage(title = "Information",
tabPanel(title = "Graph",
fluidRow(
column(2),
column(8,
tags$br(),
tags$h5("Chart", style="font-weight: bold; font-size:20px", align = "center"),
tags$br())
),
fluidRow(
column(1),
column(8,
tags$br(),
tags$h5("Exemple", style="font-weight: bold; font-size:14px", align = "center"),
tags$br(),
showOutput("bar","nvd3")),
column(1)
),
tags$head(tags$style(HTML("
.nvtooltip h3 {
font-size:14px;
}
")))
)
)
server <- function(input,output, session) {
output$bar <- renderChart2({
database2 <- cbind(cbind(c(100,110,140),c("2016-09-05","2016-09-05","2016-09-05")),c("Product A","Product B","Product C"))
database2[,1] <- as.numeric(database2[,1])
database2[,2] <- as.Date(database2[,2],origin="1899-12-30")
colnames(database2) <- c("Price","Date","Key")
database2 <- as.data.frame(database2)
m1net_eb <- nPlot(Price ~ Date, group = 'Key', data = database2, type='multiBarChart')
m1net_eb$chart(margin = list(left=60,bottom=110,right=60))
m1net_eb$chart(forceY = 0)
m1net_eb$set(lineWidth = 1, width=1100 , height = 700)
m1net_eb
})
}
shinyApp(ui=ui, server=server)