我在研究两对同源染色体的遗传Punnett方格，我已经用R 将其建模，如下所示：

# Punnet square for two homologous chromosome pairs
col_names<-c("AB", "Ab", "aB", "ab")
row_names<-c("AB", "Ab", "aB", "ab")
offspring<-as.data.frame(matrix(ncol=length(col_names), nrow=length(row_names),
                                dimnames=list(row_names, col_names)))

for(i in 1:length(row_names)){
  for(j in 1: length(col_names)){
    offspring[i,j]<-paste0(substr(rownames(offspring)[i],1,1), substr(colnames(offspring)[j],1,1), paste0(substr(rownames(offspring)[i],2,2), substr(colnames(offspring)[j],2,2)))
  }
}

> print(offspring)
     AB   Ab   aB   ab
AB AABB AABb AaBB AaBb
Ab AAbB AAbb AabB Aabb
aB aABB aABb aaBB aaBb
ab aAbB aAbb aabB aabb

现在我想对这张表中的唯一值进行频率统计；不过在这里，唯一性的判定不在于字符串中字符的排列顺序（例如Aa与 aA等价，但AA与 aa不同）。

有没有一个简单的方法可以做到？结果应该像这样：

AABB：1               AABb：2               AAbb：1

AaBB：2               AaBb：4               Aabb：2

aaBB：1               aaBb：2                aabb：1

解决方案

对于每个字符串，将其中的字符排序后重新拼接成一个字符串，并用 table 统计出现的频率。

fun <- function(x) {
  lapply(x, strsplit, "") |> 
    unlist(recursive = FALSE, use.names = FALSE) |>
    lapply(sort) |>
    sapply(paste, collapse = "") |>
    table(useNA = "ifany")
}

fun(offspring)
#> 
#> aabb aabB aaBB aAbb aAbB aABB AAbb AAbB AABB 
#>    1    2    1    2    4    2    1    2    1

创建于2026-03-03，使用 reprex v2.1.1

你可以把上述内容通过管道传给 as.data.frame，输出为数据框。

fun(offspring) |> as.data.frame()
#>   Var1 Freq
#> 1 aabb    1
#> 2 aabB    2
#> 3 aaBB    1
#> 4 aAbb    2
#> 5 aAbB    4
#> 6 aABB    2
#> 7 AAbb    1
#> 8 AAbB    2
#> 9 AABB    1

创建于2026-03-03，使用 reprex v2.1.1

编辑

虽然这里已经有一个被接受的答案（这个），但这里给出一个Rcpp版本。
用于排序字符串的第一段循环来自 这篇Rcpp Gallery的文章。

src <- "
NumericVector rcpp_str_sort_table(std::vector<std::string> strings) {
    // allow long vectors
    R_xlen_t n = (R_xlen_t)strings.size();
    if(n == 0) return Rf_allocVector(REALSXP, 0);

    // sort each string in order to make them equal/comparable
    for (R_xlen_t i = 0; i < n; ++i) {
        std::sort(strings[i].begin(), strings[i].end());
    }

    // and the strings vector so that rle works faster
    std::sort(strings.begin(), strings.end());

    NumericVector out_values;
    CharacterVector out_names;

    // now a standard run-length encoding on the sorted
    // data counts unique strings
    for(R_xlen_t i = 0; i < n; ++i) {
        double count = 1.0;
        while(strings[i] == strings[i + 1]) {
            count++;
            i++;
        }
        out_values.push_back(count);
        out_names.push_back(strings[i].c_str());
    }

    out_values.attr("names") = out_names;
    return out_values;
}
"
Rcpp::cppFunction(src)
rui2 <- function(x) {
  if(!is.null(x))
    unlist(x) |> rcpp_str_sort_table()
  else NULL
}

# test cases
rui2(NULL)
rui2(1:10)
rui2(character(0))
rui2(c(character(0), "AbAb"))
rui2(c("AbAb", character(0)))
rui2(c("AbAb", character(0), "AbAb"))
rui2(offspring)