# ==============================================================================
# Author:           Peter Raidl
# Date Created:     [2024-03-23]
# Last Updated:     [2025-01-20]
# ------------------------------------------------------------------------------
# Input:            dataframes in long format with ID, Group, time, testname, value
# Output:           list of dataframes and plots
# Dependencies:     Packages: dplyr (1.1.4), irr (0.84.1), ggplot2(3.5.1), cowplot (1.1.3).
#                   The last test of the function ran on R version 4.4.2
# Description:      This function is created for analyzing test-retest reliability
#                   of multiple metrics. Specifically we compared similar outcomes
#                   between different population. This function was the main analysis
#                   script for the study by Schaun et al. 2025.
# ==============================================================================


f.results <- function(df, tg = testgroup, tn = testname){
#setting-------------------------------------------------------------------

  df %>%
    filter(testname == tn) -> df
  # drop all incomplete cases based on NAs in the data.frame
  complete_c <- complete.cases(df)
  #dropped cases
  dropped_cases <- df[complete_c == F, ]
  # go on with complete cases
  if(length(dropped_cases$ID) >= 1){
    df <- df[df$ID != dropped_cases$ID, ]
    
  }
  
  k = length(unique(df$time)) #number of timepoints for repeated measures design
  idx = length(unique(df$ID)) #number of IDs with complete data
  iccunit = "single" # single measures see ?irr:icc()
  if (tg == "US"){ # In the study (Schaun et al., 2025) Ultrasound measures
                    # were taken averages of multiple measures as typically done
                    # for this kind of measurement
    iccunit = "average"
  }
  
  #-----------------------------------------------------------------------###
  #-----------------------------------------------------------------------###  
  # Tests for complete set of data (without group diff)  ------------------
  ## Data diagnostics -----------------------------------------------------
  # Shapiro-Wilk test for normality
  all_shapiro <- df %>%
    filter(testname == tn) %>%
    group_by(time) %>%
    rstatix::shapiro_test(value)
  all_shapiro$variable <- paste0(tg,"_", tn)
  
  # histogram distrubution of data
  all_histogram <- df %>%
    ggplot(aes(x = value, fill = time))+
    geom_histogram(alpha = 0.6, position = "identity", bins = 30)+
    ggtitle(paste(tg, tn))+
    theme_minimal()
  
  # log transformed data distribution
  all_histogram_log <- df %>%
    ggplot(aes(x = log_value, fill = time))+
    geom_histogram(alpha = 0.6, position = "identity", bins = 30)+
    ggtitle(paste(tg, tn, "- log transformed"))+
    theme_minimal()
   
  all_qq <- df%>%
    ggplot(aes(sample = value)) +
    geom_qq_line() +
    stat_qq() +
    ggtitle(paste("QQ-plot", tg, tn, ""))+
    theme_minimal()
  
  # QQ- plots
  all_qq_log <- df%>%
    ggplot(aes(sample = log_value)) +
    geom_qq_line() +
    stat_qq() +
    ggtitle(paste("QQ-plot", tg, tn, "log transformed"))+
    theme_minimal()
    
  
  
  ## rm ANVOVA over all groups ----------------------------------------------
  all_anova <- df %>%
    rstatix::anova_test(dv = value,
                        wid = ID,
                        within = time,
                        detailed = T)
  
  # Boxplot for pre and baseline
  all_boxplot <- df %>%
    ggplot(aes(x = time, y = value)) +
    geom_boxplot(fill = "lightblue", linewidth = 0.5) +
    geom_line(aes(group = ID), color = "darkgrey")+
    ggtitle(paste(tg, tn))+
    theme_minimal()
  
  #-----------------------------------------------------------------------###  
  ## Relative Reliability --------------------------------------------------
  # wide format data.frame for the irr:icc function
  df_wide <- df %>%
    pivot_wider(names_from = time,
                values_from = ends_with("value"),
                names_prefix = paste0(tn, "_"))
  
  all_ls_icc <- df_wide%>%
    select(!starts_with("log")) %>% 
    select(ends_with("_bas"), ends_with("_pre"))%>% 
    #irr needs matrix only with the defined variables
    irr::icc(model = "twoway",
             type = "agreement",
             unit = iccunit)
  all_df_icc <-data.frame(
    "testgroup" = tg,
    "testname" = tn,
    "Group" = 0,
    "N" = length(unique(df$ID)),
    "Grandmean" = mean(df$value),
    "Fvalue" = all_ls_icc$Fvalue,
    "pvalue" = all_ls_icc$p.value,
    "df1" = all_ls_icc$df1,
    "df2" = all_ls_icc$df2,
    "icc" = all_ls_icc$value,
    "icc_lowerCI" = all_ls_icc$lbound,
    "icc_upperCI" = all_ls_icc$ubound)
  
  
  
  #------------------------------------------------------------------------###
  ## Absolute reliability all data SEM-----------------------------------
  # SEM from MS_error full anova table
  
  f.ANOVA <- function(df = df){ #long format data frame with time and value cols
    
    nc = length(unique(df$time)) #number of cols in wide format ANOVA = timepoints
    nr = length(unique(df$ID)) #number of rows in wide format ANOVA = IDs
    
    df_wide <- df %>%
      pivot_wider(names_from = time,
                  values_from = ends_with("value"),
                  names_prefix = paste0(tn, "_"))
    
    
    
    grandmean <- mean(df$value) # grandmean all Ids and all timepoints
    SS_total <- sum((df$value - grandmean)^2)#total sum of squares
    
    #difference score of first and second test
    df_wide$delta <- df_wide[, 4] - df_wide[, 5]
    #mean of first and second test per person
    df_wide$mean <- (df_wide[, 4] + df_wide[, 5])/2
    
    #SS_time Sum of squares for between time effect
    SS_time = nr * ((colMeans(df_wide[, 4]) - grandmean)^2 +
                      (colMeans(df_wide[, 5]) - grandmean)^2)
    MS_time <- SS_time/(nc-1)
    
    #SS_within Sum of squares within timepoint @eq-SSwithin
    df_wide$SSwithin_bas <-(df_wide[, 4] -
                              colMeans(df_wide[, 4]))^2
    df_wide$SSwithin_pre <- (df_wide[, 5] -
                               colMeans(df_wide[, 5]))^2
    SS_within <- sum(df_wide$SSwithin_pre) + sum(df_wide$SSwithin_bas)
    
    
    #SS_Subject Sum of squares subjects @eq-SSsubject
    df_wide$SSsubj <- (df_wide$mean - grandmean)^2
    SS_subject <- nc * colSums(df_wide$SSsubj)
    
    SS_error = SS_within - SS_subject
    MS_error <- SS_error/((nr-1)*(nc-1))
    
    #SS_total = SS_subject + SS_error + SS_time
    #SS_total = SS_within + SS_time
    
    all_fullVariance <- data.frame(
      "Source" = c("Time",
                   "Subject",
                   "Error",
                   "Total"),
      "degf" = c(nr-1,
                 nc-1,
                 (nr-1)*(nc-1),
                 nc + nr -1),
      "SS" = c(SS_time,
               SS_subject,
               SS_error,
               SS_total)
    )
    all_fullVariance$MS <- all_fullVariance$SS/all_fullVariance$degf
    
    all_fullVariance
  }
  
  df_variances <- f.ANOVA(df)
  
  #direct calc of SEM @stratford
  SEM_fromMSe <- sqrt(df_variances[df_variances$Source== "Error", "MS"])

  df_wide %>%
    rowwise() %>%
    mutate(var12 = var(c_across(c(4,5))),
           mean12 = mean(c_across(c(4,5))),
           diff12 = diff(c_across(c(4,5))), 
           var12_log = var(c_across(c(6,7)))) -> df_wide

  all_df_icc$SEM_MSe <- SEM_fromMSe
  all_df_icc$MDC90 <- SEM_fromMSe*1.65*sqrt(2)
  all_df_icc$MDC95 <- SEM_fromMSe*1.96*sqrt(2)
  all_df_icc$WCV <- sqrt(mean(df_wide$var12 / df_wide$mean12^2))*100 #https://www.jstor.org/stable/2532835
  all_df_icc$WCV_log <- (exp(sqrt(mean(df_wide$var12_log))) - 1)*100
  
  
  
  #----------------------------------------------------------------------###
  # Per group analysis --------------------------------------------
  # similar analysis for different groups
  df %>%
    group_by(Group, time) %>%
    filter(var(value)==0) %>%
    reframe() %>%
    as.data.frame() %>%
    mutate("variable" = paste0(tg,"_", tn, "_no_var"),
           "statistic" = NA,
           "p" = NA)-> drop_variance

  gr_shapiro <- df %>%
    group_by(Group, time) %>%
    filter(var(value)!=0) %>%  #check for variability in data/ if var is 0 --> no check for normality
    rstatix::shapiro_test(value)
  gr_shapiro$variable <- paste0(tg,"_", tn)
  
  gr_shapiro %>%
    bind_rows(drop_variance) -> gr_shapiro
  # rmANOVA per Groups
  gr_anova <- df %>%
    group_by(Group) %>%
    rstatix::anova_test(dv = value,
                        wid = ID,
                        within = time,)
  
  #boxplot for individual groups per time
  gr_boxplot <- df %>%
    ggplot(aes(x = time, y = value, color = Group)) +
    geom_boxplot() +
    ggtitle(paste(tg, tn, "per Group"))+
    theme_minimal()
  
  # relative reliability
  gr_ls_icc <- list()
  gr_df_icc <- data.frame(matrix(nrow = 0, ncol = 9))
  ls_gr_histogram <- list()
  ls_gr_loghistogram <- list()
  ls_gr_qq <- list()
  ls_gr_qq_log <- list()
  for(i in 1:3){
   p1 <-  df %>%
      filter(Group == i) %>%
      ggplot(aes(x = value, fill = time)) +
      geom_histogram(alpha = 0.6, position = "identity", bins = 30)+
      ggtitle(paste(tg, tn, "- Group", i))+
      theme_minimal()
    ls_gr_histogram <- append(ls_gr_histogram, list(p1))
    
    p2 <- df %>%
      filter(Group == i) %>%
      ggplot(aes(x = log_value, fill = time))+
      geom_histogram(alpha = 0.6, position = "identity", bins = 30)+
      ggtitle(paste(tg, tn,"- Group", i, "- log"))+
      theme_minimal()
    ls_gr_loghistogram <-  append(ls_gr_loghistogram, list(p2))
    
    
    p3 <- df %>%
      filter(Group == i) %>%
      ggplot(aes(sample = value))+
      geom_qq_line() +
      stat_qq() +
      ggtitle(paste("QQ-plot",tg, tn,"- Group", i, "")) +
      theme_minimal()
    ls_gr_qq <- append(ls_gr_qq, list(p3))
    
    p4 <- df %>%
      filter(Group == i) %>%
      ggplot(aes(sample = log_value))+
      geom_qq_line() +
      stat_qq() +
      ggtitle(paste("QQ-plot",tg, tn,"- Group", i, " log")) +
      theme_minimal()
    ls_gr_qq_log <- append(ls_gr_qq_log, list(p4))
    
    
    
    gr_ls_icc[[i]] <- df_wide%>% #irr needs wide format
      filter(Group == i) %>%
      select(!starts_with("log")) %>%
      select(ends_with("_bas"), ends_with("_pre"))%>% 
      #irr needs matrix only with the defined variables
      irr::icc(model = "twoway",
               type = "agreement",
               unit = iccunit)
    
    
    df%>%
      filter(Group == i) -> df_grcatch
    df_wide %>%
      filter(Group == i) -> df_wgrcatch
    
    gr_variances <- f.ANOVA(df_grcatch)
    catch_SEM_fromMSe <- sqrt(gr_variances[gr_variances$Source== "Error", "MS"])
    
    
    catch_WCV <- sqrt(mean(df_wgrcatch$var12/ (df_wgrcatch$mean12)^2))*100
    catch_WCV_log <- (exp(sqrt(mean(df_wgrcatch$var12_log))) - 1)*100
    
    catch_icc <-data.frame(
      "testgroup" = tg,
      "testname" = tn,
      "Group" = i,
      "N" = length(unique(df_grcatch$ID)),
      "Grandmean" = mean(df_grcatch$value),
      "Fvalue" = gr_ls_icc[[i]]$Fvalue,
      "pvalue" = gr_ls_icc[[i]]$p.value,
      "df1" = gr_ls_icc[[i]]$df1,
      "df2" = gr_ls_icc[[i]]$df2,
      "icc" = gr_ls_icc[[i]]$value,
      "icc_lowerCI" = gr_ls_icc[[i]]$lbound,
      "icc_upperCI" = gr_ls_icc[[i]]$ubound,
      "SEM_MSe" = catch_SEM_fromMSe,
      "MDC90" = catch_SEM_fromMSe * 1.65*sqrt(2), # MDC90% from SEM z-transformed 90%CI 
      "MDC95" = catch_SEM_fromMSe * 1.96*sqrt(2), #MDC95% from SEM
      "WCV" = catch_WCV,
      "WCV_log" = catch_WCV_log)
    
    
    
    gr_df_icc <- rbind(gr_df_icc, catch_icc)
  }
  
  ls_gr_histogram <- cowplot::plot_grid(ls_gr_histogram[[1]] + theme(legend.position = "none"),
                                        ls_gr_histogram[[2]]+ theme(legend.position = "none"),
                                        ls_gr_histogram[[3]]+ theme(legend.position = "none"),
                                        cowplot::get_legend(ls_gr_histogram[[1]]))
  
  ls_gr_loghistogram <- cowplot::plot_grid(ls_gr_loghistogram[[1]] +theme(legend.position = "none"),
                                           ls_gr_loghistogram[[2]] + theme(legend.position = "none"),
                                           ls_gr_loghistogram[[3]] + theme(legend.position = "none")
                                           )
  ls_gr_qq <- cowplot::plot_grid(plotlist = ls_gr_qq)
  ls_gr_qq_log <- cowplot::plot_grid(plotlist = ls_gr_qq_log)
  
  ls_results <- list(
    "dropped_cases" = dropped_cases,
    "all_shapiro" = all_shapiro,
    "all_hist" = all_histogram,
    "all_qq" = all_qq,
    "all_qq_log" = all_qq_log,
    "all_log_hist" = all_histogram_log,
    "all_boxplot" = all_boxplot,
    "all_df_icc" =all_df_icc,
    "all_variances" =df_variances,
    "gr_df_icc" = gr_df_icc,
    "gr_shapiro" = gr_shapiro,
    "gr_hist" = ls_gr_histogram,
    "gr_log_hist" = ls_gr_loghistogram,
    "gr_qq" = ls_gr_qq,
    "gr_qq_log" = ls_gr_qq_log,
    "gr_boxplot" = gr_boxplot
  )
  ls_results
  
  

}