Geek asks and answers

R-matrix frequency matrix

I have data from the barter economy. I am trying to create a matrix that counts how often elements act as counterparties to other elements.

As an example:

  myDat <- data.frame(
             TradeID = as.factor(c(1,1,1,2,2,2,3,3,4,4,5,5,6,6,7,7,8,8,8)),
             Origin = as.factor(c(1,0,0,1,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0)),
             ItemID = as.factor(c(1,2,3,4,5,1,1,6,7,1,1,8,7,5,1,1,2,3,4))
            )


     TradeID Origin ItemID
  1        1      1      1
  2        1      0      2
  3        1      0      3
  4        2      1      4
  5        2      1      5
  6        2      0      1
  7        3      1      1
  8        3      0      6
  9        4      1      7
  10       4      0      1
  11       5      1      1
  12       5      0      8
  13       6      1      7
  14       6      0      5
  15       7      1      1
  16       7      0      1
  17       8      1      2
  18       8      0      3
  19       8      0      4
  20       9      1      1
  21       9      0      8

Where TradeID indicates a specific transaction. ItemID indicates the item, and Origin indicates the direction the item is moving.

For example, given my data, the matrix I created will look something like this:     enter image description here

  • For example, a value of 2 in [1.8] indicates that positions 1 and 8 are counterparties in two transactions. (Note that this is a symmetric matrix, and therefore [8.1] also has a value of 2).
  • So far, the value 1 in [1,2] indicates that elements 1 and 2 were counterparties in only one transaction (all other 1s throughout the matrix indicate the same)
  • , [1,1], 1 , 1 ( 7)
  • , , 1 . ( ) , , . , .

. , , .

, y'all .

+3
3

, , . :

Reduce("+",by(myDat, myDat$TradeID, function(x) pmin(table(x$ItemID[x$Origin==0]) %o% table(x$ItemID[x$Origin==1]) + table(x$ItemID[x$Origin==1]) %o% table(x$ItemID[x$Origin==0]),1)))

, :

  1 2 3 4 5 6 7 8
1 1 1 1 1 1 1 1 2
2 1 0 1 1 0 0 0 0
3 1 1 0 0 0 0 0 0
4 1 1 0 0 0 0 0 0
5 1 0 0 0 0 0 1 0
6 1 0 0 0 0 0 0 0
7 1 0 0 0 1 0 0 0
8 2 0 0 0 0 0 0 0

. TradeID by outer (%o%) table. Trade 7, item 1 1, pmax, . , Reduce.

, . TradeID # 9, .

# Data
myDat <- data.frame(
  TradeID = as.factor(c(1,1,1,2,2,2,3,3,4,4,5,5,6,6,7,7,8,8,8,9,9)),
  Origin = as.factor(c(1,0,0,1,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0,1,0)),
  ItemID = as.factor(c(1,2,3,4,5,1,1,6,7,1,1,8,7,5,1,1,2,3,4,1,8))
)

# Sum in 1 direction
by(myDat, myDat$TradeID, function(x) table(x$ItemID[x$Origin==0]) %o% table(x$ItemID[x$Origin==1]))

# Sum in both directions
by(myDat, myDat$TradeID, function(x) table(x$ItemID[x$Origin==1]) %o% table(x$ItemID[x$Origin==0]) + table(x$ItemID[x$Origin==0]) %o% table(x$ItemID[x$Origin==1]))

# Remove double-count in trade 7
by(myDat, myDat$TradeID, function(x) pmin(table(x$ItemID[x$Origin==0]) %o% table(x$ItemID[x$Origin==1]) + table(x$ItemID[x$Origin==1]) %o% table(x$ItemID[x$Origin==0]),1))

# Sum across lists
Reduce("+",by(myDat, myDat$TradeID, function(x) pmin(table(x$ItemID[x$Origin==0]) %o% table(x$ItemID[x$Origin==1]) + table(x$ItemID[x$Origin==1]) %o% table(x$ItemID[x$Origin==0]),1)))

1 ( ), .

result = Reduce("+",by(myDat, myDat$TradeID, function(x) table(x$ItemID[x$Origin==0]) %o% table(x$ItemID[x$Origin==1])))
result2 = result + t(result)
diag(result2) = diag(result)
result2
    1 2 3 4 5 6 7 8
  1 1 1 1 1 1 1 1 2
  2 1 0 1 1 0 0 0 0
  3 1 1 0 0 0 0 0 0
  4 1 1 0 0 0 0 0 0
  5 1 0 0 0 0 0 1 0
  6 1 0 0 0 0 0 0 0
  7 1 0 0 0 1 0 0 0
  8 2 0 0 0 0 0 0 0

, .

> microbenchmark(Reduce("+",by(myDat, myDat$TradeID, function(x) pmin(table(x$ItemID[x$Origin==0]) %o% table(x$ItemID[x$Origin==1]) + table(x$ItemID[x$Origin==1]) %o% table(x$ItemID[x$Origin==0]),1))))
Unit: milliseconds
      min       lq   median       uq     max neval
 7.489092 7.733382 7.955861 8.536359 9.83216   100

> microbenchmark(Reduce("+",by(myDat, myDat$TradeID, function(x) table(x$ItemID[x$Origin==0]) %o% table(x$ItemID[x$Origin==1]))))
Unit: milliseconds

      min      lq   median       uq      max neval
 4.023964 4.18819 4.277767 4.452824 5.801171   100
+2

ID ItemID

myDat <- data.frame(
  TradeID = as.factor(c(1,1,1,2,2,2,3,3,4,4,5,5,6,6,7,7,8,8,8)),
  Origin = as.factor(c(1,0,0,1,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0)),
  ItemID = as.factor(c(1,2,3,4,5,1,1,6,7,1,1,8,7,5,1,1,2,3,4))
)
result = tapply(myDat$Origin, list(myDat$ItemID,myDat$TradeID), length)
result[is.na(result)] = 0
result["1","7"]

:

> result
  1 2 3 4 5 6 7 8
1 1 1 1 1 1 0 2 0
2 1 0 0 0 0 0 0 1
3 1 0 0 0 0 0 0 1
4 0 1 0 0 0 0 0 1
5 0 1 0 0 0 1 0 0
6 0 0 1 0 0 0 0 0
7 0 0 0 1 0 1 0 0
8 0 0 0 0 1 0 0 0

1 Origin ID ItemID

result = tapply(myDat$Origin, list(myDat$ItemID,myDat$TradeID), function(x) { sum(as.numeric(as.character(x)))/length(x) })

NA 0 result[is.na(result)] = 0, , 0 Origin.

+2

This will give you the number of observations for consecutive ItemIDs:

idxList <-  with(myDat, tapply(ItemID, TradeID, FUN = function(items) 
  lapply(seq(length(items) - 1), 
         function(i) sort(c(items[i], items[i + 1])))))

# indices of observations  
idx <- do.call(rbind, unlist(idxList, recursive = FALSE))

# create a matrix
ids <- unique(myDat$ItemID)
mat <- matrix(0, length(ids), length(ids))

# place values in matrix
for (i in seq(nrow(idx))) {
  mat[idx[i, , drop = FALSE]] <- mat[idx[i, , drop = FALSE]] + 1      
}

# create symmatric marix 
mat[lower.tri(mat)] <- t(mat)[lower.tri(mat)]


     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    1    1    0    0    1    1    1    1
[2,]    1    0    2    0    0    0    0    0
[3,]    0    2    0    1    0    0    0    0
[4,]    0    0    1    0    1    0    0    0
[5,]    1    0    0    1    0    0    1    0
[6,]    1    0    0    0    0    0    0    0
[7,]    1    0    0    0    1    0    0    0
[8,]    1    0    0    0    0    0    0    0
+1
source

More articles:


All Articles