r - 根据多个向量的多个条件创建数值样本

Question

给定以下数据框:

df <- tibble::tribble(
  ~pass_id, ~km_ini, ~km_fin,
        1L,    0.89,    2.39,
        2L,    1.53,    3.03,
        3L,    21.9,    23.4,
        4L,    23.4,    24.9,
        5L,      24,    25.5,
        6L,    25.9,    27.4,
        7L,    36.7,    38.2,
        8L,    41.4,    42.9,
        9L,    42.1,    43.6,
       10L,    45.5,      47
  )

创建于 2020-02-17 由 reprex package (v0.3.0)

我需要与 匹配的任意 50 个数字的样本全部 以下标准适用于 所有行 的 df :

>= .750

<= 99.450

< km_ini - .750

> km_fin + .750

我的最佳射门与我的期望相去甚远。首先我做了一个 runif ，然后我 enframe d它，并试图 filter ，但我只是让它在前两个条件下工作。无论如何，我不一定需要将结果作为数据框，它可能是一个数字向量。

library(tidyverse, verbose = F)

set.seed(42)
sort(runif(100000, 0, 99.450)) %>% 
  enframe(., "ID", "km") %>% 
  filter(km >= .750 & km <= 99.450 - .750)
#> # A tibble: 98,467 x 2
#>       ID    km
#>    <int> <dbl>
#>  1   763 0.750
#>  2   764 0.751
#>  3   765 0.751
#>  4   766 0.753
#>  5   767 0.753
#>  6   768 0.754
#>  7   769 0.754
#>  8   770 0.755
#>  9   771 0.755
#> 10   772 0.757
#> # … with 98,457 more rows

编辑:试图直观地显示问题

最终结果需要是评估整个数据集的数值向量(或 df)，而不仅仅是分别评估每一行。作为前两行的示例，请参见以下表示:



所以，请看:

黑线表示我的数据不能小于 0.750。

蓝线表示由于第 1 行的 km_ini 和 km_fin(箭头)的覆盖区域以及考虑 + 或 - .750(箭头和点之间)区域的另一个附录而无法记录的位置。

红线表示由于第 2 行的 km_ini 和 km_fin(箭头)的覆盖区域以及考虑 + 或 - .750(箭头和点之间)区域的另一个附录，我无法记录的地方。

这样一来，前 4000 米内的随机数据集只能包含 3030 + .750 的数字。

那么，问题是尝试以编程方式执行此操作，以便评估数据帧的所有行并且生成的数字不在提到的所有条件内。

Answer 1

我觉得我懂了。您想在由距离分隔的间隙中采样，复杂的因素是您无法在 750m 的标记距离的任一侧采样。

我认为对问题有更清晰的视觉理解很有用。在这个图中，x 轴代表距离(y 轴只是一个“虚拟”轴，因为我们只对 x 轴感兴趣)。黑条是我们无法采样的“禁区”。在我们不想采样的禁区两侧还有 750m 区域，这里用红色表示:



所以本质上，我们想要一个来自该图中 x 轴的非阴影区域的统一样本。

我的解决方案是首先合并重叠的段，然后创建一个根据每个间隙的大小加权的样本空间，并从该空间中取 50 个统一样本。

在这里，我已经概括为允许任意限制和样本大小。

sample_space <- function(km_ini, km_fin, km_max = 99.45, buffer = 0.75, n = 50)
{
  # Find and merge overlaps
  i <- 1
  km_ini <- km_ini - buffer
  km_fin <- km_fin + buffer
  while(i <= length(km_ini))
  {
    overlaps <- which(km_ini < km_fin[i] & km_fin > km_ini[i])
    if(length(overlaps) < 2) {i <- i + 1; next;}
    km_ini <- c(km_ini, min(km_ini[overlaps]))
    km_fin <- c(km_fin, max(km_fin[overlaps]))
    km_ini <- km_ini[-overlaps]
    km_fin <- km_fin[-overlaps]
    i <- 1
  }

  # Create a matrix of appropriate gaps
  gaps <- cbind(sort(km_fin), c(sort(km_ini)[-1], km_max))

  print(gaps)
  # Create a weighted sample space
  splits <- c(0, cumsum(apply(gaps, 1, diff)))

  # Take a sample within that space
  runifs <- runif(n, 0, max(splits))

  # Add the appropriate starting value back on
  index <- as.numeric(cut(runifs, splits))
  runifs - splits[index] + gaps[index, 1]
}

所以现在我们可以做

sample_space(df$km_ini, df$km_fin)
#>  [1] 93.107858 92.216660 83.597703 86.341198 72.258245 86.591883 18.572744
#>  [8] 16.641163 73.344658 73.075426 78.230074 97.745802 52.654342 52.298444
#> [15] 70.029034 67.430346 95.328900 62.250864 79.144025 86.344868  7.063474
#> [22] 58.797335 79.304272 54.731057 32.137068 84.837576 94.226992 50.808135
#> [29] 65.987277 76.666933 29.225744 33.309866 13.013735  6.925277 65.207383
#> [36] 91.591293 61.614993 18.646062 97.550237 48.478875 12.860920 20.263471
#> [43] 34.980616 50.583291 15.813562 96.104448 91.310377 53.063613 17.376281
#> [50] 72.511153

为了表明这符合我们的要求，让我们在禁区图上绘制样本:

set.seed(69)
sample_df <- data.frame(x = sample_space(df$km_ini, df$km_fin),
                      y = runif(50, 0.45, 0.55))

ggplot(df) + 
  geom_rect(aes(xmin = km_ini - 0.75, xmax = km_fin + 0.75, ymin = 0, ymax = 1), 
            alpha = 0.5, fill = "red") +
  geom_rect(aes(xmin = km_ini, xmax = km_fin, ymin = 0, ymax = 1), fill = "black") +
  geom_rect(aes(xmin = 0, xmax = 0.75, ymin = 0, ymax = 1), alpha = 0.5) +
  geom_rect(aes(xmin = 99.45, xmax = 100, ymin = 0, ymax = 1), alpha = 0.5) +
  labs(x = "distance", y = "dummy") +
  geom_point(data = sample_df, aes(x = x, y = y), col = "blue")

创建于 2020-03-01 由 reprex package (v0.3.0)