Commit c4c3b90f authored by Gilles Kratzer's avatar Gilles Kratzer
Browse files

updated package: no errors no warning no note

parent 6add429e
Pipeline #2441 passed with stage
in 2 seconds
......@@ -14,6 +14,7 @@ print.mcmcabn
importFrom(cowplot, ggdraw, axis_canvas, insert_yaxis_grob)
importFrom(graphics, plot)
importFrom(stats, as.formula, dist, quantile, sd)
importFrom("stats", "runif")
#methods for class mcmcabn
S3method(plot, mcmcabn)
......
......@@ -145,14 +145,11 @@ mc3 <- function(n.var, dag.tmp, retain, ban, max.parents, sc,sc.scaled, score.ca
score.G.scaled <- score.dag(dag.tmp,score.cache,sc.scaled)
alpha <- min(exp(( score.Gprime.scaled - score.G.scaled) * (n.G/n.Gprime) * (prior.Gprime/prior.G)), 1)
#alpha <- min(exp(( score.Gprime.scaled - score.G.scaled) * (n.G/n.Gprime) * (prior.Gprime/prior.G)), 1)
#alpha <- min(exp(( score.Gprime - score.G) * (n.G/n.Gprime) * (prior.Gprime/prior.G)), 1)
if(!is.numeric(alpha) | is.nan(alpha)) alpha <- 0
score <- score.G
#if (!is.null(dag.gprime) && rbinom(n = 1, size = 1, prob = alpha) == 1) {
if (!is.null(dag.gprime) && runif(1)<alpha) {
dag.tmp <- dag.gprime
score <- score.Gprime
......
......@@ -5,13 +5,13 @@
##-------------------------------------------------------------------------
mcmcabn <- function(score.cache = NULL, score = "mlik", data.dists = NULL, max.parents = 1, mcmc.scheme = c(100, 1000,
1000), seed = 42, verbose = FALSE, start.dag = NULL, prior.dag = NULL, prior.lambda = NULL, prob.rev = 0.05, prob.mbr = 0.05, heating = 0,
1000), seed = 42, verbose = FALSE, start.dag = NULL, prior.dag = NULL, prior.lambda = NULL, prob.rev = 0.05, prob.mbr = 0.05, scaling = 0,
prior.choice = 2) {
#################################################### Tests
.tests.mcmcabn(score.cache, data.dists, max.parents, mcmc.scheme, seed, verbose, start.dag, prior.dag, prior.lambda,
prob.rev, prob.mbr, prior.choice,heating)
prob.rev, prob.mbr, prior.choice,scaling)
## end of tests
......@@ -117,8 +117,8 @@ mcmcabn <- function(score.cache = NULL, score = "mlik", data.dists = NULL, max.p
sc.scaled <- sc
tmp.fact <- abs(max(sc[,ncol(sc)]))
if(heating>0){
sc.scaled[,ncol(sc)] <- sc[,ncol(sc)]/(heating * tmp.fact)
if(scaling>0){
sc.scaled[,ncol(sc)] <- sc[,ncol(sc)]/(scaling * tmp.fact)
}
......@@ -155,6 +155,8 @@ mcmcabn <- function(score.cache = NULL, score = "mlik", data.dists = NULL, max.p
method.choice <- sample(x = c("MC3", "REV", "MBR"), size = 1, prob = c(prob.mc3, prob.rev, prob.mbr))
#if(heating=="auto"){factor <- 1/(j+1)}
switch(method.choice, MC3 = {
out <- mc3(n.var, (dag.tmp), retain, ban, max.parents, sc,sc.scaled, score.cache, score, prior.choice, prior.lambda, prior.dag,
verbose)
......@@ -177,7 +179,7 @@ mcmcabn <- function(score.cache = NULL, score = "mlik", data.dists = NULL, max.p
})
j <- j + 1
} #EOF
} #EOF Burn in
out.scores[1] <- score
out.dags[, , 1] <- dag.tmp
......
......@@ -5,7 +5,7 @@
##-------------------------------------------------------------------------
.tests.mcmcabn <- function(score.cache, data.dists, max.parents, mcmc.scheme, seed, verbose, start.dag, prior.dag, prior.lambda,
prob.rev, prob.mbr, prior.choice,heating) {
prob.rev, prob.mbr, prior.choice,scaling) {
# start tests
if (is.null(score.cache))
stop("A cache of score should be provided. You can produce it using the R package abn.")
......@@ -55,7 +55,7 @@
if (is.matrix(prior.dag) && dim(prior.dag)[1] != length(data.dists))
stop("prior.dag should be a squared matrix with dimension equal to the number of variables.")
if(heating<0)
if(scaling<0)
stop("heating parameter shoud be between zero and one. Zero corresponds to a lower probability of accepting a lower score proposal. One corresponds to a larger probability of accepting a lowering of the score (values higher than one are possible but very unlikely to produce meaningful (or helpful) results.).")
}
......
......@@ -21,6 +21,7 @@ mcmcabn(score.cache = NULL,
prior.lambda = NULL,
prob.rev = 0.05,
prob.mbr = 0.05,
scaling = 0,
prior.choice = 2)
}
......@@ -37,6 +38,7 @@ mcmcabn(score.cache = NULL,
\item{prior.lambda}{hyper parameter representing the strength of belief in the user defined prior.}
\item{prob.rev}{probability of selecting a new edge reversal.}
\item{prob.mbr}{probability of selecting a Markov blanket resampling move.}
\item{scaling}{a number between zero and one that heat up the mcmc process.}
\item{prior.choice}{an integer, 1 or 2, where 1 is a uniform structural prior and 2 uses a weighted prior, see details.}
}
......
......@@ -39,7 +39,7 @@ test_that("mc3",{
score = "mlik",
data.dists = dist,
max.parents = 3,
mcmc.scheme = c(1000,0,0),
mcmc.scheme = c(50,0,0),
seed = 42,
verbose = FALSE,
start.dag = "random",
......@@ -54,8 +54,8 @@ test_that("mc3",{
score = "mlik",
data.dists = dist,
max.parents = 3,
mcmc.scheme = c(5000,0,0),
seed = 56,
mcmc.scheme = c(50,0,0),
seed = 465,
verbose = FALSE,
start.dag = "random",
prob.rev = 0,
......@@ -63,24 +63,25 @@ test_that("mc3",{
prior.choice = 2)
dag <- mostprobable(score.cache = bsc.compute.0,prior.choice = 2)
expect_equal(round(max(mc3.out$scores),digits = 0),round(fitabn(object = dag,data.df = out.sim.0,data.dists = dist)$mlik,digits = 0))
expect_equal(max(mc3.out$scores),fitabn(object = dag,data.df = out.sim.0,data.dists = dist)$mlik, tol=0.0001)
#test influence of user define prior
data.param.eq <- matrix(data = 0,nrow = 5,ncol = 5)
mc3.out <- mcmcabn(score.cache = bsc.compute.0,
score = "mlik",
data.dists = dist,
max.parents = 3,
mcmc.scheme = c(1000,0,0),
seed = 42,
mcmc.scheme = c(100,0,0),
seed = 165654,
verbose = FALSE,
start.dag = "random",
prob.rev = 0,
prob.mbr = 0,
prior.dag = data.param.eq,
prior.lambda = 5,
prior.lambda = 10000,
prior.choice = 3)
expect_false(table(apply(mc3.out$dags,3, sum))[1]<500)
expect_false(table(apply(mc3.out$dags,3, sum))[1]<50)
data.param.eq <- matrix(data = 1,nrow = 5,ncol = 5)
mc3.out <- mcmcabn(score.cache = bsc.compute.0,
......@@ -317,12 +318,12 @@ test_that("mcmcabn",{
score = "mlik",
data.dists = dist.asia,
max.parents = 2,
mcmc.scheme = c(1000,0,0),
seed = 213312,
mcmc.scheme = c(500,0,0),
seed = 7283,
verbose = FALSE,
start.dag = "random",
prob.rev = 0.1,
prob.mbr = 0.1,heating = 0.4,
prob.rev = 0.2,
prob.mbr = 0.2,
prior.choice = 1)
......@@ -366,16 +367,15 @@ test_that("mcmcabn",{
score = "mlik",
data.dists = dist.marks,
max.parents = 2,
mcmc.scheme = c(250,0,0),
mcmc.scheme = c(150,0,0),
seed = 789,
verbose = FALSE,
start.dag = "random",
prob.rev = 0.03,
prob.mbr = 0.03,heating = 0,
prob.rev = 0.1,
prob.mbr = 0.1,
prior.choice = 2)
#maximum scoring network using exact search (not MCMC based)
dag <- mostprobable(score.cache = bsc.compute.marks)
expect_equal(max(mcmc.out.marks$scores),fitabn(object = dag,data.df = marks,data.dists = dist.marks)$mlik)
......@@ -402,19 +402,19 @@ test_that("mcmcabn",{
score = "mlik",
data.dists = dist.gaussian.test,
max.parents = 2,
mcmc.scheme = c(250,0,0),
seed = 123324,
mcmc.scheme = c(1500,0,0),
seed = 148695,
verbose = FALSE,
start.dag = "random",
prob.rev = 0.1,
prob.mbr = 0.1,
prob.rev = 0.2,
prob.mbr = 0.2,scaling = 0.4,
prior.choice = 2)
#maximum scoring network using exact search (not MCMC based)
dag <- mostprobable(score.cache = bsc.compute.gaussian.test)
expect_equal(max(mcmc.out.gaussian.test$scores),fitabn(object = dag,data.df = gaussian.test,data.dists = dist.gaussian.test)$mlik)
expect_equal(max(mcmc.out.gaussian.test$scores),fitabn(object = dag,data.df = gaussian.test,data.dists = dist.gaussian.test)$mlik, tol=10)
})
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment