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.
Related
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.
I'd like to return a grid with unique rows from a sequence vector. I'm looking for a general solution so I can pass any number of sequences in a vector. I don't know the terminology for this, so how can I do this?
Example
num <- 3
v <- c(seq(1, num, 1))
Desired Output
1 2 3
2 3 1
3 1 2
Second and third column can be switched:
1 3 2
2 1 3
3 2 1
I tried manipulating expand.grid() but it requires sorting and filtering which seems excessive.
We can use permn from combinat package which generates all possible permutations of v and then select top num of them using head
head(as.data.frame(do.call(rbind, combinat::permn(v))), num)
# V1 V2 V3
#1 1 2 3
#2 1 3 2
#3 3 1 2
We can also use sample to select any num rows instead of first num rows using head.
where
combinat::permn(v) #gives
#[[1]]
#[1] 1 2 3
#[[2]]
#[1] 1 3 2
#[[3]]
#[1] 3 1 2
#[[4]]
#[1] 3 2 1
#[[5]]
#[1] 2 3 1
#[[6]]
#[1] 2 1 3
Here's one solution (column order differs but the idea holds):
n = 3
sweep(replicate(n, 1:n), 2, 1:n, "+") %% n + 1
[,1] [,2] [,3]
[1,] 3 1 2
[2,] 1 2 3
[3,] 2 3 1
Explanation:
replicate will first create a matrix where each row is 1:n:
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 2 2 2
[3,] 3 3 3
I then use the sweep function to add 1 to column 1, 2 to column 2, 3 to column 3:
[,1] [,2] [,3]
[1,] 2 3 4
[2,] 3 4 5
[3,] 4 5 6
At this point, you can do a modulo on the matrix and then add 1 to arrive at the desired matrix.
Edit: If you need to have the same column order as you had above, can do
(sweep(replicate(n, 1:n), 2, 1:n, "+") + 1) %% n + 1
Another base R option
t(sapply(1:length(v), function(i) rep(v, 2)[i:(i+2)]))
# [,1] [,2] [,3]
#[1,] 1 2 3
#[2,] 2 3 1
#[3,] 3 1 2
Explanation: We cyclically permute v and store the vectors as column vectors in a matrix.
For general v (of length length(v)) this becomes
t(sapply(1:length(v), function(i) rep(v, 2)[i:(i + length(v) - 1)]))
I'm using r and
I want to fill a 8 lenght dimension vector/table with integer numbers form 1 to 4 with respect to the conditions below:
vector [i]<= vector[i+1]
all integrs should be present
example:
1 1 1 1 2 2 3 4 may be a solution
1 2 1 1 2 3 3 4 isn't a solution to my problem
I am wondering also if there is a way to list all solutions
To get all solutions, reserve four slots for the numbers 1:4 (since every number must appear at least once), and consider all possible length-4 sequences of 1:4 to fill the remaining slots. Sorting and removing duplicates leaves you with 35 non-decreasing sequences:
# The sequences will be the rows of a matrix. First, the 'reserved' slots:
reserved = matrix(1:4, 256, 4, byrow=TRUE)
# Add all combinations of 1:4 to fill the remaining four slots:
result = cbind(reserved,
unname(as.matrix(expand.grid(1:4, 1:4, 1:4, 1:4))) )
# Now simply sort and de-duplicate along rows:
result = t(apply(result, 1, sort))
result = unique(result)
> head(result)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,] 1 1 1 1 1 2 3 4
# [2,] 1 1 1 1 2 2 3 4
# [3,] 1 1 1 1 2 3 3 4
# [4,] 1 1 1 1 2 3 4 4
# [5,] 1 1 1 1 2 2 3 4
# [6,] 1 1 1 2 2 2 3 4
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
This question already has answers here:
interleave rows of matrix stored in a list in R
(2 answers)
Closed 9 years ago.
There is a function in Mathematica called "Riffle" that can be used for inserting columns of a matrix between columns of another matrix.For example, for m1 and m2 matrices like these:
m1= 1 1 1
1 1 1
1 1 1
m2=2 2 2
2 2 2
2 2 2
it creates
1 2 1 2 1 2
1 2 1 2 1 2
1 2 1 2 1 2
is there any equivalent function in R for doing this?
Assuming that you matrices have equal dimensions, you might use this little trick
m <- rbind(m1, m2)
dim(m) <- rev(dim(m))
m
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 2 1 2 1 2
[2,] 1 2 1 2 1 2
[3,] 1 2 1 2 1 2
Another option would be to use the interleave function from the gdata package. The function interleaves rows not columns, so you need to transpose your matrices back and forth.
m <- t(interleave(t(m1), t(m2)))
m
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 2 1 2 1 2
[2,] 1 2 1 2 1 2
[3,] 1 2 1 2 1 2
Don't know if it already exists (never seen it), but it is not to difficult to write:
riffle <- function(a,b) {
if (!all(dim(a) == dim(b))) stop("dimensions do not match")
array(rbind(a, b), dim=c(dim(a)[1], dim(a)[1]+dim(b)[1]))
}