dimension problem on replacing for loops with foreach in R - r

I have the following (very simplified) loop setting:
res <- array(0, c(4, 3, 2))
for (i in 1:4) {
for (j in 1:3) {
res[i,j,] <- c(i,j) # this is not the vector I have, it should just demonstrate the dimensions. In my case there is a matrix multuplication with %*%
}
}
which gives me the following output:
, , 1
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 2 2 2
[3,] 3 3 3
[4,] 4 4 4
, , 2
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 1 2 3
[3,] 1 2 3
[4,] 1 2 3
Now, what I want is to run the same thing parallel with two foreach loops. But my attempt:
res2 <- foreach(i=1:4, .combine='rbind') %dopar% {
foreach(j=1:3 , .combine='c')%do% {
c(i,j)
}
}
gives me the wrong output:
result.1 1 1 1 2 1 3
result.2 2 1 2 2 2 3
result.3 3 1 3 2 3 3
result.4 4 1 4 2 4 3
In the end there is just one dimension missing, but I don't want to use another iterator since the third dimension is already given by the vector I get back in every step.

Related

How can I create this exact 5x5 matrix using only for loops?

0 1 2 3 4
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
So I was given this matrix and was told to create it using only for loops. What i have done so far is using cbind(0:4,1+(0:4),2+(0:4),3+(0:4),4+(0:4)) but i cant figure out a way to do so with the for function.
You were on the right track. If you rewrite your current
cbind(0:4,1+(0:4),2+(0:4),3+(0:4),4+(0:4))
as
cbind(0+(0:4),1+(0:4),2+(0:4),3+(0:4),4+(0:4))
you might notice that the thing that you are adding to 0:4 is implicitly a loop index.
Make it explicit:
m = c()
for(i in 0:4){
m = cbind(m,i+(0:4))
}
print(m)
Output:
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 1 2 3 4 5
[3,] 2 3 4 5 6
[4,] 3 4 5 6 7
[5,] 4 5 6 7 8
One way:
mat <- matrix(0L, nrow=5, ncol=5)
for (i in 0:4) {
for (j in 0:4) {
mat[i + 1, j + 1] <- i + j
}
}
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0 1 2 3 4
# [2,] 1 2 3 4 5
# [3,] 2 3 4 5 6
# [4,] 3 4 5 6 7
# [5,] 4 5 6 7 8
And technically *apply functions are loops as well:
sapply(0:4, \(x) 0:4 + x)
You can just create an empty matrix first and then fill it with two for-loops iterating over rows and columns. Playing a little bit around with the variable to write into the matrix (count) I figured out that this is a suitable solution.
matrix2fill <- matrix(NA, 5,5)
count = 0
for (i in 1:5){
for (j in 1:5){
matrix2fill[j,i] = count
count = count + 1
}
count = i
}
matrix2fill
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 1 2 3 4 5
[3,] 2 3 4 5 6
[4,] 3 4 5 6 7
[5,] 4 5 6 7 8
Yet another way:
mymat <- matrix(NA, nrow = 5, ncol = 5)
i_mat <- 1
for (i in 0:4) {
mymat[seq(i_mat, i_mat + 4)] <- seq(i, i + 4)
i_mat <- i_mat + 5
}
mymat
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 1 2 3 4 5
[3,] 2 3 4 5 6
[4,] 3 4 5 6 7
[5,] 4 5 6 7 8
Try this:
a = matrix(1:25, nrow=5, ncol=5)
for (i in 1:5) {
for (j in 1:5) {
a[i][j] = (i-1) + (j-1)
}
}
print(a)

Extracting unique rows in a 3+ column matrix

Using R, I am trying to extract unique rows in a matrix, where a "unique row" is subject to all the values in a given row.
For example if I had this data set:
x = matrix(c(1,1,1,2,2,5,1,2,2,1,2,1,5,3,5,2,1,1),6,3)
Rows 1 & 6, and rows 4 & 5 are duplicated since (1,1,5) = (5,1,1) and (2,1,2) = (2,2,1).
Ultimately, i'm trying to end up with something in the form of:
y = matrix(c(1,1,1,2,1,2,2,1,5,3,5,2),4,3)
or
z = matrix(c(1,1,2,5,2,2,2,1,3,5,1,1),4,3)
The order doesn't matter as long as only one of the unique rows remains. I've searched online, but functions such as unique() and duplicated() have only worked for exact matching rows.
Thanks in advance for any help you provide.
Another answer: use sets. Slightly modified matrix:
library(sets)
x <- matrix(c(1,1,1,2,2,5,5, 1,2,2,1,2,1,5, 5,3,5,2,1,1,1),7,3)
x
[,1] [,2] [,3]
[1,] 1 1 5
[2,] 1 2 3
[3,] 1 2 5
[4,] 2 1 2
[5,] 2 2 1
[6,] 5 1 1
[7,] 5 5 1
If (5,1,1) = (5,5,1) you can use just ordinary sets:
a <- sapply(1:nrow(x), function(i) as.set(x[i,]))
x[!duplicated(a),]
[,1] [,2] [,3]
[1,] 1 1 5
[2,] 1 2 3
[3,] 1 2 5
[4,] 2 1 2
Note: rows 6 and 7 are both gone.
If (5,1,1) != (5,5,1), use generalized sets:
b <- sapply(1:nrow(x), function(i) as.gset(x[i,]))
x[!duplicated(b),]
[,1] [,2] [,3]
[1,] 1 1 5
[2,] 1 2 3
[3,] 1 2 5
[4,] 2 1 2
[5,] 5 5 1

Creating a matrix of increasing concentric rings of numbers in R

I need to write a function in R that creates a matrix of increasing concentric rings of numbers. This function's argument is a number of layers. For example, if x = 3, matrix will look like following:
1 1 1 1 1
1 2 2 2 1
1 2 3 2 1
1 2 2 2 1
1 1 1 1 1
I have no idea how to do it. I would really appreciate any suggestions.
1) Try this:
x <- 3 # input
n <- 2*x-1
m <- diag(n)
x - pmax(abs(row(m) - x), abs(col(m) - x))
giving:
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 1 2 2 2 1
[3,] 1 2 3 2 1
[4,] 1 2 2 2 1
[5,] 1 1 1 1 1
2) A second approach is:
x <- 3 # input
n <- 2*x-1
mid <- pmin(1:n, n:1) # middle row/column
outer(mid, mid, pmin)
giving the same result as before.
3) yet another approach having some similarities to the prior two approaches is:
x <- 3 # input
n <- 2*x-1
Dist <- abs(seq_len(n) - x)
x - outer(Dist, Dist, pmax)
Note: The above gives the sample matrix shown in the question but the subject of the question says the rings should be increasing which may mean increasing from the center to the outside so if that is what is wanted then try this where m, mid and Dist are as before:
pmax(abs(row(m) - x), abs(col(m) - x)) + 1
or
x - outer(mid, mid, pmin) + 1
or
outer(Dist, Dist, pmax) + 1
Any of these give:
[,1] [,2] [,3] [,4] [,5]
[1,] 3 3 3 3 3
[2,] 3 2 2 2 3
[3,] 3 2 1 2 3
[4,] 3 2 2 2 3
[5,] 3 3 3 3 3
Try this:
x<-3
res<-matrix(nrow=2*x-1,ncol=2*x-1)
for (i in 1:x) res[i:(2*x-i),i:(2*x-i)]<-i
res
# [,1] [,2] [,3] [,4] [,5]
#[1,] 1 1 1 1 1
#[2,] 1 2 2 2 1
#[3,] 1 2 3 2 1
#[4,] 1 2 2 2 1
#[5,] 1 1 1 1 1
A recursive solution for kicks (odd n only)
f <- function(n) if (n == 1) 1 else `[<-`(matrix(1,n,n), 2:(n-1), 2:(n-1), 1+Recall(n-2))
f(5)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 1 1
# [2,] 1 2 2 2 1
# [3,] 1 2 3 2 1
# [4,] 1 2 2 2 1
# [5,] 1 1 1 1 1
Here's the logic, implement it yourself in R.
Create a matrix with number of rows and columns equal to 2*x-1 and
fill it with zeros and start traversing the array from (0,0) to
(2*x-2,2*x-2).
Now, at each cell, calculate the 'level' of the cell. The level of
the cell is the nearest distance of it from the four borders of
the matrix, i.e. min(i,j,2*x-2-i,2*x-2-j).
This 'level' value is the one to be put in the cell.

Flattening 3-Dimensional data to elongated 2-D in R

I have data with dim 10,5,2 (t,x,y) and I want to convert it to dimensions 10*5,3. i.e to append every t frame to (x,y) frame with t value.
eg:
data[1,,]=
x y
1 2
1 3
data[2,,]=
x y
5 2
1 6
I would like to convert this data to flatten array like this
x y t
1 2 1
1 3 1
5 2 2
1 6 2
I was looking if there is already R function to do this or I'd do it by looping every t array and add the recreated array at bottom of main array.
a <- array(1:8, c(2,2,2))
a[1,,]
# [,1] [,2]
#[1,] 1 5
#[2,] 3 7
a[2,,]
# [,1] [,2]
#[1,] 2 6
#[2,] 4 8
m <- matrix(aperm(a, c( 2, 1, 3)), nrow=prod(dim(a)[2:3]))
cbind(m, rep(seq_len(dim(a)[2]), each=dim(a)[1]))
# [,1] [,2] [,3]
#[1,] 1 5 1
#[2,] 3 7 1
#[3,] 2 6 2
#[4,] 4 8 2
Here's a different approach:
a <- array(c(1,5,1,1,2,2,3,6), dim = c(2,2,2) )
do.call('rbind',lapply(1:dim(a)[3], function(x) cbind(a[x,,], t = x)))
t
[1,] 1 2 1
[2,] 1 3 1
[3,] 5 2 2
[4,] 1 6 2
Also:
If ais the array.
ft <- ftable(a)
cbind(ft[,1:2], as.numeric(factor(gsub("\\_.*","",row.names(as.matrix(ft))))))
[,1] [,2] [,3]
[1,] 1 2 1
[2,] 1 3 1
[3,] 5 2 2
[4,] 1 6 2

Create a block circulant matrix in R

I am trying to create a block circulant matrix in R. The structure of a block circulant matrix is given below.
C0 C1 ... Cn-1
Cn-1 C0 C1 ... Cn-2
Cn-2 Cn-1 .... Cn-3
and so on
I have the blocks
C0 .... Cn-1
What is the easiest way to create the matrix. Is there a function already available?
Thanks for a challenging question! Here is a solution summing kronecker products of your matrices with sub- and super-diagonals.
Sample data, a list of matrices:
C <- lapply(1:3, matrix, nrow = 2, ncol = 2)
My solution:
bcm <- function(C) {
require(Matrix)
n <- length(C)
Reduce(`+`, lapply((-n+1):(n-1),
function(i) kronecker(as.matrix(bandSparse(n, n, -i)),
C[[1 + (i %% n)]])))
}
bcm(C)
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 1 1 3 3 2 2
# [2,] 1 1 3 3 2 2
# [3,] 2 2 1 1 3 3
# [4,] 2 2 1 1 3 3
# [5,] 3 3 2 2 1 1
# [6,] 3 3 2 2 1 1
I don't know if this is particularly efficient, but as I interpret your question it does what you want.
rotList <- function(L,n) {
if (n==0) return(L)
c(tail(L,n),head(L,-n))
}
rowFun <- function(n,matList) do.call(rbind,rotList(matList,n))
bcMat <- function(matList) {
n <- length(matList)
do.call(cbind,lapply(0:(n-1),rowFun,matList))
}
Example:
bcMat(list(diag(3),matrix(1:9,nrow=3),matrix(4,nrow=3,ncol=3)))
I think what you are looking for is circulant.matrix from the lgcp package.
If x is a matrix whose columns are the bases of the sub-blocks of a
block circulant matrix, then this function returns the block circulant
matrix of interest.
eg
x <- matrix(1:8,ncol=4)
circulant(x)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,] 1 2 3 4 5 6 7 8
# [2,] 2 1 4 3 6 5 8 7
# [3,] 7 8 1 2 3 4 5 6
# [4,] 8 7 2 1 4 3 6 5
# [5,] 5 6 7 8 1 2 3 4
# [6,] 6 5 8 7 2 1 4 3
# [7,] 3 4 5 6 7 8 1 2
# [8,] 4 3 6 5 8 7 2 1
Alternative approach
Here is a highly inefficient approach using kronecker and Reduce
bcirc <- function(list.blocks){
P <- lapply(seq_along(list.blocks), function(x,y) x ==y, x = circulant(seq_along(list.blocks)))
Reduce('+',Map(P = P, A=list.blocks, f = function(P,A) kronecker(P,A)))
}
benchmarking with #flodel and #Ben Bolker
lbirary(microbenchmark)
microbenchmark(bcm(C), bcirc(C), bcMat(C))
Unit: microseconds
expr min lq median uq max neval
bcm(C) 10836.719 10925.7845 10992.8450 11141.1240 21622.927 100
bcirc(C) 444.983 455.7275 479.5790 487.0370 569.105 100
bcMat(C) 288.558 296.4350 309.8945 348.4215 2190.231 100
Is something like this what you are looking for?
> vec <- 1:4
> sapply(rev(seq_along(vec)),function(x) c(tail(vec,x),head(vec,-x)) )
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 3 4 1
[3,] 3 4 1 2
[4,] 4 1 2 3

Resources