I thought the full row was 12, so 4 3-wide columns should fill across the whole page, but this doesn't.
library(shiny)
fluidPage(
mainPanel(
fluidRow(
column(3,
textInput("user_id", "User ID", width = NULL)
),
column(3,
textInput("name", "Organization name",value = "",width = NULL)
),
column(3,
textInput("address", "Address",value = "",width = NULL)
),
column (3,
textInput("zip", "Zip Code",value = "",width = NULL)
)
) #row
) #panel
) #page
Per default mainPanel has a width of 8. This can be seen when looking at the docs:
?shiny::mainPanel
mainPanel(..., width = 8)
Therefore you have to explicitly state width = 12 inside your mainPanel call.
fluidPage(
mainPanel(
fluidRow(
column(3,
textInput("user_id", "User ID", width = NULL)
),
column(3,
textInput("name", "Organization name",value = "",width = NULL)
),
column(3,
textInput("address", "Address",value = "",width = NULL)
),
column (3,
textInput("zip", "Zip Code",value = "",width = NULL)
)
) #row
, width = 12) #panel
) #page
..should do the trick.
Related
The reproducible code below uses a fluidRow() to house several user selections using radio buttons. Works fine in this limited example of only 2 radio button groupings. But I need to fit more radio button groupings into this row, without any wrapping. To do this, I'd like to replace this combination of fluidRow()/column() with a horizontally scrollable, non-wrapping row that is not subject to the limitations of the 12-wide grid system currently used in this code.
Also, all objects viewed in the scrolling row need to be left aligned without "fluid" expansion. Currently, using this fluidRow()/column() combo, if the viewing pane is expanded, the 2 columns housing each radio button grouping also expanded which doesn't look good. They need to remain fixed width and stay to the left.
Is this possible?
I prefer sticking with this sidebar/main panel/tab panel/conditional panel layout as I find it very user friendly for navigating the type of data we work with.
The image at the bottom further explains.
Reproducible code:
library(dplyr)
library(DT)
library(shiny)
library(shinyWidgets)
ui <-
fluidPage(
titlePanel("Summary"),
sidebarLayout(
sidebarPanel(
selectInput("selectData", h5("Select data to view:"),
choices = list("Beta"),
selected = "Beta"),
),
mainPanel(
tabsetPanel(
tabPanel("Private data", value = 1,
conditionalPanel(condition = "input.selectData == 'Beta'",
fluidRow(div(style = "margin-top:15px"),
column(width = 6, offset = 0,
wellPanel(
radioButtons(inputId = 'group1',
label = NULL,
choiceNames = c('By period','By MOA'),
choiceValues = c('Period','MOA'),
selected = 'Period',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
),
column(width = 6, offset = 0,
wellPanel(
radioButtons(inputId = 'group2',
label = NULL,
choiceNames = c('Exclude CT','Include CT'),
choiceValues = c('Exclude','Include'),
selected = 'Exclude',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
)
),
DTOutput("plants")
)
),
id = "tabselected"
)
)
)
)
server <- function(input, output, session) {
output$plants <- renderDT({iris %>% datatable(rownames = FALSE)})
}
shinyApp(ui, server)
How about using a carousel instead e.g. via shinyglide or slickR:
library(dplyr)
library(DT)
library(shiny)
library(shinyWidgets)
library(shinyglide)
ui <-
fluidPage(
titlePanel("Summary"),
sidebarLayout(
sidebarPanel(
selectInput("selectData", h5("Select data to view:"),
choices = list("Beta"),
selected = "Beta"),
),
mainPanel(
tabsetPanel(
tabPanel("Private data", value = 1,
conditionalPanel(condition = "input.selectData == 'Beta'",
fluidRow(div(style = "margin-top:15px"),
column(12, glide(
height = "25",
controls_position = "top",
screen(
p(strong("Group 1")),
wellPanel(
radioButtons(inputId = 'group1',
label = NULL,
choiceNames = c('By period','By MOA'),
choiceValues = c('Period','MOA'),
selected = 'Period',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
),
screen(
p(strong("Group 2")),
wellPanel(
radioButtons(inputId = 'group2',
label = NULL,
choiceNames = c('Exclude CT','Include CT'),
choiceValues = c('Exclude','Include'),
selected = 'Exclude',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
)
))
),
DTOutput("plants")
)
),
id = "tabselected"
)
)
)
)
server <- function(input, output, session) {
output$plants <- renderDT({iris %>% datatable(rownames = FALSE)})
}
shinyApp(ui, server)
I have an shinydashboard app, the app get an filter box and a tabset which show a datatatable depending on filter.
I have a reset button which reset the filters whith shinyjs::reset function, and I want to reset also the tableset and showing the complete table or nothing.
I want also to do it for a valuboxes.
My app is like this :
For server interface I have an basic : output$tableprint_A <- DT::renderDataRable ({})
ui :
body <- dashboardBody(
tabItems(
#### First tab item #####
tabItem(tabName = "fpc",
fluidRow(
infoBoxOutput("kpm_inf", width = 6),
infoBoxOutput(outputId = "fpc_inf", width = 6)
),
fluidRow(
box(title = "Variables filter",
shinyjs::useShinyjs(),
id = "side_panel",
br(),
background = "light-blue",
solidHeader = TRUE,
width = 2,
selectInput("aaa", "aaa", multiple = T, choices = c("All", as.character(unique(fpc$aaa))))
br(),
br(),
p(class = "text-center", div(style = "display:inline-block", actionButton("go_button", "Search",
icon = icon("arrow-circle-o-right"))),
div(style = "display:inline-block", actionButton("reset_button", "Reset",
icon = icon("repeat")))),
p(class = 'text-center', downloadButton('dl_fpc', 'Download Data'))),
tabBox(
title = tagList(),
id = "tabset1",
width = 10,
tabPanel(
"A \u2030 ",
DT::dataTableOutput("tableprint_A"),
bsModal(id = 'startupModal', title = 'Update message', trigger = '',
size = 'large',
tags$p(tags$h2("Last update of A : 01/09/2017",
br(), br(),
"Last update of B : 01/09/2017",
br(), br(),
"Last update of C : 01/09/2017",
style = "color:green", align = "center")))
),
tabPanel(
"B % Table",
DT::dataTableOutput("tableprint_B")),
type = "pills"
)
),
fluidRow(
# Dynamic valueBoxes
valueBoxOutput("info_gen", width = 6)
)
I tried this :
observeEvent(input$reset_button, {
output$tableprint_A <- NULL
})
Edit:
I want something like that, but when I action the search button I want it to appear again :
shinyjs::onclick("reset_button",
shinyjs::toggle(id = "tableprint_A", anim = TRUE))
You should try this out:
output$tableprint_A <- renderDataTable({
if(input$reset_button == 1) {
NULL
}else{
datatable(...)
}
})
if the button is clicked then nothing will be displayed, else the datatable is shown.
[EDIT]
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(selectInput("select", "select", choices = unique(iris$Species), multiple = T),
actionButton("go_button", "Search",
icon = icon("arrow-circle-o-right")),
actionButton("reset_button", "Reset",
icon = icon("repeat")),
DT::dataTableOutput('tbl')),
server = function(input, output) {
values <- reactiveValues(matrix = NULL)
observe({
if (input$go_button == 0)
return()
values$matrix <- iris[iris$Species %in% input$select, ]
})
observe({
if (input$reset_button == 0)
return()
values$matrix <- NULL
})
output$tbl = DT::renderDataTable({
datatable(values$matrix, options = list(lengthChange = FALSE))}
)
}
)
Lets assume I have a very simple application that only has 8 inputs grouped in 2 Panels (4 inputs | 4 inputs - see picture bellow) and based on these, I plot a small plot (easy peasy).
The problem that I face is that I want to have the labels only for the first panel, and on the left of the textInput box.
e.g. (Please excuse my sloppy image editing!)
Any suggestion?
My MWE for Figure 1 output:
library(shiny)
ui<-shinyUI(fluidPage(
wellPanel(
tags$style(type="text/css", '#leftPanel { max-width:300px; float:left;}'),
id = "leftPanel",
textInput("Population1000", 'Population 1000',"15"),
textInput("Area1000",'Area 1000', "20"),
textInput("GNI1000", 'GNI 1000', "2314"),
textInput("GDP1000", "GDP 1000", "1000")
),
wellPanel(
tags$style(type="text/css", '#RightPanel { max-width:300px; float:left;}'),
id = "RightPanel",
textInput("Population2000", 'Population 2000',"15"),
textInput("Area2000",'Area 2000', "20"),
textInput("GNI2000", 'GNI 2000', "2314"),
textInput("GDP2000", "GDP 2000", "1000")
)
)
)
server<-shinyServer(function(input, output) {NULL})
shinyApp(ui,server)
Hi you can try to use Bootstrap's horizontal form, look at the code below, it create 3 columns of width 4 each. You can change width in class = "col-sm-4 control-label" for labels, and in width = 4 for inputs.
library("shiny")
ui <- fluidPage(
fluidRow(
column(
width = 4,
tags$form(
class="form-horizontal",
tags$div(
class="form-group",
tags$label(class = "col-sm-4 control-label", `for` = "Population1000", br(), "Population"),
column(width = 4, textInput(inputId = "Population1000", label = "Year 1000", value = "15")),
column(width = 4, textInput(inputId = "Population2000", label = "Year 2000", value = "15"))
),
tags$div(
class="form-group",
tags$label(class = "col-sm-4 control-label", `for` = "Area1000", "Area"),
column(width = 4, textInput(inputId = "Area1000", label = NULL, value = "20")),
column(width = 4, textInput(inputId = "Area2000", label = NULL, value = "20"))
),
"..."
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
Result :
PS : you should not use same ids for inputs.
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;', ...)
I have a couple of questions regarding R shiny Dashboard.
ui.R
library(shinydashboard)
library(shiny)
dashboardPage(
dashboardHeader(title = 'Test Interface'),
dashboardSidebar(width = 600,
h3('-------Input Data-------'),
fluidRow(
column(6, div(style = "height:10px"), fileInput(inputId = 'FileInput', label = 'Upload Input:', accept = c('csv','tsv','txt'))),
column(2, div(style = "height:3px"), checkboxInput(inputId = 'header', label = 'Header', value = FALSE)),
column(2, div(style = "height:12px"), radioButtons(inputId = 'sep', label = 'Separator', choices = c(comma=',',tab="\t",space=' '), selected = ","),offset = 1)
),
fluidRow(column(6, div(style = "height:1px"), fileInput(inputId = 'FileInput1', label = 'Upload Second Input:'))),
br(),
h3('-------Select Foreground-------'),
fluidRow(
column(5, div(style = "height:17px"), radioButtons(inputId = 'cutoff', label = 'Selection', choices = c('Up'='pos','Down'='neg','Both'='both'))),
br(),
column(3, div(style = "height:1px"), textInput(inputId = 'fc', label = "Fold Change", value = '0')),
column(3, div(style = "height:1px; margin-left:10cm"), height = 6,textInput(inputId = 'pvalue', label = "Adj. Pvalue",value = '0.05'))
),
fluidRow(column(2, h1(" "), actionButton(inputId = 'select', label = "Select Data"))),
fluidRow(column(5, div(style = "height:25px;font-color:blue"), downloadButton('download', 'Download Plot')))),
dashboardBody(
tabsetPanel(type="tabs", id = "tabvalue",
tabPanel(title = "Input Table", value = 'tab1', DT::dataTableOutput('table')),
tabPanel(title = "Plot", value = 'tab7', plotOutput('plot',width = 800,height = 800)))))
server.R
library(shiny)
shinyServer(function(input, output, session){
})
I couldn't figure out how to add a vertical scroll bar to the dashboardSidebar. In my actual app, the last elements are not visible when I run the app.
Thanks!
I ran into this and came up with the following hack (and I do mean hack).
shinyDashboard(
tags$head(
tags$style(HTML(".sidebar {
height: 90vh; overflow-y: auto;
}"
) # close HTML
) # close tags$style
), # close tags#Head
# ...
The 90vh sets the sidebar height at 90% of the viewport height. You may want to adjust this to taste. Too large a percentage and some of the sidebar still drops below the horizon; too small a percentage and the sidebar ends noticeably before the main body (with the scrollbar appearing prematurely).