R/data-crunching-functions-dynamic.R

In jaropis/HRAexplorer: HRA and HRV explorer

#' export function to get analysis results
#'
#' @param analysis_type analysis type (poincare, runs, spectral)
#' @param file_addresses the addresses of the uploaded file(s)
#' @param separator the separator chosen by the user
#' @param column_data a 1x2 vector with the numbers of columns holding RR intervals and annotations
#' @param minmax 1x2 vector with the maximum and minimum acceptable RR intervals values
#' @param using_Excel boolean, whether Excel files are used
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param clicked_file number of clicked file or NULL
#' @param asym_comparisons comparisons for dynamic asymmetry analysis
#' @param flags_coding list with flags_coding
#' @param shuffle whether the data should be shuffled
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#' @param pnnX_th pnnX thresholds vector
#' @param pnn_perc_th pnn_perc_th thresholds vector

#'
#' @return the results of Poincare plot analysis
#' @export
get_dynamic_numerical_results <- function(analysis_type,
                                  fileAddresses,
                                  separator = "\t",
                                  column_data = c(1,2),
                                  minmax = c(0, 3000),
                                  using_excel = FALSE,
                                  use_ULF = "No",
                                  window_type,
                                  time_unit,
                                  move_type,
                                  window_length,
                                  clicked_file = NULL,
                                  asym_comparisons = NULL,
                                  flags_coding,
                                  shuffle = shuffle,
                                  tolerance = tolerance,
                                  pnnX_th = pnnX_th,
                                  pnn_perc_th = pnn_perc_th,
                                  sampen_m,
                                  sampen_r
                                  ) {
  if (analysis_type == "poincare_dynamic")
    return(get_dynamic_pp_results(fileAddresses,
                                  time_functions_list = glb_time_functions,
                                  separator = separator,
                                  column_data = column_data,
                                  minmax = minmax,
                                  using_excel = using_excel,
                                  window_type = window_type,
                                  time_unit = time_unit,
                                  move_type = move_type,
                                  window_length = window_length,
                                  clicked_file = clicked_file,
                                  asym_comparisons = asym_comparisons,
                                  flags_coding = flags_coding,
                                  shuffle = shuffle,
                                  tolerance = tolerance,
                                  pnnX_th = pnnX_th,
                                  pnn_perc_th = pnn_perc_th))
  if (analysis_type == "runs_dynamic")
    return(get_dynamic_runs_results(fileAddresses,
                                    time_functions_list = glb_time_functions,
                                    separator = separator,
                                    column_data = column_data,
                                    minmax = minmax,
                                    using_excel = using_excel,
                                    window_type = window_type,
                                    time_unit = time_unit,
                                    move_type = move_type,
                                    window_length = window_length,
                                    clicked_file = clicked_file,
                                    asym_comparisons = asym_comparisons,
                                    flags_coding = flags_coding,
                                    shuffle = shuffle,
                                    tolerance = tolerance))
  if (analysis_type == "spectral_dynamic")
    return(get_dynamic_spectral_results(fileAddresses,
                                        time_functions_list = glb_time_functions,
                                        separator = separator,
                                        column_data = column_data,
                                        minmax = minmax,
                                        using_excel = using_excel,
                                        use_ULF = use_ULF,
                                        window_type = window_type,
                                        time_unit = time_unit,
                                        move_type = move_type,
                                        window_length = window_length,
                                        clicked_file = clicked_file,
                                        flags_coding = flags_coding,
                                        shuffle = shuffle,
                                        tolerance = tolerance))
  if (analysis_type == "quality_dynamic")
    return(get_dynamic_quality_results(fileAddresses,
                                       time_functions_list = glb_time_functions,
                                       separator = separator,
                                       column_data = column_data,
                                       minmax = minmax,
                                       using_excel = using_excel,
                                       window_type = window_type,
                                       time_unit = time_unit,
                                       move_type = move_type,
                                       window_length = window_length,
                                       clicked_file = clicked_file,
                                       flags_coding = flags_coding,
                                       shuffle = shuffle,
                                       tolerance = tolerance))
  if (analysis_type == "chaos_dynamic")
    return(get_dynamic_chaos_results(fileAddresses,
                                       time_functions_list = glb_time_functions,
                                       separator = separator,
                                       column_data = column_data,
                                       minmax = minmax,
                                       using_excel = using_excel,
                                       window_type = window_type,
                                       time_unit = time_unit,
                                       move_type = move_type,
                                       window_length = window_length,
                                       clicked_file = clicked_file,
                                       flags_coding = flags_coding,
                                       shuffle = shuffle,
                                       tolerance = tolerance,
                                       sampen_m = sampen_m,
                                       sampen_r = sampen_r))
}

#' function for getting the results of dynamic Poincare Plot analysis
#'
#' @param file_addresses the addresses of the uploaded file(s)
#' @param separator the separator chosen by the user
#' @param column_data a 1x2 vector with the numbers of columns holding RR intervals and annotations
#' @param minmax 1x2 vector with the maximum and minimum acceptable RR intervals values
#' @param using_Excel boolean, whether Excel files are used
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param clicked_file number of clicked file or NULL
#' @param flags_coding list with flags_coding
#' @param shuffle whether the data should be shuffled
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#' @param pnnX_th pnnX thresholds vector
#' @param pnn_perc_th pnn_perc_th thresholds vector
#'
#' @return the results of Poincare plot analysis
get_dynamic_pp_results <- function(fileAddresses,
                                   time_functions_list = glb_time_functions,
                                   separator = "\t",
                                   column_data = c(1, 2),
                                   minmax = c(0, 3000),
                                   using_excel = FALSE,
                                   window_type,
                                   time_unit,
                                   move_type,
                                   window_length,
                                   clicked_file = NULL,
                                   asym_comparisons = NULL,
                                   flags_coding,
                                   shuffle,
                                   tolerance,
                                   pnnX_th,
                                   pnn_perc_th
                                   ) {
  results <- c()
  if (!is.null(clicked_file)) {
    rr_and_flags <- read_and_filter_one_file(fileAddresses, clicked_file, separator, column_data, minmax, using_excel, flags_coding, shuffle)
    single_file_result <- get_single_pp_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                         time_functions_list = time_functions_list,
                                                         window_type = window_type,
                                                         time_unit = time_unit,
                                                         move_type = move_type,
                                                         window_length = window_length,
                                                         tolerance = tolerance,
                                                         shuffle = shuffle,
                                                         pnnX_th = pnnX_th,
                                                         pnn_perc_th = pnn_perc_th)
    return(dplyr::bind_cols(tibble(`win NO` = seq(nrow(single_file_result))), single_file_result))
  } else {
    for (lineNumber in  1:length(fileAddresses[[1]])) {
      rr_and_flags <- read_and_filter_one_file(fileAddresses, lineNumber, separator, column_data, minmax, using_excel, flags_coding, shuffle)
      temp_results <- get_single_pp_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                     time_functions_list = time_functions_list,
                                                     window_type = window_type,
                                                     time_unit = time_unit,
                                                     move_type = move_type,
                                                     window_length = window_length,
                                                     tolerance = tolerance,
                                                     shuffle = shuffle,
                                                     pnnX_th = pnnX_th,
                                                     pnn_perc_th = pnn_perc_th) %>%
        round_and_summarize_dynamic_asym(round_digits = 3, asym_comparisons = asym_comparisons)
      results <- rbind(results, temp_results)
    }
    results <- cbind(fileAddresses$name, results)
    colnames(results)[1] <- "file"
    rownames(results) <- NULL
    return(results)
  }
}

#' function for getting the results of dynamic runs analysis
#'
#' @param file_addresses the addresses of the uploaded file(s)
#' @param separator the separator chosen by the user
#' @param column_data a 1x2 vector with the numbers of columns holding RR intervals and annotations
#' @param minmax 1x2 vector with the maximum and minimum acceptable RR intervals values
#' @param using_Excel boolean, whether Excel files are used
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param clicked_file number of clicked file or NULL
#' @param flags_coding list with flags_coding
#' @param shuffle whether the data should be shuffled
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#'
#' @return the results of Poincare plot analysis
get_dynamic_runs_results <- function(fileAddresses,
                                     time_functions_list = glb_time_functions,
                                     separator = "\t",
                                     column_data = c(1, 2),
                                     minmax = c(0, 3000),
                                     using_excel = FALSE,
                                     window_type,
                                     time_unit,
                                     move_type,
                                     window_length,
                                     clicked_file = NULL,
                                     asym_comparisons = NULL,
                                     flags_coding,
                                     shuffle,
                                     tolerance) {
  results <- c()
  if (!is.null(clicked_file)) {
    rr_and_flags <- read_and_filter_one_file(fileAddresses, clicked_file, separator, column_data, minmax, using_excel, flags_coding, shuffle)
    single_file_result <- get_single_runs_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                           time_functions_list = time_functions_list,
                                                           window_type = window_type,
                                                           time_unit = time_unit,
                                                           move_type = move_type,
                                                           window_length = window_length,
                                                           tolerance = tolerance,
                                                           shuffle = shuffle)
    # single_file_result[, -1] <- round(single_file_result[, -1], digits = 3)
    return(dplyr::bind_cols(tibble(`win NO` = seq(nrow(single_file_result))), single_file_result))
  } else {
    for (lineNumber in  1:length(fileAddresses[[1]])){
      rr_and_flags <- read_and_filter_one_file(fileAddresses, lineNumber, separator, column_data, minmax, using_excel, flags_coding, shuffle)
      temp_results <- get_single_runs_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                       time_functions_list = time_functions_list,
                                                       window_type = window_type,
                                                       time_unit = time_unit,
                                                       move_type = move_type,
                                                       window_length = window_length,
                                                       tolerance = tolerance,
                                                       shuffle = shuffle) %>%
        dplyr::select(-c("file")) %>%
        round_and_summarize_dynamic_asym(round_digits = 3, asym_comparisons = asym_comparisons) %>%
        as.data.frame()
      results <- plyr::rbind.fill(results, temp_results) # rbinding columns with potentially different cols
    }
    results %<>% sort_out_NAs()
    results[results == -1] <- NA # turning the -1 to NA'a
    results <- cbind(fileAddresses$name, results)
    colnames(results)[1] <- "file"
    rownames(results) <- NULL
    return(results %>% sort_out_runs())
  }
}

#' function for getting the results of Poincare Plot analysis
#'
#' @param file_addresses the addresses of the uploaded file(s)
#' @param separator the separator chosen by the user
#' @param column_data a 1x2 vector with the numbers of columns holding RR intervals and annotations
#' @param minmax 1x2 vector with the maximum and minimum acceptable RR intervals values
#' @param using_Excel boolean, whether Excel files are used
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param clicked_file number of clicked file or NULL
#' @param flags_coding list with flags_coding
#' @param shuffle whether the data should be shuffled
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#'
#' @return the results of Poincare plot analysis
get_dynamic_spectral_results <- function(fileAddresses,
                                         use_ULF = "No",
                                         time_functions_list = glb_time_functions,
                                         separator = "\t",
                                         column_data = c(1, 2),
                                         minmax = c(0, 3000),
                                         using_excel = FALSE,
                                         window_type,
                                         time_unit,
                                         move_type,
                                         window_length,
                                         clicked_file,
                                         flags_coding,
                                         shuffle,
                                         tolerance) {
  results <- c()
  if (!is.null(clicked_file)) {
    rr_and_flags <- read_and_filter_one_file(fileAddresses, clicked_file, separator, column_data, minmax, using_excel, flags_coding, shuffle)
    single_file_result <- get_single_spectral_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                         use_ULF = use_ULF,
                                                         time_functions_list = time_functions_list,
                                                         window_type = window_type,
                                                         time_unit = time_unit,
                                                         move_type = move_type,
                                                         window_length = window_length,
                                                         tolerance = tolerance,
                                                         shuffle = shuffle)
    return(dplyr::bind_cols(tibble(`win NO` = seq(nrow(single_file_result))), single_file_result))
  } else {
    for (lineNumber in  1:length(fileAddresses[[1]])) {
      rr_and_flags <- read_and_filter_one_file(fileAddresses, lineNumber, separator, column_data, minmax, using_excel, flags_coding, shuffle)
      temp_results <- get_single_spectral_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                           use_ULF = use_ULF,
                                                           time_functions_list = time_functions_list,
                                                           window_type = window_type,
                                                           time_unit = time_unit,
                                                           move_type = move_type,
                                                           window_length = window_length,
                                                           tolerance = tolerance,
                                                           shuffle = shuffle) %>%
        colMeans(na.rm = TRUE)
      results <- rbind(results, temp_results)
    }
    results <- as.data.frame(results)
    results <- cbind(fileAddresses$name, results)
    colnames(results)[1] <- "file"
    rownames(results) <- NULL
    return(results)
  }
}

#' function for getting the results of dynamic Poincare Plot analysis
#'
#' @param file_addresses the addresses of the uploaded file(s)
#' @param separator the separator chosen by the user
#' @param column_data a 1x2 vector with the numbers of columns holding RR intervals and annotations
#' @param minmax 1x2 vector with the maximum and minimum acceptable RR intervals values
#' @param using_Excel boolean, whether Excel files are used
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param clicked_file number of clicked file or NULL
#' @param flags_coding list with flags_coding
#' @param shuffle whether the data should be shuffled
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#'
#' @return the results of Poincare plot analysis
get_dynamic_quality_results <- function(fileAddresses,
                                        time_functions_list = glb_time_functions,
                                        separator = "\t",
                                        column_data = c(1, 2),
                                        minmax = c(0, 3000),
                                        using_excel = FALSE,
                                        window_type,
                                        time_unit,
                                        move_type,
                                        window_length,
                                        clicked_file,
                                        flags_coding,
                                        shuffle,
                                        tolerance) {
  results <- c()
  if (!is.null(clicked_file)) {
    rr_and_flags <- read_and_filter_one_file(fileAddresses, clicked_file, separator, column_data, minmax, using_excel, flags_coding, shuffle)
    temp_results <- get_single_quality_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                        time_functions_list = time_functions_list,
                                                        window_type = window_type,
                                                        time_unit = time_unit,
                                                        move_type = move_type,
                                                        window_length = window_length,
                                                        tolerance = tolerance,
                                                        shuffle = shuffle)
  } else {
  for (lineNumber in  1:length(fileAddresses[[1]])){
    rr_and_flags <- read_and_filter_one_file(fileAddresses, lineNumber, separator, column_data, minmax, using_excel, flags_coding, shuffle)
    temp_results <- get_single_quality_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                        time_functions_list = time_functions_list,
                                                        window_type = window_type,
                                                        time_unit = time_unit,
                                                        move_type = move_type,
                                                        window_length = window_length,
                                                        tolerance = tolerance,
                                                        shuffle = shuffle) %>%
      colMeans(na.rm = TRUE)
    results <- rbind(results, temp_results)
  }
  results <- as.data.frame(results)
  results <- cbind(fileAddresses$name, results)
  colnames(results)[1] <- "file"
  rownames(results) <- NULL
  return(results)
  }
}

#' function for getting the results of dynamic chos based analysis
#'
#' @param file_addresses the addresses of the uploaded file(s)
#' @param separator the separator chosen by the user
#' @param column_data a 1x2 vector with the numbers of columns holding RR intervals and annotations
#' @param minmax 1x2 vector with the maximum and minimum acceptable RR intervals values
#' @param using_Excel boolean, whether Excel files are used
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param clicked_file number of clicked file or NULL
#' @param flags_coding list with flags_coding
#' @param shuffle whether the data should be shuffled
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#'
#' @return the results of Poincare plot analysis
get_dynamic_chaos_results <- function(fileAddresses,
                                        time_functions_list = glb_time_functions,
                                        separator = "\t",
                                        column_data = c(1, 2),
                                        minmax = c(0, 3000),
                                        using_excel = FALSE,
                                        window_type,
                                        time_unit,
                                        move_type,
                                        window_length,
                                        clicked_file,
                                        flags_coding,
                                        shuffle,
                                        tolerance,
                                        sampen_m,
                                        sampen_r) {
  results <- c()
  if (!is.null(clicked_file)) {
    rr_and_flags <- read_and_filter_one_file(fileAddresses, clicked_file, separator, column_data, minmax, using_excel, flags_coding, shuffle)
    single_file_result <- get_single_chaos_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                        time_functions_list = time_functions_list,
                                                        window_type = window_type,
                                                        time_unit = time_unit,
                                                        move_type = move_type,
                                                        window_length = window_length,
                                                        tolerance = tolerance,
                                                        shuffle = shuffle,
                                                        sampen_m = sampen_m,
                                                        sampen_r = sampen_r)
    return(dplyr::bind_cols(tibble(`win NO` = seq(nrow(single_file_result))), single_file_result))
  } else {
    for (lineNumber in  1:length(fileAddresses[[1]])){
      rr_and_flags <- read_and_filter_one_file(fileAddresses, lineNumber, separator, column_data, minmax, using_excel, flags_coding, shuffle)
      temp_results <- get_single_chaos_windowed_results(data.frame(RR = rr_and_flags[[1]], flags = rr_and_flags[[2]]),
                                                          time_functions_list = time_functions_list,
                                                          window_type = window_type,
                                                          time_unit = time_unit,
                                                          move_type = move_type,
                                                          window_length = window_length,
                                                          tolerance = tolerance,
                                                          shuffle = shuffle,
                                                          sampen_m = sampen_m,
                                                          sampen_r = sampen_r) %>%
        colMeans(na.rm = TRUE)
      results <- rbind(results, temp_results)
    }
    results <- as.data.frame(results)
    results <- cbind(fileAddresses$name, results)
    colnames(results)[1] <- "file"
    rownames(results) <- NULL
    return(results)
  }
}

#' time window functions as a list
#' @export
glb_time_functions <- list(time_jump = hrvhra::time_based_jump,
                           time_slide = hrvhra::time_based_slide,
                           index_jump = hrvhra::index_based_jump,
                           index_slide = hrvhra::index_based_slide)

#' Function calculating windowed hrvhra results for a single RR time series
#' @param RR rr object
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#' @param shuffle whether the data should be shuffled
#' @param pnnX_th pnnX thresholds vector
#' @param pnn_perc_th pnn_perc_th thresholds vector
#' @return data.frame with results for windows as rows
#' @export
get_single_pp_windowed_results <- function(RR,
                                           time_functions_list = glb_time_functions,
                                           window_type = "time",
                                           time_unit = "minute",
                                           move_type = "jump",
                                           window_length = 5,
                                           cut_end = FALSE,
                                           return_all = FALSE,
                                           tolerance = 0.05,
                                           shuffle = "No",
                                           pnnX_th,
                                           pnn_perc_th) {
  window_slide = paste(move_type, window_type, sep = "_")
  rr_index <- 'if' (move_type == 'time', 2, 1) # index based windows do not have time track
  time_function <- time_functions_list[[window_slide]]
  lapply('if' (window_type == 'jump', # cut end is only applicable to the jump window type
               time_function(RR, window = window_length, cut_end = cut_end, tolerance = tolerance, time_unit = time_unit),
               time_function(RR, window = window_length, time_unit = time_unit)
        ),
         function(window_table) {
           window_table <- shuffle_in_windows(window_table, shuffle, rr_index) # shuffle if necessary
           hrvhra::hrvhra(window_table[[rr_index]],
                          window_table[[rr_index + 1]],
                          pnnX_th,
                          pnn_perc_th)
         }) %>%
    dplyr::bind_rows()
}

#' Function calculating windowed runs results for a single RR time series
#' @param RR rr object
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#' @param shuffle whether the data should be shuffled
#' @return data.frame with results for windows as rows
#' @export
get_single_runs_windowed_results <- function(RR,
                                             time_functions_list = glb_time_functions,
                                             window_type = "jump",
                                             time_unit = "minute",
                                             move_type = "time",
                                             window_length = 5,
                                             cut_end = FALSE,
                                             return_all = FALSE,
                                             tolerance = 0.05,
                                             shuffle = "No") {
  window_slide = paste(move_type, window_type, sep = "_")
  rr_index <- 'if' (move_type == 'time', 2, 1) # index based windows do not have time track
  time_function <- time_functions_list[[window_slide]]
  runs_list <- lapply('if' (window_type == 'jump', # cut end is only applicable to the jump window type
                            time_function(RR, window = window_length, cut_end = cut_end, tolerance = tolerance, time_unit = time_unit),
                            time_function(RR, window = window_length, time_unit = time_unit)),
                      function(window_table) {
                        window_table <- shuffle_in_windows(window_table, shuffle, rr_index)
                        hrvhra::countruns(window_table[[rr_index]], window_table[[rr_index + 1]])
                      }) %>% Filter(function(elem) !is.null(elem), .)
  runs_results <- hrvhra::bind_runs_as_table(runs_list, 'if' (length(runs_list) == 0, 1, as.character(seq_along(runs_list))))
  entropies_results <- lapply('if' (window_type == 'jump', # cut end is only applicable to the jump window type
                                    time_function(RR, window = window_length, cut_end = cut_end, tolerance = tolerance, time_unit = time_unit),
                                    time_function(RR, window = window_length, time_unit = time_unit)),
                              function(window_table) {
                                window_table <- shuffle_in_windows(window_table, shuffle, rr_index)
                                runs_list_local <- hrvhra::countruns(window_table[[rr_index]], window_table[[rr_index + 1]])
                                hrvhra::entropies(runs_list_local$direction_down,
                                                  runs_list_local$direction_up,
                                                  runs_list_local$no_change)
                              }) %>% Filter(function(elem) !is.null(elem), .)
  entropies_df <- data.frame()
  for (line in entropies_results) {
    entropies_df <- rbind(entropies_df, line)
  }
  colnames(entropies_df) <-c("HDR", "HAR", "HNO", "HDR2", "HAR2", "HNO2")
  cbind(runs_results, entropies_df)
}

#' Function calculating windowed spectral results for a single RR time series
#' @param RR rr object
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#' @param shuffle whether the data should be shuffled
#' @return data.frame with results for windows as rows
#' @export
get_single_spectral_windowed_results <- function(RR,
                                                 time_functions_list = glb_time_functions,
                                                 window_type = "jump",
                                                 time_unit = "minute",
                                                 move_type = "time",
                                                 use_ULF = "No",
                                                 window_length = 5,
                                                 cut_end = FALSE,
                                                 return_all = FALSE,
                                                 tolerance = 0.05,
                                                 shuffle = "No") {
  window_slide = paste(move_type, window_type, sep = "_")
  rr_index <- 'if' (move_type == 'time', 2, 1) # index based windows do not have time track
  time_function <- time_functions_list[[window_slide]]
  bands <- if (use_ULF == "Yes") {
    hrvhra::frequency_bands_24
  } else {
    hrvhra::frequency_bands
  }
  lapply('if' (window_type == 'jump', # cut end is only applicable to the jump window type
               time_function(RR, window = window_length, cut_end = cut_end, tolerance = tolerance, time_unit = time_unit),
               time_function(RR, window = window_length, time_unit = time_unit)),
         function(window_table) {
           window_table <- shuffle_in_windows(window_table, shuffle, rr_index)
           hrvhra::calculate_RR_spectrum(data.frame(RR = window_table[[rr_index]], flags = window_table[[rr_index + 1]]), bands)
         }) %>%
    dplyr::bind_rows()
}

#' Function calculating windowed quality results for a single RR time series
#' @param RR rr object
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#' @param shuffle whether the data should be shuffled
#' @return data.frame with results for windows as rows
#' @export
get_single_quality_windowed_results <- function(RR,
                                                time_functions_list = glb_time_functions,
                                                window_type = "jump",
                                                time_unit = "minute",
                                                move_type = "time",
                                                window_length = 5,
                                                cut_end = FALSE,
                                                return_all = FALSE,
                                                tolerance = 0.05,
                                                shuffle = "No") {
  window_slide = paste(move_type, window_type, sep = "_")
  rr_index <- 'if' (move_type == 'time', 2, 1) # index based windows do not have time track
  time_function <- time_functions_list[[window_slide]]
  lapply('if' (window_type == 'jump', # cut end is only applicable to the jump window type
               time_function(RR, window = window_length, cut_end = cut_end, tolerance = tolerance, time_unit = time_unit),
               time_function(RR, window = window_length, time_unit = time_unit)),
         function(window_table) {
           window_table <- shuffle_in_windows(window_table, shuffle, rr_index)
           hrvhra::describerr(window_table[[rr_index]], window_table[[rr_index + 1]])
         }) %>%
    dplyr::bind_rows()
}

#' Function calculating windowed chaos results for a single RR time series
#' @param RR rr object
#' @param window_type string, jumping or sliding
#' @param time_unit unit of time (minutes or seconds)
#' @param move_type string, time based or index based
#' @param window_length numeric, window length
#' @param tolerance what is the maximum data loss in a single window in dynamic analysis that should be tolerated
#' @param shuffle whether the data should be shuffled
#' @return data.frame with results for windows as rows
#' @export
get_single_chaos_windowed_results <- function(RR,
                                                time_functions_list = glb_time_functions,
                                                window_type = "jump",
                                                time_unit = "minute",
                                                move_type = "time",
                                                window_length = 5,
                                                cut_end = FALSE,
                                                return_all = FALSE,
                                                tolerance = 0.05,
                                                shuffle = "No",
                                                sampen_m,
                                                sampen_r) {
  window_slide = paste(move_type, window_type, sep = "_")
  rr_index <- 'if' (move_type == 'time', 2, 1) # index based windows do not have time track
  time_function <- time_functions_list[[window_slide]]
  lapply('if' (window_type == 'jump', # cut end is only applicable to the jump window type
               time_function(RR, window = window_length, cut_end = cut_end, tolerance = tolerance, time_unit = time_unit),
               time_function(RR, window = window_length, time_unit = time_unit)),
         function(window_table) {
           window_table <- shuffle_in_windows(window_table, shuffle, rr_index)
           std <- sd(window_table[[rr_index]])
           hrvhra::ncm_samp_en(window_table[[rr_index]], sampen_m, sampen_r * std)
         }) %>%
    unlist() %>%
    data.frame(SampEn = .)
}
#' Function adding dynamic asymmetry tests and rounding values
#' @param windowed_results result of a numerical function applied to an RR window
#' @param round_digits how much to round the descirptors
#' @param p_digits how should the p-value be rounded
#' @param asym_comparisons vector of strings, containing comparisons of the form AR1>DR1, SD1d>SD1a etc for use in dynamic asymmetry
round_and_summarize_dynamic_asym <- function(windowed_results, round_digits = 3, p_digits = 4, asym_comparisons = NULL) {
  cols_to_round <- sapply(windowed_results[1, ], is.numeric)
  result <- windowed_results[, cols_to_round] %>%
    colMeans(na.rm = TRUE)
  if (length(result) == 0) {
    result[is.na(result)] <- 0
    to_return <- if (!is.null(asym_comparisons)) {
      comparisons <- get_comparisons_in_windowed_results(windowed_results, asym_comparisons)
      partial_data_frame <- data.frame(t(rep(NA, length(comparisons))))
      names(partial_data_frame) <- comparisons
      cbind(windowed_results[1, ], partial_data_frame)
    } else {
      windowed_results[1, ]
    }
  return(to_return)
  }
  if (!is.data.frame(result)) {
    result <- as.data.frame(t(result))
  }
  if (!is.null(asym_comparisons)) {
    comparisons_in_windowed_results <- get_comparisons_in_windowed_results(windowed_results, asym_comparisons)
    if(length(comparisons_in_windowed_results) == 0) {
      return(result)
    }
    p_s <- c()
    props <- c()
    for (comparison in comparisons_in_windowed_results) {
      vars <- strsplit(comparison, '>')[[1]]
      prop_sum <- sum(windowed_results[[vars[[1]]]] > windowed_results[[vars[[2]]]])
      prop_test <- prop.test(prop_sum, nrow(windowed_results), alternative = 'greater')
      props <- c(props, prop_test$estimate)
      p_s <- c(p_s, puj(prop_test$p.value, rmarkdown = FALSE, digits = p_digits))
    }
    prop_frame <- as.data.frame(t(props))
    names(prop_frame) <- sapply(comparisons_in_windowed_results, function(name) paste0(name, "_prop"))
    pval_frame <- as.data.frame(t(p_s))
    names(pval_frame) <- sapply(comparisons_in_windowed_results, function(name) paste0(name, "_pVal"))
    result <- cbind(result, prop_frame, pval_frame)
  }
  result
}

#' Function extracting which comparisons can be applied to a window
#'
#' @param windowed_results windowed results to apply the comparisons
#' @param asym_comparisons vector of strings, containing comparisons of the form AR1>DR1, SD1d>SD1a etc for use in dynamic asymmetry
#' @return vector of strings, containing comparisons of the form AR1>DR1, SD1d>SD1a etc for use in dynamic asymmetry
get_comparisons_in_windowed_results <- function(windowed_results, comparisons) {
  sapply(comparisons, function(comparison) {
    vars <- strsplit(comparison, '>')[[1]]
    if (all(vars %in% colnames(windowed_results))) {
      return(comparison)
    } else {
      return(NA)
    }
  }) %>%
    Filter(not_na, .) %>%
    unname()
}

#' Function formatting p-values - copied from my package shiny-tools
#' @param p p value to be formated
#' @param rmarkdown, boolea, whether to use rmarkdown
#' @param digits how much to round the p-value
puj <- function(p, rmarkdown = TRUE, digits) {
  if (rmarkdown ) {
    if (p<0.0001) return ("<em>p</em><0.0001")
    else return(paste("<em>p</em>=", as.character(round(p, digits)), sep=""))
  } else {
    if (p<0.0001) return ("p<0.0001")
    else return(paste0('p=',  as.character(round(p, 4))))
  }
}

#' Function for use in Filter equivalent to !is.na
#' @param x data
not_na <- function(x) !is.na(x)

#' Function to sort out the coluns of the runs results table
#' @param results windowed results
#' @export
sort_out_runs <- function(results) {
  runs_names <- names(results)
  ARs <- runs_names[grepl('AR', runs_names) & !grepl('_', runs_names)] %>%
    sort_ardrn(type = "AR")
  DRs <- runs_names[grepl('DR', runs_names) & !grepl('_', runs_names)] %>%
    sort_ardrn(type = "DR")
  Ns <- runs_names[grepl('N', runs_names) & !grepl('_', runs_names)] %>%
    sort_ardrn(type = 'N')
  Hs <- runs_names[grepl('H', runs_names) & !grepl('_', runs_names)] %>%
    sort_ardrn(type = 'H')
  compars_props <- runs_names[grepl('_prop', runs_names)] %>%
    sort_ps(stub = '_prop')
  compars_pvals <- runs_names[grepl('_pVal', runs_names)] %>%
    sort_ps(stub = '_pVal')
  rest <- runs_names[!(runs_names %in% c(DRs, ARs, Ns, "DR_MAX", "AR_MAX", "N_MAX", "HDR", "HAR", "HNO", "HDR2", "HAR2", "HNO2", compars_props, compars_pvals))]
  results[c(rest, ARs, DRs, Ns, "DR_MAX", "AR_MAX", "N_MAX", "HDR", "HAR", "HNO", "HDR2", "HAR2", "HNO2", compars_props, compars_pvals)]
}

#' Sorting function for runs
#' @param ardrn_vec vector of runs names
#' @param type DR, AR or N
sort_ardrn <- function(ardrn_vec, type = "DR") {
  ardrn_vec %>%
    sub(pattern = type, replacement = "", .) %>%
    as.numeric() %>%
    sort() %>%
    paste0(type, .)
}

#' Sorting function for comparisons
#' @param ardr_p comparison names
#' @param stub what the stub of the comparison is (_prop or _pVal)
sort_ps <- function(ardr_p, stub = "_prop") {
  if (length(ardr_p) == 0) {
    return(NULL)
  }
  pattern <- paste0("(DR)|(AR)|(", stub, ")")
  names_to_sort <- gsub(pattern = pattern, replacement = "", ardr_p) %>%
    sapply(function(elem) strsplit(elem, split = ">")[[1]][1] %>% as.numeric()) %>%
    sort()
  names(names_to_sort) <- ardr_p
  names(sort(names_to_sort))
}


#' Function shuffling data in windows if necessary
#' @param window_table table with windowed signal (single window)
#' @param shuffle whether the table should be shuffled (shuffled if value == "window")
#' @param rr_index which column contains RR intervals
shuffle_in_windows <- function(window_table, shuffle, rr_index) {
  if (shuffle == "window") {
    sampling_order <- sample(seq_along(window_table[[rr_index]]), length(window_table[[rr_index]]))
    window_table <- window_table[sampling_order, ]
  }
  window_table
}

#' Function checking wheter a NA should be replaced with 0 or not
#' @param results_table table of results which has NAs - they will be replaced with 0s if the whole line contains NAs
sort_out_NAs <- function(results_table) {
  for (idx in seq(nrow(results_table))) {
    if (sum(is.na(results_table[idx, 2:(ncol(results_table))])) != ncol(results_table) -1 ) {
      results_table[idx, is.na(results_table[idx, ])] <- 0
    }
  }
  results_table
}