3

I am trying to get all occurences of a value in a data frame per row like this:

     a   b  c  d  e
  1  1   1  0 -1 NA
  2  0  -1 -1  1 NA
  3  -1  0 NA NA  1

to this

     a   b  c  d  e count.-1 count.0 count.1 count.NA
  1  1   1  0 -1 NA        1       1       2        1
  2  0  -1 -1  1 NA        2       1       1        1
  3  1   0 NA NA  1        0       1       2        2

which I am doing like this at the moment:

    df = df %>%
  by_row(
    ..f = function(x) {
      sum(is.na(x[1:8]))
    },
    .to = "count_na",
    .collate = "cols"
  ) %>% 
  by_row(
    ..f = function(x) {
      sum(x[1:8] == 1, na.rm = T)
    },
    .to = "count_positive",
    .collate = "cols"
  ) %>% 
  by_row(
    ..f = function(x) {
      sum(x[1:8] == -1, na.rm = T)
    },
    .to = "count_negative",
    .collate = "cols"
  ) %>% 
  by_row(
    ..f = function(x) {
      sum(x[1:8] == 0, na.rm = T)
    },
    .to = "count_neutral",
    .collate = "cols"
  ) 

The problem is however that for 5 mil rows this takes forever to complete (over 3 hours, is there some better way to do this?

zx8754
  • 52,746
  • 12
  • 114
  • 209
R.vW
  • 177
  • 1
  • 11
  • Possible duplicate https://stackoverflow.com/questions/24015557/count-occurrences-of-value-in-a-set-of-variables-in-r-per-row , not efficient but it should be faster than your current version. – Ronak Shah May 21 '18 at 09:54
  • 1
    Try `cbind(df1, t(apply(df1, 1, table, exclude = NULL)))` – zx8754 May 21 '18 at 10:11

1 Answers1

2

You can make use of the data.table for fast processing. First, melt into a long format then tabulate by row number and value before pivoting back and joining to get your desired output

agg <- dcast(melt(DT[, rn:=.I], id.vars="rn")[, .N, by=.(rn, value)], 
    rn ~ value, sum, value.var="N")
DT[agg, on=.(rn)]

sample data:

library(data.table)
set.seed(0L)
DT <- as.data.table(matrix(sample(c(-1L, 0L, 1L, NA_integer_), 5*5e6, replace=TRUE), ncol=5))
DT

edit: added some timings. tl;dr around 10seconds for a 5 million rows dataset using data.table

dtmtd <- function() {
    agg <- dcast(melt(DT[, rn:=.I], id.vars="rn")[, .N, by=.(rn, value)], 
        rn ~ value, sum, value.var="N")
    DT[agg, on=.(rn)]

}    
microbenchmark::microbenchmark(dtmtd(), times=3L)

timings:

Unit: seconds
    expr      min       lq     mean  median       uq      max neval
 dtmtd() 10.07663 10.14351 10.17387 10.2104 10.22249 10.23458     3
chinsoon12
  • 25,005
  • 4
  • 25
  • 35