Мне кажется, я понимаю. Вы хотите производить выборку в промежутках, ограниченных расстояниями, с усложняющим фактором, который вы не можете выбрать по обе стороны от отмеченных расстояний для 750 м.
Я думаю, что было бы полезно получить более четкое визуальное понимание проблемы , На этом графике ось x представляет расстояние (ось y является просто фиктивной осью, поскольку нас интересует только ось x). Черные полосы - это «зоны отчуждения», в которых мы не можем проводить выборки. Есть также 750-метровые зоны по обе стороны от зон отчуждения, в которых мы не хотим брать пробы, которые здесь окрашены в красный цвет:
По сути , мы хотим получить равномерную выборку из незатененных областей оси 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 пакетом Представить (v0.3.0)