-
Notifications
You must be signed in to change notification settings - Fork 3
/
getFocalAnimalPed.R
66 lines (66 loc) · 2.81 KB
/
getFocalAnimalPed.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
#' Get pedigree based on list of focal animals
#'
## Copyright(c) 2017-2020 R. Mark Sharp
## This file is part of nprcgenekeepr
#'
#' @return A pedigree file compatible with others in this package.
#'
#' @examples
#' library(nprcgenekeepr)
#' siteInfo <- getSiteInfo()
#' source <- " generated by getFocalAnimalPed: "
#' tryCatch(getFocalAnimalPed(fileName = "breeding file.csv"),
#' warning = function(wCond) {
#' cat(paste0("Warning", source, wCond),
#' name = "nprcgenekeepr")
#' return(NULL)},
#' error = function(eCond) {
#' cat(paste0("Error", source, eCond),
#' name = "nprcgenekeepr")
#' return(NULL)}
#' )
#' @param fileName character vector of temporary file path.
#' @param sep column separator in CSV file
#' @import futile.logger
#' @importFrom readxl excel_format
#' @importFrom utils read.table
#' @export
getFocalAnimalPed <- function(fileName, sep = ",") {
flog.debug(paste0("in getFocalAnimalPed\n"),
name = "nprcgenekeepr")
if (excel_format(fileName) %in% c("xls", "xlsx")) {
focalAnimals <- readExcelPOSIXToCharacter(fileName)
flog.debug(paste0("in getFocalAnimalPed after readxl, ",
"nrow(focalAnimals) = ",
nrow(focalAnimals), "\n"), name = "nprcgenekeepr")
} else {
focalAnimals <- read.csv(fileName,
header = TRUE,
sep = sep,
stringsAsFactors = FALSE,
na.strings = c("", "NA"),
check.names = FALSE)
flog.debug(paste0("in getFocalAnimalPed after read.csv, ",
"nrow(focalAnimals) = ",
nrow(focalAnimals), "\n"), name = "nprcgenekeepr")
}
focalAnimals <- as.character(focalAnimals[ , 1])
ped <- getLkDirectRelatives(ids = focalAnimals)
if (is.null(ped)) {
flog.debug(paste0("in getFocalAnimalPed after getLkDirectRelatives, which ",
"returned NULL.\n"), name = "nprcgenekeepr")
errorLst <- getEmptyErrorLst()
errorLst$failedDatabaseConnection <-
"Database connection failed: configuration or permissions are invalid."
return(errorLst)
}
flog.debug(paste0("in getFocalAnimalPed after getLkDirectRelatives, which ",
"returned ped with ", nrow(ped), "rows.\n"),
name = "nprcgenekeepr")
names(ped) <- c("id", "sex", "birth", "death", "departure", "dam", "sire")
ped <- ped[!is.na(ped$id), ]
ped$birth <- format(ped$birth, format = "%Y-%m-%d")
ped$death <- format(ped$death, format = "%Y-%m-%d")
ped$departure <- format(ped$departure, format = "%Y-%m-%d")
ped
}