max/ourMELONS
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Refactored remaining laskeMuutokset as R6 methods

Browse source
This commit is contained in:
Waldir Leoncio 2022-08-25 13:48:17 +02:00
parent c05a500d5f
commit 3efb54d8b5
3 changed files with 354 additions and 162 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
R/indMix.R
View file

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

67
R/laskeMuutokset12345.R
View file

@ -1,5 +1,4 @@
#' @title Calculate changes (spatial mixture class) #' @title Calculate changes (spatial mixture class)
#' @importFrom R6 R6Class
spatialMixture_muutokset <- R6Class( spatialMixture_muutokset <- R6Class(
classname = "spatialMixture_muutokset", classname = "spatialMixture_muutokset",
public = list( public = list(
@ -66,16 +65,24 @@ admix1_muutokset <- R6Class(
) )
) )
#' @title Calculate changes (greedyMix class)
# Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi #' @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. #' 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> #' diffInCounts on poistettava COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
# COUNTS:in siivuun i2, mik<69>li muutos toteutetaan. #' COUNTS:in siivuun i2, mik<69>li muutos toteutetaan.
# #'
# Lis<69>ys 25.9.2007: #' Lis<69>ys 25.9.2007:
# Otettu k<>ytt<74><74>n globaali muuttuja LOGDIFF, johon on tallennettu muutokset #' 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. #' logml:ss<73> siirrett<74>ess<73> yksil<69>it<69> toisiin populaatioihin.
laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) { 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) npops <- size(COUNTS, 3)
muutokset <- LOGDIFF[ind, ] muutokset <- LOGDIFF[ind, ]
@ -110,9 +117,13 @@ laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) {
muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
LOGDIFF[ind, ] <- muutokset LOGDIFF[ind, ] <- muutokset
return(list(muutokset = muutokset, diffInCounts = diffInCounts)) return(list(muutokset = muutokset, diffInCounts = diffInCounts))
} },
#' @param i1 i1
laskeMuutokset2 <- function(i1, globalRows, data, adjprior, priorTerm) { #' @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 # % 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 # % muutos logml:ss<73>, mik<69>li korin i1 kaikki yksil<69>t siirret<65><74>n
# % koriin i. # % koriin i.
@ -159,10 +170,16 @@ laskeMuutokset2 <- function(i1, globalRows, data, adjprior, priorTerm) {
muutokset[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)) return(list(muutokset = muutokset, diffInCounts = diffInCounts))
} },
#' @param T2 T2
#' @param inds2 inds2
laskeMuutokset3 <- function(T2, inds2, globalRows, data, adjprior, priorTerm, i1 #' @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 # Palauttaa length(unique(T2))*npops taulun, jossa (i,j):s alkio
# kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio # kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio
@ -207,9 +224,15 @@ laskeMuutokset3 <- function(T2, inds2, globalRows, data, adjprior, priorTerm, i1
} }
} }
return(muutokset) return(muutokset)
} },
#' @param inds inds
laskeMuutokset5 <- function(inds, globalRows, data, adjprior, priorTerm, i1, i2) { #' @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 # 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>. # muutos logml:ss<73>, mik<69>li yksil<69> i vaihtaisi koria i1:n ja i2:n v<>lill<6C>.
@ -253,3 +276,5 @@ laskeMuutokset5 <- function(inds, globalRows, data, adjprior, priorTerm, i1, i2)
muutokset <- muutokset - i1_logml - i2_logml muutokset <- muutokset - i1_logml - i2_logml
return(muutokset) return(muutokset)
} }
)
)

163
man/greedyMix_muutokset.Rd Normal file
View file

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