R中的字符串簇序列[重复]答案

【问题标题】：Cluster sequences of strings in R [duplicate]R中的字符串簇序列[重复]
【发布时间】：2017-06-11 22:58:09
【问题描述】：

我必须关注数据：

attributes <- c("apple-water-orange", "apple-water", "apple-orange", "coffee", "coffee-croissant", "green-red-yellow", "green-red-blue", "green-red","black-white","black-white-purple")
attributes 

           attributes 
1  apple-water-orange
2         apple-water
3        apple-orange
4              coffee
5    coffee-croissant
6    green-red-yellow
7      green-red-blue
8           green-red
9         black-white
10 black-white-purple

我想要的是另一列，它根据观察相似性为每一行分配一个类别。

category <- c(1,1,1,2,2,3,3,3,4,4)
df <- as.data.frame(cbind(df, category))

       attributes     category
1  apple-water-orange        1
2         apple-water        1
3        apple-orange        1
4              coffee        2
5    coffee-croissant        2
6    green-red-yellow        3
7      green-red-blue        3
8           green-red        3
9         black-white        4
10 black-white-purple        4

这是广义上的聚类，但我认为大多数聚类方法仅适用于数字数据，并且单热编码有很多缺点（这是我在互联网上看到的）。

有人知道如何完成这项任务吗？也许一些单词匹配方法？

如果我可以根据参数调整相似度（粗略与体面的“聚类”），那就太好了。

提前感谢您的任何想法！

【问题讨论】：

stackoverflow.com/questions/21511801/…
This post 可能有帮助。
聚类适用于距离，无论数据类型如何。您可以使用多种不同的方法计算字符串之间的距离。
看来第一个字总是一样的？那么也许match(sub('-.*', '', attributes), unique(sub('-.*', '', attributes))) 就足够了吗？
这在很大程度上取决于实际数据的外观。（本地）编辑距离可能是一个不错的选择（您上面显示的反例在本地编辑距离方面得分很高），并且可以扩展该算法以允许反转。如果您只想基于单词匹配进行聚类，将字符串拆分为单词并量化单词的重叠（length(intersect(words_vector_1, words_vector2))）会更简单、更高效。

标签： r cluster-analysis string-matching categorical-data textmatching

【解决方案1】：

所以我提出了两种可能性。选项 1：例如，只要 apple/apples 与 apple/orange 同样不同，就使用简单直接的“one-hot-encoding”。我使用 Jaccard 索引作为距离度量，因为它在重叠集方面做得相当好。选项 2：使用局部序列比对算法，并且对于 apple/apples 与 apple/orange 之类的东西应该相当稳健，它还会有更多的调整参数，这可能需要时间来优化您的问题。

library(reshape2)
library(proxy)

attributes <- c("apple-water-orange", "apple-water", "apple-orange", "coffee", 
                "coffee-croissant", "green-red-yellow", "green-red-blue", 
                "green-red","black-white","black-white-purple")
dat <- data.frame(attr=attributes, row.names = paste("id", seq_along(attributes), sep=""))
attributesList <- strsplit(attributes, "-")

df <- data.frame(id=paste("id", rep(seq_along(attributesList), sapply(attributesList, length)), sep=""), 
                 word=unlist(attributesList))

df.wide <- dcast(data=df, word ~ id, length)
rownames(df.wide) <- df.wide[, 1] 
df.wide <- as.matrix(df.wide[, -1])

df.dist <- dist(t(df.wide), method="jaccard")
plot(hclust(df.dist))
abline(h=c(0.6, 0.8))
heatmap.2(df.wide, trace="none", col=rev(heat.colors(15)))

res <- merge(dat, data.frame(cat1=cutree(hclust(df.dist), h=0.8)), by="row.names")
res <- merge(res, data.frame(cat2=cutree(hclust(df.dist), h=0.6)), by.y="row.names", by.x="Row.names")
res

您会发现，您可以通过调整树状图的剪切位置来控制分类的粒度。

这是一种使用“Smith-Waterman”对齐（局部）对齐的方法

Biostrings 是Bioconductor project 的一部分。 SW 算法找到两个序列（字符串）的最佳局部（非端到端）对齐。在这种情况下，您可以再次使用cutree 设置您的类别，但您也可以调整scoring function 以满足您的需求。

library(Biostrings)
strList <- lapply(attributes, BString)

swDist <- matrix(apply(expand.grid(seq_along(strList), seq_along(strList)), 1, function(x) {
  pairwiseAlignment(strList[[x[1]]], strList[[x[2]]], type="local")@score
}), nrow = 10)

heatmap.2(swDist, trace="none", col = rev(heat.colors(15)),
          labRow = paste("id", 1:10, sep=""), labCol = paste("id", 1:10, sep=""))

【讨论】：