Refactored laskeMuutokset4() as an R6 method

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

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)

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")) {

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
+admix1_muutokset <- R6Class(
-laskeMuutokset4 <- function(osuus, osuusTaulu, omaFreqs, logml) {
+  classname = "admix1_muutokset",
-  if (isGlobalEmpty(COUNTS)) {
+  public = list(
-    npops <- 1
+    laskeMuutokset4 = function(osuus, osuusTaulu, omaFreqs, logml) {
-  } else {
+      if (isGlobalEmpty(COUNTS)) {
-    npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
+        npops <- 1
-  }
+      } else {
-  notEmpty <- which(osuusTaulu > 0.005)
+        npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
-  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)
       }
+      notEmpty <- which(osuusTaulu > 0.005)
+      muutokset <- zeros(npops)
+      empties <- !notEmpty
 
-      muutokset[i1, i2] <- loggis - logml
+      for (i1 in notEmpty) {
-      osuusTaulu[i2] <- osuusTaulu[i2] - osuus
+        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<69> olisi
 # muutos logml:ss<73>, mik<69>li yksil<69> ind siirret<65><74>n koriin i.

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

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{<hr>}}
+\if{html}{\out{<a id="method-admix1_muutokset-laskeMuutokset4"></a>}}
+\if{latex}{\out{\hypertarget{method-admix1_muutokset-laskeMuutokset4}{}}}
+\subsection{Method \code{laskeMuutokset4()}}{
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{admix1_muutokset$laskeMuutokset4(osuus, osuusTaulu, omaFreqs, logml)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{osuus}}{Percentages?}
+
+\item{\code{osuusTaulu}}{Percentage table?}
+
+\item{\code{omaFreqs}}{own Freqs?}
+
+\item{\code{logml}}{log maximum likelihood}
+}
+\if{html}{\out{</div>}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-admix1_muutokset-clone"></a>}}
+\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{<div class="r">}}\preformatted{admix1_muutokset$clone(deep = FALSE)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{deep}}{Whether to make a deep clone.}
+}
+\if{html}{\out{</div>}}
+}
+}
+}

man/laskeMuutokset4.Rd

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

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
   )