diff --git a/R/greedyPopMix.R b/R/greedyPopMix.R new file mode 100644 index 0000000..cb8c660 --- /dev/null +++ b/R/greedyPopMix.R @@ -0,0 +1,88 @@ +#' @title Clustering of pop individuals +#' @param data data file +#' @param format Data format. Format supported: "FASTA", "VCF" ,"BAM", "GenePop" +#' @param verbose if \code{TRUE}, prints extra output information +#' @param partitionCompare a properly-named list. Proper names include +#' "partitions" +#' @importFrom utils read.delim +#' @importFrom vcfR read.vcfR +#' @importFrom Rsamtools scanBam +#' @importFrom adegenet read.genepop .readExt +#' @references Samtools: a suite of programs for interacting +#' with high-throughput sequencing data. +#' @export +greedyPopMix <- function(data, format, partitionCompare = NULL, verbose = TRUE) { + # Replacing original file reading code with greedyMix() + greedyMix(data, format, verbose) + # TODO: find out where the elements above come from. Maybe greedyMix should create them? + c <- list() + c$data <- data + c$rows <- rows + c$alleleCodes <- alleleCodes + c$noalle <- noalle + c$adjprior <- adjprior + c$priorTerm <- priorTerm + c$dist <- dist + c$Z <- Z + c$rowsFromInd <- rowsFromInd + # partition compare + if (!is.null(partitionCompare)) { + nsamplingunits <- size(rows, 1) + partitions <- partitionCompare$partitions + npartitions <- size(partitions, 2) + partitionLogml <- zeros(1, npartitions) + for (i in 1:npartitions) { + # number of unique partition lables + npops <- length(unique(partitions[, i])) + partitionInd <- zeros(rows(end), 1) + partitionSample <- partitions[, i] + for (j in 1:nsamplingunits) { + partitionInd[c$rows[j, 1]:c.rows[j, 2]] <- partitionSample[j] + } + partitionLogml[i] <- initialCounts( + partitionInd, data[, 1:(ncol(data) - 1)], npops, c$rows, noalle, + adjprior + ) + } + # return the logml result + partitionCompare$logmls <- partitionLogml + } + data = data(:,1:end-1); + data <- data[, 1:(ncol(data) - 1)] + changesInLogml <- writeMixtureInfoPop( + logml, rows, data, adjprior, priorTerm, + outp, inp, partitionSummary, popnames, fixedK + ) + talle <- questdlg( + 'Do you want to save the mixture populations so that you can use them later in admixture analysis?', + 'Save results?', c('Yes', 'No'), 'Yes' + ) + if (isequal(talle, 'Yes')) { + waitALittle() + filename_pathname <- uiputfile() + if (rowsFromInd == 0) { + # BAPS format was used, rowsFromInd is not known. + popnames_rowsFromInd <- findOutRowsFromInd(popnames, rows) + popnames_rowsFromInd$popnames -> popnames + popnames_rowsFromInd$rows -> rows + rm(popnames_rowsFromInd) + } + groupPartition <- PARTITION + fiksaaPartitioYksiloTasolle(rows, rowsFromInd) + c$PARTITION <- PARTITION + c$COUNTS <- COUNTS + c$SUMCOUNTS <- SUMCOUNTS + c$alleleCodes <- alleleCodes + c$adjprior <- adjprior + c$rowsFromInd <- rowsFromInd + c$popnames <- popnames + c$data <- data + c$npops <- npops + c$noalle <- noalle + c$mixtureType = 'popMix' + c$groupPartition <- groupPartition + c$rows <- rows + c$logml <- logml + c$changesInLogml <- changesInLogml + } +} diff --git a/R/waitALittle.R b/R/waitALittle.R new file mode 100644 index 0000000..f448afc --- /dev/null +++ b/R/waitALittle.R @@ -0,0 +1,4 @@ +waitALittle <- function() { + A <- rand(500) + invisible(gammaln(A)) +}