Skip to content

Instantly share code, notes, and snippets.

@gluc
Last active Aug 25, 2020
Embed
What would you like to do?
Shiny CRUD
library(shiny)
library(shinyjs)
# Get table metadata. For now, just the fields
# Further development: also define field types
# and create inputs generically
GetTableMetadata <- function() {
fields <- c(id = "Id",
name = "Name",
used_shiny = "Used Shiny",
r_num_years = "R Years")
result <- list(fields = fields)
return (result)
}
# Find the next ID of a new record
# (in mysql, this could be done by an incremental index)
GetNextId <- function() {
if (exists("responses") && nrow(responses) > 0) {
max(as.integer(rownames(responses))) + 1
} else {
return (1)
}
}
#C
CreateData <- function(data) {
data <- CastData(data)
rownames(data) <- GetNextId()
if (exists("responses")) {
responses <<- rbind(responses, data)
} else {
responses <<- data
}
}
#R
ReadData <- function() {
if (exists("responses")) {
responses
}
}
#U
UpdateData <- function(data) {
data <- CastData(data)
responses[row.names(responses) == row.names(data), ] <<- data
}
#D
DeleteData <- function(data) {
responses <<- responses[row.names(responses) != unname(data["id"]), ]
}
# Cast from Inputs to a one-row data.frame
CastData <- function(data) {
datar <- data.frame(name = data["name"],
used_shiny = as.logical(data["used_shiny"]),
r_num_years = as.integer(data["r_num_years"]),
stringsAsFactors = FALSE)
rownames(datar) <- data["id"]
return (datar)
}
# Return an empty, new record
CreateDefaultRecord <- function() {
mydefault <- CastData(list(id = "0", name = "", used_shiny = FALSE, r_num_years = 2))
return (mydefault)
}
# Fill the input fields with the values of the selected record in the table
UpdateInputs <- function(data, session) {
updateTextInput(session, "id", value = unname(rownames(data)))
updateTextInput(session, "name", value = unname(data["name"]))
updateCheckboxInput(session, "used_shiny", value = as.logical(data["used_shiny"]))
updateSliderInput(session, "r_num_years", value = as.integer(data["r_num_years"]))
}
ui <- fluidPage(
#use shiny js to disable the ID field
shinyjs::useShinyjs(),
#data table
DT::dataTableOutput("responses", width = 300),
#input fields
tags$hr(),
shinyjs::disabled(textInput("id", "Id", "0")),
textInput("name", "Name", ""),
checkboxInput("used_shiny", "Used Shiny", FALSE),
sliderInput("r_num_years", "R Years", 0, 25, 2, ticks = FALSE),
#action buttons
actionButton("submit", "Submit"),
actionButton("new", "New"),
actionButton("delete", "Delete")
)
server <- function(input, output, session) {
# input fields are treated as a group
formData <- reactive({
sapply(names(GetTableMetadata()$fields), function(x) input[[x]])
})
# Click "Submit" button -> save data
observeEvent(input$submit, {
if (input$id != "0") {
UpdateData(formData())
} else {
CreateData(formData())
UpdateInputs(CreateDefaultRecord(), session)
}
}, priority = 1)
# Press "New" button -> display empty record
observeEvent(input$new, {
UpdateInputs(CreateDefaultRecord(), session)
})
# Press "Delete" button -> delete from data
observeEvent(input$delete, {
DeleteData(formData())
UpdateInputs(CreateDefaultRecord(), session)
}, priority = 1)
# Select row in table -> show details in inputs
observeEvent(input$responses_rows_selected, {
if (length(input$responses_rows_selected) > 0) {
data <- ReadData()[input$responses_rows_selected, ]
UpdateInputs(data, session)
}
})
# display table
output$responses <- DT::renderDataTable({
#update after submit is clicked
input$submit
#update after delete is clicked
input$delete
ReadData()
}, server = FALSE, selection = "single",
colnames = unname(GetTableMetadata()$fields)[-1]
)
}
# Shiny app with 3 fields that the user can submit data for
shinyApp(ui = ui, server = server)
@josedv82

This comment has been minimized.

Copy link

@josedv82 josedv82 commented Mar 2, 2019

what would be the code to save the new responses to a local directory and load it back every time a user opens the app again?

@philibe

This comment has been minimized.

Copy link

@philibe philibe commented Mar 25, 2019

@gluc
Thank you for this gist and your article on ipub about grouped fields by sapply().

@der-lu

This comment has been minimized.

Copy link

@der-lu der-lu commented Jan 3, 2020

hey. nice shiny app..

im searching exactly something like this for my crud based DB app. Can you guve some assistance in changung the code for saving the data locally?

thx :)

@Harish2f

This comment has been minimized.

Copy link

@Harish2f Harish2f commented Jun 2, 2020

Nice one. Does this support persistent data storage?

@Harish2f

This comment has been minimized.

Copy link

@Harish2f Harish2f commented Jun 2, 2020

How could we integrate with MySQL to use persistent data storage

@TarJae

This comment has been minimized.

Copy link

@TarJae TarJae commented Aug 9, 2020

Thank you. Very helpful!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment