max/ourMELONS
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Added function with minimal testing

Browse source
This commit is contained in:
Waldir Leoncio 2020-01-30 12:10:49 +01:00
parent a6508a3d85
commit 248db439dc
5 changed files with 74 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

36
R/admix1.R
View file

@ -486,38 +486,4 @@ admix1 <- function(tietue) {
# cumsumma = cumsum(freqs);
# arvo = rand;
# isommat = find(cumsumma>arvo);
# all = min(isommat);
# %--------------------------------------------------------------------------
# function omaFreqs = computePersonalAllFreqs(ind, data, allFreqs, rowsFromInd)
# % Laskee npops*(rowsFromInd*nloci) taulukon, jonka kutakin saraketta
# % vastaa yksilön ind alleeli. Eri rivit ovat alleelin alkuperäfrekvenssit
# % eri populaatioissa. Jos yksilölt?puuttuu jokin alleeli, niin vastaavaan
# % kohtaa tulee sarake ykkösi?
# global COUNTS;
# nloci = size(COUNTS,2);
# npops = size(COUNTS,3);
# rows = data(computeRows(rowsFromInd, ind, 1),:);
# omaFreqs = zeros(npops, (rowsFromInd*nloci));
# pointer = 1;
# for loc=1:size(rows,2)
# for all=1:size(rows,1)
# if rows(all,loc)>=0
# try,
# omaFreqs(:,pointer) = ...
# reshape(allFreqs(rows(all,loc),loc,:), [npops,1]);
# catch
# a=0;
# end
# else
# omaFreqs(:,pointer) = ones(npops,1);
# end
# pointer = pointer+1;
# end
# end
# all = min(isommat);

42
R/computePersonalAllFreqs.R Normal file
View file

@ -0,0 +1,42 @@
#' @title Compute Personal Freqs
#' @description Laskee npops*(rowsFromInd*nloci) taulukon, jonka kutakin
#' saraketta vastaa yksilön ind alleeli. Eri rivit ovat alleelin
#' alkuperäfrekvenssit eri populaatioissa. Jos yksilölt?puuttuu jokin alleeli,
#' niin vastaavaan kohtaa tulee sarake ykkösi?
#' @param ind ind
#' @param data data
#' @param allFreqs allFreqs
#' @param rowsFromInd rowsFromInd
#' @param COUNTS COUNTS
#' @export
computePersonalAllFreqs <- function(ind, data, allFreqs, rowsFromInd,
COUNTS = matrix(0)) {
nloci <- ifelse(is.na(dim(COUNTS)[2]), 1, dim(COUNTS)[2])
npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
rows <- as.matrix(t(data))[computeRows(rowsFromInd, ind, 1), , drop = FALSE]
omaFreqs <- zeros(npops, rowsFromInd * nloci)
pointer <- 1
for (loc in 1:dim(rows)[2]) {
for (all in 1:dim(rows)[1]) {
if (rows[all, loc] >= 0) {
if (pointer > ncol(omaFreqs)) omaFreqs <- cbind(omaFreqs, 0)
omaFreqs[, pointer] <- tryCatch(
matrix(
data = as.matrix(t(allFreqs))[rows[all, loc], loc],
nrow = npops
),
error = function(e) return(NA)
)
} else {
omaFreqs[, pointer] <- ones(npops, 1)
}
# omaFreqs <- unname(cbind(omaFreqs, new_omaFreqs))
pointer <- pointer + 1
}
}
omaFreqs <- omaFreqs[, !is.na(omaFreqs)]
return(omaFreqs)
}