The app below contains a fileInput and actionButton. I would like to vertically align the two elements so that the actionButton lines up with the Browse button of the fileInput. In addition to the code included below, I also tried display:flex and align-items:center; as well as fluidRow(column(width = 9, ...), column(width = 3, ...)) to no avail. I'm not sure what I'm missing and any help would be much appreciated.
Here is the app:
library(shiny)
library(shinydashboard)
# UI ----------------------------------------------------------------------
ui = fluidPage(
tagList(
box(
width = 5,
tags$div(style = "display:inline-block; width:75%;",
fileInput(
inputId = 'file',
label = 'Select file:',
accept = c('.txt', '.csv', '.xls', '.xlsx', '.rds', '.dta', '.sas7bdat', '.sav')
)
),
tags$div(style = "display:inline-block; width:20%;",
div(class = 'pull-right',
actionButton('upload', 'Upload')
)
)
)
)
)
# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {})
shinyApp(ui, server)
The result:
Related
I have an app set up as this is. As the user selects multiple items from the Animals dropdown, the printout of what they have selected gets longer and pushes the elements under it down
I would like for the elements under it to be justified to the bottom of the page so that they don't move as more animals are selected
library(tidyverse)
library(ggplot2)
library(dplyr)
library(shiny)
# Define UI for app
ui <-
fillPage(
column(2,
fluidRow(
# Input 1: animal
selectInput(
inputId = 'FilterFieldSelection',
label = 'Animal Of Choice',
choices = c('Dog','Cat','Inu','Neko','Giraffe','Kirin','Mouse','Nezumi'),
selected = 'Dog',
multiple = TRUE
),
# Output 1: Active Filters
htmlOutput('ActiveFiltersText')
),
fluidRow(
h4("Counts"),
# Input 2: color
selectInput(
inputId = 'ColorChoice',
label = 'Color Of Choice',
choices = c('red','blue','green'),
selected = 'red'
),
# Output 2: Filtered Well Count
htmlOutput('WellCountFilteredText'),
)
),
column(10,
plotOutput('myplot')
)
)
# Define Server
server <- function(input, output, session) {
# Text Outputs ----
## Text Output Of Active Filters ----
output$ActiveFiltersText <- renderUI({
full_text <- ""
full_text <- paste0(full_text, '<b>','There Is A','</b>:<br/>',
paste(input$FilterFieldSelection,collapse="<br/>"),'<br/>'
)
full_text <- HTML(full_text)
})
## Text Output Of Filtered Well Count ----
output$WellCountFilteredText <- renderUI({
HTML(paste0('<b>','Filtered','</b>:<br/>',150000))
})
## Plot
output$myplot <- renderPlot({
m <- matrix(rnorm(50), ncol = 5)
colnames(m) <- c("a", "b", "c", "d", "e")
as_tibble(m) %>%
ggplot(aes(x=a, y=b) ) +
geom_point(color=input$ColorChoice)
})
}
# Run App
shinyApp(ui = ui, server = server)
I have tried putting the elements to not move in another fluidRow, but that didn't change anything. They're still fully top-justified
You can put the elements in a div with CSS style properties position: fixed; bottom: 0;.
ui <- fluidPage(
fluidRow(
column(
2,
selectInput(
inputId = 'FilterFieldSelection',
label = 'Animal Of Choice',
choices = c('Dog','Cat','Inu','Neko','Giraffe','Kirin','Mouse','Nezumi'),
selected = 'Dog',
multiple = TRUE
),
tags$div(
style = "position: fixed; bottom: 0;",
# Output 1: Active Filters
htmlOutput('ActiveFiltersText'),
tags$hr(),
h4("Counts"),
# Input 2: color
selectInput(
inputId = 'ColorChoice',
label = 'Color Of Choice',
choices = c('red','blue','green'),
selected = 'red'
),
# Output 2: Filtered Well Count
htmlOutput('WellCountFilteredText'),
)
),
column(
10,
plotOutput("myplot")
)
)
)
As shown in the below image, I'm trying to place a line of text in front of an info icon rendered using the popify() function in the shinyBS package. The code at the bottom works for the situation where there is no text in front of info icon and commented-out is one of my attempts to insert the text. Uncomment, run the code, and you'll see garbled output.
So how would one insert text in front of the icon? One option is to split the text and icon into 2 separate columns, but I don't want to fiddle with the column widths to make it look right. I want the text to "flow into" the icon.
I thought this Stack Overflow question might provide an answer but it is a dead end: How to place both text and image output in one html div (rshiny)
Code:
library(shiny)
library(shinyBS)
app = shinyApp(
ui =
fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins","Number of bins:",min = 1,max = 50,value = 30)
),
mainPanel(
plotOutput("distPlot"),
uiOutput("uiExample")
)
)
),
server =
function(input, output, session) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$uiExample <- renderUI({
# paste( #uncomment
# "Look at the little circle >>", #uncomment
tags$span(
popify(icon("info-circle", verify_fa = FALSE),
"Placeholder",
"This icon is <b>placeholder</b>. It will be fixed</em>!")
)
# ) #uncomment
})
}
)
runApp(app)
This could be achieved via a tagList and another span:
library(shiny)
library(shinyBS)
app = shinyApp(
ui =
fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins","Number of bins:",min = 1,max = 50,value = 30)
),
mainPanel(
plotOutput("distPlot"),
uiOutput("uiExample")
)
)
),
server =
function(input, output, session) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$uiExample <- renderUI({
tagList(
tags$span(
"Look at the little circle >>"
),
tags$span(
popify(icon("info-circle", verify_fa = FALSE),
"Placeholder",
"This icon is <b>placeholder</b>. It will be fixed</em>!")
)
)
})
}
)
runApp(app)
I have a simple app where I want to have a text pop up, but because the text is long, I want to add line breaks. For some reason, R isn't recognizing my line breaks, even though I've added , like I read in this example.
Any help would be greatly appreciated!
library(shiny)
long_text <- paste0(htmltools::HTML("I have a lot of text. <br><br>And I want it on different lines.<br><br> This should work, but R is being....<br><br>difficult."))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
br(),
actionButton(inputId = "text_info",
label = "My R Sob Story", style = "color: #FFFFFF; background-color: #CA001B; border_color: #CA001B")
),
mainPanel(
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
observeEvent(input$text_info, {
showModal(modalDialog(long_text, title = strong("Why R you doing this to me?")))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Here's what it looks like now:
If you paste after changing the text to HTML, it will be character again.
library(shiny)
long_text <- htmltools::HTML("I have a lot of text. <br><br>And I want it on different lines.<br><br> This should work, but R is being....<br><br>difficult.")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
br(),
actionButton(inputId = "text_info",
label = "My R Sob Story", style = "color: #FFFFFF; background-color: #CA001B; border_color: #CA001B")
),
mainPanel(
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
observeEvent(input$text_info, {
showModal(modalDialog(long_text, title = strong("Why R you doing this to me?")))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have an app where the user will generate a bunch of selectizeInputs along with 3 numericInputs for every selectizeInput. The problem I am having is that the selectizeInput does not align well with the numericInputs and once you have about 10 rows, the alignment is completely gone.
I have thought of two ways of solving this problem:
create one renderUI function and include fluidRows in a loop but some searching has led me to believe that isnt possible.
Height adjust the selectizeInput with using tags$style(type = "text/css", ".form-control.shiny-bound-input, .selectize-input {height: 46px;}"), but I dont want to adjust the selectizeInput height universally as the app has selectizeInputs elsewhere.
I can't really hardcode the input name with tags$style(type = "text/css", "#some_id.form-control.shiny-bound-input {height: 46px;}") since the names are dynamically generated by the user.
Will one of these two options work? If not is there a third option?
I have made a demo version of the problem below.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width = 3, br(),br(),br(),br(),br(),br(),br(), h6("something else is here")),
mainPanel(
tabsetPanel(
tabPanel("Problem tab",
br(),
numericInput("inputs_num","Enter Number of Channels to Calibrate", min = 1, value = 10),
hr(),
br(),
fluidRow(
column(width= 3,uiOutput("colname")),
column(width =3, uiOutput("initial_numeric")),
column(width =3, uiOutput("min_numeric")),
column(width =3, uiOutput("max_numeric"))
),
hr()
)
)
)
)
)
server <- function(input, output, server){
output$colname <- renderUI({
req(input$inputs_num)
columns <- colnames(mtcars)
tags <- tagList()
for(i in 1:input$inputs_num){
tags[[i]] = selectizeInput(paste0("colname_",i), paste0("Column ",i), choices = columns, selected = NULL,
options = list(
placeholder = "Enter Column Name",
onInitialize = I('function() { this.setValue(""); }')
))
}
tags
})
output$initial_numeric <- renderUI({
req(input$inputs_num)
tags <- tagList()
for (i in 1:input$inputs_num){
tags[[i]] <- numericInput(paste0("initial_",i), paste("Initial",i), min = 0,value = 1)
}
tags
})
output$min_numeric <- renderUI({
req(input$inputs_num)
tags <- tagList()
for (i in 1:input$inputs_num){
tags[[i]] <- numericInput(paste0("min_",i), paste("Min",i), min = 0,value = 1)
}
tags
})
output$max_numeric <- renderUI({
req(input$inputs_num)
tags <- tagList()
for (i in 1:input$inputs_num){
tags[[i]] <- numericInput(paste0("max_",i), paste("Max",i), min = 0,value = 1)
}
tags
})
}
shinyApp(ui, server)
In Safari everything was aligned fine, and only in Firefox it became visible. I tried wrapping everything in one loop and it seems to work fine, even in Firefox.
So the approach below should correspond to solution 1. Since solution 2 (changing the css of the input universally) is not an option, another approach would be to define custom inputs by wrapping the original inputs in a tag and adding an additional class which can then be targeted in css. But I think that this not necessary, since the approach below works.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width = 3, br(),br(),br(),br(),br(),br(),br(), h6("something else is here")),
mainPanel(
tabsetPanel(
tabPanel("Problem tab",
br(),
numericInput("inputs_num","Enter Number of Channels to Calibrate", min = 1, value = 10),
hr(),
br(),
uiOutput("all"),
hr()
)
)
)
)
)
server <- function(input, output, server){
output$all <- renderUI({
req(input$inputs_num)
columns <- colnames(mtcars)
tags <- tagList()
for(i in 1:input$inputs_num){
tags[[i]] <- fluidRow(
column(width= 3,
selectizeInput(paste0("colname_",i), paste0("Column ",i), choices = columns, selected = NULL,
options = list(
placeholder = "Enter Column Name",
onInitialize = I('function() { this.setValue(""); }')
))),
column(width= 3,
numericInput(paste0("initial_",i), paste("Initial",i), min = 0,value = 1)),
column(width= 3,
numericInput(paste0("min_",i), paste("Min",i), min = 0,value = 1)),
column(width= 3,
numericInput(paste0("max_",i), paste("Max",i), min = 0,value = 1))
)
}
tags
})
}
shinyApp(ui, server)
I'm trying to create a checkbox for which the choices are plots created through ggplot. In the result, the UI looks like the HTML code itself instead of evaluating the HTML code to show the chart. Any ideas how I can get the checkboxGroupInput to show ggplots?
Sample code below -
runApp(shinyApp(
ui = fluidPage(
headerPanel("Plot check box"),
mainPanel(
uiOutput("plotscheckboxes")
)
),
server = function(input, output, session) {
output$plot1 = renderPlot({
ggplot(mtcars)+geom_point(aes(x=mpg,y=mpg))
})
output$plot2 = renderPlot({
ggplot(mtcars)+geom_point(aes(x=mpg,y=mpg))
})
output$plotscheckboxes = renderUI({
plotlist = list(
plotOutput('plot1'),
plotOutput('plot2')
)
plotlist2 = do.call(tagList, plotlist)
# this just produces a list with 1,2, some sort of underlying value for the checkboxGroup
finaloptionlist = lapply(
seq(length(plotlist2)),
function(x) x
)
# the names of the list are what get used in the options so setting the names accordingly as the HTML code of the ggplot rendering
names(finaloptionlist) = sapply(plotlist2, function(x) paste(x, collapse = "\n"))
checkboxGroupInput("checkGroup", label = h3("Checkbox group"),
choices = finaloptionlist,
selected = 1)
})
}
))