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.
Related
I am relatively new to shiny app and is trying to make a simple app : while i am able to run ui.R correctly, i am having problem with server.R......what i want is to take a value of slider bar "post" (this number will be used as arg. of function "wbpg"),select the type of plot from dropdown menu and plot the corresponding variable when action button "RUN" is pushed.....all the results and plots are saved when a function named "wbpg(x)" (where "x" is the value of slider bar)...when wbpg(x) is run it returns plots(this contains list of all the plots in drop down menu)
#UI.R
shinyUI( fluidPage(
titlePanel(title=h4("Text Mining on thread",align="centre")),
sidebarLayout(
sidebarPanel(
sliderInput("post","1. Choose no. of posts you want to run the model",value = 1, min = 1, max = 30000),
br(),
selectInput("plotvar","2. Select the variable you want to plot",choices=c("raw_dat"=1,"content"=2,"barplot"=3,"genderplot"=4,"girlplot"=5,"rawplot"=6,"adjplot"=7,
"drinkplot"=8,"damageplot"=9,"songplot"=10,"sentimentplot"=11)),
br(),
actionButton(inputId="act",label = "RUN!")
),
mainPanel(
textOutput("out"),
#tableOutput("tab"),
plotOutput("hist1")
)
)
))
this is server file, where the problem exists:
#server.R
shinyServer(function(input, output) {
#observeEvent(input$action,wbpage(as.numeric(input$post)))
#output$data<-renderPrint({str(get(content))})
observeEvent(input$act,{wbpg(np)})
output$out<-renderText(paste("No. of posts mined: ",input$post))
#defaul<-reactiveValues(data=wbpage(3000))
np<-wbpage(as.numeric(input$post))
output$hist1 <- renderPlot({barplot})
})
#output$hist1 <-
#renderPlot({
#plots$barplot
#output$tab<-
# renderTable({
# head(data())
#})
#output$hist2 <- renderPlot({
#hist(rnorm(input$num))
#raunchyplot
#})
#})
Without having access to your function (wbpg), let me try to help you with the values returned from the 'observeEvent' call. I think your problem is the placement of the '})' on the line with 'observeEvent'. Everything you want to happen upon clicking the 'Run' button needs to be within the '})'. If this isn't what you need, please restate the question.
In place of your 'observeEvent' command, use the following code to see the data returned every time you click on the 'Run' button. It shows the value of the slider bar and the number from the drop down menu.
observeEvent(input$act,{
print (paste(input$post,input$plotvar,sep=' '))
})
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.
This is my day one with R shiny and I'm trying to figure out the following question: assuming that I have a root directory like
/usr/data/
This directory might contain some folders (A,B,C,...) where each folder has contains some files (no folders within them and just files). I am planning to create a dropdown menue based on another dropdown menu. The use select a folder name from the list and the second dropdown menu is automatically loaded with the file names within that folder. For example if folder A is selected and it contains File1 and File2 then the second dropdown will contain those two. This is how I'm doing it right now:
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("This is a test app"),
sidebarLayout(
sidebarPanel(
uiOutput("Box1"),
uiOutput("Box2")
),
mainPanel("Display results",
tableOutput("view"))
)
))
server.R
library(shiny)
biz = data.frame(
Folder = c("A", "A", "B" , "B"),
Filename = c("File1","File2","File3","File4"),
stringsAsFactors = FALSE
)
shinyServer(function(input, output) {
output$Box1 = renderUI(selectInput("folder","Select directory",c("None",unique(biz$Folder)),"None"))
output$Box2 = renderUI(
if (is.null(input$folder) || input$folder == "None"){return()
}else selectInput("filename",
"Select dataset",
c("None",unique(biz$Filename[which(biz$Folder == input$folder)])),
"None")
)
subdata1 = reactive(biz[which(biz$Folder == input$folder),])
subdata2 = reactive(subdata1()[which(subdata1()$Filename == input$filename),])
output$view = renderTable({
if(is.null(input$folder) || is.null(input$filename)){return()
} else if (input$folder == "None" || input$filename == "None"){return()
} else return(subdata2())
})
})
As you can see, I'm using a dataframe to take care of that but this should better be dynamic in case that the content of those folders change. So I think the best way is to have list of folder names and then get the contents of that folder and load them in to the second dropdown. I have tried several posts on SO but they are mostly about the content of a csv file and so on. Any help would be much appreciated.
Thanks
I recommend generating UI elements reactively in the following way:
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("My Great File Selector"),
fluidRow(
sidebarPanel(
uiOutput("select.folder"),
uiOutput('select.file')
)
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
root <- '~'
output$select.folder <-
renderUI(expr = selectInput(inputId = 'folder.name',
label = 'Folder Name',
choices = list.dirs(path = root,
full.names = FALSE,
recursive = FALSE)))
output$select.file <-
renderUI(expr = selectInput(inputId = 'file.name',
label = 'File Name',
choices = list.files(path = file.path(root,
input$folder.name))))
})
All I have done in ui.R is essentially promise that I will render two UI elements named 'select.folder' and 'select.file' in server.R. That's pretty simple.
In server.R, I specify root, where I want the app to look for directories.
I use renderUI() to generate a UI element in which the user will select the folder and store it in output$select.folder, fulfilling my first promise in ui.R, give it a label of 'Folder Name', and set its choices to the result of list.dirs() (from base R) called with the appropriate arguments. The choice that the user has selected in this UI element will be accessible via input$folder.name because the InputId is 'folder.name'.
I use renderUI() again to generate a UI element that will be used to select a file in that folder and store it in output$select.file, fulfilling my second promise from ui.R. Its choices are based on a call to list.files that uses the folder selected in the first UI element, retrieving it via `input$folder.name'.
You can get the names of the files in a folder with the list.files function.
So something like this should work:
ROOT <- '/usr/data'
dropdown_options <- list.files(paste(ROOT, input$folder, sep = '/'))
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.
In shiny, how do you use tagList inside renderUI to create multiple widgets customized with data from an uploaded file? This idea is referenced here, but there doesn't appear to be very good documentation for tagList.
I plan to answer my own question here. I did a bit of research, found that a simple example of this process was lacking, and felt a desire to contribute it so that others might benefit.
In server.R, define an object using a reactive() statement to hold the contents of the uploaded file. Then, in a renderUI statement, wrap a comma-delimited list of widget definitions in a tagList function. In each widget, use the object holding the contents of the uploaded file for the widget parameters. The example below, hosted at shinyapps.io and available on github, creates a checkBoxGroupInput and a radioButtons widget using a singer renderUI that is defined based on an uploaded file.
server.R
library(shiny)
shinyServer(function(input, output) {
ItemList = reactive(
if(is.null(input$CheckListFile)){return()
} else {d2 = read.csv(input$CheckListFile$datapath)
return(as.character(d2[,1]))}
)
output$CustomCheckList <- renderUI({
if(is.null(ItemList())){return ()
} else tagList(
checkboxGroupInput(inputId = "SelectItems",
label = "Which items would you like to select?",
choices = ItemList()),
radioButtons("RadioItems",
label = "Pick One",
choices = ItemList(),
selected = 1)
)
})
})
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Create a checkboxGroupInput and a RadioButtons widget from a CSV"),
sidebarLayout(
sidebarPanel(fileInput(inputId = "CheckListFile", label = "Upload list of options")),
mainPanel(uiOutput("CustomCheckList")
)
)
))