Project: s41467-024-53548-z | Function: outlierThresh (r)

system: You are an expert R programmer implementing algorithms from scientific papers.
Complete the masked function based on the algorithm description.
Follow R best practices and maintain consistent code style.
Return **only** the complete R function code.

user: Complete this R function:

**DESCRIPTION:** Implements outlier detection for brain trajectory analysis using GAM residuals. Identifies individuals with extreme brain change patterns for potential exclusion from analysis.

**KEY TERMS:** {
  "ranef": "random effect slope/intercept",
  "Q": "standardized residuals",
  "outlierthresh": "outlier threshold in SD"
}

**CONTEXT CODE:**     axis.text = element_text(color = "black", size = 18),
    legend.key.size = unit(1,"cm"))
  
  
  
  #colour palette ---
  pal = wesanderson::wes_palettes$Zissou1
  #colour palette ---
  
  
  #set colour by hemi
  if (braakaparc == 0) {
    if (strsplit(roi," ")[[1]][1] == "Left") { 
      pointcol = pal[1]
    } else if (strsplit(roi," ")[[1]][1] == "Right") {
      pointcol = pal[3]
    }
  } else if (braakaparc == 1) {
      ROI=gsub("\\)","",gsub("\\(", ".", gsub(" ", "-", roivec[[iii]])))
    if (stringi::stri_reverse(substr(stringi::stri_reverse(roi),4,5)) == "lh") { 
      pointcol = pal[1]
    } else if (stringi::stri_reverse(substr(stringi::stri_reverse(roi),4,5)) == "rh") { 
      pointcol = pal[3]
    }
  }
  
  
  
  (fig1=ggplot() +
      geom_line(data=DF,aes(x=visit_age,brainvarcor,group=subject_id),color=pointcol,alpha=0.6, size=1) +
      geom_point(data=DF,aes(x=visit_age,brainvarcor,group=subject_id),color=pointcol,stat="identity",alpha=1, size=0.5) +
      geom_ribbon(data=dug,aes(x=visit_age,ymin=fit-CI,ymax=fit+CI),alpha=.7,show.legend=F,fill="dark grey") +
      geom_line(data=DF,aes(x=visit_age,y=fit),col="black") +
      # geom_line(data=dug,aes(x=visit_age,y=fit),col="red",size=2) + #check correct
      ylab("Volume") +
      ggtitle(roi) +
      theme_classic() + mytheme)
  
  
  
  #random slopes
  rr = ranef(g$mer)$subject_id
  length(unique(DF$subject_id))
  U = DF %>% filter(TimeBsl == 0)
  names(rr) = c("rInt", "rSlope")
  rr$subject_id = row.names(rr)
  U = merge(U, rr, by = "subject_id")
  
  
  #check outliers
  outlierThresh = function(U, outlierthresh, ranef) {
    stop("Function implementation has been masked")
    # Validate inputs
    if (!is.data.frame(U)) stop("U must be a data.frame")
    if (!is.character(ranef) || length(ranef) != 1) stop("ranef must be a single character string naming a column in U")
    if (!ranef %in% names(U)) stop(paste0("Column '", ranef, "' not found in U"))
    if (!is.numeric(outlierthresh) || length(outlierthresh) != 1) stop("outlierthresh must be a single numeric value")

    x <- U[[ranef]]
    # compute robust z using MAD; fallback to SD if MAD is zero
    med_x <- median(x, na.rm = TRUE)
    mad_x <- mad(x, constant = 1, na.rm = TRUE)
    scale_val <- ifelse(is.na(mad_x) || mad_x == 0, sd(x, na.rm = TRUE), mad_x)
    # If scale still NA (e.g., all NA), set scale to 1 to avoid division by zero
    if (is.na(scale_val) || scale_val == 0) scale_val <- 1

    zscore <- (x - med_x) / scale_val
    outlier_mask <- !is.na(zscore) & (abs(zscore) > outlierthresh)

    # Create annotated data.frame
    U2 <- U
    U2[[paste0(ranef, "_z")]] <- zscore
    U2[[paste0(ranef, "_outlier")]] <- outlier_mask
    # Colour columns for plotting: red for outlier, black otherwise
    U2$Qcol1 <- ifelse(outlier_mask, "red", "black")
    U2$Qcol2 <- ifelse(outlier_mask, "red", "grey40")

    outliers_df <- U2[outlier_mask, , drop = FALSE]

    # Informative message
    n_out <- nrow(outliers_df)
    if (n_out > 0) {
      message(sprintf("Detected %d outlier(s) in '%s' (threshold = %s).", n_out, ranef, outlierthresh))
    } else {
      message(sprintf("No outliers detected in '%s' (threshold = %s).", ranef, outlierthresh))
    }

    return(list(outliers = outliers_df, data = U2))
  }

  ranef="rSlope"
  thr = 6
  check = outlierThresh(U, thr, "rSlope")[[2]] #outliers saved for later PGS tests

  ggplot(data=check,aes(x=meanAge,rSlope)) +
    geom_point(color=check$Qcol1,stat="identity",alpha=0.7) +
    geom_smooth(method="lm",col="black") +
    theme_classic() +
    ylab("rSlope") +
    theme(axis.line = element_blank())
   
  
  
  (fig2=ggplot() +
      geom_point(data=U,aes(x=meanAge,rSlope),color=pointcol,stat="identity",alpha=0.7) +
      # geom_smooth(data=U,aes(x=meanAge,rSlope),method = "gam",col="black") +
      geom_hline(yintercept = 0,linetype=2,size=1) +
      labs(y="rSlope",
           x="Age (mean)") +
      ggtitle("Age-relative change") + 
      ylab(expression("Additional Change (mm"^3*"/year)")) +
      theme_classic() + mytheme +
      theme(
        axis.title.y = element_text(color = "black", size = 19, vjust =-1, margin = margin(0,10,0,0)),
        axis.title.x = element_text(color = "black", size = 19, vjust = -2, margin = margin(0,20,20,0)),
        # axis.title.x = element_text(vjust = -4),
        plot.margin = unit(c(1,2,1,1), "lines")
      
      ) )

  
  
  #calculate derivatives
  dd=derivatives(object=g$gam,
                 newdata=U,
                 order = 1L,
                 n = nrow(U),
                 interval = c("confidence")
  )
  
  #add random effect to curve derivative to get vals of slope
  U$absChange=U$rSlope+dd$derivative
  
  U$dd=dd$derivative
  
  
  (fig3=ggplot() +
      geom_point(data=U,aes(x=meanAge,absChange),color=pointcol,stat="identity",alpha=0.7) +
      geom_smooth(data=U,aes(x=meanAge,absChange),method="loess",col="black", size=0.5) +
      geom_hline(yintercept = 0,linetype=2,size=1) +
      labs(
           x="Age (mean)") +
      ggtitle("Absolute change") +
      ylab(expression("Change (mm"^3*"/year)")) +
      theme_classic() + mytheme +
      theme(
        axis.title.y = element_text(color = "black", size = 19, vjust =-1, margin = margin(0,10,0,0)),
        axis.title.x = element_text(color = "black", size = 19, vjust = -2, margin = margin(0,20,20,0)),
        # axis.title.x = element_text(vjust = -4),
        plot.margin = unit(c(1,2,1,1), "lines")


Complete the function implementation replacing "stop("Not implemented")".