我需要在我的大脑成像数据中编辑一些用于ER目的的标记，这基本上意味着如果第一个连续的非零条目具有某个值，我需要更改条目的值。我不知道我是否需要为它编写一个自定义函数(如果我需要这样做，将不胜感激正确的方向
)。更好地用一个例子来说明我的问题(假设col 标记是包含标记值信息的 16000 行数据集的片段)：
markers = matrix(c(1,0,0,0,0,2,0,0,0,0,1,0,0,0,3), ncol = 1)
如果下一个非零条目为 2(但如果是 3，则不需要)，我需要将值 1 更改为(f.e.)值 9。这些条目之间没有相等的间距(这意味着，这两个感兴趣的条目之间可能有 3-8 个零条目。
我很高兴得到任何帮助，因为我真的不想:D手动更改这些值。
也许不是最直接的方法，但这里有一个使用基本 R： 的方法： 我将逐步编写它，以便您可以看到每个步骤中发生的事情。
首先要做rle
b <- rle(markers[,1])$values
检查哪些元素为 1
z <- which(b==1)
现在检查 0 是否是前面的一个元素，如果是，则前面取两个元素的索引
k <- ifelse(b[z + 1] == 0, z + 2, z + 1)
现在检查这些元素是否等于 2，删除任何不等于
v <- ifelse(b[k] == 2, z, NA)
v <- na.omit(v)
将剩余索引的值更改为 9
b[v] = 9
取回矢量
rep(b, times = rle(markers[,1])$lengths)
#output
[1] 9 0 0 0 0 2 0 0 0 0 1 0 0 0 3
markers[,1]
#output
[1] 1 0 0 0 0 2 0 0 0 0 1 0 0 0 3
这里有一个小基准：
evers <- function(markers){require(dplyr);
df <- sapply(1:nrow(markers), function(i) lead(markers, i - 1))
idx <- which(df[, 1] == 1);
idx
idx <- idx[sapply(idx, function(i) any(df[i, 2:nrow(df)] == 2, na.rm = TRUE))]}
mss <- function(markers) {
b <- rle(markers[,1])$values
z <- which(b==1)
k <- ifelse(b[z + 1] == 0, z + 2, z + 1)
v <- ifelse(b[k] == 2, z, NA)
v <- na.omit(v)
b[v] = 9
rep(b, times = rle(markers[,1])$lengths)
b
}
microbenchmark(
mss(markers),
evers(markers)
)
#Unit: microseconds
expr min lq mean median uq max neval
mss(markers) 42.667 45.555 118.2324 50.046 52.1315 6681.986 100
evans(markers) 128.322 133.775 271.2453 136.021 140.6725 12645.376 100
使用更大的数据集：
markers = matrix(rep(c(1,0,0,0,0,2,0,0,0,0,1,0,0,0,3), times = 1000), ncol = 1)
#output
Unit: microseconds
expr min lq mean median uq max neval
mss(markers) 823.5 904.5025 1144.658 957.5945 1045.174 5455.24 100
evans(markers) 2940719.3 3185982.7470 3453372.766 3242533.4130 3299607.308 11652090.81 100
这是另一种方式：
markers <- matrix(c(1,0,0,0,0,2,0,0,0,0,1,0,0,0,3), ncol = 1)
创建所有可能的滞后版本的dataframemarkers。
# Create dataframe of lagged vectors
require(dplyr);
df <- sapply(1:nrow(markers), function(i) lead(markers, i - 1));
获取无滞后向量中的条目等于 1 的行索引。
# Select rows where entry = 1
idx <- which(df[, 1] == 1);
idx;
#[1] 1 11
仅保留那些对于行idx存在等于 2 的条目的索引，anymarkers的滞后版本。
# Keep only those rows where entry = 1 followed by a lagged 2
idx <- idx[sapply(idx, function(i) any(df[i, 2:nrow(df)] == 2, na.rm = TRUE))];
最后，将这些行的值设置为等于 9。
# Set those entries equal to 9
markers[idx, 1] <- 9;
markers;
# [,1]
# [1,] 9
# [2,] 0
# [3,] 0
# [4,] 0
# [5,] 0
# [6,] 2
# [7,] 0
# [8,] 0
# [9,] 0
#[10,] 0
#[11,] 1
#[12,] 0
#[13,] 0
#[14,] 0
#[15,] 3
更新
以第二个markers为例：
markers <- matrix(c(1,0,0,0,0,2,0,0,0,0,1,0,0,0,2,0,0,0,0,1,0,0,0,0,3), ncol = 1);
df <- sapply(1:nrow(markers), function(i) lead(markers, i - 1));
idx <- which(df[, 1] == 1);
idx <- idx[sapply(idx, function(i) any(df[i, 2:nrow(df)] == 2, na.rm = TRUE))];
markers[idx, 1] <- 9;
markers;
# [,1]
# [1,] 9
# [2,] 0
# [3,] 0
# [4,] 0
# [5,] 0
# [6,] 2
# [7,] 0
# [8,] 0
# [9,] 0
#[10,] 0
#[11,] 9
#[12,] 0
#[13,] 0
#[14,] 0
#[15,] 2
#[16,] 0
#[17,] 0
#[18,] 0
#[19,] 0
#[20,] 1
#[21,] 0
#[22,] 0
#[23,] 0
#[24,] 0
#[25,] 3