Заранее спасибо за помощь.
Я создаю блестящее приложение, которое позволит пользователю назначать теги для фрейма данных открытых текстовых комментариев. Для этих целей я создал простой фальшивый фрейм данных.
Это приложение в настоящее время принимает помеченные входные данные и сохраняет их в CSV-файлы в папке «answers» в моем каталоге.
Однако, одна особенность, которую я не могу понять, - это как добавить отображаемый «комментарий» (текущий вывод текста), который генерируется случайным образом после каждой отправки (которой пользователь назначает теги) к столбцу в файле сохраненных данных.
В настоящий момент приложение работает, как и ожидалось, при сохранении пользовательских данных.
Ниже приведен код, включающий одну из моих неудачных попыток решить эту проблему.
(Вторичная, хотя и менее важная проблема заключается в том, что при начальной загрузке выходных данных нет, так как у меня есть выходные данные, изменяющиеся в зависимости от действия отправки, но я бы хотел загрузить с комментарием, который будет помечен.)
library(shiny)
library(shinyjs)
library(tidyverse)
library(here)
library(digest)
# which fields get saved
fieldsAll <- c("tag", "tag2", "tag3")
# make at least one tag mandatory
fieldsMandatory <- c("tag")
# add an asterisk to an input label
labelMandatory <- function(label) {
tagList(
label,
span("*", class = "mandatory_star")
)
}
# get current Epoch time
epochTime <- function() {
return(as.integer(Sys.time()))
}
# get a formatted string of the timestamp
humanTime <- function() {
format(Sys.time(), "%Y%m%d-%H%M%OS")
}
# save the results to a file
saveData <- function(data) {
fileName <- sprintf("%s_%s.csv",
humanTime(),
digest::digest(data))
write.csv(x = data, file = file.path(responsesDir, fileName),
row.names = FALSE, quote = TRUE)
}
# directory where responses get stored
responsesDir <- file.path(here("./responses"))
# CSS to use in the app
appCSS <-
".mandatory_star { color: red; }
.shiny-input-container { margin-top: 25px; }
#submit_msg { margin-left: 15px; }
#error { color: red; }
body { background: #fcfcfc; }
#header { background: #fff; border-bottom: 1px solid #ddd; margin: -20px -15px 0; padding: 15px 15px 10px; }
"
labelMandatory <- function(label) {
tagList(
label,
span("*", class = "mandatory_star")
)
}
appCSS <-
".mandatory_star { color: red; }"
#init data
b_data <- data.frame(
date = c("10/11/2019","10/12/2019","10/13/2019","10/14/2019"),
answer = c("comment number 1", "comment number 2...", "this is comment number 3", "and this is the fourth comment to be tagged"))
i <- nrow(b_data)
#APP
shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
shinyjs::inlineCSS(appCSS),
titlePanel("Comment Tagging Tool"),
fluidRow(column(6,
textOutput("comment")),
column(6,
div(
id = "form",
selectInput("tag", "Tag 1",
c("N/A", "Topic 1", "Topic 2", "Topic 3"),labelMandatory("tag")),
textInput("tag2","Tag 2"),
textInput("tag3", "Tag 3"),
actionButton("submit", "Submit", class = "btn-primary"),
shinyjs::hidden(
span(id = "submit_msg", "Submitting..."),
div(id = "error",
div(br(), tags$b("Error: "), span(id = "error_msg"))
)
)
),
shinyjs::hidden(
div(
id = "thankyou_msg",
h3("Submitted successfully!"),
actionLink("submit_another", "Next Comment")
)
)
)
)
),
server = function(input, output, session) {
observe({
mandatoryFilled <-
vapply(fieldsMandatory,
function(x) {
!is.null(input[[x]]) && input[[x]] != ""
},
logical(1))
mandatoryFilled <- all(mandatoryFilled)
shinyjs::toggleState(id = "submit", condition = mandatoryFilled)
})
#Load a random comment into the display after submission
comment <- eventReactive(input$submit_another, {
n <- sample(1:i,1, replace = FALSE)
comment <- b_data$answer[n]
return(comment)
})
#show comment
output$comment <- renderText({
comment()
})
# Gather all the form inputs (and add timestamp)
formData <- reactive({
data <- sapply(fieldsAll, function(x) input[[x]])
data <- c(data, timestamp = epochTime())
#data <- c(data, text = comment()) #tried this to add displayed text to output - did not work!
data <- t(data)
data
})
# When the Submit button is clicked, submit the response
observeEvent(input$submit, {
# User-experience stuff
shinyjs::disable("submit")
shinyjs::show("submit_msg")
shinyjs::hide("error")
# Save the data (show an error message in case of error)
tryCatch({
saveData(formData())
shinyjs::reset("form")
shinyjs::hide("form")
shinyjs::show("thankyou_msg")
},
error = function(err) {
shinyjs::html("error_msg", err$message)
shinyjs::show(id = "error", anim = TRUE, animType = "fade")
},
finally = {
shinyjs::enable("submit")
shinyjs::hide("submit_msg")
})
})
# submit another response
observeEvent(input$submit_another, {
shinyjs::show("form")
shinyjs::hide("thankyou_msg")
})
}
)