Приложение для пометки текста: как включить реактивный вывод в приложение Shiny в сохраненный файл CSV, содержащий пользовательские данные? - PullRequest
0 голосов
/ 31 марта 2020

Заранее спасибо за помощь.

Я создаю блестящее приложение, которое позволит пользователю назначать теги для фрейма данных открытых текстовых комментариев. Для этих целей я создал простой фальшивый фрейм данных.

Это приложение в настоящее время принимает помеченные входные данные и сохраняет их в 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")
        })
    }
)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...