Merge branch 'fix-handleData' into issue-2-greedy-test

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) {

R/computeDiffInCounts.R

@@ -4,7 +4,7 @@ computeDiffInCounts <- function(rows, max_noalle, nloci, data) {
 	# % riveill<6C> rows. rows pit<69><74> 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))
 

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)
 }

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

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)

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<69>li ykk<6B>si<73> annettu yl<79>rajaksi, ne poistetaan.
+			npopsTaulu[ykkoset] <- NA # Mik<69>li ykk<6B>si<73> annettu yl<79>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<73>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]]

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