Added functional learn_simple_partition
This commit is contained in:
parent
447875bd87
commit
27a296ad00
5 changed files with 115 additions and 0 deletions
|
|
@ -1,2 +1,3 @@
|
||||||
# Generated by roxygen2: do not edit by hand
|
# Generated by roxygen2: do not edit by hand
|
||||||
|
|
||||||
|
export(learn_simple_partition)
|
||||||
|
|
|
||||||
60
R/admix1-learn_simple_partition.R
Normal file
60
R/admix1-learn_simple_partition.R
Normal file
|
|
@ -0,0 +1,60 @@
|
||||||
|
#' @title Learn simple partition
|
||||||
|
#' @param ordered_points ordered_points
|
||||||
|
#' @param fii fii
|
||||||
|
#' @description Goes through all the ways to divide the points into two or
|
||||||
|
#' three groups. Chooses the partition which obtains highest logml.
|
||||||
|
#' @export
|
||||||
|
learn_simple_partition <- function(ordered_points, fii) {
|
||||||
|
npoints <- length(ordered_points)
|
||||||
|
|
||||||
|
# One cluster:
|
||||||
|
val <- calculatePopLogml(ordered_points, fii)
|
||||||
|
bestValue <- val
|
||||||
|
best_type <- 'single'
|
||||||
|
|
||||||
|
# Two clusters:
|
||||||
|
for (i in 1:(npoints - 1)) {
|
||||||
|
# The right endpoint of the first cluster.
|
||||||
|
val_1 <- calculatePopLogml(ordered_points[1:i], fii)
|
||||||
|
val_2 <- calculatePopLogml(ordered_points[(i + 1):length(ordered_points)], fii)
|
||||||
|
total <- val_1 + val_2
|
||||||
|
if (total > bestValue) {
|
||||||
|
bestValue <- total
|
||||||
|
best_type <- 'double'
|
||||||
|
best_i <- i
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Three clusters:
|
||||||
|
for (i in 1:(npoints - 2)) {
|
||||||
|
for (j in (i + 1):(npoints - 1)) {
|
||||||
|
val_1 <- calculatePopLogml(ordered_points[1:i], fii)
|
||||||
|
val_2 <- calculatePopLogml(ordered_points[(i + 1):j], fii)
|
||||||
|
val_3 <- calculatePopLogml(ordered_points[(j + 1):length(ordered_points)], fii)
|
||||||
|
total <- val_1 + val_2 + val_3
|
||||||
|
if (total > bestValue) {
|
||||||
|
bestValue <- total
|
||||||
|
best_type <- 'triple'
|
||||||
|
best_i <- i
|
||||||
|
best_j <- j
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
part = matrix(0, npoints, 1)
|
||||||
|
|
||||||
|
switch(best_type,
|
||||||
|
'single' = {
|
||||||
|
part <- matrix(1, npoints, 1)
|
||||||
|
},
|
||||||
|
'double' = {
|
||||||
|
part[1:best_i] <- 1
|
||||||
|
part[(best_i + 1):length(part)] <- 2
|
||||||
|
},
|
||||||
|
'triple' = {
|
||||||
|
part[1:best_i] <- 1
|
||||||
|
part[(best_i + 1):best_j] <- 2
|
||||||
|
part[(best_j + 1):length(part)] <- 3
|
||||||
|
})
|
||||||
|
return(part)
|
||||||
|
}
|
||||||
19
R/calculatePopLogml.R
Normal file
19
R/calculatePopLogml.R
Normal file
|
|
@ -0,0 +1,19 @@
|
||||||
|
#' @title Calculate log marginal likelihood
|
||||||
|
#' @description Calculates fuzzy (log) marginal likelihood for a population of
|
||||||
|
#' real values using estimate "fii" for the dispersion value, and Jeffreys prior
|
||||||
|
#' for the mean parameter.
|
||||||
|
#' @param points points
|
||||||
|
#' @param fii fii
|
||||||
|
calculatePopLogml <- function(points, fii) {
|
||||||
|
n <- length(points)
|
||||||
|
fuzzy_ones <- sum(points)
|
||||||
|
fuzzy_zeros <- n - fuzzy_ones
|
||||||
|
val = log(gamma(1)) -
|
||||||
|
log(gamma(1 + n / fii)) +
|
||||||
|
log(gamma(0.5 + fuzzy_ones / fii)) +
|
||||||
|
log(gamma(0.5 + fuzzy_zeros / fii)) -
|
||||||
|
log(gamma(0.5)) -
|
||||||
|
log(gamma(0.5))
|
||||||
|
return(val)
|
||||||
|
}
|
||||||
|
|
||||||
18
man/calculatePopLogml.Rd
Normal file
18
man/calculatePopLogml.Rd
Normal file
|
|
@ -0,0 +1,18 @@
|
||||||
|
% Generated by roxygen2: do not edit by hand
|
||||||
|
% Please edit documentation in R/calculatePopLogml.R
|
||||||
|
\name{calculatePopLogml}
|
||||||
|
\alias{calculatePopLogml}
|
||||||
|
\title{Calculate log marginal likelihood}
|
||||||
|
\usage{
|
||||||
|
calculatePopLogml(points, fii)
|
||||||
|
}
|
||||||
|
\arguments{
|
||||||
|
\item{points}{points}
|
||||||
|
|
||||||
|
\item{fii}{fii}
|
||||||
|
}
|
||||||
|
\description{
|
||||||
|
Calculates fuzzy (log) marginal likelihood for a population of
|
||||||
|
real values using estimate "fii" for the dispersion value, and Jeffreys prior
|
||||||
|
for the mean parameter.
|
||||||
|
}
|
||||||
17
man/learn_simple_partition.Rd
Normal file
17
man/learn_simple_partition.Rd
Normal file
|
|
@ -0,0 +1,17 @@
|
||||||
|
% Generated by roxygen2: do not edit by hand
|
||||||
|
% Please edit documentation in R/admix1-learn_simple_partition.R
|
||||||
|
\name{learn_simple_partition}
|
||||||
|
\alias{learn_simple_partition}
|
||||||
|
\title{Learn simple partition}
|
||||||
|
\usage{
|
||||||
|
learn_simple_partition(ordered_points, fii)
|
||||||
|
}
|
||||||
|
\arguments{
|
||||||
|
\item{ordered_points}{ordered_points}
|
||||||
|
|
||||||
|
\item{fii}{fii}
|
||||||
|
}
|
||||||
|
\description{
|
||||||
|
Goes through all the ways to divide the points into two or
|
||||||
|
three groups. Chooses the partition which obtains highest logml.
|
||||||
|
}
|
||||||
Loading…
Add table
Reference in a new issue