Мой вопрос связан с двумя предыдущими вопросами ( 1 , 2 ), которые были разумно решены Эли Берков . Мой пользовательский интерфейс состоит из кнопки для динамического добавления новой строки с несколькими виджетами selectizeInput (через insertUI на моем сервере) один за другим внутри соответствующего столбца, причем выбранные варианты новых виджетов совпадают с выбранными вариантами виджетов в предыдущей строке,Рядом с каждой динамической строкой есть кнопка действия, которая удаляет соответствующую строку (еще раз спасибо Eli Berkow также за это решение). Номер каждой удаленной строки (которую вы видите слева) затем сохраняется внутри реактивного вектора. Кроме того, я сохранил также номера доступных строк внутри вектора для других областей, связанных с моей формой. Вот код, используемый до сих пор:
library(shiny)
library(shinyjs)
##########========== UI ==========##########
ui <- fluidPage(
br(),
useShinyjs(),
br(),
fluidRow(
column(width = 3,
align = "center",
h5("Letters")
),
column(width = 3,
align = "center",
h5("Numbers")
)
),
br(),
fluidRow(
column(width = 12,
tags$div(id = "amr_test_placeholder")
)
),
fluidRow(
br(),
column(width = 12,
actionButton(inputId = "add_amr_test",
label = icon(name = "plus",
lib = "font-awesome")),
actionButton(inputId = "reset_button",
label = "RESET FIELDS")
)
),
br(),
br(),
fluidRow(
column(width = 6,
textOutput(outputId = "print_delete")
)
),
fluidRow(
column(width = 6,
textOutput(outputId = "print_deleted_rows")
)
),
fluidRow(
column(width = 6,
textOutput(outputId = "print_subset_input_number")
)
),
fluidRow(
column(width = 6,
tableOutput(outputId = "show_table")
)
)
)
#########========== SERVER ==========##########
server <- function(input, output, session) {
amr_test_values <- reactiveValues(val = 0,
ignore = 0)
#####===== Defined the input number to count every row =====#####
input_number <- reactive({
input_number <- input$add_amr_test + 1
return(input_number)
})
observeEvent(input$add_amr_test, {
amr_test_divId <- max(amr_test_values$val) + 1
#####==== Define variables to store previous widget values =====#####
# Animal species
if (!is.null(eval(parse(text = paste0("input$letters_", input_number() - 1))))) {
letters_value = eval(parse(text = paste0("input$letters_", input_number() - 1)))
} else {
letters_value = ""
}
# Animal sample type
if (!is.null(eval(parse(text = paste0("input$numbers_", input_number() - 1))))) {
numbers_value = eval(parse(text = paste0("input$numbers_", input_number() - 1)))
} else {
numbers_value = ""
}
#####===== Insert dynamic UI =====#####
insertUI(
selector = "#amr_test_placeholder",
where = "beforeBegin",
ui = tags$div(id = amr_test_divId,
tags$head(tags$style(HTML(".shiny-split-layout > div {overflow: visible;}"))),
br(),
fluidRow(
column(width = 3,
splitLayout(cellWidths = c("15%", "8%", "77%"),
actionButton(inputId = paste0("delete_row_",
input_number()),
label = div(icon(name = "times",
lib = "font-awesome")),
style = "color: #FFFFFF; border-radius: 50%; border: 1px solid #2D2D2D; background-color: #2D2D2D; font-color: red; padding: 0.6px 2.8px 0.3px 3px; font-size:48%; margin-top: 8px;"),
h6(input_number()),
selectizeInput(inputId = paste0("letters_",
input_number()),
label = NULL,
choices = c("A" = "",
"A",
"B",
"C",
"D",
"E",
"F",
"F"),
selected = letters_value,
width = "100%",
options = list(create = TRUE))
)
),
column(width = 3,
selectizeInput(inputId = paste0("numbers_",
input_number()),
label = NULL,
choices = list("1" = "",
"1" = "1",
"2" = "2",
"3" = "3",
"4" = "4",
"5" = "5"),
selected = numbers_value,
width = "100%")
)
)
)
)
#####===== Update reactive val =====#####
amr_test_values$val <- c(amr_test_values$val,
amr_test_divId)
}, ignoreNULL = FALSE)
#####===== Remove dynamic UI by rows =====#####
observeEvent(lapply(paste0("delete_row_", amr_test_values$val), function(x) input[[x]]), {
value <- grep(1, lapply(paste0("delete_row_", amr_test_values$val), function(x) input[[x]]))
value <- value[!value%in%amr_test_values$ignore]
if (length(value) != 0) {
removeUI(
selector = paste0('#', value - 1)
)
amr_test_values$ignore <- c(amr_test_values$ignore,
value)
}
})
#####===== Keep track of deleted and remaining rows =====#####
deleted_rows <- reactive({
deleted_rows <- grep(1, lapply(paste0("delete_row_", amr_test_values$val), function(x) input[[x]])) - 1
return(deleted_rows)
})
subset_input_number <- reactive({
if (length(deleted_rows()) > 0) {
subset_input_number <- setdiff(x = seq(from = 1,
to = input_number(),
by = 1),
y = deleted_rows())
}
return(subset_input_number)
})
#####===== Dataset to check the dynamic updates of the responses =====#####
response <- reactive({
if (input_number() != 0 & !is.null(input[[paste0("letters_", input_number())]])) {
response <- data.frame("Letters" = sapply(X = 1:input_number(),
FUN = function(i) {
input[[paste0("letters_", i)]]
}),
"Numbers" = sapply(X = 1:input_number(),
FUN = function(i) {
input[[paste0("numbers_", i)]]
})
)
return(response)
} else {
response <- NULL
}
})
#####===== Print total number, deleted and available rows =====#####
output$print_delete <- renderText({
print(paste0("Rows: ", nrow(response())))
})
output$print_deleted_rows <- renderText({
if (length(deleted_rows()) > 0) {
print(paste0("Deleted_rows: ", deleted_rows()))
}
})
output$print_subset_input_number <- renderText({
if (length(deleted_rows()) > 0) {
print(paste0("Subset_input_numbers: ", subset_input_number()))
}
})
output$show_table <- renderTable({
response()
})
}
#####==== Launch App =====#####
shinyApp(ui = ui, server = server)
Кнопка RESET FIELDS на данный момент не работает и, более того, как вы можете заметить, в мой пользовательский интерфейс я также вставилвременный renderTable() для отображения динамического фрейма данных и печати чисел, соответствующих всем его строкам, удаленным и доступным (если вы удалите хотя бы одну строку). Таким образом, несмотря на то, что я удаляю одну строку с помощью кнопки x, мой фрейм данных не меняется, но я могу отслеживать удаленные числа и, позже, поднастроить свой фрейм данных. С этим решением позже я уберу нумерацию возле каждой строки, потому что она мне действительно не нужна. То, чего я сейчас пытаюсь достичь, это также использовать КНОПКУ СБРОСА , чтобы удалить все «неподвижные» доступные строки (не знаю, возможно ли сохранить одну строку в начале, но, возможно, неттак важно после сброса). Опять же, эта кнопка не должна изменять весь мой фрейм данных, но должна просто иметь возможность каким-то образом подключиться к предыдущему наблюдающему событию и добавить числа, соответствующие удаленным строкам после сброса, в существующую реактивную переменную deleted_rows(). Опять же, существующее количество строк не должно быть сброшено, потому что таким образом я всегда могу поднастроить свой фрейм данных с удаленными строками, и в основном пользователь мог сбросить фрейм данных несколько раз. Я думаю, что код, который будет добавлен к существующему наблюдателю, всегда должен содержать функцию removeUI() (ниже приведен пример, который Eli Berkow всегда предоставляет также для этого решения), но я не могу понять, какдля соединения двух функций.
observeEvent(input$reset_button, {
for(remove_value in 3:max(amr_test_values$val)) {
removeUI(
selector = paste0('#', remove_value)
)
}
amr_test_values$reset <- input$add_amr_test
amr_test_values$val <- c(0, 2)
})
Заранее большое спасибо за вашу доступность!