代码之家 › 专栏 › 技术社区 › ayasugihada

R: 基于数据帧中的连续条目(两个条目之间的间距不等)更改条目的值

rows dataset r

ayasugihada · 技术社区 · 7 年前

我需要在我的大脑成像数据中编辑一些用于ER目的的标记,这基本上意味着如果第一个连续的非零条目具有某个值,我需要更改条目的值。我不知道我是否需要为它编写一个自定义函数(如果我需要这样做,请朝着正确的方向轻推一下)。

最好用一个示例来说明我的问题(假设列标记是16000行数据集的一个片段,其中包含有关标记值的信息):

markers = matrix(c(1,0,0,0,0,2,0,0,0,0,1,0,0,0,3), ncol = 1)

如果下一个非零条目是2,我需要将值1更改为(f.e.)值9(但如果是3,则不需要)。这两个条目之间没有相等的间距(也就是说,这两个感兴趣的条目之间可能有3-8个零条目。

我很高兴能得到任何帮助,因为我真的不想手动更改这些值:d。

2 回复 | 直到 7 年前

missuse 7 年前

也许不是最简单的方法,但这里有一种使用base R的方法: 我会一步一步地写,这样你就可以看到每一步都发生了什么。

第一个do rle

b <- rle(markers[,1])$values

检查哪些元素为1

z <- which(b==1)

现在检查0是否为前面的一个元素如果是,则取前面两个元素的索引

k <- ifelse(b[z + 1] == 0, z + 2, z + 1)

现在检查这些元素是否等于2,删除任何不等于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

Maurits Evers 7 年前

还有一种方法:

markers <- matrix(c(1,0,0,0,0,2,0,0,0,0,1,0,0,0,3), ncol = 1)

创建 dataframe 所有可能的滞后版本 markers .

# 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的条目 any 的滞后版本 标记 .

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