N permutations of only some elements in a vector

2
votes

Can someone please help me with a function or command in RStudio that permutes only some elements in a vector. So far I tried runif(), sample(), and replicate() but none allowed me to do what I trully needed.

What I currently have is:

  1. A fixed vector drawn from theory rc1<-c(8,4,2,10,5,6,9,6,1,3) This vector will be used later to computer spearman correlations.
  2. A vector from which to draw n-samples of permutations y <-c(8,4,2,10,5,6,9,6,1,3)

I would like the permutations to apply only to some elements of the y vector. For example:

y1[**8**,6,5,7,2,10,9,4,1, **3**] y2[**8**,2,5,10,4,7,9,1,6, **3**]

This procedure should be repeated as many times as necessary, say n=100. Finally, I would like to compute spearman correlations between vector rc1 and each of the permuted y vectors and eventually have one average correlation coefficient and the associated standard deviation.

Thank you in advance! A complete beginner here and in R

3
rvectorpermutationsimulation
Welcome to the site! Thank you for taking the time to make your question clear and reproducible! – Gregor Thomas
Thank you! I already love this extremely helpful community. – Stanciu Adrian

3 Answers

1
votes

You can create a little function that allows you to feed in your vector and the positions within that vector you wish to permute. It will just shuffle the indexes of the vector that you want to shuffle using sample

permute_partial <- function(vec, indexes)
{
  keepers <- seq_along(vec)
  keepers[indexes] <- sample(indexes)
  vec[keepers]
}

So, for example, if you want 20 replicates of your vector, you could do:

y   <- c(8, 4, 2, 10, 5, 6, 9, 6, 1, 3)

t(replicate(20, permute_partial(y, 2:9)))
#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#>  [1,]    8    4    6    2    6   10    5    9    1     3
#>  [2,]    8    6    9    2    5    1    4   10    6     3
#>  [3,]    8    2    4    9    6    6   10    5    1     3
#>  [4,]    8    5    2    6    9    1    6   10    4     3
#>  [5,]    8    4    6   10    6    1    5    2    9     3
#>  [6,]    8    9    4    6    5   10    2    1    6     3
#>  [7,]    8    2    9    4    1    6   10    6    5     3
#>  [8,]    8    6    1    5    9   10    2    6    4     3
#>  [9,]    8    5    4   10    9    6    1    6    2     3
#> [10,]    8    6   10    1    4    2    6    5    9     3
#> [11,]    8    4    6   10    9    2    5    6    1     3
#> [12,]    8   10    1    9    5    6    6    4    2     3
#> [13,]    8    6    2    6   10    9    4    1    5     3
#> [14,]    8    2    5    6    4   10    1    9    6     3
#> [15,]    8    6    9   10    6    4    2    1    5     3
#> [16,]    8   10    9    5    1    6    4    6    2     3
#> [17,]    8   10    6    9    1    2    5    6    4     3
#> [18,]    8   10    6    5    9    2    1    4    6     3
#> [19,]    8   10    2    6    9    4    1    6    5     3
#> [20,]    8    9    2    5   10    6    6    1    4     3

Now you can also replicate many samples using sapply to get a vector of all the Spearman correlations:

set.seed(1)
y   <- c(8, 4, 2, 10, 5, 6, 9, 6, 1, 3)
rc1 <- c(8, 4, 2, 10, 5, 6, 9, 6, 1, 3)

result <- sapply(1:100, function(x) cor(rc1, permute_partial(y, 2:9), 
                                        method = "spearman"))

result
#>   [1]  0.167682927 -0.167682927  0.073170732 -0.192073171  0.277439024
#>   [6]  0.317073171  0.112804878  0.015243902  0.042682927 -0.189024390
#>  [11]  0.518292683  0.167682927  0.719512195 -0.457317073  0.091463415
#>  [16] -0.268292683  0.399390244  0.329268293  0.103658537  0.911585366
#>  [21] -0.451219512  0.118902439 -0.231707317 -0.039634146 -0.125000000
#>  [26]  0.021341463  0.527439024 -0.250000000  0.268292683  0.112804878
#>  [31] -0.091463415  0.682926829  0.435975610  0.707317073 -0.240853659
#>  [36]  0.182926829  0.088414634 -0.100609756  0.210365854  0.469512195
#>  [41]  0.356707317  0.182926829 -0.560975610  0.091463415  0.253048780
#>  [46]  0.466463415 -0.009146341  0.054878049  0.371951220  0.667682927
#>  [51]  0.911585366 -0.036585366  0.655487805  0.414634146 -0.073170732
#>  [56]  0.225609756 -0.009146341  0.134146341  0.435975610 -0.012195122
#>  [61] -0.091463415  0.509146341 -0.201219512  0.158536585 -0.036585366
#>  [66]  0.716463415 -0.463414634 -0.417682927  0.545731707 -0.015243902
#>  [71] -0.006097561  0.036585366  0.079268293 -0.338414634  0.493902439
#>  [76]  0.414634146  0.466463415  0.503048780 -0.289634146  0.185975610
#>  [81] -0.371951220 -0.228658537  0.201219512  0.414634146 -0.225609756
#>  [86]  0.329268293  0.551829268  0.115853659  0.112804878 -0.103658537
#>  [91] -0.003048780  0.219512195 -0.073170732 -0.320121951  0.082317073
#>  [96]  0.390243902  0.280487805  0.344512195 -0.198170732  0.009146341

Which looks like this:

hist(result)

Created on 2020-06-25 by the reprex package (v0.3.0)

2
votes

Create a logical vector of the positions to be fixed. Fill in the fixed positions and then the permuted positions

set.seed(42)
fix <- c(TRUE, rep(FALSE, 8), TRUE)  # Fix first and last position
rcsam <- rep(NA, length(rc1))        # Empty vector
rcsam[fix] <- rc1[fix]               # Fixed positions
rcsam[!fix] <- sample(rc1[!fix])     # Permuted values
rcsam
# [1]  8  4  6  1  9  2  5 10  6  3

You can create a function to repeat this process:

fixsam <- function(x, fix) {
    y <- rep(NA, length(x))
    y[fix] <- x[fix]
    y[!fix] <- sample(x[!fix])
    return(y)
}

rcsam <- replicate(100, fixsam(x=rc1, fix=fix))
rcsam[, 1:5]    # Each column is a sample.

      [,1] [,2] [,3] [,4] [,5]
 [1,]    8    8    8    8    8
 [2,]    5    2    6    6    1
 [3,]   10    6    5    5    4
 [4,]    9    4    6    9    2
 [5,]    6    9    4    1    6
 [6,]    2   10   10    6    9
 [7,]    6    6    9    2   10
 [8,]    1    1    1   10    5
 [9,]    4    5    2    4    6
[10,]    3    3    3    3    3

To compute spearman correlations use apply:

cors <- apply(rcsam, 2, cor, y=rc1, method="spearman")
summary(cors)
#    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# -0.6433 -0.1059  0.1585  0.1715  0.3880  0.9604
0
votes

Someone has already given a neat answer, if you want to generalize the process, perhaps you can write a function to do this.

rc1<-c(8,4,2,10,5,6,9,6,1,3) 
y <-c(8,4,2,10,5,6,9,6,1,3)
fix_index <- c(1,10) ## index of the fixed elements

spear_corr <- function(rc1,y,fix_index){
  
  y_size <- length(y) 
  permute_index <- c(1:y_size)[-fix_index] ## index of to be permuted elements

  permute_num <- length(permute_index) ## 
  permute_y <- y
  permute_y[permute_index] <- sample(x=y[permute_index],size = permute_num,replace = FALSE) ## a new vector with permuted elements
  
  corrleation <- cor(rc1,permute_y,method = "spearman") ## find spearman correlation
  
  return(corrleation)
}

spear_corr(rc1,y,fix_index)

## repeat this 100 times
corr_vector <- vector()
for (i in 1:100) {
  corr_vector[i] <- spear_corr(rc1,y,fix_index)
}