diff --git a/DESCRIPTION b/DESCRIPTION index 20ade91..8e8ffb6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,4 +40,4 @@ RoxygenNote: 7.2.1 Suggests: testthat (>= 2.1.0) Imports: - methods, ape, vcfR, Rsamtools, adegenet, matlab2r + methods, ape, vcfR, Rsamtools, adegenet, matlab2r, R6 diff --git a/NAMESPACE b/NAMESPACE index 43dbeb2..a7ddd55 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,7 +15,6 @@ export(greedyPopMix) export(handleData) export(handlePopData) export(initPopNames) -export(laskeMuutokset4) export(learn_partition_modified) export(learn_simple_partition) export(linkage) @@ -40,6 +39,7 @@ export(testaaOnkoKunnollinenBapsData) export(testaaPop) export(writeMixtureInfo) export(writeMixtureInfoPop) +importFrom(R6,R6Class) importFrom(Rsamtools,scanBam) importFrom(adegenet,.readExt) importFrom(adegenet,read.genepop) diff --git a/R/etsiParas.R b/R/etsiParas.R index 8757e38..80ee063 100644 --- a/R/etsiParas.R +++ b/R/etsiParas.R @@ -8,7 +8,8 @@ etsiParas <- function(osuus, osuusTaulu, omaFreqs, logml) { ready <- 0 while (ready != 1) { - muutokset <- laskeMuutokset4(osuus, osuusTaulu, omaFreqs, logml) + muutokset <- admix1_muutokset$new() + muutokset <- muutokset$laskeMuutokset4(osuus, osuusTaulu, omaFreqs, logml) # Work around R's base::max() limitation on complex numbers if (any(vapply(muutokset, class, vector("character", 1)) == "complex")) { diff --git a/R/laskeMuutokset12345.R b/R/laskeMuutokset12345.R index be783bd..178e2d4 100644 --- a/R/laskeMuutokset12345.R +++ b/R/laskeMuutokset12345.R @@ -3,42 +3,48 @@ #' muutos logml:ss? mikäli populaatiosta i siirretään osuuden verran #' todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään #' siirrettävää, on vastaavassa kohdassa rivi nollia. +#' @importFrom R6 R6Class #' @param osuus Percentages? -#' @param omaFreqs own Freqs? #' @param osuusTaulu Percentage table? +#' @param omaFreqs own Freqs? #' @param logml log maximum likelihood -#' @export -laskeMuutokset4 <- function(osuus, osuusTaulu, omaFreqs, logml) { - if (isGlobalEmpty(COUNTS)) { - npops <- 1 - } else { - npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3]) - } - notEmpty <- which(osuusTaulu > 0.005) - muutokset <- zeros(npops) - empties <- !notEmpty - - for (i1 in notEmpty) { - osuusTaulu[i1] <- osuusTaulu[i1] - osuus - for (i2 in c(colon(1, i1 - 1), colon(i1 + 1, npops))) { - osuusTaulu[i2] <- osuusTaulu[i2] + osuus - loggis <- computeIndLogml(omaFreqs, osuusTaulu) - - # Work around Matlab OOB bug - if (i1 > nrow(muutokset)) { - muutokset <- rbind(muutokset, muutokset * 0) - } - if (i2 > ncol(muutokset)) { - muutokset <- cbind(muutokset, muutokset * 0) +admix1_muutokset <- R6Class( + classname = "admix1_muutokset", + public = list( + laskeMuutokset4 = function(osuus, osuusTaulu, omaFreqs, logml) { + if (isGlobalEmpty(COUNTS)) { + npops <- 1 + } else { + npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3]) } + notEmpty <- which(osuusTaulu > 0.005) + muutokset <- zeros(npops) + empties <- !notEmpty - muutokset[i1, i2] <- loggis - logml - osuusTaulu[i2] <- osuusTaulu[i2] - osuus + for (i1 in notEmpty) { + osuusTaulu[i1] <- osuusTaulu[i1] - osuus + for (i2 in c(colon(1, i1 - 1), colon(i1 + 1, npops))) { + osuusTaulu[i2] <- osuusTaulu[i2] + osuus + loggis <- computeIndLogml(omaFreqs, osuusTaulu) + + # Work around Matlab OOB bug + if (i1 > nrow(muutokset)) { + muutokset <- rbind(muutokset, muutokset * 0) + } + if (i2 > ncol(muutokset)) { + muutokset <- cbind(muutokset, muutokset * 0) + } + + muutokset[i1, i2] <- loggis - logml + osuusTaulu[i2] <- osuusTaulu[i2] - osuus + } + osuusTaulu[i1] <- osuusTaulu[i1] + osuus + } + return(muutokset) } - osuusTaulu[i1] <- osuusTaulu[i1] + osuus - } - return(muutokset) -} + ) +) + # Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik� olisi # muutos logml:ss�, mik�li yksil� ind siirret��n koriin i. diff --git a/R/laskeVarmuus.R b/R/laskeVarmuus.R new file mode 100644 index 0000000..954dc5c --- /dev/null +++ b/R/laskeVarmuus.R @@ -0,0 +1,13 @@ +laskeVarmuus <- function( + rowsFromInd, data, adjprior, priorTerm, logml, cliques, separators, ninds +) { +varmuus <- zeros(ninds, 1) +for (ind in 1:ninds) { + # muutokset <- spatialMixture() + # muutokset <- muutokset$laskeMuutokset( + # ind, rowsFromInd, data, adjprior, priorTerm, logml, cliques, separators + # ) + # varmuus[ind] <- 1 / sum(exp(muutokset)) +} + return(varmuus) +} diff --git a/man/admix1_muutokset.Rd b/man/admix1_muutokset.Rd new file mode 100644 index 0000000..fe61a98 --- /dev/null +++ b/man/admix1_muutokset.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/laskeMuutokset12345.R +\name{admix1_muutokset} +\alias{admix1_muutokset} +\title{Calculate changes (?)} +\description{ +Palauttaa npops*npops taulun, jonka alkio (i,j) kertoo, mik?on +muutos logml:ss? mikäli populaatiosta i siirretään osuuden verran +todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään +siirrettävää, on vastaavassa kohdassa rivi nollia. +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-admix1_muutokset-laskeMuutokset4}{\code{admix1_muutokset$laskeMuutokset4()}} +\item \href{#method-admix1_muutokset-clone}{\code{admix1_muutokset$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-admix1_muutokset-laskeMuutokset4}{}}} +\subsection{Method \code{laskeMuutokset4()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{admix1_muutokset$laskeMuutokset4(osuus, osuusTaulu, omaFreqs, logml)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{osuus}}{Percentages?} + +\item{\code{osuusTaulu}}{Percentage table?} + +\item{\code{omaFreqs}}{own Freqs?} + +\item{\code{logml}}{log maximum likelihood} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-admix1_muutokset-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{admix1_muutokset$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/laskeMuutokset4.Rd b/man/laskeMuutokset4.Rd deleted file mode 100644 index db7a2f2..0000000 --- a/man/laskeMuutokset4.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/laskeMuutokset12345.R -\name{laskeMuutokset4} -\alias{laskeMuutokset4} -\title{Calculate changes (?)} -\usage{ -laskeMuutokset4(osuus, osuusTaulu, omaFreqs, logml) -} -\arguments{ -\item{osuus}{Percentages?} - -\item{osuusTaulu}{Percentage table?} - -\item{omaFreqs}{own Freqs?} - -\item{logml}{log maximum likelihood} -} -\description{ -Palauttaa npops*npops taulun, jonka alkio (i,j) kertoo, mik?on -muutos logml:ss? mikäli populaatiosta i siirretään osuuden verran -todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään -siirrettävää, on vastaavassa kohdassa rivi nollia. -} diff --git a/tests/testthat/test-admix1.R b/tests/testthat/test-admix1.R index 782ead3..27d5491 100644 --- a/tests/testthat/test-admix1.R +++ b/tests/testthat/test-admix1.R @@ -147,9 +147,9 @@ test_that("suoritaMuutos works like on Matlab", { }) test_that("laskeMuutokset4 works like on Matlab", { - mx1 <- t(c(.4, 7)) + x <- admix1_muutokset$new() expect_equivalent( - object = laskeMuutokset4(2, mx1, c(8, 2), 3), + object = x$laskeMuutokset4(2, t(c(.4, 7)), c(8, 2), 3), expected = t(c(0, .3742)), tol = .0001 )