根据闪亮小部件的 if 条件将值替换为数据表

Posted 2023-03-24

【中文标题】根据闪亮小部件的 if 条件将值替换为数据表

【英文标题】：Replace value into a datatable based on if condition of a shiny widget

【发布时间】：2018-12-25 11:49:22

【问题描述】：

我有一个简单的闪亮应用：

#ui.r
navbarPage(
  "Application",
  tabPanel("General",
           sidebarLayout(

             sidebarPanel(
               uiOutput("tex2"),
               uiOutput("book3"),
               uiOutput("book6")
             ),
             mainPanel(
               DT::dataTableOutput("hot3")

             )
           )))
#server.r
library(shiny)
library(DT)
server <- function(input, output,session) 
  output$tex2<-renderUI(
    numericInput("text2","#tests",
                 value = 1,
                 min=1
    )
  )
  output$book3<-renderUI(

    selectInput("bk3", 
                "Label", 
                choices=(paste("Test",1:input$text2)))
  )
  output$book6<-renderUI(
    textInput("bk6", "Change to",
              value=NULL
    )
  )
  rt4<-reactive(
    if(is.null(input$bk6))
        DF=data.frame(
          Label=paste("Test",1:input$text2),
          stringsAsFactors = FALSE)
    
    else
        DF=data.frame(
          Label=paste("Test",1:input$text2),
          stringsAsFactors = FALSE)
        DF[DF==input$bk3]<-input$bk6
        DF
      
  )
  output$hot3 <-DT::renderDataTable(
    rt4(),
    selection=list(mode="single") 

  )

如您所见，我每次都通过numericInput()“测试”添加一行。然后我使用selectInput()“标签”选择其中一项测试。当我选择一个测试时，我将它重命名为第三个textInput()“更改为”。 问题是我希望我的textInput() 默认为空。因此，如果这是空的，那么数据表中的“标签”应该以Label=paste("Test",1:input$text2) 命名，而不是空的。 例如，最初加载应用时，第一行中的标签应为“Test 1”而不是 null。

【参考方案1】：

出现问题是因为您的初始化为 NULL，但是当调用 input$bk6 时，它不是 NULL，而是一个空字符 ""。您可以通过对响应式数据框执行以下操作来解决此问题。注意更改为is.null(input$bk6)|input$bk6==""

rt4<-reactive(
     if(is.null(input$bk6)|input$bk6=="")
      DF=data.frame(
        Label=paste("Test",1:input$text2),
        stringsAsFactors = FALSE)
    
    else
      DF=data.frame(
        Label=paste("Test",1:input$text2),
        stringsAsFactors = FALSE)
      DF[DF==input$bk3]<-input$bk6
      DF
    
  )

但是，您可能需要进行初始化以解决此问题。以下内容可能会消除您在启动期间收到的一些警告。

#ui.r
navbarPage(
  "Application",
  tabPanel("General",
           sidebarLayout(

             sidebarPanel(
               uiOutput("tex2"),
               uiOutput("book3"),
               uiOutput("book6")
             ),
             mainPanel(
               DT::dataTableOutput("hot3")

             )
           )))
#server.r
library(shiny)
library(DT)
server <- function(input, output,session) 
  output$tex2<-renderUI(
    numericInput("text2","#tests",
                 value = 1,
                 min=1
    )
  )
  output$book3<-renderUI(
    if(!is.null(input$text2))
    selectInput("bk3", 
                "Label", 
                choices=(paste("Test",1:input$text2)))
  )
  output$book6<-renderUI(
    textInput("bk6", "Change to",
              value=""
    )
  )

  rt4<-reactive(
    if(!is.null(input$bk6))
     if(input$bk6=="")
      DF=data.frame(
        Label=paste("Test",1:input$text2),
        stringsAsFactors = FALSE)
    
    else
      DF=data.frame(
        Label=paste("Test",1:input$text2),
        stringsAsFactors = FALSE)
      DF[DF==input$bk3]<-input$bk6
      DF
    
  
  )
  output$hot3 <-DT::renderDataTable(
    rt4(),
    selection=list(mode="single") 

  )