Replacing an element within a vector in a list - r

I have a list of vectors that looks like
[[1]][1] 1 1 2
[[2]]
[1] 1 1 2
[[3]]
[1] 2 1 1
[[4]]
[1] 2 2 2
I would like the replace the first component of each of the vectors with a 9. I have tried
out <- append(vecs2T2[[1]], y, after=0)
but this just adds an 9 in at the start and does not replace it (see below).
[1] 9 1 1 2
I would like this entry to read 912.


lapply(ll, replace, 1, 9)
This goes vector by vector, and replaces the 1st item with 9. (Replace's arguments are: (data, list-of-indexes, list-of-values), with the list of values recycled to be as long as the list of indexes.)
replace() is just defined as:
replace <- function (x, list, values) {
x[list] <- values
x
}
so you can also use that method.
lapply(ll, function(x) { x[1] <- 9 ; x })
You can use either with purrr::map(), too:
purrr::map(ll, ~{ .x[1] <- 9 ; .x })
purrr::map(ll, replace, 1, 9)
Head-to-head (not the best microbenchmark setup in the world tho):
microbenchmark::microbenchmark(
purr_repl = purrr::map(ll, replace, 1, 9),
purr_op = purrr::map(ll, ~{ .x[1] <- 9 ; .x }),
lapp_repl = lapply(ll, replace, 1, 9),
lapp_op = lapply(ll, function(x) { x[1] <- 9 ; x }),
Map = Map(function(x, y)c(x, y[-1]), 9, ll)
)
## Unit: microseconds
## expr min lq mean median uq max neval
## purr_repl 27.510 29.7555 49.98242 31.4735 33.4805 1506.400 100
## purr_op 84.415 86.9550 125.07364 90.0665 98.9465 2423.406 100
## lapp_repl 4.422 4.8350 5.94472 5.1965 5.5930 34.947 100
## lapp_op 4.672 5.4250 19.14590 5.9045 6.5015 1215.477 100
## Map 10.670 12.2490 28.94712 13.5935 14.7170 1238.311 100


Another idea is to use Map and concatenate 9 with the each vector minus its first element
Map(function(x, y)c(x, y[-1]), 9, l1)

Related

Trouble with R and vector length NA values appended

I've looked this over and I can't quite understand why this is giving me NA values appended onto the vector I want. Prompt below:
"The function should return a vector where the first element is the sum of the first n elements of the input vector, and the rest of the vector is a copy of the other elements of the input vector. For example, if the input vector is (2, 3, 6, 7, 8) and n = 2, then the output should be the vector (5, 6, 7, 8)"
testA<- c(1,2,3,4,5)
myFunction <- function(vector1, n)
{
sum1=0
for(i in 1:n)
{
sum1<-sum1+vector1[i]
newVector<-c(sum1,vector1[n+1:length(vector1)])
}
return(newVector)
}
print(newVector)
myFunction(testA, 3)
Output is: [1] 6 4 5 NA NA NA when it should just be 6 4 5

There is no need for a for loop here; you can do something like this
test <- c(2, 3, 6, 7, 8)
myfunction <- function(x, n) c(sum(x[1:n]), x[-(1:n)])
myfunction(test, 2)
#[1] 5 6 7 8
testA <- c(1,2,3,4,5)
myfunction(testA, 3)
#[1] 6 4 5
Explanation: sum(x[1:n]) calculates the sum of the first n elements of x and x[-(1:n)] returns x with the first n elements removed.

It can be done with head and tail
n <- 2
c(sum(head(test, 2)), tail(test, -2))
#[1] 5 6 7 8
data
test <- c(2, 3, 6, 7, 8)

Here I try to compare the efficiency of above two functions, which are answer post https://stackoverflow.com/a/52472214/3806250 with the question post.
> testA <- 1:5
> myFunction <- function(vector1, n) {
+ sum1 <- 0
+ for(i in 1:n) {
+ sum1 <- sum1 + vector1[i]
+ newVector <- c(sum1, vector1[n+1:length(vector1)])
+ }
+ newVector <- newVector[!is.na(newVector)]
+ return(newVector)
+ }
>
> microbenchmark::microbenchmark(myFunction(testA, 3))
Unit: microseconds
expr min lq mean median uq max neval
myFunction(testA, 3) 3.592 4.1055 77.37798 4.106 4.619 7292.85 100
>
> myfunction <- function(x, n) c(sum(x[1:n]), x[-(1:n)])
>
> microbenchmark::microbenchmark(myfunction(testA, 2))
Unit: microseconds
expr min lq mean median uq max neval
myfunction(testA, 2) 1.539 1.54 47.04373 2.053 2.053 4462.644 100

Thank you for everyone's answers! I was really tired last night and couldn't come up with this simple solution:
function(vector1, n)
{
sum1=0
for(i in 1:n) #scans input vector from first element to input 'n' element
{
sum1<-sum1+vector1[i]#Find sum of numbers scanned
newVector<-c(sum1,vector1[n+1:length(vector1)])#new output vector starting with the sum found then concatonates rest of the original vector after 'n' element
length(newVector)<-(length(newVector)-(n)) #NA values were returned, length needs to be changed with respect to 'n'
}
return(newVector)
print(newVector)
}

There are already great solutions, but here is another option which does minimum modifications on you original code:
testA<- c(1,2,3,4,5)
myFunction <- function(vector1, n)
{
sum1=0
for(i in 1:n)
{
sum1<-sum1+vector1[i]
}
newVector<-c(sum1,vector1[(n+1):length(vector1)]) # we take this line out of the for loop
# and put the n+1 in between parenthesis
return(newVector)
}
newVector <- myFunction(testA, 3)
print(newVector)
The problem on the original code/example was that n+1:length(vector1) was supossed to return [1] 4 5, in order to do the appropiate subsetting (obtaining the last elements in the vector which weren't included in the sum of the first n elements), but it is actually returning [1] 4 5 6 7 8. Since there are no elements in positions 6:8 in testA, this is the reason why there are appearing missing values/NAs.
What n+1:length(vector1) is actually doing is first obtaining the secuence 1:length(vector1) and then adding n to each element. Here is an example of this behaviour using values:
3+1:5
#> [1] 4 5 6 7 8
We can solve this by putting n+1 between parenthesis on the original code. In our example using values:
(3+1):5
#> [1] 4 5
Also, taking the assignment of newVector out of the loop improves performance, because the binding between sum1 and the subsetted vector only needs to be done once the sum of the first n elements is completed.

Arranging a list of vectors according to the sum of square of each element

x <- list(c(1,2), c(1,4), c(1,1))
I want to arange the vectors of the list according to their sum of square of the elements of each vector.
Sum of squares of three vectors:
1^2 + 2^2 = 5,
1^2 + 4^2 = 17,
1^2 + 1^2 = 2.
Since, 2 < 5 < 17, the desired output will be:
vectors squaresum
c(1,1) 2
c(1,2) 5
c(1,4) 17
I was thinking to build a function for square sum. Then using that function to sort the vectors. But could not do properly. Any help will be appriciated.

You can go iterate over your list to calculate the sum of squares of each vector and use order() to get the indices of values in ascending order. You can then use those to sort your initial list x:
x[order(sapply(x, function(v) sum(v ** 2)))]
the result is:
[[1]]
[1] 1 1
[[2]]
[1] 1 2
[[3]]
[1] 1 4

Here is another approach which can be used if the list vectors are all ofthe same length:
x[order(rowSums(do.call(rbind, x)^2))]
[[1]]
[1] 1 1
[[2]]
[1] 1 2
[[3]]
[1] 1 4
however it looks it does not provide any speed benefits on bigger lists compared to #clemens (I really thought it would):
x <- replicate(10000, sample(1:1000, 100, replace = TRUE), simplify = FALSE)
library(microbenchmark)
microbenchmark(clemens = x[order(sapply(x, function(v) sum(v ** 2)))],
missuse = x[order(rowSums(do.call(rbind, x) ^ 2))])
#output
Unit: milliseconds
expr min lq mean median uq max neval cld
clemens 32.03712 34.65821 59.16911 43.51531 57.19269 822.7295 100 a
missuse 32.84621 35.33422 47.53151 42.69733 56.09183 107.2334 100 a

Subsetting with negative indices: best practices?

Say I have a function for subsetting (this is just a minimal example):
f <- function(x, ind = seq(length(x))) {
x[ind]
}
(Note: one could use only seq(x) instead of seq(length(x)), but I don't find it very clear.)
So, if
x <- 1:5
ind <- c(2, 4)
ind2 <- which(x > 5) # integer(0)
I have the following results:
f(x)
[1] 1 2 3 4 5
f(x, ind)
[1] 2 4
f(x, -ind)
[1] 1 3 5
f(x, ind2)
integer(0)
f(x, -ind2)
integer(0)
For the last result, we would have wanted to get all x, but this is a common cause of error (as mentionned in the book Advanced R).
So, if I want to make a function for removing indices, I use:
f2 <- function(x, ind.rm) {
f(x, ind = `if`(length(ind.rm) > 0, -ind.rm, seq(length(x))))
}
Then I get what I wanted:
f2(x, ind)
[1] 1 3 5
f2(x, ind2)
[1] 1 2 3 4 5
My question is:
Can I do something cleaner and that doesn't need passing seq(length(x)) explicitly in f2 but using directly the default value of f's parameter ind when ind.rm is integer(0)?

If you anticipate having "empty" negative indices a lot, you can get a performance improvement for these cases if you can avoid the indexing used by x[seq(x)] as opposed to just x. In other words, if you are able to combine f and f2 into something like:
new_f <- function(x, ind.rm){
if(length(ind.rm)) x[-ind.rm] else x
}
There will be a huge speedup in the case of empty negative indices.
n <- 1000000L
x <- 1:n
ind <- seq(0L,n,2L)
ind2 <- which(x>n+1) # integer(0)
library(microbenchmark)
microbenchmark(
f2(x, ind),
new_f(x, ind),
f2(x, ind2),
new_f(x, ind2)
)
all.equal(f2(x, ind), new_f(x, ind)) # TRUE - same result at about same speed
all.equal(f2(x, ind2), new_f(x, ind2)) # TRUE - same result at much faster speed
Unit: nanoseconds
expr min lq mean median uq max neval
f2(x, ind) 6223596 7377396.5 11039152.47 9317005 10271521 50434514 100
new_f(x, ind) 6190239 7398993.0 11129271.17 9239386 10202882 59717093 100
f2(x, ind2) 6823589 7992571.5 11267034.52 9217149 10568524 63417978 100
new_f(x, ind2) 428 1283.5 5414.74 6843 7271 14969 100

What you have isn't bad, but if you want to avoid passing the default value of a default argument you could restructure like this:
f2 <- function(x, ind.rm) {
`if`(length(ind.rm) > 0, f(x,-ind.rm), f(x))
}
which is slightly shorter than what you have.
On Edit
Based on the comments, it seems you want to be able to pass a function nothing (rather than simply not pass at all), so that it uses the default value. You can do so by writing a function which is set up to receive nothing, also known as NULL. You can rewrite your f as:
f <- function(x, ind = NULL) {
if(is.null(ind)){ind <- seq(length(x))}
x[ind]
}
NULL functions as a flag which tells the receiving function to use a default value for the parameter, although that default value must be set in the body of the function.
Now f2 can be rewritten as
f2 <- function(x, ind.rm) {
f(x, ind = `if`(length(ind.rm) > 0, -ind.rm, NULL))
}
This is slightly more readable than what you have, but at the cost of making the original function slightly longer.

To implement "parameter1 = if(cond1) then value1 else default_value_of_param1", I used formals to get default parameters as a call:
f <- function(x, ind.row = seq_len(nrow(x)), ind.col = seq_len(ncol(x))) {
x[ind.row, ind.col]
}
f2 <- function(x, ind.row.rm = integer(0), ind.col.rm = integer(0)) {
f.args <- formals(f)
f(x,
ind.row = `if`(length(ind.row.rm) > 0, -ind.row.rm, eval(f.args$ind.row)),
ind.col = `if`(length(ind.col.rm) > 0, -ind.col.rm, eval(f.args$ind.col)))
}
Then:
> x <- matrix(1:6, 2)
> f2(x, 1:2)
[,1] [,2] [,3]
> f2(x, , 1:2)
[1] 5 6
> f2(x, 1, 2)
[1] 2 6
> f2(x, , 1)
[,1] [,2]
[1,] 3 5
[2,] 4 6
> f2(x, 1, )
[1] 2 4 6
> f2(x)
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6

Count number of occurrences of vector in list

I have a list of vectors of variable length, for example:
q <- list(c(1,3,5), c(2,4), c(1,3,5), c(2,5), c(7), c(2,5))
I need to count the number of occurrences for each of the vectors in the list, for example (any other suitable datastructure acceptable):
list(list(c(1,3,5), 2), list(c(2,4), 1), list(c(2,5), 2), list(c(7), 1))
Is there an efficient way to do this? The actual list has tens of thousands of items so quadratic behaviour is not feasible.

match and unique accept and handle "list"s too (?match warns for being slow on "list"s). So, with:
match(q, unique(q))
#[1] 1 2 1 3 4 3
each element is mapped to a single integer. Then:
tabulate(match(q, unique(q)))
#[1] 2 1 2 1
And find a structure to present the results:
as.data.frame(cbind(vec = unique(q), n = tabulate(match(q, unique(q)))))
# vec n
#1 1, 3, 5 2
#2 2, 4 1
#3 2, 5 2
#4 7 1
Alternatively to match(x, unique(x)) approach, we could map each element to a single value with deparseing:
table(sapply(q, deparse))
#
# 7 c(1, 3, 5) c(2, 4) c(2, 5)
# 1 2 1 2
Also, since this is a case with unique integers, and assuming in a small range, we could map each element to a single integer after transforming each element to a binary representation:
n = max(unlist(q))
pow2 = 2 ^ (0:(n - 1))
sapply(q, function(x) tabulate(x, nbins = n)) # 'binary' form
sapply(q, function(x) sum(tabulate(x, nbins = n) * pow2))
#[1] 21 10 21 18 64 18
and then tabulate as before.
And just to compare the above alternatives:
f1 = function(x)
{
ux = unique(x)
i = match(x, ux)
cbind(vec = ux, n = tabulate(i))
}
f2 = function(x)
{
xc = sapply(x, deparse)
i = match(xc, unique(xc))
cbind(vec = x[!duplicated(i)], n = tabulate(i))
}
f3 = function(x)
{
n = max(unlist(x))
pow2 = 2 ^ (0:(n - 1))
v = sapply(x, function(X) sum(tabulate(X, nbins = n) * pow2))
i = match(v, unique(v))
cbind(vec = x[!duplicated(v)], n = tabulate(i))
}
q2 = rep_len(q, 1e3)
all.equal(f1(q2), f2(q2))
#[1] TRUE
all.equal(f2(q2), f3(q2))
#[1] TRUE
microbenchmark::microbenchmark(f1(q2), f2(q2), f3(q2))
#Unit: milliseconds
# expr min lq mean median uq max neval cld
# f1(q2) 7.980041 8.161524 10.525946 8.291678 8.848133 178.96333 100 b
# f2(q2) 24.407143 24.964991 27.311056 25.514834 27.538643 45.25388 100 c
# f3(q2) 3.951567 4.127482 4.688778 4.261985 4.518463 10.25980 100 a
Another interesting alternative is based on ordering. R > 3.3.0 has a grouping function, built off data.table, which, along with the ordering, provides some attributes for further manipulation:
Make all elements of equal length and "transpose" (probably the most slow operation in this case, though I'm not sure how else to feed grouping):
n = max(lengths(q))
qq = .mapply(c, lapply(q, "[", seq_len(n)), NULL)
Use ordering to group similar elements mapped to integers:
gr = do.call(grouping, qq)
e = attr(gr, "ends")
i = rep(seq_along(e), c(e[1], diff(e)))[order(gr)]
i
#[1] 1 2 1 3 4 3
then, tabulate as before.
To continue the comparisons:
f4 = function(x)
{
n = max(lengths(x))
x2 = .mapply(c, lapply(x, "[", seq_len(n)), NULL)
gr = do.call(grouping, x2)
e = attr(gr, "ends")
i = rep(seq_along(e), c(e[1], diff(e)))[order(gr)]
cbind(vec = x[!duplicated(i)], n = tabulate(i))
}
all.equal(f3(q2), f4(q2))
#[1] TRUE
microbenchmark::microbenchmark(f1(q2), f2(q2), f3(q2), f4(q2))
#Unit: milliseconds
# expr min lq mean median uq max neval cld
# f1(q2) 7.956377 8.048250 8.792181 8.131771 8.270101 21.944331 100 b
# f2(q2) 24.228966 24.618728 28.043548 25.031807 26.188219 195.456203 100 c
# f3(q2) 3.963746 4.103295 4.801138 4.179508 4.360991 35.105431 100 a
# f4(q2) 2.874151 2.985512 3.219568 3.066248 3.186657 7.763236 100 a
In this comparison q's elements are of small length to accomodate for f3, but f3 (because of large exponentiation) and f4 (because of mapply) will suffer, in performance, if "list"s of larger elements are used.

One way is to paste each vector , unlist and tabulate, i.e.
table(unlist(lapply(q, paste, collapse = ',')))
#1,3,5 2,4 2,5 7
# 2 1 2 1

Create groups from vector of 0,1 and NA

Background:
I'm trying to strip out a corpus where the speaker is identified. I've reduced the problem of removing a particular speaker from the corpuse to the following stream of 1,0, and NA (x). 0 means that person is speaking, 1 someone else is speaking, NA means that whoever was the last speaker is still speaking.
Here's a visual example:
0 1 S0: Hello, how are you today?
1 2 S1: I'm great thanks for asking!
NA 3 I'm a little tired though!
0 4 S0: I'm sorry to hear that. Are you ready for our discussion?
1 5 S1: Yes, I have everything I need.
NA 7 Let's begin.
So from this frame, I'd like to take 2,3,5, and 7. Or,. I would like the result to be 0,1,1,0,1,1.
How do I pull the positions of each run of 1 and NA up to the position before the next 0 in a vector.
Here is an example, and my desired output:
Example input:
x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0)
Example output:
These are the positions that I want because they identify that "speaker 1" is talking (1, or 1 followed by NA up to the next 0)
pos <- c(6,8,9,10,11,15,16,17)
An alternative output would be a filling:
fill <- c(0,0,0,0,0,1,0,1,1,1,1,0,0,0,1,1,1,0)
Where the NA values of the previous 1 or 0 are filled up to the next new value.

s <- which(x==1);
e <- c(which(x!=1),length(x)+1L);
unlist(Map(seq,s,e[findInterval(s,e)+1L]-1L));
## [1] 6 8 9 10 11 15 16 17
Every occurrence of a 1 in the input vector is the start of a sequence of position indexes applicable to speaker 1. We capture this in s with which(x==1).
For each start index, we must find the length of its containing sequence. The length is determined by the closest forward occurrence of a 0 (or, more generally, any non-NA value other than 1, if such was possible). Hence, we must first compute which(x!=1) to get these indexes. Because the final occurrence of a 1 may not have a forward occurrence of a 0, we must append an extra virtual index one unit past the end of the input vector, which is why we must call c() to combine length(x)+1L. We store this as e, reflecting that these are (potential) end indexes. Note that these are exclusive end indexes; they are not actually part of the (potential) preceding speaker 1 sequence.
Finally, we must generate the actual sequences. To do this, we must make one call to seq() for each element of s, also passing its corresponding end index from e. To find the end index we can use findInterval() to find the index into e whose element value (that is, the end index into x) falls just before each respective element of s. (The reason why it is just before is that the algorithm used by findInterval() is v[i[j]] ≤ x[j] < v[i[j]+1] as explained on the doc page.) We must then add one to it to get the index into e whose element value falls just after each respective element of s. We then index e with it, giving us the end indexes into x that follow each respective element of s. We must subtract one from that because the sequence we generate must exclude the (exclusive) end element. The easiest way to make the calls to seq() is to Map() the two endpoint vectors to it, returning a list of each sequence, which we can unlist() to get the required output.
s <- which(!is.na(x));
rep(c(0,x[s]),diff(c(1L,s,length(x)+1L)));
## [1] 0 0 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0
Every occurrence of a non-NA value in the input vector is the start of a segment which, in the output, must become a repetition of the element value at that start index. We capture these indexes in s with which(!is.na(x));.
We must then repeat each start element a sufficient number of times to reach the following segment. Hence we can call rep() on x[s] with a vectorized times argument whose values consist of diff() called on s. To handle the final segment, we must append an index one unit past the end of the input vector, length(x)+1L. Also, to deal with the possible case of NAs leading the input vector, we must prepend a 0 to x[s] and a 1 to the diff() argument, which will repeat 0 a sufficient number of times to cover the leading NAs, if such exist.
Benchmarking (Position)
library(zoo);
library(microbenchmark);
library(stringi);
marat <- function(x) { v <- na.locf(zoo(x)); index(v)[v==1]; };
rawr <- function(x) which(zoo::na.locf(c(0L, x))[-1L] == 1L);
jota1 <- function(x) { stringx <- paste(x, collapse = ""); stringx <- gsub("NA", "N", stringx, fixed = TRUE); while(grepl("(?<=1)N", stringx, perl = TRUE)) stringx <- gsub("(?<=1)N", "1", stringx, perl = TRUE); unlist(gregexpr("1", stringx)); };
jota2 <- function(x) { stringx <- paste(x, collapse = ""); stringx <- gsub("NA", "N", stringx, fixed = TRUE); while(grepl("(?<=1)N", stringx, perl = TRUE)) stringx <- gsub("(?<=1)N", "1", stringx, perl = TRUE); newx <-unlist(strsplit(stringx, "")); which(newx == 1); };
jota3 <- function(x) {x[is.na(x)] <- "N"; stringx <- stri_flatten(x); ones <- stri_locate_all_regex(stringx, "1N*")[[1]]; unlist(lapply(seq_along(ones[, 1]), function(ii) seq.int(ones[ii, "start"], ones[ii, "end"]))); };
bgoldst <- function(x) { s <- which(x==1); e <- c(which(x!=1),length(x)+1L); unlist(Map(seq,s,e[findInterval(s,e)+1L]-1L)); };
## OP's test case
x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0);
ex <- marat(x);
identical(ex,rawr(x));
## [1] TRUE
identical(ex,jota1(x));
## [1] TRUE
identical(ex,jota2(x));
## [1] TRUE
identical(ex,jota3(x));
## [1] TRUE
identical(ex,bgoldst(x));
## [1] TRUE
microbenchmark(marat(x),rawr(x),jota1(x),jota2(x),jota3(x),bgoldst(x));
## Unit: microseconds
## expr min lq mean median uq max neval
## marat(x) 411.830 438.5580 503.24486 453.7400 489.2345 2299.915 100
## rawr(x) 115.466 143.0510 154.64822 153.5280 163.7920 276.692 100
## jota1(x) 448.180 469.7770 484.47090 479.6125 491.1595 835.633 100
## jota2(x) 440.911 464.4315 478.03050 472.1290 484.3170 661.579 100
## jota3(x) 53.885 65.4315 74.34808 71.2050 76.9785 158.232 100
## bgoldst(x) 34.212 44.2625 51.54556 48.5395 55.8095 139.843 100
## scale test, high probability of NA
set.seed(1L);
N <- 1e5L; probNA <- 0.8; x <- sample(c(NA,T),N,T,c(probNA,1-probNA)); x[which(x)] <- rep(c(0,1),len=sum(x,na.rm=T));
ex <- marat(x);
identical(ex,rawr(x));
## [1] TRUE
identical(ex,jota1(x));
## [1] TRUE
identical(ex,jota2(x));
## [1] TRUE
identical(ex,jota3(x));
## [1] TRUE
identical(ex,bgoldst(x));
## [1] TRUE
microbenchmark(marat(x),rawr(x),jota1(x),jota2(x),jota3(x),bgoldst(x));
## Unit: milliseconds
## expr min lq mean median uq max neval
## marat(x) 189.34479 196.70233 226.72926 233.39234 237.45738 293.95154 100
## rawr(x) 24.46984 27.46084 43.91167 29.92112 68.86464 79.53008 100
## jota1(x) 154.91450 157.09231 161.73505 158.18326 160.42694 206.04889 100
## jota2(x) 149.47561 151.68187 155.92497 152.93682 154.79668 201.13302 100
## jota3(x) 82.30768 83.89149 87.35308 84.99141 86.95028 129.94730 100
## bgoldst(x) 80.94261 82.94125 87.80780 84.02107 86.10844 130.56440 100
## scale test, low probability of NA
set.seed(1L);
N <- 1e5L; probNA <- 0.2; x <- sample(c(NA,T),N,T,c(probNA,1-probNA)); x[which(x)] <- rep(c(0,1),len=sum(x,na.rm=T));
ex <- marat(x);
identical(ex,rawr(x));
## [1] TRUE
identical(ex,jota1(x));
## [1] TRUE
identical(ex,jota2(x));
## [1] TRUE
identical(ex,jota3(x));
## [1] TRUE
identical(ex,bgoldst(x));
## [1] TRUE
microbenchmark(marat(x),rawr(x),jota1(x),jota2(x),jota3(x),bgoldst(x));
## Unit: milliseconds
## expr min lq mean median uq max neval
## marat(x) 178.93359 189.56032 216.68963 226.01940 234.06610 294.6927 100
## rawr(x) 17.75869 20.39367 36.16953 24.44931 60.23612 79.5861 100
## jota1(x) 100.10614 101.49238 104.11655 102.27712 103.84383 150.9420 100
## jota2(x) 94.59927 96.04494 98.65276 97.20965 99.26645 137.0036 100
## jota3(x) 193.15175 202.02810 216.68833 209.56654 227.94255 295.5672 100
## bgoldst(x) 253.33013 266.34765 292.52171 292.18406 311.20518 387.3093 100
Benchmarking (Fill)
library(microbenchmark);
bgoldst <- function(x) { s <- which(!is.na(x)); rep(c(0,x[s]),diff(c(1L,s,length(x)+1L))); };
user31264 <- function(x) { x[is.na(x)]=2; x.rle=rle(x); val=x.rle$v; if (val[1]==2) val[1]=0; ind = (val==2); val[ind]=val[which(ind)-1]; rep(val,x.rle$l); };
## OP's test case
x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0);
ex <- bgoldst(x);
identical(ex,user31264(x));
## [1] TRUE
microbenchmark(bgoldst(x),user31264(x));
## Unit: microseconds
## expr min lq mean median uq max neval
## bgoldst(x) 10.264 11.548 14.39548 12.403 13.258 73.557 100
## user31264(x) 31.646 32.930 35.74805 33.785 35.068 84.676 100
## scale test, high probability of NA
set.seed(1L);
N <- 1e5L; probNA <- 0.8; x <- sample(c(NA,T),N,T,c(probNA,1-probNA)); x[which(x)] <- rep(c(0,1),len=sum(x,na.rm=T));
ex <- bgoldst(x);
identical(ex,user31264(x));
## [1] TRUE
microbenchmark(bgoldst(x),user31264(x));
## Unit: milliseconds
## expr min lq mean median uq max neval
## bgoldst(x) 10.94491 11.21860 12.50473 11.53015 12.28945 50.25899 100
## user31264(x) 17.18649 18.35634 22.50400 18.91848 19.53708 65.02668 100
## scale test, low probability of NA
set.seed(1L);
N <- 1e5L; probNA <- 0.2; x <- sample(c(NA,T),N,T,c(probNA,1-probNA)); x[which(x)] <- rep(c(0,1),len=sum(x,na.rm=T));
ex <- bgoldst(x);
identical(ex,user31264(x));
## [1] TRUE
microbenchmark(bgoldst(x),user31264(x));
## Unit: milliseconds
## expr min lq mean median uq max neval
## bgoldst(x) 5.24815 6.351279 7.723068 6.635454 6.923264 45.04077 100
## user31264(x) 11.79423 13.063710 22.367334 13.986584 14.908603 55.45453 100

You can make use of na.locf from the zoo package:
library(zoo)
x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0)
v <- na.locf(zoo(x))
index(v)[v==1]
#[1] 6 8 9 10 11 15 16 17

x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0)
x[is.na(x)]=2
x.rle=rle(x)
val=x.rle$v
if (val[1]==2) val[1]=0
ind = (val==2)
val[ind]=val[which(ind)-1]
rep(val,x.rle$l)
Output:
[1] 0 0 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0

Pasting the sequence into a string and using a while loop that checks (with grep) whether there are any NAs preceded by 1s and substitutes (with gsub) such cases with a 1 will do it:
# substitute NA for "N" for later ease of processing and locating 1s by position
x[is.na(x)] <- "N"
# Collapse vector into a string
stringx <- paste(x, collapse = "")
while(grepl("(?<=1)N", stringx, perl = TRUE)) {
stringx <- gsub("(?<=1)N", "1", stringx, perl = TRUE)
}
Then you can use gregexpr to get the indices of 1s.
unlist(gregexpr("1", stringx))
#[1] 6 8 9 10 11 15 16 17
Or you can split the string and look through to find the indices of 1s in the resulting vector:
newx <-unlist(strsplit(stringx, ""))
#[1] "N" "N" "N" "N" "0" "1" "0" "1" "1" "1" "1" "0" "N" "N" "1" "1" "1" "0"
which(newx == "1")
#[1] 6 8 9 10 11 15 16 17
Using stri_flatten from the stringi package instead of paste and stri_locate_all_fixed rather than gregexpr or a string splitting route can provide a little bit more performance if it's a larger vector you're processing. If the vector isn't large, no performance gains will result.
library(stringi)
x[is.na(x)] <- "N"
stringx <- stri_flatten(x)
while(grepl("(?<=1)N", stringx, perl = TRUE)) {
stringx <- gsub("(?<=1)N", "1", stringx, perl = TRUE)
}
stri_locate_all_fixed(stringx, "1")[[1]][,"start"]
The following approach is fairly straightforward and performs relatively well (based on bgoldst's excellent benchmarking example) on small and large samples (very well on bgoldst's high probability of NA example)
x[is.na(x)] <- "N"
stringx <- stri_flatten(x)
ones <- stri_locate_all_regex(stringx, "1N*")[[1]]
#[[1]]
#
# start end
#[1,] 6 6
#[2,] 8 11
#[3,] 15 17
unlist(lapply(seq_along(ones[, 1]),
function(ii) seq.int(ones[ii, "start"], ones[ii, "end"])))
#[1] 6 8 9 10 11 15 16 17

Resources