248 lines
7.2 KiB
R
248 lines
7.2 KiB
R
|
|
||
|
|
## Utils
|
||
|
|
|
||
|
|
multi_rev <- function(ds, var){
|
||
|
|
ndx <- match(var,colnames(ds))
|
||
|
|
for (i in seq_along(ndx)){
|
||
|
|
j <- ndx[i]
|
||
|
|
ds[[j]]<-as.character(factor(ds[[j]],labels = c(rev(levels(factor(ds[[j]]))))))
|
||
|
|
}
|
||
|
|
ds
|
||
|
|
}
|
||
|
|
|
||
|
|
reg2score <- function(ds){
|
||
|
|
# Removes all padding from registred scores
|
||
|
|
l <- c()
|
||
|
|
for (i in seq_len(ncol(ds))){
|
||
|
|
l[[i]] <- gsub("[^a-zA-Z0-9]","",ds[[i]])
|
||
|
|
}
|
||
|
|
|
||
|
|
d <- do.call(cbind,l) |> data.frame()
|
||
|
|
|
||
|
|
colnames(d) <- colnames(ds)
|
||
|
|
d |> tibble()
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
## MFI modding
|
||
|
|
|
||
|
|
mfi_domains <- function(ds, reverse=TRUE, var){
|
||
|
|
|
||
|
|
# Subscore indexes
|
||
|
|
indexes <- list(
|
||
|
|
data.frame(grp="gen", ndx=c(1, 5, 12, 16)),
|
||
|
|
data.frame(grp="phy", ndx=c(2, 8, 14, 20)),
|
||
|
|
data.frame(grp="act", ndx=c(3, 6, 10, 17)),
|
||
|
|
data.frame(grp="mot", ndx=c(4, 9, 15, 18)),
|
||
|
|
data.frame(grp="men", ndx=c(7, 11, 13, 19))
|
||
|
|
) |> bind_rows() |> arrange(ndx)
|
||
|
|
|
||
|
|
# Assumes reverse scores are not correctly reversed
|
||
|
|
if (reverse){ds <- ds |> multi_rev(var)}
|
||
|
|
|
||
|
|
# Removes padding and converts to numeric
|
||
|
|
d <- ds |> reg2score() |>
|
||
|
|
mutate_if(is.character, as.numeric)
|
||
|
|
|
||
|
|
split.default(d, factor(indexes$grp)) |>
|
||
|
|
lapply(function(x){
|
||
|
|
apply(x, MARGIN = 1, sum)
|
||
|
|
}) |> bind_cols()
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
## Registration correction
|
||
|
|
|
||
|
|
# 1. If the inc_time is 38 days or less MDI 6 scores are moved to MDI 1 and visit 6 is defined as visit 1.
|
||
|
|
# 2. If both visit 1 and 6 dates are NA, use enddate as visit 1 date. This is the case if patients were excluded early.
|
||
|
|
# 3. If visit 6 is recorded later than enddate, use enddate instead. MDI 6 score is dropped.
|
||
|
|
# 4. If visit delay is 7 days or less, and inclusion time is more than 38, MDI 1 is moved to MDI 6 and dropped. If MDI 1 and 6 are different both are kept. Enddate is moved to visit 6 date.
|
||
|
|
# 5. Defining the visit 6 date as same as enddate if visit delay is <7.
|
||
|
|
|
||
|
|
# ds <- ls_nas$mdi
|
||
|
|
# ref <- subjects
|
||
|
|
|
||
|
|
|
||
|
|
time_reg_correction <- function(ds, ref) {
|
||
|
|
|
||
|
|
# Splitting by rnumb, to treat each subj
|
||
|
|
ls <- split(ds, ds$rnumb)
|
||
|
|
|
||
|
|
# ref: https://r-coder.com/progress-bar-r/
|
||
|
|
# Setting up simple progress bar
|
||
|
|
pb <- txtProgressBar(min = 0, max = length(ls), style = 3)
|
||
|
|
|
||
|
|
|
||
|
|
# Getting the rnumbs for subsetting in order of the list
|
||
|
|
nms <- names(ls)
|
||
|
|
# Applying correction to each element in list
|
||
|
|
ls_c <- lapply(seq_along(ls), function(i) {
|
||
|
|
cat(paste(i,"af",length(ls)))
|
||
|
|
# Updates the current state
|
||
|
|
setTxtProgressBar(pb, i)
|
||
|
|
|
||
|
|
# Current rnumb
|
||
|
|
nm <- nms[i]
|
||
|
|
# print(i)
|
||
|
|
df <- ls[[i]]
|
||
|
|
# Only run if both instance 2 and 4 are present
|
||
|
|
if (all(c(2, 4) %in% select(df, matches("instance", ignore.case = TRUE))[[1]])) {
|
||
|
|
|
||
|
|
# Define common variables
|
||
|
|
inc_time <- as.numeric(ref$inc_time[ref$rnumb == nm])
|
||
|
|
end_date <- as.Date(ref$enddate[ref$rnumb == nm])
|
||
|
|
rdate <- as.Date(ref$rdate[ref$rnumb == nm])
|
||
|
|
inst <- grep("instance", tolower(colnames(df)))
|
||
|
|
|
||
|
|
# Define relevant data columns to substitute/modify
|
||
|
|
cols <- (inst + 1):ncol(df)
|
||
|
|
|
||
|
|
# Define date column index
|
||
|
|
date_col_index <-
|
||
|
|
match(colnames(select(df, ends_with("00"))), colnames(df))
|
||
|
|
|
||
|
|
# Step 1
|
||
|
|
|
||
|
|
## Correction if inc_time is performed
|
||
|
|
if (inc_time <= 38 & all(is.na(df[df[inst] == 2, cols]))) {
|
||
|
|
# Substitutions to transfer instance 4 meassures and leave as NA
|
||
|
|
df[df[inst] == 2, cols] <- df[df[inst] == 4, cols]
|
||
|
|
df[df[inst] == 4, -c(inst,date_col_index)] <- NA
|
||
|
|
}
|
||
|
|
|
||
|
|
# Step 2
|
||
|
|
|
||
|
|
if (all(is.na(df[date_col_index]))) {
|
||
|
|
# If both visit dates are missing, instance 2 date is substituted with enddate
|
||
|
|
df[date_col_index][df[inst] == 2] <-
|
||
|
|
as.character(end_date)
|
||
|
|
}
|
||
|
|
|
||
|
|
# Step HELPA
|
||
|
|
## Extra help step to impute enddate as visit 4 if instance 4 is present but no date.
|
||
|
|
if (is.na(df[date_col_index][df[inst] == 4])){
|
||
|
|
df[date_col_index][df[inst] == 4] <- as.character(end_date)
|
||
|
|
}
|
||
|
|
|
||
|
|
## Last steps are only performed if date values are available for both instance 2 and 4
|
||
|
|
if (!any(is.na(df[date_col_index]))){
|
||
|
|
|
||
|
|
# Step 3
|
||
|
|
end_delay <- as.numeric(difftime(df[date_col_index][df[inst] == 4],
|
||
|
|
end_date,
|
||
|
|
units = "days"))
|
||
|
|
|
||
|
|
# If enddate is before last visit, the last visit data is dropped.
|
||
|
|
if (end_delay > 2) {
|
||
|
|
df[df[inst] == 4,-c(inst,date_col_index)] <- NA
|
||
|
|
}
|
||
|
|
|
||
|
|
# Step 4
|
||
|
|
visit_delay <-
|
||
|
|
as.numeric(difftime(df[date_col_index][df[inst] == 4], df[date_col_index][df[inst] ==
|
||
|
|
2], units = "days"))
|
||
|
|
|
||
|
|
if (purrr::is_empty(visit_delay)){
|
||
|
|
visit_delay <- NA
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
## Test if data has manually been inserted at visit 2, though should should be visit 4 time wise
|
||
|
|
second2fourth <-
|
||
|
|
if_else((visit_delay <= 7 |
|
||
|
|
all(is.na(df[df[inst] == 2, cols]))) &
|
||
|
|
inc_time > 38,
|
||
|
|
TRUE,
|
||
|
|
FALSE,
|
||
|
|
missing = FALSE)
|
||
|
|
|
||
|
|
## Move data from 2. visit to 4.
|
||
|
|
if (second2fourth) {
|
||
|
|
# df[date_col_index][df[inst] == 2]
|
||
|
|
|
||
|
|
## If all missing at last visit, 1. visit is copied
|
||
|
|
if (all(is.na(df[df[inst] == 4, cols]))) {
|
||
|
|
df[df[inst] == 4, cols] <- df[df[inst] == 2, cols]
|
||
|
|
}
|
||
|
|
|
||
|
|
## If entries at visit 2 and 4 are identical, vist 2 is deleted
|
||
|
|
if (identical(df[df[inst] == 4, cols], df[df[inst] == 2, cols])) {
|
||
|
|
df[df[inst] == 2, -c(inst,date_col_index)] <- NA
|
||
|
|
}
|
||
|
|
|
||
|
|
## If data entries are NA at visit 2, the date is also deleted
|
||
|
|
if (all(is.na(df[df[inst] == 2, cols]))) {
|
||
|
|
df[,date_col_index][df[inst] == 2] <- NA
|
||
|
|
}
|
||
|
|
|
||
|
|
## The registered enddate is copied to the visit 4 date
|
||
|
|
df[,date_col_index][df[inst] == 4] <-
|
||
|
|
as.character(end_date)
|
||
|
|
}
|
||
|
|
|
||
|
|
# Step 5
|
||
|
|
## Ensure enddate is visit 4 if visit delay is <7
|
||
|
|
if (visit_delay < 7) {
|
||
|
|
df[,date_col_index][df[inst] == 4] <- as.character(end_date)
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
df
|
||
|
|
})
|
||
|
|
|
||
|
|
ls_c |> bind_rows()
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
longlist2wide <-
|
||
|
|
function(list,
|
||
|
|
id.name = "rnumb",
|
||
|
|
instance = "instance",
|
||
|
|
inst.glue = "{.value}_{instance}") {
|
||
|
|
|
||
|
|
# ref: https://r-coder.com/progress-bar-r/
|
||
|
|
# Setting up simple progress bar
|
||
|
|
pb <- txtProgressBar(min = 0, max = length(list), style = 3)
|
||
|
|
|
||
|
|
l <- lapply(seq_along(list), function(i) {
|
||
|
|
|
||
|
|
# Updates the current state
|
||
|
|
setTxtProgressBar(pb, i)
|
||
|
|
|
||
|
|
lst <- list[[i]] |> data.frame()
|
||
|
|
|
||
|
|
rep_inst <-
|
||
|
|
length(levels(factor(lst[, colnames(lst) == instance]))) > 1
|
||
|
|
|
||
|
|
|
||
|
|
k <- lapply(split(lst, f = lst[[id.name]]), function(j) {
|
||
|
|
cname <- colnames(j)
|
||
|
|
vals <-
|
||
|
|
cname[!cname %in% c(id.name,
|
||
|
|
instance)]
|
||
|
|
s <- tidyr::pivot_wider(
|
||
|
|
j,
|
||
|
|
names_from = instance,
|
||
|
|
values_from = all_of(vals),
|
||
|
|
names_glue = inst.glue
|
||
|
|
)
|
||
|
|
s[!colnames(s) %in% instance]
|
||
|
|
})
|
||
|
|
|
||
|
|
k |> dplyr::bind_rows()
|
||
|
|
|
||
|
|
|
||
|
|
})
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
na_recode <- function(ds,vars_na,new_na="no"){
|
||
|
|
for (i in seq_along(vars_na)){
|
||
|
|
ds[i][is.na(ds[i])] <- new_na
|
||
|
|
}
|
||
|
|
ds
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
|