In my shiny app, I have a textOutput named acronym where I would like to renderText some text which is half non-italicized, half-italicized.
I tried doing it like this:
output$acronym_1 <- renderText(paste("SID SIDE:", tags$em("Siderastrea siderea")))
But this did not get the second half in italics. How do I do this?
Thanks in advance.
The following code will produce italicized text
library(shiny)
ui = fluidPage(uiOutput("htmlText"))
server <- function(input, output)
output$htmlText <- renderUI(HTML(paste(
"Non-italic text.", em("Italic text")
)))
shinyApp(ui, server)
I don't think textOutput is capable of text markup since the output string will be created by cat according to the documentation.
renderText(expr, env = parent.frame(), quoted = FALSE,
outputArgs = list())
expr An expression that returns an R object that can be used as an argument to cat.
Related
I am able to create an Rmarkdown file and I'm trying to embed a shiny app into the html output. The interactive graph shows if I run the code in the Rmarkdown file. But in the html output it only shows a blank box. Can anybody help fix it?
Run the code in Rmarkdown file:
In the html output:
My Rmarkdown file (please add the three code sign at the end yourself somehow i cannot do here):
---
title: "Data Science - Tagging"
pagetitle: "Data Science - Style Tagging"
author:
name: "yyy"
params:
creation_date: "`r format(Sys.time(), c('%Y%m%d', '%h:%m'))`"
runtime: shiny
---
```{r plt.suppVSauto.week.EB, out.width = '100%'}
data <- data.frame(BclgID = c('US','US','US','UK','UK','UK','DE','DE','DE'),
week = as.Date(c('2020-06-28', '2020-06-21', '2020-06-14', '2020-06-28', '2020-06-21', '2020-06-14', '2020-06-28', '2020-06-21', '2020-06-14')),
value = c(1,2,3,1,2,2,3,1,1))
shinyApp(
ui <- fluidPage(
radioButtons(inputId = 'BclgID', label = 'Catalog',
choices = type.convert(unique(plot$BclgID), as.is = TRUE),
selected = 'US'),
plotOutput("myplot")
),
server <- function(input, output) {
mychoice <- reactive({
subset(data, BclgID %in% input$BclgID)
})
output$myplot <- renderPlot({
if (length(row.names(mychoice())) == 0) {
print("Values are not available")
}
p <- ggplot(mychoice(), aes(x=as.factor(week), y=value)) +
geom_line() +
labs(title = "test",
subtitle = "",
y="Value",
x ="Date") +
theme(axis.text.x = element_text(angle = 90)) +
facet_wrap( ~ BclgID, ncol = 1)
print(p)
}, height = 450, width = 450)
}
)
EDIT:
Coming back another year later in case anyone still finds this useful. Having done some more work with both shiny and rmarkdown so I understand both better, there isn't really a reason to use them together. Rmarkdown's advantage is being able to come up with a somewhat static pdf that is readable, where shiny is dynamic and requires input.
While my answer below works, if you're using shiny for a GUI, consider removing the rmarkdown portion of what you are writing. It probably isn't adding much/anything, and trying to use the two together can cause headaches.
Original answer below:
I see this was asked a long time ago, so you've probably moved on, but I ran into the same problem and this came up first, so I'll answer it in case anyone else runs into this problem.
I found the answer on this page:
https://community.rstudio.com/t/embedding-shiny-with-inline-not-rendering-with-html-output/41175
The short of it is shiny documents need to be run and not rendered. Rather than calling:
>rmarkdown::render("filename.rmd")
we need to call:
>rmarkdown::run("filename.rmd")
If you are inside Rstudio, it seems the "knit" function changes from render to run when using shiny in RMD.
I have a shiny application that has a functionnality to translate its text between several languages, by using some RenderText and an ActionButton to toggle between languages.
Here is my app:
library(shiny)
trads = list(text3=list("text3 in language 1", "text in other language"),
titl3=list("widget label in language 1", "widget label in other language"))
ui <- fluidPage(
actionButton("language",label="language", icon=icon("flag")),
htmlOutput("text3", container = tags$h3),
sliderInput("slider1", label=h2("slider1"), 0, 10, 5)
)
server <- function(input, output, session) {
tr <- function(text){sapply(text, function(s) trads[[s]][[input$language%%2+1]], USE.NAMES=FALSE)}
output$text3 = renderText({tr("text3")})
observeEvent(input$language, {
updateSliderInput(session, "slider1", label=tr("titl3"))
})
}
shinyApp(ui, server)
It works fine except that my slider label was formatted initially with a html tag h3(), and when I use updatesliderinput I loose this tag and it returns to plain text. I tried adding the tag in the translation with paste0, or different syntax with eval but it prints in text the result of the paste instead of running it or gives an error.
Any ideas to translate while keepping the format? Thanks
Note: I have the same problem with one text containing a URL link..
it really seams you have found a bug in updateSliderInput here. It can only handle pure strings and no HTML tags. As a work around would I recommend you to add something like this to the beginning of your UI
tags$head(
tags$style(
'label[for = "slider1"] {
color: red;
font-size: 20px;
}'
)
)
but change the css to what ever you like (maybe copy the css rules for the h2 tag) and then always only pass a string to the label parameter. This way the styling always stays the same.
my complete code
library(shiny)
trads = list(text3=list("text3 in language 1", "text in other language"),
titl3=list("widget label in language 1", "widget label in other language"))
ui <- fluidPage(
tags$head(
tags$style(
'label[for = "slider1"] {
color: red;
font-size: 20px;
}'
)
),
actionButton("language",label="language", icon=icon("flag")),
htmlOutput("text3", container = tags$h3),
sliderInput("slider1", label="slider1", 0, 10, 5)
)
server <- function(input, output, session) {
tr <- function(text){sapply(text, function(s) trads[[s]][[input$language%%2+1]], USE.NAMES=FALSE)}
output$text3 = renderText({tr("text3")})
observeEvent(input$language, {
updateSliderInput(session, "slider1", label=tr("titl3"))
})
}
shinyApp(ui, server)
hope this helps!
uiOutput('myTable') followed by p("Here is some text....") puts the text next to uioutput display, but I like to print the text in a new line starting from left side of the page. Adding br() is simply adding empty space equivalent to screen width, therefore, text starts from a new line but not from from the left side of the page. Interestingly, adding any control widget, e.g., dateInput displays the widget in a new line. In my case, uioutput input comes from map [ package purrr]. I combined map output and HTML("<br>") via list, but no solution. Here is reproducible code:
library(shiny)
ui <- fluidPage(
tabPanel("Test",
numericInput("samsize","specify sample size",4,1,52),
uiOutput('myTable'),
#dateInput("date", label = "Today's Date")
#br(""),
p("Here is some text...")
))
server <- function(input, output) {
data <- reactive({
alphabets <- c(letters,LETTERS)
Index <- seq(1,length(alphabets),1)
names(Index) <- alphabets
# Notice I don't put the vector in a one row matrix as in you example
sample(Index,input$samsize)
})
library(purrr) # map is a nice alternative to lapply
output$myTable <- renderUI(map(names(data()),~div(strong(.),
div(data()[.]),
style="float:left;padding:10px 20px;")))
}
shinyApp(ui, server)
Here is screen shot. As it is seen, Here is some text is next to uioutput display, which I want to be in a new line below the display
After using div with style float:left, you need to clear the floating, for example with clear:left:
ui <- fluidPage(
tabPanel("Test",
numericInput("samsize","specify sample size",4,1,52),
uiOutput('myTable'),
div("Here is some text...", style="clear:left;"),
dateInput("date", label = "Today's Date")
))
You will find more info about floating div here
I have a vector of values and each value is associated with a name; length of vector changes as per the user input. Although I used table related commands, I like to know other ways to display this kind of data, which is essentially a vector (a single row) of values with names). The problem shows up when selected sample size produces the output that is greater than screen width. Scrolling horizontally allows flexibility to glance over the data, but I am looking for a solution that wraps up the data at the screen width and prints in multiple rows without the need to scroll. Here is the code to play:
ui <- fluidPage(
tabPanel("Test",
numericInput("samsize","specify sample size",4,1,52),
tableOutput('table')
))
server <- function(input, output) {
data <- reactive({
# create a vector of lower- and upper- case alphabets
# create a vector assigning numbers to alphabets
alphabets <- c(letters,LETTERS)
Index <- seq(1,length(alphabets),1)
names(Index) <- alphabets
# sample values
SampleIndex <- sample(Index,input$samsize)
# convert it into a matrix
data <- matrix(SampleIndex,nrow=1)
colnames(data)=names(SampleIndex)
data
})
output$table <- renderTable(data(),digits = 0)
}
shinyApp(ui, server)
As you see in the below picture, for a sample size '36' one need to scroll the page horizontally to see all the values. width in renderTable did not offer any solution Converting data into a html object/text might be one option, but not sure how to retain the names.
You can use renderUI together with uiOutput to create yourself the HTML object you want to display for example using div:
library(shiny)
ui <- fluidPage(
tabPanel("Test",
numericInput("samsize","specify sample size",4,1,52),
uiOutput('myTable')
))
server <- function(input, output) {
data <- reactive({
alphabets <- c(letters,LETTERS)
Index <- seq(1,length(alphabets),1)
names(Index) <- alphabets
# Notice I don't put the vector in a one row matrix as in you example
sample(Index,input$samsize)
})
library(purrr) # map is a nice alternative to lapply
output$myTable <- renderUI(map(names(data()),~div(strong(.),
div(data()[.]),
style="float:left;padding:10px 20px;")))
}
shinyApp(ui, server)
I have a string like this for example:
SomeName SomeValue
A much longer name AnotherValue
Even longer name than before NewValue
Let's say I have this text correctly in a R variable like
variable<-"SomeName SomeValue<br\>A much longer name AnotherValue<br\>Even longer name than before NewValue<br\>
In my ui.R:
...htmlOutput("TextTable")
And in my server.R
output$TextTable<- renderUI({
HTML(variable)
})
But the output isn't the way I want it. All white spaces are deleted except one. So the "columns" aren't as they should be in my output. How can I avoid this?
If I remember correctly, browsers tend to shorten consecutive whitespaces in HTML code to a single character. Don't put the whitespace in your r variable. Store the data as a matrix, and use renderTable.
##server.R
library(shiny)
shinyServer(function(input, output) {
variable = c("SomeName","SomeValue","A much longer name","AnotherValue","Even longer name than before", "NewValue")
variable = matrix(data = variable, ncol = 2)
output$TextTable<- renderTable({variable},include.rownames = FALSE,include.colnames = FALSE)
})
##ui.R
library(shiny)
shinyUI(fluidPage(titlePanel(""),
sidebarLayout(sidebarPanel(),
mainPanel(uiOutput("TextTable")
)
)
))
Update
On the other hand, if your text is already in that format, you can prevent a browser from collapsing whitespace using the <pre> tag. In your case, you could use the following code:
output$TextTable<- renderUI(HTML(paste0("<pre>",variable,"</pre>")))