This question already has answers here:
How to generate permutations or combinations of object in R?
(3 answers)
Closed 2 years ago.
I'm trying to create an efficient function to generate all monotonically increasing permutations of a large vector. Obviously, reducing the outputs from expand.grid or gtools::permutations works, but only for smaller vectors.
Example:
x = 1:3
Desired output:
1, 1, 1
1, 1, 2
1, 1, 3
1, 2, 2
1, 2, 3
1, 3, 3
2, 2, 2
2, 2, 3
2, 3, 3
3, 3, 3
Any suggestions using base R or, existing packages with this capability?
EDIT: An ideal solution would avoid generating the complete set of permutations to then subset.
Using data.table this is fairly easy:
expand.monotonic <- function(x, len=length(x)){
do.call(CJ, lapply(integer(len), function(...) x ))[
eval(parse(text=paste0("V", 2:len, ">=", "V", 1:(len-1), collapse="&") )), ]
}
expand.monotonic(1:3)
V1 V2 V3
1: 1 1 1
2: 1 1 2
3: 1 1 3
4: 1 2 2
5: 1 2 3
6: 1 3 3
7: 2 2 2
8: 2 2 3
9: 2 3 3
10: 3 3 3
explanation:
First create a list containing the replicated vector len times, Use data.table::CJ to cross join all the vectors. And this is where the magic happens based on the len create an expression basically V2>=V1&V3>=V2 as V# is the default name for unnamed columns, and subset by the result of evaluating said expression.
parse(text=paste0("V", 2:len, ">=", "V", 1:(len-1), collapse="&") )
# expression(V2>=V1&V3>=V2)
Here's some code which creates permutations with repeats allowed as in your example, and detects whether each permutation is monotonic
x <- 1:3
# Generate permutations of length x
out <- gtools::permutations(length(x), length(x), v = x, repeats.allowed=TRUE)
# Detect if they're monotonic
mono <- apply(out, 1, function(x) { all(x == cummax(x)) })
output_with_monotonic_label <- cbind(out, mono)
# output_with_monotonic_label
# mono
# [1,] 1 1 1 1
# [2,] 1 1 2 1
# [3,] 1 1 3 1
# [4,] 1 2 1 0
# [5,] 1 2 2 1
# [6,] 1 2 3 1
# [7,] 1 3 1 0
# [8,] 1 3 2 0
# [9,] 1 3 3 1
# [10,] 2 1 1 0
# ....
Related
This question already has an answer here:
Sort vector into repeating sequence when sequential values are missing R
(1 answer)
Closed 6 months ago.
I want to convert a vector:
1 1 2 2 3 3
to
1 2 3 1 2 3
How to do it? Many thanks.
You can use a matrix to layout the original vector by rows and then convert it back to a vector to get the desired result.
v = c(1,1,2,2,3,3)
v2 = as.vector(matrix(v, nrow = length(unique(v)), byrow = T))
> v2
[1] 1 2 3 1 2 3
The length(unique(v)) is there to generalize how many rows the matrix should have and not hardcode a 3.
Another example:
v = c(1,1,1,2,2,2,3,3,3,4,4,4)
v2 = as.vector(matrix(v, nrow = length(unique(v)), byrow = T))
v2
[1] 1 2 3 4 1 2 3 4 1 2 3 4
We can use rbind/split
c(do.call(rbind, split(v1, v1)))
#[1] 1 2 3 1 2 3
Or if there are unequal number of replications of each element, get the order of the rowid
library(data.table)
v1[order(rowid(v1))]
#[1] 1 2 3 1 2 3
Or with base R
v1[order(ave(v1, v1, FUN = seq_along))]
#[1] 1 2 3 1 2 3
data
v1 <- c(1, 1, 2, 2, 3, 3)
vec <- c(1, 1, 2, 2, 3, 3)
rep(unique(vec), 2)
[1] 1 2 3 1 2 3
I am hoping to create a matrix that shows a count of instances of overlapping values for a grouping variable based on a second variable. Specifically, I am hoping to determine the degree to which primary studies overlap across meta-analyses in order to create a network diagram.
So, in this example, I have three meta-analyses that include some portion of three primary studies.
df <- data.frame(metas = c(1,1,1,2,3,3), studies = c(1,3,2,1,2,3))
metas studies
1 1 1
2 1 3
3 1 2
4 2 1
5 3 2
6 3 3
I would like it to return:
v1 v2 v3
1 3 1 2
2 1 1 0
3 2 0 2
The value in row 1, column 1 indicates that Meta-analysis 1 had three studies in common with itself (i.e., it included three studies). Row 1, column 2 indicates that Meta-analysis 1 had one study in common with Meta-analysis 2. Row 1, column 3 indicates that Meta-analysis 1 had two studies in common with Meta-analysis 3.
I believe you are looking for a symmetric matrix of intersecting studies.
dfspl <- split(df$studies, df$metas)
out <- outer(seq_along(dfspl), seq_along(dfspl),
function(a, b) lengths(Map(intersect, dfspl[a], dfspl[b])))
out
# [,1] [,2] [,3]
# [1,] 3 1 2
# [2,] 1 1 0
# [3,] 2 0 2
If you need names on them, you can go with the names as defined by df$metas:
rownames(out) <- colnames(out) <- names(dfspl)
out
# 1 2 3
# 1 3 1 2
# 2 1 1 0
# 3 2 0 2
If you need the names defined as v plus the meta name, go with
rownames(out) <- colnames(out) <- paste0("v", names(dfspl))
out
# v1 v2 v3
# v1 3 1 2
# v2 1 1 0
# v3 2 0 2
If you need to understand what this is doing, outer creates an expansion of the two argument vectors, and passes them all at once to the function. For instance,
outer(seq_along(dfspl), seq_along(dfspl), function(a, b) { browser(); 1; })
# Called from: FUN(X, Y, ...)
debug at #1: [1] 1
# Browse[2]>
a
# [1] 1 2 3 1 2 3 1 2 3
# Browse[2]>
b
# [1] 1 1 1 2 2 2 3 3 3
# Browse[2]>
What we ultimately want to do is find the intersection of each pair of studies.
dfspl[[1]]
# [1] 1 3 2
dfspl[[3]]
# [1] 2 3
intersect(dfspl[[1]], dfspl[[3]])
# [1] 3 2
length(intersect(dfspl[[1]], dfspl[[3]]))
# [1] 2
Granted, we are doing it twice (once for 1 and 3, once for 3 and 1, which is the same result), so this is a little inefficient ... it would be better to filter them to only look at the upper or lower half and transferring it to the other.
Edited for a more efficient process (only calculating each intersection pair once, and never calculating self-intersection.)
eg <- expand.grid(a = seq_along(dfspl), b = seq_along(dfspl))
eg <- eg[ eg$a < eg$b, ]
eg
# a b
# 4 1 2
# 7 1 3
# 8 2 3
lens <- lengths(Map(intersect, dfspl[eg$a], dfspl[eg$b]))
lens
# 1 1 2 ## btw, these are just names, from eg$a
# 1 2 0
out <- matrix(nrow = length(dfspl), ncol = length(dfspl))
out[ cbind(eg$a, eg$b) ] <- lens
out
# [,1] [,2] [,3]
# [1,] NA 1 2
# [2,] NA NA 0
# [3,] NA NA NA
out[ lower.tri(out) ] <- out[ upper.tri(out) ]
diag(out) <- lengths(dfspl)
out
# [,1] [,2] [,3]
# [1,] 3 1 2
# [2,] 1 1 0
# [3,] 2 0 2
Same idea as #r2evans, also Base R (and a bit less eloquent) (edited as required):
# Create df using sample data:
df <- data.frame(metas = c(1,1,1,2,3,3), studies = c(1,7,2,1,2,3))
# Test for equality between the values in the metas vector and the rest of
# of the values in the dataframe -- Construct symmetric matrix from vector:
m1 <- diag(v1); m1[,1] <- m1[1,] <- v1 <- rowSums(data.frame(sapply(df$metas, `==`,
unique(unlist(df)))))
# Coerce matrix to dataframe setting the names as desired; dropping non matches:
df_2 <- setNames(data.frame(m1[which(rowSums(m1) > 0), which(colSums(m1) > 0)]),
paste0("v", 1:ncol(m1[which(rowSums(m1) > 0), which(colSums(m1) > 0)])))
I would like to list all unique combinations of vectors of length 3 where each element of the vector can range between 1 to 9.
First I list all such combinations:
df <- expand.grid(1:9, 1:9, 1:9)
Then I would like to remove the rows that contain repetitions.
For example:
1 1 9
9 1 1
1 9 1
should only be included once.
In other words if two lines have the same numbers and the same number of each number then it should only be included once.
Note that
8 8 8 or
9 9 9 is fine as long as it only appears once.
Based on your approach and the idea to remove repetitions:
df <- expand.grid(1:2, 1:2, 1:2)
# Var1 Var2 Var3
# 1 1 1 1
# 2 2 1 1
# 3 1 2 1
# 4 2 2 1
# 5 1 1 2
# 6 2 1 2
# 7 1 2 2
# 8 2 2 2
df2 <- unique(t(apply(df, 1, sort))) #class matrix
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 1 1 2
# [3,] 1 2 2
# [4,] 2 2 2
df2 <- as.data.frame(df2) #class data.frame
There are probably more efficient methods, but if I understand you correct, that is the result you want.
Maybe something like this (since your data frame is not large, so it does not pain!):
len <- apply(df,1,function(x) length(unique(x)))
res <- rbind(df[len!=2,], df[unique(apply(df[len==2,],1,prod)),])
Here is what is done:
Get the number of unique elements per row
Comprises two steps:
First argument of rbind: Those with length either 1 (e.g. 1 1 1, 7 7 7, etc) or 3 (e.g. 5 8 7, 2 4 9, etc) are included in the final results res.
Second argument of rbind: For those in which the number of unique elements are 2 (e.g. 1 1 9, 3 5 3, etc), we apply product per row and take whose unique products (cause, for example, the product of 3 3 5 and 3 5 3 and 5 3 3 are the same)
I have 6 digits (1, 2, 3, 4, 5, 6), and I need to create all possible combinations (i.e. 6*5*4*3*2*1 = 720 combinations) in which no number can be used twice and O is not allowed. I would like to obtain combinations like: 123456, 246135, 314256, etc.
Is there a way to create them with Matlab or R? Thank you.
In Matlab you can use
y = perms(1:6);
This gives a numerical 720×6 array y, where each row is a permutation:
y =
6 5 4 3 2 1
6 5 4 3 1 2
6 5 4 2 3 1
6 5 4 2 1 3
6 5 4 1 2 3
···
If you want the result as a char array:
y = char(perms(1:6)+'0');
which produces
y =
654321
654312
654231
654213
654123
···
In R:
library(combinat)
p <- permn(1:6)
gives you a list; do.call(rbind, p) or matrix(unlist(p), ncol=6, byrow=TRUE) will give a numeric array; sapply(p,paste,collapse="") gives a vector of strings.
Here's a base R 'solution':
p <- unique(t(replicate(100000, sample(6,6), simplify="vector")))
nrow(p)
#> [1] 720
head(p)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 3 5 4 2 1 6
#> [2,] 6 3 5 4 1 2
#> [3,] 5 1 6 2 3 4
#> [4,] 6 5 3 2 4 1
#> [5,] 5 2 3 6 4 1
#> [6,] 1 4 2 5 6 3
It's a hack of course, and this potentially only applies to the example given, but sometimes it's useful to do things in silly ways... this takes an excessive number of samples (without replacement) of the vector 1:6, then removes any duplicates. It does indeed produce the unique 720 results, but they're not sorted.
A base R approach is
x <- do.call(expand.grid, rep(list(1:6), 6))
x <- x[apply(x, MAR = 1, function(x) length(unique(x)) == 6), ]
which creates a matrix with 6^6 rows, then retains only rows that contain all 6 numbers.
I'm looking for a way to count the frequency of each element in a vector.
ex <- c(2,2,2,3,4,5)
Desired outcome:
[1] 3 3 3 1 1 1
Is there a simple command for this?
rep(table(ex), table(ex))
# 2 2 2 3 4 5
# 3 3 3 1 1 1
If you don't want the labels you can wrap in as.vector()
as.vector(rep(table(ex), table(ex)))
# [1] 3 3 3 1 1 1
I'll add (because it seems related somehow) that if you only wanted consecutive values, you could use rle instead of table:
ex2 = c(2, 2, 2, 3, 4, 2, 2, 3, 4, 4)
rep(rle(ex2)$lengths, rle(ex2)$lengths)
# [1] 3 3 3 1 1 2 2 1 2 2
As pointed out in comments, for a large vector calculating a table can be expensive, so doing it only once is more efficient:
tab = table(ex)
rep(tab, tab)
# 2 2 2 3 4 5
# 3 3 3 1 1 1
You can use
ex <- c(2,2,2,3,4,5)
outcome <- ave(ex, ex, FUN = length)
This is what thelatemail suggested. Also similar to the answer at this question