-
Notifications
You must be signed in to change notification settings - Fork 1
/
app.R
123 lines (105 loc) · 3.82 KB
/
app.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
library(shiny)
ui <- fluidPage(
titlePanel("Delete rows"),
mainPanel(
selectInput('datasetSelect',
label = 'Select data',
choices = c("mtcars", "iris", "faithful")),
uiOutput('undoUI'),
DT::dataTableOutput("dtable")
)
)
server <- function(input, output) {
rv <- reactiveValues(
data = NULL,
deletedRows = NULL,
deletedRowIndices = list()
)
observeEvent(input$datasetSelect, {
rv$data <- switch (input$datasetSelect,
"mtcars" = mtcars,
"iris" = iris,
"faithful" = faithful
)
# Clear the previous deletions
rv$deletedRows <- NULL
rv$deletedRowIndices = list()
})
observeEvent(input$deletePressed, {
rowNum <- parseDeleteEvent(input$deletePressed)
dataRow <- rv$data[rowNum,]
# Put the deleted row into a data frame so we can undo
# Last item deleted is in position 1
rv$deletedRows <- rbind(dataRow, rv$deletedRows)
rv$deletedRowIndices <- append(rv$deletedRowIndices, rowNum, after = 0)
# Delete the row from the data frame
rv$data <- rv$data[-rowNum,]
})
observeEvent(input$undo, {
if(nrow(rv$deletedRows) > 0) {
row <- rv$deletedRows[1, ]
rv$data <- addRowAt(rv$data, row, rv$deletedRowIndices[[1]])
# Remove row
rv$deletedRows <- rv$deletedRows[-1,]
# Remove index
rv$deletedRowIndices <- rv$deletedRowIndices[-1]
}
})
# Disable the undo button if we have not deleted anything
output$undoUI <- renderUI({
if(!is.null(rv$deletedRows) && nrow(rv$deletedRows) > 0) {
actionButton('undo', label = 'Undo delete', icon('undo'))
} else {
actionButton('undo', label = 'Undo delete', icon('undo'), disabled = TRUE)
}
})
output$dtable <- DT::renderDataTable(
# Add the delete button column
deleteButtonColumn(rv$data, 'delete_button')
)
}
#' Adds a row at a specified index
#'
#' @param df a data frame
#' @param row a row with the same columns as \code{df}
#' @param i the index we want to add row at.
#' @return the data frame with \code{row} added to \code{df} at index \code{i}
addRowAt <- function(df, row, i) {
# Slow but easy to understand
if (i > 1) {
rbind(df[1:(i - 1), ], row, df[-(1:(i - 1)), ])
} else {
rbind(row, df)
}
}
#' A column of delete buttons for each row in the data frame for the first column
#'
#' @param df data frame
#' @param id id prefix to add to each actionButton. The buttons will be id'd as id_INDEX.
#' @return A DT::datatable with escaping turned off that has the delete buttons in the first column and \code{df} in the other
deleteButtonColumn <- function(df, id, ...) {
# function to create one action button as string
f <- function(i) {
# https://shiny.rstudio.com/articles/communicating-with-js.html
as.character(actionButton(paste(id, i, sep="_"), label = NULL, icon = icon('trash'),
onclick = 'Shiny.setInputValue(\"deletePressed\", this.id, {priority: "event"})'))
}
deleteCol <- unlist(lapply(seq_len(nrow(df)), f))
# Return a data table
DT::datatable(cbind(delete = deleteCol, df),
# Need to disable escaping for html as string to work
escape = FALSE,
options = list(
# Disable sorting for the delete column
columnDefs = list(list(targets = 1, sortable = FALSE))
))
}
#' Extracts the row id number from the id string
#' @param idstr the id string formated as id_INDEX
#' @return INDEX from the id string id_INDEX
parseDeleteEvent <- function(idstr) {
res <- as.integer(sub(".*_([0-9]+)", "\\1", idstr))
if (! is.na(res)) res
}
# Run the application
shinyApp(ui = ui, server = server)