How to flag a progressive decrease in values in list

user_8039978 0
Viewed 93

I have a dataframe with columns containing lists of values:

dt
   onset_l  coda_l
1     3, 7 7, 4, 1
3        7 7, 1, 3
12    1, 7 7, 4, 1
21    6, 7 7, 4, 1
23       7 7, 1, 5

What I want to do is create a new column, say, coda_flag, that flags whether the values in column coda_l progressively decrease or not.

I've tried this lapply method:

dt$coda_flag <- lapply(dt$coda_l, function(x) ifelse(x[1] > x[2] & x[2] > x[3], 1, 0))

The output is okay but I dislike that I have to enumerate x[1], x[2] and so on because in some cases I may not know the exact number of values in the lists.

The desired output would be:

dt
   onset_l  coda_l coda_flag
1     3, 7 7, 4, 1         1  # values do progressively decrease
3        7 7, 1, 3         0  # values do not progressively decrease
12    1, 7 7, 4, 1         1
21    6, 7 7, 4, 1         1
23       7 7, 1, 5         0

How can this be achieved?

Reproducible data:

dt <- structure(list(onset_l = list(c("3", "7"), "7", c("1", "7"), 
    c("6", "7"), "7"), coda_l = list(c("7", "4", "1"), c("7", 
"1", "3"), c("7", "4", "1"), c("7", "4", "1"), c("7", "1", "5"
))), row.names = c(1L, 3L, 12L, 21L, 23L), class = "data.frame")
r list
4 Answers

You can use is.unsorted() - although it can only detect increasing order so it's necessary to reverse the vector first.

dt$coda_flag <- +!sapply(dt$coda_l, function(x) is.unsorted(rev(as.numeric(x))))

   onset_l  coda_l coda_flag
1     3, 7 7, 4, 1         1
3        7 7, 1, 3         0
12    1, 7 7, 4, 1         1
21    6, 7 7, 4, 1         1
23       7 7, 1, 5         0

Note the strictly argument controls what happens in the event of tied values.

x <- c(1, 2, 2, 3)

is.unsorted(x)
[1] FALSE

is.unsorted(x, strictly = TRUE)
[1] TRUE
user_28352610

One dplyr and purrr solution could be:

dt %>%
 mutate(coda_flag = map_int(.x = coda_l, ~ +(all(diff(as.numeric(.x)) < 1))))

  onset_l  coda_l coda_flag
1    3, 7 7, 4, 1         1
2       7 7, 1, 3         0
3    1, 7 7, 4, 1         1
4    6, 7 7, 4, 1         1
5       7 7, 1, 5         0
user_59645570

You can also try with a loop:

#Flag
dt$Flag <- NA
#Loop
for(i in 1:nrow(dt))
{
  #Extract elements
  vecvar <- do.call(c,dt$coda_l[i])
  #Compute diff
  difvec <- diff(sort(as.numeric(vecvar)))
  #Assign
  dt$Flag[i] <- ifelse(length(unique(difvec))==1,1,0)
}

Output:

dt
   onset_l  coda_l Flag
1     3, 7 7, 4, 1    1
3        7 7, 1, 3    0
12    1, 7 7, 4, 1    1
21    6, 7 7, 4, 1    1
23       7 7, 1, 5    0
user_20808480

An option with data.table

library(data.table)
setDT(dt)[, coda_flag := +(sapply(coda_l, function(x)
   all(as.numeric(x) - shift(as.numeric(x), fill = first(as.numeric(x))) < 1)))]

-output

dt
#   onset_l coda_l coda_flag
#1:     3,7  7,4,1         1
#2:       7  7,1,3         0
#3:     1,7  7,4,1         1
#4:     6,7  7,4,1         1
#5:       7  7,1,5         0
user_37322710
Related