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 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 need to show tweets in my shiny app, so let's assume that the URL is in a data frame.
here is my code without variable:
library(shiny)
runApp(list(
ui = fluidPage(
tags$head(
tags$script("!function(d,s,id){var js,fjs=d.getElementsByTagName(s) [0],p=/^http:/.test(d.location)?'http':'https';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+'://platform.twitter.com/widgets.js';fjs.parentNode.insertBefore(js,fjs);}}(document,'script','twitter-wjs');")
),
mainPanel(
HTML('
<blockquote class="twitter-tweet" data-lang="en">
tweet1
</blockquote>
') )
),
server = function(input, output, session) {}
))
)
then I do some change to HTML and pass a variable
HTML('
<blockquote class="twitter-tweet" data-lang="en">
paste0("<a href='",Top5Retweet2[1,3],"'>","tweet","</a>")
</blockquote>
')
) )
but I got this error and I think it because of quotes
Error: unexpected '<' in "<"
also, I tried all of this but still does not show anything
cat("","tweet","")
cat("","tweet","")
update :
runApp(list(
ui = fluidPage(
tags$head(
tags$script("!function(d,s,id){var js,fjs=d.getElementsByTagName(s) [0],p=/^http:/.test(d.location)?'http':'https';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+'://platform.twitter.com/widgets.js';fjs.parentNode.insertBefore(js,fjs);}}(document,'script','twitter-wjs');")
),
mainPanel(
htmlOutput("tweets_show")
)
),
server = function(input, output, session) {
output$tweets_show <- renderUI({
HTML(
paste('<blockquote class="twitter-tweet" data-lang="en">',
paste("","tweet",""),
'</blockquote>')
)
})
}
))
any help thank you
From ?renderUI we can use tagList to insert a list of multiple HTML tags
library(shiny)
runApp(list(
ui = fluidPage(
mainPanel(
htmlOutput("tweets_show")
)
),
server = function(input, output, session) {
tws <- c("https://twitter.com/Twitter/status/1144673160777912322","https://twitter.com/Twitter/status/1144673160777912322","https://twitter.com/Twitter/status/1144673160777912322")
output$tweets_show <- renderUI({
tagList(
tags$head(
tags$script("!function(d,s,id){var js,fjs=d.getElementsByTagName(s) [0],p=/^http:/.test(d.location)?'http':'https';if(!d.getElementById(id)){js=d.createElement(s);js.id=id;js.src=p+'://platform.twitter.com/widgets.js';fjs.parentNode.insertBefore(js,fjs);}}(document,'script','twitter-wjs');")
),
HTML(
paste('<blockquote class="twitter-tweet" data-lang="en">',
paste("","tweet",""),
'</blockquote>')
))
})
}
))
Reproducible example:
require(shiny)
runApp(list(ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
sliderInput("index",
label = "Select a number",
min = 1,
max = 4,
step = 1,
value = 2)),
mainPanel(
htmlOutput("text")
)),
server = function(input, output) {
output$text <- renderUI({
HTML(paste(c("banana","raccoon","duck","grapefruit")))
})
}
))
I would like to have the word corresponding to index ("raccoon" in the default) displayed in bold and the other words in normal font.
If I do:
HTML(
<b>paste(c("banana","raccoon","duck","grapefruit")[input$index])<\b>,
paste(c("banana","raccoon","duck","grapefruit")[setdiff(1:4,input$index)])
)
I receive an error (< is not recognized)...
One more try, is this helpful?
require(shiny)
fruits <- c("banana","raccoon","duck","grapefruit")
runApp(list(ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
sliderInput("index",
label = "Select a number",
min = 1,
max = 4,
step = 1,
value = 2)),
mainPanel(
htmlOutput("text")
)),
server = function(input, output) {
output$text <- renderUI({
fruits[input$index] <- paste("<b>",fruits[input$index],"</b>")
HTML(paste(fruits))
})
}
))
This might help you:
shinyApp(
ui <- basicPage(
uiOutput(outputId = "text")
),
server <- function(input,output){
output$text <- renderText({
HTML(paste0("<b>","bold","</b>", " not bold"))
})
})
Is that what you were looking for?
If you're not set on using the HTML function, I believe you should be able to use strong(paste(character_vector[index])) instead.
Just use renderPrint instead of renderText
renderPrint({
HTML(paste0("El valor 1 es:", input$val1,"\n","el valor 2 es:",input$val2))
})