Блестящий реактивный ввод добавить и удалить - PullRequest
Новая
       10

Блестящий реактивный ввод добавить и удалить

0 голосов
/ 17 февраля 2020

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

У меня есть модуль, чтобы добавить что-то в мой список. 

find_inputUI <- function(id){
  ns <- NS(id)
  tagList(
  sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
  radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
  actionButton(ns("press"), "Add to queue"))

}

find_input <- function(input, output, session){
  queue <- list()
 observeEvent(input$press, {
  queue_append <- list(input$first, input$second)
queue <<- append(queue, queue_append )})
 queue_ret <- eventReactive(input$press,{return(list(queue=queue, add=input$press))})

}

Затем я вызываю его дважды и подключаю 2 разных входа. Теперь я хочу выбрать элементы для удаления, но это не работает. 

source('/cloud/project/Queue/find_input.R')
library(shiny)

ui <- fluidPage(
  tagList(tabsetPanel(
    tabPanel("INPUT 1",
             find_inputUI("input1"),
             verbatimTextOutput("test")),
    tabPanel("INPUT 2",
             find_inputUI("input2")
    )
  ),
  actionButton("combine", "Show combined input"),
  verbatimTextOutput("combination"),
  uiOutput("del")
  )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  input_manual1 <- callModule(find_input,"input1")
  input_manual2 <- callModule(find_input, "input2")
  output$test <- renderPrint({input_manual1()$queue})

  appended <- eventReactive(input$combine, {
    return(append(input_manual1()$queue, input_manual2()$queue))
  })

  output$combination <- renderPrint({appended()})

  output$del <- renderUI({
    input$combine
    tagList(checkboxGroupInput("delete", "Choose do delete", seq(1:length(appended()))),
            actionButton("dodelete", "Delete selected"))
  })
  observeEvent(input$dodelete,{
    appended <<- appended()[-input$delete]
  })

}

# Run the application 
shinyApp(ui = ui, server = server)

Может быть, кто-нибудь может сказать мне, что пока не так?

Заранее спасибо!

1 Ответ

1 голос
/ 17 февраля 2020

Ниже приведено приложение, которое, кажется, работает, но я не уверен, что понимаю, для чего предназначено ваше приложение.

В целом, предпочитайте реактивные значения (reactiveVal) вместо использования не местное назначение <<-.

Код appended <<- appended()[-input$delete] неверен. Он не заменяет вывод appended() его исходным значением минус индекс input$delete. 

library(shiny)

find_inputUI <- function(id){
  ns <- NS(id)
  tagList(
    sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
    radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
    actionButton(ns("press"), "Add to queue"))

}

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

  queue <- reactiveVal(list())

  observeEvent(input$press, {
    queue_append <- list(input$first, input$second)
    queue(append(queue(), queue_append))
  })

  queue_ret <- eventReactive(input$press, {
    list(queue=queue(), add=input$press)
  })

}

ui <- fluidPage(
  tagList(tabsetPanel(
    tabPanel("INPUT 1",
             find_inputUI("input1"),
             verbatimTextOutput("test")),
    tabPanel("INPUT 2",
             find_inputUI("input2")
    )
  ),
  actionButton("combine", "Show combined input"),
  verbatimTextOutput("combination"),
  uiOutput("del")
  )
)


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

  input_manual1 <- callModule(find_input,"input1")
  input_manual2 <- callModule(find_input, "input2")
  output$test <- renderPrint({input_manual1()$queue})

  appended <- reactiveVal(list())
  observeEvent(input$combine, {
    appended(append(input_manual1()$queue, input_manual2()$queue))
  })

  output$combination <- renderPrint({appended()})

  output$del <- renderUI({
    input$combine
    tagList(checkboxGroupInput("delete", "Choose do delete", seq_along(appended())),
            actionButton("dodelete", "Delete selected"))
  })

  observeEvent(input$dodelete,{
    appended(appended()[-as.integer(input$delete)])
  })

}

# Run the application 
shinyApp(ui = ui, server = server)
...