在 Shiny 中替换列中的重复行

Posted 2023-03-24

【中文标题】在 Shiny 中替换列中的重复行

【英文标题】：Replacing duplicate rows in a column in Shiny

【发布时间】：2021-11-20 14:42:19

【问题描述】：

我有一个 Shiny 应用程序，用户可以根据水的类型选择一项或多项分析。他们应该能够为每种水类型选择尽可能多的分析，彼此独立。例如，他们应该能够在淡水中选择 2 次分析，在海水中选择 3 次。在此示例中，表格理想情况下应如下所示：

  Freshwater Saltwater
  <chr>      <chr>    
1 pH         pH       
2 turbidity  salinity 
3 -          turbidity

但由于我的data.frame 是动态的，因此我在格式化表格时遇到了问题。这是一个可重现的示例：

library(shiny)
library(shinyWidgets)
library(DT)

AnalysisChoices = c("pH", "salinity","turbidity")

shinyApp(
  ui = fluidPage(box(pickerInput( 
    
    inputId = "anaFW",
    label = "Analysis 2",
    choices =AnalysisChoices,
    
    multiple = T,
    options = list(`actions-box` = TRUE)),
    
    pickerInput(
      
      inputId = "anaSea",
      label = "Analysis 1 ",
      choices = AnalysisChoices,
      multiple = T,
      options = list(`actions-box` = TRUE)))
   ,
    
    
  fluidRow( DT::dataTableOutput ("analysisTbl"),
    style = "  overflow-y: scroll;
                   overflow-x: scroll;"
  ) ),
  
  server = function(input, output) 
    DataAnalysis = reactive(
      df2<- data.frame(
        
        Freshwater = if (length(input$anaFW) == 0) 
          Freshwater = ""
          
        
        else 
          Freshwater = input$anaFW
          
        ,
        SeaWater = if (length(input$anaSea) == 0) 
          SeaWater = ""
        
        else 
          SeaWater = input$anaSea
        )
      return(list(df2 = (df2)))
      
      
     
   
      
    )
    output$analysisTbl <- renderDataTable(DataAnalysis()$df2)


 )

如果我在其中一个选项中进行了一次分析，而在另一个选项中进行了多次分析，则第一个选项中的分析将在下一行中重复。如果我尝试前面的示例（一种水类型有 2 个选项，另一种水有 3 个选项），那么我会收到一条错误消息，因为该函数不知道如何填充空行。如何将空单元格替换为- ？

【参考方案1】：

也许这会满足您的需求。

library(shiny)
library(shinyWidgets)
library(DT)

################ cbind datasets with different number of rows  ######
cbindPad <- function(...)
  args <- list(...)
  n <- sapply(args,nrow)
  mx <- max(n)
  pad <- function(x, mx)
    if (nrow(x) < mx)
      nms <- colnames(x)
      padTemp <- matrix(NA, mx - nrow(x), ncol(x))
      colnames(padTemp) <- nms
      if (ncol(x)==0) 
        return(padTemp)
       else 
        return(rbind(x,padTemp))
      
    
    else
      return(x)
    
  
  rs <- lapply(args,pad,mx)
  return(do.call(cbind,rs))


AnalysisChoices = c("pH", "salinity","turbidity")

shinyApp(
  ui = fluidPage(box(pickerInput( 
    
    inputId = "anaFW",
    label = "Analysis 2",
    choices =AnalysisChoices,
    
    multiple = T,
    options = list(`actions-box` = TRUE)),
    
    pickerInput(
      
      inputId = "anaSea",
      label = "Analysis 1 ",
      choices = AnalysisChoices,
      multiple = T,
      options = list(`actions-box` = TRUE)))
    ,
    
    
    fluidRow( DT::dataTableOutput ("analysisTbl"),
              style = "  overflow-y: scroll;
                   overflow-x: scroll;"
    ) ),
  
  server = function(input, output) 
    DataAnalysis = reactive(
      df1<- data.frame(
        Freshwater = if (length(input$anaFW) == 0) 
          Freshwater = ""
        
        else 
          Freshwater = input$anaFW
        )
      
      df2 <- data.frame(
        SeaWater = if (length(input$anaSea) == 0) 
          SeaWater = ""
        
        else 
          SeaWater = input$anaSea
        )
      
      df <- cbindPad(df1,df2)
      return(df)
      
    )
    
    output$analysisTbl <- renderDataTable(DataAnalysis())
    
   )