R Shiny - сохранение значений функции в таблице данных после нажатия кнопки действия

Question

Я пытаюсь найти способ отслеживать открытие и закрытие дыхательного органа (то есть рта) нескольких животных одновременно в течение 45 минут. Цель состоит в том, чтобы иметь возможность рассчитать общее время открытия и частоту открытия для каждого животного. По сути, идея состоит в том, чтобы несколько секундомеров работали параллельно, отслеживая два списка значений для каждого животного: время открытия и время закрытия.

В идеале эксперимент go должен выглядеть следующим образом: я начинаю эксперимент и поэтому секундомер Каждый раз, когда животное 1 открывает свой дыхательный орган, я нажимаю кнопку открытия, и как только оно закрывает свой дыхательный орган, я нажимаю кнопку закрытия. Время каждого, относительно секундомера, начатого в начале эксперимента, заносится в таблицу данных для животного 1. Этот процесс повторяется 10-15 раз в течение 45 минут. В то же время другое животное открывает и закрывает свой дыхательный орган, и отдельный набор данных для животного 2 создается с использованием другого набора кнопок. Я хотел бы, чтобы это было возможно для до 10 животных одновременно.

Я смог сделать секундомеры (пример кода ниже), используя функцию watch, а также включить кнопки действий, которые выводят текст, соответствующий разнице в системном времени между временем начала эксперимента и временем нажатия кнопок открытия или закрытия. Однако я не уверен, как сохранить эти значения в кадре данных для каждого животного.

Я просмотрел stackoverflow и не нашел ничего, что работает, включая этот поток: r Блестящая кнопка действия и вывод таблицы данных и вот это: Добавьте значения в реактивную таблицу в блестящем

Дайте мне знать, если вам нужна дополнительная информация! Заранее спасибо.

library(lubridate)
library(shiny)
library(DT)

# stopwatch function ----

stop_watch = function() {
  start_time = stop_time = open_time = close_time = NULL
  start = function() start_time <<- Sys.time()
  stop = function() {
    stop_time <<- Sys.time()
    as.numeric(difftime(stop_time, start_time))
  }
  open = function() {
    open_time <<- Sys.time()
    as.numeric(difftime(open_time, start_time))
  }
  close = function() {
    close_time <<- Sys.time()
    as.numeric(difftime(close_time, start_time))
  }
  list(start=start, open=open, close=close, stop=stop)
}
watch = stop_watch()

# ui ----

ui <- fluidPage(
  titlePanel("Lymnaea stopwatch"),

  sidebarLayout(
    sidebarPanel(

      selectInput(
        "select",
        label = "Number of animals",
        choices = c(1,2,3,4,5,6,7,8,9,10),
        selected = c("1")
      )
  # action button conditionals ----      
    ),
    mainPanel(
      h4("Start/Stop Experiment:"),
      actionButton('start1',"Start"),
      actionButton('stop1', "Stop"),
      textOutput('initial1'),
      textOutput('start1'),
      textOutput('stop1'),
      textOutput('stoptime1'),

     conditionalPanel(
       h4("Animal 1"),
      condition = "input.select == '1'||input.select == '2'||input.select == '3'||input.select == '4'||input.select == '5'||input.select == '6'||input.select == '7'||input.select == '8'||input.select == '9'||input.select == '10'",
       actionButton('open1', "Open"),
       actionButton('close1', "Close"),
       textOutput('open1'),
       textOutput('opentime1'),
       textOutput('close1'),
       textOutput('closetime1'),

     )

  )
)
)

# server ----

server <- function(input, output, session) {

values <- reactiveValues()

values$df <- data.frame(colnames(c("Open", "Close")))

newEntry <- observe({
  if(input$open1 > 0) {
    newLine <- isolate(c(({watch$start()})))
    isolate(values$df <- rbind(values$df, newLine))
  }
})

output$table <- renderTable({values$df})

  # n = 1 animal  ----
  observeEvent(input$start1, {
    watch$start()
    output$initial1 <- renderText(
      "Timer started."
      )
  })

  observeEvent(input$open1, {
    watch$open()
    output$open1 <- renderText(
      "Time of opening:"
    )
    output$opentime1 <- renderText({
      watch$open()
    })
 })

  observeEvent(input$close1, {
    watch$close()
    output$close1 <- renderText({
      "Time of closing:"
    })
    output$closetime1 <- renderText({
      watch$close()
    })
  })

}

shinyApp(ui, server)

Answer 1

Я думаю, что может быть несколько способов настроить это по-разному.

Одна рекомендация, которую я имею, состоит в том, чтобы избегать помещения output внутрь вашего observers.

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

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

Вот краткий пример, который вы можете попробовать, просто чтобы понять поведение. Также добавьте tableOutput('table') к вашему ui после вашего conditionalPanel, чтобы просмотреть фрейм данных.

# ui ----

ui <- fluidPage(
  titlePanel("Lymnaea stopwatch"),

  sidebarLayout(
    sidebarPanel(

      selectInput(
        "select",
        label = "Number of animals",
        choices = c(1,2,3,4,5,6,7,8,9,10),
        selected = c("1")
      )
      # action button conditionals ----      
    ),
    mainPanel(
      h4("Start/Stop Experiment:"),
      actionButton('start1',"Start"),
      actionButton('stop1', "Stop"),
      textOutput('initial1'),
      textOutput('start1'),
      textOutput('stop1'),
      textOutput('stoptime1'),

      conditionalPanel(
        h4("Animal 1"),
        condition = "input.select == '1'||input.select == '2'||input.select == '3'||input.select == '4'||input.select == '5'||input.select == '6'||input.select == '7'||input.select == '8'||input.select == '9'||input.select == '10'",
        actionButton('open1', "Open"),
        actionButton('close1', "Close"),
        textOutput('open1'),
        textOutput('opentime1'),
        textOutput('close1'),
        textOutput('closetime1'),
      ),
      tableOutput('table')
    )
  )
)

# server ----

server <- function(input, output, session) {

  values <- reactiveValues(df = data.frame(Animal = integer(),
                                           Event = character(),
                                           Time = as.POSIXct(character()),
                                           stringsAsFactors = FALSE),
                           timer = "Timer Off")

  output$initial1 <- renderText({
    values$timer
  })

  output$opentime1 <- renderText({
    paste("Opened at:", tail(values$df[values$df[["Animal"]] == 1 & values$df[["Event"]] == "Open", "Time"], 1))
  })

  output$closetime1 <- renderText({
    paste("Closed at:", tail(values$df[values$df[["Animal"]] == 1 & values$df[["Event"]] == "Close", "Time"], 1))
  })

  output$table <- renderTable({
    values$df
  })

  observeEvent(input$start1, {
    watch$start()
    values$timer <- "Timer Started"
  })

  observeEvent(input$open1, {
    values$df <- rbind(values$df, data.frame(Animal = 1, Event = "Open", Time = watch$open()))
  })

  observeEvent(input$close1, {
    values$df <- rbind(values$df, data.frame(Animal = 1, Event = "Close", Time = watch$close()))
  })

}

Это можно увеличить до 10 животных, и есть альтернативные способы предоставления обратной связи пользователю на данных.

Дайте мне знать, что вы думаете, и если это в том направлении, которое вы имели в виду.