Related
Imagine that you have these variables:
> a <- list(matrix(1:25, 5, 5, byrow = TRUE), matrix(31:55, 5, 5, byrow = TRUE))
> b <- list(rep(1, 5), rep(2, 5))
> a
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 2 3 4 5
[2,] 6 7 8 9 10
[3,] 11 12 13 14 15
[4,] 16 17 18 19 20
[5,] 21 22 23 24 25
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 31 32 33 34 35
[2,] 36 37 38 39 40
[3,] 41 42 43 44 45
[4,] 46 47 48 49 50
[5,] 51 52 53 54 55
> b
[[1]]
[1] 1 1 1 1 1
[[2]]
[1] 2 2 2 2 2
I want to end up with something like this:
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 1 2 3 4 5
[3,] 6 7 8 9 10
[4,] 11 12 13 14 15
[5,] 16 17 18 19 20
[6,] 21 22 23 24 25
[,1] [,2] [,3] [,4] [,5]
[1,] 2 2 2 2 2
[2,] 31 32 33 34 35
[3,] 36 37 38 39 40
[4,] 41 42 43 44 45
[5,] 46 47 48 49 50
[6,] 51 52 53 54 55
So, it is like having a Python zip-like function and then apply rbind.
Any idea?
An option is Map from base R
Map(rbind, b, a)
Or you can try:
lapply(1:length(a),function(i)rbind(b[[i]],a[[i]]))
Assuming length(a) == length(b)
One option is to use the purrr package.
library(purrr)
map2(b, a, rbind)
I have a number of subarrays, say 2 (for simplicity), each with the same number of rows and columns. Each spot in the subarrays is occupied by a number in [1, 10].
What I would like to do is move rows randomly between subarrays according to some rate of movement m = [0, 1]. m = 0 corresponds to no movement, while m = 1 means that any rows across all subarrays can be moved.
I take inspiration from:
How to swap a number of the values between 2 rows in R
but my problem is a bit different than this. I do know that sample() would be needed here.
Is there an easy way to go about accomplishing this?
This doesn't do it, but I believe I'm on the right track anyway.
m <- 0.2
a <- array(dim = c(5, 5, 2)) # 5 rows, 5 columns, 2 subarrays
res <- rep(sample(nrow(a), size = ceiling(nrow(a)*m), replace = FALSE)) # sample 20% of rows from array a.
Any assistance is appreciated.
It is significantly easier if you can use a matrix (2-dim array).
set.seed(2)
m <- 0.2
d <- c(10, 4)
a <- array(sample(prod(d)), dim = d)
a
# [,1] [,2] [,3] [,4]
# [1,] 8 17 14 1
# [2,] 28 37 40 26
# [3,] 22 38 16 29
# [4,] 7 35 3 32
# [5,] 34 11 23 4
# [6,] 36 33 19 31
# [7,] 5 24 30 13
# [8,] 39 6 27 25
# [9,] 15 10 12 9
# [10,] 18 2 21 20
(I'm going to set the seed again to something that conveniently gives me something "interesting" to show.)
set.seed(2)
ind <- which(runif(d[1]) < m)
ind
# [1] 1 4 7
The first randomness, runif, is compared against m and generates the indices that may change. The second randomness, sample below, takes those indices and possibly reorders them. (In this case, it reorders "1,4,7" to "4,1,7", meaning the third of the rows-that-may-change will be left unchanged.)
a[ind,] <- a[sample(ind),]
a
# [,1] [,2] [,3] [,4]
# [1,] 7 35 3 32 # <-- row 4
# [2,] 28 37 40 26
# [3,] 22 38 16 29
# [4,] 8 17 14 1 # <-- row 1
# [5,] 34 11 23 4
# [6,] 36 33 19 31
# [7,] 5 24 30 13 # <-- row 7, unchanged
# [8,] 39 6 27 25
# [9,] 15 10 12 9
# [10,] 18 2 21 20
Note that this is probabilistic, which means a probability of 0.2 does not guarantee you 20% (or even any) of the rows will be swapped.
(Since I'm guessing you'd really like to preserve your 3-dim (or even n-dim) array, you might be able to use aperm to transfer between array <--> matrix.)
EDIT 1
As an alternative to a probabilitic use of runif, you can use:
ind <- head(sample(d[1]),size=d[1]*m)
to get closer to your goal of "20%". Since d[1]*m will often not be an integer, head silently truncates/floors the number, so you'll get the price-is-right winner: closest to but not over your desired percentage.
EDIT 2
A reversible method for transforming an n-dimensional array into a matrix and back again. Caveat: though the logic appears solid, my testing has only included a couple arrays.
array2matrix <- function(a) {
d <- dim(a)
ind <- seq_along(d)
a2 <- aperm(a, c(ind[2], ind[-2]))
dim(a2) <- c(d[2], prod(d[-2]))
a2 <- t(a2)
attr(a2, "origdim") <- d
a2
}
The reversal uses the "origdim" attribute if still present; this will work as long as your modifications to the matrix do not clear its attributes. (Simple row-swapping does not.)
matrix2array <- function(m, d = attr(m, "origdim")) {
ind <- seq_along(d)
m2 <- t(m)
dim(m2) <- c(d[2], d[-2])
aperm(m2, c(ind[2], ind[-2]))
}
(These two functions should probably do some more error-checks, such as is.null(d).)
A sample run:
set.seed(2)
dims <- 5:2
a <- array(sample(prod(dims)), dim=dims)
Quick show:
a[,,1,1:2,drop=FALSE]
# , , 1, 1
# [,1] [,2] [,3] [,4]
# [1,] 23 109 61 90
# [2,] 84 15 27 102
# [3,] 68 95 83 24
# [4,] 20 53 117 46
# [5,] 110 62 43 8
# , , 1, 2
# [,1] [,2] [,3] [,4]
# [1,] 118 25 14 93
# [2,] 65 21 16 77
# [3,] 87 82 3 38
# [4,] 92 12 78 17
# [5,] 49 4 75 80
The transformation:
m <- array2matrix(a)
dim(m)
# [1] 30 4
head(m)
# [,1] [,2] [,3] [,4]
# [1,] 23 109 61 90
# [2,] 84 15 27 102
# [3,] 68 95 83 24
# [4,] 20 53 117 46
# [5,] 110 62 43 8
# [6,] 67 47 1 54
Proof of reversability:
identical(matrix2array(m), a)
# [1] TRUE
EDIT 3, "WRAP UP of all code"
Creating fake data:
dims <- c(5,4,2)
(a <- array(seq(prod(dims)), dim=dims))
# , , 1
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 2 7 12 17
# [3,] 3 8 13 18
# [4,] 4 9 14 19
# [5,] 5 10 15 20
# , , 2
# [,1] [,2] [,3] [,4]
# [1,] 21 26 31 36
# [2,] 22 27 32 37
# [3,] 23 28 33 38
# [4,] 24 29 34 39
# [5,] 25 30 35 40
(m <- array2matrix(a))
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 2 7 12 17
# [3,] 3 8 13 18
# [4,] 4 9 14 19
# [5,] 5 10 15 20
# [6,] 21 26 31 36
# [7,] 22 27 32 37
# [8,] 23 28 33 38
# [9,] 24 29 34 39
# [10,] 25 30 35 40
# attr(,"origdim")
# [1] 5 4 2
The random-swapping of rows. I'm using 50% here.
pct <- 0.5
nr <- nrow(m)
set.seed(3)
(ind1 <- sample(nr, size = ceiling(nr * pct)))
# [1] 2 8 4 3 9
(ind2 <- sample(ind1))
# [1] 3 2 9 8 4
m[ind1,] <- m[ind2,]
m
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 3 8 13 18
# [3,] 23 28 33 38
# [4,] 24 29 34 39
# [5,] 5 10 15 20
# [6,] 21 26 31 36
# [7,] 22 27 32 37
# [8,] 2 7 12 17
# [9,] 4 9 14 19
# [10,] 25 30 35 40
# attr(,"origdim")
# [1] 5 4 2
(Note that I pre-made ind1 and ind2 here, mostly to see what was going on internally. You can replace m[ind2,] with m[sample(ind1),] for the same effect.)
BTW: if we had instead used a seed of 2, we would notice that 2 rows are not swapped:
set.seed(2)
(ind1 <- sample(nr, size = ceiling(nr * pct)))
# [1] 2 7 5 10 6
(ind2 <- sample(ind1))
# [1] 6 2 5 10 7
Because of this, I chose a seed of 3 for demonstration. However, this may give the appearance of things not working. Lacking more controlling code, sample does not ensure that positions change: it is certainly reasonable to expect that "randomly swap rows" could randomly choose to move row 2 to row 2. Take for example:
set.seed(267)
(ind1 <- sample(nr, size = ceiling(nr * pct)))
# [1] 3 6 5 7 2
(ind2 <- sample(ind1))
# [1] 3 6 5 7 2
The first randomly chooses five rows, and then reorders them randomly into an unchanged order. (I suggest that if you want to force that they are all movements, you should ask a new question asking about just forcing a sample vector to change.)
Anyway, we can regain the original dimensionality with the second function:
(a2 <- matrix2array(m))
# , , 1
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 3 8 13 18
# [3,] 23 28 33 38
# [4,] 24 29 34 39
# [5,] 5 10 15 20
# , , 2
# [,1] [,2] [,3] [,4]
# [1,] 21 26 31 36
# [2,] 22 27 32 37
# [3,] 2 7 12 17
# [4,] 4 9 14 19
# [5,] 25 30 35 40
In the first plane of the array, rows 1 and 5 are unchanged; in the second plane, rows 1, 2, and 5 are unchanged. Five rows the same, five rows moved around (but otherwise unchanged within each row).
I want to know the command in R to lag a matrix.
I have defined x as:
> (x <- matrix(1:50, 10, 5))
[,1] [,2] [,3] [,4] [,5]
[1,] 1 11 21 31 41
[2,] 2 12 22 32 42
[3,] 3 13 23 33 43
[4,] 4 14 24 34 44
[5,] 5 15 25 35 45
[6,] 6 16 26 36 46
[7,] 7 17 27 37 47
[8,] 8 18 28 38 48
[9,] 9 19 29 39 49
[10,] 10 20 30 40 50
I want create l.x:
[,1] [,2] [,3] [,4] [,5]
[1,] NA NA NA NA NA
[2,] 1 11 21 31 41
[3,] 2 12 22 32 42
[4,] 3 13 23 33 43
[5,] 4 14 24 34 44
[6,] 5 15 25 35 45
[7,] 6 16 26 36 46
[8,] 7 17 27 37 47
[9,] 8 18 28 38 48
[10,] 9 19 29 39 49
lag will coerce your object to a time-series (ts class to be specific) and only shifts the time index. It does not change the underlying data.
You need to manually lag the matrix yourself by adding rows of NA at the beginning and removing the same number of rows at the end. Here's an example of a function that does just that:
lagmatrix <- function(x, k) {
# ensure 'x' is a matrix
stopifnot(is.matrix(x))
if (k == 0)
return(x)
na <- matrix(NA, nrow=abs(k), ncol=ncol(x))
if (k > 0) {
nr <- nrow(x)
# prepend NA and remove rows from end
rbind(na, x[-((nr-k):nr),])
} else {
# append NA and remove rows from beginning
rbind(x[-1:k,], na)
}
}
Or you can use a lag function that does what you expect. For example, xts::lag.xts.
> xts::lag.xts(x)
[,1] [,2] [,3] [,4] [,5]
[1,] NA NA NA NA NA
[2,] 1 11 21 31 41
[3,] 2 12 22 32 42
[4,] 3 13 23 33 43
[5,] 4 14 24 34 44
[6,] 5 15 25 35 45
[7,] 6 16 26 36 46
[8,] 7 17 27 37 47
[9,] 8 18 28 38 48
[10,] 9 19 29 39 49
> is.matrix(xts::lag.xts(x))
[1] TRUE
Here is one manual method in base R with head and rbind:
rbind(NA, head(x, 9))
[,1] [,2] [,3] [,4] [,5]
[1,] NA NA NA NA NA
[2,] 1 11 21 31 41
[3,] 2 12 22 32 42
[4,] 3 13 23 33 43
[5,] 4 14 24 34 44
[6,] 5 15 25 35 45
[7,] 6 16 26 36 46
[8,] 7 17 27 37 47
[9,] 8 18 28 38 48
[10,] 9 19 29 39 49
More generally, as noted by #akrun, head(., -1) will work for any sized matrix:
rbind(NA, head(x, -1))
We can use apply
library(dplyr)
apply(x, 2, lag)
# [,1] [,2] [,3] [,4] [,5]
# [1,] NA NA NA NA NA
# [2,] 1 11 21 31 41
# [3,] 2 12 22 32 42
# [4,] 3 13 23 33 43
# [5,] 4 14 24 34 44
# [6,] 5 15 25 35 45
# [7,] 6 16 26 36 46
# [8,] 7 17 27 37 47
# [9,] 8 18 28 38 48
#[10,] 9 19 29 39 49
0r
rbind(NA, x[-nrow(x),])
# [,1] [,2] [,3] [,4] [,5]
# [1,] NA NA NA NA NA
# [2,] 1 11 21 31 41
# [3,] 2 12 22 32 42
# [4,] 3 13 23 33 43
# [5,] 4 14 24 34 44
# [6,] 5 15 25 35 45
# [7,] 6 16 26 36 46
# [8,] 7 17 27 37 47
# [9,] 8 18 28 38 48
#[10,] 9 19 29 39 49
Below is a pure dplyr solution without the need for apply. Only annoyance here is that it needs to be converted to a data.frame to work.
library(dplyr)
x %>% as.data.frame %>% mutate_each( funs(lag))
Matlab can do this task. I cannot get it right so far by using matrix(), t(), and reShape().
My intention is to transpose a series to a matrix of fixed 10 rows and the number of column varies based on the length of the data series. If these are some remains left, they can be discarded.
For example:
Row #1 1 2 3 4
Row #2 5 6 7 8
Row #3 9 10 11 12
Row #4 13 14 15 16
Row #5 17 18 19 20
Row #6 21 22 23 24
Row #7 25 26 27 28
Row #8 29 30 31 32
Row #9 33 34 35 36
Row #10 37 38 39 40
If there are any remains left (i.e, 41~49), these data can be just discarded.
Any suggestions?
This is what I think you are asking for. A vector of arbitrary length and data. To be turned into a matrix with nrow 10 and ncol based on data length.
#your series of arbitrary length
data = 1:49
#calculate number of columns based on length
col = as.integer(length(data)/10)
#max index
maxIndx = 10*col
#create and transpose matrix
yourMtx = t(matrix(data[0:maxIndx],col,10))
#your matrix
> [,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12
[4,] 13 14 15 16
[5,] 17 18 19 20
[6,] 21 22 23 24
[7,] 25 26 27 28
[8,] 29 30 31 32
[9,] 33 34 35 36
[10,] 37 38 39 40
#create reverse matrix
revMtx = yourMtx[,rev(seq_len(ncol(yourMtx)))]
#reverse matrix
> [,1] [,2] [,3] [,4]
[1,] 4 3 2 1
[2,] 8 7 6 5
[3,] 12 11 10 9
[4,] 16 15 14 13
[5,] 20 19 18 17
[6,] 24 23 22 21
[7,] 28 27 26 25
[8,] 32 31 30 29
[9,] 36 35 34 33
[10,] 40 39 38 37
If I understand your question correctly, this looks to be an approach you could use.
# generate my series
myseries <- 1:49
# specify number of columns and rows
ncols <- 4
nrows <- 10
# create a matrix with the first ncols*nrows elements and fill by row
mymatrix <- matrix(myseries[1:(ncols*nrows)],
ncol = ncols, nrow = nrows, byrow = TRUE)
mymatrix
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12
[4,] 13 14 15 16
[5,] 17 18 19 20
[6,] 21 22 23 24
[7,] 25 26 27 28
[8,] 29 30 31 32
[9,] 33 34 35 36
[10,] 37 38 39 40
How could I build a function that extracts the diagonal blocks matrices of a larger one? The problem is as follows. The function takes a centred matrix as argument, computes the full error covariance matrix and extracts the blocks on the leading diagonal? I tried the following, but not working.
err_cov <- function(x){
m <- nrow(x)
n <- ncol(x)
#compute the full error covariance matrix as the inner product
#of vec(x) and its transpose. Note that, omega is a mnxmn matrix
vec <- as.vector(x)
omega <- vec%*%t(vec)
sigmas <- list()
for(i in 0:n-1){
#here the blocks have to be m nxn matrices along the
#leading diagonal
for (j in 1:m)
sigmas[[j]] <- omega[(n*i+1):n*(i+1), (n*i+1):n*(i+1)]
}
return(sigmas)
}
So, for instance for
A
[,1] [,2] [,3] [,4]
[1,] 1 4 7 10
[2,] 2 5 8 11
[3,] 3 6 9 12
> B<-as.vector(A)
> B
[1] 1 2 3 4 5 6 7 8 9 10 11 12
> C<-B%*%t(B)
> C
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,] 1 2 3 4 5 6 7 8 9 10 11 12
[2,] 2 4 6 8 10 12 14 16 18 20 22 24
[3,] 3 6 9 12 15 18 21 24 27 30 33 36
[4,] 4 8 12 16 20 24 28 32 36 40 44 48
[5,] 5 10 15 20 25 30 35 40 45 50 55 60
[6,] 6 12 18 24 30 36 42 48 54 60 66 72
[7,] 7 14 21 28 35 42 49 56 63 70 77 84
[8,] 8 16 24 32 40 48 56 64 72 80 88 96
[9,] 9 18 27 36 45 54 63 72 81 90 99 108
[10,] 10 20 30 40 50 60 70 80 90 100 110 120
[11,] 11 22 33 44 55 66 77 88 99 110 121 132
[12,] 12 24 36 48 60 72 84 96 108 120 132 144
The function should return:
> C1
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 2 4 6
[3,] 3 6 9
> C2
[,1] [,2] [,3]
[1,] 16 20 24
[2,] 20 25 30
[3,] 24 30 36
> C3
[,1] [,2] [,3]
[1,] 49 56 63
[2,] 56 64 72
[3,] 63 72 81
> C4
[,1] [,2] [,3]
[1,] 100 110 120
[2,] 110 121 132
[3,] 120 132 144
Thanks for answering.
I think a clearer solution is to reset the dimensions and then let R do the index calculations for you:
err_cov <- function(x){
m <- nrow(x)
n <- ncol(x)
#compute the full error covariance matrix as the inner product
#of vec(x) and its transpose
vec <- as.vector(x)
omega <- tcrossprod(vec)
dim(omega) <- c(n,m,n,m)
sigmas <- list()
for (j in 1:m)
sigmas[[j]] <- omega[,j,,j]
return(sigmas)
}
Here is an example:
> x
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
> tcrossprod(vec)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 2 3 4 5 6
[2,] 2 4 6 8 10 12
[3,] 3 6 9 12 15 18
[4,] 4 8 12 16 20 24
[5,] 5 10 15 20 25 30
[6,] 6 12 18 24 30 36
> err_cov(x)
[[1]]
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 2 4 6
[3,] 3 6 9
[[2]]
[,1] [,2] [,3]
[1,] 16 20 24
[2,] 20 25 30
[3,] 24 30 36