Create Row Labels based on an existing label in R - r

Question

I have a df with a label "S" for anywhere my numeric column is <35.
I'd like to use each S position and label "S-1", "S-2", "S-3" for the 3 previous rows to S, then "S+1", "S+2" for the next 2 rows of S.
like this..
N S
45
56
67 S-3
47 S-2
52 S-1
28 S
89 S+1
66 S+2
55
76
I was using this to start me off, just as an example.
n <- sample(50:100, 10, replace=T)
data <- data.frame(N=n)
data <- rbind(data, 30)
data <- rbind(data,data,data,data,data,data)
data$S <- ifelse(data$N<35, "S", "")
Any ideas..?

Answer 1

here is an option using base R, where we get the index of rows where 'N' is less than 35 ('i1'), create the 'S' column with blank ("") elements, loop through 'i1', get the sequence of 3 elements before, 2 elements after, paste with 'S', get the intersect of sequence with the index ('ind') and assign the strings ('val') to the 'S' column
i1 <- which(data$N < 35)
data$S <- ""
out <- do.call(rbind, lapply(i1, function(i) data.frame(ind =(i-3): (i+2),
val = c(paste0("S-", 3:1), "S", paste0("S+", 1:2)), stringsAsFactors = FALSE)))
i2 <- out$ind %in% seq_len(nrow(data))
data$S[out$ind[i2]] <- out$val[i2]
data
set.seed(24)
n <- sample(50:100, 10, replace=T)
data <- data.frame(N=n)
data <- rbind(data, 30)
data <- rbind(data,data,data,data,data,data)

Answer 2

Without dealing with possible overlap, here is a bunch of ifelse() statements to get the job done. Maybe you can think of a more appropriate way to generalize it.
You can use lag() and lead() with the dplyr package.
data %>% mutate(S = ifelse(S == "S", S,
ifelse(lag(S == "S"), "S+1",
ifelse(lag(S == "S", 2), "S+2",
ifelse(lead(S == "S"), "S-1",
ifelse(lead(S == "S", 2), "S-2", ""))))),
S = ifelse(is.na(S), "", S))
(You would get NA values in the first two rows if the first value is not <35, so replace these with "".)
N S
1 52
2 86
3 86
4 57
5 54
6 57
7 51
8 98
9 100 S-2
10 73 S-1
11 30 S
12 52 S+1
13 86 S+2
14 86

Answer 3

This is a long-ish answer since I break it down into pieces I would normally implement using a pipeline and lambda expressions, but it should be easy enough to follow.
I will work on row indices and compute two vectors, one containing the index closest to i on the left that has label "S", and one containing the index closest to i on the right.
indices <- 1:length(data$S)
closest_left <- rep(NA, length = length(indices))
closest_right <- rep(NA, length = length(indices))
I compute these using purrr's reduce functions but you could easily do it in a loop as well.
this_or_left <- function(left_val, i) {
res <- if (data$S[[i]] == "S") i else left_val
closest_left[[i]] <<- if (data$S[[i]] == "S") i else left_val
}
this_or_right <- function(right_val, i) {
res <- if (data$S[[i]] == "S") i else right_val
closest_right[[i]] <<- if (data$S[[i]] == "S") i else right_val
}
purrr::reduce(indices, this_or_left, .init = this_or_left(NA, 1))
purrr::reduce_right(indices, this_or_right, .init = this_or_right(NA, length(indices)))
Whether you could do it with vectorised expressions I don't know. Possibly. I didn't try.
Now, I simply have to compute the distance to the closest S and make labels from that, using empty labels if the distance is greater than 3 and label "S" if the distance is zero.
get_dist <- Vectorize(function(i) {
down <- i - closest_left[i]
up <- closest_right[i] - i
if (is.na(down) || down > up) up
else if (is.na(up) || down <= up) -down
else NA
})
make_label <- Vectorize(function(dist) {
if (abs(dist) > 3) ""
else if (dist == 0) "S"
else if (dist < 0) paste0("S", dist)
else if (dist > 0) paste0("S+", dist)
})
make_label(get_dist(indices))
Here, I used Vectorized expressions to change it up a little.