R: Replace "off-diagonal" elements of a random matrix

Question

I'm using the following code to generate a random matrix with some elements = 1 near the diagonal, the rest = 0. (This is basically a random walk along the main diagonal.)

n <- 20
rw <- matrix(0, ncol = 2, nrow = n)
indx <- cbind(seq(n), sample(c(1, 2), n, TRUE))
rw[indx] <- 1
rw[,1] <- cumsum(rw[, 1])+1
rw[,2] <- cumsum(rw[, 2])+1
rw2 <- subset(rw, (rw[,1] <= 10 & rw[,2] <= 10))
field <- matrix(0, ncol = 10, nrow = 10)
field[rw2] <- 1
field

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

Next thing, I would like to replace the 0 elements to the right-hand/upper side of the 1-elements by 1. For the above matrix the desired output would be:

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

I have tried

fill <- function(row) {first = match(1, row); if (is.na(first)) {row = rep(1, 10)} else {row[first:10] = 1}; return(row)}  
field2 <- apply(field, 1, fill)
field2

But that gives me instead:

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

Can anyone help me fix this?

Cheers,

mce

PS: If the first row is all zeros (as it can happen with the above code) it should be changed to all ones.

Answer 1

Why not just:

t(apply(field,1,cummax))

One instance:

dput(field)
structure(c(0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0), .Dim = c(10L, 
10L))

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

The output:

> t(apply(field,1,cummax))
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    0    0    0    0    0    0    0    0    0     0
 [2,]    1    1    1    1    1    1    1    1    1     1
 [3,]    0    0    0    0    0    1    1    1    1     1
 [4,]    0    0    0    0    0    1    1    1    1     1
 [5,]    0    0    0    0    0    1    1    1    1     1
 [6,]    0    0    0    0    0    0    0    0    0     0
 [7,]    0    0    0    0    0    0    0    0    0     0
 [8,]    0    0    0    0    0    0    0    0    0     0
 [9,]    0    0    0    0    0    0    0    0    0     0
[10,]    0    0    0    0    0    0    0    0    0     0

Answer 2

This should work:

MaxFull <- which.max((apply(field,1,sum) > 0) * (1:10))
rbind(t(apply(field[1:MaxFull,], 1, fill)),matrix(0,ncol=10,nrow=10-MaxFull))

notice that it uses fill as you defined it.

Answer 3

In the help for the value of apply, "If each call to FUN returns a vector of length n, then apply returns an array of dimension c(n, dim(X)[MARGIN])". So, you want the transpose of this. Print statements were added to the fill function to confirm the operation. You may want to check if your function is hiding another function, there is a function named fill, but it doesn't matter in this case.

n <- 20
rw <- matrix(0, ncol = 2, nrow = n)
indx <- cbind(seq(n), sample(c(1, 2), n, TRUE))
rw[indx] <- 1
rw[,1] <- cumsum(rw[, 1])+1
rw[,2] <- cumsum(rw[, 2])+1
rw2 <- subset(rw, (rw[,1] <= 10 & rw[,2] <= 10))
field <- matrix(0, ncol = 10, nrow = 10)
field[rw2] <- 1
field
myfill <- function(row) {
  print("Function start")
  print(row)
  first = match(1, row)
  print(paste("Match", first))
  if (is.na(first)) {
    row = rep(1, 10)
  } else {
    row[first:10] = 1
  };
  print(row)
  flush.console()
  return(row)
}  
field2 = t(apply(field, 1, myfill))
field2