Add lambda (genomic inflation factor)

[sinarueeger]

## Geom Inflation factor
## ------------------
# https://academic.oup.com/hmg/article/17/R2/R122/2527210
lambda_gc <- function(x)
{
  # x = P values
  ## turn P values into Zstats, then square them
  chisq <- qnorm(x/2)^2
  
  lambda <- median(chisq)/qchisq(0.5,1)
  return(lambda)
}
  

StatLambdaGC <- ggproto("StatLambdaGC", Stat,
                      compute_group = function(data, scales, params, p.thresh) {
                        data < - 
                       gc.val = lambda_gc(data$y)
                       label = glue::glue("lambda = {format(gc.val, digits = 3)}")
                       data.frame(x = 1, y = 1, label = label)
                      },
                      
                      required_aes = c("y")
)

stat_lambda_gc <- function(mapping = NULL, data = NULL, geom = "text",
                        position = "identity", na.rm = FALSE, show.legend = NA, 
                        inherit.aes = TRUE, parse = TRUE, hjust = "left", vjust = "outward", p.thresh = 0, ...) {
  layer(
    stat = StatLambdaGC, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, parse = parse, 
                  hjust = hjust, vjust = vjust, p.thresh = p.thresh, ...)
  )
}

n.sample <- 10000
df <- data.frame(P = runif(n.sample), GWAS = sample(c("a","b"), n.sample, replace = TRUE))

## Example 
ggplot(df, aes(y = P)) + 
    stat_qqplot() + 
    geom_abline(intercept = 0, slope = 1) + 
    stat_lambda_gc()