Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

diff_stat functions use base R for all calculations -2x speed up

  • Loading branch information...
commit fb2612a528f712e059e9e20080e6e400f6c49945 1 parent c4362ab
David Winter authored
3  R/D_Jost.R
@@ -24,8 +24,9 @@
24 24 D_Jost <- function(x){
25 25 n <- length(unique(pop(x)))
26 26 harmN <- harmonic_mean(table(pop(x)))
  27 + pops <- pop(x)
27 28 D.per.locus <- function(g) {
28   - a <- makefreq(genind2genpop(g, quiet=T), quiet=T)[[1]]
  29 + a <- apply(g@tab,2,function(row) tapply(row, pops, mean, na.rm=TRUE))
29 30 HpS <- sum(1 - apply(a^2, 1, sum, na.rm=TRUE)) / n
30 31 Hs_est <- (2*harmN/(2*harmN-1))*HpS
31 32 HpT <- 1 - sum(apply(a,2,mean, na.rm=TRUE)^2)
2  R/D_Jost.R~
@@ -38,7 +38,7 @@ D_Jost <- function(x){
38 38 global_Hs <- mean(loci[,1], na.rm=T)
39 39 global_Ht <- mean(loci[,2], na.rm=T)
40 40 global_D <- (global_Ht - global_Hs)/(1 - global_Hs ) * (n/(n-1))
41   - harm_D <- harmonic_mean(loci)
  41 + harm_D <- harmonic_mean(loci[,3])
42 42 return(list("per.locus"=loci[,3],
43 43 "global.het"=global_D,
44 44 "global.harm_mean" = harm_D
3  R/Gst_Hedrick.R
@@ -23,9 +23,10 @@
23 23 Gst_Hedrick <- function(x){
24 24 n <- length(unique(pop(x)))
25 25 harmN <- harmonic_mean(table(pop(x)))
  26 + pops <- pop(x)
26 27 D.per.locus <- function(g) {
27 28 #what we need to calculate these stats
28   - a <- makefreq(genind2genpop(g, quiet=T), quiet=T)[[1]]
  29 + a <- apply(g@tab,2,function(row) tapply(row, pops, mean, na.rm=TRUE))
29 30 HpS <- sum(1 - apply(a^2, 1, sum, na.rm=TRUE)) / n
30 31 Hs_est <- (2*harmN/(2*harmN-1))*HpS
31 32 HpT <- 1 - sum(apply(a,2,mean, na.rm=TRUE)^2)
2  R/Gst_Hedrick.R~
@@ -3,7 +3,7 @@
3 3 #' This function calculates Hedrick's G'st from a genind object
4 4 #'
5 5 #' Takes a genind object with population information and calculates Hedrick's
6   -#' G'st. This Returns a list with values for each locus as well as a global estimates
  6 +#' G''st. This Returns a list with values for each locus as well as a global estimates
7 7 #'
8 8 #' Because estimators of Hs and Ht are used, it's possible to have negative
9 9 #' estimates of Gst. You should treat such results as zeros (or estimating a
5 R/Gst_Nei.R
@@ -19,9 +19,10 @@
19 19 Gst_Nei <- function(x){
20 20 n <- length(unique(pop(x)))
21 21 harmN <- harmonic_mean(table(pop(x)))
  22 + pops <- pop(x)
22 23 Gst.per.locus <- function(g) {
23   - #what we need to calculate these stats
24   - a <- makefreq(genind2genpop(g, quiet=T), quiet=T)[[1]]
  24 + #what we need to calculate these
  25 + a <- apply(g@tab,2,function(row) tapply(row, pops, mean, na.rm=TRUE))
25 26 HpS <- sum(1 - apply(a^2, 1, sum, na.rm=TRUE)) / n
26 27 Hs_est <- (2*harmN/(2*harmN-1))*HpS
27 28 HpT <- 1 - sum(apply(a,2,mean, na.rm=TRUE)^2)
3  R/diff_stats.R
@@ -26,9 +26,10 @@
26 26 diff_stats <- function(x){
27 27 n <- length(unique(pop(x)))
28 28 harmN <- harmonic_mean(table(pop(x)))
  29 + pops <- pop(x)
29 30 per.locus <- function(g) {
30 31 #what we need to calculate these stats
31   - a <- makefreq(genind2genpop(g, quiet=T), quiet=T)[[1]]
  32 + a <- apply(g@tab,2,function(row) tapply(row, pops, mean, na.rm=TRUE))
32 33 HpS <- sum(1 - apply(a^2, 1, sum, na.rm=TRUE)) / n
33 34 Hs_est <- (2*harmN/(2*harmN-1))*HpS
34 35 HpT <- 1 - sum(apply(a,2,mean, na.rm=TRUE)^2)
6 R/diff_stats.R~
@@ -14,8 +14,11 @@
14 14 #' diff_stats(nancycats)
15 15 #' @references
16 16 #' Hedrick, PW. (2005), A Standardized Genetic Differentiation Measure. Evolution 59: 1633-1638.
  17 +#' @references
17 18 #' Jost, L. (2008), GST and its relatives do not measure differentiation. Molecular Ecology, 17: 4015-4026.
  19 +#' @references
18 20 #' Nei M. (1973) Analysis of gene diversity in subdivided populations. PNAS: 3321-3323.
  21 +#' @references
19 22 #' Nei M, Chesser RK. (1983). Estimation of fixation indices and gene diversities. Annals of Human Genetics. 47: 253-259.
20 23 #' @family diffstat
21 24
@@ -23,9 +26,10 @@
23 26 diff_stats <- function(x){
24 27 n <- length(unique(pop(x)))
25 28 harmN <- harmonic_mean(table(pop(x)))
  29 + pops <- pop(x)
26 30 per.locus <- function(g) {
27 31 #what we need to calculate these stats
28   - a <- makefreq(genind2genpop(g, quiet=T), quiet=T)[[1]]
  32 + a <- apply(g@tab,2,function(row) tapply(row, pops, mean, na.rm=TRUE))
29 33 HpS <- sum(1 - apply(a^2, 1, sum, na.rm=TRUE)) / n
30 34 Hs_est <- (2*harmN/(2*harmN-1))*HpS
31 35 HpT <- 1 - sum(apply(a,2,mean, na.rm=TRUE)^2)
2  R/summarise_bootstrap.R
@@ -34,7 +34,7 @@ summarise_bootsrap <- function(bs, statistic){
34 34 res$global.harm <- unlist(stats[3,])
35 35 }
36 36 summarise <- function(x){
37   - return(c(mean=mean(x), quantile(x, c(0.025, 0.975))))
  37 + return(c(mean=mean(x), quantile(x, c(0.025, 0.975), na.rm=TRUE)))
38 38 }
39 39 res$summary.loci <- apply(loc_stats, 2, summarise)
40 40 res$summary.global.het <- summarise(res$global.het)
5 R/summarise_bootstrap.R~
@@ -24,9 +24,8 @@
24 24 summarise_bootsrap <- function(bs, statistic){
25 25 nreps <- length(bs)
26 26 stats <- sapply(bs, statistic)
27   - loc_stats <- matrix(unlist(stats[1,]), nrow=nreps,
28   - dimnames=list(paste("rep", 1:nreps, sep=""), bs[[1]]@loc.names)
29   - )
  27 + loc_stats <- do.call(rbind, stats["per.locus",])
  28 +
30 29 res <-list("per.locus"= loc_stats,
31 30 "global.het"=unlist(stats[2,])
32 31 )

0 comments on commit fb2612a

Please sign in to comment.
Something went wrong with that request. Please try again.