Refactored laskeMuutokset4() as an R6 method

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