Merge branch 'refactor-laskeMuutokset' into develop

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/indMix.R

@@ -142,8 +142,9 @@ indMix <- function(c, npops, dispText = TRUE) {
 
           for (ind in inds) {
             i1 <- PARTITION[ind]
-            muutokset_diffInCounts <- laskeMuutokset(
+            muutokset_diffInCounts <- greedyMix_muutokset$new()
-              # FIXME: using 100-length global variables instead of the ones in this function
+            # FIXME: using 100-length global variables instead of the ones in this function
+            muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset(
               ind, rows, data, adjprior, priorTerm
             )
             muutokset <- muutokset_diffInCounts$muutokset
@@ -190,7 +191,8 @@ indMix <- function(c, npops, dispText = TRUE) {
         } else if (round == 2) { # Populaation yhdist<73>minen toiseen.
           maxMuutos <- 0
           for (pop in 1:npops) {
-            muutokset_diffInCounts <- laskeMuutokset2(
+            muutokset_diffInCounts <- greedyMix_muutokset$new()
+            muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset2(
               pop, rows, data, adjprior, priorTerm
             )
             muutokset <- muutokset_diffInCounts$muutokset
@@ -244,7 +246,8 @@ indMix <- function(c, npops, dispText = TRUE) {
                 npops2 <- 2 # Moneenko osaan jaetaan
               }
               T2 <- cluster_own(Z2, npops2)
-              muutokset <- laskeMuutokset3(
+              muutokset_diffInCounts <- greedyMix_muutokset$new()
+              muutokset <- muutokset_diffInCounts$laskeMuutokset3(
                 T2, inds2, rows, data, adjprior, priorTerm, pop
               )
               isoin <- matlab2r::max(muutokset)[[1]]
@@ -326,8 +329,8 @@ indMix <- function(c, npops, dispText = TRUE) {
             while (length(inds) > 0 & i < length(inds)) {
               i <- i + 1
               ind <- inds[i]
-
+              muutokset_diffInCounts <- greedyMix_muutokset$new()
-              muutokset_diffInCounts <- laskeMuutokset(
+              muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset(
                 ind, rows, data, adjprior, priorTerm
               )
               muutokset <- muutokset_diffInCounts$muutokset
@@ -411,8 +414,8 @@ indMix <- function(c, npops, dispText = TRUE) {
               Z2 <- linkage(t(dist2))
               T2 <- cluster_own(Z2, 2)
               muuttuvat <- inds2[matlab2r::find(T2 == 1)]
-
+              muutokset <- greedyMix_muutokset$new()
-              muutokset <- laskeMuutokset3(
+              muutokset <- muutokset$laskeMuutokset3(
                 T2, inds2, rows, data, adjprior, priorTerm, pop
               )
               totalMuutos <- muutokset(1, emptyPop)
@@ -436,7 +439,8 @@ indMix <- function(c, npops, dispText = TRUE) {
               while (muutettu == 1) {
                 muutettu <- 0
                 # Siirret<65><74>n yksil<69>it<69> populaatioiden v<>lill<6C>
-                muutokset <- laskeMuutokset5(
+                muutokset <- greedyMix_muutokset$new()
+                muutokset <- muutokset$laskeMuutokset5(
                   inds2, rows, data, adjprior, priorTerm,
                   pop, emptyPop
                 )

R/laskeMuutokset12345.R

@@ -1,161 +1,153 @@
-#' @title Calculate changes (?)
+#' @title Calculate changes (spatial mixture class)
+spatialMixture_muutokset <- R6Class(
+  classname = "spatialMixture_muutokset",
+  public = list(
+    #' @param ind ind
+    #' @param rowsFromInd rowsFromInd
+    #' @param data data
+    #' @param adjprior adjprior
+    #' @param priorTerm priorTerm
+    #' @param logml logml
+    #' @param cliques cliques
+    #' @param separators separators
+    laskeMuutokset = function(
+      ind, rowsFromInd, data, adjprior, priorTerm, logml, cliques, separators
+    ) {
+      stop("Not yet implemented") # TODO: implement
+    }
+  )
+)
+
+#' @title Calculate changes (admix1 class)
 #' @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.
-#' @param osuus Percentages?
+#' @importFrom R6 R6Class
-#' @param omaFreqs own Freqs?
+admix1_muutokset <- R6Class(
-#' @param osuusTaulu Percentage table?
+  classname = "admix1_muutokset",
-#' @param logml log maximum likelihood
+  public = list(
-#' @export
+    #' @param osuus Percentages?
-laskeMuutokset4 <- function(osuus, osuusTaulu, omaFreqs, logml) {
+    #' @param osuusTaulu Percentage table?
-  if (isGlobalEmpty(COUNTS)) {
+    #' @param omaFreqs own Freqs?
-    npops <- 1
+    #' @param logml log maximum likelihood
-  } else {
+    laskeMuutokset4 = function(osuus, osuusTaulu, omaFreqs, logml) {
-    npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
+      if (isGlobalEmpty(COUNTS)) {
-  }
+        npops <- 1
-  notEmpty <- which(osuusTaulu > 0.005)
+      } else {
-  muutokset <- zeros(npops)
+        npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
-  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.
-# diffInCounts on poistettava COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
-# COUNTS:in siivuun i2, mik<69>li muutos toteutetaan.
-#
-# Lis<69>ys 25.9.2007:
-# Otettu k<>ytt<74><74>n globaali muuttuja LOGDIFF, johon on tallennettu muutokset
-# logml:ss<73> siirrett<74>ess<73> yksil<69>it<69> toisiin populaatioihin.
-laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) {
-  npops <- size(COUNTS, 3)
-  muutokset <- LOGDIFF[ind, ]
-
-  i1 <- PARTITION[ind]
-  i1_logml <- POP_LOGML[i1]
-  muutokset[i1] <- 0
-
-  rows <- globalRows[ind, 1]:globalRows[ind, 2]
-  diffInCounts <- computeDiffInCounts(
-    rows, size(COUNTS, 1), size(COUNTS, 2), data
   )
-  diffInSumCounts <- colSums(diffInCounts)
+)
 
-  COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
+#' @title Calculate changes (greedyMix class)
-  SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
+#' @description Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
-  new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
+#' muutos logml:ss<73>, mik<69>li yksil<69> ind siirret<65><74>n koriin i.
-  COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
+#' diffInCounts on poistettava COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
-  SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
+#' COUNTS:in siivuun i2, mik<69>li muutos toteutetaan.
+#'
+#' Lis<69>ys 25.9.2007:
+#' Otettu k<>ytt<74><74>n globaali muuttuja LOGDIFF, johon on tallennettu muutokset
+#' logml:ss<73> siirrett<74>ess<73> yksil<69>it<69> toisiin populaatioihin.
+greedyMix_muutokset <- R6Class(
+  classname = "greedyMix_muutokset",
+  public = list(
+    #' @param ind ind
+    #' @param globalRows globalRows
+    #' @param data data
+    #' @param adjprior adjprior
+    #' @param priorTerm priorTerm
+    laskeMuutokset = function(ind, globalRows, data, adjprior, priorTerm) {
+      npops <- size(COUNTS, 3)
+      muutokset <- LOGDIFF[ind, ]
 
-  i2 <- matlab2r::find(muutokset == -Inf) # Etsit<69><74>n populaatiot jotka muuttuneet viime kerran j<>lkeen. (Searching for populations that have changed since the last time)
+      i1 <- PARTITION[ind]
-  i2 <- setdiff(i2, i1)
+      i1_logml <- POP_LOGML[i1]
-  i2_logml <- POP_LOGML[i2]
+      muutokset[i1] <- 0
 
-  ni2 <- length(i2)
+      rows <- globalRows[ind, 1]:globalRows[ind, 2]
+      diffInCounts <- computeDiffInCounts(
+        rows, size(COUNTS, 1), size(COUNTS, 2), data
+      )
+      diffInSumCounts <- colSums(diffInCounts)
 
-  COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, ni2))
+      COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
-  SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(ni2, 1))
+      SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
-  new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm)
+      new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
-  COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, ni2))
+      COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
-  SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(ni2, 1))
+      SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
 
-  muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
+      i2 <- matlab2r::find(muutokset == -Inf) # Etsit<69><74>n populaatiot jotka muuttuneet viime kerran j<>lkeen. (Searching for populations that have changed since the last time)
-  LOGDIFF[ind, ] <- muutokset
+      i2 <- setdiff(i2, i1)
-  return(list(muutokset = muutokset, diffInCounts = diffInCounts))
+      i2_logml <- POP_LOGML[i2]
-}
 
-laskeMuutokset2 <- function(i1, globalRows, data, adjprior, priorTerm) {
+      ni2 <- length(i2)
-  # % Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
-  # % muutos logml:ss<73>, mik<69>li korin i1 kaikki yksil<69>t siirret<65><74>n
-  # % koriin i.
 
-  npops <- size(COUNTS, 3)
+      COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, ni2))
-  muutokset <- zeros(npops, 1)
+      SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(ni2, 1))
+      new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm)
+      COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, ni2))
+      SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(ni2, 1))
 
-  i1_logml <- POP_LOGML[i1]
+      muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
+      LOGDIFF[ind, ] <- muutokset
+      return(list(muutokset = muutokset, diffInCounts = diffInCounts))
+    },
+    #' @param i1 i1
+    #' @param globalRows globalRows
+    #' @param data data
+    #' @param adjprior adjprior
+    #' @param priorTerm priorTerm
+    laskeMuutokset2 = function(i1, globalRows, data, adjprior, priorTerm) {
+      # % Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
+      # % muutos logml:ss<73>, mik<69>li korin i1 kaikki yksil<69>t siirret<65><74>n
+      # % koriin i.
 
-  inds <- matlab2r::find(PARTITION == i1)
+      npops <- size(COUNTS, 3)
-  ninds <- length(inds)
+      muutokset <- zeros(npops, 1)
 
-  if (ninds == 0) {
+      i1_logml <- POP_LOGML[i1]
-    diffInCounts <- zeros(size(COUNTS, 1), size(COUNTS, 2))
-    return()
-  }
 
-  rows <- list()
+      inds <- matlab2r::find(PARTITION == i1)
-  for (i in 1:ninds) {
+      ninds <- length(inds)
-    ind <- inds(i)
-    lisa <- globalRows(ind, 1):globalRows(ind, 2)
-    rows <- c(rows, t(lisa))
-  }
 
-  diffInCounts <- computeDiffInCounts(
+      if (ninds == 0) {
-    t(rows), size(COUNTS, 1), size(COUNTS, 2), data
+        diffInCounts <- zeros(size(COUNTS, 1), size(COUNTS, 2))
-  )
+        return()
-  diffInSumCounts <- sum(diffInCounts)
+      }
 
-  COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
-  SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
-  new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
-  COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
-  SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
-
-  i2 <- c(1:i1 - 1, i1 + 1:npops)
-  i2_logml <- POP_LOGML[i2]
-
-  COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
-  SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(npops - 1, 1))
-  new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm)
-  COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1))
-  SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 1))
-
-  muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
-  return(list(muutokset = muutokset, diffInCounts = diffInCounts))
-}
-
-
-laskeMuutokset3 <- function(T2, inds2, globalRows, data, adjprior, priorTerm, i1
-) {
-  # Palauttaa length(unique(T2))*npops taulun, jossa (i,j):s alkio
-  # kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio
-  # inds2(matlab2r::find(T2==i)) siirret<65><74>n koriin j.
-
-  npops <- size(COUNTS, 3)
-  npops2 <- length(unique(T2))
-  muutokset <- zeros(npops2, npops)
-
-  i1_logml <- POP_LOGML[i1]
-  for (pop2 in 1:npops2) {
-    inds <- inds2[matlab2r::find(T2 == pop2)]
-    ninds <- length(inds)
-    if (ninds > 0) {
       rows <- list()
       for (i in 1:ninds) {
-        ind <- inds[i]
+        ind <- inds(i)
-        lisa <- globalRows[ind, 1]:globalRows[ind, 2]
+        lisa <- globalRows(ind, 1):globalRows(ind, 2)
         rows <- c(rows, t(lisa))
       }
+
       diffInCounts <- computeDiffInCounts(
         t(rows), size(COUNTS, 1), size(COUNTS, 2), data
       )
@@ -168,61 +160,121 @@ laskeMuutokset3 <- function(T2, inds2, globalRows, data, adjprior, priorTerm, i1
       SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
 
       i2 <- c(1:i1 - 1, i1 + 1:npops)
-      i2_logml <- t(POP_LOGML[i2])
+      i2_logml <- POP_LOGML[i2]
 
       COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
       SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(npops - 1, 1))
-      new_i2_logml <- t(computePopulationLogml(i2, adjprior, priorTerm))
+      new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm)
       COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1))
       SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 1))
 
-      muutokset[pop2, i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
+      muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
+      return(list(muutokset = muutokset, diffInCounts = diffInCounts))
+    },
+    #' @param T2 T2
+    #' @param inds2 inds2
+    #' @param globalRows globalRows
+    #' @param data data
+    #' @param adjprior adjprior
+    #' @param priorTerm priorTerm
+    #' @param i1 i1
+    laskeMuutokset3 = function(
+      T2, inds2, globalRows, data, adjprior, priorTerm, i1
+    ) {
+      # Palauttaa length(unique(T2))*npops taulun, jossa (i,j):s alkio
+      # kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio
+      # inds2(matlab2r::find(T2==i)) siirret<65><74>n koriin j.
+
+      npops <- size(COUNTS, 3)
+      npops2 <- length(unique(T2))
+      muutokset <- zeros(npops2, npops)
+
+      i1_logml <- POP_LOGML[i1]
+      for (pop2 in 1:npops2) {
+        inds <- inds2[matlab2r::find(T2 == pop2)]
+        ninds <- length(inds)
+        if (ninds > 0) {
+          rows <- list()
+          for (i in 1:ninds) {
+            ind <- inds[i]
+            lisa <- globalRows[ind, 1]:globalRows[ind, 2]
+            rows <- c(rows, t(lisa))
+          }
+          diffInCounts <- computeDiffInCounts(
+            t(rows), size(COUNTS, 1), size(COUNTS, 2), data
+          )
+          diffInSumCounts <- sum(diffInCounts)
+
+          COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
+          SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
+          new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
+          COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
+          SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
+
+          i2 <- c(1:i1 - 1, i1 + 1:npops)
+          i2_logml <- t(POP_LOGML[i2])
+
+          COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
+          SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(npops - 1, 1))
+          new_i2_logml <- t(computePopulationLogml(i2, adjprior, priorTerm))
+          COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1))
+          SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 1))
+
+          muutokset[pop2, i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
+        }
+      }
+      return(muutokset)
+    },
+    #' @param inds inds
+    #' @param globalRows globalRows
+    #' @param data data
+    #' @param adjprior adjprior
+    #' @param priorTerm priorTerm
+    #' @param i1 i1
+    #' @param i2 i2
+    laskeMuutokset5 = function(inds, globalRows, data, adjprior, priorTerm, i1, i2) {
+      # Palauttaa length(inds)*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
+      # muutos logml:ss<73>, mik<69>li yksil<69> i vaihtaisi koria i1:n ja i2:n v<>lill<6C>.
+
+      ninds <- length(inds)
+      muutokset <- zeros(ninds, 1)
+
+      i1_logml <- POP_LOGML[i1]
+      i2_logml <- POP_LOGML[i2]
+
+      for (i in 1:ninds) {
+        ind <- inds[i]
+        if (PARTITION[ind] == i1) {
+          pop1 <- i1 # mist<73>
+          pop2 <- i2 # mihin
+        } else {
+          pop1 <- i2
+          pop2 <- i1
+        }
+        rows <- globalRows[ind, 1]:globalRows[ind, 2]
+        diffInCounts <- computeDiffInCounts(
+          rows, size(COUNTS, 1), size(COUNTS, 2), data
+        )
+        diffInSumCounts <- sum(diffInCounts)
+
+
+
+        COUNTS[, , pop1] <- COUNTS[, , pop1] - diffInCounts
+        SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] - diffInSumCounts
+        COUNTS[, , pop2] <- COUNTS[, , pop2] + diffInCounts
+        SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] + diffInSumCounts
+
+        new_logmls <- computePopulationLogml(c(i1, i2), adjprior, priorTerm)
+        muutokset[i] <- sum(new_logmls)
+
+        COUNTS[, , pop1] <- COUNTS[, , pop1] + diffInCounts
+        SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] + diffInSumCounts
+        COUNTS[, , pop2] <- COUNTS[, , pop2] - diffInCounts
+        SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] - diffInSumCounts
+      }
+
+      muutokset <- muutokset - i1_logml - i2_logml
+      return(muutokset)
     }
-  }
+  )
-  return(muutokset)
+)
-}
-
-laskeMuutokset5 <- function(inds, globalRows, data, adjprior, priorTerm, i1, i2) {
-  # Palauttaa length(inds)*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
-  # muutos logml:ss<73>, mik<69>li yksil<69> i vaihtaisi koria i1:n ja i2:n v<>lill<6C>.
-
-  ninds <- length(inds)
-  muutokset <- zeros(ninds, 1)
-
-  i1_logml <- POP_LOGML[i1]
-  i2_logml <- POP_LOGML[i2]
-
-  for (i in 1:ninds) {
-    ind <- inds[i]
-    if (PARTITION[ind] == i1) {
-      pop1 <- i1 # mist<73>
-      pop2 <- i2 # mihin
-    } else {
-      pop1 <- i2
-      pop2 <- i1
-    }
-    rows <- globalRows[ind, 1]:globalRows[ind, 2]
-    diffInCounts <- computeDiffInCounts(
-      rows, size(COUNTS, 1), size(COUNTS, 2), data
-    )
-    diffInSumCounts <- sum(diffInCounts)
-
-
-
-    COUNTS[, , pop1] <- COUNTS[, , pop1] - diffInCounts
-    SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] - diffInSumCounts
-    COUNTS[, , pop2] <- COUNTS[, , pop2] + diffInCounts
-    SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] + diffInSumCounts
-
-    new_logmls <- computePopulationLogml(c(i1, i2), adjprior, priorTerm)
-    muutokset[i] <- sum(new_logmls)
-
-    COUNTS[, , pop1] <- COUNTS[, , pop1] + diffInCounts
-    SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] + diffInSumCounts
-    COUNTS[, , pop2] <- COUNTS[, , pop2] - diffInCounts
-    SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] - diffInSumCounts
-  }
-
-  muutokset <- muutokset - i1_logml - i2_logml
-  return(muutokset)
-}

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$new()
+    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 (admix1 class)}
+\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/greedyMix_muutokset.Rd

@@ -0,0 +1,163 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/laskeMuutokset12345.R
+\name{greedyMix_muutokset}
+\alias{greedyMix_muutokset}
+\title{Calculate changes (greedyMix class)}
+\description{
+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.
+diffInCounts on poistettava COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
+COUNTS:in siivuun i2, mik<69>li muutos toteutetaan.
+
+Lis<EFBFBD>ys 25.9.2007:
+Otettu k<>ytt<74><74>n globaali muuttuja LOGDIFF, johon on tallennettu muutokset
+logml:ss<73> siirrett<74>ess<73> yksil<69>it<69> toisiin populaatioihin.
+}
+\section{Methods}{
+\subsection{Public methods}{
+\itemize{
+\item \href{#method-greedyMix_muutokset-laskeMuutokset}{\code{greedyMix_muutokset$laskeMuutokset()}}
+\item \href{#method-greedyMix_muutokset-laskeMuutokset2}{\code{greedyMix_muutokset$laskeMuutokset2()}}
+\item \href{#method-greedyMix_muutokset-laskeMuutokset3}{\code{greedyMix_muutokset$laskeMuutokset3()}}
+\item \href{#method-greedyMix_muutokset-laskeMuutokset5}{\code{greedyMix_muutokset$laskeMuutokset5()}}
+\item \href{#method-greedyMix_muutokset-clone}{\code{greedyMix_muutokset$clone()}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-greedyMix_muutokset-laskeMuutokset"></a>}}
+\if{latex}{\out{\hypertarget{method-greedyMix_muutokset-laskeMuutokset}{}}}
+\subsection{Method \code{laskeMuutokset()}}{
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{greedyMix_muutokset$laskeMuutokset(ind, globalRows, data, adjprior, priorTerm)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{ind}}{ind}
+
+\item{\code{globalRows}}{globalRows}
+
+\item{\code{data}}{data}
+
+\item{\code{adjprior}}{adjprior}
+
+\item{\code{priorTerm}}{priorTerm}
+}
+\if{html}{\out{</div>}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-greedyMix_muutokset-laskeMuutokset2"></a>}}
+\if{latex}{\out{\hypertarget{method-greedyMix_muutokset-laskeMuutokset2}{}}}
+\subsection{Method \code{laskeMuutokset2()}}{
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{greedyMix_muutokset$laskeMuutokset2(i1, globalRows, data, adjprior, priorTerm)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{i1}}{i1}
+
+\item{\code{globalRows}}{globalRows}
+
+\item{\code{data}}{data}
+
+\item{\code{adjprior}}{adjprior}
+
+\item{\code{priorTerm}}{priorTerm}
+}
+\if{html}{\out{</div>}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-greedyMix_muutokset-laskeMuutokset3"></a>}}
+\if{latex}{\out{\hypertarget{method-greedyMix_muutokset-laskeMuutokset3}{}}}
+\subsection{Method \code{laskeMuutokset3()}}{
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{greedyMix_muutokset$laskeMuutokset3(
+  T2,
+  inds2,
+  globalRows,
+  data,
+  adjprior,
+  priorTerm,
+  i1
+)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{T2}}{T2}
+
+\item{\code{inds2}}{inds2}
+
+\item{\code{globalRows}}{globalRows}
+
+\item{\code{data}}{data}
+
+\item{\code{adjprior}}{adjprior}
+
+\item{\code{priorTerm}}{priorTerm}
+
+\item{\code{i1}}{i1}
+}
+\if{html}{\out{</div>}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-greedyMix_muutokset-laskeMuutokset5"></a>}}
+\if{latex}{\out{\hypertarget{method-greedyMix_muutokset-laskeMuutokset5}{}}}
+\subsection{Method \code{laskeMuutokset5()}}{
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{greedyMix_muutokset$laskeMuutokset5(
+  inds,
+  globalRows,
+  data,
+  adjprior,
+  priorTerm,
+  i1,
+  i2
+)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{inds}}{inds}
+
+\item{\code{globalRows}}{globalRows}
+
+\item{\code{data}}{data}
+
+\item{\code{adjprior}}{adjprior}
+
+\item{\code{priorTerm}}{priorTerm}
+
+\item{\code{i1}}{i1}
+
+\item{\code{i2}}{i2}
+}
+\if{html}{\out{</div>}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-greedyMix_muutokset-clone"></a>}}
+\if{latex}{\out{\hypertarget{method-greedyMix_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{greedyMix_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.
-}

man/spatialMixture_muutokset.Rd

@@ -0,0 +1,74 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/laskeMuutokset12345.R
+\name{spatialMixture_muutokset}
+\alias{spatialMixture_muutokset}
+\title{Calculate changes (spatial mixture class)}
+\description{
+Calculate changes (spatial mixture class)
+
+Calculate changes (spatial mixture class)
+}
+\section{Methods}{
+\subsection{Public methods}{
+\itemize{
+\item \href{#method-spatialMixture_muutokset-laskeMuutokset}{\code{spatialMixture_muutokset$laskeMuutokset()}}
+\item \href{#method-spatialMixture_muutokset-clone}{\code{spatialMixture_muutokset$clone()}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-spatialMixture_muutokset-laskeMuutokset"></a>}}
+\if{latex}{\out{\hypertarget{method-spatialMixture_muutokset-laskeMuutokset}{}}}
+\subsection{Method \code{laskeMuutokset()}}{
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{spatialMixture_muutokset$laskeMuutokset(
+  ind,
+  rowsFromInd,
+  data,
+  adjprior,
+  priorTerm,
+  logml,
+  cliques,
+  separators
+)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{ind}}{ind}
+
+\item{\code{rowsFromInd}}{rowsFromInd}
+
+\item{\code{data}}{data}
+
+\item{\code{adjprior}}{adjprior}
+
+\item{\code{priorTerm}}{priorTerm}
+
+\item{\code{logml}}{logml}
+
+\item{\code{cliques}}{cliques}
+
+\item{\code{separators}}{separators}
+}
+\if{html}{\out{</div>}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-spatialMixture_muutokset-clone"></a>}}
+\if{latex}{\out{\hypertarget{method-spatialMixture_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{spatialMixture_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>}}
+}
+}
+}

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
   )