Refactoring and syntax fixes

This commit is contained in:
Waldir Leoncio 2021-06-29 10:41:23 +02:00
parent 829bcc447e
commit 8956949bff
4 changed files with 26 additions and 21 deletions

View file

@ -1,7 +1,7 @@
COUNTS <- array(0, dim=c(100, 100, 100)) COUNTS <- array(0, dim=c(100, 100, 100))
SUMCOUNTS <- array(0, dim=c(100, 100)) SUMCOUNTS <- array(0, dim=c(100, 100))
PARTITION <- array(1, dim=c(100)) PARTITION <- array(1, dim=c(100))
POP_LOGML <- array(1, dim=c(100)) POP_LOGML <- array(1, dim=c(100))
LOGDIFF <- array(1, dim=c(100, 100)) LOGDIFF <- array(1, dim=c(100, 100))
# If handling globas break, try other ideas from https://stackoverflow.com/a/65252740/1169233 # If handling globas break, try other ideas from https://stackoverflow.com/a/65252740/1169233
@ -9,4 +9,4 @@ LOGDIFF <- array(1, dim=c(100, 100))
#' @import utils #' @import utils
utils::globalVariables( utils::globalVariables(
c("PARTITION", "COUNTS", "SUMCOUNTS", "LOGDIFF", "POP_LOGML", "GAMMA_LN") c("PARTITION", "COUNTS", "SUMCOUNTS", "LOGDIFF", "POP_LOGML", "GAMMA_LN")
) )

View file

@ -322,7 +322,10 @@ greedyMix <- function(
npops <- logml_npops_partitionSummary$npops npops <- logml_npops_partitionSummary$npops
partitionSummary <- logml_npops_partitionSummary$partitionSummary partitionSummary <- logml_npops_partitionSummary$partitionSummary
} }
if (logml_npops_partitionSummary$logml == 1) return() if (logml == 1) {
warning("logml == 1")
return()
}
data <- data[, seq_len(ncol(data) - 1)] data <- data[, seq_len(ncol(data) - 1)]

View file

@ -1,4 +1,4 @@
indMix <- function(c, npops, dispText) { indMix <- function(c, npops, dispText=TRUE) {
# Greedy search algorithm with unknown number of classes for regular # Greedy search algorithm with unknown number of classes for regular
# clustering. # clustering.
# Input npops is not used if called by greedyMix or greedyPopMix. # Input npops is not used if called by greedyMix or greedyPopMix.
@ -25,24 +25,26 @@ indMix <- function(c, npops, dispText) {
dispText <- 1 dispText <- 1
npopstext <- matrix() npopstext <- matrix()
ready <- FALSE ready <- FALSE
teksti <- 'Input upper bound to the number of populations (possibly multiple values)' # TODO: add "likely ncol(Z) values"? teksti <- 'Input upper bound to the number of populations (possibly multiple values)'
while (!ready) { while (!ready) {
npopstextExtra <- inputdlg(teksti, 1, '20') npopstextExtra <- inputdlg(teksti, 1, '20')
if (isempty(npopstextExtra)) { # Painettu Cancel:ia if (isempty(npopstextExtra)) { # Painettu Cancel:ia
warnings("Empty value provided")
return() return()
} }
npopstextExtra <- npopstextExtra[1] npopstextExtra <- npopstextExtra[[1]]
if (length(npopstextExtra)>=255) { if (length(npopstextExtra)>=255) {
npopstextExtra <- npopstextExtra[1:255] npopstextExtra <- npopstextExtra[1:255]
npopstext <- c(npopstext, ' ', npopstextExtra) npopstext <- c(npopstext, ' ', npopstextExtra)
teksti <- 'The input field length limit (255 characters) was reached. Input more values: ' teksti <- 'The input field length limit (255 characters) was reached. Input more values: '
} else { } else {
npopstext <- strsplit(npopstextExtra, " ")[[1]] npopstext <- as.numeric(strsplit(as.character(npopstextExtra), " ")[[1]])
ready <- TRUE ready <- TRUE
} }
} }
rm(ready, teksti) rm(ready, teksti)
if (isempty(npopstext) | length(npopstext) == 1) { if (isempty(npopstext) | length(npopstext) == 1) {
warning("Empty or 1-length vector provided")
return() return()
} else { } else {
npopsTaulu <- as.numeric(npopstext) npopsTaulu <- as.numeric(npopstext)
@ -75,11 +77,10 @@ indMix <- function(c, npops, dispText) {
if (dispText) { if (dispText) {
dispLine() dispLine()
cat( cat(
paste0( 'Run ', as.character(run), '/', as.character(nruns),
'Run ', as.character(run), '/', as.character(nruns), ', maximum number of populations ', as.character(npops),
', maximum number of populations ', as.character(npops), '.\n',
'.\n' sep = ""
)
) )
} }
ninds <- size(rows, 1) ninds <- size(rows, 1)
@ -114,13 +115,13 @@ indMix <- function(c, npops, dispText) {
message( message(
paste0( paste0(
'\nMixture analysis started with initial ', '\nMixture analysis started with initial ',
as.character(npops), as.character(npops), ' populations.'
' populations.'
) )
) )
} }
while (ready != 1) { while (ready != 1) {
# FIXME: loop caught in here
muutoksia <- 0 muutoksia <- 0
if (dispText) { if (dispText) {
@ -144,6 +145,7 @@ indMix <- function(c, npops, dispText) {
for (ind in inds) { for (ind in inds) {
i1 <- PARTITION[ind] i1 <- PARTITION[ind]
muutokset_diffInCounts <- laskeMuutokset( muutokset_diffInCounts <- laskeMuutokset(
#FIXME: using 100-length global variables instead of the ones in this function
ind, rows, data, adjprior, priorTerm ind, rows, data, adjprior, priorTerm
) )
muutokset <- muutokset_diffInCounts$muutokset muutokset <- muutokset_diffInCounts$muutokset
@ -177,8 +179,8 @@ indMix <- function(c, npops, dispText) {
temp_minMATLAB <- min_MATLAB( temp_minMATLAB <- min_MATLAB(
partitionSummary[, 2] partitionSummary[, 2]
) )
worstLogml <- temp_minMATLAB[[1]] worstLogml <- temp_minMATLAB$mins
worstIndex <- temp_minMATLAB[[2]] worstIndex <- temp_minMATLAB$idx
} }
} }
} }

View file

@ -32,11 +32,11 @@ test_that("handleData works as expected", {
context("Opening files on greedyMix") context("Opening files on greedyMix")
# TODO: needs #12 to be fixed before this can be done without user intervention # TODO: needs #12 to be fixed before this can be done without user intervention
# greedyMix( greedyMix(
# tietue = "inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt", tietue = "inst/ext/ExamplesDataFormatting/Example data in BAPS format for clustering of diploid individuals.txt",
# format = "BAPS", format = "BAPS",
# savePreProcessed = FALSE savePreProcessed = FALSE
# ) # Upper bounds 100 100 ) # Upper bounds 100 100
context("Linkage") context("Linkage")