Select a subset of combinations

前端 未结 2 877
孤街浪徒
孤街浪徒 2021-01-20 14:53

Suppose that I have a 20 X 5 matrix, I would like to select subsets of the matrix and do some computation with them. Further suppose that each sub-matrix is 7 X 5. I could o

2条回答
  •  挽巷
    挽巷 (楼主)
    2021-01-20 15:29

    I ended up doing what @Roland suggested, by modifying combn(), and byte-compiling the code:

    combn_sub <- function (x, m, nset = 5000, seed=123, simplify = TRUE, ...) {
        stopifnot(length(m) == 1L)
        if (m < 0) 
            stop("m < 0", domain = NA)
        if (is.numeric(x) && length(x) == 1L && x > 0 && trunc(x) == 
            x) 
            x <- seq_len(x)
        n <- length(x)
        if (n < m) 
            stop("n < m", domain = NA)
        m <- as.integer(m)
        e <- 0
        h <- m
        a <- seq_len(m)
        len.r <- length(r <-  x[a] )
        count <- as.integer(round(choose(n, m)))
        if( count < nset ) nset <- count
        dim.use <- c(m, nset)       
    
        ##-----MOD 1: Change the output matrix size--------------
        out <- matrix(r, nrow = len.r, ncol = nset) 
    
        if (m > 0) {
            i <- 2L
            nmmp1 <- n - m + 1L
    
            ##----MOD 2: Select a subset of indices
            set.seed(seed)
            samp <- sort(c(1, sample( 2:count, nset - 1 )))  
    
            ##----MOD 3: Start a counter.
            counter <- 2L    
    
            while (a[1L] != nmmp1 ) {
                if (e < n - h) {
                    h <- 1L
                    e <- a[m]
                    j <- 1L
                }
                else {
                    e <- a[m - h]
                    h <- h + 1L
                    j <- 1L:h
                }
                a[m - h + j] <- e + j
    
                #-----MOD 4: Whenever the counter matches an index in samp, 
                #a combination of row indices is produced and stored in the matrix `out`
                if(samp[i] == counter){ 
                    out[, i] <- x[a]
                    if( i == nset ) break
                    i <- i + 1L
                }
                #-----Increase the counter by 1 for each iteration of the while-loop
                counter <- counter + 1L
            }
        }
        array(out, dim.use)
    }
    
    library("compiler")
    comb_sub <- cmpfun(comb_sub)
    

提交回复
热议问题