I've got a dataset where I'm interested in the frequencies of different pairs emerging, but it doesn't matter which order the elements occur. For example:
library(janitor)
set.seed(24601)
options <- c("a", "b", "c", "d", "e", "f")
data.frame(x = sample(options, 20, replace = TRUE),
y = sample(options, 20, replace = TRUE)) %>%
tabyl(x, y)
provides me with the output
x a b c d e f
a 1 0 1 0 1 0
b 0 2 0 1 0 0
c 2 0 1 0 0 0
d 0 0 0 0 1 0
e 1 1 2 0 0 3
f 0 0 1 1 0 1
I'd ideally have the top right or bottom left of this table, where the combination of values a and c would be a total of 3. This is the sum of 1 (in the top right) and 2 (in the middle left). And so on for each other pair of values.
I'm sure there must be a simple way to do this, but I can't figure out what it is...
Edited to add (thanks #Akrun for the request): ideally I'd like the following output
x a b c d e f
a 1 0 3 0 2 0
b 2 0 1 1 0
c 1 0 2 1
d 0 1 1
e 0 3
f 1
We could + with the transposed output (except the first column), then replace the 'out' object upper triangle values (subset the elements based on the upper.tri - returns a logical vector) with that corresponding elements, and assign the lower triangle elements to NA
out2 <- out[-1] + t(out[-1])
out[-1][upper.tri(out[-1])] <- out2[upper.tri(out2)]
out[-1][lower.tri(out[-1])] <- NA
-output
out
# x a b c d e f
# a 1 0 3 0 2 0
# b NA 2 0 1 1 0
# c NA NA 1 0 2 1
# d NA NA NA 0 1 1
# e NA NA NA NA 0 3
# f NA NA NA NA NA 1
data
set.seed(24601)
options <- c("a", "b", "c", "d", "e", "f")
out <- data.frame(x = sample(options, 20, replace = TRUE),
y = sample(options, 20, replace = TRUE)) %>%
tabyl(x, y)
Here is another option, using igraph
out[-1] <- get.adjacency(
graph_from_data_frame(
get.data.frame(
graph_from_adjacency_matrix(
as.matrix(out[-1]), "directed"
)
), FALSE
),
type = "upper",
sparse = FALSE
)
which gives
> out
x a b c d e f
a 1 0 3 0 2 0
b 0 2 0 1 1 0
c 0 0 1 0 2 1
d 0 0 0 0 1 1
e 0 0 0 0 0 3
f 0 0 0 0 0 1
Related
I have dataset "data" with 7 rows and 4 columns, as follows:
var1 var2 var3 var4
A C
A C B
B A C D
D B
B
D B
B C
I want to create following table "Mat" based on the data I have:
A B C D
1 1
1 1 1
1 1 1 1
1 1
1
1 1
1 1 1
Basically, I have taken unique elements from the original data and create a matrix "Mat" where number of rows in Mat=number of rows in Data and number of columns in "Mat"=number of unique elements in Data (that is, A, B, C, D)
I wrote following code in R:
rule <-c("A","B","C","D")
mat<-matrix(, nrow = dim(data)[1], ncol = dim(rule)[1])
mat<-data.frame(mat)
x<-rule[,1]
nm<-as.character(x)
names(mat)<-nm
n_data<-dim(data)[1]
for(i in 1:n_data)
{
for(j in 2:dim(data)[2])
{
for(k in 1:dim(mat)[2])
{
ifelse(data[i,j]==names(mat)[k],mat[i,k]==1,0)
}
}
}
I am getting all NA in "mat". Also, the running time is too much because in my original data set I have 20,000 rows and 100 columns in "Mat".
Any advice will be highly appreciated. Thanks!
This should be faster than the nested for loops:
> sapply(c("A", "B", "C", "D"), function(x) { rowSums(df == x, na.rm = T) })
# A B C D
# [1,] 1 0 1 0
# [2,] 1 1 1 0
# [3,] 1 1 1 1
# [4,] 0 1 0 1
# [5,] 0 1 0 0
# [6,] 0 1 0 1
# [7,] 0 1 1 0
Data
df <- read.table(text = "var1 var2 var3 var4
A C NA NA
A C B NA
B A C D
D B NA NA
NA B NA NA
D B NA NA
B C NA NA", header = T, stringsAsFactors = F)
By using table and rep
table(rep(1:nrow(df),dim(df)[2]),unlist(df))
A B C D
1 1 0 1 0
2 1 1 1 0
3 1 1 1 1
4 0 1 0 1
5 0 1 0 0
6 0 1 0 1
7 0 1 1 0
I have a dataframe called "df" like this:
ID Value
1 a
1 b
1 c
1 d
3 a
3 b
3 e
3 f
. .
. .
. .
I have a matrix filled with zeros like this:
a b c d e f
a x 0 0 0 0 0
b 0 x 0 0 0 0
c 0 0 x 0 0 0
d 0 0 0 x 0 0
e 0 0 0 0 x 0
f 0 0 0 0 0 x
I would then like to loop through the dataframe something like this:
for each ID, for each value i, for each value j != i, matrix[i,j] += 1
So for each ID, for each combination of values, I would like to raise the value in the matrix by 1, resulting in:
a b c d e f
a x 2 1 1 1 1
b 2 x 1 1 1 1
c 1 1 x 1 0 0
d 1 1 1 x 0 0
e 1 1 0 0 x 1
f 1 1 0 0 1 x
So for example, [a,b] = 2, because this combination of values occurs for two different IDs, while [a,c] = 1, because this combination of values only occurs when ID = 1 and not when ID = 3.
How can I achieve this? I already made a vector containing the unique IDs.
Thanks in advance.
The easiest would be to get the table and then do a crossprod
out <- crossprod(table(df))
diag(out) <- NA #replace the diagonals with NA
names(dimnames(out)) <- NULL #set the names of the dimnames as NULL
out
# a b c d e f
#a NA 2 1 1 1 1
#b 2 NA 1 1 1 1
#c 1 1 NA 1 0 0
#d 1 1 1 NA 0 0
#e 1 1 0 0 NA 1
#f 1 1 0 0 1 NA
data
df <- structure(list(ID = c(1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L), Value = c("a",
"b", "c", "d", "a", "b", "e", "f")), .Names = c("ID", "Value"
), class = "data.frame", row.names = c(NA, -8L))
Question
Let's say I have this dataframe:
# mock data set
df.size = 10
cluster.id<- sample(c(1:5), df.size, replace = TRUE)
letters <- sample(LETTERS[1:5], df.size, replace = TRUE)
test.set <- data.frame(cluster.id, letters)
Will be something like:
cluster.id letters
<int> <fctr>
1 5 A
2 4 B
3 4 B
4 3 A
5 3 E
6 3 D
7 3 C
8 2 A
9 2 E
10 1 A
Now I want to group these per cluster.id and see what kind of letters I can find within a cluster, so for example cluster 3 contains the letters A,E,D,C. Then I want to get all unique pairwise combinations (but not combinations with itself so no A,A e.g.): A,E ; A,D, A,C etc. Then I want to update the pairwise distance for these combination in an adjacency matrix/data frame.
Idea
# group by cluster.id
# per group get all (unique) pairwise combinations for the letters (excluding pairwise combinations with itself, e.g. A,A)
# update adjacency for each pairwise combinations
What I tried
# empty adjacency df
possible <- LETTERS
adj.df <- data.frame(matrix(0, ncol = length(possible), nrow = length(possible)))
colnames(adj.df) <- rownames(adj.df) <- possible
# what I tried
update.adj <- function( data ) {
for (comb in combn(data$letters,2)) {
# stucked
}
}
test.set %>% group_by(cluster.id) %>% update.adj(.)
Probably there is an easy way to do this because I see adjacency matrices all the time, but I'm not able to figure it out.. Please let me know if it's not clear
Answer to comment
Answer to #Manuel Bickel:
For the data I gave as example (the table under "will be something like"):
This matrix will be A-->Z for the full dataset, keep that in mind.
A B C D E
A 0 0 1 1 2
B 0 0 0 0 0
C 1 0 0 1 1
D 1 0 1 0 1
E 2 0 1 1 0
I will explain what I did:
cluster.id letters
<int> <fctr>
1 5 A
2 4 B
3 4 B
4 3 A
5 3 E
6 3 D
7 3 C
8 2 A
9 2 E
10 1 A
Only the clusters containing more > 1 unique letter are relevant (because we don't want combinations with itself, e.g cluster 1 containing only letter B, so it would result in combination B,B and is therefore not relevant):
4 3 A
5 3 E
6 3 D
7 3 C
8 2 A
9 2 E
Now I look for each cluster what pairwise combinations I can make:
cluster 3:
A,E
A,D
A,C
E,D
E,C
D,C
Update these combination in the adjacency matrix:
A B C D E
A 0 0 1 1 1
B 0 0 0 0 0
C 1 0 0 1 1
D 1 0 1 0 1
E 2 0 1 1 0
Then go to the next cluster
cluster 2
A,E
Update the adjacency matrix again:
A B C D E
A 0 0 1 1 2 <-- note the 2 now
B 0 0 0 0 0
C 1 0 0 1 1
D 1 0 1 0 1
E 2 0 1 1 0
As reaction to the huge dataset
library(reshape2)
test.set <- read.table(text = "
cluster.id letters
1 5 A
2 4 B
3 4 B
4 3 A
5 3 E
6 3 D
7 3 C
8 2 A
9 2 E
10 1 A", header = T, stringsAsFactors = F)
x1 <- reshape2::dcast(test.set, cluster.id ~ letters)
x1
#cluster.id A B C D E
#1 1 1 0 0 0 0
#2 2 1 0 0 0 1
#3 3 1 0 1 1 1
#4 4 0 2 0 0 0
#5 5 1 0 0 0 0
x2 <- table(test.set)
x2
# letters
#cluster.id A B C D E
# 1 1 0 0 0 0
# 2 1 0 0 0 1
# 3 1 0 1 1 1
# 4 0 2 0 0 0
# 5 1 0 0 0 0
x1.c <- crossprod(x1)
#Error in crossprod(x, y) :
# requires numeric/complex matrix/vector arguments
x2.c <- crossprod(x2)
#works fine
Following above comment, here the code of Tyler Rinker used with your data. I hope this is what you want.
UPDATE: Following below comments, I added a solution using the package reshape2 in order to be able to handle larger amounts of data.
test.set <- read.table(text = "
cluster.id letters
1 5 A
2 4 B
3 4 B
4 3 A
5 3 E
6 3 D
7 3 C
8 2 A
9 2 E
10 1 A", header = T, stringsAsFactors = F)
x <- table(test.set)
x
letters
#cluster.id A B C D E
# 1 1 0 0 0 0
# 2 1 0 0 0 1
# 3 1 0 1 1 1
# 4 0 2 0 0 0
# 5 1 0 0 0 0
#base approach, based on answer by Tyler Rinker
x <- crossprod(x)
diag(x) <- 0 #this is to set matches such as AA, BB, etc. to zero
x
# letters
# letters
# A B C D E
# A 0 0 1 1 2
# B 0 0 0 0 0
# C 1 0 0 1 1
# D 1 0 1 0 1
# E 2 0 1 1 0
#reshape2 approach
x <- acast(test.set, cluster.id ~ letters)
x <- crossprod(x)
diag(x) <- 0
x
# A B C D E
# A 0 0 1 1 2
# B 0 0 0 0 0
# C 1 0 0 1 1
# D 1 0 1 0 1
# E 2 0 1 1 0
I have a data.frame like this:
x1 <- data.frame(id=1:3,item=c("A","B","A","B","C","D"))
x1[order(x1$item),]
id item
1 1 A
3 3 A
2 2 B
4 1 B
5 2 C
6 3 D
I want to get :
id1=c(1,2,1,3,2,3)
id2 = c(2,1,3,1,3,2)
A=c(0,0,1,1,0,0)
B=c(1,1,0,0,0,0)
C = 0
D=0
datawanted <- data.frame(id1,id2,A,B,C,D)
id1 id2 A B C D
1 1 2 0 1 0 0
2 2 1 0 1 0 0
3 1 3 1 0 0 0
4 3 1 1 0 0 0
5 2 3 0 0 0 0
6 3 2 0 0 0 0
if person1 and person2 both have B,then in the datawanted dataframe,column A ,got 1,else get 0.
Can someone give me some suggestions or functions in R,to deal with this problem?
Cool question. You have a bipartite graph, so following Gabor's tutorial...
library(igraph)
g = graph_from_edgelist(as.matrix(x1))
V(g)$type = grepl("[A-Z]", V(g)$name)
For OP's desired output, first we can extract the incidence matrix:
gi = get.incidence(g)
# A B C D
# 1 1 1 0 0
# 2 0 1 1 0
# 3 1 0 0 1
Note (thanks #thelatemail), that if you don't want to use igraph, you can get to gi as table(x1).
Then, we look at the combinations of ids:
res = t(combn(nrow(gi), 2, function(x) c(
as.integer(rownames(gi)[x]),
pmin( gi[x[1], ], gi[x[2], ] )
)))
dimnames(res) <- list( NULL, c("id1", "id2", colnames(gi)))
# id1 id2 A B C D
# [1,] 1 2 0 1 0 0
# [2,] 1 3 1 0 0 0
# [3,] 2 3 0 0 0 0
This essentially is the OP's desired output. They had included redundant rows (e.g., 1,2 and 2,1).
Fun reason to use a graph (ht Chris):
V(g)$color <- ifelse(V(g)$type, "red", "light blue")
V(g)$x <- (1:2)[ V(g)$type + 1 ]
V(g)$y <- ave(seq_along(V(g)), V(g)$type, FUN = seq_along)
plot(g)
Or, apparently this can be done more or less like
plot(g, layout = layout.bipartite(g)[,2:1])
I have a distance matrix (as data.table) showing pairwise distances between a number of items, but not all items are in the matrix. I need to create a larger data.table that has all the missing items populated. I can do this with matrices fairly easily:
items=c("a", "b", "c", "d")
small_matrix=matrix(c(0, 1, 2, 3), nrow=2, ncol=2,
dimnames=list(c("a", "b"), c("a", "b")))
# create zero matrix of the right size
full_matrix <- matrix(0, ncol=length(items), nrow=length(items),
dimnames=list(items, items))
# populate items from the small matrix
full_matrix[rownames(small_matrix), colnames(small_matrix)] <- small_matrix
full_matrix
# a b c d
# a 0 2 0 0
# b 1 3 0 0
# c 0 0 0 0
# d 0 0 0 0
What is the equivalent of that in data.table? I can create an 'id' column in small_DT and use it as the key, but I'm not sure how to overwrite items in full_DT that has the same id/column pair.
Let's convert to data.table and keep the row names as an extra column:
dts = as.data.table(small_matrix, keep = T)
# rn a b
#1: a 0 2
#2: b 1 3
dtf = as.data.table(full_matrix, keep = T)
# rn a b c d
#1: a 0 0 0 0
#2: b 0 0 0 0
#3: c 0 0 0 0
#4: d 0 0 0 0
Now just join on the rows, and assuming small matrix is always a subset you can do the following:
dtf[dts, names(dts) := dts, on = 'rn']
dtf
# rn a b c d
#1: a 0 2 0 0
#2: b 1 3 0 0
#3: c 0 0 0 0
#4: d 0 0 0 0
Above assumes version 1.9.5+. Otherwise you'll need to set the key first.
Suppose you have these two data.table:
dt1 = as.data.table(small_matrix)
# a b
#1: 0 2
#2: 1 3
dt2 = as.data.table(full_matrix)
# a b c d
#1: 0 0 0 0
#2: 0 0 0 0
#3: 0 0 0 0
#4: 0 0 0 0
You can't operate like with data.frame or matrix, eg by doing:
dt2[rownames(full_matrix) %in% rownames(small_matrix), names(dt1), with=F] <- dt1
This code will raise an error, because to affect new values, you need to use the := operator:
dt2[rownames(full_matrix) %in% rownames(small_matrix), names(dt1):=dt1][]
# a b c d
#1: 0 2 0 0
#2: 1 3 0 0
#3: 0 0 0 0
#4: 0 0 0 0