【R】Steel-Dwass多重比較検定の結果にアルファベットの添え字をつける

steel_dwass_test_cld <- function(x,y,
                            method = NA,
                            n.mc = 10000,
                            alphabets = letters,
                            decreasing = TRUE,
                            alpha = 0.05) {
  
  # パッケージをインストールし、読み込む
  suppressWarnings({
    packages <- c("NSM3",
                  "tidyverse")
    package.check <- lapply(
      packages,
      FUN = function(x) {
        if (!require(x, character.only = TRUE)) {
          install.packages(x, dependencies = TRUE)
          library(x, character.only = TRUE)
        }
      }
    )
  })
  # データをdataframeにまとめる
  data <- data.frame(value = x, group = y)
  # Steel-Dwass検定の実行
  steel_dwass <- pSDCFlig(data$value, data$group, method = method, n.mc = n.mc)
  multcomp.df <- data.frame(labels = steel_dwass$labels,
                            p.val = steel_dwass$p.val)
  if (decreasing == TRUE) {
    #平均値の計算と並べ替え
    summarise <- data[1] %>% 
      group_by(data[2]) %>% 
      summarise_all(list(mean = mean)) %>% 
      arrange(-mean)
  } else {
    #平均値の計算と並べ替え
    summarise <- data[1] %>% 
      group_by(data[2]) %>% 
      summarise_all(list(mean = mean)) %>% 
      arrange(mean)
  }
  # p値表
  p.table <- matrix(nrow = length(attr(y, "levels")),
                    ncol = length(attr(y, "levels")))
  colnames(p.table) <- summarise[[1]]
  rownames(p.table) <- summarise[[1]]
  # 同じ列と行が一致する部分に空文字を入れる
  diag(p.table) <- ""
  # 右上半分を"-"に設定
  for (i in 1:nrow(p.table)) {
    for (j in 1:ncol(p.table)) {
      if (i < j) {
        p.table[i, j] <- "-"
      }
    }
  }
  # 特定のグループペアに対してp値または"*"を取得する関数
  get_p_val <- function(df, group1, group2) {
    # ラベルの組み合わせを作成
    label1 <- group1
    label2 <- group2
    
    # データフレーム内でラベルを検索
    p_val <- df$p.val[df$labels == label1 | df$labels == label2]
    
    # p値がalpha以下の場合は"*"を返し、それ以外は空文字を返す
    if (length(p_val) == 0) {
      return(NA)
    } else if (p_val <= alpha) {
      return("*")
    } else {
      return("")
    }
  }
  # NAのセルに記号を入れる
  for (i in 1:nrow(p.table)) {
    for (j in 1:ncol(p.table)) {
      if (p.table[i,j] %>% is.na() == TRUE) {
        p.table[i,j] <- get_p_val(
          multcomp.df,
          group1 = paste(rownames(p.table)[i],"-",colnames(p.table)[j]),
          group2 = paste(rownames(p.table)[j],"-",colnames(p.table)[i]))
      }
    }
  }
  # 各列に含まれる"*"の個数を数える
  star_counts <- apply(p.table, 2, function(x) sum(x == "*"))
  # アルファベットを追加する関数
  add_alphabets <- function(column, current_alphabet) {
    for (i in seq_along(column)) {
      if (column[i] == "") {
        column[i] <- current_alphabet
      }
    }
    return(column)
  }
  # 各列にアルファベットを追加
  new_matrix_data <- p.table
  previous_count <- NULL
  alphabet_index <- 1
  
  for (j in seq_along(colnames(p.table))) {
    current_count <- star_counts[j]
    if (is.null(previous_count) || current_count != previous_count) {
      current_alphabet <- alphabets[alphabet_index]
      alphabet_index <- alphabet_index + 1
    }
    new_matrix_data[, j] <- add_alphabets(p.table[, j], current_alphabet)
    previous_count <- current_count
  }
  # 行ごとに含まれる文字を集計
  cld <- apply(new_matrix_data, 1, function(row) {
    # 行内の"-"と"*"を除いた文字をユニークに集めてソート
    unique_chars <- unique(row[row != "-" & row != "*"])
    paste(sort(unique_chars), collapse = "")
  })
  return(cld[attr(y, "levels")])
}