I want to extract specific elements column wise from the matrix A with the information from a character vector B (contain elements in the row names of the matrix) such as:
A <- matrix(seq(1,12),ncol=4)
rownames(A) <- letters[1:3]
A
[,1] [,2] [,3] [,4]
a 1 4 7 10
b 2 5 8 11
c 3 6 9 12
B <- c("a","c","c","b")
I want to get 1,6,9,11. Thanks :)
Two possible ways:
> A[cbind(match(B, rownames(A)), seq_len(ncol(A)))]
[1] 1 6 9 11
>
> diag(A[B, seq_along(B)]) # or diag(A[B, seq_len(ncol(A))])
[1] 1 6 9 11
I have a large set of size M (let's say 10), and I want to, repeatedly for a certain number of occasions (let's say 13), randomly split it into M/N smaller groups of size N (let's say 2). I'd like no element in the large set to be in a repeating group until they have been in a small group with every one else. (The actual problem here: I have a class of 10 people and I want to split them into 5 pairs for a duration of 13 weeks, but I don't want anyone to be in a repeat pairing until they have been in a pairing with everyone in the class.)
How can I do this? I started by [generating non-repeating permutations from my larger group][1], but the trouble I am having is that these unique permutations don't necessarily yield unique groups. (Someone seems to have posed this same question, but [it was resolved in Python][2]. I don't understand Python, and so I'm looking for an easy R solution.)
Any help much appreciated.
Edit: Thanks to all for suggestions. I realize my original question wasn't exactly clear. The solutions suggested below work well when I only want to split the set into a single subset of size N, each time. But my problem is actually that I want to split the set into M/N subsets of size N. For example, in the case of my class, I want to split the 10 students into 5 pairs of 2 on 13 different occasions, and I want pairs to be unique until they no longer can be (i.e., after 9 occasions have passed). Unless I'm failing to see how they can be applied, I don't think any of these solutions quite solves this problem.
I see that the OP has provided a solution from the linked math.so solution, but I would like to provide a working solution of the other answer on that page that gets to the heart of this problem. That solution mentions Round-robin tournament. From the wikipedia page, the algorithm is straightforward.
One simply fixes a position in a matrix and rotates the other indices clockwise. Given M initial players, there are M - 1 unique rounds. Thus, for our given situation, we can only obtain 9 unique sets of groups.
Below, is a very straightforward base R implementation:
roll <- function( x , n ){
if( n == 0 )
return(x)
c(tail(x,n), head(x,-n))
}
RoundRobin <- function(m, n) {
m <- as.integer(m)
n <- as.integer(n)
if (m %% 2L != 0L) {
m <- m + 1L
}
myRounds <- list(n)
myRounds[[1]] <- 1:m
for (i in 2:n) {
myRounds[[i]] <- myRounds[[i - 1L]]
myRounds[[i]][2:m] <- roll(myRounds[[i]][-1], 1)
}
lapply(myRounds, matrix, nrow = 2)
}
The roll function was obtained from this answer.
Here is sample output for 10 students and 4 weeks:
RoundRobin(10, 4)
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 5 7 9
[2,] 2 4 6 8 10
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 2 4 6 8
[2,] 10 3 5 7 9
[[3]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 10 3 5 7
[2,] 9 2 4 6 8
[[4]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 9 2 4 6
[2,] 8 10 3 5 7
When we hit the 10th week, we see our first repeat "round".
RoundRobin(10, 13)[c(1, 2, 9, 10, 11)]
[[1]]
[,1] [,2] [,3] [,4] [,5] ## <- first week
[1,] 1 3 5 7 9
[2,] 2 4 6 8 10
[[2]]
[,1] [,2] [,3] [,4] [,5] ## <- second week
[1,] 1 2 4 6 8
[2,] 10 3 5 7 9
[[3]]
[,1] [,2] [,3] [,4] [,5] ## <- ninth week
[1,] 1 4 6 8 10
[2,] 3 5 7 9 2
[[4]]
[,1] [,2] [,3] [,4] [,5] ## <- tenth week
[1,] 1 3 5 7 9
[2,] 2 4 6 8 10
[[5]]
[,1] [,2] [,3] [,4] [,5] ## <- eleventh week
[1,] 1 2 4 6 8
[2,] 10 3 5 7 9
Note, this is a deterministic algorithm and given the simplicity, it is pretty efficient. E.g. if you have 1000 students and want to find all 999 unique pairings, you can run this function without fear:
system.time(RoundRobin(1000, 999))
user system elapsed
0.038 0.001 0.039
I think you maybe want something like this. It will produce a data frame with the unique combinations in rows. These are sampled randomly until all unique combinations are exhausted. Thereafter, if more samples are required it will sample randomly with replacement from unique combinations:
create_groups <- function(M, N, samples)
{
df <- seq(N) %>%
lapply(function(x) M) %>%
do.call(expand.grid, .) %>%
apply(1, sort) %>%
t() %>%
as.data.frame() %>%
unique()
df <- df[apply(df, 1, function(x) !any(duplicated(x))), ]
df <- df[sample(nrow(df)), ]
if(samples <= nrow(df)) return(df[seq(samples), ])
rbind(df, df[sample(seq(nrow(df)), samples - nrow(df), TRUE), ])
}
It's easy to see how it works if we want groups of 4 elements from 5 objects (there are only 5 possible combinations):
create_groups(letters[1:5], 4, 5)
#> V1 V2 V3 V4
#> 1 a b d e
#> 2 a b c d
#> 3 a c d e
#> 4 b c d e
#> 5 a b c e
We have a randomly-ordered sample of 4 objects drawn from the set, but no repeats. (the elements within each sample are ordered alphabetically however)
If we want more than 5 samples, the algorithm ensures that all unique combinations are exhausted before resampling:
create_groups(letters[1:5], 4, 6)
#> V1 V2 V3 V4
#> 1 a b c e
#> 2 a c d e
#> 3 a b d e
#> 4 b c d e
#> 5 a b c d
#> 6 a b d e
Here we see there are no repeated rows until row 6, which is a repeat of row 3.
For the example in your question, there are 45 unique combinations of 2 elements drawn from 10 objects, so we get no repeats in our 13 samples:
create_groups(1:10, 2, 13)
#> V1 V2
#> 1 7 8
#> 2 4 10
#> 3 2 8
#> 4 3 10
#> 5 3 9
#> 6 1 8
#> 7 4 9
#> 8 8 9
#> 9 7 9
#> 10 4 6
#> 11 5 7
#> 12 9 10
#> 13 4 7
I am not sure combn + sample can work for your goal
as.data.frame(t(combn(M, N))[sample(K <- choose(length(M), N), i, replace = K < i), ])
which gives
V1 V2
1 4 9
2 4 8
3 1 9
4 6 10
5 5 9
6 2 10
7 3 7
8 7 8
9 6 7
10 1 7
11 6 8
12 5 6
13 3 8
With apologies to all for not writing a clear question, here is a solution based on the solution suggested in this post. (Depending on the seed, it can get stuck, and if weeks are larger, the code to recycle old groups has to be adjusted a little.)
set.seed(1)
m<-10
n<-2
weeks<-13
groupmat<-combn(m,n)
students <- c(1:m)
pickedpairs <- matrix(
data=NA,
nrow=n,
ncol=0
)
while( ncol(pickedpairs) < ((m-1)*(m/n)) ) {
thisweekspairs <- matrix(sample(students),nrow=n,ncol=m/n)
#check if this weeks pairs
#are already in pickedpairs
#if so, skip iteration
pairsprez <- lapply(1:ncol(thisweekspairs),function(j) {
#j<-1
apply(pickedpairs,2,function(x) sum(x%in%thisweekspairs[,j])==n)
}) %>% Reduce(f="|") %>% sum
if(pairsprez>=1) {
pickedpairs<<-pickedpairs
} else {
pickedpairs<<-cbind(pickedpairs,thisweekspairs)
}
print(ncol(pickedpairs))
}
uniquepairs <- lapply(1:(ncol(pickedpairs)/(m/n)),function(i) {
pickedpairs[,(1 + (m/n)*(i-1)):((m/n)*i)]
})
#generate weeks' number of unique pairs
combine(
uniquepairs,
uniquepairs[sample(1:length(uniquepairs),weeks-length(uniquepairs))]
)
We could use slice_sample with combn
library(dplyr)
library(purrr)
combn(M, N, simplify = FALSE) %>%
invoke(rbind, .) %>%
as_tibble %>%
slice_sample(n = i)
# A tibble: 13 x 2
# V1 V2
# <int> <int>
# 1 4 5
# 2 3 8
# 3 9 10
# 4 5 7
# 5 8 9
# 6 3 9
# 7 5 10
# 8 4 10
# 9 2 5
#10 5 6
#11 6 9
#12 2 7
#13 4 9
Consider the following data:
x <- c(2, 4, 6, 8)
mean(x)
[1] 5
Now I want do draw 2 observations. This gives me 6 combinations. I want to calculate the mean for all 6 combinations, and the mean of these 6 values. That is, I should get the following means:
(2+4)/2 = 3
(2+6)/2 = 4
(2+8)/2 = 5
(4+6)/2 = 5
(4+8)/2 = 6
(6+8)/2 = 7
I know the order could be different from the above, but it should each time give me an average 5 (in the case above: (3+4+5+5+6+7)/6 = 5).
Can anyone help me?
One Line answer:
mean(rowMeans(t(combn(x,2))))
explained step by step:
with 'draw 2 observations' you actually mean to select 2 objects/observations out of x:
x <- c(2, 4, 6, 8)
combn(x, 2)
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 2 2 2 4 4 6
## [2,] 4 6 8 6 8 8
with t() you can transform it to:
t(combn(x,2))
## [,1] [,2]
## [1,] 2 4
## [2,] 2 6
## [3,] 2 8
## [4,] 4 6
## [5,] 4 8
## [6,] 6 8
The means you can calculate by rowMeans()
rowMeans(t(combn(x,2)))
## [1] 3 4 5 5 6 7
If you calculate the mean of that, you get what you want.
mean(rowMeans(t(combn(x,2))))
## [1] 5
I think OP was going in right-direction to use sample in order to draw 2 observations n times (as title suggests). But somehow angle of solution changed towards combn function (which is not a correct option).
An option is to use sample along with replicate as:
x <- c(2, 4, 6, 8)
mean(replicate(6, sample(x,2)))
#[1] 4.666667 #There is random-ness in set of observations selected.
In above attempt, replicate provides 6 sets of 2 observations as:
replicate(6, sample(x,2))
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 2 4 4 4 8 8
# [2,] 6 2 2 8 6 2
Personally, I dont think combn is a correct option to use here. combn returns all possible combination of selected number of observations. That means, every observation (of x) will appear equal number of times in combination set received from combn function. This implies, that mean of combn(x,2) will be same as mean(x). Hence, what's point using combn in this case.
I have a matrix
[,1] [,2]
[1,] 2 3
[2,] 3 5
[3,] 7 9
[4,] 11 3
[5,] 11 8
and I want to merge row 1 2 4 5 by their common value.
the result should be output
2 3 5 11 8
Test case:
m <- matrix(c(2,3,7,11,11,3,5,9,3,8),ncol=2)
I'm not sure this is what you want, but it gives the right answer:
unique(c(t(m[c(1,2,4,5),])))
Only two tricky bits here:
need to use c() to collapse the matrix into a single vector
need to use t() to get the matrix collapsed row-wise rather than column-wise to get the ordering as you specified.
This question already has answers here:
Get the row and column name of the minimum element of a matrix
(2 answers)
Closed 5 years ago.
I wish to find the maximum element-value of a matrix and it's location (in row and column id in the matrix).
I am using the following function to return the row and column of the matrix.
This seems like a bad hack -- it's the sort of thing where i'm probably missing a native method. Is there a better / more R way?
Here's my function:
matxMax <- function(mtx)
{
colmn <- which(mtx == max(mtx)) %/% nrow(mtx) + 1
row <- which(mtx == max(mtx)) %% nrow(mtx)
return( matrix(c(row, colmn), 1))
}
I use is as follows:
mm <- matrix(rnorm(100), 10, 10)
maxCords <- matxMax(mm)
mm[maxCords]
You could do
## Some data
set.seed(123)
mm <- matrix(rbinom(40, 20, 0.5), 8, 5)
mm
# [,1] [,2] [,3] [,4] [,5]
# [1,] 9 10 8 11 11
# [2,] 12 10 6 11 12
# [3,] 9 14 9 10 6
# [4,] 13 10 14 11 10
# [5,] 13 11 13 9 12
# [6,] 6 10 11 8 8
# [7,] 10 7 11 14 9
# [8,] 13 13 16 13 8
which(mm == max(mm), arr.ind = TRUE)
# row col
# [1,] 8 3