#################################################################
##### The Genetics of a “Femaleness/Maleness” Score in ##########
########### Cardiometabolic Traits in the UK Biobank ############
#################################################################

# Date: 2023-Apr-14
# Authors: Vosberg, D.E., Pausova, Z., Paus, T. 
# Manuscript submitted to Scientific Reports 

# List of contents 
# (1) Sex score phenotype (start: line 16)
# (2) Sex-specific GWAS quality control of participants (start: line 112)
# (3) GWAS phenotype and covariate files (start: line 193)
# (4) Sex-different SNPs (start: line 260)

#### (1) Sex-score and sum-score phenotypes ####

library(broom)
library(tidyverse)

# Custom functions

# A) outlier exclusion
outlier_na <- function(x, z = 4) {
  replace(x,abs(scale(x)) >= z, NA)
}

# B) lm sex-differences
lm_sexdiff <- function(x, my_data){
  my_datab <- my_data[!is.na(my_data[,x]),]
  out <- lm(scale(my_datab[,x]) ~ factor(Sex) + scale(Age), data = my_datab)
  return(out)
}

# C) run lm sex-difference function across variables
run_sex_diff <- function(my_data, regression_type = lm_sexdiff){
  
  # run lm_sexdiff on vars except for eid, Sex, Age  
  list_models <- lapply(4:ncol(my_data), regression_type, my_data = my_data)
  # tidy the lm model objects
  models_tidy <- lapply(list_models, tidy)
  # name elements of list
  names(models_tidy) <- names(my_data)[4:ncol(my_data)]
  # bind list into data.frame
  models_tidy <- bind_rows(models_tidy, .id = "dep")
  # select sex effect and rename
  EffSizes <- models_tidy %>%
    filter(!term %in% c("scale(Age)","(Intercept)")) %>%
    select(-c(term)) %>% 
    select(Variable = dep, Weight = estimate, p.value) 
  
  return(EffSizes)
  
}

# D) sex score calculation
comp_sexscores <- function(effsizes, df){
  
  sex.vars <- effsizes %>%
    arrange(tolower(Variable)) 
  
  VarsOnly <- df %>%  
    select(sort(names(.)))
  
  print(identical(names(VarsOnly), sex.vars$Variable))
  out_scores <- colSums(t(VarsOnly) * sex.vars$Weight)
  
  return(out_scores)
}

# Phenotypes of interest in dataframe, 'ukdf'
ukdf <- ukdf %>%
  filter(!eid %in% dropouts$V1) # remove participants who dropped out

# Specify positively-skewed variable indices (log_indi) to log10 transform
ukdf[,log_indi] <- log10(ukdf[,log_indi])

# GWAS subsample: reserved to compute sex-scores and sum-scores
ukdf_ss <- ukdf %>%
  drop_na() %>% 
  filter(eid %in% ukbb_genetics$IID) 

# Sex-difference subsample: used to compute sex-difference effect sizes
ukdf_sexdiff <- ukdf %>%
  filter(!eid %in% ukdf_ss$eid)

# GWAS subsample
# Exclude all values less/greater than 4 standard deviations from the mean
ukdf_ss[,-c(1:3)] <- as.data.frame(lapply(ukdf_ss[,-c(1:3)], outlier_na))

# Scale after outlier exclusions (mean = 0 and sd = 1)
ukdf_ss[,c(4:ncol(ukdf_ss))] <- as.data.frame(scale(ukdf_ss[,c(4:ncol(ukdf_ss))]))

# Sex-difference subsample
# Exclude all values less/greater than 4 standard deviations from the mean
ukdf_sexdiff[,-c(1:3)] <- as.data.frame(lapply(ukdf_sexdiff[,-c(1:3)], outlier_na))

# Scale after outlier exclusions (mean = 0 and sd = 1)
ukdf_sexdiff[,c(4:ncol(ukdf_sexdiff))] <- as.data.frame(scale(ukdf_sexdiff[,c(4:ncol(ukdf_sexdiff))]))

# Compute sex-difference effect sizes
EffSizes_lm <- run_sex_diff(ukdf_sexdiff, regression_type = lm_sexdiff)

# compute sex-scores and sum-scores
ukdf_ss$SexScoreLM <- comp_sexscores(EffSizes_lm, ukdf_ss[,4:12])
ukdf_ss$SumScore <- rowSums(ukdf_ss[,4:12])

write.csv(ukdf_ss, "output_sexscores/sexscores_ukdf_ss.csv",
  quote = FALSE, row.names = FALSE)


#### (2) Sex-specific GWAS quality control of participants ####
library(ukbtools)
library(tidyverse)

demo_all <- read.csv("raw_data/Demographics_site.csv", 
                     stringsAsFactors = FALSE)

ethnic_info <- read.csv("raw_data/ukbXXXXX.csv")
vnames=c("eid"='eid',
         "sex_aneuploidy"='X22019.0.0',
         "outlier_het_missing"='X22027.0.0',
         'genetic_white'='X22006.0.0',
         'kinship'='X22021.0.0',
         'genetic_sex'='X22001.0.0')
qc_dat = subset(ethnic_info,select = vnames)

kinship.info <- read.csv("raw_data/ukbXXXXX_rel_sXXXXXX.dat",
                         sep=" ")  

DropOut_subs <- read.csv("dropoutfile", header=F)  

#### Fam file structure: FamID, Individual ID, Father ID, Mother ID, Sex, Phenotype

df_gwas <- demo_all %>% select(eid, Sex)
df_gwas$fam_id <- df_gwas$eid
df_gwas$var1 <- "0" # father ID
df_gwas$var2 <- "0" # Mother ID
df_gwas$var3 <- "-9" # phenotype 
df_gwas <- select(df_gwas, eid, fam_id, var1, var2, Sex, var3)
df_gwas$Sex <- gsub("Female", "2", df_gwas$Sex)
df_gwas$Sex <- gsub("Male", "1", df_gwas$Sex)

qc_df_gwas <- merge(df_gwas, qc_dat, by="eid") # inner_join
# n = 502524; loss of 14
qc_df_gwas <- qc_df_gwas[is.na(qc_df_gwas$X22019.0.0),] 
# n = 501873; loss of 651; sex chr aneuploidy 
qc_df_gwas <- qc_df_gwas[!is.na(qc_df_gwas$X22001.0.0),]
# n = 487631; loss of 14242 (genetic sex is NA)
qc_df_gwas$X22001.0.0 <- gsub("0", "2", qc_df_gwas$X22001.0.0)
qc_df_gwas <- qc_df_gwas %>%
  filter(Sex == X22001.0.0) 
# n = 487434, loss of 197; mismatch between reported and biological sex 
qc_df_gwas <- qc_df_gwas[is.na(qc_df_gwas$X22027.0.0),] 
# n = 486471; loss of 963; heterozygosity and missingness outliers 
qc_df_gwas <- qc_df_gwas[!is.na(qc_df_gwas$X22006.0.0),] 
# n = 408181; loss of 78290 genetic ethnic grouping
qc_df_gwas <- qc_df_gwas[!qc_df_gwas$X22021.0.0 %in% c(-1, 10),] 
# https://biobank.ndph.ox.ac.uk/ukb/coding.cgi?id=682
# n = 408018; loss of 163
# not in kinship analysis (n=2) 
# more than 10 3rd degree relatives (n=161)

qc_df_gwas <- filter(qc_df_gwas, !eid %in% DropOut_subs$V1) 
qc_df_gwas <- filter(qc_df_gwas, Sex == 2) # filter for females only (Change to males for Male data)

# n = 407975; loss of 43 (dropouts)
kinship.info <- subset(kinship.info, ID1>0)
kinship.info = subset(kinship.info,Kinship>0)
kinship.anal = subset(kinship.info,ID1 %in% qc_df_gwas$eid & kinship.info$ID2 %in% qc_df_gwas$eid)

remove.ids <- ukb_gen_samples_to_remove(kinship.anal, qc_df_gwas$eid, cutoff = 0.0884)

qc_df_gwas_ind <- qc_df_gwas %>%
  filter(!eid %in% remove.ids)

# save resulting 'independent data set'
save(qc_df_gwas_ind,file="out_files/qc_df_gwas_ind_ukbfunc_female.RData")

qc_df_gwas_ind$var1 <- as.numeric(qc_df_gwas_ind$var1)
qc_df_gwas_ind$var2 <- as.numeric(qc_df_gwas_ind$var2)
qc_df_gwas_ind$var3 <- as.numeric(qc_df_gwas_ind$var3)
qc_df_gwas_ind$Sex <- as.numeric(qc_df_gwas_ind$Sex)
qc_df_gwas_fam <- select(qc_df_gwas_ind, eid:var3)
head(qc_df_gwas_fam)
nrow(qc_df_gwas_fam)

# .fam QC all subjs
write.table(qc_df_gwas_fam, "out_files/GWAS_qc_UKBB_ind_ukbfunc_female.fam", sep="\t", 
            col.names = FALSE, row.names = FALSE) # equivalent was done for Males


#### (3) GWAS phenotype and covariate files ####

library(DescTools)
library(broom)
library(tidyverse)

load("~/Documents/PostDocPaus/UKBB_no_ind_data/Sex_scores_pheno/ukdf_ss.RData")

# for PCs 1-10
ethnic_info <- read.csv("ukb#####.csv")
ethnic_info <- ethnic_info %>%
  select(eid, X22009.0.1:X22009.0.10)
names(ethnic_info)[2:11] <- paste0("PC",1:10) 

# pheno: FID, IID, phenotype 
# covar: FID, IID, covars
mk_covars <- function(data){
  
  covars_data <- data %>%
    left_join(ethnic_info, by = "eid") %>% 
    select(FID = eid, IID = eid, Age, PC1:PC10) %>%
    arrange(FID)
  
  return(covars_data)
}
mk_pheno <- function(data, pheno){
  pheno <- enquo(pheno)
  
  data_pheno <- data %>%
    select(eid, !!pheno) %>% 
    filter(!is.na(!!pheno)) 
  
  data_pheno$FID <- data_pheno$eid
  data_pheno$IID <- data_pheno$eid
  
  data_pheno <- data_pheno %>%
    select(FID, IID, !!pheno) %>%
    arrange(FID)
  
  return(data_pheno)
}

#### ukdf_ss, male and female
sexscores <- ukdf_ss %>%
  select(eid, Sex, Age, SexScoreLM, SumScore)

uk_Female_qc <- sexscores %>%
  filter(Sex == "Female")

uk_Male_qc <- sexscores %>% 
  filter(Sex == "Male")

# make pheno files 
# female sexscore pheno 
pheno_female_sexscores <- mk_pheno(uk_Female_qc, SexScoreLM)
# male sexscore pheno 
pheno_male_sexscores <- mk_pheno(uk_Male_qc, SexScoreLM)
# female sum-score pheno
pheno_female_sumscores <- mk_pheno(uk_Female_qc, SumScore)
# male sum-score pheno
pheno_male_sumscores <- mk_pheno(uk_Male_qc, SumScore)

# make covar files
covars_female_vars <- mk_covars(uk_Female_qc)
covars_male_vars <- mk_covars(uk_Male_qc)


#### (4) Sex-different SNPs ####

library(data.table)
library(tidyverse)

# # GWAS sumstats for sex-scores and sum-scores
f_sexscores <- fread("female_sexscores_lm_avg_sumstats_2023-mar-15.txt.gz", data.table = F)
m_sexscores <- fread("male_sexscores_lm_avg_sumstats_2023-mar-15.txt.gz", data.table = F)
f_sumscores <- fread("female_sumscores_sumstats_2023-mar-20.txt.gz", data.table = F)
m_sumscores <- fread("male_sumscores_sumstats_2023-mar-20.txt.gz", data.table = F)

gwas_f <- f_sexscores # f_sumscores
gwas_m <- m_sexscores # m_sumscores

# keep only SNPs with p <= 0.05 in at least one sex 
nominal_f <- gwas_f %>%
  filter(P <= 0.05) %>%
  select(CHR, POS, ID, P)

nominal_m <- gwas_m %>%
  filter(P <= 0.05) %>%
  select(CHR, POS, ID, P)

both_nominal <- unique(c(nominal_f$ID, nominal_m$ID))

both_gwas <- inner_join(gwas_f, gwas_m, by = c("CHR", "POS", "ID", "REF", "A1", "TEST"), 
                        suffix = c(".F",".M")) 

both_gwas_nom <- both_gwas %>% 
  filter(ID %in% both_nominal)

spear <- cor.test(both_gwas_nom$BETA.F, both_gwas_nom$BETA.M, 
                  method = "spearman")

t_diff <- function(x){
  numer <- both_gwas_nom$BETA.F[x] - both_gwas_nom$BETA.M[x]
  denom <- sqrt(both_gwas_nom$SE.F[x]^2 + both_gwas_nom$SE.M[x]^2 - 2*as.numeric(spear$estimate) * both_gwas_nom$SE.F[x] * both_gwas_nom$SE.M[x])
  t_stat <- numer/denom
  n <- both_gwas_nom$OBS_CT.F[x] + both_gwas_nom$OBS_CT.M[x]
  p <- 2*pt(abs(t_stat),df=n-1, lower.tail = FALSE)
  
  return(data.frame(ID = both_gwas_nom$ID[x], 
                    CHR = both_gwas_nom$CHR[x],
                    POS = both_gwas_nom$POS[x], 
                    A1 = both_gwas_nom$A1[x],
                    A2 = both_gwas_nom$REF[x], 
                    t_stat = t_stat, P = p))
}

beta_diff_abs <- function(x){
  beta_diff <- abs(both_gwas_nom$BETA.F[x]) - abs(both_gwas_nom$BETA.M[x])
  return(beta_diff)
}

# run equation across all retained SNPs
df_out_t <- t_diff(1:nrow(both_gwas_nom))
df_out_t$beta_diff <- beta_diff_abs(1:nrow(both_gwas_nom))

# snp list for females
df_out_t_f_dom <- df_out_t %>%
  mutate(P_1_tail = if_else(beta_diff >= 0, P/2, 1-P/2))

# snp list for males
df_out_t_m_dom <- df_out_t %>%
  mutate(P_1_tail = if_else(beta_diff < 0, P/2, 1-P/2))