R/PRS_quantitative.R

In GxEprs: Genotype-by-Environment Interaction in Polygenic Score Models

#' PRS_quantitative function
#' This function uses plink2 and outputs Polygenic Risk Scores (PRSs) of all the individuals, using pre-generated GWAS and/or GWEIS summary statistics. Note that the input used in this function can be generated by using GWAS_quantitative and/or GWEIS_quantitative functions. Users may save the output in a user-specified file (see examples).
#' @param plink_path Path to the PLINK executable application
#' @param b_file Prefix of the binary files, where all .fam, .bed and .bim files have a common prefix
#' @param summary_input Pre-generated GWAS and/or GWEIS summary statistics 
#' @keywords prs profile scores
#' @export 
#' @importFrom stats binomial fitted.values glm lm
#' @importFrom utils read.table write.table
#' @return This function will output
#' \item{prs.sscore}{PRSs for each individual}
#' @examples \dontrun{ 
#' a <- GWAS_quantitative(plink_path, DummyData, Qphe_discovery, Qcov_discovery)
#' trd <- a[c("ID", "A1", "BETA")]
#' b <- GWEIS_quantitative(plink_path, DummyData, Qphe_discovery, Qcov_discovery)
#' add <- b[c("ID", "A1", "ADD_BETA")]
#' gxe <- b[c("ID", "A1", "INTERACTION_BETA")]
#' x <- PRS_quantitative(plink_path, DummyData, summary_input = trd)
#' sink("Q_trd.sscore") #to create a file in the working directory
#' write.table(x, sep = " ", row.names = FALSE, quote = FALSE) #to write the output
#' sink() #to save the output
#' head(x) #to read the head of all columns in the output
#' x$FID #to extract the family ID's of full dataset
#' x$IID #to extract the individual ID's of full dataset 
#' x$PRS #to extract the polygenic risk scores of full dataset
#' y <- PRS_quantitative(plink_path, DummyData, summary_input = add)
#' sink("Q_add.sscore") #to create a file in the working directory
#' write.table(y, sep = " ", row.names = FALSE, quote = FALSE) #to write the output
#' sink() #to save the output
#' z <- PRS_quantitative(plink_path, DummyData, summary_input = gxe)
#' sink("Q_gxe.sscore") #to create a file in the working directory
#' write.table(z, sep = " ", row.names = FALSE, quote = FALSE) #to write the output
#' sink() #to save the output
#' }
PRS_quantitative <- function(plink_path, b_file, summary_input){    
  os_name <- Sys.info()["sysname"]
   if (startsWith(os_name, "Win")) {
     slash <- paste0("\\")
   } else {
     slash <- paste0("/")
   }  
  sink(paste0(tempdir(), slash, "summary_stats"))
  write.table(summary_input, sep = " ", row.names = FALSE, quote = FALSE)
  sink()            
  runPLINK <- function(PLINKoptions = "") system(paste(plink_path, PLINKoptions))
  log_file <- runPLINK(paste0(" --bfile ", b_file, 
                    " --score ", noquote(paste0(tempdir(), slash, "summary_stats")), " 1 2 3 header --out ", tempdir(), slash, "prs"))
  out = read.table(paste0(tempdir(), "/prs.sscore"), header = F)
  out <- out[,c(1, 2, 5)]
  colnames(out) = c("FID", "IID", "PRS")
  return(out)
}