test_that("as.ped.data.frame identifies columns correctly", { A = singleton("A") dfA = data.frame(id="A", fid=0, mid=0, sex=1) expect_identical(as.ped(dfA), A) expect_identical(as.ped(rev(dfA)), A) B = singleton("B", sex=2, famid="1") dfB = data.frame(famid="1", id="B", fid=0, mid=0, sex=2) expect_identical(as.ped(dfB), B) expect_identical(as.ped(rev(dfB)), B) }) test_that("data.frame with multiple singletons is converted to pedlist", { ans = list(S1 = singleton("A", sex=2, famid="S1"), S2 = singleton("B", sex=1, famid="S2")) df = data.frame(famid=c("S1", "S2"), id=c("A", "B"), fid=0, mid=0, sex=2:1) expect_identical(as.ped(df), ans) df_shuffled = rev(df)[2:1,] expect_identical(as.ped(df_shuffled), ans[2:1]) }) test_that("data.frame with multiple peds is converted to pedlist", { ans = list(S1 = nuclearPed(1), S2 = nuclearPed(1)) famid(ans$S1) = "S1" famid(ans$S2) = "S2" df = data.frame(famid = rep(c("S1", "S2"), each=3), id = rep(1:3,2), fid = rep(c(0,0,1), 2), mid = rep(c(0,0,2), 2), sex = rep(c(1,2,1), 2)) expect_identical(as.ped(df), ans) df_shuffled = rev(df)[6:1,] res = as.ped(df_shuffled) expect_identical(lapply(res, reorderPed), ans[2:1]) }) test_that("as.ped() converts data.frame with marker columns", { df = data.frame(id=c('fa','mo','boy'), fid=c(0,0,'fa'), mid=c(0,0,'mo'), sex=c(1,2,1), c(0,0,1), c(0,0,2), c(0,0,2), c(0,0,2), fix.empty.names = F, stringsAsFactors = F) trio = nuclearPed(fa="fa", mo="mo", child="boy") x1 = as.ped(df) expect_equal(nMarkers(x1), 2) expect_identical(x1$MARKERS[[1]], marker(trio, boy=1:2)) expect_identical(x1$MARKERS[[2]], marker(trio, boy=2)) # force two alleles x2 = as.ped(df, locusAttributes = list(alleles=1:2)) expect_identical(x2$MARKERS[[1]], marker(trio, boy=1:2)) expect_identical(x2$MARKERS[[2]], marker(trio, boy=2, alleles=1:2)) # Same, with markers in single columns: dfS = data.frame(id=c('fa','mo','boy'), fid=c(0,0,'fa'), mid=c(0,0,'mo'), sex=c(1,2,1), c(NA,NA,"1/2"), c(NA,NA,"2/2"), fix.empty.names = F, stringsAsFactors = F) expect_identical(x1, as.ped(dfS, sep="/")) expect_identical(x2, as.ped(dfS, sep="/", locusAttributes = list(alleles=1:2))) }) test_that("as.ped() converts data.frame to singletons with marker columns", { df = data.frame(famid=c("s1", "s2"), id=1, fid=0, mid=0, sex=1, m1=c(NA, "1/2")) pedlist = as.ped(df, sep="/") s1 = singleton(1, famid="s1") s1 = setMarkers(s1, marker(s1, name = "m1")) s2 = singleton(1, famid="s2") s2 = setMarkers(s2, marker(s2, '1'=1:2, name = "m1")) expect_identical(pedlist, list('s1'=s1, 's2'=s2)) }) test_that("as.ped() does not reorder (i.e. does not shuffle genotypes)", { x = reorderPed(nuclearPed(1), 3:1) |> addMarker('3' = "1/2", name = "M") s = singleton("NN") |> addMarker(NN = 1:2, name = "M") df = rbind(as.data.frame(x), as.data.frame(s)) df = cbind(famid = c(1,1,1,2), df) y = as.ped(df, sep="/") famid(y[[1]]) = famid(y[[2]]) = "" expect_identical(list('1'=x, '2'=s), y) }) test_that("marker_col argument of as.ped() works", { trio = data.frame(id = 1:3, fid = c(0,0,1), mid = c(0,0,2), sex = c(1,2,1), M1a = c(1,2,1), M1b=c(1,2,2)) trio.ped = as.ped(trio, marker_col=5:ncol(trio)) expect_length(trio.ped$MARKERS, 1) }) test_that("readPed() handles spaces in ID labels", { x = singleton("A B C") tmp = writePed(x, tempfile(), what = "ped") y = readPed(tmp, colSep = "\t") expect_identical(x,y) }) test_that("readPed() guesses columns correctly", { x = nuclearPed(1) df = as.data.frame(x) write.table(df, tmp <- tempfile(), col.names = FALSE, row.names = FALSE, quote = FALSE) y = readPed(tmp) expect_identical(x,y) df2 = c(1, df) write.table(df, tmp2 <- tempfile(), col.names = FALSE, row.names = FALSE, quote = FALSE) y2 = readPed(tmp2) expect_identical(x,y2) })