I've got an array that was generated by flattening of a bottom triangle of a symmetrical square matrix (i.e distance matrix). I'm looking to reverse that process and generate the full square matrix from the array.
Let's say the original matrix was:
0 1 2 4
1 0 3 5
2 3 0 6
4 5 6 0
The lower triangle is:
1
2 3
4 5 6
...which was then flattened and recorded as array
1 2 3 4 5 6
I want to take that array and convert it back to the original matrix. I was hoping that it'd be as simple as
as.matrix(as.dist(ar)) + t(as.matrix(as.dist(ar)))
...but as.dist(...) actually goes on calculate distances in various ways, instead of simply filling in the values from the array. There's probably a simple alternative, right?
ar <- 1:6
d <- (1 + sqrt(1 + 8 * length(ar))) / 2
x <- matrix(0, d, d)
x[upper.tri(x)] <- ar
x[lower.tri(x)] <- t(x)[lower.tri(x)]
x
# [,1] [,2] [,3] [,4]
# [1,] 0 1 2 4
# [2,] 1 0 3 5
# [3,] 2 3 0 6
# [4,] 4 5 6 0
Let n1 be such that 1+2+3+...+n1 is the length of x and let n = n1 + 1. Then m is an n x n matrix so:
ar <- 1:6
n <- which(cumsum(seq_along(ar)) == length(ar)) + 1
m <- matrix(0, n, n)
as.dist(t(replace(m, upper.tri(m), ar)))
giving:
1 2 3
2 1
3 2 3
4 4 5 6
Related
I am hoping to create a matrix that shows a count of instances of overlapping values for a grouping variable based on a second variable. Specifically, I am hoping to determine the degree to which primary studies overlap across meta-analyses in order to create a network diagram.
So, in this example, I have three meta-analyses that include some portion of three primary studies.
df <- data.frame(metas = c(1,1,1,2,3,3), studies = c(1,3,2,1,2,3))
metas studies
1 1 1
2 1 3
3 1 2
4 2 1
5 3 2
6 3 3
I would like it to return:
v1 v2 v3
1 3 1 2
2 1 1 0
3 2 0 2
The value in row 1, column 1 indicates that Meta-analysis 1 had three studies in common with itself (i.e., it included three studies). Row 1, column 2 indicates that Meta-analysis 1 had one study in common with Meta-analysis 2. Row 1, column 3 indicates that Meta-analysis 1 had two studies in common with Meta-analysis 3.
I believe you are looking for a symmetric matrix of intersecting studies.
dfspl <- split(df$studies, df$metas)
out <- outer(seq_along(dfspl), seq_along(dfspl),
function(a, b) lengths(Map(intersect, dfspl[a], dfspl[b])))
out
# [,1] [,2] [,3]
# [1,] 3 1 2
# [2,] 1 1 0
# [3,] 2 0 2
If you need names on them, you can go with the names as defined by df$metas:
rownames(out) <- colnames(out) <- names(dfspl)
out
# 1 2 3
# 1 3 1 2
# 2 1 1 0
# 3 2 0 2
If you need the names defined as v plus the meta name, go with
rownames(out) <- colnames(out) <- paste0("v", names(dfspl))
out
# v1 v2 v3
# v1 3 1 2
# v2 1 1 0
# v3 2 0 2
If you need to understand what this is doing, outer creates an expansion of the two argument vectors, and passes them all at once to the function. For instance,
outer(seq_along(dfspl), seq_along(dfspl), function(a, b) { browser(); 1; })
# Called from: FUN(X, Y, ...)
debug at #1: [1] 1
# Browse[2]>
a
# [1] 1 2 3 1 2 3 1 2 3
# Browse[2]>
b
# [1] 1 1 1 2 2 2 3 3 3
# Browse[2]>
What we ultimately want to do is find the intersection of each pair of studies.
dfspl[[1]]
# [1] 1 3 2
dfspl[[3]]
# [1] 2 3
intersect(dfspl[[1]], dfspl[[3]])
# [1] 3 2
length(intersect(dfspl[[1]], dfspl[[3]]))
# [1] 2
Granted, we are doing it twice (once for 1 and 3, once for 3 and 1, which is the same result), so this is a little inefficient ... it would be better to filter them to only look at the upper or lower half and transferring it to the other.
Edited for a more efficient process (only calculating each intersection pair once, and never calculating self-intersection.)
eg <- expand.grid(a = seq_along(dfspl), b = seq_along(dfspl))
eg <- eg[ eg$a < eg$b, ]
eg
# a b
# 4 1 2
# 7 1 3
# 8 2 3
lens <- lengths(Map(intersect, dfspl[eg$a], dfspl[eg$b]))
lens
# 1 1 2 ## btw, these are just names, from eg$a
# 1 2 0
out <- matrix(nrow = length(dfspl), ncol = length(dfspl))
out[ cbind(eg$a, eg$b) ] <- lens
out
# [,1] [,2] [,3]
# [1,] NA 1 2
# [2,] NA NA 0
# [3,] NA NA NA
out[ lower.tri(out) ] <- out[ upper.tri(out) ]
diag(out) <- lengths(dfspl)
out
# [,1] [,2] [,3]
# [1,] 3 1 2
# [2,] 1 1 0
# [3,] 2 0 2
Same idea as #r2evans, also Base R (and a bit less eloquent) (edited as required):
# Create df using sample data:
df <- data.frame(metas = c(1,1,1,2,3,3), studies = c(1,7,2,1,2,3))
# Test for equality between the values in the metas vector and the rest of
# of the values in the dataframe -- Construct symmetric matrix from vector:
m1 <- diag(v1); m1[,1] <- m1[1,] <- v1 <- rowSums(data.frame(sapply(df$metas, `==`,
unique(unlist(df)))))
# Coerce matrix to dataframe setting the names as desired; dropping non matches:
df_2 <- setNames(data.frame(m1[which(rowSums(m1) > 0), which(colSums(m1) > 0)]),
paste0("v", 1:ncol(m1[which(rowSums(m1) > 0), which(colSums(m1) > 0)])))
Calculate sequence score based on score matrix.
sum(j[k])
j <- matrix(1:25, ncol = 5, nrow = 5)
diag(j) <- 0
j
n <- 1:5
k <- sample(n, 5, replace = FALSE)
k <- replicate(5, sample(n, 5, replace = FALSE))
j is score matrix.
k is sequence type matrix.
lets say k[1,] = 4 1 5 3 2
k[2,] = 2 5 4 2 4
solution: Please help answer two issues;
Issue 1:
add one more column to matrix k (lets call it "score"). Based on J matrix the score for this sequence should be 48.
4 1 5 3 2 48
Issue 2:
k[2,] = 2 5 4 2 4 The sample function is producing wrong permutations. I don't want any repetition in the sequence. Here 4 is repeated. Secondly 1 is missing. is there any other best way to generate random permutations.
You better double check the result. Without a reproducible example from your end it's difficult to confirm the values.
set.seed(1)
k <- replicate(5, sample(5))
# each column is a random permutation of 1:5
k
# [,1] [,2] [,3] [,4] [,5]
# [1,] 2 5 2 3 5
# [2,] 5 4 1 5 1
# [3,] 4 2 3 4 2
# [4,] 3 3 4 1 4
# [5,] 1 1 5 2 3
j <- matrix(1:25, 5)
diag(j) <- 0
nr <- nrow(k)
# arrange successive values as a column pair
ix <- cbind(c(k[-nr,]), c(k[-1,]))
# use the column pair to reference indices in j
jx <- j[ix]
# arrange j-values into a matrix and sum by column, producing the scores
scores <- colSums(matrix(jx, nr-1))
cbind(t(k), scores)
# scores
# [1,] 2 5 4 3 1 59
# [2,] 5 4 2 3 1 44
# [3,] 2 1 3 4 5 55
# [4,] 3 5 4 1 2 53
# [5,] 5 1 2 4 3 42
I have 6 digits (1, 2, 3, 4, 5, 6), and I need to create all possible combinations (i.e. 6*5*4*3*2*1 = 720 combinations) in which no number can be used twice and O is not allowed. I would like to obtain combinations like: 123456, 246135, 314256, etc.
Is there a way to create them with Matlab or R? Thank you.
In Matlab you can use
y = perms(1:6);
This gives a numerical 720×6 array y, where each row is a permutation:
y =
6 5 4 3 2 1
6 5 4 3 1 2
6 5 4 2 3 1
6 5 4 2 1 3
6 5 4 1 2 3
···
If you want the result as a char array:
y = char(perms(1:6)+'0');
which produces
y =
654321
654312
654231
654213
654123
···
In R:
library(combinat)
p <- permn(1:6)
gives you a list; do.call(rbind, p) or matrix(unlist(p), ncol=6, byrow=TRUE) will give a numeric array; sapply(p,paste,collapse="") gives a vector of strings.
Here's a base R 'solution':
p <- unique(t(replicate(100000, sample(6,6), simplify="vector")))
nrow(p)
#> [1] 720
head(p)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 3 5 4 2 1 6
#> [2,] 6 3 5 4 1 2
#> [3,] 5 1 6 2 3 4
#> [4,] 6 5 3 2 4 1
#> [5,] 5 2 3 6 4 1
#> [6,] 1 4 2 5 6 3
It's a hack of course, and this potentially only applies to the example given, but sometimes it's useful to do things in silly ways... this takes an excessive number of samples (without replacement) of the vector 1:6, then removes any duplicates. It does indeed produce the unique 720 results, but they're not sorted.
A base R approach is
x <- do.call(expand.grid, rep(list(1:6), 6))
x <- x[apply(x, MAR = 1, function(x) length(unique(x)) == 6), ]
which creates a matrix with 6^6 rows, then retains only rows that contain all 6 numbers.
I have a matrix A[72][36] and I would like to fit the values of A in a bigger matrix B[360][180].
I constructed this data frame linking the col/row index of A to the new 'grid'.
> head(INDEX)
LonNew LatNew LonINT LatINT
1 -179.5 -89.5 1 1
2 -178.5 -88.5 1 1
3 -177.5 -87.5 1 1
4 -176.5 -86.5 1 1
5 -175.5 -85.5 1 1
6 -174.5 -84.5 2 2
7 -173.5 -83.5 2 2
8 -172.5 -82.5 2 2
9 -171.5 -81.5 2 2
10 -170.5 -80.5 2 2
Then I calculated the corresponding values of the new Lat/Lon couples
NEWVar <- array(NA, dim = length(INDEX$LonNew))
for (j in 1:length(INDEX$LonINT) ){
NEWVar[j] <- A[INDEX$LonINT[j],INDEX$LatINT[j]]
}
> head(NEWVar)
3 3 3 3 3 4 4 4 4 4
The problem is then that I don't know how to create the new 360x180 matrix where for each couple (LonNew,LatNew) I have the corresponding NEWVar.
Can someone help me?
I've created a smaller, complete reproducible example. Here's the smaller matrix.
A<-matrix(1:4, nrow=2)
# [,1] [,2]
# [1,] 1 3
# [2,] 2 4
And let's say you want to scale that up to a 5x5 using this index.
INDEX<-data.frame(
LonNew = rep(c(-2,-2,0,2,2), each=5),
LatNew = rep(c(-2,-2,0,2,2), 5),
LonInt = rep(c(1,1,1,2,2), each=5),
LatInt = rep(c(1,1,2,1,2), 5)
)
The easiest way to turn the new values of Lat and Lon into array indexes is via factor variables. So i created
NNF <- factor(INDEX$LonNew)
TNF <- factor(INDEX$LatNew)
And i create the new B matrix with
B<-matrix(NA, nrow=nlevels(NNF), ncol=nlevels(TNF),
dimnames=list(levels(NNF), levels(TNF)))
And then I do the assignment with
B[cbind(NNF, TNF)] <- A[cbind(INDEX$LonInt, INDEX$LatInt)]
and that returns
# -2 0 2
# -2 1 3 3
# 0 1 3 3
# 2 2 4 4
which has scaled up the matrix according to the index data. The trick here was just index our matrices with matrices so we can grab different row and column values each time.
I am working on a collaborative filtering problem, and I am having problems reshaping my raw data into a user-rating matrix. I am given a rating database with columns 'movie', 'user' and 'rating'. From this database, I would like to obtain a matrix of size #users x #movies, where each row indicates a user's ratings.
Here is a minimal working example:
# given this:
ratingDB <- data.frame(rbind(c(1,1,1),c(1,2,NA),c(1,3,0), c(2,1,1), c(2,2,1), c(2,3,0),
c(3,1,NA), c(3,2,NA), c(3,3,1)))
names(ratingDB) <- c('user', 'movie', 'liked')
#how do I get this?
userRating <- matrix(data = rbind(c(1,NA,0), c(1,1,0), c(NA,NA,1)), nrow=3)
I can solve the problem using two for loops, but this of course doesn't scale well. Can anybody help with me with a vectorized solution?
This can be done without any loop. It works with the function matrix:
# sort the 'liked' values (this is not neccessary for the example data)
vec <- with(ratingDB, liked[order(user, movie)])
# create a matrix
matrix(vec, nrow = length(unique(ratingDB$user)), byrow = TRUE)
[,1] [,2] [,3]
[1,] 1 NA 0
[2,] 1 1 0
[3,] NA NA 1
This will transform the vector stored in ratingDB$liked to a matrix. The argument byrow = TRUE allows arranging the data in rows (the default is by columns).
Update: What to do if the NA cases are not in the data frame?
(see comment by #steffen)
First, remove the rows containing NA:
subDB <- ratingDB[complete.cases(ratingDB), ]
user movie liked
1 1 1 1
3 1 3 0
4 2 1 1
5 2 2 1
6 2 3 0
9 3 3 1
The full data frame can be reconstructed. The function expand.grid is used to generate all combinations of user and movie:
full <- setNames(with(subDB, expand.grid(sort(unique(user)), sort(unique(movie)))),
c("user", "movie"))
movie user
1 1 1
2 2 1
3 3 1
4 1 2
5 2 2
6 3 2
7 1 3
8 2 3
9 3 3
Now, the information of the sub data frame subDB and the full combination data frame full can be combined with the merge function:
ratingDB_2 <- merge(full, subDB, all = TRUE)
user movie liked
1 1 1 1
2 1 2 NA
3 1 3 0
4 2 1 1
5 2 2 1
6 2 3 0
7 3 1 NA
8 3 2 NA
9 3 3 1
The result is identical with the original matrix. Hence, the same procedure can be applied to transform it to a matrix of liked values:
matrix(ratingDB_2$liked, nrow = length(unique(ratingDB_2$user)), byrow = TRUE)
[,1] [,2] [,3]
[1,] 1 NA 0
[2,] 1 1 0
[3,] NA NA 1