My earlier function woks fine with this. Still, posting a reprex, and deleting old post as that's now unnecessary.
sample_data <- data.frame(M1 = c(1, 4, 0, 5, -1, 0, -4, -72),
M2 = c(1, -4, 0, 0, -1, 0, 6, -27),
M3 = c(0, 0, 1, 1, 1, 0, -3, -10),
M4 = c(0, 0, 1, 1, 1, 0, 5, 13),
M5 = c(0, 10, 1, 1, 1, 0, 8, 42),
M6 = c(1, 10, 0, 1, 1, 24, 2, 7))
results_positive_expected <- c(2, 2, 3, 4, 4, 0, 3, 3)
results_negative_expected <- c(0, 0, 0, 0, 2, 0, 0, 3)
runs <- apply(X = sample_data,
MARGIN = 1,
FUN = function(t) rle(x = sign(x = t)))
get_maximum_consecutive_lengths <- function(run_data, value_sign)
{
runs_of_sign <- with(data = run_data,
expr = lengths[values == value_sign])
if (length(x = runs_of_sign) == 0)
return(0)
maximum_run <- max(runs_of_sign)
if (maximum_run == 1)
return(0)
return(maximum_run)
}
sample_data$results_positive <- vapply(X = runs,
FUN = get_maximum_consecutive_lengths,
FUN.VALUE = numeric(length = 1L),
value_sign = 1)
sample_data$results_negative <- vapply(X = runs,
FUN = get_maximum_consecutive_lengths,
FUN.VALUE = numeric(length = 1L),
value_sign = -1)
all.equal(target = results_positive_expected,
current = sample_data$results_positive)
#> [1] TRUE
all.equal(target = results_negative_expected,
current = sample_data$results_negative)
#> [1] TRUE
sample_data
#> M1 M2 M3 M4 M5 M6 results_positive results_negative
#> 1 1 1 0 0 0 1 2 0
#> 2 4 -4 0 0 10 10 2 0
#> 3 0 0 1 1 1 0 3 0
#> 4 5 0 1 1 1 1 4 0
#> 5 -1 -1 1 1 1 1 4 2
#> 6 0 0 0 0 0 24 0 0
#> 7 -4 6 -3 5 8 2 3 0
#> 8 -72 -27 -10 13 42 7 3 3
Created on 2020-08-13 by the reprex package (v0.3.0)
Hope this helps.