Subset dataframe based on selectInput in R Shiny - r

I have a shiny app in which I generate scagnostics based on the relationship between variables in a dataframe, as follows
library(binostics)
scagnostics(df$x1,
df$x2)$s
However, I want to dynamically select these variables from a drop down list. But when I do so I'm not able to subset the data frame based on the input variables
selectInput("v1", label = "Select Variable 1", choices = selection, selected = "x1"),
selectInput("v2", label = "Select Variable 2", choices = selection, selected = "x2")
scagnostics(df$input$v1,
df$input$v2)$s
Reproducible Example :
library(readr)
library(binostics)
library(tidyverse)
library(gridExtra)
big_epa_cars_2019 <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-15/big_epa_cars.csv") %>%
filter(year == 2019)
my_vars <- c("barrels08", "cylinders", "city08", "highway08", "feScore", "fuelCost08", "co2TailpipeGpm", "youSaveSpend")
ui <- fluidPage(
fluidRow(
column(1),
column(3, selectInput("v1", label = "Select x Variable", choices = my_vars, selected = "barrels08")),
column(3, selectInput("v2", label = "Select y Variable", choices = my_vars, selected = "city08"))
),
fluidRow(
column(1),
column(10, plotOutput("scagnosticsplots")),
column(1))
)
server <- function(input, output, session) {
output$scagnosticsplots <- renderPlot({
p1 <- ggplot(big_epa_cars_2019,
aes(x = get(input$v1),
y = get(input$v2))) +
geom_point() +
theme_bw() +
labs(x = input$v1,
y = input$v2)
s <- scagnostics(big_epa_cars_2019$input$v1,
big_epa_cars_2019$input$v2)$s
df_s <- tibble(scag = names(s), value = s) %>%
mutate(scag = fct_reorder(scag, value))
p2 <- ggplot(df_s, aes(x=value, y=scag)) +
geom_point(size=4, colour="orange") +
geom_segment(aes(x=value, xend=0,
y=as.numeric(scag),
yend=as.numeric(scag)), colour="orange") +
theme_bw() +
labs(x = "Scagnostic value",
y = "")
grid.arrange(p1, p2, ncol=2)
})
}
shinyApp(ui, server)

#Ben's answer commented above worked.
s <- scagnostics(big_epa_cars_2019[[input$v1]], big_epa_cars_2019[[input$v2]])$s

Related

undefined column selected error in Shiny app

I just want to imitate to make a little shiny app.
but it does not work at all.
ERORR is: Warning: Error in [.data.frame: undefined columns selected
I load a df I created.
data.frame : df_pris_salary
colnames : region , år , Antal ,Medelpris, Medianpris ,MedelLön year_per_lgh
Code looks like this:
library(shiny)
library(tidyverse)
library(ggplot2)
load("data/shiny2.RData")
# load df: df_pris_salary
ui <- fluidPage(
titlePanel("Utveckling av lägenhetspris & Lön"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "VarX",
label = "Select X-axis Variable:",
choices = list("år", "MedelLön")),
selectInput(inputId = "VarY",
label = "Select Y-axis Variable:",
choices = list("Medelpris", "MedelLön")),
selectInput(inputId = "Color",
label = "Select Color Variable:",
choices = as.list(c("region", "år")))
),
mainPanel(
plotOutput("scatter")
)
)
)
server <- function(input, output, session) {
output$scatter <- renderPlot({
mtc <- df_pris_salary[,c(input$VarX, input$VarY, input$Color)]
mtc[,3] <- as.factor(mtc[,3])
ggplot()+
geom_line(data = mtc, aes(x = mtc[,1], y = mtc[,2], color = mtc[,3]))+
geom_point(data = mtc, aes(x = mtc[,1], y = mtc[,2], color = mtc[,3]))+
labs(x = colnames(mtc)[1], y = colnames(mtc)[2],
color = colnames(mtc)[3],
title = paste("Scatter Plot of", input$VarX, "vs", input$VarY),
subtitle = "Under åren 2000 - 2021",
caption = "Data Source: SCB")
})
}
shinyApp(ui, server)
Could someone help me to figure out how to solve this problem?

Incorporating Shiny app sliders into ggplot graphs

I am trying to filter the dataframe that I use for my graph based on the input values from two sliders. I have sliders that select a range for temperature and wind speed in a given NFL game. (Each row of the dataframe is a quarterback's performance in a game along with game weather and QB measurables, so at least two rows per game.) How do I take the output from the sliders and filter the dataframe based on that? For example, how do I filter df$temperature based on the slider with id "z"?
library(shiny)
library(dplyr)
library(ggplot2)
library(tidyr)
df = read.csv("Combined_QB_Game_Data.csv")
df[df == "--"] = NA
df$Passes.Completed = as.double(df$Passes.Completed)
df$Passes.Attempted = as.double(df$Passes.Attempted)
df$Completion.Percentage = as.double(df$Completion.Percentage)
df$Passing.Yards = as.double(df$Passing.Yards)
df$Passing.Yards.Per.Attempt = as.double(df$Passing.Yards.Per.Attempt)
df$TD.Passes = as.double(df$TD.Passes)
df$Sacks = as.double(df$Sacks)
ui = fluidPage(
titlePanel("QB Performance"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "x",
label = "Options:",
choices = c("Ht", "Wt",
"Forty", "Vertical", "BenchReps",
"BroadJump", "Cone", "Shuttle", "Round", "Pick"),
selected = "Ht"),
selectInput(inputId = "y",
label = "Options2:",
choices = c("Passer.Rating","Passes.Completed","Passes.Attempted","Completion.Percentage","Passing.Yards","Passing.Yards.Per.Attempt","TD.Passes","Ints","Sacks"),
selected = "Passer.Rating"),
sliderInput("z", "Tempurature",
min = 0, max = 100, value = c(25, 75)),
sliderInput("a", "Wind",
min = 0, max = 30, value = c(5, 25))
),
mainPanel(
plotOutput(outputId = "scatterplot")
)
)
)
server = function(input, output) {
output$scatterplot = renderPlot({
p = ggplot(data = df) +
aes_string(x = input$x, y = input$y) +
geom_point()+
geom_smooth(method = "lm")
plot(p)
})
}
shinyApp(ui, server)
One possibility is to treat the data in a reactive conductor:
ggdata <- reactive({
bounds <- input$z
df %>% filter(temperature > bounds[1], temperature < bounds[2])
})
and then use it in the renderPlot:
output$scatterplot = renderPlot({
ggplot(data = ggdata()) +
aes_string(x = input$x, y = input$y) +
geom_point() +
geom_smooth(method = "lm")
})

Create graph based on selection of input and output

New to shiny. I am trying to create a plot based on chosen x and y values. Basically, whatever the user selects for the select1 and select2 selectInput function will graph it accordingly. My original data has many columns, not just two. When I try to graph very specific things, my code works great, but when I try to graph what the user "selects" it does not work.
library(shiny)
library(readr)
library(ggplot2)
library(dplyr)
data0 <- rnorm(n = 10, mean = 100, sd = 5)
data1 <- rnorm(n = 10, mean = 50, sd = 10)
data2 <- data.frame(data0, data1)
attach(data2)
ui <- fluidPage(
selectInput(inputId = "select1",
label = "select the x-axis",
choices = c(" ", "data0", "data1")
),
selectInput(inputId = "select2",
label = "select the y-axis",
choices = c(" ", "data0", "data1")
),
submitButton(text = "Apply Changes", icon = NULL, width = NULL),
plotOutput(outputId = "myplot")
)
server <- function(input, output) {
output$myplot <- renderPlot({
data2 %>%
ggplot(aes(input$select1 ~ input$select2))+
geom_point(alpha = 0.8)
})
}
shinyApp(ui = ui, server = server)
I had to add ggplot(aes(x = get(paste(input$select1)), y = get(paste(input$select2)) to make the input selects work.
library(shiny)
library(readr)
library(ggplot2)
library(dplyr)
data0 <- read_csv("DeltaX_Soil_Properties_Fall2020_Spring2021_Fall2021.csv")
data1 <- data0[!(data0$time_marker_sampled == "-9999"),]
attach(data1)
ui <- fluidPage(
selectInput(inputId = "select1",
label = "select the x-axis",
choices = c(" ", "elevation_navd88", "sediment_accretion", "days_between_sampling_and_deployment", "normalized_accretion", "soil_bulk_density", "soil_organic_matter_content", "soil_organic_carbon", "soil_organic_carbon_density")
),
selectInput(inputId = "select2",
label = "select the y-axis",
choices = c(" ", "elevation_navd88", "sediment_accretion", "days_between_sampling_and_deployment", "normalized_accretion", "soil_bulk_density", "soil_organic_matter_content", "soil_organic_carbon", "soil_organic_carbon_density")
),
submitButton(text = "Apply Changes", icon = NULL, width = NULL),
plotOutput(outputId = "myplot")
)
server <- function(input, output) {
output$myplot <- renderPlot({
data1 %>%
ggplot(aes(x = get(paste(input$select1)), y = get(paste(input$select2)), col = hydrogeomorphic_zone))+
geom_point(alpha = 0.8)
})
}
shinyApp(ui = ui, server = server)
If you want to use a variable as x or y, you can alternatively use aes_() instead of aes().
This would then result in:
ggplot(aes_(x = input$select1, y = input$select2))
Beware, that you need to add a tilde if you want to use a normal column name with aes_(), e.g.:
ggplot(aes_(x = ~elevation_navd88, y = input$select2))

Plotting in Rshiny for newly created variable

I have a dataset with categorical data (let's use Arthritis from vcd package for exmaple purposes).
I want to obtain a barplot where for two variables and colouring by a third one.
In base R this would be:
library(vcd)
library(ggplot2)
data(Arthritis)
tab <- as.data.frame(prop.table(table(Arthritis$Treatment, Arthritis$Improved), margin = 1))
ggplot(tab,aes(x=Var1,y=Freq, fill=Var2, label = round(Freq,3)))+
geom_bar(stat = 'identity')+
geom_text(position = position_stack(vjust=0.5))+
scale_fill_manual(values=c('cyan3','tomato', 'blue'), guide = guide_legend(reverse=TRUE))
Which would give the result:
In my shinyApp the user should be able to choose the variables to plot.
For this I've created:
# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(shinyjs)
# Data
library(readxl)
library(dplyr)
library(vcd)
# Plots
library(ggplot2)
not_sel <- "Not Selected"
ui <- navbarPage(
title = "Plotter",
windowTitle = "Plotter",
tabPanel(
"Plotter",
fluidPage(
fluidRow(
sidebarPanel(
title = "Inputs",
fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
uiOutput("factor"),
br(),
actionButton("run_button", "Run Analysis", icon = icon("play"))
),
# Main panel
mainPanel(
tabsetPanel(
tabPanel(
"Plot",
br(),
plotOutput("plot_1"),
br(),
verbatimTextOutput("data")
)
)
)
)
)
)
)
################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
# Dynamic selection of the data
data_input <- reactive({
#req(input$xlsx_input)
#inFile <- input$xlsx_input
#read_excel(inFile$datapath, 1)
Arthritis
})
# We update the choices available for each of the variables
observeEvent(data_input(),{
choices <- c(not_sel, names(data_input()))
updateSelectInput(inputId = "num_var_1", choices = choices)
updateSelectInput(inputId = "num_var_2", choices = choices)
})
num_var_1 <- eventReactive(input$run_button, input$num_var_1)
num_var_2 <- eventReactive(input$run_button, input$num_var_2)
# data
data_discrete_plot <- reactive({
req(data_input(), input$num_var_1, input$num_var_2)
df <- data_input()
df1 <- as.data.frame(prop.table(table(df[[input$num_var_1]], df[[input$num_var_2]]), margin = 1))
df1
})
# Function for printing the plots
draw_barplot <- function(data_input)
ggplot(data = data_input, aes(x=data_input[1], y=data_input[3], fill=data_input [2], label = round(Freq, 3))) +
geom_bar(stat = "identity") +
scale_fill_manual(guide = guide_legend(reverse=TRUE)) +
ylim(0, 100) +
theme_bw()
## BarPlot -------------------------------------------------------------------
plot_1 <- eventReactive(input$run_button,{
req(data_input())
draw_barplot(data_discrete_plot())
})
output$plot_1 <- renderPlot(plot_1())
output$data <- renderPrint(data_discrete_plot())
}
# Connection for the shinyApp
shinyApp(ui = ui, server = server)
As you can see in the previous RepEx we are obtaining the contingency table, however, I'm finding some trouble when calling for the variables to plot,
as it is a new dataframe with different names for the data.
If I run the code above, I get an error that says: default method not implemented for type 'list'
But if I try to do something like:
data_input[1] <- unlist(data_input[1])
data_input[2] <- unlist(data_input[2])
data_input[3] <- unlist(data_input[3])
The application crashes.
As the columns of your new dataframe have names Var1, Var2 and Freqyou could do:
draw_barplot <- function(data_input) {
ggplot(data = data_input, aes(x = Var1, y = Freq, fill = Var2, label = round(Freq, 3))) +
geom_bar(stat = "identity") +
scale_fill_discrete(guide = guide_legend(reverse = TRUE)) +
ylim(0, 1) +
theme_bw()
}
Additionally I replaced scale_fill_manual by scale_fill_discrete as for the first one you have to provide a vector of color values and set ylim(0, 1) as the proportions in the ´Freq` column are on a 0 to 1 scale.

Cannot plot properly in RShiny

I'm trying to create an easy shiny dashboard. I'm using the next data frame:
df <- data.frame(Age = c(18,20,25,30,40),
Salary = c(18000, 20000, 25000, 30000, 40000),
Date = as.Date(c("2006-01-01", "2008-01-01", "2013-01-01", "2018-01-01", "2028-01-01")))
save(df, file = "data.Rdata")
And the code for doing the shiny app is the following:
library(shiny)
library(ggplot2)
load("C:/.../data.RData")
ui <- fluidPage(
sidebarLayout(
# Inputs
sidebarPanel(
# Select variable for y-axis
selectInput(inputId = "y",
label = "Y-axis:",
choices = names(df),
selected = "Salary"),
# Select variable for x-axis
selectInput(inputId = "x",
label = "X-axis:",
choices = names(df),
selected = "Date")
),
# Outputs
mainPanel(
plotOutput(outputId = "scatterplot")
)
)
)
server <- function(input, output) {
output$scatterplot <- renderPlot({
ggplot(data = df, aes(x = input$x, y = input$y)) +
geom_line()
})
}
shinyApp(ui = ui, server = server)
This is what I get on my plot:
And this is what I'm expecting:
I'm not sure what I'm missing on my code.
Try with:
output$scatterplot <- renderPlot({
ggplot(data = df, aes(x = df[, input$x], y = df[, input$y])) +
geom_line()
})
or simply by using:
output$scatterplot <- renderPlot({
ggplot(data = df, aes_string(x = input$x, y = input$y)) +
geom_line()
})

Resources