Create graph based on selection of input and output - r

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))

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?

Make a second SelectInput dropdown reactive

I have two SelectInput Drowpdown controls but I can't make the first one reactive. My second control works fine. Consider this small toy example: On my first dropdown (which it doesn't work), I have 5 options. I want this control to react when the selection changes. I basically want both of my dropdown controls to be reactive to the type of model or type of graphic selected.
library(shiny)
library(ggplot2)
library(tidyverse)
library(shinythemes)
library(plotly)
library(scales)
library(shinyWidgets)
library(shinydashboard)
library(DT)
library(shinyjs)
library(shinycssloaders)
# Define input choices
type <- c("lambda","indices")
model <- c("Output_21yr_noStock","Output_21yr_yesStock","Output_82yr_bdc_noStock","Output_82yr_ppp_noStock","Output_82yr_woa_nostock")
#############Lambda######Table
olddir <- getwd()
table <- structure(list(year = 1991:2010, lambda = c(0.73392, 0.75659,
1.33665, 1.06641, 1.27145, 1.01077, 0.66983, 1.6427, 0.96414,
0.55648, 0.50556, 1.08024, 0.8706, 0.89665, 1.00807, 1.01967,
0.73131, 1.1161, 1.10219, 1.35085)), row.names = c(NA, -20L), class = "data.frame")
table
# Define UI
ui <- fluidPage(
useShinyjs(), # to initialise shiny
theme = shinytheme("superhero"),
navbarPage("Species: Pink Salmon",
windowTitle = "Salmon Model Application",
sidebarPanel(width = 3,
h3("Select Model Output"),
selectInput(inputId = "model",
label = "Model to Run",
choices = model,
selected = "Output_21yr_noStock"),
selectInput(inputId = "graphtype",
label = "Graphic",
choices = type,
selected = "lambda"),
#Slider to select custom years
chooseSliderSkin("Square"),
setSliderColor(c("LightSeaGreen ", "#FF4500", "", "Teal"), c(1, 2, 4)),
#tags$style(type = "text/css", ".irs-grid-pol.small {height: 0px;}"), #hide small ticks
sliderInput(inputId = "Yearslider",
label = "Years to plot",
sep = "",
min = min(table$year), #min and max values of spawner_maturity table6
max = max(table$year),
step = 1,
value = c(min = min(table$year),max = max(table$year))
)),
#Graphic Area mainPanel. Graphic on top and table right below it
mainPanel(
plotOutput("plot")
)))
server<- function (input, output, session) {
session$onSessionEnded(function() {
stopApp()
})
plot_data <- reactive({
table[table$year >= input$Yearslider[1] & table$year <= input$Yearslider[2], ]
})
dataInput <- reactive({
switch(input$graphtype,
"lambda" = plot_data())
})
#How can I make the "model" SelectInput drowpdown control reactive when I select a different model? The "modelInput" below is not reacting.
modelInput <- reactive({
switch(input$model,
"Output_21yr_noStock" = input$model,
"Output_21yr_yesStock" = input$model)
})
# Plot data
create_plots <- reactive({
theme_set(theme_classic(14))
xlabels <- c(min(table$year):max(table$year))
if (input$graphtype == "lambda") {
ggplot(plot_data(),aes(year,lambda)) + geom_line(size=1.5,colour="blue") +
geom_point(colour="orange",size=4) + geom_hline(yintercept=1,color="hotpink",linetype="dashed") +
scale_x_continuous("",breaks = xlabels) + legendTheme +
theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) +
labs(x="",y=expression("Lambda ("~lambda *")"),
title= paste0("Modeled Population growth rate of Delta Smelt cohort years ",
table[table$year >= input$Yearslider[1] & table$year <= input$Yearslider[2], ]))
}
})
#Render plots
output$plot <- renderPlot({
create_plots()
},height = 475)
}
# Run the application
shinyApp(ui = ui, server = server)

wilcox.test does not work in shiny

I am trying to build a 'data explorer' shiny app which contains DataTables, ggplot2 graphs and wilcox.test results. I can't seem to make the wilcox.test to work though.
Outside the shiny app, things work as it should:
dat <- data.frame(outcome=sample(c("died","survived",NA), 20, TRUE),
cntr=sample(c("hospa","hospb"), 20, TRUE),
s=rnorm(20),
t=rnorm(20), stringsAsFactors=FALSE)
wilcox.test(dat$s ~ dat$outcome)
Results:
Wilcoxon rank sum test
data: dat$s by dat$outcome
W = 25, p-value = 0.3301
alternative hypothesis: true location shift is not equal to 0
Within the shiny app, the code below gives an 'Error: grouping factor > must have exactly 2 levels'. (graphs & tables work fine; I have omitted these for clarity).
library(shiny)
library(dplyr)
dat <- data.frame(outcome=sample(c("died","survived",NA), 20, TRUE),
cntr=sample(c("hospa","hospb"), 20, TRUE),
s=rnorm(20),
t=rnorm(20), stringsAsFactors=FALSE)
ui <- navbarPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("s"="s", "t"="t"),
selected = "s"),
selectInput(inputId = "z",
label = "Color by:",
choices = c("outcome", "cntr"),
selected = "outcome")
),
mainPanel(
tabsetPanel(id="tabspanel", type = "tabs",
tabPanel(title = "Wilcox"),
h4(textOutput(outputId = "p")))
)
)
)
server <- function(input, output, session) {
df <- reactive({
data.frame(input$y, input$z)
})
output$p <- renderText({
wilcox.test(df()[,1] ~ df()[,2])
})
}
shinyApp(ui=ui, server=server)
If the code is rewritten:
wilcox.test(dat$s, dat$outcome)
then the error is 'Error: 'x' must be numeric'.
Can someone help?
The issue you are having is that the line
data.frame(input$y, input$z)
gets translated to something like
data.frame("s", "outcome")
which can't be reasonably handeled by wicox.text. You should use the following instead
data.frame(dat[[input$y]], dat[[input$z]])
There were also some other minor issues. See the code code below for a full fix.
library(shiny)
library(dplyr)
dat <- data.frame(outcome=sample(c("died","survived",NA), 20, TRUE),
cntr=sample(c("hospa","hospb"), 20, TRUE),
s=rnorm(20),
t=rnorm(20), stringsAsFactors=FALSE)
ui <- navbarPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("s"="s", "t"="t"),
selected = "s"),
selectInput(inputId = "z",
label = "Color by:",
choices = c("outcome", "cntr"),
selected = "outcome")
),
mainPanel(
tabsetPanel(id="tabspanel", type = "tabs",
tabPanel(title = "Wilcox",
verbatimTextOutput(outputId = "p")))
)
)
)
server <- function(input, output, session) {
df <- reactive({
data.frame(dat[[input$y]], dat[[input$z]])
})
output$p <- renderPrint({
wilcox.test(df()[,1] ~ df()[,2])
})
}
shinyApp(ui=ui, server=server)
Gregor's guess is quite spot on; below snippet from the server codes:
dat_subset <- reactive({
req(input$selected_type)
filter(dat, outcome %in% input$selected_type)
})
output$scatterplot <- renderPlot({
ggplot(data = dat_subset(), aes_string(x = input$x, y = input$y, color = input$z)) + geom_boxplot() + labs()
})
output$nsdtable <- DT::renderDataTable({
DT::datatable(data = dat_subset()[, 1:4],
options = list(pageLength = 10),
rownames = FALSE)
})

R Shiny: Computing new Variables selected by "selectInput"

I'm working on a dashbord with Shiny and want to compute new variables based on the selected Variabels by selectInput.
Comparable to this in normal R-Code:
library(dplyr)
new_df <- old_df %>% mutate(new_1 = old_var1 + old_var2)
I'm able to compute new values with the sliderInput, but this are only single values. I want to compute a hole new variable with all the oppertunities of displaying the new variable in Tables and graphics.
Please try the followring syntax (the data is online avalible).
As you mentioned, all Inputs are working as they should.
library(shiny)
library(readr)
library(ggplot2)
library(stringr)
library(dplyr)
library(DT)
library(tools)
load(url("http://s3.amazonaws.com/assets.datacamp.com/production/course_4850/datasets/movies.Rdata"))
ui <- fluidPage(
sidebarLayout(
# Inputs
sidebarPanel(
h3("Plotting"), # Third level header: Plotting
# Select variable for y-axis
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("IMDB rating" = "imdb_rating",
"IMDB number of votes" = "imdb_num_votes",
"Critics Score" = "critics_score",
"Audience Score" = "audience_score",
"Runtime" = "runtime"),
selected = "audience_score"),
# Select variable for x-axis
selectInput(inputId = "x",
label = "X-axis:",
choices = c("IMDB rating" = "imdb_rating",
"IMDB number of votes" = "imdb_num_votes",
"Critics Score" = "critics_score",
"Audience Score" = "audience_score",
"Runtime" = "runtime"),
selected = "critics_score"),
# Select variable for color
selectInput(inputId = "z",
label = "Color by:",
choices = c("Title Type" = "title_type",
"Genre" = "genre",
"MPAA Rating" = "mpaa_rating",
"Critics Rating" = "critics_rating",
"Audience Rating" = "audience_rating"),
selected = "mpaa_rating"),
hr(),
# Set alpha level
sliderInput(inputId = "alpha",
label = "Alpha:",
min = 0, max = 1,
value = 0.5),
# Set point size
sliderInput(inputId = "beta",
label = "Beta:",
min = 0, max = 5,
value = 2)
),
# Output:
mainPanel(plotOutput(outputId = "scatterplot"),
textOutput(outputId = "description"),
DT::dataTableOutput("moviestable"))
)
)
server <- function(input, output, session) {
output$scatterplot <- renderPlot({
ggplot(data = movies, aes_string(x = input$x, y = input$y,
color = input$z)) +
geom_point(alpha = input$alpha, size = input$beta) +
labs(x = toTitleCase(str_replace_all(input$x, "_", " ")),
y = toTitleCase(str_replace_all(input$y, "_", " ")),
color = toTitleCase(str_replace_all(input$z, "_", " ")))
})
vals <- reactiveValues()
observe({
vals$x <- input$alpha
vals$y <- input$beta
vals$sum <- vals$x + vals$y
})
output$description <- renderText({
paste0("Alpha: ",input$alpha, " Beta:", input$beta," and the sum of alpha and beta:",vals$sum, ".")
})
output$moviestable <- DT::renderDataTable({
DT::datatable(data = movies,
options = list(pageLength = 10),
rownames = FALSE)
})
}
shinyApp(ui = ui, server = server)
I tried different ways to solve this problem:
1st try:
vals2 <- reactiveValues()
observe({
vals2$x <- input$y
vals2$y <- input$x
vals2$sum <- vals2$x + vals2$y
})
output$description2 <- renderText({
paste0("Input y: ",input$y, " Input x:", input$x," and the sum of both variables is:",vals2$sum, ".")
})
Warning: Error in +: non-numeric argument to binary operator
Stack trace (innermost first):
56: observerFunc [C:/Users/XXXXXX/Desktop/app.R#110]
1: runApp
ERROR: [on_request_read] connection reset by peer
2nd try:
output$try2 <- renderUI({
movies_2 <- movies %>% mutate(new_1 = input$y + input$x)
})
output$moviestable2 <- DT::renderDataTable({
DT::datatable(data = movies_2,
options = list(pageLength = 10),
rownames = FALSE)
})
Warning: Error in inherits: object 'movies_2' not found
I've no idea where I what I can try next...
I'm very happy for every kind of help!
You should make movies_2 in a reactive. Your output$try2 won't work because its expecting UI objects.
To match the call you make on the UI side I've renamed back to moviestable and have changed input$x + input$y to paste0(input$y, input$x) since they are both character.
movies_2 <- reactive({
movies %>% mutate(new_1 := movies[[input$x]] + movies[[input$y]])
})
output$moviestable <- DT::renderDataTable({
DT::datatable(data = movies_2(),
options = list(pageLength = 10),
rownames = FALSE)
})

Basic shiny not rendering plot

I have this shiny code and the plot is not showing for some reason. Can you please extend me a hand?
Is a basic shiny plot to render in the Main Panel. Checked loads of times and still not plotting.
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
(titlePanel("APP & MEP | Size (m2) ~ Hours", windowTitle = "app")),
sidebarLayout(
sidebarPanel(
checkboxGroupInput(inputId = "checkgroup",
label = "Select Deparments",
choices = c("All", "ELE", "HVAC", "MAN", "PH", "LV"),
selected = "All", inline = F),
radioButtons(inputId = "radio",
label = "ADD Stat_Smooth?",
choices = c("YES","NO"),
inline = T),
sliderInput(inputId = "slider",
label = "SPAN Setting",
min = 0.2, max = 2, value = 1,
ticks = T)
),
mainPanel(plotOutput(outputId = "plot33"))
)
)
server <- function(input, output){
output$plot33 <- renderPlotly({
gg <- ggplot(sizedf, aes(SIZE, Hours)) + geom_point(aes(color = Department)) + ggtitle("Size(m2) vs Hours per department")
p <- ggplotly(gg)
p
})
}
shinyApp(ui = ui, server = server)
I have seen this same mistake a few time already.
plotlyOutput() should be used, not plotOutput()

Resources