Incorporating subfunctions of greedyMix() (#25)

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

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) {
+greedyMix <- function(
-  data <- importFile(data, format, verbose)
+  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);
+    logmls <- comparePartitions(
-    # partitions = partitionCompare.partitions;
+      data, c.rows, partitionCompare.partitions, ninds, rowsFromInd, noalle,
-    # npartitions = size(partitions,2);
+      adjprior
-    # 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);
   }
+  # 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');
+  # Returning results ==========================================================
-  # h0 = findobj('Tag','filename2_text');
+  return(
-  # outp = get(h0,'String');
+    list(
-  # changesInLogml = writeMixtureInfo(logml, rowsFromInd, data, adjprior, priorTerm, ...
+      "alleleCodes" = alleleCodes, "adjprior" = adjprior, "popnames" = popnames,
-  #     outp,inp,partitionSummary, popnames, fixedK);
+      "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
-  }
 }

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

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}