Я ищу функцию в R для выбора некоторых оптимальных (с точки зрения расстояния) точек из вектора с течением времени.
Пусть x будет фреймом данных x=data.frame(x.val,x.time)
x.val x.time
[1,] x1 x.Time1
[2,] x2 x.Time2
[3,] x3 x.Time3
и y будет фреймом данных y=data.frame(y.val,y.time)
y.val y.time
[1,] y1 y.Time1
[2,] y2 y.Time2
[3,] y3 y.Time3
[4,] y4 y.Time4
[5,] y5 y.Time5
[6,] y6 y.Time6
[7,] y7 y.Time7
Обратите внимание, чтоx и y имеют различную длину (length(x)=3, length(y)=7), и мы предполагаем, что здесь измерение продолжается (например, в миллисекундах).
Имея структуру данных выше, я хочу написать функцию для поискасамые близкие значения в y относительно (1) времени и (2) значения до x.
Я должен сказать, что написать функцию легко, если x содержит одно значение.В этом случае функция ищет минимальное расстояние по времени (просто abs(y.time-x.time)), а затем находит минимальное расстояние x.value от точек из минимального временного расстояния.Это реализовано в приведенном ниже коде:
set.seed(123456)
closest.time.value = function(x, time1, y, time2) {
# Step 1. minimum distance on time
tmin = abs(time2 - time1)
IndT = (tmin == min(tmin))
yy = y [IndT]
ytime = time2[IndT]
# Step 2. minimum distance of values
vmin = abs(yy - x)
VInd = (vmin == min(vmin))
###########
value = yy [VInd][1]
time = ytime[VInd][1] ###########
return(list(
value = value,
time = time
))
}
##########
n = 20
y = round(runif(n), 3)
time2 = 1:n
x = runif(1, min(y), max(y))
time1 = runif(1, 1, n)
ctv = closest.time.value(
x = x,
time1 = time1,
y = y,
time2 = time2
)
plot(time2, y, main='Blue = the point on y, Green = x')
points(time1,
x,
pch = 12,
col = 3,
lwd = 7)
points(ctv$time, ctv$value, col = 4, lwd = 4)
abline(v = ctv$time)
Одна из проблем, которую я не могу решить, заключается в том, что общее количество точек, выбранных из y, должно быть равно длине x.Дублирование точки не допускается.
ОБНОВЛЕНИЕ:
Используя ответ @ Jrakru56, яобновили код и решили проблему дубликатов.Вот окончательный код:
closest.time.value = function(x, time1, y, time2) {
library(abind)
x.df = data.frame(x.val = x, x.time = time1)
y.df = data.frame(y.val = y, y.time = time2)
output2 = ol = lapply(1:nrow(x.df), function(i) {
tt <-
cbind(x.df[i,],
lapply(x.df[i,]$x.val, function(v) {
diff <- abs(y.df$y.val - v)
y.df$dist.V = diff
out <- y.df
}),
ind = i,
row.names = NULL)
tt$dist.T <- abs(tt$x.time - tt$y.time)
tt$totalD = tt$dist.V + tt$dist.T
tt = tt[order(tt$totalD),]
tt = tt[order(tt$dist.V),]
tt = tt[order(tt$dist.T),]
})
dol = 1
while (sum(dol) > 0) {
ol = lapply(
X = output2,
FUN = function(x) {
if (!is.null(x) && nrow(x) > 0) {
x[1, ]
} else{
NULL
}
}
)
ol2 = abind(ol, along = 1)
dol = duplicated(ol2[, 3:4])
if (sum(dol)) {
print(ol2[dol,])
output2[dol] = lapply(
output2[dol],
FUN = function(x) {
x[-1, , drop = FALSE]
}
)
}
}
####################
return(as.data.frame(abind(ol[!unlist(lapply(
ol,
FUN = function(x) {
is.null(x) || length(x) < 1
}
))], along = 1)))
}
##########
# Simulated points
set.seed(123456)
n = 50 # y length
k = 9 # x length
deci = 1 # just to make example fancy!
y = round(runif(n), deci)
time2 = round(rnorm(n), deci)
x = round(runif(k, min(y), max(y)), deci)
time1 = round(runif(length(x), min(time2), max(time2)), deci)
ctv = closest.time.value(
x = x,
time1 = time1,
y = y,
time2 = time2
)
# Plots
plot(time2, y, type = 'p')
points(
time1,
x,
pch = paste(1:length(time1)),
col = 2,
cex = 2.5,
lwd = 7
)
legend(
'top',
legend = c('x!', 'y!'),
fill = c(2, 4),
horiz = TRUE,
inset = -.06,
xpd = TRUE
)
points(
ctv$y.time,
ctv$y.val,
col = 4,
lwd = 4,
pch = paste(1:length(ctv$y.time)),
cex = 2
)
abline(v = ctv$y.time,
col = 4,
lty = 3)
abline(v = time1, col = 2, lty = 3)
Вот вывод функции: 