Combinations of values in each cell in a symmetric matrix - r

I have a vector of weights that I want to insert in a symmetric matrix. I want all combinations of weights (all weights in all positions but not in the diagonal)
I tried iterating through the matrix, but then I only get the same matrix triplicate. (Also I couldn't find it answered or a public solution to this problem.)
weight <- seq(0.1, 1, by = 0.1)
C <- matrix(0, nrow = 3, ncol = 3)
for (i in seq_len(nrow(C))) {
C_old <- C
for (j in seq_len(i)) {
if (i == j) {
C[i, i] <- 0
} else {
C_old2 <- C_old
for (w in weight) {
C[i, j] <- w
C[j, i] <- C[i, j]
C_old[i, j] <- w
C_old[j, i] <- C_old[i, j]
C_old2[i, j] <- w
C_old2[j, i] <- C_old2[i, j]
iter <- iter + 3
print(C)
print(C_old)
print(C_old2)
}
}
}
I want to have all the matrices such that
Matrix 0:
0 0 0
0 0 0
0 0 0
Matrix 1:
0 0 0
0 0 0.1
0 0.1 0
Matrix 2:
0 0 0.1
0 0 0.1
0.1 0.1 0
Matrix 3:
0 0.1 0.1
0.1 0 0.1
0.1 0.1 0
Matrix 4:
0 0.1 0.1
0.1 0 0.2
0.1 0.2 0
Matrix n:
0 0.9 0.1
0.5 0 0.5
0.1 0.9 0
Matrix:
0 x y
z 0 z
y x 0
I want all combinations of the last matrix were x, y and z can be any value in weight.
The first matrix (all 0) is not really important, so if a solution omits it I don't really care

No idea what you want this for, but here you go:
weight <- seq(0.1, 1, by = 0.1)
C <- matrix(0, nrow = 3, ncol = 3)
C_list <- vector("list", 10)
for(i in 1:length(weight)){
for(j in 1:3){
if(j == 1){
C[2,3] <- weight[i]
C[3,2] <- weight[i]
}
if(j == 2){
C[1,3] <- weight[i]
C[3,1] <- weight[i]
}
if(j == 3){
C[1,2] <- weight[i]
C[2,1] <- weight[i]
}
C_list[[i]][[j]] <- C
}
}
Result:
> C_list
[[1]]
[[1]][[1]]
[,1] [,2] [,3]
[1,] 0 0.0 0.0
[2,] 0 0.0 0.1
[3,] 0 0.1 0.0
[[1]][[2]]
[,1] [,2] [,3]
[1,] 0.0 0.0 0.1
[2,] 0.0 0.0 0.1
[3,] 0.1 0.1 0.0
[[1]][[3]]
[,1] [,2] [,3]
[1,] 0.0 0.1 0.1
[2,] 0.1 0.0 0.1
[3,] 0.1 0.1 0.0
[[2]]
[[2]][[1]]
[,1] [,2] [,3]
[1,] 0.0 0.1 0.1
[2,] 0.1 0.0 0.2
[3,] 0.1 0.2 0.0
[[2]][[2]]
[,1] [,2] [,3]
[1,] 0.0 0.1 0.2
[2,] 0.1 0.0 0.2
[3,] 0.2 0.2 0.0
...

Thanks to LAP I changed the approach and I managed how to do this:
weight <- seq(0.1, 1, by = 0.1)
C <- matrix(0, nrow = 3, ncol = 3)
C_list <- vector("list", 10)
names(C_list) <- as.character(weight)
for(i1 in weight){
C_list[[as.character(i1)]] <- vector("list", 10)
names(C_list[[as.character(i1)]]) <- as.character(weight)
for (i2 in weight){
C_list[[as.character(i1)]][[as.character(i2)]] <- vector("list", 10)
names(C_list[[as.character(i1)]][[as.character(i2)]]) <- as.character(weight)
for (i3 in weight) {
C[2, 3] <- i1
C[3, 2] <- i1
C[1, 3] <- i2
C[3, 1] <- i2
C[1, 2] <- i3
C[2, 1] <- i3
C_list[[as.character(i1)]][[as.character(i2)]][[as.character(i3)]] <- C
}
}
}
Now the C_list is a list of lists of lists that each one has a matrix. length(unlist(unlist(C_list, recursive = FALSE), recursive = FALSE)) == 1000 that are the 10^3 combinations that exists.

Related

How to solve this R error: In thdim[i] <- `*vtmp*` : number of items to replace is not a multiple of replacement length

I encountered the warning in the title when I ran the following code and the results also look weird:
thdim <- matrix(0,nrow=5,ncol=4)
d <- c(1, 2, 2, 1)
theta <- matrix(c(1,0.5,0.75,0.83,0.91,0.1,0.4,1.2,0.6,0.2),ncol=2)
thetanew <- matrix(0,nrow=5,ncol=2)
thetanew<- cbind(theta, thetanew)
for (i in 1:5) {
for (j in 1:4) {
thdim[i][j] <- thetanew[i][d[j]]
}
}
Can anyone help me with this error? Thanks!
We can use d as an index to subset columns from theta.
thdim <- matrix(0,nrow=5,ncol=4)
d <- c(1, 2, 2, 1)
theta <- matrix(c(1,0.5,0.75,0.83,0.91,0.1,0.4,1.2,0.6,0.2),ncol=2)
theta[, d]
# [,1] [,2] [,3] [,4]
#[1,] 1.00 0.1 0.1 1.00
#[2,] 0.50 0.4 0.4 0.50
#[3,] 0.75 1.2 1.2 0.75
#[4,] 0.83 0.6 0.6 0.83
#[5,] 0.91 0.2 0.2 0.91
To correct the for loop, we can do :
for (i in 1:5) {
#You can use nrow(thdim) instead of hard coding 5
for (j in 1:4) {
# You can use `length(d)` instead of hardcoding 4
thdim[i, j] <- theta[i, d[j]]
}
}

How to divide a matrix by the sum of rows and it has zeros

I am pretty new to R and I have a loop which gives sometimes a matrix like this:
1 2
FALSE 0 0
TRUE 0 2
I need to do as follows:
If the two cells in a single row have zeros replace them by 0.5
If one of the cells is not zero divide by the sum of the row
so the result of this will be:
1 2
FALSE 0.5 0.5
TRUE 0 1
Any idea please?
Thank you
If your matrix is x,
(x <- matrix(c(0, 0, 0, 2), 2))
# [,1] [,2]
# [1,] 0 0
# [2,] 0 2
zero_rows <- as.logical(rowSums(x != 0))
x[zero_rows,] <- x[zero_rows,]/sum(x[zero_rows,])
x[rowSums(x) == 0, ] <- rep(0.5, ncol(x))
x
# [,1] [,2]
# [1,] 0.5 0.5
# [2,] 0.0 1.0
This will work for a matrix (2 dimensional array) of arbitrary size
#akrun's suggested edit, constructing zero_rows with rowSums(x != 0) instead of apply(x, 1, function(r) 0 %in% r) should make this even more efficient.
Let x <- matrix(c(0, 0, 0, 2), 2))
t(apply(x,1,function(y)if(all(!y))replace(y,!y,0.5)else if(any(!y))y/sum(y) else y))
[,1] [,2]
[1,] 0.5 0.5
[2,] 0.0 1.0
x = matrix(c(0, 0, 0, 2), 2)
t(apply(x, 1L, function(y) ifelse(all(y == 0), return(rep(0.5, length(y))), return(y/sum(y)))))
# [,1] [,2]
#[1,] 0.5 0.5
#[2,] 0.0 1.0

Apply a condition on each element in several matrices

My question contains two parts.
Suppose I have two matrices such that:
> mat1
[,1] [,2] [,3] [,4] [,5]
[1,] 0.0 0.0 0.0 0.0 0
[2,] 0.5 0.0 0.0 0.0 0
[3,] 0.4 0.5 0.0 0.0 0
[4,] 0.5 0.5 0.4 0.0 0
[5,] 0.5 0.5 0.4 0.7 0
> mat2
[,1] [,2] [,3] [,4] [,5]
[1,] 0.0 0.0 0.0 0.0 0
[2,] 0.5 0.0 0.0 0.0 0
[3,] 0.9 0.5 0.0 0.0 0
[4,] 0.5 0.5 0.4 0.0 0
[5,] 0.5 0.5 0.4 0.3 0
> mat <- list(mat1, mat2)
First part
I would like to check if each corresponding values in both matrices are sum to 1 or not. if yes, then print the sum if not then return an error. Here is my try:
mat <- list(mat1, mat2)
myf <- function(mat){
for(i in 1:5){
for(j in 1:5){
if(all(Reduce('+', mat)) == 1 ){
return(Reduce('+', mat))
}else{
stop("some of output are > 1")
}
}
}
}
The output:
Error in myf(family) : cann
In addition: Warning message:
In all(Reduce("+", mat)) : coercing argument of type 'double' to logical
Second part
I would like to check if any of the element of the matrices is < 0.
I tried this:
if(Reduce('|', lapply(family, '<', 0))){
stop("stop all sum must be positive")
}
The output is:
Warning message:
In if (Reduce("|", lapply(family, "<", 0))) { :
the condition has length > 1 and only the first element will be used
Any help please?
Thanks to #akrun and #tobiasegli_te
myf <- function(mat){
if(!all(Reduce('+', mat) <= 1 )){
stop("some of output are > 1")
}
}
if(all(Reduce('|', lapply(mat, '<', 0)))){
stop("stop all sum must be positive")
}

How to convert values in a matrix based on a list of rules without using for-loop in R

I have a matrix with either 1s or 0s.
xmat = matrix(round(runif(12),0), ncol=3)
[,1] [,2] [,3]
[1,] 0 1 1
[2,] 1 0 1
[3,] 1 0 0
[4,] 1 0 1
I also have a rule table, which is a list.
a = c(0.2, 0.5)
b = c(0.5, 0.6)
c = c(0.8, 0.1)
names(a) = c("0", "1")
names(b) = c("0", "1")
names(c) = c("0", "1")
ruletable = list(a, b, c)
[[1]]
0 1
0.2 0.5
[[2]]
0 1
0.5 0.6
[[3]]
0 1
0.8 0.1
I need to replace the 1s and 0s in each column of xmat with the corresponding values specified by the rule table. For example, the first column of xmat is (0, 1, 1, 1), which needs to be converted into (0.2, 0.5, 0.5, 0.5) using ruletable[[1]]. Similarly, the second column of xmat (1, 0, 0, 0) needs to be converted into (0.6, 0.5, 0.5, 0.5) using ruletable[[2]]. Since this is potentially a huge matrix, I am looking for a solution without using for loop.
Thanks!
This should be reasonably efficient:
vapply(
1:length(ruletable),
function(x) ruletable[[x]][xmat[, x] + 1L],
numeric(nrow(xmat))
)
original matrix (set.seed(1)):
# [,1] [,2] [,3]
# [1,] 0 0 0
# [2,] 0 1 0
# [3,] 0 1 0
# [4,] 1 1 1
and result:
# [,1] [,2] [,3]
# [1,] 0.2 0.5 0.8
# [2,] 0.2 0.6 0.8
# [3,] 0.2 0.6 0.8
# [4,] 0.5 0.6 0.1
mapply answer:
xmat <- matrix(c(0,1,1,1,1,0,0,0,1,1,0,1),nrow=4)
mapply(function(x,y) y[as.character(x)], data.frame(xmat),ruletable)
X1 X2 X3
0 0.2 0.6 0.1
1 0.5 0.5 0.1
1 0.5 0.5 0.8
1 0.5 0.5 0.1
If you don't want the names, they are easy to remove:
unname(mapply(function(x,y) y[as.character(x)], data.frame(xmat),ruletable))

R: calculating the time spent by N individuals within each of M time intervals

There are four time intervals
[0, 3), [3, 10), [10, 12), and [12, Inf)
and three subjects for whom we have survival times
10.3, 0.7, 12.2
I would like to construct a matrix with three rows (one for each individual) and four column (one for each time interval) that contains the time spent by each individual within each time interval.
For this particular example, we have
3.0 7 0.3 0.0
0.7 0 0.0 0.0
3.0 7 2.0 0.2
Can you help me to obtain this in R? The idea is to apply this for N much larger than 3.
My attempt:
breaks <- c(0, 3, 10, 12, Inf) # interval break points
M <- length(breaks) - 1 # number of intervals
time <- c(10.3, 0.7, 12.2) # observed survival times
N <- length(time) # number of subjects
timeSpent <- matrix(NA, nrow=N, ncol=M)
for(m in 1:M)
{
ind <- which(breaks[m + 1] - time > 0)
timeSpent[ind, m] <- time[ind] - breaks[m]
timeSpent[-ind, m] <- breaks[m + 1] - breaks[m]
}
timeSpent <- replace(x=timeSpent, list=timeSpent < 0, values=0)
breaks <- c(0, 3, 10, 12, Inf)
time <- c(10.3, 0.7, 12.2)
timeSpent <- sapply(time, function(x) {
int <- max(which(x>breaks))
res <- diff(breaks)
res[int:length(res)] <- 0
res[int] <- x-breaks[int]
res
})
t(timeSpent)
# [,1] [,2] [,3] [,4]
#[1,] 3.0 7 0.3 0.0
#[2,] 0.7 0 0.0 0.0
#[3,] 3.0 7 2.0 0.2
This doesn't loop and should be faster. However, a potential problem could be memory demand.
tmp <- t(outer(time, breaks, ">"))
res <- tmp * breaks
res[is.na(res)] <- 0
res <- diff(res)
res[diff(tmp)==-1] <- time+res[diff(tmp)==-1]
t(res)
# [,1] [,2] [,3] [,4]
#[1,] 3.0 7 0.3 0.0
#[2,] 0.7 0 0.0 0.0
#[3,] 3.0 7 2.0 0.2

Resources