For more details: https://ropensci.org/technotes/2019/06/07/ropensci-docs/
ropenscibot
| 1 |
find.episode.time <- function(episode) { |
|
| 2 | 1 |
time <- unlist(lapply(episode@data, |
| 3 | 1 |
function(d) { |
| 4 | 1 |
if (length(d) > 1) |
| 5 | 1 |
return(as.character(d$time)) |
| 6 |
else
|
|
| 7 | 1 |
return(NULL) |
| 8 | 1 |
}), use.names=FALSE) |
| 9 | 1 |
if (is.null(time)) |
| 10 | 1 |
return(list(admt=as.POSIXct(NA), |
| 11 | 1 |
dsct=as.POSIXct(NA))) |
| 12 |
else { |
|
| 13 | 1 |
time <- tryCatch(xmlTime2POSIX(time), |
| 14 | 1 |
error=function(e) { |
| 15 |
cat("time is not xmlTime format.\n") |
|
| 16 |
print(unlist(time)) |
|
| 17 |
stop() |
|
| 18 |
})
|
|
| 19 | 1 |
return(list(admt=min(time), dsct=max(time))) |
| 20 |
}
|
|
| 21 |
}
|
|
| 22 |
|
|
| 23 |
|
|
| 24 |
|
|
| 25 |
|
|
| 26 |
#' Convert calendar date-time to the time difference comparing to the ICU
|
|
| 27 |
#' admission time.
|
|
| 28 |
#'
|
|
| 29 |
#' @param record ccRecord
|
|
| 30 |
#' @param pseudotime logical If pseudotime is set to be TRUE, then the
|
|
| 31 |
#' admission and discharge time will be set as the earliest and latest data stamp
|
|
| 32 |
#' in the record.
|
|
| 33 |
#' @param units units of delta time, which can be "hours", "mins", "days".
|
|
| 34 |
#' @param tdiff if false the delta time will be written in numeric format.
|
|
| 35 |
#' @export deltaTime
|
|
| 36 |
deltaTime <- function(record, pseudotime=FALSE, units="hours", tdiff=FALSE) { |
|
| 37 | 1 |
nep <- record@nepisodes |
| 38 | 1 |
if (nep == 0) |
| 39 | 1 |
stop("record is an empty ccRecord object!") |
| 40 |
|
|
| 41 |
# for pseudotime data only:
|
|
| 42 |
# convert hash admin time to the earliest time of the record
|
|
| 43 | 1 |
if (pseudotime == TRUE) { |
| 44 | 1 |
admdsct <- for_each_episode(record, find.episode.time) |
| 45 | 1 |
for(e in seq(record@episodes)) { |
| 46 | 1 |
record@episodes[[e]]@t_admission <- admdsct[[e]]$admt |
| 47 | 1 |
record@episodes[[e]]@t_discharge <- admdsct[[e]]$dsct |
| 48 |
}
|
|
| 49 |
}
|
|
| 50 |
|
|
| 51 | 1 |
update_time <- function(ep) { |
| 52 | 1 |
env <- environment() |
| 53 | 1 |
t_admission <- xmlTime2POSIX(ep@t_admission, allow=TRUE) |
| 54 | 1 |
if (is.na(t_admission)) { |
| 55 | 1 |
return(NULL) |
| 56 |
}
|
|
| 57 |
else { |
|
| 58 | 1 |
eps <-
|
| 59 | 1 |
lapply(ep@data, |
| 60 | 1 |
function(data) { |
| 61 | 1 |
if (length(data) > 1) { |
| 62 | 1 |
data$time <- |
| 63 | 1 |
difftime(xmlTime2POSIX(data$time), |
| 64 | 1 |
env$t_admission, |
| 65 | 1 |
units=units) |
| 66 | 1 |
if (!tdiff) |
| 67 | 1 |
data$time <- as.numeric(data$time) |
| 68 |
|
|
| 69 |
}
|
|
| 70 | 1 |
return(data) |
| 71 |
})
|
|
| 72 | 1 |
newep <- new.episode(eps) |
| 73 | 1 |
newep@parse_file <- ep@parse_file |
| 74 | 1 |
newep@parse_time <- ep@parse_time |
| 75 | 1 |
newep |
| 76 |
}
|
|
| 77 |
}
|
|
| 78 |
|
|
| 79 |
|
|
| 80 | 1 |
record <- ccRecord() + for_each_episode(record, update_time) |
| 81 |
|
|
| 82 | 1 |
if (pseudotime == TRUE) { |
| 83 | 1 |
for(e in seq(record@episodes)) { |
| 84 | 1 |
record@episodes[[e]]@t_admission <- admdsct[[e]]$admt |
| 85 | 1 |
record@episodes[[e]]@t_discharge <- admdsct[[e]]$dsct |
| 86 |
}
|
|
| 87 | 1 |
record <- index.record(record) |
| 88 |
}
|
|
| 89 |
|
|
| 90 |
|
|
| 91 | 1 |
if (nep != record@nepisodes) { |
| 92 | 1 |
if (pseudotime) |
| 93 | 1 |
warning(nep - record@nepisodes, |
| 94 | 1 |
" episodes have been removed due to no admission data.") |
| 95 |
else
|
|
| 96 | 1 |
warning(nep - record@nepisodes, |
| 97 | 1 |
" episodes have been removed due to no time-wise data.") |
| 98 |
}
|
|
| 99 | 1 |
return(record) |
| 100 |
}
|
Read our documentation on viewing source code .