Count number of character and their position until a value is reached

user_11518133 0
Viewed 125

I need to sum the number of times, starting from the last value, that the r element appears in my vector until it reaches an a element. For example, suppose I have a vector V = c('a', 0, 'a', 'r', 'r', 0, 'r', 'a', 0, 'a', 'r' , 0, 'r'). Note that in this case, the number of times that the element r appears until appears an a is 2 times. So I would need a to return the number 2 to me, in addition to bringing up the positions at which they appear, ie, position 13 and 11. Something like

> some.function(c('a', 0, 'a', 'r', 'r', 0, 'r', 'a', 0, 'a', 'r' , 0, 'r'))
[1] 2
[2] 13 
[3] 11

> some.function(c('a', 0, 'a', 'r', 'r', 0, 'r', 'a', 0, 'a', 'r'))
[1] 1
[2] 11

> some.function(c('a', 0, 'a', 'r', 'r', 0, 'r'))
[1] 3
[2] 7
[3] 5
[4] 4

> some.function(c('a', 0, 'a', 'r', 'r', 0, 'r', 0))
[1] 3
[2] 7
[3] 5
[4] 4

Any hint on how can I do that?

counting vector r
3 Answers

I haven't checked all the cases (although by eye it seems as though my code should work), nor embedded the code in the function, but this logic seems to do the trick.

## setup
x <- c('a', 0, 'a', 'r', 'r', 0, 'r', 'a', 0, 'a', 'r' , 0, 'r')
## find all 'r' locations
xpos <- which(x == "r")
## reverse
rx <- rev(x)
## truncate at first occurrence of 'a'
trx <- rx[seq(min(which(rx=="a")))]
## count number of 'r' values
nr <- sum(trx=="r")
## find last (nr) 'r' values in the sequence
rr <- rev(xpos)[seq(nr)]

This will probably break in some edge cases (no "r" at all in the vector, no "r" preceded by an "a", etc., no "a" at all ...)

user_1902770

Here is an option (based on the examples showed)

  1. Use a group by operation - tapply
  2. Create the group based on a logical vector (x == 'a') with rleid
  3. Pass the X in tapply with the sequence of input vector (seq_along(x)) multiplie dby the logical vector (x == 'r') so that we get positions corresponding to 'r' while the others i.e. FALSE will be 0.
  4. Specify the lambda function in FUN to subset elements that are not 0
  5. The above step 4 returns some list elements with length 0 as those were only having 0 values and we subset
  6. Use Filter to remove those empty list elements
  7. Get the last element with tail, and specify the n = 1
  8. Append with the length of the extracted element and return that as function output
f1 <- function(x) {

       out <- tail(Filter(length, tapply(seq_along(x) * (x == 'r'), 
             data.table::rleid(x == 'a'), FUN = function(y) y[y != 0])), 1)[[1]]
      c(length(out), out)
        
}

-testing

lapply(lst1, f1)
[[1]]
[1]  2 11 13

[[2]]
[1]  1 11

[[3]]
[1] 3 4 5 7

NOTE: Just for testing purpose, the vectors were created as list. Can also do this on a single vector

f1(lst1[[1]])

data

lst1 <- list(c("a", "0", "a", "r", "r", "0", "r", "a", "0", "a", "r", 
"0", "r"), c("a", "0", "a", "r", "r", "0", "r", "a", "0", "a", 
"r"), c("a", "0", "a", "r", "r", "0", "r"))
user_37322710

one more approach

somefunc <- function(x){
  y <- which(max(cumsum(x == 'a')) == cumsum(x == 'a') & x == 'r')
  return(c(length(y), rev(y)))
}

somefunc(c('a', 0, 'a', 'r', 'r', 0, 'r', 'a', 0, 'a', 'r' , 0, 'r'))
#> [1]  2 13 11
somefunc(c('a', 0, 'a', 'r', 'r', 0, 'r', 'a', 0, 'a', 'r'))
#> [1]  1 11
somefunc(c('a', 0, 'a', 'r', 'r', 0, 'r'))
#> [1] 3 7 5 4
somefunc(c('a', 0, 'a', 'r', 'r', 0, 'r', 0))
#> [1] 3 7 5 4

Created on 2021-06-19 by the reprex package (v2.0.0)

user_28848590
Related