Geek Answers Handbook

R: Replace “off-diagonal” elements of a random matrix

I use the following code to generate a random matrix with some elements = 1 next to the diagonal, the rest = 0. (This is mostly random walk on 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

Further, I would like to replace 0 elements on the right / top side of 1-elements with 1. For the specified matrix, the desired result will 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 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 this 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 someone help me fix this?

Greetings

Mce

PS: If the first line is all zeros (as this can happen with the above code), it should be replaced with everything.

+4
source share
3 answers

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))

, , .

0

:

t(apply(field,1,cummax))

:

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

:

> 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
+2

In help, for the value of apply: "If every FUN call returns a vector of length n, then apply returns an array of dimension c (n, dim (X) [MARGIN])." So you want to transfer this. Print operations have been added to the fill function to confirm the operation. You can check if your function hides another function, there is a function called fill, but in this case it does not matter.

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
0
source

More articles:


All Articles