.Rhistory

DIR_BOX_BASE <- file.path("/Users", "mattdufort", "Library", "CloudStorage", "Box-Box")
# DR3 / DQ2 = presence of DRB1*03:01 and DQB1*02:01 (this lines up perfectly with the KQ1 and TN18 dr3Result values)
REGEX_DR3_DQ2 <- "^0301\\$[0-9]{4}\\$0201"
## DR4 / DQ8 = presence of DRB1*04:xx and DQB1*03:02 (this lines up perfectly with the KQ1 and TN18 dr4Result values)
# using only DQB1*03:02 is not perfect because there are occasional haplotypes that have it but not DR4 (e.g. 0801$0301$0302 has DR4 = ABSENT in TN18)
# if we don't include the DRB1*04:xx, then
REGEX_DR4_DQ8 <- "^04[0-9]{2}\\$[0-9]{4}\\$0302"
## Function to generate 4 combinations per row (unless haplotypes are identical)
# this function is for generating potential haplotypes from unphased HLA DRB1/DQA1/DQB1 data, to match to a known set of genotypes
generateHlaHaplotypes <- function(row, id_col) {
combos <- list(
c(row["hlaDrb1_1"], row["hlaDqa1_1"], row["hlaDqb1_1"], row["hlaDrb1_2"], row["hlaDqa1_2"], row["hlaDqb1_2"]),
c(row["hlaDrb1_1"], row["hlaDqa1_1"], row["hlaDqb1_2"], row["hlaDrb1_2"], row["hlaDqa1_2"], row["hlaDqb1_1"]),
c(row["hlaDrb1_1"], row["hlaDqa1_2"], row["hlaDqb1_1"], row["hlaDrb1_2"], row["hlaDqa1_1"], row["hlaDqb1_2"]),
c(row["hlaDrb1_1"], row["hlaDqa1_2"], row["hlaDqb1_2"], row["hlaDrb1_2"], row["hlaDqa1_1"], row["hlaDqb1_1"])
)
# Create a data frame with concatenated columns for each combination
data.frame(
id = row[[id_col]],
hlaDrb1Dqa1Dqb1Alpha = sapply(combos, function(x) paste(x[1], x[2], x[3], sep = "$")),
hlaDrb1Dqa1Dqb1Beta = sapply(combos, function(x) paste(x[4], x[5], x[6], sep = "$"))
) %>%
# keep unique combinations
distinct()
}
## Function to extract DQA1/DQB1 haplotypes (with format 0000$0000$0000) from DRB1/DQA1/DQB1 haplotypes (with format 0000$0000$0000)
extractHlaDqa1Dqb1 <- function(hlaDrb1Dqa1Dqb1) {
str_extract(hlaDrb1Dqa1Dqb1, "[0-9]{3}[0-9X]\\$[0-9]{4}$")
}
## Function to determine DR3/DR4 genotype from [DRB1]$[DQA1]$[DQB1] alpha/beta alleles
getGenotypeHlaDr3Dr4 <- function(dataHla, colnamessHla = c("hlaDrb1Dqa1Dqb1Alpha", "hlaDrb1Dqa1Dqb1Beta")) {
## this function counts the DR3 and DR4 alleles in HLA data, and adds columns for counts of those haplotypes and the DR3/DR4 genotype
# it assumes that each row contains both haplotypes, and that data are in the format "[DRB1]$[DQA1]$[DQB1]" where DRB1/DQA1/DQB1 are 4-digit alleles
REGEX_DR3_DQ2 <- "^0301\\$[0-9]{4}\\$0201"
REGEX_DR4_DQ8 <- "^04[0-9]{2}\\$[0-9]{4}\\$0302"
dataHla <-
dataHla %>%
rowwise() %>%
mutate(
countHlaDr3 = sum(str_detect(!!rlang::sym(colnamessHla[1]), REGEX_DR3_DQ2), str_detect(!!rlang::sym(colnamessHla[2]), REGEX_DR3_DQ2)),
countHlaDr4 = sum(str_detect(!!rlang::sym(colnamessHla[1]), REGEX_DR4_DQ8), str_detect(!!rlang::sym(colnamessHla[2]), REGEX_DR4_DQ8)),
genotypeHlaDr3Dr4 =
case_when(
countHlaDr3 == 2 ~ "DR3/DR3",
(countHlaDr3 == 1) & (countHlaDr4 == 0) ~ "DR3/x",
(countHlaDr3 == 1) & (countHlaDr4 == 1) ~ "DR3/DR4",
countHlaDr4 == 2 ~ "DR4/DR4",
(countHlaDr3 == 0) & (countHlaDr4 == 1) ~ "DR4/x",
countHlaDr3 + countHlaDr4 == 0 ~ "x/x",
TRUE ~ "unknown") %>%
factor(levels = c("DR3/DR3", "DR3/x", "DR3/DR4", "DR4/DR4", "DR4/x", "x/x", "unknown"))) %>%
ungroup()
dataHla
}
## Function to match HLA DQA1/DQB1 alleles to a set of alleles containing "X" as wildcard
matchHlaAlleleWithWildcard <- function(allele, patterns, wildcard = "X") {
# replace $ for easier matching with wildcards
allele <- str_replace(allele, "\\$", "_")
patterns <- str_replace(patterns, "\\$", "_")
if (length(allele) > 1)
stop("This function operates on one allele at a time; for application to multiple values, please use sapply()")
for (pat in patterns) {
regex <- gsub(wildcard, "[0-9]", pat)  # e.g. A*03:0X -> A*03:[0-9]{2}
if (grepl(paste0("^", regex, "$"), allele)) {
return(str_replace(pat, "_", "$"))
}
}
return(NA)
}
## Function to calculate HLA-specific GRS2 risk based on DQA1/DQB1 haplotypes
calcGrs2HlaOnly <- function(dataHla, scoresGenotype, scoresHaplotype, colnamesHla = c("hlaDrb1Dqa1Dqb1Alpha", "hlaDrb1Dqa1Dqb1Beta")) {
## this function calculates the HLA-DQA1/DQB1 component of the T1D GRS2, using the two haplotypes either in interaction or independently
# it assumes that each row contains both haplotypes, and that data are in the format "[DRB1]$[DQA1]$[DQB1]" where DRB1/DQA1/DQB1 are 4-digit alleles
# Extract DQA1/DQB1 genotypes from DRB1/DQA1/DQB1 genotypes
dataHla$hlaDqa1Dqb1Alpha <- extractHlaDqa1Dqb1(dataHlaTn19[[colnamesHla[1]]])
dataHla$hlaDqa1Dqb1Beta <- extractHlaDqa1Dqb1(dataHlaTn19[[colnamesHla[2]]])
# Extract alleles from score tables, and match the actual data to those alleles (yields NA if not found, which is fine)
allelesHlaAllInScores <-
unique(c(scoresGenotype$hlaDqa1Dqb1Alpha, scoresGenotype$hlaDqa1Dqb1Beta, scoresHaplotype$hlaDqa1Dqb1))
dataHla$hlaDqa1Dqb1Alpha <-
sapply(dataHla$hlaDqa1Dqb1Alpha, FUN = matchHlaAlleleWithWildcard, patterns = allelesHlaAllInScores)
dataHla$hlaDqa1Dqb1Beta <-
sapply(dataHla$hlaDqa1Dqb1Beta, FUN = matchHlaAlleleWithWildcard, patterns = allelesHlaAllInScores)
# Ensure genotype score alleles are sorted alphabetically to standardize
scoresGenotype$key <- apply(scoresGenotype[, c("hlaDqa1Dqb1Alpha", "hlaDqa1Dqb1Beta")], 1, function(x) paste(sort(x), collapse = "|"))
# Create a named vector for quick haplotype lookup
scoresVecHaplo <- setNames(scoresHaplotype$score, scoresHaplotype$hlaDqa1Dqb1)
# Result vector
scoresResult <- numeric(nrow(dataHla))
for (i in seq_len(nrow(dataHla))) {
a1 <- dataHla$hlaDqa1Dqb1Alpha[i]
a2 <- dataHla$hlaDqa1Dqb1Beta[i]
key <- paste(sort(c(a1, a2)), collapse = "|")
# Try to match genotype
matchIndex <- match(key, scoresGenotype$key)
if (!is.na(matchIndex)) {
scoresResult[i] <- scoresGenotype$score[matchIndex]
} else {
# Fallback to haplotype sum
score1 <- scoresVecHaplo[a1]
score2 <- scoresVecHaplo[a2]
scoresResult[i] <- sum(c(score1, score2), na.rm = TRUE)
}
}
return(scoresResult)
}
## load HLA genotype / haplotype scores from files
dataScoresHlaGenotypes <-
readxl::read_xlsx(
file.path(DIR_BOX_BASE, "Projects", "T1D_Tscm_disease_variation", "data", "GRS2 SNPs_Axiom array.xlsx"),
sheet = "scoresHlaGenotype") %>%
standardizeDimnames() %>%
mutate(hlaDqa1Dqb1Alpha = paste(dqa1_1, dqb1_1, sep = "$") %>% str_remove_all("\\:"),
hlaDqa1Dqb1Beta = paste(dqa1_2, dqb1_2, sep = "$") %>% str_remove_all("\\:")) %>%
dplyr::rename(score = beta)
dataScoresHlaHaplotypes <-
readxl::read_xlsx(
file.path(DIR_BOX_BASE, "Projects", "T1D_Tscm_disease_variation", "data", "GRS2 SNPs_Axiom array.xlsx"),
sheet = "scoresHlaHaplotype") %>%
standardizeDimnames() %>%
mutate(hlaDqa1Dqb1 = paste(dqa1, dqb1, sep = "$") %>% str_remove_all("\\:")) %>%
dplyr::rename(score = beta)
## save all of these objects for later use
save(list = setdiff(ls(), "DIR_BOX_BASE"),
file = file.path(DIR_BOX_BASE, "code", "functionsDataForGrs2HlaScores.RData"))
## save all of these objects for later use
save(list = setdiff(ls(), "DIR_BOX_BASE"),
file = file.path(DIR_BOX_BASE, "code", "Projects", "T1D_Tscm_disease_variation", "functionsDataForGrs2HlaScores.RData"))
## save all of these objects for later use
save(list = setdiff(ls(), "DIR_BOX_BASE"),
file = file.path(DIR_BOX_BASE, "Projects", "T1D_Tscm_disease_variation", "code", "functionsDataForGrs2HlaScores.RData"))
rm(list = ls())
#### GRS2 / HLA functions
### This is a collection of functions for determining GRS2 scores and HLA alleles.
## It is bundled here to make it easier to use across datasets, without building a proper R package
library(miscHelpers)
load_packages_with_install("tidyverse")
DIR_BOX_BASE <- file.path("/Users", "mattdufort", "Library", "CloudStorage", "Box-Box")
## Function to generate 4 combinations per row (unless haplotypes are identical)
# this function is for generating potential haplotypes from unphased HLA DRB1/DQA1/DQB1 data, to match to a known set of genotypes
generateHlaHaplotypes <- function(row, id_col) {
combos <- list(
c(row["hlaDrb1_1"], row["hlaDqa1_1"], row["hlaDqb1_1"], row["hlaDrb1_2"], row["hlaDqa1_2"], row["hlaDqb1_2"]),
c(row["hlaDrb1_1"], row["hlaDqa1_1"], row["hlaDqb1_2"], row["hlaDrb1_2"], row["hlaDqa1_2"], row["hlaDqb1_1"]),
c(row["hlaDrb1_1"], row["hlaDqa1_2"], row["hlaDqb1_1"], row["hlaDrb1_2"], row["hlaDqa1_1"], row["hlaDqb1_2"]),
c(row["hlaDrb1_1"], row["hlaDqa1_2"], row["hlaDqb1_2"], row["hlaDrb1_2"], row["hlaDqa1_1"], row["hlaDqb1_1"])
)
# Create a data frame with concatenated columns for each combination
data.frame(
id = row[[id_col]],
hlaDrb1Dqa1Dqb1Alpha = sapply(combos, function(x) paste(x[1], x[2], x[3], sep = "$")),
hlaDrb1Dqa1Dqb1Beta = sapply(combos, function(x) paste(x[4], x[5], x[6], sep = "$"))
) %>%
# keep unique combinations
distinct()
}
## Function to extract DQA1/DQB1 haplotypes (with format 0000$0000$0000) from DRB1/DQA1/DQB1 haplotypes (with format 0000$0000$0000)
extractHlaDqa1Dqb1 <- function(hlaDrb1Dqa1Dqb1) {
str_extract(hlaDrb1Dqa1Dqb1, "[0-9]{3}[0-9X]\\$[0-9]{4}$")
}
# # DR3 / DQ2 = presence of DRB1*03:01 and DQB1*02:01 (this lines up perfectly with the KQ1 and TN18 dr3Result values)
# REGEX_DR3_DQ2 <- "^0301\\$[0-9]{4}\\$0201"
#
# ## DR4 / DQ8 = presence of DRB1*04:xx and DQB1*03:02 (this lines up perfectly with the KQ1 and TN18 dr4Result values)
# # using only DQB1*03:02 is not perfect because there are occasional haplotypes that have it but not DR4 (e.g. 0801$0301$0302 has DR4 = ABSENT in TN18)
# # if we don't include the DRB1*04:xx, then
# REGEX_DR4_DQ8 <- "^04[0-9]{2}\\$[0-9]{4}\\$0302"
## Function to determine DR3/DR4 genotype from [DRB1]$[DQA1]$[DQB1] alpha/beta alleles
getGenotypeHlaDr3Dr4 <- function(dataHla, colnamessHla = c("hlaDrb1Dqa1Dqb1Alpha", "hlaDrb1Dqa1Dqb1Beta")) {
## this function counts the DR3 and DR4 alleles in HLA data, and adds columns for counts of those haplotypes and the DR3/DR4 genotype
# it assumes that each row contains both haplotypes, and that data are in the format "[DRB1]$[DQA1]$[DQB1]" where DRB1/DQA1/DQB1 are 4-digit alleles
REGEX_DR3_DQ2 <- "^0301\\$[0-9]{4}\\$0201"
REGEX_DR4_DQ8 <- "^04[0-9]{2}\\$[0-9]{4}\\$0302"
dataHla <-
dataHla %>%
rowwise() %>%
mutate(
countHlaDr3 = sum(str_detect(!!rlang::sym(colnamessHla[1]), REGEX_DR3_DQ2), str_detect(!!rlang::sym(colnamessHla[2]), REGEX_DR3_DQ2)),
countHlaDr4 = sum(str_detect(!!rlang::sym(colnamessHla[1]), REGEX_DR4_DQ8), str_detect(!!rlang::sym(colnamessHla[2]), REGEX_DR4_DQ8)),
genotypeHlaDr3Dr4 =
case_when(
countHlaDr3 == 2 ~ "DR3/DR3",
(countHlaDr3 == 1) & (countHlaDr4 == 0) ~ "DR3/x",
(countHlaDr3 == 1) & (countHlaDr4 == 1) ~ "DR3/DR4",
countHlaDr4 == 2 ~ "DR4/DR4",
(countHlaDr3 == 0) & (countHlaDr4 == 1) ~ "DR4/x",
countHlaDr3 + countHlaDr4 == 0 ~ "x/x",
TRUE ~ "unknown") %>%
factor(levels = c("DR3/DR3", "DR3/x", "DR3/DR4", "DR4/DR4", "DR4/x", "x/x", "unknown"))) %>%
ungroup()
dataHla
}
## Function to match HLA DQA1/DQB1 alleles to a set of alleles containing "X" as wildcard
matchHlaAlleleWithWildcard <- function(allele, patterns, wildcard = "X") {
# replace $ for easier matching with wildcards
allele <- str_replace(allele, "\\$", "_")
patterns <- str_replace(patterns, "\\$", "_")
if (length(allele) > 1)
stop("This function operates on one allele at a time; for application to multiple values, please use sapply()")
for (pat in patterns) {
regex <- gsub(wildcard, "[0-9]", pat)  # e.g. A*03:0X -> A*03:[0-9]{2}
if (grepl(paste0("^", regex, "$"), allele)) {
return(str_replace(pat, "_", "$"))
}
}
return(NA)
}
## Function to calculate HLA-specific GRS2 risk based on DQA1/DQB1 haplotypes
calcGrs2HlaOnly <- function(dataHla, scoresGenotype, scoresHaplotype, colnamesHla = c("hlaDrb1Dqa1Dqb1Alpha", "hlaDrb1Dqa1Dqb1Beta")) {
## this function calculates the HLA-DQA1/DQB1 component of the T1D GRS2, using the two haplotypes either in interaction or independently
# it assumes that each row contains both haplotypes, and that data are in the format "[DRB1]$[DQA1]$[DQB1]" where DRB1/DQA1/DQB1 are 4-digit alleles
# Extract DQA1/DQB1 genotypes from DRB1/DQA1/DQB1 genotypes
dataHla$hlaDqa1Dqb1Alpha <- extractHlaDqa1Dqb1(dataHlaTn19[[colnamesHla[1]]])
dataHla$hlaDqa1Dqb1Beta <- extractHlaDqa1Dqb1(dataHlaTn19[[colnamesHla[2]]])
# Extract alleles from score tables, and match the actual data to those alleles (yields NA if not found, which is fine)
allelesHlaAllInScores <-
unique(c(scoresGenotype$hlaDqa1Dqb1Alpha, scoresGenotype$hlaDqa1Dqb1Beta, scoresHaplotype$hlaDqa1Dqb1))
dataHla$hlaDqa1Dqb1Alpha <-
sapply(dataHla$hlaDqa1Dqb1Alpha, FUN = matchHlaAlleleWithWildcard, patterns = allelesHlaAllInScores)
dataHla$hlaDqa1Dqb1Beta <-
sapply(dataHla$hlaDqa1Dqb1Beta, FUN = matchHlaAlleleWithWildcard, patterns = allelesHlaAllInScores)
# Ensure genotype score alleles are sorted alphabetically to standardize
scoresGenotype$key <- apply(scoresGenotype[, c("hlaDqa1Dqb1Alpha", "hlaDqa1Dqb1Beta")], 1, function(x) paste(sort(x), collapse = "|"))
# Create a named vector for quick haplotype lookup
scoresVecHaplo <- setNames(scoresHaplotype$score, scoresHaplotype$hlaDqa1Dqb1)
# Result vector
scoresResult <- numeric(nrow(dataHla))
for (i in seq_len(nrow(dataHla))) {
a1 <- dataHla$hlaDqa1Dqb1Alpha[i]
a2 <- dataHla$hlaDqa1Dqb1Beta[i]
key <- paste(sort(c(a1, a2)), collapse = "|")
# Try to match genotype
matchIndex <- match(key, scoresGenotype$key)
if (!is.na(matchIndex)) {
scoresResult[i] <- scoresGenotype$score[matchIndex]
} else {
# Fallback to haplotype sum
score1 <- scoresVecHaplo[a1]
score2 <- scoresVecHaplo[a2]
scoresResult[i] <- sum(c(score1, score2), na.rm = TRUE)
}
}
return(scoresResult)
}
## load HLA genotype / haplotype scores from files
dataScoresHlaGenotypes <-
readxl::read_xlsx(
file.path(DIR_BOX_BASE, "Projects", "T1D_Tscm_disease_variation", "data", "GRS2 SNPs_Axiom array.xlsx"),
sheet = "scoresHlaGenotype") %>%
standardizeDimnames() %>%
mutate(hlaDqa1Dqb1Alpha = paste(dqa1_1, dqb1_1, sep = "$") %>% str_remove_all("\\:"),
hlaDqa1Dqb1Beta = paste(dqa1_2, dqb1_2, sep = "$") %>% str_remove_all("\\:")) %>%
dplyr::rename(score = beta)
dataScoresHlaHaplotypes <-
readxl::read_xlsx(
file.path(DIR_BOX_BASE, "Projects", "T1D_Tscm_disease_variation", "data", "GRS2 SNPs_Axiom array.xlsx"),
sheet = "scoresHlaHaplotype") %>%
standardizeDimnames() %>%
mutate(hlaDqa1Dqb1 = paste(dqa1, dqb1, sep = "$") %>% str_remove_all("\\:")) %>%
dplyr::rename(score = beta)
## save all of these objects for later use
save(list = setdiff(ls(), "DIR_BOX_BASE"),
file = file.path(DIR_BOX_BASE, "Projects", "T1D_Tscm_disease_variation", "code", "functionsDataForGrs2HlaScores.RData"))
?aggregate
tabulate_shared_TCR_chains <-
function(tcr_chain_matches,
tcr1_col = "tcr1", tcr2_col = "tcr2") {
checkmate::assert(
checkmate::check_data_frame(tcr_chain_matches)
)
if (nrow(tcr_chain_matches) == 0) {
tcr_chains_shared <-
cbind(
tcr_chain_matches[, c(tcr1_col, tcr2_col)],
"num_shared_chains" = integer())
} else {
# convert numeric column identifiers to column names
for (i in c("tcr1_col", "tcr2_col"))
if (is.numeric(get(i))) assign(i, colnames(tcrs)[get(i)])
# extract all the matches
tcr_chains_shared <-
summarise(
group_by(tcr_chain_matches, !!rlang::sym(tcr1_col), !!rlang::sym(tcr2_col)),
num_shared_chains = n())
# make the order of the cells consistent, and drop the duplicates
for (i in 1:nrow(tcr_chains_shared)) {
tcr_chains_shared[i, c(tcr1_col, tcr2_col)] <-
tcr_chains_shared[i, c(tcr1_col, tcr2_col)] %>%
unlist() %>%
sort()
}
tcr_chains_shared <- distinct(tcr_chains_shared)
}
tcr_chains_shared
}
col
??summarise
?summarise
?distinct
?group_by
?summarise
rowwise
?dplyr::rowwise
?sort
tabulate_shared_TCR_chains <-
function(tcr_chain_matches,
tcr1_col = "tcr1", tcr2_col = "tcr2") {
checkmate::assert(
checkmate::check_data_frame(tcr_chain_matches)
)
if (nrow(tcr_chain_matches) == 0) {
tcr_chains_shared <-
cbind(
tcr_chain_matches[, c(tcr1_col, tcr2_col)],
"num_shared_chains" = integer())
} else {
# convert numeric column identifiers to column names
for (currTcrColName in c("tcr1_col", "tcr2_col"))
if (is.numeric(get(currTcrColName))) assign(currTcrColName, colnames(tcrs)[get(currTcrColName)])
# extract all the matches
tcr_chains_shared <-
dplyr::summarise(
dplyr::group_by(tcr_chain_matches, !!rlang::sym(tcr1_col), !!rlang::sym(tcr2_col)),
num_shared_chains = n())
tcr_chains_shared <- as.data.frame(tcr_chains_shared)
# # make the order of the cells consistent, and drop the duplicates
# for (currRow in seq_len(nrow(tcr_chains_shared))) {
#   tcr_chains_shared[currRow, c(tcr1_col, tcr2_col)] <-
#     tcr_chains_shared[currRow, c(tcr1_col, tcr2_col)] %>%
#     unlist() %>%
#     sort()
# }
# tcr_chains_shared <- distinct(tcr_chains_shared)
# drop duplicates where tcr1_col == tcr2_col, alternate approach
tcr_chains_shared <-
mutate(rowwise(tcr_chains_shared), tcrs_combined = paste(sort(c(!!rlang::sym(tcr1_col), !!rlang::sym(tcr2_col)))))
tcr_chains_shared <-
tcr_chains_shared[!duplicated(tcr_chains_shared$tcrs_combined),]
tcr_chains_shared$tcrs_combined <- NULL
}
tcr_chains_shared
}
?paste
tabulate_shared_TCR_chains <-
function(tcr_chain_matches,
tcr1_col = "tcr1", tcr2_col = "tcr2") {
checkmate::assert(
checkmate::check_data_frame(tcr_chain_matches)
)
if (nrow(tcr_chain_matches) == 0) {
tcr_chains_shared <-
cbind(
tcr_chain_matches[, c(tcr1_col, tcr2_col)],
"num_shared_chains" = integer())
} else {
# convert numeric column identifiers to column names
for (currTcrColName in c("tcr1_col", "tcr2_col"))
if (is.numeric(get(currTcrColName))) assign(currTcrColName, colnames(tcrs)[get(currTcrColName)])
# extract all the matches
tcr_chains_shared <-
dplyr::summarise(
dplyr::group_by(tcr_chain_matches, !!rlang::sym(tcr1_col), !!rlang::sym(tcr2_col)),
num_shared_chains = n())
tcr_chains_shared <- as.data.frame(tcr_chains_shared)
# # make the order of the cells consistent, and drop the duplicates
# for (currRow in seq_len(nrow(tcr_chains_shared))) {
#   tcr_chains_shared[currRow, c(tcr1_col, tcr2_col)] <-
#     tcr_chains_shared[currRow, c(tcr1_col, tcr2_col)] %>%
#     unlist() %>%
#     sort()
# }
# tcr_chains_shared <- distinct(tcr_chains_shared)
# drop duplicates where tcr1_col == tcr2_col, alternate approach
tcr_chains_shared <-
mutate(rowwise(tcr_chains_shared),
tcrs_combined = paste(sort(c(!!rlang::sym(tcr1_col), !!rlang::sym(tcr2_col))), collapse = ""))
tcr_chains_shared <- as.data.frame(tcr_chains_shared)
tcr_chains_shared <-
tcr_chains_shared[!duplicated(tcr_chains_shared$tcrs_combined),]
tcr_chains_shared$tcrs_combined <- NULL
}
tcr_chains_shared
}
tabulate_shared_TCR_chains <-
function(tcr_chain_matches,
tcr1_col = "tcr1", tcr2_col = "tcr2") {
checkmate::assert(
checkmate::check_data_frame(tcr_chain_matches)
)
if (nrow(tcr_chain_matches) == 0) {
tcr_chains_shared <-
cbind(
tcr_chain_matches[, c(tcr1_col, tcr2_col)],
"num_shared_chains" = integer())
} else {
# convert numeric column identifiers to column names
for (currTcrColName in c("tcr1_col", "tcr2_col"))
if (is.numeric(get(currTcrColName))) assign(currTcrColName, colnames(tcrs)[get(currTcrColName)])
# extract all the matches
tcr_chains_shared <-
dplyr::summarise(
dplyr::group_by(tcr_chain_matches, !!rlang::sym(tcr1_col), !!rlang::sym(tcr2_col)),
num_shared_chains = n())
tcr_chains_shared <- as.data.frame(tcr_chains_shared)
# # make the order of the cells consistent, and drop the duplicates
# for (currRow in seq_len(nrow(tcr_chains_shared))) {
#   tcr_chains_shared[currRow, c(tcr1_col, tcr2_col)] <-
#     tcr_chains_shared[currRow, c(tcr1_col, tcr2_col)] %>%
#     unlist() %>%
#     sort()
# }
# tcr_chains_shared <- distinct(tcr_chains_shared)
# drop duplicates where tcr1_col == tcr2_col, alternate approach
tcr_chains_shared <-
mutate(rowwise(tcr_chains_shared),
tcrs_combined = paste(sort(c(!!rlang::sym(tcr1_col), !!rlang::sym(tcr2_col))), collapse = ""))
tcr_chains_shared <- as.data.frame(ungroup(tcr_chains_shared))
tcr_chains_shared <-
tcr_chains_shared[!duplicated(tcr_chains_shared$tcrs_combined),]
tcr_chains_shared$tcrs_combined <- NULL
}
tcr_chains_shared
}
rm(list = ls())
# setwd("~/Box Sync/Tools/R_scripts/R_packages")
library(devtools)
library(roxygen2)
packagesDirectory <-
file.path("~", "Library", "CloudStorage", "Box-Box",
"Tools", "R_scripts", "R_packages")
# packageName <- "miscHelpers"
# packageName <- "comboVisTools"
# packageName <- "corrMatrix"
# packageName <- "countSubsetNorm"
# packageName <- "geneSetTools"
# packageName <- "limmaTools"
# packageName <- "MASTtools"
# packageName <- "RNAseQC"
# packageName <- "WGCNAtools"
# packageName <- "R10Xtools"
packageName <- "TCRtools"
wd.tmp <- getwd()
setwd(file.path(packagesDirectory, packageName))
# usethis::create_package(packageName)  # initial package creation
devtools::document()
credentials::set_github_pat()
devtools::install(file.path("..", packageName))
setwd(wd.tmp)
rm(wd.tmp)
# check package contents
devtools::check(file.path(packagesDirectory, packageName))
wd.tmp <- getwd()
setwd(file.path(packagesDirectory, packageName))
# usethis::create_package(packageName)  # initial package creation
devtools::document()
credentials::set_github_pat()
devtools::install(file.path("..", packageName))
setwd(wd.tmp)
rm(wd.tmp)
# check package contents
devtools::check(file.path(packagesDirectory, packageName))
# setwd("~/Box Sync/Tools/R_scripts/R_packages")
library(devtools)
library(roxygen2)
packagesDirectory <-
file.path("~", "Library", "CloudStorage", "Box-Box",
"Tools", "R_scripts", "R_packages")
packageName <- "TCRtools"
wd.tmp <- getwd()
setwd(file.path(packagesDirectory, packageName))
# usethis::create_package(packageName)  # initial package creation
devtools::document()
credentials::set_github_pat()
devtools::install(file.path("..", packageName))
setwd(wd.tmp)
rm(wd.tmp)
# check package contents
devtools::check(file.path(packagesDirectory, packageName))
# setwd("~/Box Sync/Tools/R_scripts/R_packages")
library(devtools)
library(roxygen2)
packagesDirectory <-
file.path("~", "Library", "CloudStorage", "Box-Box",
"Tools", "R_scripts", "R_packages")
packageName <- "TCRtools"
wd.tmp <- getwd()
setwd(file.path(packagesDirectory, packageName))
# usethis::create_package(packageName)  # initial package creation
devtools::document()
credentials::set_github_pat()
devtools::install(file.path("..", packageName))
setwd(wd.tmp)
rm(wd.tmp)
# check package contents
devtools::check(file.path(packagesDirectory, packageName))
# check package contents
devtools::check(file.path(packagesDirectory, packageName))
credentials::set_github_pat()
devtools::install_github(paste("BenaroyaResearch", packageName, sep="/"))
# setwd("~/Box Sync/Tools/R_scripts/R_packages")
library(devtools)
library(roxygen2)
packagesDirectory <-
file.path("~", "Library", "CloudStorage", "Box-Box",
"Tools", "R_scripts", "R_packages")
packageName <- "miscHelpers"
wd.tmp <- getwd()
setwd(file.path(packagesDirectory, packageName))
# usethis::create_package(packageName)  # initial package creation
devtools::document()
credentials::set_github_pat()
devtools::install(file.path("..", packageName))