基于R中现有标签创建行标签

Question

我有一个df，它的标签是"S“，我的数字列是<35。我想使用每个S位置，并将前面的3行标记为" S -1“、"S-2”、"S-3“，然后对后面的2行使用"S+1”、"S+2“。

像这样..。

N    S
45   
56   
67   S-3
47   S-2
52   S-1
28   S
89   S+1
66   S+2
55 
76

我用这个来启动我，举个例子。

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", "")

有什么想法吗..？

Answer 1

下面是一个使用base R的选项，其中我们获得'N‘小于35 ('i1')的行索引，创建带有空白("")元素的'S’列，循环遍历'i1'，得到3个元素之前的序列，2个元素之后的序列，'S‘的paste，得到带有索引('ind')的序列intersect，并将字符串('val')赋值给'S’列。

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]

数据

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

在不处理可能的重叠的情况下，这里有一组ifelse()语句来完成工作。也许你可以想出一种更合适的方法来概括它。

您可以将lag()和lead()与dplyr包一起使用。

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))

(如果第一个值不小于35，您将在前两行中获得NA值，因此将这些值替换为“”。)

     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

这是一个很长的答案，因为我把它分解成了一些片段，我通常会使用管道和lambda表达式来实现它，但是它应该很容易遵循。

我将处理行索引，并计算两个向量，一个向量包含左边最接近i的具有标签"S"的索引，另一个包含右边最接近i的索引。

indices <- 1:length(data$S)
closest_left  <- rep(NA, length = length(indices))
closest_right <- rep(NA, length = length(indices))

我使用purrr的精简函数来计算这些函数，但是您也可以很容易地在一个循环中这样做。

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)))

我不知道你能不能用矢量表达。有可能。我没试过。

现在，我只需计算到最近的S的距离，然后根据它制作标签，如果距离大于3，使用空标签，如果距离为零，则使用标签"S"。

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))

在这里，我使用了Vectorized表达式来稍微修改它。