从 R 中的加权矩阵中的随机值中减去

Question

and thanks in advance for your help!

This question is related to one I posted before , but I think it deserves its own post because it is a separate challenge.

Last time I asked about randomly selecting values from a matrix after adding a vector. In that example, the matrix and the vector were both binary. Now I would like to change the values in a weighted matrix after adding a weighted vector. Here is some example code to play with.

require(gamlss.dist)
mat1<-matrix(c(0,0,0,0,1,0, 0,10,0,0,0,5, 0,0,0,0,1,0, 0,0,3,0,0,0, 0,0,0,0,3,0, 
  0,0,2,0,0,0, 2,1,0,1,0,1, 0,0,0,0,37,0, 0,0,0,2,0,0, 0,0,0,0,0,1, 1,0,0,0,0,0, 
  0,1,1,0,0,0), byrow=T, ncol=6, nrow=12)

vec1<-c(0,0,0,1,1,1)
ones <- which(vec1 == 1L)
temp=rZIP(sum(vec1))      #rZIP is a function from gamlss.dist that randomly selects values from a zero-inflated distribution
vec1[ones]<-temp

The values in the vector are sampled from a zero-inflated distribution (thanks to this question ). When I bind the vector to the matrix, I want to randomly select a non zero value from the same column, and subtract the vector value from it. I can see a further complication arising if the vector value is greater than the randomly selected value in the same column. In such an instance, it would simply set that value to zero.

Here is some modified code from the earlier question that does not work for this problem but maybe will be helpful.

foo <- function(mat, vec) {
    nr <- nrow(mat)
    nc <- ncol(mat)
    cols <- which(vec != 0)        #select matrix columns where the vector is not zero
    rows <- sapply(seq_along(cols),
      function(x, mat, cols) {
        ones <- which(mat[,cols[x]] != 0)
        out <- if(length(ones) != 0) {
             ones
             } else {
                sample(ones, 1)
                }
             out
             }, mat = mat, cols = cols)
    ind <- (nr*(cols-1)) + rows           #this line doesn't work b/c it is not binary
    mat[ind] <- 0                         #here is where I would like to subtract the vector value
    mat <- rbind(mat, vec)
    rownames(mat) <- NULL
    mat
}

Any ideas? Thanks again for all of the fantastic help!

EDIT:

Thanks to help from bnaul down below, I am a lot closer to the answer, but we have run into the same problem we hit last time. The sample function doesn't work properly on columns where there is only one nonzero value. I have fixed this using Gavin Simpson's if else statement (which was the solution in the previous case). I've adjusted the matrix to have columns with only one nonzero value.

 mat1<-matrix(c(0,0,0,0,1,0, 0,0,0,0,0,5, 0,0,0,0,1,0, 0,0,0,0,0,0, 0,0,0,0,3,0, 
   0,0,2,0,0,0, 2,1,0,1,0,1, 0,0,0,0,37,0, 0,0,0,2,0,0, 0,0,0,0,0,1, 1,0,0,0,0,0, 
   0,0,0,0,0,0), byrow=T, ncol=6, nrow=12)

vec1<-c(0,1,0,0,1,1)
ones <- which(vec1 == 1L)
temp=rZIP(sum(vec1))
vec1[ones]<-temp 

mat2 = rbind(mat1, vec1)     
apply(mat2, 2, function(col) {       #Returns matrix of integers indicating their column 
                                     #number in matrix-like object
    nonzero = which(head(col,-1) != 0);      #negative integer means all but last # of elements in x
    sample_ind = if(length(nonzero) == 1){
      nonzero
      } else{
        sample(nonzero, 1)
        }
        ;                             #sample nonzero elements one time
    col[sample_ind] = max(0, col[sample_ind] - tail(col,1));    #take max of either 0 or selected value minus Inv
    return(col)
    }
  )

Thanks again!

Answer 1

mat2 = rbind(mat1, vec1)    
apply(mat2, 2, function(col) {
    nonzero = which(head(col,-1) != 0);
    sample_ind = sample(nonzero, 1);
    col[sample_ind] = max(0, col[sample_ind] - tail(col,1));
    return(col)
    }
)

I made a couple of simplifications; hopefully they don't conflict with what you had in mind. First, I ignore the requirement that you only operate on the nonzero elements of the vector, since subtracting 0 from anything will not change it. Second, I bind the matrix and vector and then perform the operation column-wise on the result, since this is a bit easier than tracking the indices in two separate data structures and then combining them afterward.