2014-11-26 2 views
5

У меня есть кусок предложений, и я хочу построить список неориентированных краев совместного совпадения слов и увидеть частоту каждого ребра. Я взглянул на пакет tm, но не нашел подобных функций. Есть ли какой-нибудь пакет/сценарий, который я могу использовать? Большое спасибо!Строка списка совпадений со словом в R

Примечание: Слово не происходит совместно с самим собой. Слово, которое появляется дважды или более, происходит с другими словами только один раз в том же предложении.

DF:

sentence_id text 
1   a b c d e 
2   a b b e 
3   b c d 
4   a e 
5   a 
6   a a a 

ВЫВОД

word1 word2 freq 
a  b  2 
a  c  1 
a  d  1 
a  e  3 
b  c  2 
b  d  2 
b  e  2 
c  d  2 
c  e  1 
d  e  1 
+0

@TylerRinker спасибо! Точно выход должен оставаться таким же, как и строка 5 имеет только «а», а в строке 6 «а» не происходит совместно с собой. – leoce

ответ

2

Это запутанное, так что должно быть лучшим подходом:

dat <- read.csv(text="sentence_id, text 
1,   a b c d e 
2,   a b b e 
3,   b c d 
4,   a e", header=TRUE) 


library(qdapTools); library(tidyr) 
x <- t(mtabulate(with(dat, by(text, sentence_id, bag_o_words))) > 0) 
out <- x %*% t(x) 
out[upper.tri(out, diag=TRUE)] <- NA 

out2 <- matrix2df(out, "word1") %>% 
    gather(word2, freq, -word1) %>% 
    na.omit() 

rownames(out2) <- NULL 
out2 

## word1 word2 freq 
## 1  b  a 2 
## 2  c  a 1 
## 3  d  a 1 
## 4  e  a 3 
## 5  c  b 2 
## 6  d  b 2 
## 7  e  b 2 
## 8  d  c 2 
## 9  e  c 1 
## 10  e  d 1 

Base единственным решение

out <- lapply(with(dat, split(text, sentence_id)), function(x) { 
    strsplit(gsub("^\\s+|\\s+$", "", as.character(x)), "\\s+")[[1]] 
}) 

nms <- sort(unique(unlist(out))) 

out2 <- lapply(out, function(x) { 
    as.data.frame(table(x), stringsAsFactors = FALSE) 
}) 

dat2 <- data.frame(x = nms) 

for(i in seq_along(out2)) { 
    m <- merge(dat2, out2[[i]], all.x = TRUE) 
    names(m)[i + 1] <- dat[["sentence_id"]][i] 
    dat2 <- m 
} 

dat2[is.na(dat2)] <- 0 
x <- as.matrix(dat2[, -1]) > 0 

out3 <- x %*% t(x) 
out3[upper.tri(out3, diag=TRUE)] <- NA 
dimnames(out3) <- list(dat2[[1]], dat2[[1]]) 

out4 <- na.omit(data.frame( 
     word1 = rep(rownames(out3), ncol(out3)), 
     word2 = rep(colnames(out3), each = nrow(out3)), 
     freq = c(unlist(out3)), 
     stringsAsFactors = FALSE) 
) 

row.names(out4) <- NULL 

out4 
+0

Спасибо! Ваш подход может работать для будущих исследований других людей. Тем не менее, мои предложения на самом деле на китайском языке, и сценарий, похоже, не способен справиться с китайскими иероглифами. Он превратил всех персонажей в буквенно-числовые, чтобы я не мог понять. – leoce

+0

Может ли быть конкретным? Какая часть превратила их в альфа-число? –

+0

О, я все понял. Скрипт не превращает китайские символы во что-либо, он просто опускает их. Строка. Имена матрицы, порожденной 'x <- t (mtabulate (with (dat, by (text, sentence_id, bag_o_words)))> 0)' - английские слова/цифры, которые являются частями предложений. – leoce

0

Вот основа R путь:

d <- read.table(text='sentence_id text 
1   "a b c d e" 
2   "a b b e" 
3   "b c d" 
4   "a e"', header=TRUE, as.is=TRUE) 

result.vec <- table(unlist(lapply(d$text, function(text) { 
    pairs <- combn(unique(scan(text=text, what='', sep=' ')), m=2) 
    interaction(pairs[1,], pairs[2,]) 
}))) 
# a.b b.b c.b d.b a.c b.c c.c d.c a.d b.d c.d d.d a.e b.e c.e d.e 
# 2 0 0 0 1 2 0 0 1 2 2 0 3 2 1 1 

result <- subset(data.frame(do.call(rbind, strsplit(names(result.vec), '\\.')), freq=as.vector(result.vec)), freq > 0) 
with(result, result[order(X1, X2),]) 

# X1 X2 freq 
# 1 a b 2 
# 5 a c 1 
# 9 a d 1 
# 13 a e 3 
# 6 b c 2 
# 10 b d 2 
# 14 b e 2 
# 11 c d 2 
# 15 c e 1 
# 16 d e 1 
+0

Спасибо! Однако в реальных данных могут быть две проблемы. Я попытался выяснить, что сценарий не может удалить предложение из 1 слова, например «hah». Если предложение имеет несколько слов, но они будут «уникальными» до 1 (например, «hah hah hah»), консоль также вызовет ошибку. – leoce

+0

Я добавил несколько строк для решения проблемы выше: http://stackoverflow.com/review/spected-edits/6328674, спасибо! – leoce

1

Это очень тесно связано с @ TylerRinker отвечают, но с использованием различных инструментов.

library(splitstackshape) 
library(reshape2) 

temp <- crossprod(
    as.matrix(
    cSplit_e(d, "text", " ", type = "character", 
      fill = 0, drop = TRUE)[-1])) 
temp[upper.tri(temp, diag = TRUE)] <- NA 
melt(temp, na.rm = TRUE) 
#  Var1 Var2 value 
# 2 text_b text_a  2 
# 3 text_c text_a  1 
# 4 text_d text_a  1 
# 5 text_e text_a  3 
# 8 text_c text_b  2 
# 9 text_d text_b  2 
# 10 text_e text_b  2 
# 14 text_d text_c  2 
# 15 text_e text_c  1 
# 20 text_e text_d  1 

В "_Тексте" часть "Var1" и "Var2" может быть легко раздела с sub или gsub.

+0

Мне это нравится. Я вытащил 'spllitstackshape' сегодня в ответ http://stackoverflow.com/a/27158031/1000343, но он не получил любви :-( –

+0

подход кажется простым и прямым, но R не может найти функцию' cSplit', ' cSplit_e' или 'cSplit_f' в последнем руководстве. Я предполагаю, что это связано с тем, что по умолчанию я установил splitstackshape 1.2.0 (двоичная версия), а не 1.4.2 (Mac OSX 10.8.5, R 3.1.1). .packages ("splitstackshape", repos = "http://github.com/mrdwab/splitstackshape", type = "source") ', но он сказал, что' package 'splitstackshape' недоступен (для R версии 3.1.1) ' – leoce

+0

@leoce, попробуйте установить его из CRAN, но с 'type =" source ". Вам также может понадобиться сделать то же самое для« data.table », возможно, перед установкой« splitstackshape ». – A5C1D2H2I1M1N2O1R2T1

Смежные вопросы