I am trying to cut a number in layers by mean the next code:
X <- matrix(c(6,7,9,9,9,17,19,4,12,2,3,6,7,7),ncol=2)
layers <- c(5,10,15,20,25,30,35,40)
partitions <- function(u) {cbind(pmin(layers[1],u),t(diff(pmin(layers,u))))}
X <- cbind(X,lapply(X[,2], partitions))
The function returns an integer partitioned in the layers.
A = a1 + a2 + .... + a8
Example
A <- 19
partitions(A)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,] 5 5 5 4 0 0 0 0
But the results does not have the matrix I need. The final matrix would be of 7 x (2 (cols from X) + 8 (num of layers in points))
[,1] [,2] [,3]
[1,] 6 Numeric,8 NULL
[2,] 7 Numeric,8 NULL
[3,] 9 Numeric,8 NULL
[4,] 9 Numeric,8 NULL
[5,] 9 Numeric,8 NULL
[6,] 17 Numeric,8 NULL
[7,] 19 Numeric,8 NULL
> dim(X)
[1] 7 3
I tried different forms and ever had errors of dimensions.
Regards
One of these two should be what you want
> rbind(t(X),sapply(X[,2], partitions))
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 6 7 9 9 9 17 19
[2,] 4 12 2 3 6 7 7
[3,] 4 5 2 3 5 5 5
[4,] 0 5 0 0 1 2 2
[5,] 0 2 0 0 0 0 0
[6,] 0 0 0 0 0 0 0
[7,] 0 0 0 0 0 0 0
[8,] 0 0 0 0 0 0 0
[9,] 0 0 0 0 0 0 0
[10,] 0 0 0 0 0 0 0
> cbind(X,t(sapply(X[,2], partitions)))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 6 4 4 0 0 0 0 0 0 0
[2,] 7 12 5 5 2 0 0 0 0 0
[3,] 9 2 2 0 0 0 0 0 0 0
[4,] 9 3 3 0 0 0 0 0 0 0
[5,] 9 6 5 1 0 0 0 0 0 0
[6,] 17 7 5 2 0 0 0 0 0 0
[7,] 19 7 5 2 0 0 0 0 0 0
Related
Is there a way to use apply family functions instead of the for loop in the code below?
m <- matrix(0, 10, 5)
m
for (i in 2:5) m[,i] <- m[,(i-1)] + 1
m
Does this answer:
> t(apply(m, 1, function(x) x = 0:4))
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 0 1 2 3 4
[3,] 0 1 2 3 4
[4,] 0 1 2 3 4
[5,] 0 1 2 3 4
[6,] 0 1 2 3 4
[7,] 0 1 2 3 4
[8,] 0 1 2 3 4
[9,] 0 1 2 3 4
[10,] 0 1 2 3 4
>
Data used:
> m
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 0 0 0 0 0
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[6,] 0 0 0 0 0
[7,] 0 0 0 0 0
[8,] 0 0 0 0 0
[9,] 0 0 0 0 0
[10,] 0 0 0 0 0
> for(i in 2:5) m[,i] <- m[,(i-1)] + 1
> m
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 0 1 2 3 4
[3,] 0 1 2 3 4
[4,] 0 1 2 3 4
[5,] 0 1 2 3 4
[6,] 0 1 2 3 4
[7,] 0 1 2 3 4
[8,] 0 1 2 3 4
[9,] 0 1 2 3 4
[10,] 0 1 2 3 4
>
Suppose I have a list of matrices. Suppose further that I would like to find the smallest value across each value of the matrices. For example,
y <- c(3,2,4,5,6, 4,5,5,6,7)
x[lower.tri(x,diag=F)] <- y
> x
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 3 0 0 0 0
[3,] 2 6 0 0 0
[4,] 4 4 5 0 0
[5,] 5 5 6 7 0
k <- c(1,4,5,2,5,-4,4,4,4,5)
z[lower.tri(z,diag=F)] <- k
> z
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 1 0 0 0 0
[3,] 4 5 0 0 0
[4,] 5 -4 4 0 0
[5,] 2 4 4 5 0
d <- list(k, x)
The expected output:
dd <– matrix(0,5,5)
dd
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 1 0 0 0 0
[3,] 2 5 0 0 0
[4,] 4 -4 4 0 0
[5,] 2 4 4 5 0
We could use pmin to get the corresponding min value for each element across the list
do.call(pmin, d)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 0 0 0 0
#[2,] 1 0 0 0 0
#[3,] 2 5 0 0 0
#[4,] 4 -4 4 0 0
#[5,] 2 4 4 5 0
data
d <- list(z, x)
When fitting a unbalanced longitudinal data with mixed model: y = X α + Z a + ξ, we usually organize the design matrix Z like ablock matrix. Take n = 3, q = 2 for example,
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 10 0 0 0 0
[2,] 2 11 0 0 0 0
[3,] 0 0 3 12 0 0
[4,] 0 0 4 13 0 0
[5,] 0 0 5 14 0 0
[6,] 0 0 0 0 6 15
[7,] 0 0 0 0 7 16
[8,] 0 0 0 0 8 17
[9,] 0 0 0 0 9 18
However, if have
[,1] [,2]
[1,] 1 10
[2,] 2 11
[3,] 3 12
[4,] 4 13
[5,] 5 14
[6,] 6 15
[7,] 7 16
[8,] 8 17
[9,] 9 18
at hand, how could we transfer a long format matrix to block matrix efficiently in r besides for loops? I recently tried this way,
> library("magic")
> (Zmat <- matrix(1:18, nrow=9))
[,1] [,2]
[1,] 1 10
[2,] 2 11
[3,] 3 12
[4,] 4 13
[5,] 5 14
[6,] 6 15
[7,] 7 16
[8,] 8 17
[9,] 9 18
> row_cuts <- c(2,3,4)
> cut_num <- length(row_cuts)
> cut_up <- cumsum(row_cuts)
> cut_lo <- cut_up - row_cuts +1
> (Reduce("adiag", mapply(function(i) Zmat[(cut_lo[i]):(cut_up[i]), ], 1:cut_num, SIMPLIFY=FALSE)))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 10 0 0 0 0
[2,] 2 11 0 0 0 0
[3,] 0 0 3 12 0 0
[4,] 0 0 4 13 0 0
[5,] 0 0 5 14 0 0
[6,] 0 0 0 0 6 15
[7,] 0 0 0 0 7 16
[8,] 0 0 0 0 8 17
[9,] 0 0 0 0 9 18
Supppose I have the following block diagonal matrix:
a <- matrix(1:6, 2, 3)
b <- matrix(7:10, 2, 2)
library(magic)
Block <- adiag(a,b)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 1 3 5 0 0
#[2,] 2 4 6 0 0
#[3,] 0 0 0 7 9
#[4,] 0 0 0 8 10
And I need to multiply each block by one part of the following vector. This means the first block "a" times 2 and the block "b" times 1.
v1=c(2,1)
So that at the end I have:
# [,1] [,2] [,3] [,4] [,5]
#[1,] 2 6 10 0 0
#[2,] 4 8 12 0 0
#[3,] 0 0 0 7 9
#[4,] 0 0 0 8 10
How could I do that in the most efficient way?
Until there is a better solution or an improvement of this one.
a <- matrix(1:9, 3, 3)
b <- matrix(7:10, 2, 2)
c <- matrix(9:24, 4, 4)
library(magic)
Block <- adiag(a,b,c)
Block
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
# [1,] 1 4 7 0 0 0 0 0 0
# [2,] 2 5 8 0 0 0 0 0 0
# [3,] 3 6 9 0 0 0 0 0 0
# [4,] 0 0 0 7 9 0 0 0 0
# [5,] 0 0 0 8 10 0 0 0 0
# [6,] 0 0 0 0 0 9 13 17 21
# [7,] 0 0 0 0 0 10 14 18 22
# [8,] 0 0 0 0 0 11 15 19 23
# [9,] 0 0 0 0 0 12 16 20 24
v1 <- c(2,1,4)
apply(Block, 2, "*", rep(v1, c(NROW(a),NROW(b),NROW(c))))
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
# [1,] 2 8 14 0 0 0 0 0 0
# [2,] 4 10 16 0 0 0 0 0 0
# [3,] 6 12 18 0 0 0 0 0 0
# [4,] 0 0 0 7 9 0 0 0 0
# [5,] 0 0 0 8 10 0 0 0 0
# [6,] 0 0 0 0 0 36 52 68 84
# [7,] 0 0 0 0 0 40 56 72 88
# [8,] 0 0 0 0 0 44 60 76 92
# [9,] 0 0 0 0 0 48 64 80 96
Or as suggested by Ven Yao in the comments:
adiag(a*v1[1], b*v1[2], c*v1[3])
Another option is bdiag from library(Matrix) (using #Pascal's example). We place the individual vectors i.e. 'a', 'b', 'c' in a list (using mget), multiply with corresponding elements of 'v1' using Map and wrap with bdiag.
library(Matrix)
as.matrix(bdiag(Map(`*`,mget(letters[1:3]), v1)))
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
# [1,] 2 8 14 0 0 0 0 0 0
# [2,] 4 10 16 0 0 0 0 0 0
# [3,] 6 12 18 0 0 0 0 0 0
# [4,] 0 0 0 7 9 0 0 0 0
# [5,] 0 0 0 8 10 0 0 0 0
# [6,] 0 0 0 0 0 36 52 68 84
# [7,] 0 0 0 0 0 40 56 72 88
# [8,] 0 0 0 0 0 44 60 76 92
# [9,] 0 0 0 0 0 48 64 80 96
So I have seen many posts about altering all values in a matrix less than a certain number equal to zero with some simple indexing of the matrix. But I think what I have is a little more advanced and I am having some trouble so hopefully you guys can help out. Here is the code I am working with:
x <- (1:5)
y <- c(0,10,0,0,8)
n <- 12
mat <- t(sapply(y, function(test) pmax(seq(test, (test-n+1), -1), 0) ))
mat
This produces:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,] 0 0 0 0 0 0 0 0 0 0 0 0
[2,] 10 9 8 7 6 5 4 3 2 1 0 0
[3,] 0 0 0 0 0 0 0 0 0 0 0 0
[4,] 0 0 0 0 0 0 0 0 0 0 0 0
[5,] 8 7 6 5 4 3 2 1 0 0 0 0
xmat <- replicate(ncol(mat),x)
Then I wanted to find which y does not equal to zero and then replace the values in xmat to zero until mat equals zero and then change the value to the x value. So below is what I currently have.
CountTest <- which(y != 0)
xmat[CountTest,] <- apply(xmat[CountTest,], 1, function(xu) ifelse(xu > 0, 0, xu))
xmat
This produces:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,] 1 1 1 1 1 1 1 1 1 1 1 1
[2,] 0 0 0 0 0 0 0 0 0 0 0 0
[3,] 3 3 3 3 3 3 3 3 3 3 3 3
[4,] 4 4 4 4 4 4 4 4 4 4 4 4
[5,] 0 0 0 0 0 0 0 0 0 0 0 0
The desired output is:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,] 1 1 1 1 1 1 1 1 1 1 1 1
[2,] 0 0 0 0 0 0 0 0 0 0 2 2
[3,] 3 3 3 3 3 3 3 3 3 3 3 3
[4,] 4 4 4 4 4 4 4 4 4 4 4 4
[5,] 0 0 0 0 0 0 0 0 5 5 5 5
You could try
> xmat*(mat==0)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
#[1,] 1 1 1 1 1 1 1 1 1 1 1 1
#[2,] 0 0 0 0 0 0 0 0 0 0 2 2
#[3,] 3 3 3 3 3 3 3 3 3 3 3 3
#[4,] 4 4 4 4 4 4 4 4 4 4 4 4
#[5,] 0 0 0 0 0 0 0 0 5 5 5 5