Vector as a choice in shiny::selectInput() - r

Here is a working template:
require(data.table)
require(shiny)
require(ggplot2)
x <- data.table(v1 = sample(letters[1:5], 100, replace = T),
v2 = sample(letters[1:2], 100, replace = T),
v3 = runif(100, 0, 1))
ui <- fluidPage(
sidebarPanel(
selectInput("in1", "Choice v1", selected = "All", choices = c("All" = list(letters[1:5]))),
selectInput("in2", "Choice v2", selected = "a", choices = letters[1:2])
),
mainPanel(
plotOutput("out1")
)
)
server <- function(input, output){
output$out1 <- renderPlot({
ggplot(x[v1 %in% input$in1 & v2 %in% input$in2], aes(x = v3)) +
geom_density(fill = "dodgerblue4", alpha = .7) +
theme_light()
})
}
runApp(shinyApp(ui, server))
Issue here is that I'd like to allow for selection of subset of values within variable. Line selectInput("in1", "Choice v1", selected = "All", choices = c("All" = list(letters[1:5]))) was intended to pass letters[1:5] to input$in1 effectively selecting all values and performing no subsetting of data on v1.
Same applies to any other subset of values e.g. choice "a_b_c" = c("a", "b", "c"), or "All" = x[,unique(v1)] and so on. What shiny does, is break up list to all values included in it, basically achieving opposite of desired result.
I know there is selectizeInput() to select multiple values. However, this is not viable if I want selected = "All" for all variables as initial state.

Would something like this work?
#rm(list=ls())
require(data.table)
require(shiny)
require(ggplot2)
x <- data.table(v1 = sample(letters[1:5], 100, replace = T),
v2 = sample(letters[1:2], 100, replace = T),
v3 = runif(100, 0, 1))
ui <- fluidPage(
sidebarPanel(
selectInput("in1", "Choice v1", selected = "All", choices = c("All",letters[1:5])),
selectInput("in2", "Choice v2", selected = "a", choices = letters[1:2])
),
mainPanel(
plotOutput("out1")
)
)
server <- function(input, output){
output$out1 <- renderPlot({
value <- input$in1
if(value == "All"){
value <- letters[1:5]
}
ggplot(x[v1 %in% value & v2 %in% input$in2], aes(x = v3)) +
geom_density(fill = "dodgerblue4", alpha = .7) +
theme_light()
})
}
runApp(shinyApp(ui, server))

shiny supports selection of multiple values in selectInput. You need to set multiple = TRUE and selectize = FALSE. I think this will provide you the functionality you desire.
You then make the choices and selected variables the same to preselect all of the variables. If you need to use an "all" feature, you'll need to add an action button to run updateSelectInput. Combining those two features could be done by writing a module.
require(data.table)
require(shiny)
require(ggplot2)
x <- data.table(v1 = sample(letters[1:5], 100, replace = T),
v2 = sample(letters[1:2], 100, replace = T),
v3 = runif(100, 0, 1))
ui <- fluidPage(
sidebarPanel(
selectInput("in1", "Choice v1",
selected = letters[1:5],
choices = letters[1:5],
multiple = TRUE,
selectize = FALSE),
selectInput("in2", "Choice v2",
selected = letters[1:2],
choices = letters[1:2],
multiple = TRUE,
selectize = FALSE)
),
mainPanel(
plotOutput("out1")
)
)
server <- function(input, output){
output$out1 <- renderPlot({
ggplot(x[v1 %in% input$in1 & v2 %in% input$in2], aes(x = v3)) +
geom_density(fill = "dodgerblue4", alpha = .7) +
theme_light()
})
}
runApp(shinyApp(ui, server))

While reading other answers and wondering about possible clean and compact workaround, here's what I came up with. It was crucial to have clean approach to adding new variables.
require(data.table)
require(shiny)
require(ggplot2)
x <- data.table(v1 = sample(letters[1:5], 100, replace = T),
v2 = sample(letters[1:2], 100, replace = T),
v3 = runif(100, 0, 1))
map.dt <- function(x, variables){
map.out <- data.table(name = character(), variable = character(), value = character())
for(i in variables){
map.out <- rbind(map.out,
data.table(name = x[,sort(as.character(na.omit(unique(get(i)))))],
variable = i,
value = x[,sort(as.character(na.omit(unique(get(i)))))]),
data.table(name = "All",
variable = i,
value = x[,sort(as.character(na.omit(unique(get(i)))))]))
}
return(map.out)
}
y <- map.dt(x, c("v1", "v2"))
ui <- fluidPage(
sidebarPanel(
selectInput("in1", "Choice v1", selected = "All", choices = c("All", letters[1:5])),
selectInput("in2", "Choice v2", selected = "All", choices = c("All", letters[1:2]))
),
mainPanel(
plotOutput("out1")
)
)
server <- function(input, output){
output$out1 <- renderPlot({
ggplot(x[v1 %in% y[variable == "v1" & name == input$in1, value] &
v2 %in% y[variable == "v2" & name == input$in2, value]],
aes(x = v3)) +
geom_density(fill = "dodgerblue4", alpha = .7) +
theme_light()
})
}
runApp(shinyApp(ui, server))
Basically, it's adding an intermediate mapping table which is generated via function.

Related

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

Creating variables when importing data into the shiny-application, managing the received data

Comrades! Greetings.
Please help me out ... there is some significant misunderstanding.
Suppose I created like this data.frame:
df<-data.frame(num = c(1:250),
app_num = sample(1:100, 250, replace=T),
entrance=sample(1:4, 250, replace=T),
gender=sample(c('m','f'), 250,replace=T),
age= sample(1:100, 250, replace=T))
I save it in the "*csv" format, using the command:
write.csv2(data_file,file = file.choose(new = T), row.names = FALSE, quote = FALSE)
O.K.
Now I want to create a shiny-application for displaying and working with this data like his:
library("shiny")
#to work with extra string functions
library("stringr")
library("data.table")
library("readr")
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel(h2(strong("Analysis of the composition and structure of residents"),
align = "center")),
fileInput(
inputId="fileInput",
label="Choose file",
multiple = FALSE,
accept = ".csv",
width = '100%',
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
sidebarPanel(
checkboxGroupInput(inputId="gender", label = "Choosing a gender feature:",
choices = c("Men" = "m",
"Women" = "f"),
selected= c("Men" = "m",
"Women" = "f")),
sliderInput(inputId = "age", label = "Indicate the age group:",
min = 1, max = 100, value = c(1, 100)),
selectInput(
inputId = "group",
label="Indicate the entrance",
choices=c(1:4),
selected = c(1:4),
multiple = TRUE,
selectize = TRUE,
width = NULL,
size = NULL
)
),
mainPanel(
navbarPage("",
tabPanel("Сommon data",
textOutput(outputId = "text1"),
),
tabPanel("Results table",
dataTableOutput(outputId = "content")
),
tabPanel("Graphic data")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
fileinfor <- reactiveValues(file=NULL,
ext=NULL,
datapath=NULL)
output$content <- renderDataTable({
fileinfor$file <- input$fileInput
fileinfor$datapath<-fileinfor$file$datapath
fileinfor.datapath <- fileinfor$file$datapath
fileinfor$ext <- tools::file_ext(fileinfor$datapath)
req(fileinfor$file)
validate(need(fileinfor$ext== "csv", "Please upload a csv file"))
fread(fileinfor$datapath,
showProgress = FALSE,
sep=";", quote="",header=TRUE)
})
output$text1 <- renderUI(renderText({
paste("Check ", fileinfor$datapath)
}))
}
# Run the application
shinyApp(ui = ui, server = server)
On the server side, I have several questions:
How to get the data correctly so that you can create a variable based on it and use it several times. On the example of my code, you can see that the server-side code block below no longer sees the created variable:
output $ text1 <- renderUI (renderText ({
paste ("Check", fileinfor $ datapath)
}))
Could you show by my example the creation of manipulated variables and their application? Can't figure out where and how to move?
Perhaps you are looking for this.
server <- function(input, output) {
mydf <- reactive({
req(input$fileInput)
inData <- input$fileInput
if (is.null(inData)){ return(NULL) }
mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
})
output$content <- renderDT(mydf())
output$text1 <- renderText({
req(input$fileInput)
paste("Check ", input$fileInput$datapath)
})
}
First of all, I would like to thank #YBS for this teaching.
Thanks to these tips, I managed to solve half of the problem.
The essence of the solution lies in how Shainiy works with variables. In fact, there is no way to store variables like when writing regular code. However, you can write a reactive function that will receive data and issue it to a variable that is within the framework of another function when called.
It should be noted that an explicit mention of this approach was found in the tutorial "Mastering Shiny"
As a result, a version of the working code was obtained.
If you want to try the end result, then sequentially sell the following steps:
Create a CSV file for our experiment:
df<-data.frame(num = c(1:250),
app_num = sample(1:100, 250, replace=T),
entrance=sample(1:4, 250, replace=T),
gender=sample(c('m','f'), 250,replace=T),
age= sample(1:100, 250, replace=T))
Save it in the "*csv" format, using the command:
write.csv2(data_file,file = file.choose(new = T), row.names = FALSE, quote = FALSE)
Use the below mentioned code to create Shiny app:
library("shiny")
library("stringr")
library("data.table")
library("readr")
library("DT")
library("readr")
library("here")
library("ggplot2")
library("dplyr")
library("tidyr")
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel(h2(strong("Analysis of the composition and structure of residents"),
align = "center")),
fileInput(
inputId="fileInput",
label="Choose file",
multiple = FALSE,
accept = ".csv",
width = '100%',
buttonLabel = "Choosing ...",
placeholder = "No files selected yet"
),
sidebarPanel(
checkboxGroupInput(inputId="gender", label = "Choosing a gender feature:",
choices = c("Men" = "M",
"Women" = "F"),
selected= c("Men" = "M",
"Women" = "F")),
sliderInput(inputId = "age", label = "Indicate the age group:",
min = 1, max = 100, value = c(1, 100)),
selectInput(
inputId = "group",
label="Indicate the entrance",
choices=c(1:4),
selected = c(1:4),
multiple = TRUE,
selectize = TRUE,
width = NULL,
size = NULL
)
),
mainPanel(
navbarPage("",
tabPanel("РЎommon data",
textOutput(outputId = "text1")
),
tabPanel("Results table",
dataTableOutput(outputId = "content")
),
tabPanel("Graphic data",
plotOutput(outputId = "my_plot")
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
fileinfor <- reactiveValues(file=NULL,
ext=NULL,
datapath=NULL)
gender = reactive({
gender <- input$gender
gender
})
age = reactive({
cbind(input$age[1],input$age[2])
})
group = reactive({
input$group
})
import_data <- reactive({
req(input$fileInput)
fileinfor$file <- input$fileInput
if (is.null(input$fileInput)){ return(NULL) }
fileinfor$datapath<-fileinfor$file$datapath
fileinfor$ext <- tools::file_ext(fileinfor$datapath)
validate(need(fileinfor$ext== "csv", "Please upload a csv file"))
import_data <- fread(fileinfor$datapath,
showProgress = FALSE,
sep=";", quote="",header=TRUE)
})
output$content <- renderDT({
GENDER = gender()
GROUP = group()
AGE = age()
req(import_data())
data_file <- import_data()
names(data_file) <- c("ID", "App", "Entrance", "Gender", "Age")
data_file <- mutate_at(data_file, vars(Gender), as.factor)
data_file<- mutate(data_file, Gender = factor(Gender, labels = c("F", "M")))
data_file <- subset(data_file,data_file$Age>=AGE[1]
& data_file$Age<=AGE[2]
& data_file$Entrance %in% GROUP
& data_file$Gender %in% GENDER)
})
output$text1 <- renderText({
req(input$fileInput)
gender <- gender()
paste(length(gender))
})
output$my_plot= reactivePlot(function(){
GENDER = gender()
GROUP = group()
AGE = age()
req(import_data())
data_file <- import_data()
names(data_file) <- c("ID", "App", "Entrance", "Gender", "Age")
data_file <- mutate_at(data_file, vars(Gender), as.factor)
data_file<- mutate(data_file, Gender = factor(Gender, labels = c("F", "M")))
data_file <- subset(data_file,data_file$Age>=AGE[1]
& data_file$Age<=AGE[2]
& data_file$Entrance %in% GROUP
& data_file$Gender %in% GENDER)
df <- group_by(data_file, data_file$Entrance, data_file$Gender)
df <- summarise(df, N = n())
names(df) <- c("Entrance", "Gender", "Quantity")
df <- mutate_at(df, vars(Gender), as.factor)
print(data_file$Gender)
#df <- mutate(df, Gender = factor(Gender, levels = c("f", "m")))
df <- complete(df, Gender, fill = list(M = 0, F = 0))
baseR.sbst.rssgn <- function(x) {
x[is.na(x)] <- 0
x
}
df$Quantity <- baseR.sbst.rssgn(df$Quantity)
ggplot(data = df, aes(x = factor(df$Gender), y = df$Quantity, fill = df$Gender)) +
geom_bar(stat = "identity", position = position_dodge2(0.9)) +
geom_text(data = df, aes(label = df$Quantity, y = 0), vjust = -0.5, position = position_dodge2(0.9)) +
scale_fill_discrete(name = "Title", labels = c("F", "M")) +
facet_wrap(~ df$Entrance, nrow = 1, strip.position = "bottom") +
xlab("Distribution of residents by entrances, taking into account gender") +
ylab("Number of residents") +
theme(
strip.placement = "outside",
strip.background = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
)
#?(ZMlength ~ Month, data = dat[dat$Lake == LAKE, ],
# main = "", xlab = "Month", ylab = "Shell length (mm)")
})
}
# Run the application
shinyApp(ui = ui, server = server)
What problems did I not solve:
I would like to immediately calculate the maximum and minimum values in the "Age" column when opening a file and change the settings for sliderInput. I would like to do the same with selectInput.
I would like to use the Saini application not only to analyze the downloaded data, but also to replenish the CSV file. In this part, I do not know anything at all.

Selecting many items from the list in R

I created an application in Shiny where I would like to choose multiple items from the drop-down menu. Unfortunately, I don't know how to make items on the list reduce after a given menu selection. By which all lines merge into a whole. what should I add in the code so that each model is a separate line. Below I put a picture with charts.
My code:
library(shiny)
library(plotly)
library(readxl)
library(shinyWidgets)
library(shinydashboard)
library(shinyjs)
library(DT)
df1 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Model = paste0('Ferrari ', rep(LETTERS[1:10], each = 12)),
Value = sample(c(0:300),120, replace = T),
Car = rep('Ferrari', 10,each = 12), Year = rep(2019:2020, each = 60),Country = rep(c("USA","DE"), each = 12, times = 5), stringsAsFactors = F)
df2 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Model = paste0('Porsche ', rep(LETTERS[1:10], each = 12)),
Value = sample(c(0:300),120, replace = T),
Car = rep('Porsche', 10,each = 12), Year = rep(2019:2020, each = 60), Country = rep(c("USA","DE"), each = 12, times = 5),stringsAsFactors = F)
data <-rbind(df1, df2)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(
sidebarPanel( width = 3,
uiOutput("category1"),
uiOutput("category2"),
uiOutput("category3"),
uiOutput("category4")),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot", plotlyOutput("plot", height = 550,width = 1000))
)
)
)
)
server <- function(input, output,session) {
output$category1 <- renderUI({
selectInput('cat1', 'Choose year:', multiple = T, selected = NULL, choices = sort(as.numeric(unique(data$Year))))
})
df_subset <- eventReactive(input$cat1,{
if(input$cat1=="All") {df_subset <- data}
else{df_subset <- data[data$Year == input$cat1,]}
})
df_subset1 <- reactive({
if(is.null(input$cat2)){df_subset()} else {df_subset()[df_subset()$Country %in% input$cat2,]}
})
output$category2 <- renderUI({
selectInput('cat2', 'Choose country:', choices = sort(as.character(unique(df_subset()$Country))), multiple = T, selected = NULL)
})
df_subset2 <- reactive({
if(is.null(input$cat3)){df_subset1()} else {df_subset1()[df_subset1()$Car %in% input$cat3,]}
})
output$category3 <- renderUI({
selectInput('cat3', 'Choose car:', choices = sort(as.character(unique(df_subset1()$Car))), multiple = F, selected = NULL)
})
df_subset3 <- reactive({
if(is.null(input$cat4)){df_subset2()} else {df_subset2()[df_subset2()$Model %in% input$cat4,]}
})
output$category4 <- renderUI({
pickerInput('cat4', 'Choose model:', choices = sort(as.character(unique(df_subset2()$Model))), multiple = TRUE, selected = NULL)
})
output$plot <- renderPlotly({
xform <- list(categoryorder = "array",
categoryarray = df_subset3()$Month,
title = " ",
nticks=12)
plot_ly(data=df_subset3(), x=~Month, y = ~Value, type = 'scatter', mode = 'lines', name = 'Value') %>%
layout(title = " ",xaxis = xform) %>%
layout(legend = list(orientation = 'h', xanchor = "center", y=1.1, x=0.5))
})
}
shinyApp(ui, server)
To display each model as a separate line on the plot, you can assign the Model column of your dataset to the color parameter of plot_ly this way:
plot_ly( data = df_subset3(), x = ~Month, y = ~Value, color = ~Model, ...)

r shiny selectInput - selectable classes in only one column

I'm new to R and shiny. I have a problem that I could not solve.
I have a histogram where I want to make the classes separately selectable.
The classes are all in one column. To make them separately selectable, I did not succeed.
How do I get it to work?
Thanks a lot
## app.R ##
set.seed(24)
df <- data.frame(Class = sample(LETTERS[1:5], 30, replace = TRUE),
Amount = sample(5:20, 30, replace = TRUE),
stringsAsFactors= FALSE, check.names = FALSE)
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
output$sum = renderPrint({
summary(df)
})
output$str = renderPrint({
str(df)
})
output$data = renderTable({
colm = as.numeric(input$var)
df[colm]
head(df)
})
output$myhist <- renderPlot({
colm = as.numeric(input$var)
hist(df$Amount, col =input$colour, xlim = c(0, max(df$Amount)), main = "Histogram", breaks = seq(0, max(df$Amount),l=input$bin+1),
xlab = names(df$Amount)
)}
)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("var", label = "1. Select Class",
choices = c("A" = 1, "B" = 2, "C" = 3, "D"= 4, "E" = 5),
selected = 2),
sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=25, value=15),
radioButtons("colour", label = "3. Select the color of histogram",
choices = c("Green", "Red",
"Blue"), selected = "Green")
),
mainPanel(
tabsetPanel(type="tab",
tabPanel("Plot", plotOutput("myhist")),
tabPanel("Summary", verbatimTextOutput("sum")),
tabPanel("Structure", verbatimTextOutput("str")),
tabPanel("Data", tableOutput("data"))
)
)
)
)
shinyApp(ui = ui, server = server)
I appreciate your help.
You have a few options:
Allow the selectInput to have multiple selections, by adding multiple = TRUE:
selectInput("var", label = "1. Select Class", choices = c("A" = 1, "B" = 2, "C" = 3, "D"= 4, "E" = 5), multiple = TRUE)
Use a checkbox group:
checkboxGroupInput('var', label = "1. Select Class", choices = c("A" = 1, "B" = 2, "C" = 3, "D"= 4, "E" = 5))
I recommend the 2nd option, using a checkbox group, as I believe they are easy for users to understand.
EDIT
As requested here is the full code, with the checkbox group linked to the chart:
## app.R ##
library(shiny)
set.seed(24)
df <- data.frame(Class = sample(LETTERS[1:5], 30, replace = TRUE),
Amount = sample(5:20, 30, replace = TRUE),
stringsAsFactors= FALSE, check.names = FALSE)
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
output$sum = renderPrint({
summary(df)
})
output$str = renderPrint({
str(df)
})
output$data = renderTable({
colm = as.numeric(input$var)
df[colm]
head(df)
})
output$myhist <- renderPlot({
df_plot <- df[df$Class %in% input$var, ]
hist(df_plot$Amount, col = input$colour, xlim = c(0, max(df_plot$Amount)), main = "Histogram", breaks = seq(0, max(df_plot$Amount),l=input$bin+1),
xlab = names(df_plot$Amount)
)}
)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput('var', label = "1. Select Class", choices = c("A", "B", "C", "D", "E"), selected = "B"),
sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=25, value=15),
radioButtons("colour", label = "3. Select the color of histogram",
choices = c("Green", "Red",
"Blue"), selected = "Green")
),
mainPanel(
tabsetPanel(type="tab",
tabPanel("Plot", plotOutput("myhist")),
tabPanel("Summary", verbatimTextOutput("sum")),
tabPanel("Structure", verbatimTextOutput("str")),
tabPanel("Data", tableOutput("data"))
)
)
)
)
shinyApp(ui = ui, server = server)

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

Resources