I am trying to build a dynamic shiny app and i would like to generate tabpanel with some contents if a condition is met. I am uploading a dataset and the condition will be on the class() of each variable. Here is a small reproduction and the condition could be even/odd number ( i took this example from a question that was answerd on Stack ) Any help would be deeply appreciated.
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel('Dynamic Tabs'),
sidebarPanel(
numericInput("nTabs", 'No. of Tabs', 5)
),
mainPanel(
uiOutput('mytabs')
)
),
server = function(input, output, session){
output$mytabs = renderUI({
nTabs = input$nTabs
myTabs = lapply(paste('Tab', 1: nTabs), tabPanel)
do.call(tabsetPanel, myTabs)
})
}
))
In the code below I am adding the number of tabpanel only when the number is even.
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel('Dynamic Tabs'),
sidebarPanel(
numericInput("nTabs", 'No. of Tabs', 2)
),
mainPanel(
uiOutput('mytabs')
)
),
server = function(input, output, session){
observe({
if(input$nTabs %% 2 == 0){
output$mytabs = renderUI({
nTabs = isolate(input$nTabs)
myTabs = lapply(paste('Tab', 1: nTabs), tabPanel)
do.call(tabsetPanel, myTabs)
})
}
})
}
))
Hope it helps!
Related
I'm trying to output a table via tableHTML that depends on some input in a Shiny app. In the example below, I want the table to depend on the radio button. I'm getting an error saying "Error: no function to return from, jumping to top level", so it seems it doesn't like my two return-statements. Any ideas how to go about this?
library(shiny)
library(tableHTML)
ui = fluidPage(
fluidRow(
radioButtons("radio", label = h3("Data on/off"),
choices = list("On", "Off"),
selected = "Off"),
tableHTML_output("mytable")
)
)
server = function(input, output) {
output$mytable <- render_tableHTML({
if ((input$radio == "On")) {
return(tableHTML(mtcars))
}
else {
return(NULL)
}
})
}
shinyApp(ui, server)
The above works when replacing tableHTML_output by tableOutput and render_tableHTML by renderTable and removing the tableHMTL() function.
It seems a package related issue.
Since we are dealing with plain html, we can use shiny::htmlOutput.
library(shiny)
library(tableHTML)
ui <- fluidPage(
fluidRow(
radioButtons("radio",
label = h3("Data on/off"),
choices = list("On", "Off"),
selected = "On"
),
htmlOutput("mytable")
)
)
server <- function(input, output) {
html_table <- eventReactive(input$radio, {
table <- if (input$radio == "On") {
tableHTML(mtcars)
}
return(table)
})
output$mytable <- renderText(
html_table()
)
}
shinyApp(ui, server)
Another workaround is to have two render_tableHTML inside an observeEvent like this:
library(shiny)
library(tableHTML)
ui <- fluidPage(
fluidRow(
radioButtons("radio",
label = h3("Data on/off"),
choices = list("On", "Off"),
selected = "Off"
),
tableHTML_output("mytable")
)
)
server <- function(input, output) {
observeEvent(input$radio, {
if (input$radio == "On") {
output$mytable <- render_tableHTML({
tableHTML(mtcars)
})
} else {
output$mytable <- render_tableHTML({
NULL
})
}
})
}
shinyApp(ui, server)
I saw the following code here on StackOverflow. When you enter values into X and Y, the sum is calculated, and the message "X + Y = " is displayed. However, when you reset, the "X + Y = " message still appears from the previous example. How can I clear that message, please?
Here is the code:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id="form",
sidebarLayout(
sidebarPanel(
numericInput("x","X",0),
numericInput("y","Y",0)
),
mainPanel(
br(),
column(width=6,actionButton("calc", "Calculate")),
column(width=6,actionButton("reset", "Reset")),
br(),br(),br(),
textOutput("sum"))
)
))
# Define the server logic
server <- function(input, output) {
output$sum <- renderText({
req(input$calc)
isolate(paste("X + Y =", input$x + input$y))
})
observeEvent(input$reset, {
reset("form")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Please test the following:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id="form",
sidebarLayout(
sidebarPanel(
numericInput("x","X",0),
numericInput("y","Y",0)
),
mainPanel(
br(),
column(width=6,actionButton("calc", "Calculate")),
column(width=6,actionButton("reset", "Reset")),
br(),br(),br(),
textOutput("sum"))
)
))
# Define the server logic
server <- function(input, output) {
values <- reactiveValues()
output$sum <- renderText({
req(values$calc_text)
})
observeEvent(input$calc, {
values$calc_text <- paste("X + Y =", input$x + input$y)
})
observeEvent(input$reset, {
reset("form")
values$calc_text <- ''
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am unsure why you need the isolate() so I've left it out but you can add it back in.
I have a list object that I would like to update with a reactive input. The object has to be a list.
Below is my minimal code. Thanks in advance.
library(shiny)
shinyApp(
ui = fluidPage(
fluidRow(
numericInput("number", "Change number", 10, min = 1, max = 100),
verbatimTextOutput('show')
)
),
server = function(input, output, session) {
QG <- list(a = c(1:10),
b = LETTERS[1:10])
#How to update reactiveVal from reactive input
#QG$a[2] <- input$number
output$show <- renderPrint({
QG$a[2]
})
}
)
Something like this?
library(shiny)
QG <- list(a = c(1:10),b = LETTERS[1:10])
shinyApp(
ui = fluidPage(
fluidRow(
numericInput("number", "Change number", 10, min = 1, max = 100),
verbatimTextOutput('show')
)
),
server = function(input, output, session) {
Values <- reactive({
QG$a[2] <- as.numeric(input$number)
QG
})
output$show <- renderPrint({
Values()
})
}
)
I have a data table with filter enabled and i want to read selected rows from this data table.
input$table_rows_selected works fine if the filter is not applied however once i apply filter on data then correct rowindex is not returned.
ui <- function(id) {
fluidPage(
title = "Job Tracker",
fluidRow(
column(width=6,
selectInput("pickvalue", label = "Pick a Value", choices = unique(iris$Species))
)
),
br(),
fluidRow(
column(12,
DT::dataTableOutput("job_data")
)
),
br(),
fluidRow(
column(12,DT::dataTableOutput("x4"))
)
)
}
server <- function(input, output, session)
{
output$job_data <- DT::renderDataTable({
datatable(iris[iris$Species==input$pickvalue,],selection = "single")
})
output$x4 <- DT::renderDataTable({
s <- input$job_data_rows_selected
datatable(iris[s,])
})
}
To return previously selected row index you can add some reactiveValues to track the index like so, please note that the index is subject to data so if you select index = 4 and switch the data, the index = 4 will be applied to new data:
library(shiny)
library(DT)
ui <- function(id) {
fluidPage(
title = "Job Tracker",
fluidRow(
column(width=6,
selectInput("pickvalue", label = "Pick a Value", choices = unique(iris$Species))
)
),
br(),
fluidRow(
column(12,
DT::dataTableOutput("job_data")
)
),
br(),
fluidRow(
column(12,DT::dataTableOutput("x4"))
)
)
}
server <- function(input, output, session){
v <- reactiveValues()
v$s <- NULL
data <- reactive({
iris[iris$Species==input$pickvalue,]
})
output$job_data <- DT::renderDataTable({
datatable(data(),selection = "single")
})
observe({
if(!is.null(input$job_data_rows_selected)){
v$s <- input$job_data_rows_selected
}
})
output$x4 <- DT::renderDataTable({
datatable(data()[v$s,])
})
}
shinyApp(ui, server)
If you want to keep the index correctly, remove rownames:
data <- reactive({
data <- (iris[iris$Species==input$pickvalue,])
rownames(data) <- NULL
data
})
Is the input$goButton in server.R that is triggered by actionButton supposed to be within an if statement in RStudio Shiny? The example on the Shiny webpage shows:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Click the button"),
sidebarPanel(
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500),
actionButton("goButton", "Go!")
),
mainPanel(
plotOutput("distPlot")
)
))
and
library(shiny)
shinyServer(function(input, output, message) {
output$distPlot <- renderPlot({
# Take a dependency on input$goButton
input$goButton
# Use isolate() to avoid dependency on input$obs
dist <- isolate(rnorm(input$obs))
hist(dist, main=isolate(paste(system(paste("echo", dist[1],"> /tmp/1 && md5sum /tmp/1"),intern=TRUE),collapse='')))
})
})
I have a slightly more complicated routine with more statements that the example above, and the event takes place event before the user clicks on the Go button. It makes me think input$goButton is ignored when one of the statements in the reactive is an R system() call.
Shiny Server v1.1.0.10000
Node.js v0.10.21
packageVersion: 0.10.0
Any ideas?
I this what you want? Whenever the button is pressed it will increase the count + 1 (starting with 0), hence there's and if statement with return() "nothing" if it hasn't been pressed
rm(list = ls())
library(shiny)
runApp(list(ui = pageWithSidebar(
headerPanel("Click the button"),
sidebarPanel(
sliderInput("obs", "Number of observations:",min = 0, max = 1000, value = 500),
actionButton("goButton", "Go!")
),
mainPanel(plotOutput("distPlot"))),
server = function(input, output,session) {
my_data <- reactive({
if(input$goButton == 0)
{
return()
}
isolate({
input$goButton
dist <- isolate(rnorm(input$obs))
hist(dist, main=isolate(paste(system(paste("echo", dist[1],"> /tmp/1 && md5sum /tmp/1"),intern=TRUE),collapse='')))
})
})
output$distPlot <- renderPlot({my_data()
})
}
)
)