rank_contributor_pairs.Rd
Separate a 2 person mixture by ranking the possible contributor pairs.
rank_contributor_pairs(contrib_pairs, fit, max_rank = NULL)
contrib_pairs | A |
---|---|
fit | A |
max_rank | Not used. Reserved for future use. |
A ranked_contrib_pairs
object that is basically an order
vector and the probabilities for each pair (in the same order as given in
contrib_pairs
), found by using fit
. Note, that contributor
order is disregarded so that each contributor pair is only present once (and
not twice as would be the case if taking order into consideration).
contributor_pairs
generate_mixture
disclapmix-package
disclapmix
disclapmixfit
clusterprob
predict.disclapmixfit
print.disclapmixfit
summary.disclapmixfit
simulate.disclapmixfit
disclap
data(danes) db <- as.matrix(danes[rep(1L:nrow(danes), danes$n), 1L:(ncol(danes) - 1L)]) set.seed(1) true_contribs <- sample(1L:nrow(db), 2L) h1 <- db[true_contribs[1L], ] h2 <- db[true_contribs[2L], ] db_ref <- db[-true_contribs, ] h1h2 <- c(paste(h1, collapse = ";"), paste(h2, collapse = ";")) tab_db <- table(apply(db, 1, paste, collapse = ";")) tab_db_ref <- table(apply(db_ref, 1, paste, collapse = ";")) tab_db[h1h2]#> #> 14;14;30;26;11;13;13;15;12;12 14;12;28;22;10;11;13;16;10;11 #> 1 9tab_db_ref[h1h2]#> #> <NA> 14;12;28;22;10;11;13;16;10;11 #> 8rm(db) # To avoid use by accident mixture <- generate_mixture(list(h1, h2)) possible_contributors <- contributor_pairs(mixture) possible_contributors#> Mixture: #> DYS19 DYS389I DYS389II DYS390 DYS391 DYS392 DYS393 DYS437 DYS438 DYS439 #> 1 14 12,14 28,30 22,26 10,11 11,13 13 15,16 10,12 11,12 #> #> Number of possible contributor pairs = 128fits <- lapply(1L:5L, function(clus) disclapmix(db_ref, clusters = clus)) best_fit_BIC <- fits[[which.min(sapply(fits, function(fit) fit$BIC_marginal))]] best_fit_BIC#> disclapmixfit from 183 observations on 10 loci with 4 clusters. #> #> EM converged: TRUE #> Number of central haplotype changes: 0 #> Total number of EM iterations: 15 #> Model observations (n*loci*clusters): 1830 #> Model parameters ((clusters*loci)+(loci+clusters-1)+(clusters-1)): 56 #> GLM method: internal_coef #> Initial central haplotypes supplied: FALSE #> Method to find initial central haplotypes: pamranked_contributors_BIC <- rank_contributor_pairs(possible_contributors, best_fit_BIC) ranked_contributors_BIC#> Mixture: #> DYS19 DYS389I DYS389II DYS390 DYS391 DYS392 DYS393 DYS437 DYS438 DYS439 #> 1 14 12,14 28,30 22,26 10,11 11,13 13 15,16 10,12 11,12 #> #> Contributor pairs = 128 #> #> Sum of all (product of contributor pair haplotypes) = 1.580619e-06 #> #> Showing rank 1-5: #> #> Rank 1 [ P(H1)*P(H2) = 1.452828e-06 ]: #> DYS19 DYS389I DYS389II DYS390 DYS391 DYS392 DYS393 DYS437 DYS438 DYS439 #> H1 . 12 28 22 10 11 . 16 10 11 #> H2 . 14 30 26 11 13 . 15 12 12 #> Prob #> H1 4.251328e-02 #> H2 3.417352e-05 #> #> Rank 2 [ P(H1)*P(H2) = 5.253259e-08 ]: #> DYS19 DYS389I DYS389II DYS390 DYS391 DYS392 DYS393 DYS437 DYS438 DYS439 #> H1 . 12 30 22 10 11 . 16 10 11 #> H2 . 14 28 26 11 13 . 15 12 12 #> Prob #> H1 1.537232e-03 #> H2 3.417349e-05 #> #> Rank 3 [ P(H1)*P(H2) = 4.103157e-08 ]: #> DYS19 DYS389I DYS389II DYS390 DYS391 DYS392 DYS393 DYS437 DYS438 DYS439 #> H1 . 12 28 22 10 11 . 16 10 12 #> H2 . 14 30 26 11 13 . 15 12 11 #> Prob #> H1 6.516434e-03 #> H2 6.296630e-06 #> #> Rank 4 [ P(H1)*P(H2) = 1.54343e-08 ]: #> DYS19 DYS389I DYS389II DYS390 DYS391 DYS392 DYS393 DYS437 DYS438 DYS439 #> H1 . 12 28 22 11 11 . 16 10 11 #> H2 . 14 30 26 10 13 . 15 12 12 #> Prob #> H1 3.996559e-03 #> H2 3.861896e-06 #> #> Rank 5 [ P(H1)*P(H2) = 1.115762e-08 ]: #> DYS19 DYS389I DYS389II DYS390 DYS391 DYS392 DYS393 DYS437 DYS438 DYS439 #> H1 . 12 30 26 11 13 . 15 12 12 #> H2 . 14 28 22 10 11 . 16 10 11 #> Prob #> H1 3.417352e-05 #> H2 3.264991e-04 #> #> (123 contributor pairs hidden.)plot(ranked_contributors_BIC, top = 10L, type = "b")#> [1] 1