Refactored laskeMuutokset4() as an R6 method
This commit is contained in:
parent
06dd1a74ee
commit
1667682c5e
8 changed files with 113 additions and 58 deletions
|
|
@ -40,4 +40,4 @@ RoxygenNote: 7.2.1
|
||||||
Suggests:
|
Suggests:
|
||||||
testthat (>= 2.1.0)
|
testthat (>= 2.1.0)
|
||||||
Imports:
|
Imports:
|
||||||
methods, ape, vcfR, Rsamtools, adegenet, matlab2r
|
methods, ape, vcfR, Rsamtools, adegenet, matlab2r, R6
|
||||||
|
|
|
||||||
|
|
@ -15,7 +15,6 @@ export(greedyPopMix)
|
||||||
export(handleData)
|
export(handleData)
|
||||||
export(handlePopData)
|
export(handlePopData)
|
||||||
export(initPopNames)
|
export(initPopNames)
|
||||||
export(laskeMuutokset4)
|
|
||||||
export(learn_partition_modified)
|
export(learn_partition_modified)
|
||||||
export(learn_simple_partition)
|
export(learn_simple_partition)
|
||||||
export(linkage)
|
export(linkage)
|
||||||
|
|
@ -40,6 +39,7 @@ export(testaaOnkoKunnollinenBapsData)
|
||||||
export(testaaPop)
|
export(testaaPop)
|
||||||
export(writeMixtureInfo)
|
export(writeMixtureInfo)
|
||||||
export(writeMixtureInfoPop)
|
export(writeMixtureInfoPop)
|
||||||
|
importFrom(R6,R6Class)
|
||||||
importFrom(Rsamtools,scanBam)
|
importFrom(Rsamtools,scanBam)
|
||||||
importFrom(adegenet,.readExt)
|
importFrom(adegenet,.readExt)
|
||||||
importFrom(adegenet,read.genepop)
|
importFrom(adegenet,read.genepop)
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,8 @@
|
||||||
etsiParas <- function(osuus, osuusTaulu, omaFreqs, logml) {
|
etsiParas <- function(osuus, osuusTaulu, omaFreqs, logml) {
|
||||||
ready <- 0
|
ready <- 0
|
||||||
while (ready != 1) {
|
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
|
# Work around R's base::max() limitation on complex numbers
|
||||||
if (any(vapply(muutokset, class, vector("character", 1)) == "complex")) {
|
if (any(vapply(muutokset, class, vector("character", 1)) == "complex")) {
|
||||||
|
|
|
||||||
|
|
@ -3,12 +3,15 @@
|
||||||
#' muutos logml:ss? mikäli populaatiosta i siirretään osuuden verran
|
#' muutos logml:ss? mikäli populaatiosta i siirretään osuuden verran
|
||||||
#' todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään
|
#' todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään
|
||||||
#' siirrettävää, on vastaavassa kohdassa rivi nollia.
|
#' siirrettävää, on vastaavassa kohdassa rivi nollia.
|
||||||
|
#' @importFrom R6 R6Class
|
||||||
#' @param osuus Percentages?
|
#' @param osuus Percentages?
|
||||||
#' @param omaFreqs own Freqs?
|
|
||||||
#' @param osuusTaulu Percentage table?
|
#' @param osuusTaulu Percentage table?
|
||||||
|
#' @param omaFreqs own Freqs?
|
||||||
#' @param logml log maximum likelihood
|
#' @param logml log maximum likelihood
|
||||||
#' @export
|
admix1_muutokset <- R6Class(
|
||||||
laskeMuutokset4 <- function(osuus, osuusTaulu, omaFreqs, logml) {
|
classname = "admix1_muutokset",
|
||||||
|
public = list(
|
||||||
|
laskeMuutokset4 = function(osuus, osuusTaulu, omaFreqs, logml) {
|
||||||
if (isGlobalEmpty(COUNTS)) {
|
if (isGlobalEmpty(COUNTS)) {
|
||||||
npops <- 1
|
npops <- 1
|
||||||
} else {
|
} else {
|
||||||
|
|
@ -39,6 +42,9 @@ laskeMuutokset4 <- function(osuus, osuusTaulu, omaFreqs, logml) {
|
||||||
}
|
}
|
||||||
return(muutokset)
|
return(muutokset)
|
||||||
}
|
}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
# 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 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.
|
||||||
|
|
|
||||||
13
R/laskeVarmuus.R
Normal file
13
R/laskeVarmuus.R
Normal file
|
|
@ -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)
|
||||||
|
}
|
||||||
58
man/admix1_muutokset.Rd
Normal file
58
man/admix1_muutokset.Rd
Normal file
|
|
@ -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>}}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
@ -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.
|
|
||||||
}
|
|
||||||
|
|
@ -147,9 +147,9 @@ test_that("suoritaMuutos works like on Matlab", {
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("laskeMuutokset4 works like on Matlab", {
|
test_that("laskeMuutokset4 works like on Matlab", {
|
||||||
mx1 <- t(c(.4, 7))
|
x <- admix1_muutokset$new()
|
||||||
expect_equivalent(
|
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)),
|
expected = t(c(0, .3742)),
|
||||||
tol = .0001
|
tol = .0001
|
||||||
)
|
)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue