From e1642f24e553597eb1ea037e3c8879b754bcecc3 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Wed, 31 Mar 2021 10:26:56 +0200 Subject: [PATCH 1/4] Added list output to cell() --- R/cell.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/cell.R b/R/cell.R index 746634e..c98a0dc 100644 --- a/R/cell.R +++ b/R/cell.R @@ -2,9 +2,14 @@ #' @description Creates an array of zeros #' @param n a the first dimension (or both, if sz is not passed) #' @param sz the second dimension (or 1st and 2nd, if not passed) +#' @param expandable if TRUE, output is a list (so it can take different +#' lengths) #' @param ... Other dimensions #' @return An array of zeroes with the dimensions passed on call -cell <- function(n, sz = c(n, n), ...) { +cell <- function(n, sz = c(n, n), expandable=FALSE, ...) { + if (expandable) { + return(vector("list", length = n)) + } if (length(sz) == 1 & missing(...)) { return(array(0, dim = c(n, sz))) } else if (length(sz) == 2) { From 4d9ed9210fdba02478d6af3316851a779ac982cb Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Wed, 31 Mar 2021 10:27:45 +0200 Subject: [PATCH 2/4] Added sorting of output on find() --- R/find.R | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/R/find.R b/R/find.R index 788b6ec..5e5efff 100644 --- a/R/find.R +++ b/R/find.R @@ -1,10 +1,15 @@ #' @title Find indices and values of nonzero elements #' @description Emulates behavior of `find` #' @param x object or logic operation on an object -find <- function(x) { +#' @param sort sort output? +find <- function(x, sort=TRUE) { if (is.logical(x)) { - return(which(x)) + out <- which(x) } else { - return(which(x > 0)) + out <- which(x > 0) } + if (sort) { + out <- sort(out) + } + return(out) } \ No newline at end of file From aec2f40c2c6e0c70c1a1c52296c949424eb80cb0 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Wed, 31 Mar 2021 10:28:11 +0200 Subject: [PATCH 3/4] Syntax fixes --- R/computeDiffInCounts.R | 2 +- R/greedyMix.R | 2 +- R/handleData.R | 25 ++++++++++-------- R/indMix.R | 56 ++++++++++++++++++++--------------------- 4 files changed, 44 insertions(+), 41 deletions(-) diff --git a/R/computeDiffInCounts.R b/R/computeDiffInCounts.R index 7de71f5..0f906e5 100644 --- a/R/computeDiffInCounts.R +++ b/R/computeDiffInCounts.R @@ -4,7 +4,7 @@ computeDiffInCounts <- function(rows, max_noalle, nloci, data) { # % riveill� rows. rows pit�� olla vaakavektori. diffInCounts <- zeros(max_noalle, nloci) - for (i in rows) { + for (i in seq_len(nrow(data)) ) { row <- data[i, ] notEmpty <- as.matrix(find(row>=0)) diff --git a/R/greedyMix.R b/R/greedyMix.R index f10f3b8..4ff05cf 100644 --- a/R/greedyMix.R +++ b/R/greedyMix.R @@ -317,7 +317,7 @@ greedyMix <- function( # npops <- logml_npops_partitionSummary$npops # partitionSummary <- logml_npops_partitionSummary$partitionSummary } else { - logml_npops_partitionSummary <- indMix(c) # TODO: translate + logml_npops_partitionSummary <- indMix(c) logml <- logml_npops_partitionSummary$logml npops <- logml_npops_partitionSummary$npops partitionSummary <- logml_npops_partitionSummary$partitionSummary diff --git a/R/handleData.R b/R/handleData.R index 5bfd072..0cbe633 100644 --- a/R/handleData.R +++ b/R/handleData.R @@ -20,7 +20,7 @@ handleData <- function(raw_data) { # koodi pienimm?ksi koodiksi, joka isompi kuin mik??n k?yt?ss?oleva koodi. # T?m?n j?lkeen funktio muuttaa alleelikoodit siten, ett?yhden lokuksen j # koodit saavat arvoja v?lill?1,...,noalle(j). - data <- raw_data + data <- as.matrix(raw_data) nloci <- size(raw_data, 2) - 1 dataApu <- data[, 1:nloci] @@ -35,26 +35,31 @@ handleData <- function(raw_data) { # isoinAlleeli <- [] noalle <- zeros(1, nloci) - alleelitLokuksessa <- cell(nloci, 1) + alleelitLokuksessa <- cell(nloci, 1, expandable=TRUE) for (i in 1:nloci) { alleelitLokuksessaI <- unique(data[, i]) - alleelitLokuksessaI_pos <- find(alleelitLokuksessaI >= 0) - alleelitLokuksessa[i, 1] <- ifelse( - test = length(alleelitLokuksessaI_pos) > 0, - yes = alleelitLokuksessaI[alleelitLokuksessaI_pos], - no = 0 - ) - noalle[i] <- length(alleelitLokuksessa[i, 1]) + alleelitLokuksessa[[i]] <- sort(alleelitLokuksessaI[ + find( + alleelitLokuksessaI >= 0 + ) + ]) + noalle[i] <- length(alleelitLokuksessa[[i]]) } alleleCodes <- zeros(max(noalle), nloci) for (i in 1:nloci) { - alleelitLokuksessaI <- alleelitLokuksessa[i, 1] + alleelitLokuksessaI <- alleelitLokuksessa[[i]] puuttuvia <- max(noalle) - length(alleelitLokuksessaI) alleleCodes[, i] <- as.matrix( c(alleelitLokuksessaI, zeros(puuttuvia, 1)) ) } + for (loc in seq_len(nloci)) { + for (all in seq_len(noalle[loc])) { + data[find(data[, loc] == alleleCodes[all, loc]), loc] <- all + } + } + nind <- max(data[, ncol(data)]) nrows <- size(data, 1) ncols <- size(data, 2) diff --git a/R/indMix.R b/R/indMix.R index 017b124..a094f0f 100644 --- a/R/indMix.R +++ b/R/indMix.R @@ -21,7 +21,6 @@ indMix <- function(c, npops, dispText) { rm(c) nargin <- length(as.list(match.call())) - 1 - if (nargin < 2) { dispText <- 1 npopstext <- matrix() @@ -48,7 +47,7 @@ indMix <- function(c, npops, dispText) { } else { npopsTaulu <- as.numeric(npopstext) ykkoset <- find(npopsTaulu == 1) - npopsTaulu[ykkoset] <- list() # Mik�li ykk�si� annettu yl�rajaksi, ne poistetaan. + npopsTaulu[ykkoset] <- NA # Mik�li ykk�si� annettu yl�rajaksi, ne poistetaan (if ones are given as an upper limit, they are deleted) if (isempty(npopsTaulu)) { logml <- 1 partitionSummary <- 1 @@ -112,7 +111,7 @@ indMix <- function(c, npops, dispText) { vaihe <- 1 if (dispText) { - cat( + message( paste0( '\nMixture analysis started with initial ', as.character(npops), @@ -125,7 +124,7 @@ indMix <- function(c, npops, dispText) { muutoksia <- 0 if (dispText) { - cat(paste('\nPerforming steps:', as.character(roundTypes))) + message(paste('\nPerforming steps:', as.character(roundTypes))) } for (n in 1:length(roundTypes)) { @@ -151,35 +150,35 @@ indMix <- function(c, npops, dispText) { diffInCounts <- muutokset_diffInCounts$diffInCounts if (round == 1) { - maxMuutos <- max_MATLAB(muutokset)[[1]] - i2 <- max_MATLAB(muutokset)[[2]] + maxMuutos <- max_MATLAB(muutokset)$max + i2 <- max_MATLAB(muutokset)$idx } if (i1 != i2 & maxMuutos > 1e-5) { - # browser() # TEMP # Tapahtui muutos muutoksia <- 1 if (muutosNyt == 0) { muutosNyt <- 1 - if (dispText) { - cat('Action 1') - } + if (dispText) message('Action 1') } kokeiltu <- zeros(nRoundTypes, 1) kivaluku <- kivaluku + 1 updateGlobalVariables( ind, i2, diffInCounts, adjprior, priorTerm ) - logml <- logml+maxMuutos + logml <- logml + maxMuutos if (logml > worstLogml) { - partitionSummary_added <- addToSummary( + temp_addToSum <- addToSummary( logml, partitionSummary, worstIndex ) - partitionSummary <- partitionSummary_added$partitionSummary - added <- partitionSummary_added$added + partitionSummary <- temp_addToSum$partitionSummary + added <- temp_addToSum$added if (added == 1) { - worstLogml <- min_MATLAB(partitionSummary[, 2])[[1]] - worstIndex <- min_MATLAB(partitionSummary[, 2])[[2]] + temp_minMATLAB <- min_MATLAB( + partitionSummary[, 2] + ) + worstLogml <- temp_minMATLAB[[1]] + worstIndex <- temp_minMATLAB[[2]] } } } @@ -188,7 +187,6 @@ indMix <- function(c, npops, dispText) { if (muutosNyt == 0) { kokeiltu[round] <- 1 } - } else if (round == 2) { # Populaation yhdist�minen toiseen. maxMuutos <- 0 for (pop in 1:npops) { @@ -218,11 +216,11 @@ indMix <- function(c, npops, dispText) { cat('Action 2') } if (logml > worstLogml) { - partitionSummary_added <- addToSummary( + temp_addToSum <- addToSummary( logml, partitionSummary, worstIndex ) - partitionSummary <- partitionSummary_added$partitionSummary - added <- partitionSummary_added$added + partitionSummary <- temp_addToSum$partitionSummary + added <- temp_addToSum$added if (added==1) { worstLogml <- min_MATLAB(partitionSummary[, 2])[[1]] worstIndex <- min_MATLAB(partitionSummary[, 2])[[2]] @@ -287,11 +285,11 @@ indMix <- function(c, npops, dispText) { } } if (logml > worstLogml) { - partitionSummary_added <- addToSummary( + temp_addToSum <- addToSummary( logml, partitionSummary, worstIndex ) - partitionSummary <- partitionSummary_added$partitionSummary - added <- partitionSummary_added$added + partitionSummary <- temp_addToSum$partitionSummary + added <- temp_addToSum$added if (added==1) { worstLogml <- min_MATLAB(partitionSummary[, 2])[[1]] worstIndex <- min_MATLAB(partitionSummary[, 2])[[2]] @@ -369,11 +367,11 @@ indMix <- function(c, npops, dispText) { } } if (logml > worstLogml) { - partitionSummary_added <- addToSummary( + temp_addToSum <- addToSummary( logml, partitionSummary, worstIndex ) - partitionSummary <- partitionSummary_added$partitionSummary - added <- partitionSummary_added$added + partitionSummary <- temp_addToSum$partitionSummary + added <- temp_addToSum$added if (added==1) { worstLogml <- min_MATLAB(partitionSummary[, 2])[[1]] worstIndex <- min_MATLAB(partitionSummary[, 2])[[2]] @@ -474,11 +472,11 @@ indMix <- function(c, npops, dispText) { muutoksia <- 1 logml <- logml + totalMuutos if (logml > worstLogml) { - partitionSummary_added <- addToSummary( + temp_addToSum <- addToSummary( logml, partitionSummary, worstIndex ) - partitionSummary <- partitionSummary_added$partitionSummary - added <- partitionSummary_added$added + partitionSummary <- temp_addToSum$partitionSummary + added <- temp_addToSum$added if (added == 1) { worstLogml <- min_MATLAB(partitionSummary[, 2])[[1]] worstIndex <- min_MATLAB(partitionSummary[, 2])[[2]] From 3d43ed856f95f862ff85a9fe81f9e93687840599 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Wed, 31 Mar 2021 10:31:43 +0200 Subject: [PATCH 4/4] Added test for handleData --- tests/testthat/test-greedyMix.R | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/tests/testthat/test-greedyMix.R b/tests/testthat/test-greedyMix.R index b833456..96b7d1d 100644 --- a/tests/testthat/test-greedyMix.R +++ b/tests/testthat/test-greedyMix.R @@ -1,3 +1,34 @@ +context("Auxiliary functions to greedyMix") + +baps_diploid <- read.delim( + "inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt", + sep = " ", + header = FALSE +) + +handleData(baps_diploid)$newData + +test_that("handleData works as expected", { + data_obs <- handleData(baps_diploid)$newData + data_exp <- matrix( + c( + -9, 1, 2, 1, 1, 1, 2, 1, 2, 2, 1, + -9, 1, 1, 2, 2, 2, 1, 1, 1, 2, 1, + 3, 2, 2, 3, 2, -9, 3, 1, 2, 1, 2, + 2, 1, 2, 1, 2, -9, 1, 1, 1, 1, 2, + 3, 1, 1, 1, 2, 1, 1, 2, -9, 1, 3, + 3, 1, 2, 1, 1, 1, 2, 1, -9, 2, 3, + 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 4, + 3, 2, 2, 3, 2, 2, 3, 1, 2, 1, 4, + 2, 1, 2, 1, -9, 1, 1, 1, 1, 1, 5, + 3, 1, 1, 1, -9, 1, 1, 2, 1, 1, 5 + ), + nrow = 10, byrow = TRUE + ) + colnames(data_exp) <- colnames(data_obs) + expect_equal(data_obs, data_exp) +}) + context("Opening files on greedyMix") # TODO: needs #12 to be fixed before this can be done without user intervention