What are my options to realize text inputs with multiple lines/line breaks (either explicit or just soft-wraps for nicer output in the UI) in shiny?
I'd like to implement an app that has a description/details field and the content being entered will most likely be more than just one line.
Basically, I'm looking for something to realize a similar functionality of the very text input box of stackoverflow I'm writing this question in: line breaks, scroll bar and/or (auto-)adjustment of height.
Example
# UI ---------------------------------------------------------------------
ui <- fluidPage(
p(),
textInput("title", "Title"),
textInput("description", "Description"),
tags$hr(),
h3("Database state"),
DT::dataTableOutput("datatable")
)
# Server ------------------------------------------------------------------
server <- function(input, output, session) {
output$datatable <- DT::renderDataTable(
data.frame(
Title = input$title,
Description = input$description,
stringsAsFactors = FALSE
)
)
}
shinyApp(ui, server)
Try using textAreaInput instead of textInput.
With the former you can set height and width, and it automatically will wrap to next line if line is too long.
Here is where it is mentioned in the docs.
Related
I am trying to create a shiny application to help my coworkers sort, highlight, organize, etc, a load of qualitative data. Basically, I want it to display some narrative text, allow uses to copy/past text or take notes in a text area, and then print those notes to a physical printer. I have managed to create a minimal app which allows users to enter text in a text field, but I cannot figure out how to send the contents to a physical printer
This is as far as I can get...
library(shiny)
library(noteMD)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(
tags$textarea("", id='input_notes', rows =20, style = 'width:100%;'),
actionButton('input_notes', 'Print Notes'))))
server <- function(input, output) {
output$print_notes <- reactive({input$input_notes}) #????????????????
}
shinyApp(ui = ui, server = server)
I ran across the noteMD package, which seems promising, here: https://www.rdocumentation.org/packages/noteMD/versions/0.1.0
I cant seem to get this to work.
Ultimately, I would like to give a clean way for users to print their own notes with one or two clicks.
Here is a simple solution with the library jQuery print:
library(shiny)
ui <- fluidPage(
tags$head(
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jQuery.print/1.6.0/jQuery.print.min.js")
),
textAreaInput("textarea", "Type some text to be printed"),
actionButton("print", "Print", onclick = "$('#textarea').print();")
)
server <- function(input, output){}
shinyApp(ui, server)
However, this also prints the frame of the text area. The following solution only prints the text:
library(shiny)
js <- paste(
"function print(){",
" var content = $('#textarea').val();",
" content = content.replace(/([^>\\r\\n]?)(\\r\\n|\\n\\r|\\r|\\n)/g, '$1' + '</br>' + '$2')",
" var $p = $('<p></p>');",
" $p.html(content);",
" $p.print();",
"}",
sep = "\n"
)
ui <- fluidPage(
tags$head(
tags$script(HTML(js)),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jQuery.print/1.6.0/jQuery.print.min.js")
),
textAreaInput("textarea", "Type some text to be printed"),
actionButton("print", "Print", onclick = "print();")
)
server <- function(input, output){}
shinyApp(ui, server)
I quiet novice to Rshiny. I want to capture the information(variables) entered by the user and pass them to python script, which I would be calling in the R itself. But initially I need help in the server code, where I am not doing something correct in the reactive code part.
My code till now is:
library(shiny)
ui <- fluidPage(
headerPanel(
titlePanel("RADP CR Prediction Tool"),
br(),
tags$head(tags$script(src = "message-handler.js")),
textInput('Region', label = 'Enter the region'),
textInput('Regulatory', label = 'Enter the regulatory status'),
textInput('Description', label = 'Enter the description for the CR'),
br(),
br(),
actionButton("goButton", "Go!"),
mainPanel(
# Output: Formatted text for caption ----
h3(textOutput("caption", container = span)),
# Output: Verbatim text for data summary ----
verbatimTextOutput("summary"),
# Output: HTML table with requested number of observations ----
tableOutput("view")
)
)
server <- function(input, output, session) {
region_input=reactive(input$Region)
regulatory_input <- reactive(input$Regulatory)
description_input <-reactive(input$Description)
observeEvent(input$do, {
session$sendCustomMessage(type = 'testmessage',
message = 'Thank you for clicking')
})
}
shinyApp(ui, server)
When I run the code it gives me Error: unexpected symbol in:
")
server"
I need to use the regulatory_input, description_input and region_input as R variables, so that I can do further analysis.
You're missing a parentheses. You close the mainPanel and the headerPanel but you don't have a close parentheses for the fluidPage function.
You can see this in RStudio by putting the cursor after the ) on line 25, you will see that the open ( in headerPanel( is highlighted. You can also select you code and then hit ctrl I to indent it. You'll see that the server function is "inside" the fluidPage function.
This may seem like a small thing, but paying attention to details like this is critical for programming. In my experience, 9 times out of 10, when something isn't working, its some small thing like this I forgot.
As for the question in your title, the values of your inputs are already in a variable: input$ID_OF_INPUT. Just use that as you would any other variable. There is no reason to copy the value out of it with something like: variable <- reactive({input$id}). Just use input$id wherever you would use variable.
I'm trying to create a shiny app that checks if an email provided in the sidebar is valid (in my case I authenticate directly to an API but in the code below I just create a toy example). I know that I can generate warnings and errors for inputs using validate and need (already read the shiny site on the topic here) but on most examples the errors and warnings are shown in the mainPanel() when generating a plot or something a like.
In my case, the main layout is only static text. What I'm trying to achieve is simple: the user inputs an email I check it, if it doesn't comply I generate some warning/error but it is shown somewhere else other than the mainPanel() because in my case there's no dynamic mainPanel.
Below is an example of what I'm trying to achieve.
library(shiny)
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("email", "Email")
),
mainPanel()
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$email <-
renderUI({
validate(need(input$email == "",
"Introduce your email"))
validate(need(grep("gmail", input$email, value = TRUE)),
"Your email is not valid")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Any idea how to achieve this? The error could be shown any where but on the mainPanel.
I am not 100% sure if I understand your question correctly, does the below do what you want? It displays a text message in the sidebar if one of your specified conditions is not met.
Hope this helps!
library(shiny)
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("email", "Email"),
uiOutput('email_text')
),
mainPanel()
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$email_text <-
renderUI({
if(input$email == ""){
return(p("Please add your gmail e-mail address."))
}
if(!grepl("gmail", input$email)){
return(p("Your email is not a gmail e-mail address!"))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Description
I have a textAreaInput box that I want to start with a default value. The user can click 2 actionButtons (Submit & Random Comment). Submit updates the comment from the textAreaInput for further processing (plot, etc.) while Random Comment sends a new random value to textAreaInput (the user may type in the textAreaInput box as well). I almost have it but can't get the app to update textAreaInput's value until the Submit button is pressed.
Question
I want it to be updated when Random Comment is pressed but still allow the user to erase the text box and type their own text. How can I make the app do this?
MWE
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
output$randcomment <- renderUI({
commentUi()
})
comment_value <- reactiveValues(default = 0)
observeEvent(input$submit,{
comment_value$default <- input$randtext
})
renderText(input$randtext)
commentUi <- reactive({
if (comment_value$default == 0) {
com <- stri_rand_lipsum(1)
} else {
com <- stri_rand_lipsum(1)
}
textAreaInput("comment", label = h3("Enter Course Comment"),
value = com, height = '300px', width = '300px')
})
output$commenttext <- renderText({ input$comment })
}
)
I'd approach this a little bit differently. I would use reactiveValues to populate both of the fields, and then use two observeEvents to control the contents of the reactiveValues.
I don't think you need a reactive at all in this situation. reactive is good when you want immediate processing. If you want to maintain control over when the value is processed, use reactiveValues.
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
# Reactive lists -------------------------------------------------------
# setting the initial value of each to the same value.
initial_string <- stri_rand_lipsum(1)
comment_value <- reactiveValues(comment = initial_string,
submit = initial_string)
# Event observers ----------------------------------------------------
observeEvent(input$randtext,
{
comment_value$comment <- stri_rand_lipsum(1)
}
)
# This prevents the comment_value$submit from changing until the
# Submit button is clicked. It changes to the value of the input
# box, which is updated to a random value when the Random Comment
# button is clicked.
observeEvent(input$submit,
{
comment_value$submit <- input$comment
}
)
# Output Components -------------------------------------------------
# Generate the textAreaInput
output$randcomment <- renderUI({
textAreaInput("comment",
label = h3("Enter Course Comment"),
value = comment_value$comment,
height = '300px',
width = '300px')
})
# Generate the submitted text display
output$commenttext <-
renderText({
comment_value$submit
})
}
)
Some comments on your code
I struggled a little with determining what your code was doing. Part of the reason was that your server function was organized a bit chaotically. Your components are
output
reactive list
observer
output (but not assigned to a slot...superfluous)
reactive object
output
I'd recommend grouping your reactives together, your observers together, and your outputs together. If you have truly separate systems, you can break the systems into different sections of code, but have them follow a similar pattern (I would claim that these two boxes are part of the same system)
Your commentUi reactive has a strange if-else construction. It always sets com to a random string. What's more, the if-else construction isn't really necessary because no where in your code do you ever update comment_value$default--it is always 0. It looks like you may have been trying to base this off of an action button at some point, and then concluded (rightly) that that wasn't a great option.
Also, I would advise against building UI components in your reactive objects. You'll find your reactives are much more flexible and useful if they return values and then build any UI components within the render family of functions.
I am trying to reactively display an image from a list in an R shiny application.
I have many .tiff images stored in the "www" directory of my app. They follow the naming convention OHC_130.tiff, OHC_131.tiff, OHC_132.tiff, IHC_133.tiff, Deiter_134.tiff, OHC_135.tiff etc...
I also have a vector containing all of these names
ImgID_Vector <- as.vector(c("OHC_130", "OHC_131", "OHC_132", "IHC_133", "Deiter_134", "OHC_135")
I would like to make a selectable input dropdown list like this where a user can select an image and then click the submit button to make the image appear below. I have set this up for the ui.r but i am not sure how to make it work on the server side.
#ui.r
library(shiny)
library(shinydashboard)
dashboardBody(
tabItems(
tabItem(tabName = "dt",
h2("Select an image"),
fluidRow(
box(title="This is a searchable database of images", solidHeader = TRUE,status = "primary"),
selectInput("input$ImageIDVariable1", label = h4("Enter your image of interest"), choices = (ImgID_Vector), multiple = TRUE),
submitButton("Submit"),
imageOutput("ImageID_Image")
)
)
)
Conceptually I know that on the server side I need to connect the user input from the UI side to the actual image in the "www" folder. I should be able to do this using reactive inputs and renderImage I think. But I am not sure how to write the render image command to achieve the desired result.
#server.r
#This is the data that contains the choices for the dropdown menu
ImgID_Vector <- readRDS("ImgID_Vector.RDS")
shinyServer(function(input, output) {
# This is where I am struggling, with the render image command
output$ImageID_Image <- renderImage({
filename <- normalizePath(file.path('./www',
paste(input$ImageIDVariable1, '.tiff', sep='')))
list(src = filename)
}, deleteFile = FALSE)
}
#This is where I have the reactive input variable
ImageIDVariable1 <- reactive({input$ImageIDVariable1})
})
Thanks for your help!
Hi argument inputId from your selectInput is wrong, it should be "ImageIDVariable1", not input$ImageIDVariable1.
In ui.R :
selectInput(inputId = "ImageIDVariable1", label = h4("Enter your image of interest")
In server.R
input$ImageIDVariable1
Moreover :
You should use this in a script called global.R or at least in ui.R :
ImgID_Vector <- readRDS("ImgID_Vector.RDS")
And you should not use multiple = TRUE because renderImage can only render one image at a time.
And you should put a selected choice by default, if not renderImage will search an image which doesn't exist.