Internalized all functions except greedyMix() and load_fasta() (#25)

This commit is contained in:
Waldir Leoncio 2023-08-09 09:36:15 +02:00
parent 449982a083
commit 7aff7bbb82
39 changed files with 2 additions and 82 deletions

View file

@ -1,45 +1,7 @@
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export(addAlleles)
export(admix1)
export(calculatePopLogml)
export(computeAllFreqs2)
export(computeIndLogml)
export(computePersonalAllFreqs)
export(computeRows)
export(etsiParas)
export(fgetl)
export(fopen)
export(greedyMix) export(greedyMix)
export(greedyPopMix)
export(handleData)
export(handlePopData)
export(initPopNames)
export(learn_partition_modified)
export(learn_simple_partition)
export(linkage)
export(load_fasta) export(load_fasta)
export(logml2String)
export(lueGenePopData)
export(lueGenePopDataPop)
export(lueNimi)
export(noIndex)
export(ownNum2Str)
export(poistaLiianPienet)
export(proportion2str)
export(randdir)
export(rivinSisaltamienMjonojenLkm)
export(selvitaDigitFormat)
export(simulateAllFreqs)
export(simulateIndividuals)
export(simuloiAlleeli)
export(suoritaMuutos)
export(takeLine)
export(testaaKoordinaatit)
export(testaaOnkoKunnollinenBapsData)
export(testaaPop)
export(writeMixtureInfo)
export(writeMixtureInfoPop)
importFrom(R6,R6Class) importFrom(R6,R6Class)
importFrom(Rsamtools,scanBam) importFrom(Rsamtools,scanBam)
importFrom(adegenet,.readExt) importFrom(adegenet,.readExt)

View file

@ -4,7 +4,6 @@
#' @param line line #' @param line line
#' @param divider divider #' @param divider divider
#' @return data (after alleles were added) #' @return data (after alleles were added)
#' @export
addAlleles <- function(data, ind, line, divider) { addAlleles <- function(data, ind, line, divider) {
# Lisaa BAPS-formaatissa olevaan datataulukkoon # Lisaa BAPS-formaatissa olevaan datataulukkoon
# yksil<69><6C> ind vastaavat rivit. Yksil<69>n alleelit # yksil<69><6C> ind vastaavat rivit. Yksil<69>n alleelit

View file

@ -6,7 +6,6 @@
#' alleleCodes, adjprior, popnames, rowsFromInd, data, npops, noalle #' alleleCodes, adjprior, popnames, rowsFromInd, data, npops, noalle
#' @param tietue tietue #' @param tietue tietue
#' @importFrom methods is #' @importFrom methods is
#' @export
admix1 <- function(tietue) { admix1 <- function(tietue) {
if (!is.list(tietue)) { if (!is.list(tietue)) {
message("Load mixture result file. These are the files in this directory:") message("Load mixture result file. These are the files in this directory:")

View file

@ -4,7 +4,6 @@
#' for the mean parameter. #' for the mean parameter.
#' @param points points #' @param points points
#' @param fii fii #' @param fii fii
#' @export
calculatePopLogml <- function(points, fii) { calculatePopLogml <- function(points, fii) {
n <- length(points) n <- length(points)
fuzzy_ones <- sum(points) fuzzy_ones <- sum(points)

View file

@ -2,7 +2,6 @@
#' @description Lisää a priori jokaista alleelia joka populaation joka lokukseen #' @description Lisää a priori jokaista alleelia joka populaation joka lokukseen
#' j 1/noalle(j) verran. #' j 1/noalle(j) verran.
#' @param noalle noalle #' @param noalle noalle
#' @export
computeAllFreqs2 <- function(noalle) { computeAllFreqs2 <- function(noalle) {
COUNTS <- ifelse(isGlobalEmpty(COUNTS), vector(), COUNTS) COUNTS <- ifelse(isGlobalEmpty(COUNTS), vector(), COUNTS)
SUMCOUNTS <- ifelse(isGlobalEmpty(SUMCOUNTS), vector(), COUNTS) SUMCOUNTS <- ifelse(isGlobalEmpty(SUMCOUNTS), vector(), COUNTS)

View file

@ -3,7 +3,6 @@
#' määritellyiksi kuten osuusTaulu:ssa. #' määritellyiksi kuten osuusTaulu:ssa.
#' @param omaFreqs own Freqs? #' @param omaFreqs own Freqs?
#' @param osuusTaulu Percentage table? #' @param osuusTaulu Percentage table?
#' @export
computeIndLogml <- function(omaFreqs, osuusTaulu) { computeIndLogml <- function(omaFreqs, osuusTaulu) {
omaFreqs <- as.matrix(omaFreqs) omaFreqs <- as.matrix(omaFreqs)
osuusTaulu <- as.matrix(osuusTaulu) osuusTaulu <- as.matrix(osuusTaulu)

View file

@ -7,8 +7,6 @@
#' @param data data #' @param data data
#' @param allFreqs allFreqs #' @param allFreqs allFreqs
#' @param rowsFromInd rowsFromInd #' @param rowsFromInd rowsFromInd
#' @export
computePersonalAllFreqs <- function(ind, data, allFreqs, rowsFromInd) { computePersonalAllFreqs <- function(ind, data, allFreqs, rowsFromInd) {
if (isGlobalEmpty(COUNTS)) { if (isGlobalEmpty(COUNTS)) {
nloci <- npops <- 1 nloci <- npops <- 1

View file

@ -4,7 +4,6 @@
#' @param rowsFromInd rowsFromInd #' @param rowsFromInd rowsFromInd
#' @param inds matrix #' @param inds matrix
#' @param ninds ninds #' @param ninds ninds
#' @export
computeRows <- function(rowsFromInd, inds, ninds) { computeRows <- function(rowsFromInd, inds, ninds) {
if (!is(inds, "matrix")) inds <- as.matrix(inds) if (!is(inds, "matrix")) inds <- as.matrix(inds)
if (identical(dim(inds), c(nrow(inds), 1L))) { if (identical(dim(inds), c(nrow(inds), 1L))) {

View file

@ -1,4 +1,3 @@
#' @export
#' @title Etsi Paras #' @title Etsi Paras
#' @description Search for the best? #' @description Search for the best?
#' @param osuus Percentages? #' @param osuus Percentages?

View file

@ -6,7 +6,6 @@
#' fgetl returns tline as a numeric value -1. #' fgetl returns tline as a numeric value -1.
#' @author Waldir Leoncio #' @author Waldir Leoncio
#' @seealso fopen #' @seealso fopen
#' @export
fgetl <- function(file) { fgetl <- function(file) {
# ========================================================================== # ==========================================================================
# Validation # Validation
@ -27,5 +26,4 @@ fgetl <- function(file) {
#' @return The same as `readLines(filename)` #' @return The same as `readLines(filename)`
#' @author Waldir Leoncio #' @author Waldir Leoncio
#' @seealso fgetl #' @seealso fgetl
#' @export
fopen <- function(filename) readLines(filename) fopen <- function(filename) readLines(filename)

View file

@ -11,7 +11,6 @@
#' @importFrom matlab2r uiputfile #' @importFrom matlab2r uiputfile
#' @references Samtools: a suite of programs for interacting #' @references Samtools: a suite of programs for interacting
#' with high-throughput sequencing data. <http://www.htslib.org/> #' with high-throughput sequencing data. <http://www.htslib.org/>
#' @export
greedyPopMix <- function(data, format, partitionCompare = NULL, verbose = TRUE greedyPopMix <- function(data, format, partitionCompare = NULL, verbose = TRUE
) { ) {
# Replacing original file reading code with greedyMix() # Replacing original file reading code with greedyMix()

View file

@ -8,7 +8,6 @@
#' code to the smallest code that is larger than any code in use. After this, #' code to the smallest code that is larger than any code in use. After this,
#' the function changes the allele codes so that one locus j #' the function changes the allele codes so that one locus j
#' codes get values between? 1, ..., Noah (j). #' codes get values between? 1, ..., Noah (j).
#' @export
handleData <- function(raw_data) { handleData <- function(raw_data) {
# Alkuper?isen datan viimeinen sarake kertoo, milt?yksil?lt? # Alkuper?isen datan viimeinen sarake kertoo, milt?yksil?lt?
# kyseinen rivi on per?isin. Funktio tutkii ensin, ett?montako # kyseinen rivi on per?isin. Funktio tutkii ensin, ett?montako

View file

@ -4,7 +4,6 @@
#' codes so that the codes for one locus have values between 1 and noalle[j]. #' codes so that the codes for one locus have values between 1 and noalle[j].
#' Before this change, an allele whose code is zero is changed. #' Before this change, an allele whose code is zero is changed.
#' @param raw_data raw data #' @param raw_data raw data
#' @export
handlePopData <- function(raw_data) { handlePopData <- function(raw_data) {
# Alkuperäisen datan viimeinen sarake kertoo, milt?yksilölt? # Alkuperäisen datan viimeinen sarake kertoo, milt?yksilölt?
# kyseinen rivi on peräisin. Funktio muuttaa alleelikoodit # kyseinen rivi on peräisin. Funktio muuttaa alleelikoodit

View file

@ -1,7 +1,6 @@
#' @title Initialize Pop Names #' @title Initialize Pop Names
#' @param nameFile nameFile #' @param nameFile nameFile
#' @param indexFile indexFile #' @param indexFile indexFile
#' @export
initPopNames <- function(nameFile, indexFile) { initPopNames <- function(nameFile, indexFile) {
# Palauttaa tyhj<68>n, mik<69>li nimitiedosto ja indeksitiedosto # Palauttaa tyhj<68>n, mik<69>li nimitiedosto ja indeksitiedosto
# eiv<69>t olleet yht?pitki? # eiv<69>t olleet yht?pitki?

View file

@ -1,5 +1,4 @@
#' @title Learn partition (modified) #' @title Learn partition (modified)
#' @export
#' @param ordered ordered #' @param ordered ordered
#' @return part #' @return part
#' @description This function is called only if some individual has less than #' @description This function is called only if some individual has less than

View file

@ -3,7 +3,6 @@
#' @param fii fii #' @param fii fii
#' @description Goes through all the ways to divide the points into two or #' @description Goes through all the ways to divide the points into two or
#' three groups. Chooses the partition which obtains highest logml. #' three groups. Chooses the partition which obtains highest logml.
#' @export
learn_simple_partition <- function(ordered_points, fii) { learn_simple_partition <- function(ordered_points, fii) {
npoints <- length(ordered_points) npoints <- length(ordered_points)

View file

@ -13,7 +13,6 @@
#' that BAPS should use this function instead of the base one, so this is why #' that BAPS should use this function instead of the base one, so this is why
#' this function is part of this package (instead of a MATLAB-replicating #' this function is part of this package (instead of a MATLAB-replicating
#' package such as matlab2r) #' package such as matlab2r)
#' @export
linkage <- function(Y, method = "co") { linkage <- function(Y, method = "co") {
k <- size(Y)[1] k <- size(Y)[1]
n <- size(Y)[2] n <- size(Y)[2]

View file

@ -2,7 +2,6 @@
#' @description Returns a string representation of a logml #' @description Returns a string representation of a logml
#' @param logml input Logml #' @param logml input Logml
#' @return String version of logml #' @return String version of logml
#' @export
logml2String <- function(logml) { logml2String <- function(logml) {
# Palauttaa logml:n string-esityksen. # Palauttaa logml:n string-esityksen.
mjono <- " " mjono <- " "

View file

@ -2,7 +2,6 @@
#' @description Reads GenePop-formatted data #' @description Reads GenePop-formatted data
#' @param tiedostonNimi Name of the file #' @param tiedostonNimi Name of the file
#' @return list containing data and popnames #' @return list containing data and popnames
#' @export
lueGenePopData <- function(tiedostonNimi) { lueGenePopData <- function(tiedostonNimi) {
fid <- readLines(tiedostonNimi) fid <- readLines(tiedostonNimi)
line <- fid[1] # ensimmäinen rivi line <- fid[1] # ensimmäinen rivi

View file

@ -3,7 +3,6 @@
#' group. popnames are as before. #' group. popnames are as before.
#' @param tiedostonNimi Name of the file #' @param tiedostonNimi Name of the file
#' @return List containing data and popnames #' @return List containing data and popnames
#' @export
lueGenePopDataPop <- function(tiedostonNimi) { lueGenePopDataPop <- function(tiedostonNimi) {
# Data annetaan muodossa, jossa viimeinen sarake kertoo ryhmän. # Data annetaan muodossa, jossa viimeinen sarake kertoo ryhmän.
# popnames on kuten ennenkin. # popnames on kuten ennenkin.

View file

@ -2,7 +2,6 @@
#' @description Returns the part of the line from the beginning that is before the comma. Useful for returning the name of a GenePop area #' @description Returns the part of the line from the beginning that is before the comma. Useful for returning the name of a GenePop area
#' @param line line #' @param line line
#' @return nimi #' @return nimi
#' @export
lueNimi <- function(line) { lueNimi <- function(line) {
# ========================================================================== # ==========================================================================
# Validation # Validation

View file

@ -5,7 +5,6 @@
#' @return puredata: a data contains no index column. #' @return puredata: a data contains no index column.
#' @param data data #' @param data data
#' @param noalle noalle #' @param noalle noalle
#' @export
noIndex <- function(data, noalle) { noIndex <- function(data, noalle) {
limit <- ifelse(is(noalle, "matrix"), ncol(noalle), length(noalle)) limit <- ifelse(is(noalle, "matrix"), ncol(noalle), length(noalle))
if (size(data, 2) == limit + 1) { if (size(data, 2) == limit + 1) {

View file

@ -2,7 +2,6 @@
#' @description Converts numbers to strings #' @description Converts numbers to strings
#' @param number number #' @param number number
#' @note On Matlab, if number is NaN the output is 'NaN'. Here, the output will be an error. Also, the function belo expects "number" to have length one, whereas Matlab accepts vectors. #' @note On Matlab, if number is NaN the output is 'NaN'. Here, the output will be an error. Also, the function belo expects "number" to have length one, whereas Matlab accepts vectors.
#' @export
ownNum2Str <- function(number) { ownNum2Str <- function(number) {
absolute <- abs(number) absolute <- abs(number)
if (absolute < 1000) { if (absolute < 1000) {

View file

@ -5,7 +5,6 @@
#' @param npops npops #' @param npops npops
#' @param rowsFromInd rowsFromInd #' @param rowsFromInd rowsFromInd
#' @param alaraja alaraja #' @param alaraja alaraja
#' @export
poistaLiianPienet <- function(npops, rowsFromInd, alaraja) { poistaLiianPienet <- function(npops, rowsFromInd, alaraja) {
popSize <- zeros(1, npops) popSize <- zeros(1, npops)
if (npops > 0) { if (npops > 0) {

View file

@ -3,7 +3,6 @@
#' @return a 4-mark presentation of proportion #' @return a 4-mark presentation of proportion
#' @note The `round` function in R, being ISO-compliant, rounds 8.5 to 8. The #' @note The `round` function in R, being ISO-compliant, rounds 8.5 to 8. The
#' Matlab equivalent rounds it to 9. #' Matlab equivalent rounds it to 9.
#' @export
proportion2str <- function(prob) { proportion2str <- function(prob) {
if (abs(prob) < 1e-3) { if (abs(prob) < 1e-3) {
str <- "0.00" str <- "0.00"

View file

@ -1,10 +1,9 @@
#' @title Generates random numbers #' @title Generates random numbers
#' @return vector of length `nc` with r.v. realizations from Gamma(rate=1) #' @return vector of length `nc` with r.v. realizations from Gamma(rate=1)
#' @examples randdir(matrix(c(10, 30, 60), 3), 3) #' @examples rBAPS:::randdir(matrix(c(10, 30, 60), 3), 3)
#' @param counts shape parameter #' @param counts shape parameter
#' @param nc number of rows on output #' @param nc number of rows on output
#' @seealso randga #' @seealso randga
#' @export
randdir <- function(counts, nc) { randdir <- function(counts, nc) {
svar <- zeros(nc, 1) svar <- zeros(nc, 1)
for (i in 1:nc) { for (i in 1:nc) {

View file

@ -2,7 +2,6 @@
#' @param line line number #' @param line line number
#' @return count #' @return count
#' @description Returns the number of queues contained in the line. There must be a space between the queues. #' @description Returns the number of queues contained in the line. There must be a space between the queues.
#' @export
rivinSisaltamienMjonojenLkm <- function(line) { rivinSisaltamienMjonojenLkm <- function(line) {
# Palauttaa line:n sis<69>lt<6C>mien mjonojen lukum<75><6D>r<EFBFBD>n. # Palauttaa line:n sis<69>lt<6C>mien mjonojen lukum<75><6D>r<EFBFBD>n.
# Mjonojen v<>liss?t<>ytyy olla v<>lily<6C>nti. # Mjonojen v<>liss?t<>ytyy olla v<>lily<6C>nti.

View file

@ -1,7 +1,6 @@
#' @title Find out the Digit Format #' @title Find out the Digit Format
#' @param line the first line after the "pop" word from data in Genepop format. # @note Function clarified based on the line format whether the alleles of the data are given using 2 or 3 numbers. #' @param line the first line after the "pop" word from data in Genepop format. # @note Function clarified based on the line format whether the alleles of the data are given using 2 or 3 numbers.
#' @return df #' @return df
#' @export
selvitaDigitFormat <- function(line) { selvitaDigitFormat <- function(line) {
# line on ensimm<6D>inen pop-sanan j<>lkeinen rivi # line on ensimm<6D>inen pop-sanan j<>lkeinen rivi
# Genepop-formaatissa olevasta datasta. funktio selvitt<74><74> # Genepop-formaatissa olevasta datasta. funktio selvitt<74><74>

View file

@ -2,8 +2,6 @@
#' @description Lisää jokaista alleelia joka populaation joka lokukseen j1/noalle(j) verran. Näin saatuja counts:eja vastaavista Dirichlet-jakaumista simuloidaan arvot populaatioiden alleelifrekvensseille. #' @description Lisää jokaista alleelia joka populaation joka lokukseen j1/noalle(j) verran. Näin saatuja counts:eja vastaavista Dirichlet-jakaumista simuloidaan arvot populaatioiden alleelifrekvensseille.
#' Add each allele to each locus in each population by j 1 / noalle(j). The Dirichlet distributions corresponding to the counts thus obtained simulate values for the allele frequencies of the populations. #' Add each allele to each locus in each population by j 1 / noalle(j). The Dirichlet distributions corresponding to the counts thus obtained simulate values for the allele frequencies of the populations.
#' @param noalle noalle #' @param noalle noalle
#' @export
simulateAllFreqs <- function(noalle) { simulateAllFreqs <- function(noalle) {
if (isGlobalEmpty(COUNTS)) { if (isGlobalEmpty(COUNTS)) {
max_noalle <- 0 max_noalle <- 0

View file

@ -6,8 +6,6 @@
#' @param allfreqs allfreqs #' @param allfreqs allfreqs
#' @param pop pop #' @param pop pop
#' @param missing_level missing_level #' @param missing_level missing_level
#' @export
simulateIndividuals <- function(n, rowsFromInd, allfreqs, pop, missing_level) { simulateIndividuals <- function(n, rowsFromInd, allfreqs, pop, missing_level) {
nloci <- size(allfreqs, 2) nloci <- size(allfreqs, 2)

View file

@ -5,8 +5,6 @@
#' @param allfreqs allfreqa #' @param allfreqs allfreqa
#' @param pop pop #' @param pop pop
#' @param loc loc #' @param loc loc
#' @export
simuloiAlleeli <- function(allfreqs, pop, loc) { simuloiAlleeli <- function(allfreqs, pop, loc) {
if (length(dim(allfreqs)) == 0) { if (length(dim(allfreqs)) == 0) {
freqs <- 1 freqs <- 1

View file

@ -3,7 +3,6 @@
#' @param osuusTaulu Percentage table? #' @param osuusTaulu Percentage table?
#' @param osuus percentage? #' @param osuus percentage?
#' @param indeksi index #' @param indeksi index
#' @export
suoritaMuutos <- function(osuusTaulu, osuus, indeksi) { suoritaMuutos <- function(osuusTaulu, osuus, indeksi) {
if (isGlobalEmpty(COUNTS)) { if (isGlobalEmpty(COUNTS)) {
npops <- 1 npops <- 1

View file

@ -3,7 +3,6 @@
#' @param description description #' @param description description
#' @param width width #' @param width width
#' @return newline #' @return newline
#' @export
takeLine <- function(description, width) { takeLine <- function(description, width) {
# Returns one line from the description: line ends to the first # Returns one line from the description: line ends to the first
# space after width:th mark. # space after width:th mark.

View file

@ -3,7 +3,6 @@
#' @param coordinates coordinates #' @param coordinates coordinates
#' @param interactive prompt user for relevant questions during execution #' @param interactive prompt user for relevant questions during execution
#' @return a list of defectives ("viallinen") and coordinates #' @return a list of defectives ("viallinen") and coordinates
#' @export
testaaKoordinaatit <- function(ninds, coordinates, interactive = TRUE) { testaaKoordinaatit <- function(ninds, coordinates, interactive = TRUE) {
# Testaa onko koordinaatit kunnollisia. # Testaa onko koordinaatit kunnollisia.
# modified by Lu Cheng, 05.12.2012 # modified by Lu Cheng, 05.12.2012

View file

@ -2,7 +2,6 @@
#' @description Test if loaded BAPS data is proper #' @description Test if loaded BAPS data is proper
#' @param data dataset #' @param data dataset
#' @return ninds #' @return ninds
#' @export
testaaOnkoKunnollinenBapsData <- function(data) { testaaOnkoKunnollinenBapsData <- function(data) {
# Tarkastaa onko viimeisess?sarakkeessa kaikki # Tarkastaa onko viimeisess?sarakkeessa kaikki
# luvut 1,2,...,n johonkin n:<3A><>n asti. # luvut 1,2,...,n johonkin n:<3A><>n asti.

View file

@ -3,7 +3,6 @@
#' @param rivi Line #' @param rivi Line
#' @return pal = 1 if the line starts with one of the following #' @return pal = 1 if the line starts with one of the following
# letter combinations: Pop, pop, POP. In all others cases, pal = 0 # letter combinations: Pop, pop, POP. In all others cases, pal = 0
#' @export
testaaPop <- function(rivi) { testaaPop <- function(rivi) {
# pal=1, mik<69>li rivi alkaa jollain seuraavista # pal=1, mik<69>li rivi alkaa jollain seuraavista
# kirjainyhdistelmist? Pop, pop, POP. Kaikissa muissa # kirjainyhdistelmist? Pop, pop, POP. Kaikissa muissa

View file

@ -10,7 +10,6 @@
#' @param partitionSummary partitionSummary #' @param partitionSummary partitionSummary
#' @param popnames popnames #' @param popnames popnames
#' @param fixedK fixedK #' @param fixedK fixedK
#' @export
writeMixtureInfo <- function( writeMixtureInfo <- function(
logml, rowsFromInd, data, adjprior, priorTerm, outPutFile, inputFile, logml, rowsFromInd, data, adjprior, priorTerm, outPutFile, inputFile,
partitionSummary, popnames, fixedK partitionSummary, popnames, fixedK

View file

@ -10,7 +10,6 @@
#' @param partitionSummary partitionSummary #' @param partitionSummary partitionSummary
#' @param popnames popnames #' @param popnames popnames
#' @param fixedK fixedK #' @param fixedK fixedK
#' @export
writeMixtureInfoPop <- function(logml, rows, data, adjprior, priorTerm, writeMixtureInfoPop <- function(logml, rows, data, adjprior, priorTerm,
outPutFile, inputFile, partitionSummary, outPutFile, inputFile, partitionSummary,
popnames, fixedK) { popnames, fixedK) {

View file

@ -18,7 +18,7 @@ vector of length `nc` with r.v. realizations from Gamma(rate=1)
Generates random numbers Generates random numbers
} }
\examples{ \examples{
randdir(matrix(c(10, 30, 60), 3), 3) rBAPS:::randdir(matrix(c(10, 30, 60), 3), 3)
} }
\seealso{ \seealso{
randga randga