## 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
}