From c0d36e2c302db7ce4592d3699e140e82b1c8b63d Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 1 Feb 2021 09:22:58 +0100 Subject: [PATCH 01/29] Fixed syntax --- R/computeDiffInCounts.R | 2 +- R/computePopulationLogml.R | 17 +++++++++++++---- R/indMix.R | 4 ++-- 3 files changed, 16 insertions(+), 7 deletions(-) diff --git a/R/computeDiffInCounts.R b/R/computeDiffInCounts.R index af53f61..7de71f5 100644 --- a/R/computeDiffInCounts.R +++ b/R/computeDiffInCounts.R @@ -6,7 +6,7 @@ computeDiffInCounts <- function(rows, max_noalle, nloci, data) { diffInCounts <- zeros(max_noalle, nloci) for (i in rows) { row <- data[i, ] - notEmpty <- find(row>=0) + notEmpty <- as.matrix(find(row>=0)) if (length(notEmpty) > 0) { diffInCounts[row(notEmpty) + (notEmpty - 1) * max_noalle] <- diff --git a/R/computePopulationLogml.R b/R/computePopulationLogml.R index a6cf71c..b2675d7 100644 --- a/R/computePopulationLogml.R +++ b/R/computePopulationLogml.R @@ -1,18 +1,26 @@ -computePopulationLogml <- function(pops, adjprior, priorTerm) { +computePopulationLogml <- function(pops, adjprior, priorTerm = 0) { # Palauttaa length(pops)*1 taulukon, jossa on laskettu korikohtaiset + # ======================================================== # + # Limiting COUNTS size # + # ======================================================== # + COUNTS <- COUNTS[seq_len(nrow(adjprior)), seq_len(ncol(adjprior)), pops, drop=FALSE] + x <- size(COUNTS, 1) y <- size(COUNTS, 2) z <- length(pops) - popLogml <- squeeze( + # ======================================================== # + # Computation # + # ======================================================== # + term1 <- squeeze( # FIXME: assumes COUNTS has 3 dims. Where does this come from? sum( sum( reshape( lgamma( repmat(adjprior, c(1, 1, length(pops))) + - COUNTS[, , pops] + COUNTS[seq_len(nrow(adjprior)), seq_len(ncol(adjprior)), pops, drop=FALSE] ), c(x, y, z) ), @@ -20,6 +28,7 @@ computePopulationLogml <- function(pops, adjprior, priorTerm) { ), 2 ) - ) - sum(lgamma(1 + SUMCOUNTS[pops, ]), 2) - priorTerm + ) + popLogml <- term1 - sum(lgamma(1 + SUMCOUNTS[pops, ]), 2) - priorTerm return(popLogml) } \ No newline at end of file diff --git a/R/indMix.R b/R/indMix.R index 4f1d65c..ac65114 100644 --- a/R/indMix.R +++ b/R/indMix.R @@ -137,11 +137,11 @@ indMix <- function(c, npops, dispText) { round <- roundTypes[n] kivaluku <- 0 - if (kokeiltu(round) == 1) { #Askelta kokeiltu viime muutoksen j�lkeen + if (kokeiltu[round] == 1) { #Askelta kokeiltu viime muutoksen j�lkeen } else if (round == 0 | round == 1) { #Yksil�n siirt�minen toiseen populaatioon. inds <- 1:ninds - aputaulu <- c(t(inds), rand(ninds, 1)) + aputaulu <- cbind(inds, rand(ninds, 1)) aputaulu <- sortrows(aputaulu, 2) inds <- t(aputaulu[, 1]) muutosNyt <- 0 From edd0cac775f79f3659dbb59491897ffb996c447c Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 1 Feb 2021 09:23:45 +0100 Subject: [PATCH 02/29] Added TODO --- tests/testthat/test-greedyMix.R | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-greedyMix.R b/tests/testthat/test-greedyMix.R index f1faf53..21a5d6d 100644 --- a/tests/testthat/test-greedyMix.R +++ b/tests/testthat/test-greedyMix.R @@ -1,10 +1,11 @@ context("Opening files on greedyMix") -# greedyMix( -# tietue = "inst/ext/ExamplesDataFormatting/Example baseline data in GENEPOP format for Trained clustering.txt", -# format = "GenePop", -# savePreProcessed = FALSE -# ) +# TODO: needs #12 to be fixed before this can be done without user intervention +greedyMix( + tietue = "inst/ext/ExamplesDataFormatting/Example baseline data in GENEPOP format for Trained clustering.txt", + format = "GenePop", + savePreProcessed = FALSE +) # Upper bounds 100 100 context("Linkage") From aa8a066530a5baed35050c4b4caf4e5770c0cbce Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 1 Feb 2021 10:01:02 +0100 Subject: [PATCH 03/29] Improved array dropping --- R/computePopulationLogml.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/computePopulationLogml.R b/R/computePopulationLogml.R index b2675d7..d4516e0 100644 --- a/R/computePopulationLogml.R +++ b/R/computePopulationLogml.R @@ -13,14 +13,14 @@ computePopulationLogml <- function(pops, adjprior, priorTerm = 0) { # ======================================================== # # Computation # # ======================================================== # + isarray <- length(dim(repmat(adjprior, c(1, 1, length(pops))))) > 2 term1 <- squeeze( - # FIXME: assumes COUNTS has 3 dims. Where does this come from? sum( sum( reshape( lgamma( repmat(adjprior, c(1, 1, length(pops))) + - COUNTS[seq_len(nrow(adjprior)), seq_len(ncol(adjprior)), pops, drop=FALSE] + COUNTS[seq_len(nrow(adjprior)), seq_len(ncol(adjprior)), pops, drop=!isarray] ), c(x, y, z) ), From 58bf940ae3210fe36bb62b9c97ffc97a1ab48745 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 1 Feb 2021 10:01:14 +0100 Subject: [PATCH 04/29] Improved printing --- R/indMix.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/indMix.R b/R/indMix.R index ac65114..4cd1212 100644 --- a/R/indMix.R +++ b/R/indMix.R @@ -79,10 +79,11 @@ indMix <- function(c, npops, dispText) { npops <- npopsTaulu[[run]] if (dispText) { dispLine() - print( + cat( paste0( 'Run ', as.character(run), '/', as.character(nruns), - ', maximum number of populations ', as.character(npops), '.' + ', maximum number of populations ', as.character(npops), + '.\n' ) ) } @@ -115,12 +116,11 @@ indMix <- function(c, npops, dispText) { vaihe <- 1 if (dispText) { - print(' ') - print( + cat( paste0( - 'Mixture analysis started with initial', + '\nMixture analysis started with initial ', as.character(npops), - 'populations.' + ' populations.' ) ) } @@ -129,7 +129,7 @@ indMix <- function(c, npops, dispText) { muutoksia <- 0 if (dispText) { - print(paste('Performing steps:', as.character(roundTypes))) + cat(paste('\nPerforming steps:', as.character(roundTypes))) } for (n in 1:length(roundTypes)) { From 44210e97373bd55c20419a7bf5724df8ce4dae97 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 1 Feb 2021 10:01:25 +0100 Subject: [PATCH 05/29] Changed global definitions --- R/globals.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/globals.R b/R/globals.R index 385c5c7..82e9f2c 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,8 +1,8 @@ COUNTS <- array(0, dim=c(100, 100, 100)) SUMCOUNTS <- array(0, dim=c(100, 100)) -PARTITION <- vector() -POP_LOGML <- vector() -LOGDIFF <- vector() +PARTITION <- array(1, dim=c(100)) +POP_LOGML <- array(1, dim=c(100)) +LOGDIFF <- array(1, dim=c(100, 100)) # If handling globas break, try other ideas from https://stackoverflow.com/a/65252740/1169233 From 62255fcb40433e302fdaf596347cb229a1b279eb Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 1 Feb 2021 10:01:40 +0100 Subject: [PATCH 06/29] Added TODOs --- R/laskeMuutokset12345.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/laskeMuutokset12345.R b/R/laskeMuutokset12345.R index d9ae738..4a979f2 100644 --- a/R/laskeMuutokset12345.R +++ b/R/laskeMuutokset12345.R @@ -68,12 +68,15 @@ laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) { COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts - i2 <- find(muutokset == -Inf) # Etsit��n populaatiot jotka muuttuneet viime kerran j�lkeen. + # TODO: check i2 calculation against MATLAB (where does this code come from?) + i2 <- find(muutokset == -Inf) # Etsit��n populaatiot jotka muuttuneet viime kerran j�lkeen. (Searching for populations that have changed since the last time) i2 <- setdiff(i2, i1) i2_logml <- POP_LOGML[i2] ni2 <- length(i2) + # FIXME: i2 is empty + browser() # TEMP COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, ni2)) SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(ni2, 1)) new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm) From 4bb450c6c14098f9f335b125bbcc07b19c70bb19 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 15 Feb 2021 09:03:28 +0100 Subject: [PATCH 07/29] Fixed bugs in laskeMuutokset() --- R/laskeMuutokset12345.R | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/R/laskeMuutokset12345.R b/R/laskeMuutokset12345.R index 4a979f2..ef790d7 100644 --- a/R/laskeMuutokset12345.R +++ b/R/laskeMuutokset12345.R @@ -60,7 +60,7 @@ laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) { diffInCounts <- computeDiffInCounts( rows, size(COUNTS, 1), size(COUNTS, 2), data ) - diffInSumCounts <- sum(diffInCounts) + diffInSumCounts <- rowSums(diffInCounts) COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts @@ -68,15 +68,12 @@ laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) { COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts - # TODO: check i2 calculation against MATLAB (where does this code come from?) i2 <- find(muutokset == -Inf) # Etsit��n populaatiot jotka muuttuneet viime kerran j�lkeen. (Searching for populations that have changed since the last time) i2 <- setdiff(i2, i1) i2_logml <- POP_LOGML[i2] ni2 <- length(i2) - # FIXME: i2 is empty - browser() # TEMP COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, ni2)) SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(ni2, 1)) new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm) @@ -84,7 +81,7 @@ laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) { SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(ni2, 1)) muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml - LOGDIFF[ind, ] = muutokset + LOGDIFF[ind, ] <- muutokset return(list(muutokset = muutokset, diffInCounts = diffInCounts)) } From 1b5d97a0412fef23a4e073c1078d1bb50dee3aaa Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 15 Feb 2021 09:03:44 +0100 Subject: [PATCH 08/29] Improved handling of 0-dim on repmat --- R/repmat.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/repmat.R b/R/repmat.R index 642c3cd..2845b7e 100644 --- a/R/repmat.R +++ b/R/repmat.R @@ -15,6 +15,12 @@ repmat <- function (mx, n) { if (length(n) > 3) warning("Extra dimensions of n ignored") if (!is(mx, "matrix")) mx <- t(as.matrix(mx)) if (length(n) == 1) n <- rep(n, 2) + if (any(n == 0)) { + n_zero <- which(n == 0) + out_dim <- dim(mx) + out_dim[n_zero] <- 0 + return(array(dim=out_dim)) + } # Replicating cols out <- mx_col <- matrix(rep(mx, n[2]), nrow(mx)) From 75ff42daedf0452ec948ca3bbc2cb02628cb50e8 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 15 Feb 2021 09:49:21 +0100 Subject: [PATCH 09/29] Fixed syntax --- R/computePopulationLogml.R | 3 ++- R/min_max_MATLAB.R | 2 ++ R/updateGlobalVariables.R | 13 ++++++------- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/R/computePopulationLogml.R b/R/computePopulationLogml.R index d4516e0..e0f4765 100644 --- a/R/computePopulationLogml.R +++ b/R/computePopulationLogml.R @@ -1,4 +1,4 @@ -computePopulationLogml <- function(pops, adjprior, priorTerm = 0) { +computePopulationLogml <- function(pops, adjprior, priorTerm) { # Palauttaa length(pops)*1 taulukon, jossa on laskettu korikohtaiset # ======================================================== # @@ -29,6 +29,7 @@ computePopulationLogml <- function(pops, adjprior, priorTerm = 0) { 2 ) ) + if (is.null(priorTerm)) priorTerm <- 0 popLogml <- term1 - sum(lgamma(1 + SUMCOUNTS[pops, ]), 2) - priorTerm return(popLogml) } \ No newline at end of file diff --git a/R/min_max_MATLAB.R b/R/min_max_MATLAB.R index 7ad9d0e..83162d2 100644 --- a/R/min_max_MATLAB.R +++ b/R/min_max_MATLAB.R @@ -5,6 +5,7 @@ #' @return Either a list or a vector #' @author Waldir Leoncio min_MATLAB <- function(X, indices = TRUE) { + if (!is(X, "matrix")) X <- as.matrix(X) mins <- apply(X, 2, min) idx <- sapply(seq_len(ncol(X)), function(x) match(mins[x], X[, x])) if (indices) { @@ -21,6 +22,7 @@ min_MATLAB <- function(X, indices = TRUE) { #' @return Either a list or a vector #' @author Waldir Leoncio max_MATLAB <- function(X, indices = TRUE) { + if (!is(X, "matrix")) X <- as.matrix(X) maxs <- apply(X, 2, max) idx <- sapply(seq_len(ncol(X)), function(x) match(maxs[x], X[, x])) if (indices) { diff --git a/R/updateGlobalVariables.R b/R/updateGlobalVariables.R index 1602faf..e6d004d 100644 --- a/R/updateGlobalVariables.R +++ b/R/updateGlobalVariables.R @@ -1,14 +1,13 @@ updateGlobalVariables <- function(ind, i2, diffInCounts, adjprior, priorTerm) { # % Suorittaa globaalien muuttujien muutokset, kun yksil� ind # % on siirret��n koriin i2. - i1 <- PARTITION[ind] PARTITION[ind] <- i2 COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts COUNTS[, , i2] <- COUNTS[, , i2] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - sum[diffInCounts] - SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + sum[diffInCounts] + SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - rowSums(diffInCounts) + SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + rowSums(diffInCounts) POP_LOGML[c(i1, i2)] <- computePopulationLogml( c(i1, i2), adjprior, priorTerm @@ -28,8 +27,8 @@ updateGlobalVariables2 <- function(i1, i2, diffInCounts, adjprior, priorTerm) { COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts COUNTS[, , i2] <- COUNTS[, , i2] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - sum[diffInCounts] - SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + sum[diffInCounts] + SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - rowSums(diffInCounts) + SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + rowSums(diffInCounts) POP_LOGML[i1] <- 0 POP_LOGML[i2] <- computePopulationLogml(i2, adjprior, priorTerm) @@ -51,8 +50,8 @@ updateGlobalVariables3 <- function( COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts COUNTS[, , i2] <- COUNTS[, , i2] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - sum[diffInCounts] - SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + sum[diffInCounts] + SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - rowSums(diffInCounts) + SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + rowSums(diffInCounts) POP_LOGML[c(i1, i2)] <- computePopulationLogml( c(i1, i2), adjprior, priorTerm From d3c390a5f8c138f7673da0e3d1874ee973faad43 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 15 Feb 2021 10:04:27 +0100 Subject: [PATCH 10/29] Syntax fix --- R/indMix.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/indMix.R b/R/indMix.R index 4cd1212..ae1eb6f 100644 --- a/R/indMix.R +++ b/R/indMix.R @@ -178,7 +178,7 @@ indMix <- function(c, npops, dispText) { partitionSummary_added = addToSummary( logml, partitionSummary, worstIndex ) - partitionSummary_added <- partitionSummary_added$partitionSummary + partitionSummary <- partitionSummary_added$partitionSummary added <- partitionSummary_added$added if (added == 1) { worstLogml <- min_MATLAB(partitionSummary[, 2])[[1]] @@ -480,7 +480,7 @@ indMix <- function(c, npops, dispText) { partitionSummary_added = addToSummary( logml, partitionSummary, worstIndex ) - partitionSummary_added <- partitionSummary_added$partitionSummary + partitionSummary <- partitionSummary_added$partitionSummary added <- partitionSummary_added$added if (added == 1) { worstLogml <- min_MATLAB(partitionSummary[, 2])[[1]] From a13e2c30ac5ff68859d8f0ff8756c469475d1c6d Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 15 Feb 2021 10:04:58 +0100 Subject: [PATCH 11/29] Improved printing --- R/indMix.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/indMix.R b/R/indMix.R index ae1eb6f..5595707 100644 --- a/R/indMix.R +++ b/R/indMix.R @@ -165,7 +165,7 @@ indMix <- function(c, npops, dispText) { if (muutosNyt == 0) { muutosNyt <- 1 if (dispText) { - print('Action 1') + cat('Action 1') } } kokeiltu <- zeros(nRoundTypes, 1) @@ -218,7 +218,7 @@ indMix <- function(c, npops, dispText) { ) logml <- logml + maxMuutos if (dispText) { - print('Action 2') + cat('Action 2') } if (logml > worstLogml) { partitionSummary_added <- addToSummary( @@ -284,9 +284,9 @@ indMix <- function(c, npops, dispText) { logml <- logml + maxMuutos if (dispText) { if (round == 3) { - print('Action 3') + cat('Action 3') } else { - print('Action 4') + cat('Action 4') } } if (logml > worstLogml) { @@ -365,9 +365,9 @@ indMix <- function(c, npops, dispText) { muutoksia <- 1 # Ulompi kirjanpito. if (dispText) { if (round == 5) { - print('Action 5') + cat('Action 5') } else { - print('Action 6') + cat('Action 6') } } } @@ -489,7 +489,7 @@ indMix <- function(c, npops, dispText) { } if (muutoksiaNyt == 0) { if (dispText) { - print('Action 7') + cat('Action 7') } muutoksiaNyt <- 1 } From 85b7fe15339f36e5c7361eb87ccf7a7a21a2245a Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 15 Feb 2021 10:05:31 +0100 Subject: [PATCH 12/29] Changed assignment operator --- R/indMix.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/indMix.R b/R/indMix.R index 5595707..c2a0cf2 100644 --- a/R/indMix.R +++ b/R/indMix.R @@ -148,7 +148,7 @@ indMix <- function(c, npops, dispText) { for (ind in inds) { i1 <- PARTITION[ind] - muutokset_diffInCounts = laskeMuutokset( + muutokset_diffInCounts <- laskeMuutokset( ind, rows, data, adjprior, priorTerm ) muutokset <- muutokset_diffInCounts$muutokset @@ -175,7 +175,7 @@ indMix <- function(c, npops, dispText) { ) logml <- logml+maxMuutos if (logml > worstLogml) { - partitionSummary_added = addToSummary( + partitionSummary_added <- addToSummary( logml, partitionSummary, worstIndex ) partitionSummary <- partitionSummary_added$partitionSummary @@ -477,7 +477,7 @@ indMix <- function(c, npops, dispText) { muutoksia <- 1 logml <- logml + totalMuutos if (logml > worstLogml) { - partitionSummary_added = addToSummary( + partitionSummary_added <- addToSummary( logml, partitionSummary, worstIndex ) partitionSummary <- partitionSummary_added$partitionSummary @@ -532,8 +532,8 @@ indMix <- function(c, npops, dispText) { } else if (vaihe == 3) { roundTypes <- c(5, 5, 7) } else if (vaihe == 4) { - roundTypes = c(4, 3, 1) - } else if (vaihe == 5) { + roundTypes <- c(4, 3, 1) + } else if (vaihe == 5) roundTypes <- c(6, 7, 2, 3, 4, 1) } } From 55cbadb471ff52238384982cffc7bd613fc09972 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 15 Feb 2021 10:15:25 +0100 Subject: [PATCH 13/29] Replaced rowSums with colSums to match MATLAB sum --- R/laskeMuutokset12345.R | 2 +- R/updateGlobalVariables.R | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/laskeMuutokset12345.R b/R/laskeMuutokset12345.R index ef790d7..e67ed2c 100644 --- a/R/laskeMuutokset12345.R +++ b/R/laskeMuutokset12345.R @@ -60,7 +60,7 @@ laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) { diffInCounts <- computeDiffInCounts( rows, size(COUNTS, 1), size(COUNTS, 2), data ) - diffInSumCounts <- rowSums(diffInCounts) + diffInSumCounts <- colSums(diffInCounts) COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts diff --git a/R/updateGlobalVariables.R b/R/updateGlobalVariables.R index e6d004d..94e5261 100644 --- a/R/updateGlobalVariables.R +++ b/R/updateGlobalVariables.R @@ -6,8 +6,8 @@ updateGlobalVariables <- function(ind, i2, diffInCounts, adjprior, priorTerm) { COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts COUNTS[, , i2] <- COUNTS[, , i2] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - rowSums(diffInCounts) - SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + rowSums(diffInCounts) + SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - colSums(diffInCounts) + SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + colSums(diffInCounts) POP_LOGML[c(i1, i2)] <- computePopulationLogml( c(i1, i2), adjprior, priorTerm @@ -27,8 +27,8 @@ updateGlobalVariables2 <- function(i1, i2, diffInCounts, adjprior, priorTerm) { COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts COUNTS[, , i2] <- COUNTS[, , i2] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - rowSums(diffInCounts) - SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + rowSums(diffInCounts) + SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - colSums(diffInCounts) + SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + colSums(diffInCounts) POP_LOGML[i1] <- 0 POP_LOGML[i2] <- computePopulationLogml(i2, adjprior, priorTerm) @@ -50,8 +50,8 @@ updateGlobalVariables3 <- function( COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts COUNTS[, , i2] <- COUNTS[, , i2] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - rowSums(diffInCounts) - SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + rowSums(diffInCounts) + SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - colSums(diffInCounts) + SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + colSums(diffInCounts) POP_LOGML[c(i1, i2)] <- computePopulationLogml( c(i1, i2), adjprior, priorTerm From f243ee046694561853ee41c594cef74e2ec8ac48 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 15 Feb 2021 10:16:33 +0100 Subject: [PATCH 14/29] Added missing { --- R/indMix.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/indMix.R b/R/indMix.R index c2a0cf2..4b39cd1 100644 --- a/R/indMix.R +++ b/R/indMix.R @@ -533,7 +533,7 @@ indMix <- function(c, npops, dispText) { roundTypes <- c(5, 5, 7) } else if (vaihe == 4) { roundTypes <- c(4, 3, 1) - } else if (vaihe == 5) + } else if (vaihe == 5) { roundTypes <- c(6, 7, 2, 3, 4, 1) } } From 4a7eef74bc33bdf596b17feb89102193fa1efb51 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Mon, 15 Feb 2021 11:31:04 +0100 Subject: [PATCH 15/29] Refactoring --- R/indMix.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/R/indMix.R b/R/indMix.R index 4b39cd1..017b124 100644 --- a/R/indMix.R +++ b/R/indMix.R @@ -28,11 +28,7 @@ indMix <- function(c, npops, dispText) { ready <- FALSE teksti <- 'Input upper bound to the number of populations (possibly multiple values)' # TODO: add "likely ncol(Z) values"? while (!ready) { - npopstextExtra <- inputdlg( - teksti, - 1, - '20' - ) + npopstextExtra <- inputdlg(teksti, 1, '20') if (isempty(npopstextExtra)) { # Painettu Cancel:ia return() } @@ -160,6 +156,7 @@ indMix <- function(c, npops, dispText) { } if (i1 != i2 & maxMuutos > 1e-5) { + # browser() # TEMP # Tapahtui muutos muutoksia <- 1 if (muutosNyt == 0) { @@ -513,7 +510,8 @@ indMix <- function(c, npops, dispText) { } } - + # FIXME: muutoksia is never 0, so vaihe never equals 5 and ready 1 + print(paste("i1 =", i1, "i2 =", i2, "maxMuutos =", maxMuutos))#TEMP if (muutoksia == 0) { if (vaihe <= 4) { vaihe <= vaihe + 1 From ae5837220512489107fa7316ae144307c4dbaec2 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Fri, 26 Feb 2021 10:01:01 +0100 Subject: [PATCH 16/29] Changed dataset used for testing greedyMix --- tests/testthat/test-greedyMix.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-greedyMix.R b/tests/testthat/test-greedyMix.R index 21a5d6d..ae80496 100644 --- a/tests/testthat/test-greedyMix.R +++ b/tests/testthat/test-greedyMix.R @@ -2,7 +2,7 @@ context("Opening files on greedyMix") # TODO: needs #12 to be fixed before this can be done without user intervention greedyMix( - tietue = "inst/ext/ExamplesDataFormatting/Example baseline data in GENEPOP format for Trained clustering.txt", + tietue = "inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt", format = "GenePop", savePreProcessed = FALSE ) # Upper bounds 100 100 From f70277cd6a3790e44ff572a87ac273f88f83f50a Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Mar 2021 08:22:24 +0200 Subject: [PATCH 17/29] Fixed delimiter for BAPS-formatted file --- R/greedyMix.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/greedyMix.R b/R/greedyMix.R index 058df21..ca38551 100644 --- a/R/greedyMix.R +++ b/R/greedyMix.R @@ -68,7 +68,7 @@ greedyMix <- function( # fprintf(1,'Data: %s\n',[pathname filename]); # end - data <- read.delim(pathname_filename) # TODO: discover delimiter + data <- read.delim(pathname_filename, header = FALSE, sep = " ") ninds <- testaaOnkoKunnollinenBapsData(data) # testing if (ninds == 0) stop('Incorrect Data-file') From 76861c9027300b3915a0fdaca27a43ecda5e1c15 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Mar 2021 08:23:07 +0200 Subject: [PATCH 18/29] Fixed BAPS format in test unit --- tests/testthat/test-greedyMix.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-greedyMix.R b/tests/testthat/test-greedyMix.R index ae80496..b833456 100644 --- a/tests/testthat/test-greedyMix.R +++ b/tests/testthat/test-greedyMix.R @@ -3,7 +3,7 @@ context("Opening files on greedyMix") # TODO: needs #12 to be fixed before this can be done without user intervention greedyMix( tietue = "inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt", - format = "GenePop", + format = "BAPS", savePreProcessed = FALSE ) # Upper bounds 100 100 From 231e0ff501dd195e3aae7ae829ca69ffe0894742 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Mar 2021 08:23:21 +0200 Subject: [PATCH 19/29] Fixed syntax --- R/testaaOnkoKunnollinenBapsData.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/testaaOnkoKunnollinenBapsData.R b/R/testaaOnkoKunnollinenBapsData.R index 8cdc5f3..0bf5c61 100644 --- a/R/testaaOnkoKunnollinenBapsData.R +++ b/R/testaaOnkoKunnollinenBapsData.R @@ -7,13 +7,13 @@ testaaOnkoKunnollinenBapsData <- function(data) { # Tarkastaa onko viimeisess?sarakkeessa kaikki # luvut 1,2,...,n johonkin n:��n asti. # Tarkastaa lis�ksi, ett?on v�hint��n 2 saraketta. - if (size[data, 1] < 2) { + if (size(data, 1) < 2) { ninds <- 0 return(ninds) } lastCol <- data[, ncol(data)] ninds <- max(lastCol) - if (t(1:ninds) != unique(lastCol)) { + if (any(1:ninds != unique(lastCol))) { ninds <- 0 return(ninds) } From c7720f33b4f18ad34483d46f24a9e1dda8bdad2e Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Mar 2021 08:23:37 +0200 Subject: [PATCH 20/29] Fixed output formatting --- R/greedyMix.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/greedyMix.R b/R/greedyMix.R index ca38551..ab2928e 100644 --- a/R/greedyMix.R +++ b/R/greedyMix.R @@ -75,12 +75,12 @@ greedyMix <- function( # ASK: remove? # h0 = findobj('Tag','filename1_text'); # set(h0,'String',filename); clear h0; - cat( + message( 'When using data which are in BAPS-format,', 'you can specify the sampling populations of the', 'individuals by giving two additional files:', 'one containing the names of the populations,', - 'the other containing the indices of the first', + 'the other containing the indices of the first ', 'individuals of the populations.' ) input_pops <- inputdlg( From ef540baf7e5767aa273e8dd602794a4caad85fe5 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Mar 2021 08:34:31 +0200 Subject: [PATCH 21/29] Reformatting BAPS input --- R/greedyMix.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/greedyMix.R b/R/greedyMix.R index ab2928e..e9dc2bb 100644 --- a/R/greedyMix.R +++ b/R/greedyMix.R @@ -69,6 +69,7 @@ greedyMix <- function( # end data <- read.delim(pathname_filename, header = FALSE, sep = " ") + data <- as.matrix(data) ninds <- testaaOnkoKunnollinenBapsData(data) # testing if (ninds == 0) stop('Incorrect Data-file') From d16de2ba7d5eb17fe4ac8fc3fc4b159d045646f0 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Tue, 30 Mar 2021 08:34:41 +0200 Subject: [PATCH 22/29] Uncommented translated functions --- R/greedyMix.R | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/R/greedyMix.R b/R/greedyMix.R index e9dc2bb..f10f3b8 100644 --- a/R/greedyMix.R +++ b/R/greedyMix.R @@ -105,8 +105,17 @@ greedyMix <- function( popnames <- "" } - # [data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data); # TODO: translate this function - # [Z,dist] = newGetDistances(data,rowsFromInd); # TODO: translate + temp_handleData <- handleData(data) + data <- temp_handleData$newData + rowsFromInd <- temp_handleData$rowsFromInd + alleleCodes <- temp_handleData$alleleCodes + noalle <- temp_handleData$noalle + adjprior <- temp_handleData$adjprior + priorTerm <- temp_handleData$priorTerm + Z_dist <- newGetDistances(data,rowsFromInd) + Z <- Z_dist$Z + dist <- Z_dist$dist + rm(temp_handleData, Z_dist) if (is.null(savePreProcessed)) { save_preproc <- questdlg( quest = 'Do you wish to save pre-processed data?', From e1642f24e553597eb1ea037e3c8879b754bcecc3 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Wed, 31 Mar 2021 10:26:56 +0200 Subject: [PATCH 23/29] 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 24/29] 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 25/29] 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 26/29] 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 From 39145ee865f75e6a6ef6953798867b885d8448dc Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Wed, 31 Mar 2021 10:39:15 +0200 Subject: [PATCH 27/29] Updated docs --- man/cell.Rd | 5 ++++- man/find.Rd | 4 +++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/man/cell.Rd b/man/cell.Rd index 1123477..4b1b3ac 100644 --- a/man/cell.Rd +++ b/man/cell.Rd @@ -4,13 +4,16 @@ \alias{cell} \title{Cell array} \usage{ -cell(n, sz = c(n, n), ...) +cell(n, sz = c(n, n), expandable = FALSE, ...) } \arguments{ \item{n}{a the first dimension (or both, if sz is not passed)} \item{sz}{the second dimension (or 1st and 2nd, if not passed)} +\item{expandable}{if TRUE, output is a list (so it can take different +lengths)} + \item{...}{Other dimensions} } \value{ diff --git a/man/find.Rd b/man/find.Rd index f7f4929..e429d07 100644 --- a/man/find.Rd +++ b/man/find.Rd @@ -4,10 +4,12 @@ \alias{find} \title{Find indices and values of nonzero elements} \usage{ -find(x) +find(x, sort = TRUE) } \arguments{ \item{x}{object or logic operation on an object} + +\item{sort}{sort output?} } \description{ Emulates behavior of `find` From 6fb06da8668d2606cd3845bdc8ce94241bd957d1 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Wed, 31 Mar 2021 10:39:42 +0200 Subject: [PATCH 28/29] Commented out non-interactive test code --- tests/testthat/test-greedyMix.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-greedyMix.R b/tests/testthat/test-greedyMix.R index 96b7d1d..a17236f 100644 --- a/tests/testthat/test-greedyMix.R +++ b/tests/testthat/test-greedyMix.R @@ -32,11 +32,11 @@ test_that("handleData works as expected", { context("Opening files on greedyMix") # TODO: needs #12 to be fixed before this can be done without user intervention -greedyMix( - tietue = "inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt", - format = "BAPS", - savePreProcessed = FALSE -) # Upper bounds 100 100 +# greedyMix( +# tietue = "inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt", +# format = "BAPS", +# savePreProcessed = FALSE +# ) # Upper bounds 100 100 context("Linkage") From b35053fd3ae5c49660b4021f104c81fe9245d58f Mon Sep 17 00:00:00 2001 From: Waldir Leoncio Date: Wed, 31 Mar 2021 10:40:15 +0200 Subject: [PATCH 29/29] Increment version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index aa9e85a..39d4f81 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rBAPS Title: Bayesian Analysis of Population Structure -Version: 0.0.0.9001 +Version: 0.0.0.9002 Date: 2020-11-09 Authors@R: c(