I need to create a function, that will rearrange any square matrix based on the values in the matrix.
So if I have matrix like this:
M <- matrix(1:16, ncol = 4)
M
#> [,1] [,2] [,3] [,4]
#> [1,] 1 5 9 13
#> [2,] 2 6 10 14
#> [3,] 3 7 11 15
#> [4,] 4 8 12 16
After rearrangement it needs to look like this:
[,1] [,2] [,3] [,4]
[1,] 1 3 6 10
[2,] 2 5 9 13
[3,] 4 8 12 15
[4,] 7 11 14 16
So it is sorted from lowest (left upper corner) to highest (right lower corner), but the numbers are sorted on diagonal (is that the right word?) not in rows or columns.
I know how to to this "manually", but I can't figure out any rules that this rearrangement operates by.
1) row(m) + col(m) is constant along reverse diagonals so:
M <- replace(m, order(row(m) + col(m)), m)
gving:
> M
[,1] [,2] [,3] [,4]
[1,] 1 3 6 10
[2,] 2 5 9 13
[3,] 4 8 12 15
[4,] 7 11 14 16
It is not clear whether sorted on the diagonal means just that they are unravelled from the storage order onto the reverse diagonals or that they are actually sorted after that within each reverse diagonal. In the example in the question the two interpretations give the same answer; however, if you did wish to sort the result within reverse diagonal afterwards using different data then apply this:
ave(M, row(M) + col(M), FUN = sort)
2) A longer version:
M2 <- matrix(m[order(unlist(tapply(seq_along(m), row(m) + col(m), c)))], nrow(m))
Here's a function columns_to_diagonals in base R that ought to do what you're after. It uses split and unsplit with the appropriate factors.
columns_to_diagonals <- function(M) {
n <- ncol(M)
f <- matrix(rep(1:(2*n-1), c(1:n, (n-1):1)), ncol = n)
m <- split(M, f)
d <- row(M) + col(M)
matrix(unsplit(m, d), ncol = n)
}
First, we may test this on your original case:
M <- matrix(1:16, ncol = 4)
columns_to_diagonals(M)
#> [,1] [,2] [,3] [,4]
#> [1,] 1 3 6 10
#> [2,] 2 5 9 13
#> [3,] 4 8 12 15
#> [4,] 7 11 14 16
And then a larger, randomly permutated matrix, to check that this looks fine as well:
M <- matrix(sample(1:25), ncol = 5)
M
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 4 15 12 10 21
#> [2,] 19 7 5 23 6
#> [3,] 9 17 2 8 1
#> [4,] 3 11 16 25 14
#> [5,] 22 18 20 13 24
columns_to_diagonals(M)
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 4 9 15 18 20
#> [2,] 19 22 11 16 25
#> [3,] 3 17 2 8 6
#> [4,] 7 5 23 21 14
#> [5,] 12 10 13 1 24
Created on 2019-12-15 by the reprex package (v0.2.1)
Related
n <- 5
a <- matrix(c(1:n**2),nrow = n, byrow = T)
output is
[,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
how do I shift the '1' to the current position of '25' to look like this:
[,1] [,2] [,3] [,4] [,5]
[1,] 2 3 4 5 6
[2,] 7 8 9 10 11
[3,] 12 13 14 15 16
[4,] 17 18 19 20 21
[5,] 22 23 24 25 1
a <- t(a); a[] <- c(a[-1], a[1]); a <- t(a)
a
# [,1] [,2] [,3] [,4] [,5]
# [1,] 2 3 4 5 6
# [2,] 7 8 9 10 11
# [3,] 12 13 14 15 16
# [4,] 17 18 19 20 21
# [5,] 22 23 24 25 1
c(a) unwinds or unlists the matrix into a vector. It does this column-first, so c(a) results in [1] 1 6 11 16 21 2 .... We want it to be row-first, though, so
t(a) transposes it, so that what was a row-first is now column-first, allowing c(a) and such to work.
c(a[-1], a[1]) is just "concatenate all except the first with the first", the classic way to put the first element of a vector at the end.
a[] <- is a way to do calcs on its values where the calcs do not preserve the "dimensionality" of the object.
After we've rearranged, we then transpose back to the original shape and row/column-order.
Here is a base R one-liner
> t(`dim<-`(t(a)[seq_along(a)%%length(a)+1],rev(dim(a))))
[,1] [,2] [,3] [,4] [,5]
[1,] 2 3 4 5 6
[2,] 7 8 9 10 11
[3,] 12 13 14 15 16
[4,] 17 18 19 20 21
[5,] 22 23 24 25 1
I am a newbie in R, I now have a matrix of 3 columns and 8, 000 rows, with groups of 500 rows, which means 16 sets of 500*3 matrices stacked on top of each other in rows. Now I want to take the first 300 rows of each group of matrices, put 16 groups of 300 by 3 into a new matrix, what do I do?
Two 6 * 2 matrices on top of each other:
m <- matrix(1:24, ncol = 2)
# [,1] [,2]
# [1,] 1 13
# [2,] 2 14
# [3,] 3 15
# [4,] 4 16
# [5,] 5 17
# [6,] 6 18
# [7,] 7 19
# [8,] 8 20
# [9,] 9 21
#[10,] 10 22
#[11,] 11 23
#[12,] 12 24
Make it an array:
a <- array(m, c(6, 2, 2))
a <- aperm(a, c(1, 3, 2))
First three rows of each matrix:
a[1:3,,]
#, , 1
#
# [,1] [,2]
#[1,] 1 13
#[2,] 2 14
#[3,] 3 15
#
#, , 2
#
# [,1] [,2]
#[1,] 7 19
#[2,] 8 20
#[3,] 9 21
Use this if you need a matrix:
matrix(aperm(a[1:3,,], c(1, 3, 2)), ncol = 2)
# [,1] [,2]
#[1,] 1 13
#[2,] 2 14
#[3,] 3 15
#[4,] 7 19
#[5,] 8 20
#[6,] 9 21
You need to generate the sequence 1:300, 501:800, ... etc, then subset out these rows. If your matrix is called mat you can do that like this:
new_mat <- mat[as.numeric(sapply((0:15 * 500), "+", 1:300)),]
If you're looking for just a way to select the first 300 rows from your matrix for each group, this could be a solution.
Given m your matrix of 8000x3 composed by 16 groups on top of each other, then:
r <- 500 # rows for each group
g <- 16 # number of groups
n <- 300 # first n rows to select
new_m <- m[rep(rep(c(T,F), c(n,r-n)), g), ]
dim(new_m)
#> [1] 4800 3
new_m is now a matrix 4800x3
In case you are working with keras or reticulate, you could use array_reshape.
#### 0. parameters
nrows <- 4 # 500 in your example # rows for each group
ncols <- 3 # 3 in your example
ngrps <- 2 # 16 in your example # number of groups
nslct <- 3 # 300 in your example # first n rows to select
#### 1. create an example matrix
m <- matrix(1:24, nrows*ngrps, ncols)
m
#> [,1] [,2] [,3]
#> [1,] 1 9 17
#> [2,] 2 10 18
#> [3,] 3 11 19
#> [4,] 4 12 20
#> [5,] 5 13 21
#> [6,] 6 14 22
#> [7,] 7 15 23
#> [8,] 8 16 24
dim(m)
#> [1] 8 3
#--> c(ngrps * nrows, ncols)
#### 2. reshape in groups
m <- reticulate::array_reshape(m, c(ngrps,nrows,ncols))
dim(m)
#> [1] 2 4 3
# --> c(n_groups, n_rows, n_cols)
m[1,,]
#> [,1] [,2] [,3]
#> [1,] 1 9 17
#> [2,] 2 10 18
#> [3,] 3 11 19
#> [4,] 4 12 20
m[2,,]
#> [,1] [,2] [,3]
#> [1,] 5 13 21
#> [2,] 6 14 22
#> [3,] 7 15 23
#> [4,] 8 16 24
#### 3. select first nslct rows for each group
new_m <- m[,seq_len(nslct),]
# that's the result for each group
new_m[1,,]
#> [,1] [,2] [,3]
#> [1,] 1 9 17
#> [2,] 2 10 18
#> [3,] 3 11 19
new_m[2,,]
#> [,1] [,2] [,3]
#> [1,] 5 13 21
#> [2,] 6 14 22
#> [3,] 7 15 23
#### 4. recreate one matrix
reticulate::array_reshape(new_m, c(nslct*ngrps,ncols))
#> [,1] [,2] [,3]
#> [1,] 1 9 17
#> [2,] 2 10 18
#> [3,] 3 11 19
#> [4,] 5 13 21
#> [5,] 6 14 22
#> [6,] 7 15 23
Created on 2020-11-23 by the reprex package (v0.3.0)
A simple way to generate an array that mimics the fill of your matrix is to use the transpose of the matrix as the input for the array function. Here is a simple example:
n <- rep(1:3, each = 4)
m1 <- matrix(n, ncol = 2, byrow = TRUE)
> m1
[,1] [,2]
[1,] 1 1
[2,] 1 1
[3,] 2 2
[4,] 2 2
[5,] 3 3
[6,] 3 3
m2 <- t(m1)
a1 <- array(m2, c(2, 2, 3))
> a1
, , 1
[,1] [,2]
[1,] 1 1
[2,] 1 1
, , 2
[,1] [,2]
[1,] 2 2
[2,] 2 2
, , 3
[,1] [,2]
[1,] 3 3
[2,] 3 3
I need to create a list of sequences that always goes back to the first digit in the sequence. I've written the code below but it seems clunky. Is there a solution that uses fewer characters?
(i = seq(1, 24, by = 3))
#> [1] 1 4 7 10 13 16 19 22
(i_list = purrr::map(i, ~c(.:(. + 2), .)))
#> [[1]]
#> [1] 1 2 3 1
#>
#> [[2]]
#> ...
Edit: here's a way with lapply(). Not sure why this is getting downvotes, any advice on how to improve the question welcome!
(i_list = lapply(i, function(x) c(x:(x+2), x)))
I was wondering if there's a way with replicate() so have added that tag.
In matrix, rather than list form, theres:
cbind(matrix(1:24, ncol=3,byrow=TRUE),seq(1, 24, by = 3))
[,1] [,2] [,3] [,4]
[1,] 1 2 3 1
[2,] 4 5 6 4
[3,] 7 8 9 7
[4,] 10 11 12 10
[5,] 13 14 15 13
[6,] 16 17 18 16
[7,] 19 20 21 19
[8,] 22 23 24 22
and then you'd iterate over rows of the matrix instead of elements of the list.
Or if you are into code golf:
> seq(1,24,by=3) + t(matrix(c(0,1,2,0),ncol=8,nrow=4))
[,1] [,2] [,3] [,4]
[1,] 1 2 3 1
[2,] 4 5 6 4
[3,] 7 8 9 7
[4,] 10 11 12 10
...
but then how much work do you put into constructing the RHS of the + in this case? How is your question parameterised?
This depends on i having a regular pattern (with some adjustment for step size), it doesn't work for arbitrary i sequences.
This question already has answers here:
Creating a symmetric matrix in R
(7 answers)
Closed 5 years ago.
I know A'A will give a symmetric positive definite matrix. But how can I generate random matrix in R that is symmetric, but not necessary to be positive definite?
The details will of course depend on what distribution you'll want the matrix elements to have, but once you settle on that, you can adapt something like the following:
m <- matrix(sample(1:20, 36, replace=TRUE), nrow=6)
m[lower.tri(m)] <- t(m)[lower.tri(m)]
m
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 19 20 15 6 5 14
# [2,] 20 20 20 3 18 17
# [3,] 15 20 6 5 11 3
# [4,] 6 3 5 6 9 20
# [5,] 5 18 11 9 10 2
# [6,] 14 17 3 20 2 7
For ease of use, you can then wrap up code like that in a function, like so:
f <- function(n) {
m <- matrix(sample(1:20, n^2, replace=TRUE), nrow=n)
m[lower.tri(m)] <- t(m)[lower.tri(m)]
m
}
## Try it out
f(2)
# [,1] [,2]
# [1,] 9 13
# [2,] 13 15
f(3)
# [,1] [,2] [,3]
# [1,] 1 8 3
# [2,] 8 13 5
# [3,] 3 5 14
I have been thinking about a problem I have but I don't know how to express the problem to even search for it. I'd be very thankful if you could explain it to me.
So, I have a data set with the following format:
10 6 4 4
10 6 4 4
7 6 4 4
I want to conduct a pairwise calculation for which I need to sum each element to the other one by one. That is 1 with 2, 1 with 3, 1 with 4, 2 with 3, 2 with 4 and 3 with 4.
I thought to do a nested a loop in R which I read about it and I started like this:
for (i in 1:r-1) { ## r the number of columns
for (j in (i+1):r) {
....
}
I am stuck at this stage, I don't know how to express in codes what I need to do. I am sorry for posting a not progressed code, some advice would be very good that how I should go about it.
Thanks a lot in advance.
Use combn to create the "pairs":
(pairs <- combn(4,2))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 1 1 2 2 3
[2,] 2 3 4 3 4 4
Then apply across the rows of your data by summing these subsets by applying across the columns of the pairs:
dat <- matrix(c(10,10,7,6,6,6,4,4,4,4,4,4),ncol=4)
t(apply(dat, 1, function(x) apply(combn(4,2),2,function(y) sum(x[y]))))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 16 14 14 10 10 8
[2,] 16 14 14 10 10 8
[3,] 13 11 11 10 10 8
You could slightly modify your loop:
d <- read.table(text='
10 6 4 4
10 6 4 4
7 6 4 4')
nc <- ncol(d)
r <- NULL
for (i in 1:nc) {
for (j in 1:nc) {
if (i < j) { # crucial condition
r <- cbind(r, d[, i] + d[, j]) # calculate new column and bind to calculated ones
}
}
}
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 16 14 14 10 10 8
[2,] 16 14 14 10 10 8
[3,] 13 11 11 10 10 8
Another application of combn but perhaps easier to understand:
apply(combn(ncol(dat),2), 2, function(x) rowSums(dat[,x]))
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 16 14 14 10 10 8
## [2,] 16 14 14 10 10 8
## [3,] 13 11 11 10 10 8
Here, the matrix dat is indexed by each column of the result of combn giving a matrix of two columns (the two columns to be summed). rowSums then does the arithmetic.
Because I really like package functional, here is a slight variation on the above:
apply(combn(ncol(dat),2), 2, Compose(Curry(`[`, dat, i=seq(nrow(dat))), rowSums))
It should be noted that a combn approach is more flexible than using nested for loops for this sort of computation. In particular, it is easily adapted to any number of columns to sum:
f <- function(dat, num=2)
{
apply(combn(ncol(dat),num), 2, function(x) rowSums(dat[,x,drop=FALSE]))
}
This will give all combinations of num columns, and sum them:
f(dat, 1)
## [,1] [,2] [,3] [,4]
## [1,] 10 6 4 4
## [2,] 10 6 4 4
## [3,] 7 6 4 4
f(dat, 2)
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 16 14 14 10 10 8
## [2,] 16 14 14 10 10 8
## [3,] 13 11 11 10 10 8
f(dat, 3)
## [,1] [,2] [,3] [,4]
## [1,] 20 20 18 14
## [2,] 20 20 18 14
## [3,] 17 17 15 14
f(dat, 4)
## [,1]
## [1,] 24
## [2,] 24
## [3,] 21