How to create dependent prompts in Shiny App in R - r

I am tying to create an R shiny app and I would like to have two selectInput i.e. data set name and column name. Right now, I am able to get data set names in the first Input but I am not able to create dependent column selectIput (whose list will depend upon data set selected). Please guide.
require(shiny)
require(MASS)
a <- data(package = "MASS")[3]
b <- a$results[,3]
ui <- fluidPage(
sidebarPanel(width = 2,
selectInput(inputId = "dsname",label = "Select Dataset:",choices = c(b)),
colnames <- names("dsname"),
selectInput(inputId = "columns", label = "Choose columns",
choices = c(colnames))
)
)
server <- function(input,output) {}
shinyApp(ui <- ui, server <- server)

In order to have "responsive" elements in Shiny, you need to wrap your expressions for computing the responsive elements in reactive({...}).
You could use renderUI in your server() and uiOutput in your ui() with something like this. Here is an example I had built for using some of R's data sets (iris, mtcars, and diamonds):
library(shinythemes)
library(shiny)
library(ggplot2)
ui <- fluidPage(theme = shinytheme("superhero"),
titlePanel("Welcome to Responisve Shiny"),
sidebarLayout(
sidebarPanel(
selectInput("data", "Dataset:",
choices = c("mtcars", "iris", "diamonds")
),
uiOutput("x_axis"),
uiOutput("y_axis"),
uiOutput("color")
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$x_axis <- renderUI({
col_opts <- get(input$data)
selectInput("x_axis2", "X-Axis:",
choices = names(col_opts))
})
output$y_axis <- renderUI({
cols2 <- reactive({
col_opts2 <- get(input$data)
names(col_opts2)[!grepl(input$x_axis2, names(col_opts2))]
})
selectInput("y_axis2", "Y-Axis:",
choices = cols2(),
selected = "hp")
})
output$color <- renderUI({
col_opts <- get(input$data)
selectInput("color", "Color:",
choices = names(col_opts),
selected = "cyl")
})
output$distPlot <- renderPlot({
if(input$data == "mtcars"){
p <- ggplot(mtcars, aes_string(input$x_axis2, input$y_axis2, color = input$color)) +
geom_point()
}
if(input$data == "iris"){
p <- ggplot(iris, aes_string(input$x_axis2, input$y_axis2, color = input$color)) +
geom_point()
}
if(input$data == "diamonds"){
p <- ggplot(diamonds, aes_string(input$x_axis2, input$y_axis2, color = input$color)) +
geom_point()
}
print(p)
})
}
shinyApp(ui = ui, server = server)

Related

ggplot2 mutate error when select variable from uploaded dataset in R shinydashbard

I am trying to plot using ggplot in R shiny. I want to upload data and any variable can be used for plotting. I am trying to keep aes() dynamically. I tried a few examples example 1, but dint work for me. Here is my code:
library(shiny)
library(shinydashboard)
library(readxl)
library(DT)
library(dplyr)
library(ggplot2)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Upload data File',
accept=c('text/csv','.xlsx',
'text/comma-separated-values,text/plain',
'.csv'))),
mainPanel(
DT::dataTableOutput('contents')
)
),
tabPanel("First Type",
pageWithSidebar(
headerPanel('Visualization of Dengue Cases'),
sidebarPanel(
selectInput('xcol', 'X Variable', ""),
selectInput('ycol', 'Y Variable', "", selected = "")
),
mainPanel(
plotOutput('MyPlot')
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output,session) {
data <- reactive({
req(input$file1)
inFile <- input$file1
df <- read_excel(paste(inFile$datapath, sep=""), 1)
updateSelectInput(session, inputId = 'xcol', label = 'X Variable',
choices = names(df), selected = names(df))
updateSelectInput(session, inputId = 'ycol', label = 'Y Variable',
choices = names(df), selected = names(df)[2])
return(df)
})
output$contents <- DT::renderDataTable({
data()
},options = list(pageLength = 10, width="100%", scrollX = TRUE))
output$MyPlot <- renderPlot({
select_quo <- quo(input$MyPlot_select)
data %>%
mutate(user_input = !!select_quo) %>%
ggplot(aes(fill=user_input, y=user_input, x= user_input)) +
geom_bar( stat="identity")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Can use any data set, such as Diamond dataset.
Also kindly help in allowing all types of formats (.csv, .txt,.xls) of data. As of now, only .xls is acceptable.
There are several issues with your code.
You use data instead of data() in the renderPlot
There is no input input$MyPlot_select.
Using quo and !! will not give the desired result. Instead you could simply use the .data pronoun if your column names are strings.
Add req at the beginning of renderPlot.
This said your renderPlot should look like so:
output$MyPlot <- renderPlot({
req(input$xcol, input$ycol)
x <- input$xcol
y <- input$ycol
fill <- input$xcol
ggplot(data(), aes(x = .data[[x]], y = .data[[y]], fill=.data[[fill]])) +
geom_col()
})
For the second part of your question. To make your app work for different types of input files you could get the file extension using e.g. tools::file_ext and use the result in switch statement.
Full reproducible code:
library(shiny)
library(shinydashboard)
library(readxl)
library(DT)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Upload data File",
accept = c(
"text/csv", ".xlsx",
"text/comma-separated-values,text/plain",
".csv"
)
)
),
mainPanel(
DT::dataTableOutput("contents")
)
),
tabPanel(
"First Type",
pageWithSidebar(
headerPanel("Visualization of Dengue Cases"),
sidebarPanel(
selectInput("xcol", "X Variable", ""),
selectInput("ycol", "Y Variable", "", selected = "")
),
mainPanel(
plotOutput("MyPlot")
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
data <- reactive({
req(input$file1)
inFile <- input$file1
type <- tools::file_ext(inFile$name)
filename <- inFile$datapath
df <- switch(type,
"xlsx" = read_excel(filename),
"csv" = read_csv(filename),
"tsv" = read_tsv(filename))
updateSelectInput(session,
inputId = "xcol", label = "X Variable",
choices = names(df), selected = names(df)
)
updateSelectInput(session,
inputId = "ycol", label = "Y Variable",
choices = names(df), selected = names(df)[2]
)
return(df)
})
output$contents <- DT::renderDataTable({
data()
}, options = list(pageLength = 10, width = "100%", scrollX = TRUE))
output$MyPlot <- renderPlot({
req(input$xcol, input$ycol)
x <- input$xcol
y <- input$ycol
fill <- input$xcol
ggplot(data(), aes(x = .data[[x]], y = .data[[y]], fill=.data[[fill]])) +
geom_col()
})
}
# Run the application
shinyApp(ui = ui, server = server)

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)

Shiny Application for Linear Regression with dynamic variable dropdown based on user upload

As the title describes, I'm simply trying to create a shiny application that allows the user to generate linear regression plots based on an imported csv file. After importing the file the dropdown for the variables of interest should be dynamically updated.
As the code below shows, I'm able to accomplish that with mtcars but I'm not able to do the same with an imported files that would have different dependent and independent variables .
Thank you for your help
data(mtcars)
cols <- sort(unique(names(mtcars)[names(mtcars) != 'mpg']))
ui <- fluidPage(
titlePanel("Build a Linear Model for MPG"),
sidebarPanel(
#fluidRow(
#column(4,
#tags$h3('Build a Linear Model for MPG'),
fileInput(
inputId = "filedata",
label = "Upload data. csv",
accept = c(".csv")
),
fileInput(
inputId = "filedata1",
label = "Upload data. csv",
accept = c(".csv")
),
selectInput('vars',
'Select dependent variables',
choices = cols,
selected = cols[1:2],
multiple = TRUE)
#)
), #sidebarpanel
mainPanel( column(4, verbatimTextOutput('lmSummary')),
column(4, plotOutput('diagnosticPlot')))
) #fluidpage
server <- function(input, output) {
data <- reactive({
req(input$filedata)
read.csv(input$filedata$datapath) %>% rename_all(tolower) %>%
filter(driver_name == input$driver_name & county == input$county & model == input$model)
})
lmModel <- reactive({lm(sprintf('mpg ~ %s', paste(input$vars, collapse = '+')),
data = mtcars)})
# lmModel <- reactive({lm(sprintf('mpg ~ %s', paste(input$vars, collapse = '+')),
# data = mtcars)})
output$lmSummary <- renderPrint({
summary(lmModel())
})
output$diagnosticPlot <- renderPlot({
par(mfrow = c(2,2))
plot(lmModel())
})
}
shinyApp(ui = ui, server = server)```
To dynamically select x and y axis variables, you can try the following
ui <- fluidPage(
titlePanel("Build a Linear Model"),
sidebarPanel(
fileInput(
inputId = "filedata",
label = "Upload data. csv",
multiple = FALSE,
accept = c(".csv"),
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
uiOutput("xvariable"),
uiOutput("yvariable")
), #sidebarpanel
mainPanel( #DTOutput("tb1"),
fluidRow(column(6, verbatimTextOutput('lmSummary')) , column(6, plotOutput('diagnosticPlot')))
)
) #fluidpage
server <- function(input, output) {
data <- reactive({
req(input$filedata)
inData <- input$filedata
if (is.null(inData)){ return(NULL) }
mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
})
output$tb1 <- renderDT(data())
output$xvariable <- renderUI({
req(data())
xa<-colnames(data())
pickerInput(inputId = 'xvar',
label = 'Select x-axis variable',
choices = c(xa[1:length(xa)]), selected=xa[1],
options = list(`style` = "btn-info"))
})
output$yvariable <- renderUI({
req(data())
ya<-colnames(data())
pickerInput(inputId = 'yvar',
label = 'Select y-axis variable',
choices = c(ya[1:length(ya)]), selected=ya[2],
options = list(`style` = "btn-info"))
})
lmModel <- reactive({
req(data(),input$xvar,input$yvar)
x <- as.numeric(data()[[as.name(input$xvar)]])
y <- as.numeric(data()[[as.name(input$yvar)]])
if (length(x) == length(y)){
model <- lm(x ~ y, data = data(), na.action=na.exclude)
}else model <- NULL
return(model)
})
output$lmSummary <- renderPrint({
req(lmModel())
summary(lmModel())
})
output$diagnosticPlot <- renderPlot({
req(lmModel())
par(mfrow = c(2,2))
plot(lmModel())
})
}
shinyApp(ui = ui, server = server)
Addressing the dynamic menu:
Your selectInput element must be placed in the server section for it to be reactive. Things in the ui section are basically static. Use a uiOutput in the ui section and renderUI in the server section.
ui section (in place of selectInput block): uiOutput("var_select_ui")
server section (add):
output$var_select_ui <- renderUI({
cols <- colnames(data())
selectInput(
'vars',
'Select dependent variables',
choices = cols,
selected = cols[1:2],
multiple = TRUE
)
})

Shiny not displaying ggplot data

I am new to working with shiny package. I am trying to use it to display a ggplot2 graph. I get no errors with my code, however data points are not appearing on the graph. When I select the variables from ui, the axes labels changes accordingly but the data is not added to the plot.
Thank you,
Code:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("P-value", "P-adjust"),
selected = "P-adjust"),
selectInput(inputId = "x" ,
label = "X-axis:",
choices = c("FC", "Mean_Count_PD"),
selected = "FC")
),
mainPanel(plotOutput(outputId = "scatterplot"))
))
server <- function(input, output)
{
output$scatterplot <- renderPlot({
ggplot(data = mir, aes(input$x,input$y)) + geom_point()
})
}
The issue is that you have to tell ggplot that your inputs are names of variables in your dataset. This could be achieved e.g. by making use of the .data pronoun, i.e. instead of using input$x which is simply a string use .data[[input$x]] which tells ggplot that by input$x you mean the variable with that name in your data:
As you provided no data I could not check but this should give you the desired result:
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("P-value", "P-adjust"),
selected = "P-adjust"),
selectInput(inputId = "x" ,
label = "X-axis:",
choices = c("FC", "Mean_Count_PD"),
selected = "FC")
),
mainPanel(plotOutput(outputId = "scatterplot"))
))
server <- function(input, output) {
output$scatterplot <- renderPlot({
ggplot(data = mir, aes(.data[[input$x]], .data[[input$y]])) + geom_point()
})
}
shinyApp(ui, server)

Modify my rChart based on a reactive input?

I am having trouble with some code that I've written.
Here is a sample of the dataset: https://docs.google.com/spreadsheets/d/1C_P5xxzYr7HOkaZFfFiDhanqDSuSIrd2UkiC-6_G2q0/edit?usp=sharing
Objective:
I have a dataset that contains a column of Purchase_Month, candy and freq of the number of times that type of candy was purchased in that given month.
I have an rPlot which I was to change based on the chosen Candy bar in the SelectInput. And output a line chart based on the number of times that candy was purchased that month.
I have my current code below, but it tells me that candyCount is not found.
## ui.R ##
library(shinydashboard)
library(rCharts)
dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
width = 150,
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("bar-chart"))
)
),
dashboardBody(
sidebarPanel(
htmlOutput("candy")
),
mainPanel(
showOutput("plot2", "polycharts")
))
)
##server.R##
library(rCharts)
library(ggplot2)
library(ggvis)
server <- function(input, output, session) {
output$candy <- renderUI({
available2 <- dataset[(dataset$candy == input$candy), "candy"]
selectInput(
inputId = "candy",
label = "Choose a candy: ",
choices = sort(as.character(unique(available2))),
selected = unique(available2[1])
)
})
observeEvent(input$candy, {
candyChoice<- toString(input$customer_issue)
print(candyChoice)
candyCount<- dataset[dataset$candy == candyChoice, ]
})
})
output$plot2 <- renderChart2({
p2 <- rPlot(freq~purchase_month, data = candyCount, type = 'line')
p2$guides(y = list(min = 0, title = ""))
p2$guides(y = list(title = sprintf("%s Claims",input$candy)))
p2$addParams(height = 300, dom = 'chart2')
return(p2)
})
}
Updated Data: Why wouldn't this work?
candyCount<- reactive({
dataset[dataset$candy == input$candy, ]
})
output$plot2 <- renderChart2({
p2 <- rPlot(freq~purchase, data = candyCount(), type = 'line')
p2$guides(y = list(min = 0, title = ""))
p2$guides(y = list(title = ""))
p2$addParams(height = 300, dom = 'chart2')
return(p2)
})
output$candy <- renderUI({
available2 <- dataset[(dataset$candy == input$candy), "candy"]
selectInput(
inputId = "candy",
label = "Choose a candy: ",
choices = sort(as.character(unique(available2))),
selected = unique(available2[1])
)
})
In the above you are trying to subset by an input, which is inside your output. The selectInput needs to be inside UI.R.
A working basic example you may find useful.
library(shiny)
df <- read.csv("/path/to/my.csv")
ui <- shinyUI(pageWithSidebar(
headerPanel('Candy Data'),
sidebarPanel(
selectInput('candy', 'Candy', unique(as.character(df[,2])), selected = "Twix")
),
mainPanel(
plotOutput('plot1')
)
))
server <- shinyServer(function(input, output, session) {
selectedData <- reactive({
df[which(df[,2] == input$candy),3]
})
output$plot1 <- renderPlot({
barplot(selectedData())
})
})
shinyApp(ui, server)
In the above example the ui renders a selectInput which has the ID candy. The value, i.e the candy selected is now assigned to input$candy scope. In server we have a reactive function watching for any input change. When the user selects a new candy this function, df[which(df[,2] == input$candy),3] is saying "subset my data frame, df, by the new input$candy". This is now assigned to the selectedData(). Finally we render then boxplot.
EDIT
server.R
require(rCharts)
options(RCHART_WIDTH = 500)
df <- read.csv("path/to/my.csv")
shinyServer(function(input, output, session) {
selectedData <- reactive({
df[which(df[,2] == input$candy),]
})
output$plot1 <- renderChart({
p <- rPlot(freq~purchase_month, data = selectedData(), type = "line")
p$addParams(dom = 'plot1')
return(p)
})
})
ui.R
require(rCharts)
options(RCHART_LIB = 'polycharts')
shinyUI(pageWithSidebar(
headerPanel('Candy Data'),
sidebarPanel(
selectInput('candy', 'Candy', unique(as.character(df[,2])), selected = "Twix")
),
mainPanel(
showOutput('plot1', 'polycharts')
)
))
save files in directory and then runApp.
At available2 you're filtering the data about a selected candy with dataset$candy == input$candy. But you use the same available2 to determine which are the choices at selectInput. I'm guessing you wanted: available2 <- dataset[, "candy"].

Resources