I am currently loading the data set in a Shiny App using load function. I would like to know how I can generate it as a kind of load but make it reactive so that I can load one depending on the input that the user chooses.
Another problem is that within the rData the name of the data sets are the same, so when they are loaded they are lost since each time one is loaded the previous one is deleted.
I am looking for something like below.
Thank you
library(shiny)
ui <- fluidPage(
selectInput("data.set", "Select Data Set", c("Data set 1", "Data set 2"), "Data set 1" ),
uiOutput("ui1")
)
server <- function(input, output, session) {
if(input$data.set == "Data set 1"){
load("dataset1.RData")
}else{
load("dataset2.RData")
}
output$ui1 <- renderUI({
tags$div(
sidebarPanel(selectInput("input1", "select var 1", names(data), names(data)),
selectInput("input2", "select var 2", names(data), names(data))),
mainPanel(
plotOutput("plot")
)
)
output$plot <- renderPlot({
plot(data[,c(input$input1, input$input2)])
})
})
}
shinyApp(ui, server)
I think its best if you load the datasets into global namespace and use reactive to switch which one to show:
library(shiny)
ui <- fluidPage(
selectInput("data.set", "Select Data Set", c("Data set 1", "Data set 2"), "Data set 1" ),
uiOutput("ui1")
)
data1 <- mtcars #load("dataset1.RData")
data2 <- iris #load("dataset2.RData")
server <- function(input, output, session) {
data <- eventReactive(input$data.set,{
if(input$data.set == "Data set 1"){
data1
}else{
data2
}
})
output$ui1 <- renderUI({
tags$div(
sidebarPanel(selectInput("input1", "select var 1", names(data()), names(data())),
selectInput("input2", "select var 2", names(data()), names(data()))),
mainPanel(
plotOutput("plot")
)
)
})
output$plot <- renderPlot({
cols <- c(unique(c(input$input1, input$input2)))
plot(data()[,cols])
})
}
shinyApp(ui, server)
Here is a solution using reactive values.
library(shiny)
ui <- fluidPage(
selectInput("data.set", "Select Data Set",
choices = c(`Data set 1` = "dataset1.RData",
`Data set 2` = "dataset2.RData"),
selected = c(`Data set 1` = "dataset1.RData")),
uiOutput("ui1")
)
server <- function(input, output, session) {
r <- reactiveValues(
data = NULL
)
observeEvent(input$data.set, {
data_name <- load(input$data.set)
r$data <- get(data_name)
})
output$ui1 <- renderUI({
tags$div(
sidebarPanel(selectInput("input1", "select var 1", names(r$data)),
selectInput("input2", "select var 2", names(r$data))),
mainPanel(
plotOutput("plot")
)
)
})
output$plot <- renderPlot({
if (input$input1 %in% names(r$data) && input$input2 %in% names(r$data)) {
plot(r$data[,c(input$input1, input$input2)])
}
})
}
shinyApp(ui, server)
Related
I am trying to reference the values of a reactive variable. I have included the code I have so far below. I am referring to "output$var1" below. This app selects the dataset and based on that dataset produces another selectInput to select a variable.
I am able to render the text if I directly type dataset$area (the first variable of the rock dataset). I would like to render something like "dataset$selvar". Is there a way to do this?
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("dataset", label = "Dataset", choices =c("rock","pressure","cars")),
numericInput(inputId = "obs",
label = "Number of observations to view:",
value=10)
),
mainPanel(
verbatimTextOutput("summary"),
tableOutput("table"),
selectInput("inSelect","Select variable", c("Item A", "Item B")),
textOutput("var1")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
datasetInput<-reactive({
switch(input$dataset,
"rock"=rock,
"pressure"=pressure,
"cars"=cars
)
})
output$summary<- renderPrint({
dataset<- datasetInput()
summary(dataset)
})
output$table<- renderTable({
head(datasetInput(), n=input$obs)
})
observe({
dataset<- datasetInput()
varlist<-colnames(dataset)
updateSelectInput(session,"inSelect",
label="Select variable",
choices=varlist,
selected=head(varlist,1)
)
selvar<-updateSelectInput(session,"inSelect",
label="Select variable",
choices=varlist,
selected=head(varlist,1)
)
output$var1<-renderText({
dataset$area
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
When I try dataset$selvar I get "error i ncat: argument 1 (type 'environment') cannot be bandled by 'cat'
Remove the second updateSelectInput from your observer, move your renderText outside of the observer. and inside the renderText use datasetInput()[[input$inSelect]] to display the select column from the selected dataset.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("dataset", label = "Dataset", choices = c("rock", "pressure", "cars")),
numericInput(
inputId = "obs",
label = "Number of observations to view:",
value = 10
)
),
mainPanel(
verbatimTextOutput("summary"),
tableOutput("table"),
selectInput("inSelect", "Select variable", c("Item A", "Item B")),
textOutput("var1")
)
)
)
server <- function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars
)
})
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})
output$table <- renderTable({
head(datasetInput(), n = input$obs)
})
observe({
dataset <- datasetInput()
varlist <- colnames(dataset)
updateSelectInput(session, "inSelect",
label = "Select variable",
choices = varlist,
selected = varlist[[1]]
)
})
output$var1 <- renderText({
datasetInput()[[input$inSelect]]
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:5275
I'm exploring shiny and I'm trying to do some app that does the following:
Let the user choose between two (or more) different data.frames (in my example I use mtcars and iris but I'm planning to use some self-made data.frames.
Select some X and Y variables according to the data.frame selected
Plot a simple x-y scatterplot
Code below:
df_list <- list(cars= mtcars, iris= iris)
ui <- fluidPage(
titlePanel("Simple app"),
sidebarLayout(
sidebarPanel(
selectInput("data", "Choose a database",
choices=ls(df_list), selected=ls(df_list[1])),
selectInput("xcol", "Variable X", names(data)),
selectInput("ycol", "Variable Y", names(data))),
mainPanel(
plotOutput(outputId = "plot")
)
)
)
server <- function(input, output) {
selectedData <- reactive( {
data[, c(data$xcol, data$ycol)]
})
output$plot <- renderPlot({plot(selectedData())})
}
shinyApp(ui, server)
I feel I have two problems. The first one is pretty obvious since I can't make the app displays variables according to the data.frame selected. Second one is that I feel I'm missing something in my server function (I guess that's related with my first problem) so no plot is displayed.
Any help will be much appreciated.
You had a few issues. The following should work.
df_list <- list("mtcars", "iris")
ui <- fluidPage(
titlePanel("Simple app"),
useShinyjs(),
sidebarLayout(
sidebarPanel(
selectInput("data", "Choose a database",
choices=df_list, selected=df_list[[1]]),
selectInput("xcol", "Variable X", c()),
selectInput("ycol", "Variable Y", c())),
mainPanel(
plotOutput(outputId = "plot")
,DTOutput("t1")
)
)
)
server <- function(input, output, session) {
mydata <- eventReactive(input$data, {
get(input$data)
})
observeEvent(input$data, {
req(mydata())
choices <- names(mydata())
updateSelectInput(session,"xcol",choices = choices, selected=choices[1])
updateSelectInput(session,"ycol",choices = choices, selected=choices[2])
}, ignoreNULL = FALSE)
output$t1 <- renderDT({mydata()})
output$plot <- renderPlot({
req(mydata(),input$xcol,input$ycol)
if (is.null(mydata()) | !(input$xcol %in% colnames(mydata())) | !(input$ycol %in% colnames(mydata())) ) {
return(NULL)
} else{
selected_df <- mydata() %>% select(input$xcol, input$ycol)
plot(selected_df)
}
})
}
shinyApp(ui, server)
I'm trying to write a shiny app where I produce a list and add and delete some elements.
I have a module to add somethind to my list.
find_inputUI <- function(id){
ns <- NS(id)
tagList(
sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
actionButton(ns("press"), "Add to queue"))
}
find_input <- function(input, output, session){
queue <- list()
observeEvent(input$press, {
queue_append <- list(input$first, input$second)
queue <<- append(queue, queue_append )})
queue_ret <- eventReactive(input$press,{return(list(queue=queue, add=input$press))})
}
Then I call it twice and connect the 2 different inputs. Now I want to choose the elements to delete but this doesn't work.
source('/cloud/project/Queue/find_input.R')
library(shiny)
ui <- fluidPage(
tagList(tabsetPanel(
tabPanel("INPUT 1",
find_inputUI("input1"),
verbatimTextOutput("test")),
tabPanel("INPUT 2",
find_inputUI("input2")
)
),
actionButton("combine", "Show combined input"),
verbatimTextOutput("combination"),
uiOutput("del")
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
input_manual1 <- callModule(find_input,"input1")
input_manual2 <- callModule(find_input, "input2")
output$test <- renderPrint({input_manual1()$queue})
appended <- eventReactive(input$combine, {
return(append(input_manual1()$queue, input_manual2()$queue))
})
output$combination <- renderPrint({appended()})
output$del <- renderUI({
input$combine
tagList(checkboxGroupInput("delete", "Choose do delete", seq(1:length(appended()))),
actionButton("dodelete", "Delete selected"))
})
observeEvent(input$dodelete,{
appended <<- appended()[-input$delete]
})
}
# Run the application
shinyApp(ui = ui, server = server)
Maybe anybody can tell me what's wrong so far?
Thanks in advance!
Below is an app which seems to work but I'm not sure to understand what your app is intended to do.
In general, prefer reactive values (reactiveVal) instaed of using the non-local assignment <<-.
The code appended <<- appended()[-input$delete] is not correct. It does not replace the output of appended() by its originalvalue minus the input$delete index.
library(shiny)
find_inputUI <- function(id){
ns <- NS(id)
tagList(
sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
actionButton(ns("press"), "Add to queue"))
}
find_input <- function(input, output, session){
queue <- reactiveVal(list())
observeEvent(input$press, {
queue_append <- list(input$first, input$second)
queue(append(queue(), queue_append))
})
queue_ret <- eventReactive(input$press, {
list(queue=queue(), add=input$press)
})
}
ui <- fluidPage(
tagList(tabsetPanel(
tabPanel("INPUT 1",
find_inputUI("input1"),
verbatimTextOutput("test")),
tabPanel("INPUT 2",
find_inputUI("input2")
)
),
actionButton("combine", "Show combined input"),
verbatimTextOutput("combination"),
uiOutput("del")
)
)
server <- function(input, output, session) {
input_manual1 <- callModule(find_input,"input1")
input_manual2 <- callModule(find_input, "input2")
output$test <- renderPrint({input_manual1()$queue})
appended <- reactiveVal(list())
observeEvent(input$combine, {
appended(append(input_manual1()$queue, input_manual2()$queue))
})
output$combination <- renderPrint({appended()})
output$del <- renderUI({
input$combine
tagList(checkboxGroupInput("delete", "Choose do delete", seq_along(appended())),
actionButton("dodelete", "Delete selected"))
})
observeEvent(input$dodelete,{
appended(appended()[-as.integer(input$delete)])
})
}
# Run the application
shinyApp(ui = ui, server = server)
In a Shiny app I create radioButtons dynamically on the server and use renderUI to pass this to the client. Now I have a problem of getting the response of the radioButtons (selected item) back for further processing. Below the stripped down version of my problem.
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test dynamic radio buttons"),
sidebarPanel(
),
mainPanel(
x <- uiOutput('radioTest'),
actionButton('submit', label = "Submit"),
br(),
print(paste("Radiobutton response is:", "reply()")),
textOutput('text')
)
))
server <- shinyServer(
function(input, output) {
output$radioTest <- renderUI({
options <- c("item 1", "item 2", "item 3")
# The options are dynamically generated on the server
radioButtons('reply', 'What item do you select ?', options, selected = character(0))
})
observe({
input$submit
isolate(
output$text <- renderText({
paste("Radiobutton response is:", "reply()" )
})
)
})
}
)
# Run the application
shinyApp(ui = ui, server = server)
Do you want something like the following?
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("test dynamic radio buttons"),
sidebarPanel(
),
mainPanel(
x <- uiOutput('radioTest'),
actionButton('submit', label = "Submit"),
br(),
#print(paste("Radiobutton response is:", "reply")),
textOutput('text')
)
))
server <- shinyServer(
function(input, output) {
output$radioTest <- renderUI({
options <- c("item 1", "item 2", "item 3")
# The options are dynamically generated on the server
radioButtons('reply', 'What item do you select ?', options, selected = character(0))
})
observe({
input$submit
isolate(
output$text <- renderText({
paste("Radiobutton response is:", input$reply )
})
)
})
}
)
# Run the application
shinyApp(ui = ui, server = server)
I user renderTable to show some data. However, sometimes the data table is empty, in which case I'd like to print "No data to show" or something similar. the default by renderTable is to show nothing for empty data. can this be changed? how?
You can use a condition into a renderUi to render either a message or a "tableOutput" (you can't render directly the table)
datas <- data.frame()
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
selectInput("dataset", "Dataset", choices = c("iris", "datas"))
),
mainPanel(
uiOutput("ui")
)
),
server = function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"iris" = iris,
"datas" = datas)
})
output$ui <- renderUI({
if(nrow(datasetInput()) == 0)
return("No data to show")
tableOutput("table")
})
output$table <- renderTable({
head(datasetInput())
})
}
))
I think you are looking for something like validate function.
Using example code provided by Julien:
datas <- data.frame()
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
selectInput("dataset", "Dataset", choices = c("iris", "datas"))
),
mainPanel(
tableOutput('table')
)
),
server = function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"iris" = iris,
"datas" = datas)
})
output$table <- renderTable({
y <- head(datasetInput())
validate(
need(nrow(y) > 0, "No Data to show")
)
y
})
}
))
If you still want to show a "table" within the UI, do this:
output$table_output <- renderTable {
data <- data.frame(a = c(1,2),
b = c(8,9)) #example data.frame
if (nrow(data) > 0) {
data
} else {
datatable(data.frame(Nachricht = "Die ausgewählte Schnittstelle enthält hierfür keine Daten."))
}
}