library(shiny)
library(ggplot2)
outputDir <- "responses"
# Define the fields we want to save from the form
fields <- c("name", "r_num_years","frustration")
saveData <- function(input) {
# put variables in a data frame
data <- data.frame(matrix(nrow=1,ncol=0))
for (x in fields) {
var <- input[[x]]
if (length(var) > 1 ) {
# handles lists from checkboxGroup and multiple Select
data[[x]] <- list(var)
} else {
# all other data types
data[[x]] <- var
}
}
data$submit_time <- date()
# Create a unique file name
fileName <- sprintf(
"%s_%s.rds",
as.integer(Sys.time()),
digest::digest(data)
)
# Write the file to the local system
saveRDS(
object = data,
file = file.path(outputDir, fileName)
)
}
loadData <- function() {
# read all the files into a list
files <- list.files(outputDir, full.names = TRUE)
if (length(files) == 0) {
# create empty data frame with correct columns
field_list <- c(fields, "submit_time")
data <- data.frame(matrix(ncol = length(field_list), nrow = 0))
names(data) <- field_list
} else {
data <- lapply(files, function(x) readRDS(x))
# Concatenate all data together into one data.frame
data <- do.call(rbind, data)
}
data
}
deleteData <- function() {
# Read all the files into a list
files <- list.files(outputDir, full.names = TRUE)
lapply(files, file.remove)
}
resetForm <- function(session) {
# reset values
updateTextInput(session, "name", value = "")
updateSliderInput(session, "r_num_years", value = 0)
updateSliderInput(session, "frustration", value = 0)
}
# ui ----
ui <- fluidPage(
includeScript("../../../Matomo-tquant.js"),
titlePanel("Coding Experience and Level of Frustration"),
sidebarLayout(
sidebarPanel(
textInput("name", "Here you can be whoever you want to be", ""),
sliderInput("r_num_years", "Level of R Experience",
1, 10, 0, ticks = FALSE),
helpText("1= low level to 10= high level"),
br(),
sliderInput("frustration", "How much do you want to kill R",
1, 10, 0, ticks = FALSE),
helpText("1= not at all to 10= down with R"),
br(),
actionButton("submit", "Submit"),
actionButton("clear", "Clear Form"),
downloadButton("downloadData", "Download"),
actionButton("delete", "Delete All Data")
),
mainPanel(
tabsetPanel(
# tabPanel(
# "About us",
# h1(strong("We are Tiny Shiny!"), align = "center", style = "color:CC99FF"),
# br(),
# h4("We are two students from the University of Graz, who never worked with Shiny before."),
# h4("Well, we can`t say it was easy, but all this work paid up because here is our own little App"),
# h4("This App is about the visualising from the level of experience you already have in R and your frustration level working with R"),
# br(),
# h6("Authors: Bettina Brueckler and Luca Huszar", align = "center")
# ),
tabPanel(
"Experience",
plotOutput("yearsPlot")),
tabPanel(
"Frustration",
plotOutput("frustrationPlot")),
tabPanel(
"Visualisation",
plotOutput("ExperienceFrustration")),
tabPanel(
"The End",
HTML('<iframe width="600" height="300" src="//www.youtube.com/embed/dFChni3OrMs" frameborder="0" allowfullscreen></iframe>'),
h6("Authors: Bettina Brueckler and Luca Huszar", align = "center"))
)
)
)
)
server = function(input, output, session) {
# When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(input)
resetForm(session)
})
observeEvent(input$clear, {
resetForm(session)
})
# When the Delete button is clicked, delete all of the saved data files
observeEvent(input$delete, {
deleteData()
})
# Show the previous responses in a reactive table ----
output$responses <- renderDataTable({
# update with current response when Submit or Delete are clicked
input$submit
input$delete
loadData()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = "data.csv",
content = function(file) {
write.csv(loadData(), file, row.names = FALSE, quote= TRUE)
}
)
output$frustrationPlot <- renderPlot({
input$submit
input$delete
data <- loadData()
ggplot(data) +
geom_histogram(
aes(frustration),
binwidth = 1,
color = "black",
fill = "#FF9999"
) +
scale_x_continuous(
name = "Level of frustration",
breaks = 1:10,
limits = c(-0.5, 10.5)
) +
scale_y_continuous(
name = "Number of participants"
)
})
output$yearsPlot <- renderPlot({
input$submit
input$delete
data <- loadData()
ggplot(data) +
geom_histogram(
aes(r_num_years),
binwidth = 1,
color = "black",
fill = "#FF9999"
) +
# from continious to discrete --> groups
scale_x_continuous(
name = "Level of R Experience",
breaks = 0:10,
limits = c(-0.5, 10.5)
)
# theme_minimal() +
# theme(
#text = element_text(size = 20),
# plot.background = element_rect(fill = "white"),
#axis.line = element_line(color = "grey", size = 1)
# )
})
output$ExperienceFrustration <- renderPlot({
input$submit
input$delete
data <- loadData()
ggplot(data = data,
mapping = aes(x = frustration , y = r_num_years)
) +
geom_point(mapping = aes()) +
ggtitle("Scatterplot of Frustration Level and Experience in R")+
labs(x= "Frustration Level", y= "Level of Experience")+
aes(color="pink", size=5)
# theme_minimal() +
# theme(
#text = element_text(size = 20),
#panel.background = element_rect(fill = "white" ),
#axis.line = element_line(color = "grey", size = 1) )
})
}
shinyApp(ui, server)
library(shiny)
library(ggplot2)
outputDir <- "responses"
# Define the fields we want to save from the form
fields <- c("name", "r_num_years","frustration")
saveData <- function(input) {
# put variables in a data frame
data <- data.frame(matrix(nrow=1,ncol=0))
for (x in fields) {
var <- input[[x]]
if (length(var) > 1 ) {
# handles lists from checkboxGroup and multiple Select
data[[x]] <- list(var)
} else {
# all other data types
data[[x]] <- var
}
}
data$submit_time <- date()
# Create a unique file name
fileName <- sprintf(
"%s_%s.rds",
as.integer(Sys.time()),
digest::digest(data)
)
# Write the file to the local system
saveRDS(
object = data,
file = file.path(outputDir, fileName)
)
}
loadData <- function() {
# read all the files into a list
files <- list.files(outputDir, full.names = TRUE)
if (length(files) == 0) {
# create empty data frame with correct columns
field_list <- c(fields, "submit_time")
data <- data.frame(matrix(ncol = length(field_list), nrow = 0))
names(data) <- field_list
} else {
data <- lapply(files, function(x) readRDS(x))
# Concatenate all data together into one data.frame
data <- do.call(rbind, data)
}
data
}
deleteData <- function() {
# Read all the files into a list
files <- list.files(outputDir, full.names = TRUE)
lapply(files, file.remove)
}
resetForm <- function(session) {
# reset values
updateTextInput(session, "name", value = "")
updateSliderInput(session, "r_num_years", value = 0)
updateSliderInput(session, "frustration", value = 0)
}
# ui ----
ui <- fluidPage(
titlePanel("Coding Experience and Level of Frustration"),
sidebarLayout(
#change name to a generated code -> problem could be if they send it at the same time, so it should be random,
#without the chronological influence
sidebarPanel(
textInput("name", "Here you can be whoever you want to be", ""), #generate a random code
sliderInput("r_num_years", "Level of R Experience",
1, 10, 0, ticks = FALSE),
helpText("1= low level to 10= high level"),
br(),
sliderInput("frustration", "How much do you want to kill R",
1, 10, 0, ticks = FALSE),
helpText("1= not at all to 10= down with R"),
br(),
actionButton("submit", "Submit"),
actionButton("clear", "Clear Form"),
downloadButton("downloadData", "Download"),
actionButton("delete", "Delete All Data")
),
#nicer plot
mainPanel(
tabsetPanel(
tabPanel(
"Experience",
plotOutput("yearsPlot")),
tabPanel(
"Frustration",
plotOutput("frustrationPlot")),
tabPanel(
"Correlation",
plotOutput("ExperienceFrustration")
)
)
)
)
)
server = function(input, output, session) {
# When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(input)
resetForm(session)
})
observeEvent(input$clear, {
resetForm(session)
})
# When the Delete button is clicked, delete all of the saved data files
observeEvent(input$delete, {
deleteData()
})
# Show the previous responses in a reactive table ----
output$responses <- renderDataTable({
# update with current response when Submit or Delete are clicked
input$submit
input$delete
loadData()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = "data.csv",
content = function(file) {
write.csv(loadData(), file, row.names = FALSE, quote= TRUE)
}
)
output$frustrationPlot <- renderPlot({
input$submit
input$delete
data <- loadData()
ggplot(data) +
geom_histogram(
aes(frustration),
binwidth = 1,
color = "black",
fill = "grey"
) +
# from continious to discrete --> groups
scale_x_continuous(
name = "Level of frustration",
breaks = 1:10,
limits = c(-0.5, 10.5)
) +
scale_y_continuous(
name = "Number of participants",
breaks = seq(1, 40,1)
) + #--> why this doesnt work ? the whole axis disappear
theme_minimal() +
theme(
text = element_text(size = 20),
plot.background = element_rect(fill = "white"),
panel.grid = element_blank(),
axis.title.y = element_blank()
)
})
output$yearsPlot <- renderPlot({
input$submit
input$delete
data <- loadData()
ggplot(data) +
geom_histogram(
aes(r_num_years),
binwidth = 1,
color = "black",
fill = "grey"
) +
# from continious to discrete --> groups
scale_x_continuous(
name = "Number of years using R",
breaks = 0:10,
limits = c(-0.5, 10.5)
) +
theme_minimal() +
theme(
text = element_text(size = 20),
plot.background = element_rect(fill = "white"),
panel.grid = element_blank(),
axis.title.y = element_blank()
)
})
output$ExperienceFrustration <- renderPlot({
input$submit
input$delete
data <- loadData()
ggplot(data = data, mapping = aes(x = frustration , y = r_num_years)) +
geom_point(mapping = aes(color = "pink")) +
geom_smooth() +
theme_minimal() +
theme(
text = element_text(size = 20),
plot.background = element_rect(fill = "white"),
panel.grid = element_blank(),
axis.title.y = element_blank()
)
})
}
shinyApp(ui, server)