如何在Shiny应用中仅展示存在异常值的行结果

问题描述 #

开发的Shiny应用支持用户上传时间序列DataFrame，并计算每行的异常值，但当前主面板会输出所有行的结果，包括无异常值的numeric(0)行，需求是仅展示存在异常值的行及其对应行号。

现有代码 #

ui <- fluidPage(

    titlePanel("Outlier analysis"),

    sidebarLayout(
        sidebarPanel(
            fileInput("Data",
                        "Upload file:")
        ),

        mainPanel(
          verbatimTextOutput("Outliers")
        )
    )
)


server <- function(input, output) {
  
      options(shiny.maxRequestSize=30*1024^2)
  
      mydata <- reactive({
        data <- input$Data
        data <- read_excel(data$datapath, col_names=FALSE)
        data <- data[-(1:2),]
        names(data) <- data[1,]
        data <- data[-1,]
        data <- data[,-1]
        data <- data.frame(data)
        })
      
      f <- function(data){
        x <- na.omit(as.numeric(data))
        mean <- mean(as.numeric(x), na.rm=T)
        sd <-   sd(as.numeric(x), na.rm=T)
        Tmin <- mean - (3*sd)
        Tmax <- mean + (3*sd)
        return(x[which(x < Tmin | x > Tmax)])
      }
      output$Outliers <- renderPrint({
        apply(mydata(), 1, f)
      })
}

当前输出 #

[[1]]
numeric(0)

... 

[[30]]
numeric(0)

[[31]]
numeric(0)

[[32]]
numeric(0)

[[33]]
numeric(0)

[[34]]
numeric(0)

[[35]]
[1] 682.231 692.713 698.037 716.197 735.422

[[36]]
numeric(0)

...

期望输出 #

[[35]]
[1] 682.231 692.713 698.037 716.197 735.422

[[51]]
[1] 682.231 692.713 698.037 716.197 735.422

[[66]]
[1] 682.231 692.713 698.037 716.197 735.422

...

解决方案 #

修改server部分的output$Outliers代码，对apply的结果进行过滤，只保留长度大于0的元素（即存在异常值的行）：

output$Outliers <- renderPrint({
  # 先计算所有行的异常值结果
  outlier_results <- apply(mydata(), 1, f)
  # 过滤掉空结果，仅保留有异常值的行
  outlier_results[sapply(outlier_results, length) > 0]
})

也可以使用Filter函数实现相同效果：

output$Outliers <- renderPrint({
  outlier_results <- apply(mydata(), 1, f)
  Filter(function(x) length(x) > 0, outlier_results)
})

两种方法都会保留原有的行号索引，仅输出存在异常值的行结果。

内容的提问来源于stack exchange，提问作者ERud