Новичок в shiny
и борется с этим уже более двух дней.
Я создал приложение, в котором пользователь загружает файл данных .csv
и выбирает одну или несколько переменных, имена которых отображаются в приложении в виде флажков. Когда флажок установлен, под ним появляется новый флажок с тем же именем, а при щелчке по нему рядом появляется textAreaInput
, где пользователь может добавить имена переменных, которые составляют целевую переменную в виде шкалы. Вот упрощенная версия приложения:
library(shiny)
ui <- fluidPage(
mainPanel(
fileInput(inputId = "file", label = "Choose File", multiple = TRUE, accept = ".csv"),
uiOutput(outputId = "varCheckBoxesIndivScores"),
column(width = 3,
uiOutput(outputId = "selectedScoresCheckBoxes")),
conditionalPanel(condition = "input.selectedScoresCheckBoxes",
column(width = 6,
uiOutput(outputId = "variablesConstitutingScale"))
)
)
)
server = function(input, output, session) {
df <- reactive({
if (is.null(input$file)) {
return(NULL)
} else {
tbl <- fread(input$file$datapath, stringsAsFactors = TRUE)
return(tbl)
}
})
output$varCheckBoxesIndivScores <- renderUI({
if (is.null(df())) {
return(NULL)
} else if (!is.null(df())) {
return(tags$div(align = "left",
class = "multicol",
checkboxGroupInput(inputId = "varCheckBoxesIndivScores",
label = "Select variables",
choices = colnames(df()))))
}
})
output$selectedScoresCheckBoxes <- renderUI({
if (is.null(df())) {
return(NULL)
} else if (!is.null(df())) {
return(tags$div(align = "left",
checkboxGroupInput(inputId = "selectedScoresCheckBoxes",
label = "",
choices = input$varCheckBoxesIndivScores)))
}
})
output$variablesConstitutingScale <- renderUI({
if (is.null(df())) {
return(NULL)
} else if (!is.null(df()) & length(input$selectedScoresCheckBoxes > 0)) {
var.list.input.fields <- lapply(input$selectedScoresCheckBoxes, function(i) {
textAreaInput(inputId = "i", label = paste("Variables constituting scale", i), width = "700px", height = "100px", value = NULL)
})
var.list.input.fields
}
})
}
shinyApp(ui = ui, server = server)
Данные для загрузки генерируются следующим образом (просто отрывок, у настоящего есть больше столбцов и случаев):
library(data.table)
x <- data.table(ID = c(2201:2220), VAR1 = rnorm(n = 20, mean = 10, sd = 2),
VAR2 = rnorm(n = 20, mean = 100, sd = 20), VAR3 = 1:20, VAR4 = 21:40,
VAR5 = 41:60, VAR6 = 61:80, VAR7 = 81:100)
write.csv(x = x, file = "/tmp/test_data.csv", row.names = FALSE)
Работает нормально, ошибок нет. Вот как это выглядит после того, как я ввожу имена переменных в каждое из сгенерированных полей textAreaInput
:
Однако я хотел бы использовать вводимые пользователем данные из каждого динамически сгенерированного textAreaInput
и сохранить его в виде списка:
list(VAR1 = "VAR3 VAR4 VAR5", VAR2 = "VAR6 VAR7")
или же
list(VAR1 = "VAR3", "VAR4", "VAR5", VAR2 = "VAR6", "VAR7")
внутри серверной части приложения для будущего использования.
Я пытался проследить за решением в потоке это, но мне не удалось прийти к какому-либо решению, и я очень запутался. Может кто поможет?
Во-первых, убедитесь, что каждому из динамически добавленных элементов присвоено уникальное имя. Вы только что жестко запрограммировали букву «i» в образце. Вы хотите что-то вроде
textAreaInput(inputId = paste0("varconst_",i), label = paste("Variables constituting scale", i),
width = "700px", height = "100px", value = NULL)
Затем вы можете наблюдать эти текстовые поля с чем-то вроде этого
observeEvent(lapply(paste0("varconst_", input$selectedScoresCheckBoxes), function(x) input[[x]]), {
obj <- Map(function(x) input[[paste0("varconst_",x)]], input$selectedScoresCheckBoxes)
dput(obj)
})
Здесь я просто использовал dput
, чтобы выгрузить список на консоль, чтобы вы могли видеть его по мере обновления, но вы можете делать с ним все, что захотите.
Фантастический! Большое спасибо. Действительно, я не думал об уникальности имен. Работает отлично.
Я изменил код приложения в соответствии с ответом MrFlick. Чтобы оставить бумажный след от полного решения, я публикую его ниже. Несколько дополнительных изменений, которые я сделал, включают распечатку списка с переменными для каждого из сгенерированных полей textAreaInput
, так что список можно просмотреть в самом приложении. Я также добавил некоторые дополнительные модификации obj
после того, как он был сгенерирован, чтобы получить список по желанию.
Если есть больше динамически генерируемых выходных разделов, где есть флажки и связанные текстовые области, индекс varconst_
должен быть уникальным для разных фрагментов кода (например, varconst1_
, varconst2_
, varconst3_
и т. д.).
Вот код:
library(shiny)
ui <- fluidPage(
mainPanel(
fileInput(inputId = "file", label = "Choose File", multiple = TRUE, accept = ".csv"),
uiOutput(outputId = "varCheckBoxesIndivScores"),
fluidRow(
column(width = 3,
uiOutput(outputId = "selectedScoresCheckBoxes")),
conditionalPanel(condition = "input.selectedScoresCheckBoxes",
column(width = 6,
uiOutput(outputId = "variablesConstitutingScale")))),
br(),
fluidRow(
conditionalPanel(condition = "input.selectedScoresCheckBoxes",
verbatimTextOutput(outputId = "scalesVarList")))
)
)
server = function(input, output, session) {
df <- reactive({
if (is.null(input$file)) {
return(NULL)
} else {
tbl <- fread(input$file$datapath, stringsAsFactors = TRUE)
return(tbl)
}
})
output$varCheckBoxesIndivScores <- renderUI({
if (is.null(df())) {
return(NULL)
} else if (!is.null(df())) {
return(tags$div(align = "left",
class = "multicol",
checkboxGroupInput(inputId = "varCheckBoxesIndivScores",
label = "Select variables",
choices = colnames(df()))))
}
})
output$selectedScoresCheckBoxes <- renderUI({
if (is.null(df())) {
return(NULL)
} else if (!is.null(df())) {
return(tags$div(align = "left",
checkboxGroupInput(inputId = "selectedScoresCheckBoxes",
label = "",
choices = input$varCheckBoxesIndivScores)))
}
})
output$variablesConstitutingScale <- renderUI({
if (is.null(df())) {
return(NULL)
} else if (!is.null(df()) & length(input$selectedScoresCheckBoxes > 0)) {
var.list.input.fields <- lapply(input$selectedScoresCheckBoxes, function(i) {
textAreaInput(inputId = paste0("varconst_",i), label = paste("Variables constituting scale", i),
width = "700px", height = "100px", value = NULL)
})
var.list.input.fields
}
})
observeEvent(lapply(paste0("varconst_", input$selectedScoresCheckBoxes), function(x) input[[x]]), {
obj <- Map(function(x) input[[paste0("varconst_",x)]], input$selectedScoresCheckBoxes)
obj <- sapply(obj, function(i) {
if (length(i) > 0) {
strsplit(x = i, split = " ")
}
})
dput(obj)
output$scalesVarList <- renderPrint({
if (is.null(df())) {
return(NULL)
} else if (!is.null(df()) && length(input$selectedScoresCheckBoxes) > 0 && length(obj) > 0) {
print(obj)
}
})
})
}
shinyApp(ui = ui, server = server)
(просто комментарий, ничего общего с ответом). Это выглядит не очень удобно. Я бы использовал блестящее дерево для выбора.