Convert a column vector into a extended diagonal matrix - r

Consider the following column vector:
vec <- rbind(c(0.5),c(0.6))
I want to convert it into the following 4x4 diagonal matrix:
0.5 0 0 0
0 0.6 0 0
0 0 0.5 0
0 0 0 0.6
I know I can do it by the following code:
dia <- diag(c(vec,vec))
But what if I want to convert it into a 1000x1000 diagonal matrix. Then the code above is so efficient. Maybe I can use rep, but I am not totally sure how to do it. How can I do it more efficient?


Here is one other way using recycling:
diag(c(vec), length(vec)*2)


I think your approach is already good enough, here is another way by initialising the matrix and using rep to fill diagonals.
n <- 4
mat <- matrix(0, ncol = n, nrow = n)
diag(mat) <- rep(vec, n/2)
mat
# [,1] [,2] [,3] [,4]
#[1,] 0.5 0.0 0.0 0.0
#[2,] 0.0 0.6 0.0 0.0
#[3,] 0.0 0.0 0.5 0.0
#[4,] 0.0 0.0 0.0 0.6
and following your approach you could do
diag(rep(vec, n/2))

Related

use function code to produce a n×n matrix

In order to produce the matrix in the picture, I tried to write a function code to do this, but I cannot figure it out what to do next, and also not sure if what I already did is right or not.
Matrix <- function(n){
mat1 <- diag(x = ((1:n)-1)/((1:n)+1), n, n)[-1,]
mat2 <- diag(x = ((1:n)-(1:n)+1)/((1:n)+1), n, n)[,-1]
mat3 <- diag(x = 1/((1:n)+1), n, n)
}

An option:
library(SoDA)
n <- 4
triDiag(diagonal = rep(1/(n+1), n+1),
upper = (n:1)/(n+1),
lower = (1:n)/(n+1))
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0.2 0.8 0.0 0.0 0.0
# [2,] 0.2 0.2 0.6 0.0 0.0
# [3,] 0.0 0.4 0.2 0.4 0.0
# [4,] 0.0 0.0 0.6 0.2 0.2
# [5,] 0.0 0.0 0.0 0.8 0.2

It is not entirely clear what you are trying to achieve.
From your description the matrix will have n+1 elements (from 1/(n+1) to n/(n+1)), and I assume the remaining matrix is Sparse. It is not a simple structure to achieve via vectorized computations, but it can be achieved in a single for loop, thus being constructed in O(n) time, given a matrix of size n+1.
In the code below i present an example of such code. The idea is to traverse the matrix in opposite, and only assign 1 type value to each.
Create_Matrix <- function(n){
n1 = n + 1 #Last row, avoid n computations
n2 = n1 + 1
output <- diag(1/n1, nrow = n1, ncol = n1)
for(i in seq(n)){
output[i + 1, i] = output[n1 - i, n2 - i] = output[[1]] * i
}
output
}

Sequence Combination Matrix in R

I'm looking to create a matrix for 5 variables, such that each variable takes a value from seq(from = 0, to = 1, length.out = 500) and rowSums(data) = 1 .
In other words, I am wondering how to create a matrix that shows all the possible combinations of numbers with the sum of every row = 1.

Here is an iterative solution, using loops. Gives you all possible permutations of numbers adding up to 1, with the distance between them being a multiple of N. The idea here is to take all numbers from 0 to 1 (with distance of a multiple of N between them), then for each one include in a new column all the numbers that when added don't go above 1. Rinse and repeat, except in the last iteration, in which you only add the numbers that complete the row the sum of the row.
Like people pointed out in the comments, if you want N = 1/499*, it will give you a really really big matrix. I noticed that for N = 1/200 it was already taking around 2, 3 minutes, so it would probably take way too long for N = 1/499.
*seq(from = 0, to = 1, length.out = 500) is the same as seq(from = 0, to = 1, by = 1/499)
N = 1/2
M = 5
x1 = seq(0, 1, by = N)
df = data.frame(x1)
for(i in 1:(M-2)){
x_next = sapply(rowSums(df), function(x){seq(0, 1-x, by = N)})
df = data.frame(sapply(df, rep, sapply(x_next,length)))
df = cbind(df, unlist(x_next))
}
x_next = sapply(rowSums(df), function(x){1-x})
df = sapply(df, rep, sapply(x_next,length))
df = data.frame(df)
df = cbind(df, unlist(x_next))
> df
x1 unlist.x_next. unlist.x_next..1 unlist.x_next..2 unlist(x_next)
1 0.0 0.0 0.0 0.0 1.0
2 0.0 0.0 0.0 0.5 0.5
3 0.0 0.0 0.0 1.0 0.0
4 0.0 0.0 0.5 0.0 0.5
5 0.0 0.0 0.5 0.5 0.0
6 0.0 0.0 1.0 0.0 0.0
7 0.0 0.5 0.0 0.0 0.5
8 0.0 0.5 0.0 0.5 0.0
9 0.0 0.5 0.5 0.0 0.0
10 0.0 1.0 0.0 0.0 0.0
11 0.5 0.0 0.0 0.0 0.5
12 0.5 0.0 0.0 0.5 0.0
13 0.5 0.0 0.5 0.0 0.0
14 0.5 0.5 0.0 0.0 0.0
15 1.0 0.0 0.0 0.0 0.0

If I understood correctly, this could take you to the right track at least.
# Parameters
len_vec = 500 # vector length
num_col = 5 # number of columns
# Creating the values for the matrix using rational numbers between 0 and 1
values <- runif(len_vec*num_col)
# Creating matrix
mat <- matrix(values,ncol = num_col,byrow = T)
# ROunding the matrix to create only 0s and 1s
mat <- round(mat)
# Calculating the sum per row
apply(mat,1,sum)

This is exactly what the package partitions is made for. Basically the OP is looking for all possible combinations of 5 integers that sum to 499. This can easily be achieved with restrictedparts:
system.time(combsOne <- t(as.matrix(restrictedparts(499, 5))) / 499)
user system elapsed
1.635 0.867 2.502
head(combsOne)
[,1] [,2] [,3] [,4] [,5]
[1,] 1.000000 0.000000000 0 0 0
[2,] 0.997996 0.002004008 0 0 0
[3,] 0.995992 0.004008016 0 0 0
[4,] 0.993988 0.006012024 0 0 0
[5,] 0.991984 0.008016032 0 0 0
[6,] 0.989980 0.010020040 0 0 0
tail(combsOne)
[,1] [,2] [,3] [,4] [,5]
[22849595,] 0.2024048 0.2004008 0.2004008 0.2004008 0.1963928
[22849596,] 0.2064128 0.1983968 0.1983968 0.1983968 0.1983968
[22849597,] 0.2044088 0.2004008 0.1983968 0.1983968 0.1983968
[22849598,] 0.2024048 0.2024048 0.1983968 0.1983968 0.1983968
[22849599,] 0.2024048 0.2004008 0.2004008 0.1983968 0.1983968
[22849600,] 0.2004008 0.2004008 0.2004008 0.2004008 0.1983968
And since we are dealing with numeric values we can't get exact precision, however we can get machine precision:
all(rowSums(combsOne) == 1)
[1] FALSE
all((rowSums(combsOne) - 1) < .Machine$double.eps)
[1] TRUE
There are over 22 million results:
row(combsOne)
[1] 22849600

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")
}

subset matrices: map a binary matrix onto a qualitative matrix for 1s but not 0s while keeping matrix dimension intact

Lets say I have two list-of-lists, one being solely binary and the other one being quantitative. The order in the lists matters. I would like to map the binary matrices onto its qualitatively counterpart while creating a new list-of-lists with the same number of nested matrices with the same dimensions. These matrices will be subsets of their qualitative counterparts; where there are 1s in the binary matrices.
# dummy data
dat1 <- c(0,1,0,1,1,0,0,0,1,0,0,0,1,1,0,1)
mat1 <- matrix(dat1, ncol=4, nrow=4, byrow=T)
dat2 <- c(1,1,0,1,0,0,1,1,0,1,0,1,0,1,0,0)
mat2 <- matrix(dat1, ncol=4, nrow=4, byrow=T)
lsMat1 <- list(mat1, mat2)
dat3 <- c(0.3,0.1,0.6,0.3,0.9,0.1,0.1,0.3,0.6,0.2,0.7,0.8,0.4,0.1,0.4,0.5)
mat3 <- matrix(dat3, ncol=4, nrow=4, byrow=T)
dat4 <- c(0.5,0.3,0.6,0.8,0.1,0.4,0.5,0.1,0.5,0.1,0.0,0.1,0.4,0.6,0.0,0.8)
mat4 <- matrix(dat4, ncol=4, nrow=4, byrow=T)
lsMat2 <- list(mat3, mat4)
Desired new nested list
[[1]]
[,1] [,2] [,3] [,4]
[1,] 0.0 0.1 0 0.3
[2,] 0.9 0.0 0 0.0
[3,] 0.6 0.0 0 0.0
[4,] 0.4 0.1 0 0.5
[[2]]
[,1] [,2] [,3] [,4]
[1,] 0.0 0.3 0 0.8
[2,] 0.1 0.0 0 0.0
[3,] 0.5 0.0 0 0.0
[4,] 0.4 0.6 0 0.8
Any pointers would be highly appreciated, thanks!

I'm going to assume the output you supplied above is incorrect. Since you have 0's and 1's in your binary matrix and you only want to keep the 1's values, you can use simple elementwise multiplication. You can do that for each item in the list with
Map(`*`, lsMat1, lsMat2)
which returns
[[1]]
[,1] [,2] [,3] [,4]
[1,] 0.0 0.1 0 0.3
[2,] 0.9 0.0 0 0.0
[3,] 0.6 0.0 0 0.0
[4,] 0.4 0.1 0 0.5
[[2]]
[,1] [,2] [,3] [,4]
[1,] 0.0 0.3 0 0.8
[2,] 0.1 0.0 0 0.0
[3,] 0.5 0.0 0 0.0
[4,] 0.4 0.6 0 0.8
given that column three in both matrices in lsMat1 are all 0, this seems more correct.

If i understood the question i would do a element-wise matrix multiplication. Im not familiar with the syntax you posted but IN MATLAB:
mat1 .* mat3
Now all elements that are zero in your binary matrix will stay zero, and all that are one will become the value from your qualitative matrix.
Hope it helps!

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))

Resources