2
votes

Compter le nombre d'occurrences de zéro entre une valeur non nulle dans R

J'ai une matrice

[[1]]
[1] 2 2

[[2]]
[1] 1 4 1

[[3]]
[1] 1 1

[[4]]
[1] 2 5

Je souhaite créer une liste qui compte le nombre d'occurrence de zéro entre valeur non nulle

mat <- matrix(c(64,76,0,0,78,35,45,0,0,4,37,0,66,46,0,0,0,0,3,0,71,0,28,97,0,30,55,65,116,30,18,0,0,143,99,0,0,0,0,0), nrow=4, byrow=T)

mat
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]   64   76    0    0   78   35   45    0    0     4
[2,]   37    0   66   46    0    0    0    0    3     0
[3,]   71    0   28   97    0   30   55   65  116    30
[4,]   18    0    0  143   99    0    0    0    0     0

matrix r

0 commentaires

4 Réponses :

6
votes

Tout ce dont vous avez besoin est rle

> apply(mat, 1, function(x) {
   rle(x)$length[rle(x)$values == 0]
 })
[[1]]
[1] 2 2

[[2]]
[1] 1 4 1

[[3]]
[1] 1 1

[[4]]
[1] 2 5

1 commentaires

Ce n'est pas que la vitesse compte dans cet exemple, mais vous pouvez éviter de calculer rle (x) deux fois en utilisant with (rle (x), lengths [values == 0])

2
votes

Vous pouvez utiliser rle qui calcule le nombre de nombres consécutifs

mat <- matrix(c(64,76,0,0,78,35,45,0,0,4,37,0,66,46,0,0,0,0,3,0,71,0,28,97,0,30,55,65,116,30,18,0,0,143,99,0,0,0,0,0), nrow=4, byrow=T)
apply(mat,1,function(x) {
  value = rle(x==0)
  value$length[value$values]
  })

0 commentaires

1
votes

Encore un

setNames(object = lapply(X = data.frame(t(mat)),
                         FUN = function(x)
                             with(rle(x == 0), lengths[values])),
         nm = NULL)
#[[1]]
#[1] 2 2

#[[2]]
#[1] 1 4 1

#[[3]]
#[1] 1 1

#[[4]]
#[1] 2 5

0 commentaires

0
votes

Si, pour une raison quelconque, vous avez une matrice avec de nombreuses lignes et que vous devez le faire quelques secondes plus rapidement (je ne sais probablement pas), vous pouvez utiliser la méthode ci-dessous

mat <- mat[sample(nrow(mat), 1e6, T),]

f1 <- function(mat){
  apply(mat, 1, function(x) {
   with(rle(x), lengths[values == 0])
 })
}
f2 <- function(mat){
rle(c(t(mat))) %>% 
  do.call(what = data.frame) %>% 
  mutate(mrow = (cumsum(lengths) - 1) %/% ncol(mat)) %>% 
  {split(.$lengths[!.$values], .$mrow[!.$values])}
}

microbenchmark::microbenchmark(f1(mat), f2(mat), times = 10)
# Unit: seconds
#     expr       min        lq      mean    median        uq       max neval
#  f1(mat) 28.346335 28.978307 30.633423 30.720702 31.504075 35.049800    10
#  f2(mat)  3.683452  3.916681  4.099936  4.086634  4.250613  4.482668    10

Benchmark p>

library(dplyr)

rle(c(t(mat))) %>% 
  do.call(what = data.frame) %>% 
  mutate(mrow = (cumsum(lengths) - 1) %/% ncol(mat)) %>% 
  {split(.$lengths[!.$values], .$mrow[!.$values])}

# $`0`
# [1] 2 2
# 
# $`1`
# [1] 1 4 1
# 
# $`2`
# [1] 1 1
# 
# $`3`
# [1] 2 5

0 commentaires