I have a top banner that I want to split into two separate sections representing two different inputs. To do this, I've created a fluidRow and with two columns, one for each input. However, as it is now there is a little bit of white space between the columns, despite putting offset = 0. Is there any way to remove this white space so that the columns are immediately next to one another?
colors = c("green","blue","red")
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("Info",
fluidRow(
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
tags$h3("Section 1")
)
),
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
tags$h3("Section 2")
)
)
),
fluidRow(
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
selectInput(inputId = "color",label = "color:",
choices = colors,
selected = colors[2],
multiple = FALSE)
)
),
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
selectInput(inputId = "points",label = "Number of Points:",
choices = c("30","60","90"),
selected = "10",
multiple = FALSE) )
)
),
br(),
br(),
fluidRow(
actionButton(inputId = "go",
label = "Update"
)
),
fluidRow(
plotOutput("plot", width = "100%")
)
)
)
)
server <- function(input, output,session) {
data = eventReactive(input$go, {
var1 = rnorm(isolate(as.numeric(input$points)),5)
cat1 = c(rep("red",length(var1)/3),rep("blue",length(var1)/3),rep("green",length(var1)/3))
data = cbind.data.frame(var1,cat1)
plotdata = data[which(data$cat1 ==isolate(input$color)),]
}
)
output$plot = renderPlot({
plotdata = data()
plotcol = isolate(input$color)
plot(plotdata$var1, col = plotcol)
})
}
shinyApp(ui = ui,server = server)
The white space is the padding of the column div. To remove that, use
column(width = 6, offset = 0, style='padding:0px;', ...)
Related
I'm creating a table that has 88 columns, so naturally I'd require a scrollbar, I'd also like to highlight some column variables depending on their values, however my issue is that no horizontal scrollbar appears. This is the code:
library(DT)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)
data <- read.csv("somedata.csv", check.names = FALSE)
options(DT.options = list(pageLength = 5), scrollX = TRUE)
ui <- dashboardPage(
dashboardHeader(title = "Table Summary"),
dashboardSidebar(collapsed = FALSE,
sidebarMenu(
id = "tabs",
menuItem(text = "Tab 1",
tabName = "t1",
icon = icon('trophy'),
selected = TRUE
)
)
),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(
tabName = "t1",
#we wan to create 3 separate pages on this tab
tabsetPanel(
id = "t1Selected", #returns value of current page we're on,
type = "tabs",
tabPanel(
title = "totals",
id = "tab_totals",
fluidRow(
column(width = 6, align = "right", DT::dataTableOutput("table"))
#DT::dataTableOutput("table")
),
fluidRow(
column(
width = 3, align = "left", checkboxInput("bt1", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt1C", "Choice", 0, min = -100, max = 100)
),
column(
width = 3, align = "left", checkboxInput("bt2", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt2C", "Choice", 0, min = -100, max = 100)
),
)
)
)
)
)
)
)
server <- function(input, output, session) {
observe({
shinyjs::enable("bt1C")
if(input$bt1 == 0){
shinyjs::disable("bt1C")
}
})
output$table <- DT::renderDataTable({
datatable(data) %>% formatStyle('Message_ratio', backgroundColor = styleEqual(c(0, 9.57), c('gray', 'yellow')))
})
}
shinyApp(ui, server)
I have the global setting for DT.options saying that scrollX should be on, but no horizontal taskbar comes up....
If it matters, I'm using windows.
Any suggestions would be helpful.
Before anyone recommends this link: How to make the horizontal scrollbar visible in DT::datatable
I've already tried what theyre saying, did not seem to help.
Using mtcars as example this works for me to get a horizontal scroll bar.
library(DT)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)
data <- mtcars
ui <- dashboardPage(
dashboardHeader(title = "Table Summary"),
dashboardSidebar(collapsed = FALSE,
sidebarMenu(
id = "tabs",
menuItem(text = "Tab 1",
tabName = "t1",
icon = icon('trophy'),
selected = TRUE
)
)
),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(
tabName = "t1",
#we wan to create 3 separate pages on this tab
tabsetPanel(
id = "t1Selected", #returns value of current page we're on,
type = "tabs",
tabPanel(
title = "totals",
id = "tab_totals",
fluidRow(
column(width = 6, align = "right", DT::dataTableOutput("table"))
#DT::dataTableOutput("table")
),
fluidRow(
column(
width = 3, align = "left", checkboxInput("bt1", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt1C", "Choice", 0, min = -100, max = 100)
),
column(
width = 3, align = "left", checkboxInput("bt2", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt2C", "Choice", 0, min = -100, max = 100)
),
)
)
)
)
)
)
)
server <- function(input, output, session) {
observe({
shinyjs::enable("bt1C")
if(input$bt1 == 0){
shinyjs::disable("bt1C")
}
})
output$table <- DT::renderDataTable({
datatable(data, options = list(scrollX = TRUE)) %>%
formatStyle('mpg', backgroundColor = styleEqual(c(0, 9.57), c('gray', 'yellow')))
})
}
shinyApp(ui, server)
I have two columns in a shiny app, I want to vertically align them to the bottom of their columns. I've tried adding styles to the column and the fluid row which contains them with no success. How can I adjust the css of a column to achieve this?
Many thanks!
ui <-
fluidPage(
fluidRow(
column(width = 6,
numericInput(inputId = "id_1", label = "Id number 1", value = 1, min = 0, max = 2, step =0.05),
# style = "vertical-align: bottom"
),
column(width = 6,
checkboxGroupInput("icons", "Choose icons:",
choiceNames = list(icon("calendar"), icon("bed"), icon("cog"), icon("bug")),
choiceValues = list("calendar", "bed", "cog", "bug")
)),
# style = "vertical-align: bottom"
)
)
server <- function(input, output) { }
shinyApp(ui, server)
I don't know how to do that with the bootstrap columns. Here is a way using a flexbox:
css <- "
.bottom-aligned {
display: flex;
align-items: flex-end;
}
.bottom-aligned > div {
flex-grow: 1;
}
"
ui <- fluidPage(
tags$head(
tags$style(HTML(css))
),
fluidRow(
column(
width = 12,
div(
class = "bottom-aligned",
div(
numericInput(inputId = "id_1", label = "Id number 1", value = 1, min = 0, max = 2, step = 0.05)
),
div(
checkboxGroupInput("icons", "Choose icons:",
choiceNames = list(icon("calendar"), icon("bed"), icon("cog"), icon("bug")),
choiceValues = list("calendar", "bed", "cog", "bug")
)
)
)
)
)
)
server <- function(input, output) { }
shinyApp(ui, server)
I'm trying to reduce the margin between two elements on this shiny app. When open in a browser, the whitespace between the two is huge.
I tried setting the css by adding style = "margin:0px; padding:0px" to the UI, but it did not help. I also tried messing with the inline = TRUE settings, also no help.
ui <- fluidPage(
fluidRow(
column(width = 3,
htmlOutput("select1", inline = TRUE, style = "margin:0px; padding:0px")
),
column(width = 3,
htmlOutput("select2", inline = TRUE, style = "margin:0px; padding:0px")
),
column(width = 6)
)
)
server <- function(input, output, session) {
output$select1 <- renderUI({
pickerInput(
inputId = "select1",
label = "LETTERS",
#choices = sort(unique(inventory$SubDivision)),
choices = LETTERS,
options = list(
"actions-box" = TRUE,
size = 10,
`live-search`=TRUE
),
multiple = TRUE
)
})
output$select2 <- renderUI({
pickerInput(
inputId = "select2",
label = "letters",
#choices = sort(unique(inventory$SubDivision)),
choices = letters,
options = list(
"actions-box" = TRUE,
size = 10,
`live-search`=TRUE
),
multiple = TRUE
)
})
}
shinyApp(ui, server)
Whitespace in browser:
The issue here is not the margin or padding, but the limit of the width to 300px. To allow the control to grow to full size of the column, you can change the global style :
ui <- fluidPage(
fluidRow(
tags$head(
tags$style(HTML("
.shiny-input-container:not(.shiny-input-container-inline) {
width:100%;
}"))
),
column(width = 3,
htmlOutput("select1", inline = TRUE)
),
column(width = 3,
htmlOutput("select2", inline = TRUE)
),
column(width = 6)
)
)
Layout-Question: Attached the following figure. I try to adjust the layout in the following way such that I achieve the "red" extensions. Any suggestions how to do that?
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
mainPanel(width = 12,
fluidRow(
column(6, offset = 0, uiOutput("f1")),
column(6, offset = 0, uiOutput("f2"))
),
fluidRow(
column(4, offset = 0, uiOutput("f3")),
column(4, offset = 0, uiOutput("f4")),
column(4, offset = 0, uiOutput("f5"))
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$f1 <- renderUI({
selectizeInput(inputId = "select_visualize_aggregation",
label = "F1",
choices = c("day", "week"),
selected = "week",
multiple = FALSE
)
})
...
}
# Run the application
shinyApp(ui = ui, server = server)
Set width = "100%" in selectizeInput:
output$f1 <- renderUI({
selectizeInput(inputId = "select_visualize_aggregation",
label = "F1",
choices = c("day", "week"),
selected = "week",
multiple = FALSE,
width = "100%"
)
})
I have an app with two Highcharts plot, when I start the app the width of the two plots are correct, but everytime I change the mean input, the width of the first plot is set to the width of the second, like this :
When I start the app :
When I change the input :
My code to produce the app :
library(rCharts)
library(shiny)
runApp(list(
ui = fluidPage(
title = "App title",
titlePanel(strong("App title", style="color: steelblue")),
sidebarLayout(
sidebarPanel(width = 2,
br()),
mainPanel(width = 10,
tabsetPanel(
tabPanel("Tab 1",
selectInput(inputId = "input_mean", label = "Mean : ", choices = c(20:30)),
fluidRow(
column(8,
showOutput(outputId = "chart1", lib = "highcharts")
, br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br()),
column(4,
showOutput(outputId = "chart2", lib = "highcharts"))
)
)
)
)
)
),
server = function(input, output) {
my_data <- reactive({
rnorm(n = 30, mean = as.numeric(input$input_mean))
})
output$chart1 <- renderChart2({
my_data = my_data()
h2 <- Highcharts$new()
h2$chart(type="line")
h2$series(data=my_data, name = "One", marker = list(symbol = 'circle'), color = "lightblue")
h2$set(width = 800, height = 400)
return(h2)
})
output$chart2 <- renderChart2({
my_data = my_data()
my_mean = as.numeric(input$input_mean)
part = data.frame(V1 = c("Sup", "Inf"), V2 = c(sum(my_data>my_mean), sum(my_data<my_mean)))
p = hPlot(x = "V1", y = "V2", data = part, type = "pie")
p$tooltip(pointFormat = "{series.name}: <b>{point.percentage:.1f}%</b>")
p$params$width <- 200
p$params$height <- 200
return(p)
})
}
))
I use rCharts_0.4.5 and shiny_0.9.1.
Thanks !
Replace these lines:
h2$chart(type="line")
h2$set(width = 800, height = 400)
as follows:
h2$chart(type="line", width = 800, height = 400)
This should help.