Related
I don't even really know how to describe what I want to do, so hopefully the title makes at least some sense.
Better if I show you:
I have a simple 3x5 matrix of letters a to e:
matrix(data = rep(letters[1:5], 3), nrow = 3, ncol = 5, byrow = TRUE)
It gives this:
[,1] [,2] [,3] [,4] [,5]
[1,] "a" "b" "c" "d" "e"
[2,] "a" "b" "c" "d" "e"
[3,] "a" "b" "c" "d" "e"
I would like to change it to this without typing it manually:
[,1] [,2] [,3] [,4] [,5]
[1,] "a" "b" "c" "d" "e"
[2,] "e" "a" "b" "c" "d"
[3,] "d" "e" "a" "b" "c"
I'm thinking some kind of loop system or similar, but I have no idea where to start.
For the simple case you might try this for loop.
n <- dim(m3)[2]
for (i in seq_len(nrow(m))[-1]) {
m3[i, ] <- c(m3[i, (n - i + 2):n], m3[i, 1:(n - i + 1)])
}
m3
# [,1] [,2] [,3] [,4] [,5]
# [1,] "a" "b" "c" "d" "e"
# [2,] "e" "a" "b" "c" "d"
# [3,] "d" "e" "a" "b" "c"
To let the pattern repeat for a longer matrix, we might generalize:
n <- dim(m7)[2]
for (i in seq_len(nrow(m7))[-1]) {
j <- i %% 5
if (j == 0) j <- 5
if (j > 1) m7[i, ] <- c(m7[i, (n - j + 2):n], m7[i, 1:(n - j + 1)])
}
m7
# [,1] [,2] [,3] [,4] [,5]
# [1,] "a" "b" "c" "d" "e"
# [2,] "e" "a" "b" "c" "d"
# [3,] "d" "e" "a" "b" "c"
# [4,] "c" "d" "e" "a" "b"
# [5,] "b" "c" "d" "e" "a"
# [6,] "a" "b" "c" "d" "e"
# [7,] "e" "a" "b" "c" "d"
Data:
m3 <- matrix(data=letters[1:5], nrow=3, ncol=5, byrow=TRUE)
m7 <- matrix(data=letters[1:5], nrow=7, ncol=5, byrow=TRUE)
You can create a variable called ord ord <- seq_len(ncol(m))
Within the map function use the ord and the max(ord) to create some integers that will be used to subset the array.
Then rbinding the result with do.call(rbind)
Where m is the matrix
library(purrr)
do.call(rbind, map2(ord, nrow(m), \(x,y)
m[y, c(x:max(ord),
ord[- (x:max(ord))])]
)[c(1,rev(ord))]
)
[,1] [,2] [,3] [,4] [,5]
[1,] "a" "b" "c" "d" "e"
[2,] "e" "a" "b" "c" "d"
[3,] "d" "e" "a" "b" "c"
[4,] "c" "d" "e" "a" "b"
[5,] "b" "c" "d" "e" "a"
[6,] "a" "b" "c" "d" "e"
How to randomize values in an R matrix
For example, here is what I Would like to randomize
A, A, A, A, A
B, B, B, B, B
C, C, C, C, C
D, D, D, D, D
E, E, E, E, E
F, F, F, F, F
G, G, G, G, G
I'd recommend a random process that checks for dupes and reruns columns as needed.
myfunc <- function(nrow = 7, ncol = 4, iters = 500) {
m <- matrix("", nrow = nrow, ncol = ncol)
len <- seq_len(nrow)
m[,1] <- sample(LETTERS[len])
iter <- 0
for (col in seq_len(ncol)[-1]) {
iter <- iter + 1
if (iter > iters) break
m[,col] <- sample(LETTERS[len])
while (any(m[,col] == m[,-col])) {
iter <- iter + 1
if (iter > iters) break
m[,col] <- sample(LETTERS[len])
}
}
attr(m, "iter") <- iter
m
}
set.seed(42)
myfunc()
# [,1] [,2] [,3] [,4]
# [1,] "A" "B" "F" "D"
# [2,] "E" "G" "A" "C"
# [3,] "G" "C" "B" "A"
# [4,] "F" "A" "C" "G"
# [5,] "B" "D" "E" "F"
# [6,] "C" "E" "D" "B"
# [7,] "D" "F" "G" "E"
# attr(,"iter")
# [1] 69
I added the internal iter counting just so that we'd know how many times it took. And I added the iters limit so that it would not go on forever with ridiculous combinations; you'll know it hit the limit when one or more columns are empty strings "":
myfunc(7,7)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,] "D" "E" "G" "B" "A" "C" "G"
# [2,] "B" "A" "D" "G" "E" "F" "C"
# [3,] "C" "D" "F" "A" "G" "E" "E"
# [4,] "E" "B" "C" "D" "F" "A" "B"
# [5,] "F" "G" "E" "C" "B" "D" "F"
# [6,] "A" "C" "B" "F" "D" "G" "A"
# [7,] "G" "F" "A" "E" "C" "B" "D"
# attr(,"iter")
# [1] 501
myfunc(7,7)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,] "D" "E" "C" "F" "G" "B" ""
# [2,] "G" "D" "E" "A" "F" "C" ""
# [3,] "F" "A" "B" "G" "D" "A" ""
# [4,] "E" "B" "F" "D" "C" "D" ""
# [5,] "A" "C" "G" "B" "E" "E" ""
# [6,] "C" "F" "A" "E" "B" "F" ""
# [7,] "B" "G" "D" "C" "A" "G" ""
# attr(,"iter")
# [1] 502
Your shifting approach you may realize like so.
mapply(function(x, y) x[(seq(x) + y - 1) %% nrow(m)], as.data.frame(m), 1:ncol(m))
# V1 V2 V3 V4
# [1,] "A" "B" "C" "D"
# [2,] "B" "C" "D" "E"
# [3,] "C" "D" "E" "F"
# [4,] "D" "E" "F" "A"
# [5,] "E" "F" "A" "B"
# [6,] "F" "A" "B" "C"
Data:
m <- structure(c("A", "B", "C", "D", "E", "F", "G", "A", "B", "C",
"D", "E", "F", "G", "A", "B", "C", "D", "E", "F", "G", "A", "B",
"C", "D", "E", "F", "G"), .Dim = c(7L, 4L))
To get a deterministic permutation, create the matrix and fill it in using the row() and col() functions. For example,
rotated <- function(r, c, symbols = NULL) {
num <- max(r, c)
m <- matrix(NA, r, c)
m <- (row(m) + col(m) - 2) %% num + 1
if (!is.null(symbols)) {
m <- symbols[m]
dim(m) <- c(r,c)
}
m
}
rotated(7, 4, LETTERS)
#> [,1] [,2] [,3] [,4]
#> [1,] "A" "B" "C" "D"
#> [2,] "B" "C" "D" "E"
#> [3,] "C" "D" "E" "F"
#> [4,] "D" "E" "F" "G"
#> [5,] "E" "F" "G" "A"
#> [6,] "F" "G" "A" "B"
#> [7,] "G" "A" "B" "C"
Created on 2020-10-07 by the reprex package (v0.3.0)
If you want it randomized, permute rows and columns randomly:
rotated(7, 4, LETTERS)[sample(7), sample(4)]
#> [,1] [,2] [,3] [,4]
#> [1,] "B" "D" "C" "A"
#> [2,] "F" "A" "G" "E"
#> [3,] "E" "G" "F" "D"
#> [4,] "A" "C" "B" "G"
#> [5,] "G" "B" "A" "F"
#> [6,] "C" "E" "D" "B"
#> [7,] "D" "F" "E" "C"
Consider a vector:
dim <- c("a", "b", "c", "d")
I want to be able to create versions of the vector by dropping some variables and then using the updated vector for my loop.
For eg:
I want it to iterate to all possible vectors that can results from this:
dim <- c("a", "b", "d")
So on and so forth. Could I do this in a loop or someway that I do not have to specify anything. Order doesn't matter, so I do not want a,b,c and c,a,b
You can get this with:
dim <- c("a", "b", "c", "d")
> Map(combn, list(dim), 1:length(dim))
[[1]] # All combinations of size 1
[,1] [,2] [,3] [,4]
[1,] "a" "b" "c" "d"
[[2]] # All combinations of size 2
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] "a" "a" "a" "b" "b" "c"
[2,] "b" "c" "d" "c" "d" "d"
[[3]] # All combinations of size 3
[,1] [,2] [,3] [,4]
[1,] "a" "a" "a" "b"
[2,] "b" "b" "c" "c"
[3,] "c" "d" "d" "d"
[[4]] # All combinations of size 4
[,1]
[1,] "a"
[2,] "b"
[3,] "c"
[4,] "d"
if you are looking for all combinations of dim you can check out the function combn from the combinat package:
combinat::combn(letters[1:4], 1, simplify = F)
[[1]]
[1] "a"
[[2]]
[1] "b"
[[3]]
[1] "c"
[[4]]
[1] "d"
combinat::combn(letters[1:4], 2, simplify = F)
combinat::combn(letters[1:4], 3, simplify = F)
combinat::combn(letters[1:4], 4, simplify = F)
In base R I would use either of the for-loop, sapply or lapply
for-loop
for (i in seq_along(dim)) {
print(dim[-i])
}
[1] "b" "c" "d"
[1] "a" "c" "d"
[1] "a" "b" "d"
[1] "a" "b" "c"
sapply
t( sapply(seq_along(dim), function(i) dim[-i]) )
[,1] [,2] [,3]
[1,] "b" "c" "d"
[2,] "a" "c" "d"
[3,] "a" "b" "d"
[4,] "a" "b" "c"
lapply
lapply(seq_along(dim), function(i) dim[-i])
[[1]]
[1] "b" "c" "d"
[[2]]
[1] "a" "c" "d"
[[3]]
[1] "a" "b" "d"
[[4]]
[1] "a" "b" "c"
I have following input data:
# [,1] [,2]
#[1,] "A" "B"
#[2,] "A" "C"
#[3,] "A" "D"
#[4,] "B" "C"
#[5,] "B" "D"
#[6,] "C" "D"
Next I want to exclude rows where first or second element has been previously for N times. For example if N = 2 then need to exclude following rows:
#[3,] "A" "D" - element "A" has been 2 times
#[5,] "B" "D" - element "B" has been 2 times
#[6,] "C" "D" - element "C" has been 2 times
Note: Need to take into account excluding results immediately. For example if element has met 5 times and after removing it met only 1 times then need to leave next row with this element. Because now it meets 2 times.
Example (N=2):
Input data:
[,1] [,2]
[1,] "A" "B"
[2,] "A" "C"
[3,] "A" "D"
[4,] "A" "E"
[5,] "B" "C"
[6,] "B" "D"
[7,] "B" "E"
[8,] "C" "D"
[9,] "C" "E"
[10,] "D" "E"
Output data:
[,1] [,2]
[1,] "A" "B"
[2,] "A" "C"
[5,] "B" "C"
[10,] "D" "E"
There are possibly more elegant solutions... but this seems to work:
v <- c("A", "B", "C", "D", "E")
cmb <- t(combn(v, 2))
n <- 2
# Go through each letter
for (l in v)
{
# Find the combinations using that letter
rows <- apply(cmb, 1, function(x){l %in% x})
rows.2 <- which(rows==T)
if (length(rows.2)>n)
rows.2 <- rows.2[1:n]
# Take the first n rows containing the letter,
# then append all the ones not containing it
cmb <- rbind(cmb[rows.2,], cmb[rows==F,])
}
cmb
which outputs:
[,1] [,2]
[1,] "D" "E"
[2,] "B" "C"
[3,] "A" "C"
[4,] "A" "B"
I'm trying to create a list of permutations of a list, such that, for example, perms(list("a", "b", "c")) returns
list(list("a", "b", "c"), list("a", "c", "b"), list("b", "a", "c"),
list("b", "c", "a"), list("c", "a", "b"), list("c", "b", "a"))
I'm not sure how to proceed, any help would be greatly appreciated.
A while back I had to do this in base R without loading any packages.
permutations <- function(n){
if(n==1){
return(matrix(1))
} else {
sp <- permutations(n-1)
p <- nrow(sp)
A <- matrix(nrow=n*p,ncol=n)
for(i in 1:n){
A[(i-1)*p+1:p,] <- cbind(i,sp+(sp>=i))
}
return(A)
}
}
Usage:
> matrix(letters[permutations(3)],ncol=3)
[,1] [,2] [,3]
[1,] "a" "b" "c"
[2,] "a" "c" "b"
[3,] "b" "a" "c"
[4,] "b" "c" "a"
[5,] "c" "a" "b"
[6,] "c" "b" "a"
combinat::permn will do that work:
> library(combinat)
> permn(letters[1:3])
[[1]]
[1] "a" "b" "c"
[[2]]
[1] "a" "c" "b"
[[3]]
[1] "c" "a" "b"
[[4]]
[1] "c" "b" "a"
[[5]]
[1] "b" "c" "a"
[[6]]
[1] "b" "a" "c"
Note that calculation is huge if the element is large.
base R can also provide the answer:
all <- expand.grid(p1 = letters[1:3], p2 = letters[1:3], p3 = letters[1:3], stringsAsFactors = FALSE)
perms <- all[apply(all, 1, function(x) {length(unique(x)) == 3}),]
You can try permutations() from the gtools package, but unlike permn() from combinat, it doesn't output a list:
> library(gtools)
> permutations(3, 3, letters[1:3])
[,1] [,2] [,3]
[1,] "a" "b" "c"
[2,] "a" "c" "b"
[3,] "b" "a" "c"
[4,] "b" "c" "a"
[5,] "c" "a" "b"
[6,] "c" "b" "a"
A solution in base R, no dependencies on other packages:
> getPermutations <- function(x) {
if (length(x) == 1) {
return(x)
}
else {
res <- matrix(nrow = 0, ncol = length(x))
for (i in seq_along(x)) {
res <- rbind(res, cbind(x[i], Recall(x[-i])))
}
return(res)
}
}
> getPermutations(letters[1:3])
[,1] [,2] [,3]
[1,] "a" "b" "c"
[2,] "a" "c" "b"
[3,] "b" "a" "c"
[4,] "b" "c" "a"
[5,] "c" "a" "b"
[6,] "c" "b" "a"
I hope this helps.
# Another recursive implementation
# for those who like to roll their own, no package required
permutations <- function( x, prefix = c() )
{
if(length(x) == 0 ) return(prefix)
do.call(rbind, sapply(1:length(x), FUN = function(idx) permutations( x[-idx], c( prefix, x[idx])), simplify = FALSE))
}
permutations(letters[1:3])
# [,1] [,2] [,3]
#[1,] "a" "b" "c"
#[2,] "a" "c" "b"
#[3,] "b" "a" "c"
#[4,] "b" "c" "a"
#[5,] "c" "a" "b"
#[6,] "c" "b" "a"
Try:
> a = letters[1:3]
> eg = expand.grid(a,a,a)
> eg[!(eg$Var1==eg$Var2 | eg$Var2==eg$Var3 | eg$Var1==eg$Var3),]
Var1 Var2 Var3
6 c b a
8 b c a
12 c a b
16 a c b
20 b a c
22 a b c
As suggested by #Adrian in comments, last line can be replaced by:
eg[apply(eg, 1, anyDuplicated) == 0, ]
A fun solution "probabilistic" using sample for base R:
elements <- c("a", "b", "c")
k <- length(elements)
res=unique(t(sapply(1:200, function(x) sample(elements, k))))
# below, check you have all the permutations you need (if not, try again)
nrow(res) == factorial(k)
res
basically you call many random samples, hoping to get them all, and you unique them.
We can use base function combn with a little modifcation:
combn_n <- function(x) {
m <- length(x) - 1 # number of elements to choose: n-1
xr <- rev(x) # reversed x
part_1 <- rbind(combn(x, m), xr, deparse.level = 0)
part_2 <- rbind(combn(xr, m), x, deparse.level = 0)
cbind(part_1, part_2)
}
combn_n(letters[1:3])
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] "a" "a" "b" "c" "c" "b"
[2,] "b" "c" "c" "b" "a" "a"
[3,] "c" "b" "a" "a" "b" "c"
Behold, the purrr 🐾 solution:
> map(1:3, ~ c('a', 'b', 'c')) %>%
cross() %>%
keep(~ length(unique(.x)) == 3) %>%
map(unlist)
#> [[1]]
#> [1] "c" "b" "a"
#>
#> [[2]]
#> [1] "b" "c" "a"
#>
#> [[3]]
#> [1] "c" "a" "b"
#>
#> [[4]]
#> [1] "a" "c" "b"
#>
#> [[5]]
#> [1] "b" "a" "c"
#>
#> [[6]]
#> [1] "a" "b" "c"
In case this helps, there is the "arrangements" package, that allows you to simply do :
> abc = letters[1:3]
> permutations(abc)
[,1] [,2] [,3]
[1,] "a" "b" "c"
[2,] "a" "c" "b"
[3,] "b" "a" "c"
[4,] "b" "c" "a"
[5,] "c" "a" "b"
[6,] "c" "b" "a"
A generic version of rnso's answer is:
get_perms <- function(x){
stopifnot(is.atomic(x)) # for the matrix call to make sense
out <- as.matrix(expand.grid(
replicate(length(x), x, simplify = FALSE), stringsAsFactors = FALSE))
out[apply(out,1, anyDuplicated) == 0, ]
}
Here are two examples:
get_perms(letters[1:3])
#R> Var1 Var2 Var3
#R> [1,] "c" "b" "a"
#R> [2,] "b" "c" "a"
#R> [3,] "c" "a" "b"
#R> [4,] "a" "c" "b"
#R> [5,] "b" "a" "c"
#R> [6,] "a" "b" "c"
get_perms(letters[1:4])
#R> Var1 Var2 Var3 Var4
#R> [1,] "d" "c" "b" "a"
#R> [2,] "c" "d" "b" "a"
#R> [3,] "d" "b" "c" "a"
#R> [4,] "b" "d" "c" "a"
#R> [5,] "c" "b" "d" "a"
#R> [6,] "b" "c" "d" "a"
#R> [7,] "d" "c" "a" "b"
#R> [8,] "c" "d" "a" "b"
#R> [9,] "d" "a" "c" "b"
#R> [10,] "a" "d" "c" "b"
#R> [11,] "c" "a" "d" "b"
#R> [12,] "a" "c" "d" "b"
#R> [13,] "d" "b" "a" "c"
#R> [14,] "b" "d" "a" "c"
#R> [15,] "d" "a" "b" "c"
#R> [16,] "a" "d" "b" "c"
#R> [17,] "b" "a" "d" "c"
#R> [18,] "a" "b" "d" "c"
#R> [19,] "c" "b" "a" "d"
#R> [20,] "b" "c" "a" "d"
#R> [21,] "c" "a" "b" "d"
#R> [22,] "a" "c" "b" "d"
#R> [23,] "b" "a" "c" "d"
#R> [24,] "a" "b" "c" "d"
One can also slightly alter Rick's answer by using lapply, only doing a single rbind, and reduce the number of [s]/[l]apply calls:
permutations <- function(x, prefix = c()){
if(length(x) == 1) # was zero before
return(list(c(prefix, x)))
out <- do.call(c, lapply(1:length(x), function(idx)
permutations(x[-idx], c(prefix, x[idx]))))
if(length(prefix) > 0L)
return(out)
do.call(rbind, out)
}
What about
pmsa <- function(l) {
pms <- function(n) if(n==1) return(list(1)) else unlist(lapply(pms(n-1),function(v) lapply(0:(n-1),function(k) append(v,n,k))),recursive = F)
lapply(pms(length(l)),function(.) l[.])
}
This gives a list. Then
pmsa(letters[1:3])