Создание матрицы совпадения

Я пытаюсь решить проблему наличия матрицы совместного присутствия. У меня есть файл данных транзакций и элементов, и я хочу видеть матрицу количества транзакций, в которых элементы отображаются вместе.

Я новичок в программировании R, и мне интересно узнать все ярлыки, которые R имеет, а не создавать определенные циклы (я использовал C лет назад и только придерживался макросов Excel и SPSS сейчас), Я проверил решения здесь, но не нашел тот, который работает (ближайшим является решение, приведенное здесь: Матрица совпадения с использованием SAC? - но она создала сообщение об ошибке, когда я использовал projecting_tm, я подозревал, что cbind не удалось в моем случае.

По существу, у меня есть таблица, содержащая следующее:

TrxID Items Quant
Trx1 A 3
Trx1 B 1
Trx1 C 1
Trx2 E 3
Trx2 B 1
Trx3 B 1
Trx3 C 4
Trx4 D 1
Trx4 E 1
Trx4 A 1
Trx5 F 5
Trx5 B 3
Trx5 C 2
Trx5 D 1, etc.

Я хочу создать что-то вроде:

   A B C D E F
A  0 1 1 0 1 1
B  1 0 3 1 1 0
C  1 3 0 1 0 0
D  1 1 1 0 1 1
E  1 1 0 1 0 0
F  0 1 1 1 0 0

Что я сделал (и вы, наверное, смеетесь над моим новичком R):

library(igraph)
library(tnet)

trx <- read.table("FileName.txt", header=TRUE) 
transID <- t(trx[1])
items <- t(trx[2])

id_item <- cbind(items,transID)
item_item <- projecting_tm(id_item, method="sum")
item_item <- tnet_igraph(item_item,type="weighted one-mode tnet")
item_matrix <-get.adjacency(item_item,attr="weight")
item_matrix

Как упоминалось выше, cbind, вероятно, не увенчался успехом, поэтому projecting_tm не смог дать мне никакого результата.

Любой альтернативный подход или поправка к моему методу?

Ваша помощь будет очень признательна!

Ответ 1

Я бы использовал комбинацию пакета reshape2 и матричной алгебры:

#read in your data
dat <- read.table(text="TrxID Items Quant
Trx1 A 3
Trx1 B 1
Trx1 C 1
Trx2 E 3
Trx2 B 1
Trx3 B 1
Trx3 C 4
Trx4 D 1
Trx4 E 1
Trx4 A 1
Trx5 F 5
Trx5 B 3
Trx5 C 2
Trx5 D 1", header=T)

#making the boolean matrix   
library(reshape2)
dat2 <- melt(dat)
w <- dcast(dat2, Items~TrxID)
x <- as.matrix(w[,-1])
x[is.na(x)] <- 0
x <- apply(x, 2,  function(x) as.numeric(x > 0))  #recode as 0/1
v <- x %*% t(x)                                   #the magic matrix 
diag(v) <- 0                                      #repalce diagonal
dimnames(v) <- list(w[, 1], w[,1])                #name the dimensions
v

Для графика возможно...

g <- graph.adjacency(v, weighted=TRUE, mode ='undirected')
g <- simplify(g)
# set labels and degrees of vertices
V(g)$label <- V(g)$name
V(g)$degree <- degree(g)
plot(g)

Ответ 2

Используя "dat" из одного из ответов выше, попробуйте crossprod и table:

V <- crossprod(table(dat[1:2]))
diag(V) <- 0
V
#      Items
# Items A B C D E F
#     A 0 1 1 1 1 0
#     B 1 0 3 1 1 1
#     C 1 3 0 1 0 1
#     D 1 1 1 0 1 1
#     E 1 1 0 1 0 0
#     F 0 1 1 1 0 0

Ответ 3

По соображениям эффективности, особенно по разреженным данным, я бы рекомендовал использовать разреженную матрицу.

dat <- read.table(text="TrxID Items Quant
Trx1 A 3
Trx1 B 1
Trx1 C 1
Trx2 E 3
Trx2 B 1
Trx3 B 1
Trx3 C 4
Trx4 D 1
Trx4 E 1
Trx4 A 1
Trx5 F 5
Trx5 B 3
Trx5 C 2
Trx5 D 1", header=T)

library("Matrix")

# factors for indexing matrix entries and naming dimensions
trx.fac <- factor(dat[,1])
itm.fac <- factor(dat[,2])

s <- sparseMatrix(
        as.numeric(trx.fac), 
        as.numeric(itm.fac),
        dimnames = list(
                as.character(levels(trx.fac)), 
                as.character(levels(itm.fac))),
        x = 1)

# calculating co-occurrences
v <- t(s) %*% s

# setting transactions counts of items to zero
diag(v) <- 0
v

Я предлагал каждое решение, опубликованное в этом потоке, попробовать. Ни один из них не работал с большими матрицами (я работал с матрицей размером 1500 x 2 000 000).

Немного не по теме: после вычисления матрицы совпадения я обычно хочу рассчитать расстояние между отдельными элементами. Коэффициент подобия/расстояния может быть рассчитан эффективно на матрице совпадения следующим образом:

# cross-product of vectors (numerator)
num <- v %*% v

# square root of square sum of each vector (used for denominator)
srss <- sqrt(apply(v^2, 1, sum))

# denominator
den <- srss %*% t(srss)

# cosine similarity
v.cos.sim <- num / den

# cosine distance
v.cos.dist <- 1 - v.cos.sim

Ответ 4

Я бы использовал xtabs для этого:

dat <- read.table(text="TrxID Items Quant
Trx1 A 3
Trx1 B 1
Trx1 C 1
Trx2 E 3
Trx2 B 1
Trx3 B 1
Trx3 C 4
Trx4 D 1
Trx4 E 1
Trx4 A 1
Trx5 F 5
Trx5 B 3
Trx5 C 2
Trx5 D 1", header=T)


term_doc <- xtabs(~ TrxID + Items, data=dat, sparse = TRUE)
co_occur <- crossprod(term_doc, term_doc)
diag(co_occur) <- 0
co_occur

Я ввел sparse = TRUE, чтобы показать, что это может работать для очень больших наборов данных.

Ответ 5

Это на самом деле очень просто и чисто, если вы сначала создаете двудольный граф, где верхние узлы являются транзакциями, а нижние - элементами. Затем вы создаете проекцию на нижние узлы.

dat <- read.table(text="TrxID Items Quant
Trx1 A 3
Trx1 B 1
Trx1 C 1
Trx2 E 3
Trx2 B 1
Trx3 B 1
Trx3 C 4
Trx4 D 1
Trx4 E 1
Trx4 A 1
Trx5 F 5
Trx5 B 3
Trx5 C 2
Trx5 D 1", header=T)

library(igraph)
bip <- graph.data.frame(dat)
V(bip)$type <- V(bip)$name %in% dat[,1]

## sparse=TRUE is a good idea if you have a large matrix here
v <- get.adjacency(bipartite.projection(bip)[[2]], attr="weight", sparse=FALSE)

## Need to reorder if you want it alphabetically
v[order(rownames(v)), order(colnames(v))]

#   A B C D E F
# A 0 1 1 1 1 0
# B 1 0 3 1 1 1
# C 1 3 0 1 0 1
# D 1 1 1 0 1 1
# E 1 1 0 1 0 0
# F 0 1 1 1 0 0