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))
})
Related
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 want to add one tabulation to a line in Shiny but I don't find the way to do it.
I know that there are HTML tags in Shiny such as strong to put words in bold, small to make them smaller... Even blockquote to add blocks of quotes.
But I didn't find one to add one tabulation.
Does anyone know how to do it?
Reproducible code:
library(shiny)
ui = pageWithSidebar(
headerPanel("My app"),
sidebarPanel(
),
mainPanel(
htmlOutput("text")
)
)
server = function(input, output) {
output$text <- renderUI({
str1 <- strong("This is the first line in bold:")
str2 <- em("This is the second line in italics and with one tabulation")
HTML(paste(str1, str2, sep = '<br/>'))
})
}
shinyApp(ui,server)
You can add a style attribute to each shiny-tag:
library(shiny)
ui = pageWithSidebar(
headerPanel("My app"),
sidebarPanel(),
mainPanel(
htmlOutput("text")
)
)
server = function(input, output) {
output$text <- renderUI({
tag1 <- p(strong("This is the first line in bold:"))
tag2 <- p(em("This is the second line in italics and with one tabulation"), style = "text-indent: 1em;")
HTML(paste(tag1, tag2, sep = '<br/>'))
})
}
shinyApp(ui,server)
You could do it just using html code instead of the r tags from shiny:
library(shiny)
ui = pageWithSidebar(
headerPanel("My app"),
sidebarPanel(
),
mainPanel(
htmlOutput("text")
)
)
server = function(input, output) {
output$text <- renderUI({
str1 <- "<p><strong>This is the first line in bold:</strong></p>"
str2 <- "<p style='text-indent: 45px'><em>This is the second line in italics and with one tabulation</em></p>"
HTML(paste(str1, str2, sep = ''))
})
}
shinyApp(ui,server)
unless I have misunderstood what you're trying to do.
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)
For a shiny app, I'd like to go through a data frame row-wise and highlight (bold, color, or similiar) the selected row in renderTable. I was thinking of selecting the row by index. Can I do this with renderTable, or should I consider DT?
library(shiny)
ui <-
fluidRow(
actionButton(
"my_button",
"Go to next row"
),
tableOutput("my_table")
)
server <- function(input, output){
values <- reactiveValues()
values$index <- 1
values$dat <- iris
observeEvent(
input$my_button, {
values$index <- values$index + 1
})
output$my_table <-
renderTable(values$dat) # somehow highlight the row at the index
}
shinyApp(ui = ui, server = server)
This might get you started.
library(shiny)
library(DT)
library(dplyr)
ui <-
fluidRow(
actionButton(
"my_button",
"Go to next row"
),
dataTableOutput("my_table")
)
server <- function(input, output){
values <- reactiveValues()
values$index <- 1
values$dat <- iris
observeEvent(
input$my_button, {
values$index <- values$index + 1
})
output$my_table <-
renderDataTable({
values$dat %>%
mutate(row = row_number()) %>%
datatable() %>%
formatStyle(
"row",
target = 'row',
backgroundColor = styleEqual(values$index, c('yellow'))
)
}) # somehow highlight the row at the index
}
shinyApp(ui = ui, server = server)
I can't open and show html file into shiny code in r
I'm trying make it by R programm:
ui.R
tabItem(tabName = "ndvi",
fluidPage(tags$style(type = "text/css", "#map{height: 800px !important;}"),
fluidRow(
column(2,
dateInput("date1",
label = "DATE",
value = "2018-08-07")
)
),
fluidRow(
htmlOutput("frame1")
server.R
framePath <- reactive({
return(sprintf("http://10.0.6.179:5656/WEB_NKR/ndvi_shape_files/agro_priishimski//%s_agro_priishimski.html", input$date1))
})
output$frame1 <- renderUI({
tags$iframe(seamless="seamless", src=framePath(), height=800, width=1650)
})
I must take in the result: