Refactoring and syntax fixes
This commit is contained in:
parent
829bcc447e
commit
8956949bff
4 changed files with 26 additions and 21 deletions
|
|
@ -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")
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -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)]
|
||||||
|
|
||||||
|
|
|
||||||
28
R/indMix.R
28
R/indMix.R
|
|
@ -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
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -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")
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue