selectInput based on columns of uploading csv file - r

I am trying to build a shiny app where I can upload a csv file and based on the column names, from selectInput - app shows basic statistic (graphs, descriptive statistic-average, sd, var .... and some statistical tests).
There is no problem with datasets, which are already in the app. Also no problem with statistics.
Problem is how to make working selectInput with the names of columns from new upload csv file.
Here is my light version of code:
UI:
library(shiny)
shinyUI(fluidPage(
titlePanel("xxx"),
sidebarLayout(
sidebarPanel(
fileInput("csvFile", "Drag cars.csv over here!"),
selectInput("var", "choose variable:", choices= names(data()))
),
mainPanel(
textOutput("average"),
plotOutput("plot")
)
)
))
SERVER:
shinyServer(function(input, output, session) {
data <- reactive({
file1 <- input$csvFile
if (is.null(file1)) {
return()
}
data = read.csv(file=file1$datapath)
data
})
output$average <- renderText({
paste("average is: ", mean(data()[,input$var]))
})
output$plot <- renderPlot({
boxplot(data()[,input$var])
})
})

You will need to use uiOutput() and renderUI() functions.
library(shiny)
ui <- fluidPage(
titlePanel("xxx"),
sidebarLayout(
sidebarPanel(
fileInput("csvFile", "Drag cars.csv over here!"),
uiOutput("var_ui")
),
mainPanel(
textOutput("average"),
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
data <- reactive({
file1 <- input$csvFile
if (is.null(file1)) {
return()
}
data = read.csv(file=file1$datapath)
data
})
output$average <- renderText({
paste("average is: ", mean(data()[,input$var]))
})
output$plot <- renderPlot({
boxplot(data()[,input$var])
})
output$var_ui <- renderUI({
selectInput("var", "choose variable:", choices= names(data()))
})
}
shinyApp(ui, server)

You can also use observe in server. observe does not return anything. Unlike reactive, it responds immediately (and not lazily). It's best used for ip/op operations.
observe({
updateSelectInput(
session,
"var",
choices = names(data())
)
)}

Related

How to select variables from different data.frames in shiny?

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)

How to update the choices in a Shiny selectInput after loading a file? [duplicate]

I have a Shiny app that includes a number of dropdown selection boxes, the values of which are filled from reading an RDS file. The app also includes a fileInput function to upload new data. How can I change the values in the dropdown boxes to reflect the new data? Currently I can see that the data is uploaded, but the old data remains in the dropdown.
The data that should be uploaded is saved to a file using
saveRDS( data.frame(names=c("Jill","Jane","Megan")),"myDataFrame.rds")
In my app.R file, I first define the 'default' value of the data:
myDataFrame <- data.frame(names=c("Tom","Dick","Harry"))
The content of my app.R is as follows:
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput('file1', 'Choose file to upload',accept = ".rds"),
selectInput("myNames","Names",myDataFrame$names),
tableOutput('contents')
)
)
server <- shinyServer(function(input, output) {
output$contents <- renderTable({
inFile <- input$file1
if (is.null(inFile)) { return(myDataFrame) }
readRDS(inFile$datapath)
})
})
The initial view of the application is as expected: both the dropdown and the table contain the 'default' names. Upon upload of my RDS file containing a new dataframe, the table changes (which is what I was looking for) but the dropdown values do not. How can I make the latter happen?
I added reactive object myData that you have to use for table contents, but more importantly to update choices in selectInput (check observe and updateSelectInput part).
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
myData <- reactive({
inFile <- input$file1
if (is.null(inFile)) {
d <- myDataFrame
} else {
d <- readRDS(inFile$datapath)
}
d
})
output$contents <- renderTable({
myData()
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = myData()$names,
selected = myData()$names[1])
})
}
shinyApp(ui, server)
to riff off of #PoGibas' answer, I needed to load multiple list values for an app, here is a similar application using reactiveValues and observeEvent :
library(shiny)
# save a dummy RDS for loading
saveRDS(list(names=LETTERS,numbers=seq(10)),'dummy.rds')
# define initial values
myDataList <- list(names=c("Tom","Dick","Harry"), numbers=seq(5))
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
selectInput("myNumbers","Numbers", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
md <- reactiveValues(
names = myDataList$names,
numbers = myDataList$numbers
)
observeEvent(input$file1,{
d <- readRDS(input$file1$datapath)
for (n in names(d)){
md[[n]] <- d[[n]]
}
})
output$contents <- renderTable({
data.frame(data = c(md$names,md$numbers))
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = md$names,
selected = md$names[1])
updateSelectInput(session, "myNumbers",
label = "myNumbers",
choices = md$numbers,
selected = md$numbers[1])
})
}
shinyApp(ui, server)

Gives Error:object of type 'closure' is not subsettable after using reactive function [duplicate]

I have a Shiny app that includes a number of dropdown selection boxes, the values of which are filled from reading an RDS file. The app also includes a fileInput function to upload new data. How can I change the values in the dropdown boxes to reflect the new data? Currently I can see that the data is uploaded, but the old data remains in the dropdown.
The data that should be uploaded is saved to a file using
saveRDS( data.frame(names=c("Jill","Jane","Megan")),"myDataFrame.rds")
In my app.R file, I first define the 'default' value of the data:
myDataFrame <- data.frame(names=c("Tom","Dick","Harry"))
The content of my app.R is as follows:
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput('file1', 'Choose file to upload',accept = ".rds"),
selectInput("myNames","Names",myDataFrame$names),
tableOutput('contents')
)
)
server <- shinyServer(function(input, output) {
output$contents <- renderTable({
inFile <- input$file1
if (is.null(inFile)) { return(myDataFrame) }
readRDS(inFile$datapath)
})
})
The initial view of the application is as expected: both the dropdown and the table contain the 'default' names. Upon upload of my RDS file containing a new dataframe, the table changes (which is what I was looking for) but the dropdown values do not. How can I make the latter happen?
I added reactive object myData that you have to use for table contents, but more importantly to update choices in selectInput (check observe and updateSelectInput part).
library(shiny)
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
myData <- reactive({
inFile <- input$file1
if (is.null(inFile)) {
d <- myDataFrame
} else {
d <- readRDS(inFile$datapath)
}
d
})
output$contents <- renderTable({
myData()
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = myData()$names,
selected = myData()$names[1])
})
}
shinyApp(ui, server)
to riff off of #PoGibas' answer, I needed to load multiple list values for an app, here is a similar application using reactiveValues and observeEvent :
library(shiny)
# save a dummy RDS for loading
saveRDS(list(names=LETTERS,numbers=seq(10)),'dummy.rds')
# define initial values
myDataList <- list(names=c("Tom","Dick","Harry"), numbers=seq(5))
ui <- shinyUI(
fluidPage(
fileInput("file1", "Choose file to upload", accept = ".rds"),
selectInput("myNames","Names", ""),
selectInput("myNumbers","Numbers", ""),
tableOutput("contents")
)
)
server <- function(input, output, session) {
md <- reactiveValues(
names = myDataList$names,
numbers = myDataList$numbers
)
observeEvent(input$file1,{
d <- readRDS(input$file1$datapath)
for (n in names(d)){
md[[n]] <- d[[n]]
}
})
output$contents <- renderTable({
data.frame(data = c(md$names,md$numbers))
})
observe({
updateSelectInput(session, "myNames",
label = "myNames",
choices = md$names,
selected = md$names[1])
updateSelectInput(session, "myNumbers",
label = "myNumbers",
choices = md$numbers,
selected = md$numbers[1])
})
}
shinyApp(ui, server)

Perform multiple actions on actioButton Shiny

I am pretty new to Shiny and dealing with the following problem, upon pressing an actionButton in shiny, I want it to do multiple calculations. I use the handler of observeEvent.
An example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(`
actionButton("calc","calculate stuff")),
mainPanel(
textOutput("result")
)
)
)
server <- function(input,output){
observeEvent(input$calc, {output$result <- renderText({"only this is not enough"}) })
}
shinyApp(ui,server')`
Now what I would want is where the output$result is made in the server-observeEvent, I would like to perform additional tasks, say assign a variable a <- 12, calculate B4 <- input$ID1*inputID2 etc.
This can not be hard I imagine.. but I am just not getting there.
kind regards,
Pieter
You can use isolate, see this example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId = 'x', label = 'Select a value for x', value = 1),
actionButton( "calc", "calculate stuff" )
),
mainPanel(
textOutput("result")
)
)
)
server <- function(input, output) {
output$result <- renderText({
input$calc
isolate({
y<- input$x *2
paste("The result is:", y)
})
})
}
shinyApp(ui, server)

I am new to shiny and I am trying to put a simple app together using the iris data set, which is a package in R:

I get the following error:
Error in $.shinyoutput(*tmp*, X) :
Reading objects from shinyoutput object not allowed
when using the scripts below. ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Dynamic user interface-RenderUI"),
sidebarLayout(
sidebarPanel(
selectInput("data", "Select the Database of your choice",
c("iris"="Iris","mtcars"="mt","trees"="tree")),
br(),
helpText("The folowing SelectInput drop down choices are dynamically polulated based on dataset selected"),
br(),
uiOutput("X-Axis"),#X-Axis is coming from renderui inserver
br(),
uiOutput("Y-Axis")#Y-Axis is coming from renderui inserver
),
mainPanel(
plotOutput("p")
)
)
))
and server.R
library(shiny)
shinyServer(function(input, output) {
var <-reactive({
switch(input$data,
"iris"=names(iris),
"mtcars"=names(mtcars),
"trees"=names(trees)
)
})
output$X-Axis <- renderUI({
selectInput("x-axis", "Select the X-Axis variable",choices = var())
})
output$Y-Axis <- renderUI({
selectInput("y-axis", "Select the Y-Axis variable",choices = var())
})
output$p <- renderPlot({
attach(get(input$data))
plot(x=get(input$x-axis),y=get(input$y-axis),xlab =input$x-axis,ylab = input$y-axis )
})
})
You are using inappropriate names. If you use names such as x-axis you will need to refer to them as input$'x-axis' or maybe easier input[["x-axis"]]. In your selectInput your names are your objects and vice versa.
# UI.r
library(shiny)
shinyUI(fluidPage(
titlePanel("Dynamic user interface-RenderUI"),
sidebarLayout(
sidebarPanel(
selectInput("data", "Select the Database of your choice",
c("Iris"="iris","mt"="mtcars","tree"="trees")),
br(),
helpText("The folowing SelectInput drop down choices are dynamically polulated based on dataset selected"),
br(),
uiOutput("X-Axis"),#X-Axis is coming from renderui inserver
br(),
uiOutput("Y-Axis")#Y-Axis is coming from renderui inserver
),
mainPanel(
plotOutput("p")
)
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
var <-reactive({
switch(input$data,
"iris"=names(iris),
"mtcars"=names(mtcars),
"trees"=names(trees)
)
})
output[["X-Axis"]] <- renderUI({
selectInput("x-axis", "Select the X-Axis variable",choices = var())
})
output[["Y-Axis"]] <- renderUI({
selectInput("y-axis", "Select the Y-Axis variable",choices = var())
})
output$p <- renderPlot({
attach(get(input$data))
plot(x=get(input[["x-axis"]]),y=get(input[["y-axis"]]),xlab =input[["x-axis"]],ylab = input[["y-axis"]] )
})
})

Resources