Skip to content

Commit 441a17a

Browse files
smasongarrisonsmasongarrison
committed
cran prep
1 parent f65b27f commit 441a17a

27 files changed

Lines changed: 166 additions & 198 deletions

‎R/buildComponent.R‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -687,7 +687,6 @@ loadOrComputeCheckpoint <- function(file, compute_fn,
687687
}
688688

689689

690-
691690
#' parent-child adjacency data
692691
#' @inheritParams loadOrComputeCheckpoint
693692
#' @inheritParams ped2com

‎R/calculateRelatedness.R‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -33,10 +33,11 @@
3333
#' @export
3434
#'
3535
calculateRelatedness <- function(
36-
generations = 2, path = NULL, full = TRUE, maternal = FALSE,
37-
empirical = FALSE, segregating = TRUE,
38-
total_a = 6800 * 1000000, total_m = 16500,
39-
weight_a = 1, weight_m = 1, denom_m = FALSE, ...) {
36+
generations = 2, path = NULL, full = TRUE, maternal = FALSE,
37+
empirical = FALSE, segregating = TRUE,
38+
total_a = 6800 * 1000000, total_m = 16500,
39+
weight_a = 1, weight_m = 1, denom_m = FALSE, ...
40+
) {
4041
# If path is not provided, it is calculated as twice the number of generations
4142
if (is.null(path)) {
4243
path <- generations * 2

‎R/checkIDs.R‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,6 @@ checkIDuniqueness <- function(ped, verbose = FALSE) {
123123
}
124124

125125

126-
127126
#' Check for within-row duplicates (self-parents, same mom/dad)
128127
#'
129128
#' This function checks for within-row duplicates in a pedigree.

‎R/checkParents.R‎

Lines changed: 20 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -35,8 +35,7 @@ checkParentIDs <- function(ped, verbose = FALSE, repair = FALSE,
3535
momID = "momID",
3636
dadID = "dadID",
3737
code_male = NULL,
38-
code_female = NULL
39-
) {
38+
code_female = NULL) {
4039
# Standardize column names in the input dataframe
4140
ped <- standardizeColnames(ped, verbose = verbose)
4241

@@ -93,7 +92,6 @@ checkParentIDs <- function(ped, verbose = FALSE, repair = FALSE,
9392
# Determine modal sex values for moms and dads
9493

9594

96-
9795
mom_results <- checkParentSex(ped, parent_col = "momID", verbose = verbose)
9896
dad_results <- checkParentSex(ped, parent_col = "dadID", verbose = verbose)
9997

@@ -187,7 +185,7 @@ checkParentIDs <- function(ped, verbose = FALSE, repair = FALSE,
187185
}
188186
}
189187
}
190-
if (addphantoms==TRUE) {
188+
if (addphantoms == TRUE) {
191189
# Generate new IDs
192190
newIDbase <- if (is.numeric(ped$ID)) max(ped$ID, na.rm = TRUE) + 1 else paste0("phantom-", seq_len(nrow(ped)))
193191
# Initialize a dataframe to store new entries
@@ -210,37 +208,36 @@ checkParentIDs <- function(ped, verbose = FALSE, repair = FALSE,
210208
newID <- if (is.numeric(ped$ID)) newIDbase + added_counter else paste0("phantom-dad-", ped$ID[idx])
211209
added_counter <- added_counter + 1
212210
ped$dadID[idx] <- newID
213-
if ("famID" %in% names(ped)){
214-
newFAMID <- unique(ped$famID[idx])
211+
if ("famID" %in% names(ped)) {
212+
newFAMID <- unique(ped$famID[idx])
215213
newFAMID <- newFAMID[!is.na(newFAMID)]
216214

217-
new_entry <- addParentRow(new_entry_base, newID = newID, dadID = NA, momID = NA, sex = inferred_sex, famID = newFAMID)
215+
new_entry <- addParentRow(new_entry_base, newID = newID, dadID = NA, momID = NA, sex = inferred_sex, famID = newFAMID)
218216
} else {
219-
new_entry <- addParentRow(new_entry_base, newID = newID, dadID = NA, momID = NA, sex = inferred_sex)
217+
new_entry <- addParentRow(new_entry_base, newID = newID, dadID = NA, momID = NA, sex = inferred_sex)
220218
}
221219
new_entries <- rbind(new_entries, new_entry)
222220
}
223221

224222
# Add moms when missing
225-
inferred_sex <- if (length(validation_results$female_var) > 0 && !is.na(validation_results$female_var)){
223+
inferred_sex <- if (length(validation_results$female_var) > 0 && !is.na(validation_results$female_var)) {
226224
validation_results$female_var
227225
} else {
228-
0
229-
}
226+
0
227+
}
230228

231229
for (idx in which(!is.na(ped$dadID) & is.na(ped$momID))) {
232230
newID <- if (is.numeric(ped$ID)) newIDbase + added_counter else paste0("phantom-mom-", ped$ID[idx])
233231
added_counter <- added_counter + 1
234232
ped$momID[idx] <- newID
235233

236-
if ("famID" %in% names(ped)){
237-
newFAMID <- unique(ped$famID[idx])
234+
if ("famID" %in% names(ped)) {
235+
newFAMID <- unique(ped$famID[idx])
238236
newFAMID <- newFAMID[!is.na(newFAMID)]
239237

240238
new_entry <- addParentRow(new_entry_base, newID = newID, dadID = NA, momID = NA, sex = inferred_sex, famID = newFAMID)
241239
} else {
242-
243-
new_entry <- addParentRow(new_entry_base, newID = newID, dadID = NA, momID = NA, sex = inferred_sex)
240+
new_entry <- addParentRow(new_entry_base, newID = newID, dadID = NA, momID = NA, sex = inferred_sex)
244241
}
245242
new_entries <- rbind(new_entries, new_entry)
246243
}
@@ -333,16 +330,16 @@ addRowlessParents <- function(ped, verbose, validation_results) {
333330
)
334331
inferred_sex <- if ("mom" %in% role) validation_results$female_var else validation_results$male_var
335332

336-
if("famID" %in% names(ped)){
337-
newFAMID <- unique(ped$famID[which(ped$momID == pid | ped$dadID == pid)])
338-
newFAMID <- newFAMID[!is.na(newFAMID)]
333+
if ("famID" %in% names(ped)) {
334+
newFAMID <- unique(ped$famID[which(ped$momID == pid | ped$dadID == pid)])
335+
newFAMID <- newFAMID[!is.na(newFAMID)]
339336

340337

341-
if(length(newFAMID) >1){
342-
newFAMID <- NA
343-
}
338+
if (length(newFAMID) > 1) {
339+
newFAMID <- NA
340+
}
344341

345-
new_entry <- addParentRow(new_entry_base, newID = pid, dadID = NA, momID = NA, sex = inferred_sex, famID = newFAMID)
342+
new_entry <- addParentRow(new_entry_base, newID = pid, dadID = NA, momID = NA, sex = inferred_sex, famID = newFAMID)
346343
} else {
347344
new_entry <- addParentRow(new_entry_base, newID = pid, dadID = NA, momID = NA, sex = inferred_sex)
348345
}
@@ -357,7 +354,6 @@ addRowlessParents <- function(ped, verbose, validation_results) {
357354
}
358355

359356

360-
361357
return(ped)
362358
}
363359

@@ -374,8 +370,7 @@ addRowlessParents <- function(ped, verbose, validation_results) {
374370
addParentRow <- function(template_row, newID, sex,
375371
momID = NA,
376372
dadID = NA,
377-
famID = NA
378-
) {
373+
famID = NA) {
379374
new_row <- template_row
380375
new_row[] <- NA # set all columns to NA
381376
new_row$ID <- newID

‎R/cleanPedigree.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
#'
88
#' @param df A dataframe whose column names need to be standardized.
99
#' @param verbose A logical indicating whether to print progress messages.
10-
#' @return A dataframe with standardized column names.
10+
#' @return A dataframe with standardized column names.
1111
#'
1212
#' @keywords internal
1313
standardizeColnames <- function(df, verbose = FALSE) {

‎R/estimateCIs.R‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -61,23 +61,23 @@ calculateCIs <- function(tbl,
6161
mc <- match.call()
6262
user_set_doubleentered <- "doubleentered" %in% names(mc)
6363

64-
method_in <- tolower(method %||% "raykov") # `%||%` if you have it; else just tolower(method)
65-
method_effective <- switch(
66-
method_in,
64+
method_in <- tolower(method %||% "raykov") # `%||%` if you have it; else just tolower(method)
65+
method_effective <- switch(method_in,
6766
"raykov" = "raykov",
68-
"fisherz" = "raykov", # alias
67+
"fisherz" = "raykov", # alias
6968
"wald" = "wald",
7069
"doubleentered" = {
7170
if (!user_set_doubleentered) doubleentered <- TRUE
72-
"raykov" # double-entry + Fisher z
71+
"raykov" # double-entry + Fisher z
7372
},
7473
"doubleenteredconserv" = {
7574
if (!user_set_doubleentered) doubleentered <- TRUE
76-
"wald" # double-entry + Wald (more conservative)
75+
"wald" # double-entry + Wald (more conservative)
7776
},
7877
{
7978
warning(sprintf("Unrecognized method '%s'; defaulting to 'wald'.", method),
80-
call. = FALSE)
79+
call. = FALSE
80+
)
8181
"wald"
8282
}
8383
)

‎R/makeLinks.R‎

Lines changed: 44 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -24,24 +24,25 @@
2424
#' @export com2links
2525

2626
com2links <- function(
27-
rel_pairs_file = "dataRelatedPairs.csv",
28-
ad_ped_matrix = NULL,
29-
mit_ped_matrix = mt_ped_matrix,
30-
mt_ped_matrix = NULL,
31-
cn_ped_matrix = NULL,
32-
# pat_ped_matrix = NULL,
33-
# mat_ped_matrix = NULL,
34-
# mapa_id_file = "data_mapaID.csv",
35-
write_buffer_size = 1000,
36-
update_rate = 1000,
37-
gc = TRUE,
38-
writetodisk = TRUE,
39-
verbose = FALSE,
40-
legacy = FALSE,
41-
outcome_name = "data",
42-
drop_upper_triangular = TRUE,
43-
include_all_links_1ped = FALSE,
44-
...) {
27+
rel_pairs_file = "dataRelatedPairs.csv",
28+
ad_ped_matrix = NULL,
29+
mit_ped_matrix = mt_ped_matrix,
30+
mt_ped_matrix = NULL,
31+
cn_ped_matrix = NULL,
32+
# pat_ped_matrix = NULL,
33+
# mat_ped_matrix = NULL,
34+
# mapa_id_file = "data_mapaID.csv",
35+
write_buffer_size = 1000,
36+
update_rate = 1000,
37+
gc = TRUE,
38+
writetodisk = TRUE,
39+
verbose = FALSE,
40+
legacy = FALSE,
41+
outcome_name = "data",
42+
drop_upper_triangular = TRUE,
43+
include_all_links_1ped = FALSE,
44+
...
45+
) {
4546
# --- Input Validations and Preprocessing ---
4647

4748
# Ensure that at least one relationship matrix is provided.
@@ -80,7 +81,6 @@ com2links <- function(
8081
ids <- NULL
8182

8283

83-
8484
if (!is.null(cn_ped_matrix)) {
8585
ids <- as.numeric(dimnames(cn_ped_matrix)[[1]])
8686
nc <- ncol(cn_ped_matrix)
@@ -228,7 +228,6 @@ com2links <- function(
228228
#' @keywords internal
229229

230230

231-
232231
process_one <- function(matrix, rel_name, ids, nc, rel_pairs_file, writetodisk,
233232
write_buffer_size, drop_upper_triangular, update_rate, verbose, gc,
234233
include_all_links = TRUE, ...) {
@@ -340,18 +339,19 @@ process_one <- function(matrix, rel_name, ids, nc, rel_pairs_file, writetodisk,
340339
}
341340

342341
process_all_three <- function(
343-
mat1, name1,
344-
mat2, name2,
345-
mat3, name3,
346-
ids, nc,
347-
rel_pairs_file,
348-
writetodisk,
349-
write_buffer_size,
350-
drop_upper_triangular,
351-
update_rate,
352-
verbose,
353-
gc,
354-
...) {
342+
mat1, name1,
343+
mat2, name2,
344+
mat3, name3,
345+
ids, nc,
346+
rel_pairs_file,
347+
writetodisk,
348+
write_buffer_size,
349+
drop_upper_triangular,
350+
update_rate,
351+
verbose,
352+
gc,
353+
...
354+
) {
355355
# Extract matrix slots
356356
p1 <- mat1@p + 1L
357357
i1 <- mat1@i + 1L
@@ -446,17 +446,18 @@ process_all_three <- function(
446446
}
447447

448448
process_two <- function(
449-
matrix1, name1,
450-
matrix2, name2,
451-
ids, nc,
452-
rel_pairs_file,
453-
writetodisk,
454-
write_buffer_size,
455-
drop_upper_triangular,
456-
update_rate,
457-
verbose,
458-
gc,
459-
...) {
449+
matrix1, name1,
450+
matrix2, name2,
451+
ids, nc,
452+
rel_pairs_file,
453+
writetodisk,
454+
write_buffer_size,
455+
drop_upper_triangular,
456+
update_rate,
457+
verbose,
458+
gc,
459+
...
460+
) {
460461
# Extract internal slots
461462
p1 <- matrix1@p + 1L
462463
i1 <- matrix1@i + 1L

‎R/makeLinkslegacy.R‎

Lines changed: 28 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -4,23 +4,24 @@
44

55

66
.com2links.legacy <- function(
7-
rel_pairs_file = "dataRelatedPairs.csv",
8-
ad_ped_matrix = NULL,
9-
mit_ped_matrix = mt_ped_matrix,
10-
mt_ped_matrix = NULL,
11-
cn_ped_matrix = NULL,
12-
# pat_ped_matrix = NULL,
13-
# mat_ped_matrix = NULL,
14-
# mapa_id_file = "data_mapaID.csv",
15-
write_buffer_size = 1000,
16-
update_rate = 1000,
17-
gc = TRUE,
18-
writetodisk = TRUE,
19-
verbose = FALSE,
20-
legacy = FALSE,
21-
outcome_name = "data",
22-
drop_upper_triangular = TRUE,
23-
...) {
7+
rel_pairs_file = "dataRelatedPairs.csv",
8+
ad_ped_matrix = NULL,
9+
mit_ped_matrix = mt_ped_matrix,
10+
mt_ped_matrix = NULL,
11+
cn_ped_matrix = NULL,
12+
# pat_ped_matrix = NULL,
13+
# mat_ped_matrix = NULL,
14+
# mapa_id_file = "data_mapaID.csv",
15+
write_buffer_size = 1000,
16+
update_rate = 1000,
17+
gc = TRUE,
18+
writetodisk = TRUE,
19+
verbose = FALSE,
20+
legacy = FALSE,
21+
outcome_name = "data",
22+
drop_upper_triangular = TRUE,
23+
...
24+
) {
2425
# Non-legacy mode processing
2526

2627
if (!legacy) {
@@ -62,7 +63,6 @@
6263
ids <- NULL
6364

6465

65-
6666
if (!is.null(cn_ped_matrix)) {
6767
ids <- as.numeric(dimnames(cn_ped_matrix)[[1]])
6868
nc <- ncol(cn_ped_matrix)
@@ -508,15 +508,16 @@
508508

509509

510510
.com2links.og <- function(
511-
rel_pairs_file = "dataRelatedPairs.csv",
512-
ad_ped_matrix = NULL,
513-
mit_ped_matrix = mt_ped_matrix,
514-
mt_ped_matrix = NULL,
515-
cn_ped_matrix = NULL,
516-
update_rate = 500,
517-
verbose = FALSE,
518-
outcome_name = "data",
519-
...) {
511+
rel_pairs_file = "dataRelatedPairs.csv",
512+
ad_ped_matrix = NULL,
513+
mit_ped_matrix = mt_ped_matrix,
514+
mt_ped_matrix = NULL,
515+
cn_ped_matrix = NULL,
516+
update_rate = 500,
517+
verbose = FALSE,
518+
outcome_name = "data",
519+
...
520+
) {
520521
# --- Legacy Mode ---
521522
if (verbose == TRUE) {
522523
message("Using legacy mode")

0 commit comments

Comments
 (0)