根据值范围向列添加/合并/变异值

Question

我有两个数据帧，一个（称为“trialTS”）包含一系列“试验”（1、2、3 等）以及一个开始和结束时间戳：

trial start    end

1   48.37500    49.76822
2   53.90189    55.35198
3   59.48472    60.96783
4   65.10088    66.40155
5   70.55197    71.95272
6   76.08391    77.50065
7   81.63425    83.10151
8   87.23389    88.58481
9   92.71907    93.98458
10  98.11758    99.43337

我有第二个数据帧（称为“eyeData”），其中包含许多行（>100 万行），这些行具有样本记录的时间戳（来自眼球追踪器）：

time      gaze_x    gaze_y
48.37877    -260.5  20.099976
48.37879    -257.8  17.700012
48.37879    -265.5  16.500000
48.37880    -256.6  15.799988
48.37881    -264.1  16.900024
48.37881    -254.5  14.400024
48.37882    -263.0  19.400024
48.37882    -262.6  12.900024
48.38070    -259.4  16.500000
48.38071    -262.5  16.299988
48.38277    -260.8  16.400024
48.38277    -259.3  14.700012
48.38759    -265.9  11.700012

我希望能够将适当的试用号添加到 eyeData 记录中。所以我需要根据 trialTS 的开始和结束列在 eyeData 中评估每次。这是当前的解决方案：

# function to list the trial numbers for the samples
getTrialNumbers <- function(dataIn){
  trialTS %>% 
    filter((dataIn >= trialTS$start) & (dataIn < trialTS$end)) %>% 
    select(trial) %>% 
    as.numeric() %>% 
    return()
}

eyeTrialNums <- flatten_dbl(map(eyeData$time,getTrialNumbers)) # RUNNING THIS TAKES AGES!

cbind(eyeData,eyeTrialNums)

问题在于，对超过 100 万行 eyeData 数据帧执行此操作的过程意味着可能需要大约 20 分钟。谁能帮我更好地解决这个问题？

数据

trialTS <- read.table(h=T,text="trial start    end
1   48.37500    49.76822
2   53.90189    55.35198
3   59.48472    60.96783
4   65.10088    66.40155
5   70.55197    71.95272
6   76.08391    77.50065
7   81.63425    83.10151
8   87.23389    88.58481
9   92.71907    93.98458
10  98.11758    99.43337")

eyeData <- read.table(h=T,text="
  time      gaze_x    gaze_y
48.37877    -260.5  20.099976
48.37879    -257.8  17.700012
48.37879    -265.5  16.500000
48.37880    -256.6  15.799988
48.37881    -264.1  16.900024
48.37881    -254.5  14.400024
48.37882    -263.0  19.400024
48.37882    -262.6  12.900024
48.38070    -259.4  16.500000
48.38071    -262.5  16.299988
48.38277    -260.8  16.400024
48.38277    -259.3  14.700012
48.38759    -265.9  11.700012")

Answer 1

你可以使用包fuzzyjoin：

fuzzyjoin::interval_right_join(trialTS, eyeData, by = c(start = "time", end = "time"))
#>    trial  start      end     time gaze_x   gaze_y
#> 1      1 48.375 49.76822 48.37877 -260.5 20.09998
#> 2      1 48.375 49.76822 48.37879 -257.8 17.70001
#> 3      1 48.375 49.76822 48.37879 -265.5 16.50000
#> 4      1 48.375 49.76822 48.37880 -256.6 15.79999
#> 5      1 48.375 49.76822 48.37881 -264.1 16.90002
#> 6      1 48.375 49.76822 48.37881 -254.5 14.40002
#> 7      1 48.375 49.76822 48.37882 -263.0 19.40002
#> 8      1 48.375 49.76822 48.37882 -262.6 12.90002
#> 9      1 48.375 49.76822 48.38070 -259.4 16.50000
#> 10     1 48.375 49.76822 48.38071 -262.5 16.29999
#> 11     1 48.375 49.76822 48.38277 -260.8 16.40002
#> 12     1 48.375 49.76822 48.38277 -259.3 14.70001
#> 13     1 48.375 49.76822 48.38759 -265.9 11.70001

^{由reprex package (v0.3.0) 于 2019 年 12 月 12 日创建}

它包装了 IRanges 包，该包旨在有效地处理范围，因此它应该比您尝试过的要快得多。

Answer 2

我们可以使用来自data.table的非等连接

library(data.table)
setDT(eyeData)[trialTS, on = .(time >= start, time < end) , nomatch = FALSE]