From eff04b312442480a98b50bca727aca3f07e248e5 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 25 Feb 2020 15:41:05 +0100 Subject: [PATCH] Added poistaLiianPienet --- NAMESPACE | 1 + R/poistaLiianPienet.R | 49 ++++++++++++++++++++++++++++++++++++ man/poistaLiianPienet.Rd | 27 ++++++++++++++++++++ tests/testthat/test-admix1.R | 5 ++++ 4 files changed, 82 insertions(+) create mode 100644 R/poistaLiianPienet.R create mode 100644 man/poistaLiianPienet.Rd diff --git a/NAMESPACE b/NAMESPACE index c80ce2b..aa5e19f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ export(etsiParas) export(laskeMuutokset4) export(learn_simple_partition) export(ownNum2Str) +export(poistaLiianPienet) export(proportion2str) export(rand) export(randdir) diff --git a/R/poistaLiianPienet.R b/R/poistaLiianPienet.R new file mode 100644 index 0000000..685a8f1 --- /dev/null +++ b/R/poistaLiianPienet.R @@ -0,0 +1,49 @@ +#' @title Remove too small +#' @description Muokkaa tulokset muotoon, jossa outlier yksilöt on poistettu. +#' Tarkalleen ottaen poistaa ne populaatiot, joissa on vähemmän kuin +#' 'alaraja':n verran yksilöit? +#' @param npops npops +#' @param rowsFromInd rowsFromInd +#' @param alaraja alaraja +#' @export +poistaLiianPienet <- function (npops, rowsFromInd, alaraja, + PARTITION = matrix(NA, 0, 0), COUNTS = matrix(NA, 0, 0), + SUMCOUNTS = NA) { + + popSize <- zeros(1,npops) + if (npops > 0) { + for (i in 1:npops) { + popSize[i] <- length(which(PARTITION == i)) + } + } + miniPops <- which(popSize < alaraja) + + if (length(miniPops) == 0) { + return(npops) + } + + outliers <- matrix(NA, 0, 0) + for (pop in miniPops) { + inds <- which(PARTITION == pop) + cat('Removed individuals: ') + cat(as.character(inds)) + outliers = matrix(c(outliers, inds), ncol=1) + } + + ninds <- length(PARTITION) + PARTITION[outliers] <- 0 + korit <- unique(PARTITION(which(PARTITION > 0))) + for (n in 1:length(korit)) { + kori <- korit[n] + yksilot <- which(PARTITION == kori) + PARTITION[yksilot] == n + } + + # TODO: add COUNTS, SUMCOUNTS and PARTITION to return or use <<- + COUNTS[, , miniPops] <- NA + SUMCOUNTS[miniPops, ] <- NA + + npops <- npops - length(miniPops) + + return(npops) +} \ No newline at end of file diff --git a/man/poistaLiianPienet.Rd b/man/poistaLiianPienet.Rd new file mode 100644 index 0000000..1e48921 --- /dev/null +++ b/man/poistaLiianPienet.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/poistaLiianPienet.R +\name{poistaLiianPienet} +\alias{poistaLiianPienet} +\title{Remove too small} +\usage{ +poistaLiianPienet( + npops, + rowsFromInd, + alaraja, + PARTITION = matrix(NA, 0, 0), + COUNTS = matrix(NA, 0, 0), + SUMCOUNTS = NA +) +} +\arguments{ +\item{npops}{npops} + +\item{rowsFromInd}{rowsFromInd} + +\item{alaraja}{alaraja} +} +\description{ +Muokkaa tulokset muotoon, jossa outlier yksilöt on poistettu. +Tarkalleen ottaen poistaa ne populaatiot, joissa on vähemmän kuin +'alaraja':n verran yksilöit? +} diff --git a/tests/testthat/test-admix1.R b/tests/testthat/test-admix1.R index 12ae460..453a1e1 100644 --- a/tests/testthat/test-admix1.R +++ b/tests/testthat/test-admix1.R @@ -227,4 +227,9 @@ test_that("simulateAllFreqs works as expected", { test_that("computeAllFreqs2 works as expected", { expect_equivalent(computeAllFreqs2(10), matrix(NA, 0, 0)) +}) + +test_that("poistaLiianPienet works as expected", { + expect_equal(poistaLiianPienet(100, matrix(1:4, 2), 0), 100) + expect_equal(poistaLiianPienet(100, matrix(1:4, 2), -5), 100) }) \ No newline at end of file