R语言 切换selectInput条目不会呈现预期内容

zzlelutf  于 2023-02-10  发布在  其他
关注(0)|答案(2)|浏览(79)

在modalDialog中，我有一个带有一些日期的selectInput
对于每个日期，我都有一个带有项目ID和值的 Dataframe 。所有数据都在一个列表myhist中，如下所示：

> myhist
$`2023-02-06`
  id  value
1  1 value1
2  2 value2

$`2023-02-05`
  id  value
1  4 value4
2  5 value5
3  6 value6

在我的modalDialog中，当我选择第一个日期2023-02-06时，它会打印我的2个值的列表，每行都有一个减号图标，以删除这一特定行。
如果我选择第二个日期2023-02-05，它会以与上面相同的方式打印我的3个值的列表，一切都运行良好。
对于这个日期2023-02-05，如果我通过单击减号图标删除第二个元素（id=5，value=5），它就会消失......好！
如果我现在用selectInput切换到另一个日期2023-02-06，它只打印列表的第一个元素。第二个元素不显示！我认为它与我从另一个日期中删除的第二个元素有关。但我没有'我不明白为什么，因为在我的代码中，我将removeUI应用于元素的整个div内容，然后我用apply再次构建它，这样所有元素都应该显示！为什么少了一个？？？
如果我切换到2023-02-05日期，然后切换到2023-02-06日期，所以现在列表显示得很好。
我尝试将immediate=TRUE添加到removeUI，但它不起作用...
这是一段可复制的代码

library(shiny)

ui <- fluidPage(
  actionButton("open", "Modal")
)

server <- function(input, output, session) {
  myhist <- reactiveVal(
    value=list("2023-02-06"=data.frame(item=c(1,2),value=c("value1","value2")), 
               "2023-02-05"=data.frame(item=c(4,5,6),value=c("value4","value5","value6"))
              )
  )
  count <- reactiveVal(0)
  
  observeEvent(input$open, {
    dates <- names(myhist())
    showModal(
      modalDialog(
        tagList(
          selectInput(
            "dateList", "History:",
            choices = dates
          ),
          div(
            id = "add_update",
          )
        ),
        footer = tagList(
          modalButton("Cancel"),
          actionButton("add_db", "SAVE")
        )
      )
    )
  })
  
  add_item <- function(count, item, value) {
    id <- paste0("gcs",count)
    idrm <- paste0("gcsrm",count)
    return(
      tagList(
        div(id=idrm,

                actionButton(inputId = id, icon("circle-minus"))
            ,
            div(textInput(width=164, inputId = paste0("add_id",count), "ID", value=item)),
            div(textAreaInput(width=400, height=100, inputId = paste0("add_comment",count), "Value",value=value))
        )
      )
    )
  }
  
  observeEvent(input$dateList, {
    mydf <- myhist()[[input$dateList]]
    removeUI(selector = "#add_update div", multiple=TRUE, immediate=TRUE)
    count(0)
    lapply(1:nrow(mydf), function(row) {
      insertUI(selector = "#add_update", ui = add_item(count(), mydf[row,]$item, mydf[row,]$value))
      id <- paste0("gcs",count())
      idrm <- paste0("gcsrm",count())
      observeEvent(input[[id]], {
        removeUI(selector = paste0("#", idrm))
      })
      count(count()+1)
    })
  })           
}

shinyApp(ui, server)

谢谢你的帮助！

r

2条答案

按热度按时间
xu3bshqb

xu3bshqb1#

这是因为您在不同的日期重用了id和idrm。通过再添加一个变量，您可以使其唯一。

library(shiny)

ui <- fluidPage(
  actionButton("open", "Modal")
)

server <- function(input, output, session) {
  myhist <- reactiveVal(
    value=list("2023-02-06"=data.frame(item=c(1,2),value=c("value1","value2")), 
               "2023-02-05"=data.frame(item=c(4,5,6),value=c("value4","value5","value6"))
    )
  )
  count <- reactiveVal(0)
  
  observeEvent(input$open, {
    dates <- names(myhist())
    showModal(
      modalDialog(
        tagList(
          selectInput(
            "dateList", "History:",
            choices = dates
          ),
          div(
            id = "add_update",
          )
        ),
        footer = tagList(
          modalButton("Cancel"),
          actionButton("add_db", "SAVE")
        )
      )
    )
  })
  
  add_item <- function(count, date, item, value) {
    id <- paste0("gcs",count,date)
    idrm <- paste0("gcsrm",count,date)
    return(
      tagList(
        div(id=idrm,
            
            actionButton(inputId = id, icon("minus"))
            ,
            div(textInput(width=164, inputId = paste0("add_id",count), "ID", value=item)),
            div(textAreaInput(width=400, height=100, inputId = paste0("add_comment",count), "Value",value=value))
        )
      )
    )
  }
  
  observeEvent(input$dateList, {
    mydf <- myhist()[[input$dateList]]
    removeUI(selector = "#add_update div", multiple=TRUE, immediate=TRUE)
    count(0)
    lapply(1:nrow(mydf), function(row) {
      insertUI(selector = "#add_update", ui = add_item(count(),input$dateList, mydf[row,]$item, mydf[row,]$value))
      id <- paste0("gcs",count(),input$dateList)
      idrm <- paste0("gcsrm",count(),input$dateList)
      # print(id)
      # print(idrm)
      observeEvent(input[[id]], {
        removeUI(selector = paste0("#", idrm))
      })
      count(count()+1)
    })
  })           
}

shinyApp(ui, server)
赞(0）分享  回复(0）举报  2023-02-10
46scxncf

46scxncf2#

以下是我的解决方案，以避免我在前面的评论中解释的偏见。
我用@YBS另一个唯一的ID（基于Sys.time（），6位数表示秒）来 Package 我所有的行项目/值。所以现在当我删除一个日期的行，然后选择另一个日期，所有的项目都会显示出来。这是我的可复制代码。谢谢你的提示。

library(shiny)
options(digits.secs=6)

ui <- fluidPage(
  actionButton("open", "Modal")
)

server <- function(input, output, session) {
  myhist <- reactiveVal(
    value=list("2023-02-06"=data.frame(item=c(1,2),value=c("value1","value2")), 
               "2023-02-05"=data.frame(item=c(4,5,6),value=c("value4","value5","value6"))
    )
  )
  count <- reactiveVal(0)
  addupdate <- reactiveVal(0)
  
  observeEvent(input$open, {
    dates <- names(myhist())
    showModal(
      modalDialog(
        tagList(
          div(id="mainupdate",
            selectInput(
              "dateList", "History:",
              choices = dates
            )
          )
        ),
        footer = tagList(
          modalButton("Cancel"),
          actionButton("add_db", "SAVE")
        )
      )
    )
  })
  
  add_item <- function(count, date, item, value) {
    id <- paste0("gcs",count,date)
    idrm <- paste0("gcsrm",count,date)
    return(
      tagList(
        div(id=idrm,
            actionButton(inputId = id, icon("minus")),
            div(textInput(width=164, inputId = paste0("add_id",count), "ID", value=item)),
            div(textAreaInput(width=400, height=100, inputId = paste0("add_comment",count), "Value",value=value))
        )
      )
    )
  }
  
  observeEvent(input$dateList, {
    mydf <- myhist()[[input$dateList]]
    removeUI(selector = paste0("#add_update",addupdate()))
    count(0)
    addupdate(create_unique_id())
    insertUI(selector = "#mainupdate", where="beforeEnd", ui = div(id=paste0("add_update",addupdate())))
    lapply(1:nrow(mydf), function(row) {
      insertUI(selector = paste0("#add_update",addupdate()), where="beforeEnd", ui = add_item(count(),addupdate(), mydf[row,]$item, mydf[row,]$value))
      id <- paste0("gcs",count(),addupdate())
      idrm <- paste0("gcsrm",count(),addupdate())
      observeEvent(input[[id]], {
        removeUI(selector = paste0("#", idrm))
      })
      count(count()+1)
    })
  })
  
  create_unique_id <- function() {
    return(gsub('[:.]',"",unlist(strsplit(as.character(Sys.time()), "[ ]"))[2]))
  }
}

shinyApp(ui, server)
赞(0）分享  回复(0）举报  2023-02-10
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备2022004421号-2 NULL123 https://www.null123.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com