diff --git a/R/comparePartitions.R b/R/comparePartitions.R new file mode 100644 index 0000000..82b325c --- /dev/null +++ b/R/comparePartitions.R @@ -0,0 +1,23 @@ +comparePartitions <- function(data, c.rows, partitionCompare.partitions, ninds, rowsFromInd, noalle, adjprior) { + stop("Comparing partitions not yet implemented") # TODO: implement + # nsamplingunits = size(c.rows,1); + # partitions = partitionCompare.partitions; + # npartitions = size(partitions,2); + # partitionLogml = zeros(1,npartitions); + # for i = 1:npartitions + # % number of unique partition lables + # npops = length(unique(partitions(:,i))); + + # partitionInd = zeros(ninds*rowsFromInd,1); + # partitionSample = partitions(:,i); + # for j = 1:nsamplingunits + # partitionInd([c.rows(j,1):c.rows(j,2)]) = partitionSample(j); + # end + # partitionLogml(i) = initialCounts(partitionInd, data(:,1:end-1), npops, c.rows, noalle, adjprior); + + # end + # % return the logml result + # partitionCompare.logmls = partitionLogml; + # set(h1, 'userdata', partitionCompare); + # return +} diff --git a/R/greedyMix.R b/R/greedyMix.R index 412f720..0c06935 100644 --- a/R/greedyMix.R +++ b/R/greedyMix.R @@ -12,78 +12,46 @@ #' @examples #' data <- system.file("extdata", "FASTA_clustering_haploid.fasta", package = "rBAPS") #' greedyMix(data) -greedyMix <- function(data, format, fixedK = FALSE, partition_compare = FALSE, verbose = TRUE) { - data <- importFile(data, format, verbose) +greedyMix <- function( + data, format, c.rows, partitionCompare.partitions, ninds, inp, popnames, + fixedK = FALSE, partition_compare = FALSE, verbose = TRUE +) { + # Importing and handling data ================================================ + raw_data <- importFile(data, format, verbose) + data <- handleData(raw_data) + alleleCodes <- data[["alleleCodes"]] + noalle <- data[["noalle"]] + rowsFromInd <- data[["rowsFromInd"]] + adjprior <- data[["adjprior"]] + priorTerm <- data[["priorTerm"]] + if (partition_compare) { - # nsamplingunits = size(c.rows,1); - # partitions = partitionCompare.partitions; - # npartitions = size(partitions,2); - # partitionLogml = zeros(1,npartitions); - # for i = 1:npartitions - # % number of unique partition lables - # npops = length(unique(partitions(:,i))); - - # partitionInd = zeros(ninds*rowsFromInd,1); - # partitionSample = partitions(:,i); - # for j = 1:nsamplingunits - # partitionInd([c.rows(j,1):c.rows(j,2)]) = partitionSample(j); - # end - # partitionLogml(i) = ... - # initialCounts(partitionInd, data(:,1:end-1), npops, c.rows, noalle, adjprior); - - # end - # % return the logml result - # partitionCompare.logmls = partitionLogml; - # set(h1, 'userdata', partitionCompare); - # return - } - - if (fixedK) { - # [logml, npops, partitionSummary]=indMix_fixK(c); - } else { - # [logml, npops, partitionSummary]=indMix(c); + logmls <- comparePartitions( + data, c.rows, partitionCompare.partitions, ninds, rowsFromInd, noalle, + adjprior + ) } + # Generating partition summary =============================================== + logml_npops_partitionSummary <- indMixWrapper(c); + logml <- logml_npops_partitionSummary[["logml"]] + npops <- logml_npops_partitionSummary[["npops"]] + partitionSummary <- logml_npops_partitionSummary[["partitionSummary"]] stopifnot(logml != 1) - # data = data(:,1:end-1); + # Writing mixture info ======================================================= + changesInLogml <- writeMixtureInfo( + logml, rowsFromInd, data, adjprior, priorTerm, NULL, inp, partitionSummary, + popnames, fixedK + ) - # h0 = findobj('Tag','filename1_text'); inp = get(h0,'String'); - # h0 = findobj('Tag','filename2_text'); - # outp = get(h0,'String'); - # changesInLogml = writeMixtureInfo(logml, rowsFromInd, data, adjprior, priorTerm, ... - # outp,inp,partitionSummary, popnames, fixedK); + # Returning results ========================================================== + return( + list( + "alleleCodes" = alleleCodes, "adjprior" = adjprior, "popnames" = popnames, + "rowsFromInd" = rowsFromInd, "data" = data, "npops" = npops, + "noalle" = noalle, "mixtureType" = "mix", "logml" = logml, + "changesInLogml" = changesInLogml + ) + ) - # viewMixPartition(PARTITION, popnames); - - talle <- questdlg( - c( - 'Do you want to save the mixture populations ', - 'so that you can use them later in admixture analysis?' - ), - 'Save results?', - defbtn = 'n' - ); - if (talle == "y") { - # [filename, pathname] = uiputfile('*.mat','Save results as'); - # if (sum(filename)==0) || (sum(pathname)==0) - # % Cancel was pressed - # return; - # else - # % copy 'baps4_output.baps' into the text file with the same name. - # if exist('baps4_output.baps','file') - # copyfile('baps4_output.baps',[pathname filename '.txt']) - # delete('baps4_output.baps') - # end - # end; - # c.PARTITION = PARTITION; c.COUNTS = COUNTS; c.SUMCOUNTS = SUMCOUNTS; - # c.alleleCodes = alleleCodes; c.adjprior = adjprior; c.popnames = popnames; - # c.rowsFromInd = rowsFromInd; c.data = data; c.npops = npops; - # c.noalle = noalle; c.mixtureType = 'mix'; - # c.logml = logml; c.changesInLogml = changesInLogml; - # save([pathname filename], 'c', '-v7.3'); % added by Lu Cheng, 08.06.2012 - } else { - # if exist('baps4_output.baps','file') - # delete('baps4_output.baps') - # end - } } diff --git a/R/indMixWrapper.R b/R/indMixWrapper.R new file mode 100644 index 0000000..c4fe8ba --- /dev/null +++ b/R/indMixWrapper.R @@ -0,0 +1,7 @@ +indMixWrapper <- function(fixedK = FALSE) { + if (fixedK) { + indMix(c, npops, TRUE) + } else { + stop("indMix_fixK() not yet implemented.") # TODO: translate indMix_fixK.m + } +} diff --git a/man/greedyMix.Rd b/man/greedyMix.Rd index 8403005..8c78333 100644 --- a/man/greedyMix.Rd +++ b/man/greedyMix.Rd @@ -4,7 +4,18 @@ \alias{greedyMix} \title{Clustering of individuals} \usage{ -greedyMix(data, format, verbose = TRUE) +greedyMix( + data, + format, + c.rows, + partitionCompare.partitions, + ninds, + inp, + popnames, + fixedK = FALSE, + partition_compare = FALSE, + verbose = TRUE +) } \arguments{ \item{data}{data file}