在R语言Shiny应用中为密度图添加垂直线报错的解决咨询

错误原因 #

1. 索引类型错误：lines_amt()中使用c(AllOutliers())作为clusterMember2()$Petal.Length的索引，而AllOutliers()返回的是数据框（list类型），不能直接用于向量索引，导致Error in [: invalid subscript type 'list'。
2. 聚类数未关联UI输入：原代码中kmeans固定使用3类，未调用UI中设置的input$clusters参数。
3. 过滤条件错误：dist0()中用distances() == 0过滤，应该使用数据框自身的Distance列。
4. 绘图语法错误：geom_vline前的#导致代码断裂，且get(vlines)属于冗余写法，直接使用列名即可。

修正后的完整代码 #

Global

library(tidyverse)
library(cluster)
library(shiny)

require(iris)

UI

ui <- fluidPage({
  pageWithSidebar(
    headerPanel('Iris k-means clustering'),
    sidebarPanel(
      numericInput('clusters', 'Cluster count', 3, min = 1, max = 9)
    ),
    mainPanel(
      plotOutput('plot1')
    )
  )
})

Server

server <- function(input, output){
  
  ClusterData <- reactive({
    iris[,1:4]
  })
  
  # 保留行号用于异常值标签
  ClusterData2 <- reactive({
    df <- data.frame(ClusterData())
    row.names(df) <- 1:nrow(df)
    df
  })
  
  # 标准化数据
  ScaledData <- reactive({
    scale(ClusterData2())
  })
  
  # kmeans聚类，使用UI输入的聚类数
  final <- reactive({
    kmeans(ScaledData(), input$clusters, nstart = 25)
  })
  
  # 获取每个样本对应的聚类中心
  states.centers <- reactive({
    final()$centers[final()$cluster, ]
  })
  
  # 计算每个样本到所属聚类中心的距离
  distances <- reactive({
    sqrt(rowSums((ScaledData() - states.centers())^2))
  })
  
  # 绑定距离到原始数据
  outliers <- reactive({
    cbind(ClusterData(), Distance = distances())
  })
  
  # 绑定聚类编号
  clusterMember <- reactive({
    cbind(outliers(), clusterNum = final()$cluster)
  })
  
  # 转换为数据框
  clusterMember2 <- reactive({
    as.data.frame(clusterMember())
  })
  
  # 找出距离为0的单点聚类样本
  dist0 <- reactive({
    clusterMember() %>%
      filter(Distance == 0)  # 使用数据框内的Distance列
  })
  
  # 按距离从大到小排序
  distArrange <- reactive({
    clusterMember() %>%
      arrange(desc(Distance))
  })
  
  # 取前5个距离最大的异常值
  filtTop5 <- reactive({
    distArrange()[1:5,]
  })
  
  # 合并异常值与单点聚类样本，去重
  AllOutliers <- reactive({
    rbind(filtTop5(), dist0()) %>%
      distinct()
  })
  
  # 准备垂直线和标签数据：提取Petal.Length和样本行号（作为标签）
  lines_amt <- reactive({
    outlier_df <- AllOutliers()
    data.frame(
      vlines = outlier_df$Petal.Length,
      labels = rownames(outlier_df),  # 使用样本行号作为标签
      stringsAsFactors = FALSE
    )
  })
  
  # 输出密度图，添加垂直线和标签
  output$plot1 <- renderPlot({
    ggplot(ClusterData(), aes(x = Petal.Length)) +
      geom_density(fill = "blue", alpha = 0.4) +
      # 添加垂直线
      geom_vline(data = lines_amt(), aes(xintercept = vlines), 
                 color = "red", linetype = "dashed") +
      # 添加标签，调整位置避免重叠
      geom_text(data = lines_amt(), 
                aes(x = vlines, y = 0.2, label = labels),
                color = "darkred", angle = 90, vjust = -0.2) +
      labs(title = "Petal Length Density with Outlier Vertical Lines",
           x = "Petal Length", y = "Density") +
      theme_minimal()
  })
  
}

Run App

shinyApp(ui, server)

关键修正说明 #

1. 修正索引错误：lines_amt()直接从AllOutliers()数据框中提取Petal.Length列作为垂直线的x轴位置，同时用行号作为标签，避免了用list类型作为索引的问题。
2. 关联UI输入：kmeans聚类数改为input$clusters，实现交互式调整聚类数量。
3. 修复过滤逻辑：dist0()中使用filter(Distance == 0)，基于数据框内的列进行过滤，逻辑更准确。
4. 完善绘图元素：添加了颜色、线型区分垂直线，用geom_text添加异常值标签，并调整标签位置避免与密度图重叠。

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