Project: s41467-025-57887-3 | Function: GetProb_SPA_G (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:** Saddle point approximation for genetic association testing. Implements SPA method to obtain accurate p-values for genetic variants.

**KEY TERMS:** {
  "zeta": "saddle point",
  "k1": "first cumulant",
  "k2": "second cumulant"
}

**CONTEXT CODE:** 
  ## Score statistic
  S = sum(g * R)

  ## estimated variance without adjusting for covariates
  N1set = 1:N
  N0 = 0
  MAF.est = MAF

  g.var.est = 2 * MAF.est * (1 - MAF.est)
  S.var = sum(R^2 * g.var.est)

  # update on 2023-10-24
  S.mean = 2 * sum(R * MAF.est)

  z = (S - S.mean)/sqrt(S.var)


  if(abs(z) < Cutoff){
    pval.norm = pnorm(abs(z), lower.tail = FALSE)*2
    return(c(MAF, missing.rate, pval.norm, pval.norm, S, S.var, z))
  }

  # update on 2023-10-24
  pval1 = GetProb_SPA_G_new(init.t = 0, MAF.est, R, max(S, (2*S.mean-S)), lower.tail = FALSE) # SPA-G p value
  pval2 = GetProb_SPA_G_new(init.t = 0, MAF.est, R, min(S, (2*S.mean-S)), lower.tail = TRUE)  # SPA-G p value

  # update on 2023-10-24
  if(is.na(pval2)){
    pval2 = pval1
  }

  pval3 = pnorm(abs(z), lower.tail = FALSE) # Normal
  pval4 = pnorm(-abs(z), lower.tail = TRUE) # Normal

  pval.spa.G = pval1 + pval2
  pval.norm = pval3 + pval4

  pval = c(pval.spa.G, pval.norm) # 2 elements: element 1 is from SPA-G, element 2 is from Normal

  return(c(MAF, missing.rate, pval, S, S.var, z))
}




CCT <- function(pvals, weights = rep(1, length(pvals))) {
  stop("Function implementation has been masked")
}

GetProb_SPA_G <- function(init.t = 0, MAFVec, R, s, lower.tail) {
  stop("Function implementation has been masked")
}




#### other functions with input of local ancestry information

# MAF is the minor allele frequency of the tested marker in the ancestry to analyze
# MAFVec is the vector (length = sample size) of minor allele frequency of the tested marker in the ancestry to analyze
# haplo_numVec is the vector (length = sample size) of the number haplotype of the tested marker in the ancestry to analyze

# The MGF of G (genotype from the ancestry to analyze)
M_G0_local = function(t, MAF, haplo_num){
  re = (1 - MAF + MAF * exp(t))^haplo_num
  return(re)
}

# The first derivative of the MGF of G (genotype from the ancestry to analyze)
M_G1_local = function(t, MAF, haplo_num){
  re = haplo_num*(MAF * exp(t))*(1 - MAF + MAF * exp(t))^(haplo_num - 1)
  return(re)
}

# The second derivative of the MGF of G (genotype from the ancestry to analyze)
M_G2_local = function(t, MAF, haplo_num){
  re = haplo_num * (haplo_num-1) * (MAF * exp(t))^2 * (1 - MAF + MAF * exp(t))^(haplo_num - 2) +
    haplo_num * (MAF * exp(t)) * (1 - MAF + MAF * exp(t)) ^ (haplo_num - 1)
  return(re)
}


# The CGF of G (genotype from the ancestry to analyze)
K_G0_local = function(t, MAF, haplo_num){
  re = log(M_G0_local(t, MAF, haplo_num))
  return(re)
}

# The first derivative of the CGF of G (genotype from the ancestry to analyze)
K_G1_local = function(t, MAF, haplo_num){
  re = M_G1_local(t, MAF, haplo_num)/M_G0_local(t, MAF, haplo_num)
  return(re)
}

# The second derivative of the CGF of G (genotype from the ancestry to analyze)
K_G2_local = function(t, MAF, haplo_num){
  re = (M_G0_local(t, MAF, haplo_num)*M_G2_local(t, MAF, haplo_num)-M_G1_local(t, MAF, haplo_num)^2)/M_G0_local(t, MAF, haplo_num)^2
  return(re)
}

# The CGF of score test statistic for the ancestry to analyze
H_org_local = function(t, R, MAFVec, haplo_numVec){

  n.t = length(t)
  out = rep(0,n.t)
  for(i in 1:n.t){
    t1 = t[i]
    out[i] = sum(K_G0_local(t1*R, MAFVec, haplo_numVec))
  }
  return(out)
}

# The first derivative of the CGF of score test statistic for the ancestry to analyze
H1_adj_local = function(t, R, s, MAFVec, haplo_numVec)
{
  n.t = length(t)
  out = rep(0,n.t)

  for(i in 1:n.t){
    t1 = t[i]
    out[i] = sum(R*K_G1_local(t1*R, MAFVec, haplo_numVec)) - s
  }
  return(out)
}


# The second derivative of the CGF of score test statistic for the ancestry to analyze
H2_local = function(t, R, MAFVec, haplo_numVec)
{
  n.t = length(t)
  out = rep(0,n.t)

  for(i in 1:n.t){
    t1 = t[i]
    out[i] = sum(R^2*K_G2_local(t1*R, MAFVec, haplo_numVec))
  }
  return(out)
}


GetProb_SPA_G_local = function(MAFVec, R, haplo_numVec, s, lower.tail){

  out = uniroot(H1_adj_local, c(-20,20), extendInt = "upX",
                R=R, s=s, MAFVec=MAFVec, haplo_numVec=haplo_numVec)
  zeta = out$root

  k1 = H_org_local(t=zeta, R=R, MAFVec=MAFVec, haplo_numVec=haplo_numVec)
  k2 = H2_local(t=zeta, R=R, MAFVec=MAFVec, haplo_numVec=haplo_numVec)



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