max/ourMELONS
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Incorporating subfunctions of greedyMix() (#25)

Browse source
This commit is contained in:
Waldir Leoncio 2023-08-09 12:06:09 +02:00
parent 103dc6acd6
commit cae1fe4c1e
4 changed files with 78 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
R/comparePartitions.R Normal file
View file

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

104
R/greedyMix.R
View file

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

7
R/indMixWrapper.R Normal file
View file

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

13
man/greedyMix.Rd
View file

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