1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
## find nearest event for each time step
nearestEvent <- function(times, eventtimes) {
eventtimes <- unique(eventtimes) # remove double events first
## sorting does not cost much if already sorted
times <- sort(times)
eventtimes <- sort(eventtimes)
## find index of events where time is between
inearest <- findInterval(times, eventtimes)
## special care for smallest and biggest element
lower <- eventtimes[pmax(inearest, 1)]
upper <- eventtimes[pmin(inearest + 1, length(eventtimes))]
nearest <- ifelse(times - lower < upper - times, lower, upper)
return(nearest)
}
## remove times that are numerically "too close" to an event
cleanEventTimes <- function(times, eventtimes, eps = .Machine$double.eps * 10) {
## sorting does not cost much if already sorted
## sort times to ensure match of returned "nearest" value
times <- sort(times)
nearest <- nearestEvent(times, eventtimes)
## use bigger of the two numbers
div <- pmax(times, nearest)
## special handling of zero
div <- ifelse(div == 0, 1, div)
reldiff <- abs(times - nearest) / div
tooClose <- reldiff < eps
times[!tooClose]
}
|
