diff --git a/R/admixture_initialization.R b/R/admixture_initialization.R new file mode 100644 index 0000000..bc8166c --- /dev/null +++ b/R/admixture_initialization.R @@ -0,0 +1,17 @@ +#'@title Seuraavat kolme funktiota liittyvat alkupartition muodostamiseen. + +admixture_initialization <- function (data_matrix, nclusters, Z) { + size_data <- size(data_matrix) + nloci <- size_data[2] - 1 + n <- max(data_matrix[, end]) + T <- cluster_own(Z, nclusters) + initial_partition <- zeros(size_data[1], 1) + for (i in 1:n) { + kori <- T[i] + here <- find(data_matrix[,end] == i) + for (j in 1:length(here)) { + initial_partition[here[j], 1] <- kori + } + } + return(initial_partition) +} \ No newline at end of file diff --git a/R/clearGlobalVars.R b/R/clearGlobalVars.R index 1d77d9c..6cddf96 100644 --- a/R/clearGlobalVars.R +++ b/R/clearGlobalVars.R @@ -1,5 +1,5 @@ clearGlobalVars <- function() { - COUNTS <- SUMCOUNTS <- PARTITION <- POP_LOGML <- vector() # placeholders + # COUNTS <- SUMCOUNTS <- PARTITION <- POP_LOGML <- vector() # placeholders COUNTS <<- vector() SUMCOUNTS <<- vector() PARTITION <<- vector() diff --git a/R/greedyMix.R b/R/greedyMix.R index ef91b17..7b0004e 100644 --- a/R/greedyMix.R +++ b/R/greedyMix.R @@ -11,10 +11,11 @@ greedyMix <- function( savePreProcessed = NULL, filePreProcessed = NULL ) { - # ASK: graphical components. Remove? + # ASK: Unclear when fixedk == TRUE. Remove? # check whether fixed k mode is selected # h0 <- findobj('Tag','fixk_menu') # fixedK = get(h0, 'userdata'); + fixedK <- FALSE # if fixedK # if ~(fixKWarning == 1) % call function fixKWarning @@ -22,9 +23,11 @@ greedyMix <- function( # end # end + # ASK: ditto # % check whether partition compare mode is selected # h1 = findobj('Tag','partitioncompare_menu'); # partitionCompare = get(h1, 'userdata'); + partitionCompare <- FALSE if (is(tietue, "list") | is(tietue, "character")) { # ---------------------------------------------------------------------- @@ -244,13 +247,15 @@ greedyMix <- function( } # ========================================================================== - # Declaring global variables + # Declaring global variables and changing environment of children functions # ========================================================================== PARTITION <- vector() COUNTS <- vector() SUMCOUNTS <- vector() POP_LOGML <- vector() - clearGlobalVars <- vector() + clearGlobalVars() + + environment(writeMixtureInfo) <- environment() # ========================================================================== c <- list() c$data <- data @@ -265,6 +270,7 @@ greedyMix <- function( ekat <- t(seq(1, ninds, rowsFromInd) * rowsFromInd) c$rows <- c(ekat, ekat + rowsFromInd - 1) + # ASK remove? # partition compare # if (!is.null(partitionCompare)) { # nsamplingunits <- size(c$rows, 1) @@ -291,17 +297,22 @@ greedyMix <- function( # } # # return the logml result # partitionCompare$logmls <- partitionLogml - # # set(h1, 'userdata', partitionCompare) # ASK remove? + # # set(h1, 'userdata', partitionCompare) # return() # } - # ASK remove (graphical part)? - # if (fixedK) { - # #logml_npops_partitionSummary <- indMix_fixK(c) # ASK translate? - # } else { - # #logml_npops_partitionSummary <- indMix(c) # ASK translate? - # } - # if (logml_npops_partitionSummary$logml == 1) return() + if (fixedK) { + # logml_npops_partitionSummary <- indMix_fixK(c) # TODO: translate + # logml <- logml_npops_partitionSummary$logml + # npops <- logml_npops_partitionSummary$npops + # partitionSummary <- logml_npops_partitionSummary$partitionSummary + } else { + logml_npops_partitionSummary <- indMix(c) # TODO: translate + logml <- logml_npops_partitionSummary$logml + npops <- logml_npops_partitionSummary$npops + partitionSummary <- logml_npops_partitionSummary$partitionSummary + } + if (logml_npops_partitionSummary$logml == 1) return() data <- data[, seq_len(ncol(data) - 1)] @@ -310,8 +321,9 @@ greedyMix <- function( # inp = get(h0,'String'); # h0 = findobj('Tag','filename2_text') # outp = get(h0,'String'); + inp <- vector() + outp <- vector() - browser() # TEMP changesInLogml <- writeMixtureInfo( logml, rowsFromInd, data, adjprior, priorTerm, outp, inp, popnames, fixedK diff --git a/R/indMix.R b/R/indMix.R index 1d62ac9..1265423 100644 --- a/R/indMix.R +++ b/R/indMix.R @@ -1157,22 +1157,6 @@ indMix <- function(c, npops, dispText) { # %-------------------------------------------------------------------------- -# %Seuraavat kolme funktiota liittyvat alkupartition muodostamiseen. - -# function initial_partition=admixture_initialization(data_matrix,nclusters, Z) - -# size_data=size(data_matrix); -# nloci=size_data(2)-1; -# n=max(data_matrix(:,end)); -# T=cluster_own(Z,nclusters); -# initial_partition=zeros(size_data(1),1); -# for i=1:n -# kori=T(i); -# here=find(data_matrix(:,end)==i); -# for j=1:length(here) -# initial_partition(here(j),1)=kori; -# end -# end # function T = cluster_own(Z,nclust) # true=logical(1); diff --git a/R/min_MATLAB.R b/R/min_MATLAB.R index af91efd..2c749c6 100644 --- a/R/min_MATLAB.R +++ b/R/min_MATLAB.R @@ -30,4 +30,6 @@ min_MATLAB <- function(X, indices = TRUE) { } else { return(mins) } -} \ No newline at end of file +} + +# TODO: consider using methods instead (maybe for the package) \ No newline at end of file diff --git a/R/writeMixtureInfo.R b/R/writeMixtureInfo.R index ca8efea..ec5120b 100644 --- a/R/writeMixtureInfo.R +++ b/R/writeMixtureInfo.R @@ -10,16 +10,10 @@ #' @param partitionSummary partitionSummary #' @param popnames popnames #' @param fixedK fixedK -#' @param PARTITION PARTITION -#' @param COUNTS COUNTS -#' @param SUMCOUNTS SUMCOUNTS -#' @param LOGDIFF LOGDIFF #' @export writeMixtureInfo <- function( - logml, rowsFromInd, data, adjprior, priorTerm, outPutFile, inputFile, partitionSummary, popnames, fixedK, PARTITION, COUNTS, SUMCOUNTS, - LOGDIFF + logml, rowsFromInd, data, adjprior, priorTerm, outPutFile, inputFile, partitionSummary, popnames, fixedK ) { - changesInLogml <- list() ninds <- size(data, 1) / rowsFromInd npops <- size(COUNTS, 3) @@ -30,7 +24,6 @@ writeMixtureInfo <- function( fid <- load(outPutFile) } else { fid <- -1 - message('Diverting output to baps4_output.baps') # TODO: replace sink with option that will record input and output sink('baps4_output.baps', split=TRUE) # save in text anyway. } diff --git a/man/min_MATLAB.Rd b/man/min_MATLAB.Rd index 9376fed..bd1113e 100644 --- a/man/min_MATLAB.Rd +++ b/man/min_MATLAB.Rd @@ -1,9 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/min.R +% Please edit documentation in R/min.R, R/min_MATLAB.R \name{min_MATLAB} \alias{min_MATLAB} \title{Minimum (MATLAB version)} \usage{ +min_MATLAB(X, indices = TRUE) + min_MATLAB(X, indices = TRUE) } \arguments{ @@ -12,11 +14,17 @@ min_MATLAB(X, indices = TRUE) \item{indices}{return indices?} } \value{ +Either a list or a vector + Either a list or a vector } \description{ +Finds the minimum value for each column of a matrix, potentially returning the indices instead + Finds the minimum value for each column of a matrix, potentially returning the indices instead } \author{ +Waldir Leoncio + Waldir Leoncio } diff --git a/man/writeMixtureInfo.Rd b/man/writeMixtureInfo.Rd index e973db9..f30bde0 100644 --- a/man/writeMixtureInfo.Rd +++ b/man/writeMixtureInfo.Rd @@ -14,11 +14,7 @@ writeMixtureInfo( inputFile, partitionSummary, popnames, - fixedK, - PARTITION, - COUNTS, - SUMCOUNTS, - LOGDIFF + fixedK ) } \arguments{ @@ -41,14 +37,6 @@ writeMixtureInfo( \item{popnames}{popnames} \item{fixedK}{fixedK} - -\item{PARTITION}{PARTITION} - -\item{COUNTS}{COUNTS} - -\item{SUMCOUNTS}{SUMCOUNTS} - -\item{LOGDIFF}{LOGDIFF} } \description{ Writes information about the mixture diff --git a/tests/testthat/test-greedyMix.R b/tests/testthat/test-greedyMix.R index 9a1c05a..51cdf8b 100644 --- a/tests/testthat/test-greedyMix.R +++ b/tests/testthat/test-greedyMix.R @@ -1,11 +1,7 @@ -# library(devtools)#TEMP -library(testthat)#TEMP -# library(rBAPS)#TEMP - context("Opening files on greedyMix") greedyMix( - tietue = "data/ExamplesDataFormatting/Example baseline data in GENEPOP format for Trained clustering.txt", + tietue = "inst/ext/ExamplesDataFormatting/Example baseline data in GENEPOP format for Trained clustering.txt", format = "GenePop", savePreProcessed = FALSE )