andreas/daDoctoR
1
0
Fork 0
mirror of https://github.com/agdamsbo/daDoctoR.git synced 2024-11-22 11:50:23 +01:00
Code Issues Projects Releases Wiki Activity

u

Browse Source
This commit is contained in:
agdamsbo 2018-10-08 16:36:46 +02:00
parent ba38fa052d
commit a8afb7df46
1 changed files with 12 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
R/hwe_sum.R
View File

@ -10,25 +10,17 @@
#' hwe_sum() #' hwe_sum()
hwe_sum<-function (a1, a2, f) { hwe_sum<-function (a1, a2, f) {
## HWE summarising function, for several groups defined by factor f. Alleles are provided as vectors, a1 and a2. require(daDoctoR)
source("https://raw.githubusercontent.com/agdamsbo/research/master/hwe_allele.R")
lst <- list() lst <- list()
df<-data.frame(cbind(a1,a2)) df <- data.frame(a1, a2)
for (i in 1:length(ls <- split(df, f))) { for (i in 1:length(ls <- split(df, f))) {
grp <- names(ls)[i] grp <- names(ls)[i]
obs <- data.frame(hwe_allele(ls[[i]][, 1], ls[[i]][,2])[[c("observed.dist")]]) obs <- data.frame(hwe_allele(ls[[i]][, 1], ls[[i]][,2])[[c("observed.dist")]])
pval <- round(hwe_allele(ls[[i]][, 1], ls[[i]][, 2])[[c("p.value")]],3) pval <- round(hwe_allele(ls[[i]][, 1], ls[[i]][, 2])[[c("p.value")]],3)
prnt <- paste0(obs[1, ], " (", obs[2, ], ")") prnt <- paste0(obs[1, ], " (", obs[2, ], ")")
names(prnt) <- names(obs) names(prnt) <- names(obs)
lst <- list(lst, grp, obs.dist = obs, print = prnt,hwe.pv = pval) lst <- list(lst, grp, obs.dist = obs, print = prnt,hwe.pv = pval)
} }
return(lst) return(lst)
} }