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

【问题标题】：Replace value into a datatable based on if condition of a shiny widget根据闪亮小部件的 if 条件将值替换为数据表
【发布时间】：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。

【问题讨论】：

标签： r shiny dt

【解决方案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") 

  )

}

【讨论】：