I am new with Shiny. I have developed a very simple app that modifies a string inserted in a text input after the click of a button. The result appears in a text output present from the beginning. This is my code:
# ui.R
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
textInput("caption", "Caption", "abc"),
actionButton("btn_input", "Enter"),
verbatimTextOutput("value")
)
# server.R
library(shiny)
library(shinyjs)
server <- function(input, output) {
output$value <- reactive({
# toggle(id="caption")
input$btn_input
v <- isolate({input$caption})
if (v == "xxx") {
value <- paste(v, "a")
} else {
value <- paste(v, "b")
}
value
})
}
I would like the text output to appear only after clicking the button.
At the same time I would like the caption, the text input and the button to disappear after clicking the button.
What is the easiest way to make this change? Thanks in advance.
I think conditionalPanel is the easiest way:
library(shiny)
ui <- fluidPage(
conditionalPanel(
"input.btn_input === 0",
textInput("caption", "Caption", "abc"),
actionButton("btn_input", "Enter")
),
conditionalPanel(
"input.btn_input !== 0",
style = "display: none;",
verbatimTextOutput("value")
)
)
server <- function(input, output) {
Value <- eventReactive(input$btn_input, {
v <- input$caption
if (v == "xxx") {
paste(v, "a")
} else {
paste(v, "b")
}
})
output$value <- renderPrint({
Value()
})
}
shinyApp(ui, server)
If you want a "Back" button, as asked in your comment, you can proceed as follows:
library(shiny)
ui <- fluidPage(
conditionalPanel(
"output.show_input",
textInput("caption", "Caption", "abc"),
actionButton("btn_input", "Enter")
),
conditionalPanel(
"output.show_output",
style = "display: none;",
verbatimTextOutput("value"),
actionButton("btn_back", "Back")
)
)
server <- function(input, output) {
ShowInput <- reactiveVal(TRUE)
output$show_input <- reactive({
ShowInput()
})
outputOptions(output, "show_input", suspendWhenHidden = FALSE)
ShowOutput <- reactiveVal(FALSE)
output$show_output <- reactive({
ShowOutput()
})
outputOptions(output, "show_output", suspendWhenHidden = FALSE)
observeEvent(input$btn_input, {
ShowInput(FALSE)
ShowOutput(TRUE)
})
observeEvent(input$btn_back, {
ShowInput(TRUE)
ShowOutput(FALSE)
})
Value <- eventReactive(input$btn_input, {
v <- input$caption
if (v == "xxx") {
paste(v, "a")
} else {
paste(v, "b")
}
})
output$value <- renderPrint({
Value()
})
}
shinyApp(ui, server)
...
# output$value <- reactive({
output$value <- eventReactive(input$btn_input, {
...
I created a shiny app which has two buttons as you can see in the following screenshot. I want to display 8 images which I have in this folder in the shiny app after I click the "Show Images" button. I tried using renderImages but couldn't get it to work.
Here is the code I have so far:
ui.R
fluidPage(
# Application title
titlePanel("For Fun!!"),
hr(),
sidebarLayout(
# Sidebar with a slider and selection inputs
sidebarPanel(
actionButton("update", "Print Text"),
hr(),
actionButton("test", "Show Images")
),
mainPanel(
verbatimTextOutput("plot"),
uiOutput("images")
)
)
)
server.r
server <- function(input, output) {
randomVals <- eventReactive(input$update, {
myString="Hello!"
myString
})
output$plot <- renderPrint({
myString=randomVals()
print(myString)
})
}
This is what I'm looking for as an output:
Thanks for your time
Try it like this.
library(shiny)
server <- shinyServer(function(input, output) {
output$files <- renderTable(input$files)
files <- reactive({
files <- input$files
files$datapath <- gsub("\\\\", "/", files$datapath)
files
})
output$images <- renderUI({
if(is.null(input$files)) return(NULL)
image_output_list <-
lapply(1:nrow(files()),
function(i)
{
imagename = paste0("image", i)
imageOutput(imagename)
})
do.call(tagList, image_output_list)
})
observe({
if(is.null(input$files)) return(NULL)
for (i in 1:nrow(files()))
{
print(i)
local({
my_i <- i
imagename = paste0("image", my_i)
print(imagename)
output[[imagename]] <-
renderImage({
list(src = files()$datapath[my_i],
alt = "Image failed to render")
}, deleteFile = FALSE)
})
}
})
})
ui <- shinyUI(fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput(inputId = 'files',
label = 'Select an Image',
multiple = TRUE,
accept=c('image/png', 'image/jpeg'))
),
mainPanel(
tableOutput('files'),
uiOutput('images')
)
)
))
shinyApp(ui=ui,server=server)
I am building a shiny app and I want to refresh the main panel screen. Here is a sample code. I have a submit button to display the data and I have a re-fresh button to clear the screen. I am not so sure how to code the re-fresh button in R and shiny since I am new to this. Thanks for looking into
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10),
actionButton("submit1" ,"Submit", icon("refresh"),
class = "btn btn-primary"),
actionButton("refresh1" ,"Refresh", icon("refresh"),
class = "btn btn-primary")
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
observeEvent(input$submit1, {
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
tagList(lapply(1:10, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)
You could add the possibility of return nothing from the renderUI() if the refresh button is used.
As it is not that straightforward to reset an action button you would have to use a workaround with a reactive variable.
if(global$refresh) return()
This reactive variable you can control with the refresh and submit button
E.g. if(input$refresh1) isolate(global$refresh <- TRUE)
which you wrap in seperate observe functions.
Full code see below:
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10),
actionButton("submit1" ,"Submit", icon("refresh"),
class = "btn btn-primary"),
actionButton("refresh1" ,"Refresh", icon("refresh"),
class = "btn btn-primary")
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
global <- reactiveValues(refresh = FALSE)
observe({
if(input$refresh1) isolate(global$refresh <- TRUE)
})
observe({
if(input$submit1) isolate(global$refresh <- FALSE)
})
observeEvent(input$submit1, {
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
if(global$refresh) return()
tagList(lapply(1:10, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)
I'm trying to use lapply to create multiple tabs in a tabsetPanel in Shiny based on this example: http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html. Below is my app.R code. When I run it, it doesn't create 5 tabs, nor does it print the name of each tab. What am I doing wrong?
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(),
mainPanel(
tabsetPanel(id='t',
lapply(1:5, function(i) {
tabPanel(
title=paste0('tab', i),
textOutput(paste0('a',i))
)
})
)
)
)
server <- function(input, output) {
observe({
print(input$t)
})
lapply(1:5, function(j) {
output[[paste0('a',j)]] <- renderPrint({
input$t
})
})
}
shinyApp(ui, server)
It's a bit tricky, because tabsetPanel does not accept a list of tabset as an argument. You can use do.call to "unlist" arguments:
mainPanel(
do.call(tabsetPanel, c(id='t',lapply(1:5, function(i) {
tabPanel(
title=paste0('tab', i),
textOutput(paste0('a',i))
)
})))
)
stack.app <- function(n = 5){
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(
verbatimTextOutput("show_selected")
),
mainPanel(
uiOutput('my_tabs')
)
)
server <- function(input, output, session) {
output$my_tabs <- renderUI({
### Had to hicjack this from shiny to get it to work...
shiny:::buildTabset(
id = "t",
lapply(1:n, function(i){
tabPanel(title = sprintf("tt_%s",i),
HTML(sprintf("This is tab %s content", i))
)
}), paste0("nav nav-","tabs")) %>% (function(x){
tags$div(class = "tabbable", x[[1]], x[[2]])
})
})
output$show_selected <- renderPrint({
sprintf("SELECTED TAB IS : %s", input$t)
})
}
shinyApp(ui, server)
}
Which results in:
I have the following web application example:
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Add Features"),
sidebarPanel(width=4,
fluidRow(column(12,
h3('Features'),
uiOutput('uiOutpt')
)), # END fluidRow
fluidRow(
column(4,div()),
column(4,actionButton("add", "Add!")),
column(4,actionButton("remove", "Remove!")),
column(4,actionButton('goButton',"Analyze"))
) # END fluidRow
), # END sidebarPanel
mainPanel(
textOutput("text2"),
tableOutput('tbl')
)
))
server <- shinyServer(function(input, output) {
features <- reactiveValues(renderd=c(1),
conv=c(50),
inlabels=c('A'),
outlabels=c('B'))
df <- eventReactive(input$goButton, {
out <- lapply(features$renderd,function(i){
fv <- paste0('numInp_',i)
vn <- paste0('InLabel',i)
data.frame(Variable=input[[vn]], Value=input[[fv]] )
})
do.call(rbind,out)
})
output$nText <- renderText({
ntext()
})
output$text2 <- renderText({
paste(sprintf("You have selected feature: %s", paste(features$renderd,collapse=", ")))
})
output$tbl <- renderTable({
df()
})
# Increment reactive values array used to store how may rows we have rendered
observeEvent(input$add,{
out <- lapply(features$renderd,function(i){
fv <- paste0('numInp_',i)
vn <- paste0('InLabel',i)
vo <- paste0('OutLabel',i)
data.frame(inlabels=input[[vn]],outlabels=input[[vo]], conv=input[[fv]] )
})
df<-do.call(rbind,out)
print(df)
features$inlabels <- c(as.character(df$inlabels),' ')
features$outlabels <- c(as.character(df$outlabels),' ')
print(c(features$inlabels,features$outlabels))
features$renderd <- c(features$renderd, length(features$renderd)+1)
print(features$renderd)
print(names(features))
features$conv<-c(df$conv,51-length(features$renderd))
})
observeEvent(input$remove,{
features$renderd <- features$renderd[-length(features$renderd)]
})
# If reactive vector updated we render the UI again
observe({
output$uiOutpt <- renderUI({
# Create rows
rows <- lapply(features$renderd,function(i){
fluidRow(
# duplicate choices make selectize poop the bed, use unique():
column(4, selectizeInput(paste0('InLabel',i),
label = 'Input Name',selected=features$inlabels[i-1],
choices=unique(c(features$inlabels[i-1],features$outlabels[!features$outlabels %in% features$inlabels])),
options = list(create = TRUE))),
column(4, sliderInput(paste0('numInp_',i), label="Conversion",min = 0, max = 100, value = features$conv[i-1])),
column(4, selectizeInput(paste0('OutLabel',i),
label = "Output Name", selected=features$outlabels[i-1],
choices=unique(c(features$inlabels,features$outlabels)),
options = list(create = TRUE)))
)
})
do.call(shiny::tagList,rows)
})
})
})
shinyApp(ui=ui,server=server)
The problem is that each time, when we add a new fluidRow by clicking on the buton "add", the chosen values in the previous fluidRow are refreshed. I would like to change that. If I chose for instance, inputName='B', Conversion=50, outputName='A', I would like them to be constant even thought I have add or delete rows.
I have tried this but it didn't work:
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Add Features"),
sidebarPanel(width=4,
fluidRow(column(12,
h3('Features'),
uiOutput('uiOutpt')
)), # END fluidRow
fluidRow(
column(4,div()),
column(4,actionButton("add", "Add!")),
column(4,actionButton("remove", "Remove!")),
column(4,actionButton('goButton',"Analyze"))
) # END fluidRow
), # END sidebarPanel
mainPanel(
textOutput("text2"),
tableOutput('tbl')
)
))
server <- shinyServer(function(input, output) {
features <- reactiveValues(renderd=c(1),
conv=c(50),
inlabels=c('A'),
outlabels=c('B'))
df <- eventReactive(input$goButton, {
out <- lapply(features$renderd,function(i){
fv <- paste0('numInp_',i)
vn <- paste0('InLabel',i)
data.frame(Variable=input[[vn]], Value=input[[fv]] )
})
do.call(rbind,out)
})
output$nText <- renderText({
ntext()
})
output$text2 <- renderText({
paste(sprintf("You have selected feature: %s", paste(features$renderd,collapse=", ")))
})
output$tbl <- renderTable({
df()
})
# Increment reactive values array used to store how may rows we have rendered
observeEvent(input$add,{
out <- lapply(features$renderd,function(i){
fv <- paste0('numInp_',i)
vn <- paste0('InLabel',i)
vo <- paste0('OutLabel',i)
data.frame(inlabels=input[[vn]],outlabels=input[[vo]], conv=input[[fv]] )
})
df<-do.call(rbind,out)
print(df)
features$inlabels <- c(as.character(df$inlabels),' ')
features$outlabels <- c(as.character(df$outlabels),' ')
print(c(features$inlabels,features$outlabels))
features$renderd <- c(features$renderd, length(features$renderd)+1)
print(features$renderd)
print(names(features))
features$conv<-c(df$conv,51-length(features$renderd))
})
observeEvent(input$remove,{
features$renderd <- features$renderd[-length(features$renderd)]
})
# If reactive vector updated we render the UI again
observe({
output$uiOutpt <- renderUI({
# Create rows
rows <- lapply(features$renderd,function(i){
fluidRow(
# duplicate choices make selectize poop the bed, use unique():
column(4, selectizeInput(paste0('InLabel',i),
label = 'Input Name',selected=features$inlabels[i],
choices=c('A','B','C'),
options = list(create = TRUE))),
column(4, sliderInput(paste0('numInp_',i), label="Conversion",min = 0, max = 100, value = features$conv[i])),
column(4, selectizeInput(paste0('OutLabel',i),
label = "Output Name", selected=features$outlabels[i],
choices=c('A','B','C'),
options = list(create = TRUE)))
)
})
do.call(shiny::tagList,rows)
})
})
})
shinyApp(ui=ui,server=server)
I am sure that it's very easy to figure it out but I have no idea.
Thank you for your response.
I have found the answer of my question. I think that it could be useful for someone that's why I post the follwing example:
library(shiny)
ui <- shinyUI(
fluidPage(
actionButton("addFilter", "Add filter", icon=icon("plus", class=NULL, lib="font-awesome")),
uiOutput("filterPage1")
)
)
server <- function(input, output){
i <- 0
observeEvent(input$addFilter, {
i <<- i + 1
output[[paste("filterPage",i,sep="")]] = renderUI({
list(
fluidPage(
fluidRow(
column(6, selectInput(paste("filteringFactor",i,sep=""), "Choose factor to filter by:",
choices=c("factor A", "factor B", "factor C"), selected="factor B",
width="100%")),
column(6, actionButton(paste("removeFactor",i,sep=""), "",
icon=icon("times", class = NULL, lib = "font-awesome"),
onclick = paste0("Shiny.onInputChange('remove', ", i, ")")))
)
),
uiOutput(paste("filterPage",i + 1,sep=""))
)
})
})
observeEvent(input$remove, {
i <- input$remove
output[[paste("filterPage",i,sep="")]] <- renderUI({uiOutput(paste("filterPage",i + 1,sep=""))})
})
}
shinyApp(ui, server)
Have a nice day.