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")
})
Related
I do not know how to connect input (n) in the slider and output (plot). When I move the bottom on the slider in the shinny app, the plot did not change. I am wondering if the output and input did not link together approporatedly.
library(ggplot2)
library(shiny)
plot<-function(x,y,xlim=c(-3,3)){
x <- seq(-4, 4, by=0.01)
norm_dens <- dnorm(x)
t_dens <- dt(x, df = n-1)
df = data.frame(x = x, z = norm_dens, t = t_dens)
ggplot(data = df, aes(x)) +
geom_line(aes(y = z, colour = "z"))+
geom_line(aes(y = t,color = "t"))+
labs(x="x", y = "")+
scale_color_manual(name = "l", values = c("z" = "blue", "t" = "red"))+
coord_cartesian(xlim = xlim)
}
plot(x,y)
## UI function
ui <- fluidPage(
mainPanel(
plotOutput(outputId="plot")),
fluidRow(
column(2,
"Sample Size",
sliderInput("n", label = "n", value = 5, min = 2, max = 100),step=1)
)
)
# Server logic
server <- function(input, output) {
reactive({
df %>%
filter(n %in% input$n)
})
output$plot<-renderPlot({
plot(x,y)
})
}
## Run shiny app
shinyApp(ui, server)
You don't need the reactive here. Try this:
library(ggplot2)
library(shiny)
plot<-function(x,y,xlim=c(-3,3),n){
x <- seq(-4, 4, by=0.01)
norm_dens <- dnorm(x)
t_dens <- dt(x, df = n-1)
df = data.frame(x = x, z = norm_dens, t = t_dens)
ggplot(data = df, aes(x)) +
geom_line(aes(y = z, colour = "z"))+
geom_line(aes(y = t,color = "t"))+
labs(x="x", y = "")+
scale_color_manual(name = "l", values = c("z" = "blue", "t" = "red"))+
coord_cartesian(xlim = xlim)
}
## UI function
ui <- fluidPage(
mainPanel(
plotOutput(outputId="plot")),
fluidRow(
column(2,
"Sample Size",
sliderInput("n", label = "n", value = 5, min = 2, max = 100),step=1)
)
)
# Server logic
server <- function(input, output) {
output$plot<-renderPlot({
req(input$n)
plot(x,y,n=input$n)
})
}
## Run shiny app
shinyApp(ui, server)`enter code here`
I have two output plots and I want to get them above each other, so I can compare between them through the selected inputs input$sel and input$sel2.
I mean with above each other is one should be in the background and the other one should be another layer on it transparent, so one can see both plots at the same time.
If data are necessary, here is data.csv file :
https://impfdashboard.de/static/data/germany_vaccinations_by_state.tsv
server <- function(input, output, session) {
#Summarize Data and then Plot
data <- reactive({
req(input$sel)
df <- germany_vaccinations_k %>% group_by(code) %>% summarise( output = get(input$sel))
print(df)
})
data2 <- reactive({
req(input$sel2)
df <- germany_vaccinations_k %>% group_by(code) %>% summarise( output = get(input$sel2))
print(df)
})
#Plot 1
output$plot <- renderPlot({
g <- ggplot( data(), aes( y = output ,x = code ,ho = factor(code) ) )
g + geom_bar( stat = "sum" )
output$plot2 <- renderPlot({
g <- ggplot( data(), aes( y = output ,x = code ,ho = factor(code) ) )
g + geom_bar( stat = "sum" )
})
ui <- basicPage(
#first-input
selectInput(inputId = "sel", label = "Möglichkeit auswählen",
list("vaccinationsTotal","peopleFirstTotal","peopleFullTotal","peopleBoosterTotal")),
#second-input
selectInput(inputId = "sel2", label = "Möglichkeit auswählen",
list("vaccinationsTotal","peopleFirstTotal","peopleFullTotal","peopleBoosterTotal")),
#the both outputs
plotOutput("plot")
plotOutput("plot2")
)
We can combine both plots and play around with alpha argument. I added two sliders that enables the user to control the level of transparency of both plots.
output$plot <- renderPlot({
ggplot() +
geom_bar(data = data(), aes(y = output, x = code), stat = "sum", alpha = .5) +
geom_bar(data = data2(), aes(y = output, x = code), stat = "sum", alpha = .5, fill = "lightblue")
})
app:
germany_vaccinations_k <- read_tsv("germany_vaccinations_by_state.tsv")
ui <- basicPage(
# first-input
selectInput(
inputId = "sel", label = "Möglichkeit auswählen",
list("vaccinationsTotal", "peopleFirstTotal", "peopleFullTotal", "peopleBoosterTotal")
),
# second-input
selectInput(
inputId = "sel2", label = "Möglichkeit auswählen",
list("vaccinationsTotal", "peopleFirstTotal", "peopleFullTotal", "peopleBoosterTotal")
),
sliderInput("alpha_sel", "Select First Alpha", min = .01, max = 1, value = 0.5),
sliderInput("alpha_sel2", "Select Second Alpha", min = .01, max = 1, value = 0.8),
# the both outputs
plotOutput("plot")
)
server <- function(input, output, session) {
# Summarize Data and then Plot
data <- reactive({
req(input$sel)
df <- germany_vaccinations_k %>%
group_by(code) %>%
summarise(output = get(input$sel))
print(df)
})
data2 <- reactive({
req(input$sel2)
df <- germany_vaccinations_k %>%
group_by(code) %>%
summarise(output = get(input$sel2))
print(df)
})
output$plot <- renderPlot({
ggplot() +
geom_bar(data = data(), aes(y = output, x = code), stat = "sum", alpha = input$alpha_sel) +
geom_bar(data = data2(), aes(y = output, x = code), stat = "sum", alpha = input$alpha_sel2, fill = "lightblue")
})
}
shinyApp(ui, server)
I create a barplot shiny app.
The biggest problem I met now is when I click the acitonbutton to get a new picture ,
the barplot appear delay and when I choose another input and click actionbutton again, the last barplot will appear but instantly disappear and the second picture appear.
But the input first and second time is different. Why the first picture will appear twice?
Here is my sample code,it is normal because it's a small sample.
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
###
ui <- fluidPage(
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot")
#uiOutput("all")
)
)
)
server <- function(input, output, session) {
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
# geom_errorbar(aes(ymin = plotdata()[,input$selectGeneSymbol] - sddata()[,input$selectGeneSymbol], ymax = plotdata()[,input$selectGeneSymbol] + sddata()[,input$selectGeneSymbol]), width = .2, position = position_dodge(0.9)) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
})
output$plot <- renderPlot({
p1()
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
My real data is huge and I don't know if it is the main reason.
Or I should change the reactive() and EventReactive() or adjust the parameters ??
My sample data here is simple. You may not meet what the problem I met in my code.
I will show you some details, just like this:
That's ok.Though it may appeare slowly.
But when I choose another gene as input,
the first "Gene_1" result will appear again and then the "Gene_2" result will appear.
I hope somebody could help me or met this problem before.
Vary thankful.
As your data is large, there is a delay in generating the plot p1(). Hence, the previous plot is shown in renderPlot. The following update will show blank until a new plot is generated whenever user selects a new gene. Perhaps this will solve your issue. I cannot verify as I don't have large dataframe.
ui <- fluidPage(
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot")
#,verbatimTextOutput("all")
)
)
)
server <- function(input, output, session) {
rv <- reactiveVal(0)
observeEvent(input$selectGeneSymbol, {rv(0)})
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
rv(0)
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
req(plotdata())
p <- ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
rv(1)
p
})
observeEvent(input$plot1, {rv(1)})
output$plot <- renderPlot({
if (rv()) {
p1()
}
})
#output$all <- renderPrint(rv())
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
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
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()
})