###############################################################################
# "Infection Rate Models for COVID-19:
#  Model Risk and Public Health News Sentiment Exposure Adjustments"
#
#  Ioannis Chalkiadakis, Kevin Hongxuan Yan, Gareth W. Peters, Pavel V. Shevchenko
#
#  Kevin Hongxuan Yan
#  March 2021
###############################################################################

rm(list=ls(all=TRUE))

library(methods)
library(rstan)

cat("Stan version:", stan_version(), "\n")
stanmodelcode <- "

#### define GP function
functions {

real normal_generalized_poisson_log(int y, real theta, real lambda, real sigob) {
    return (log(theta)
           + (y - 1) * log(theta + y * lambda)
           - lgamma(y + 1)
           - y * lambda
           - theta)*(y<=200)
           +(normal_lpdf(y|theta,sigob))*(y>200);

  }

}

#### define our data, integer value
data {
int<lower=0> N;
int y[N];
real E[N];
}

#### define parameters
parameters {

real lambda;
real u;
real b7;
real<lower=0> sig2;
vector[N] e;
real sigob;
}

#### define some parameters which is the function of other parameters
transformed parameters {
vector[N] mu;

### define the mean function

mu[1] <- y[1];  ## not tested

  for (n in 2:N) {

      mu[n] <- (mu[n-1]^b7)*exp(u+e[n]);

	  }

}

##### define piror and likelihood function
model {
lambda~uniform(-1,1);
u ~ normal(0.2,0.1);
b7 ~ normal(0.98,0.1);
sig2 ~  gamma(1,1);
e~normal(0,sig2);
sigob ~ uniform(100,1100);

for (j in 1:N) {

y[j] ~ normal_generalized_poisson( mu[j]*E[j], lambda, sigob);
}

}

#### calculate DIC
generated quantities {
vector[N] log_lik;
real dev; // deviance

  for (n in 1:N){
    log_lik[n] <- normal_generalized_poisson_log (y[n],mu[n]*E[n], lambda, sigob);
  }

  dev <- 0;
        for ( n in 1:N ) {
            dev <- dev + (-2) * normal_generalized_poisson_log (y[n],mu[n]*E[n], lambda, sigob);
        }

}

"

######

####### read new data Y
setwd("./covid19modelrisk/output/forecast")

##  y=read.csv("COVID-19_confirmed__Germany.csv")
##  y=read.csv("COVID-19_confirmed__Italy.csv")
##  y=read.csv("COVID-19_confirmed__Japan.csv")
##  y=read.csv("COVID-19_confirmed__Spain.csv")
##  y=read.csv("COVID-19_confirmed__United Kingdom.csv")
##  y=read.csv("COVID-19_confirmed__US.csv")
  y=read.csv("COVID-19_confirmed_Australia.csv")

y=y[,2]

E=rep(1,length(y))

N=length(y)
dat <- list(N = N, y = y,E=E)

#### initial values
inits =list(list(lambda=0,u=0.2,b7=0.98,sig2=0.0005,e=rep(0.01,N),sigob=1000))  ### 134

fit <- stan(model_code = stanmodelcode, model_name = "example",init =inits,
data = dat, warmup=10000,iter = 100000, chains = 1, seed=999,thin=1)
print(fit,digits = 4)

Epars_m <- apply( as.data.frame(fit@sim[[1]][[1]])[10001:100000,(6+N):(5+2*N)] , 2 , mean )

Epars_5 <- apply( as.data.frame(fit@sim[[1]][[1]])[10001:100000,(6+N):(5+2*N)] , 2 , quantile, probs=0.05 )

Epars_9 <- apply( as.data.frame(fit@sim[[1]][[1]])[10001:100000,(6+N):(5+2*N)] , 2 , quantile, probs=0.95 )

####################  trace plot

library(methods)
library(rstan)

name=c("Germany","Italy","Japan","Spain","U.K.","U.S.","Australia")
abn=c("GM","IT","JP","SP","UK","US","AU")

k=6

pdf(paste("M9_",abn[k],"_p1.pdf",sep=""), width = 16.5, height = 8.50)

traceplot(fit, pars=c("u","b7","lambda"), inc_warmup = T,  nrow = 3, ncol = 1, window = NULL, include = TRUE)

dev.off()

pdf(paste("M9_",abn[k],"_p2.pdf",sep=""), width = 16.5, height = 8.50)

traceplot(fit, pars=c("sigob","sig2"), inc_warmup = T,  nrow = 2, ncol = 1, window = NULL, include = TRUE)

dev.off()

##################   plot 30/45/60/   length(y)

Epars_m <- apply( as.data.frame(fit@sim[[1]][[1]])[10001:100000,(6+N):(5+2*N)] , 2 , mean )

Epars_5 <- apply( as.data.frame(fit@sim[[1]][[1]])[10001:100000,(6+N):(5+2*N)] , 2 , quantile, probs=0.05 )

Epars_9 <- apply( as.data.frame(fit@sim[[1]][[1]])[10001:100000,(6+N):(5+2*N)] , 2 , quantile, probs=0.95 )

pdf(paste("M9_",abn[k],"_30.pdf",sep=""), width = 16.5, height = 8.50)

m=30

newx=c(1:m)
par(cex.axis=2.5,cex.lab=2.5,cex.main=2.5,mar=c(5, 5, 3, 0.5))
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)

polygon(c(rev(newx), newx), c(rev(Epars_9[1:m]), Epars_5[1:m]), col = "grey80", border = NA)

lines(newx,Epars_9[1:m], lty = 'dashed', col = 'red',lwd = 2)
lines(newx, Epars_5[1:m], lty = 'dashed', col = 'red',lwd = 2)
par(new=TRUE)
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)
plot.ts(Epars_m[1:m],col="red",ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),lwd = 2)

dev.off()

pdf(paste("M9_",abn[k],"_45.pdf",sep=""), width = 16.5, height = 8.50)

m=45

newx=c(1:m)
par(cex.axis=2.5,cex.lab=2.5,cex.main=2.5,mar=c(5, 5, 3, 0.5))
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)

polygon(c(rev(newx), newx), c(rev(Epars_9[1:m]), Epars_5[1:m]), col = "grey80", border = NA)

lines(newx,Epars_9[1:m], lty = 'dashed', col = 'red',lwd = 2)
lines(newx, Epars_5[1:m], lty = 'dashed', col = 'red',lwd = 2)
par(new=TRUE)
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)
plot.ts(Epars_m[1:m],col="red",ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),lwd = 2)

dev.off()

pdf(paste("M9_",abn[k],"_60.pdf",sep=""), width = 16.5, height = 8.50)

m=60

newx=c(1:m)
par(cex.axis=2.5,cex.lab=2.5,cex.main=2.5,mar=c(5, 5, 3, 0.5))
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)

polygon(c(rev(newx), newx), c(rev(Epars_9[1:m]), Epars_5[1:m]), col = "grey80", border = NA)

lines(newx,Epars_9[1:m], lty = 'dashed', col = 'red',lwd = 2)
lines(newx, Epars_5[1:m], lty = 'dashed', col = 'red',lwd = 2)
par(new=TRUE)
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)
plot.ts(Epars_m[1:m],col="red",ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),lwd = 2)

dev.off()

pdf(paste("M9_",abn[k],"_all.pdf",sep=""), width = 16.5, height = 8.50)

m=length(y)

newx=c(1:m)
par(cex.axis=2.5,cex.lab=2.5,cex.main=2.5,mar=c(5, 5, 3, 0.5))
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)

polygon(c(rev(newx), newx), c(rev(Epars_9[1:m]), Epars_5[1:m]), col = "grey80", border = NA)

lines(newx,Epars_9[1:m], lty = 'dashed', col = 'red',lwd = 2)
lines(newx, Epars_5[1:m], lty = 'dashed', col = 'red',lwd = 2)
par(new=TRUE)
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)
plot.ts(Epars_m[1:m],col="red",ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),lwd = 2)

dev.off()

########    log plot          ####################################################

k=1

name=c("Germany","Italy","Japan","Spain","U.K.","U.S.","Australia")
abn=c("GM","IT","JP","SP","UK","US","AU")

Epars_m <- apply( as.data.frame(fit@sim[[1]][[1]])[10001:100000,(6+N):(5+2*N)] , 2 , mean )

Epars_5 <- apply( as.data.frame(fit@sim[[1]][[1]])[10001:100000,(6+N):(5+2*N)] , 2 , quantile, probs=0.05 )

Epars_9 <- apply( as.data.frame(fit@sim[[1]][[1]])[10001:100000,(6+N):(5+2*N)] , 2 , quantile, probs=0.95 )

y=log(y)
Epars_m=log(Epars_m)
Epars_9=log(Epars_9)
Epars_5=log(Epars_5)

setwd("./covid19modelrisk/output/plot")

pdf(paste("M9_",abn[k],"_log.pdf",sep=""), width = 16.5, height = 8.50)

m=length(y)

newx=c(1:m)
par(cex.axis=2.5,cex.lab=2.5,cex.main=2.5,mar=c(5, 5, 3, 0.5))
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)

polygon(c(rev(newx), newx), c(rev(Epars_9[1:m]), Epars_5[1:m]), col = "grey80", border = NA)

lines(newx,Epars_9[1:m], lty = 'dashed', col = 'red',lwd = 2)
lines(newx, Epars_5[1:m], lty = 'dashed', col = 'red',lwd = 2)
par(new=TRUE)
plot(y[1:m],ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),pch=19)
par(new=TRUE)
plot.ts(Epars_m[1:m],col="red",ylim=c(min(y[1:m]),max(y[1:m],Epars_9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M9 model for ",name[k],sep=""),lwd = 2)

dev.off()

#####################################################################################################################################################
######################################      forecast          ###################################

GP.r <- function(L, s)
{

v=0
Lp=exp(log(L)+ (v - 1) * log(L + v * s) - v * s - L - lgamma(v + 1))
sLp=Lp

# calculate the vector of cum pmf
v=1
while((sLp<0.9999999) & ((L + v * s )> 0))
{Lp1=exp(log(L)+ (v - 1) * log(L + v * s) - v * s - L - lgamma(v + 1))
Lp=c(Lp,Lp1)
sLp=sLp+Lp1
v=v+1
}

csLp=c(cumsum(Lp),1) ##### add a max for it
x=length(Lp)

# first check if you are in the first interval

U = runif(1)
B = FALSE
i = 1

while(B == FALSE) {

  if(U > csLp[i])  ### U may greater than max of csLp if do not set 1
    { i=i+1}
  else
    {X=i-1
     B=TRUE}

}

return(X)

}

################################################ as.data.frame(fit@sim[[1]][[1]])[1,]

P=20
Mu=matrix(,nrow=90000,ncol=P)
X=matrix(,nrow=90000,ncol=P)

lambda_p=as.data.frame(fit@sim[[1]][[1]])[10001:100000,1]
u_p=as.data.frame(fit@sim[[1]][[1]])[10001:100000,2]
b7_p=as.data.frame(fit@sim[[1]][[1]])[10001:100000,3]
sig2_p=as.data.frame(fit@sim[[1]][[1]])[10001:100000,4]

set.seed(999)

for (r in 1:90000){

Mu[r,1]=y[length(y)]
for (s in 1:(P-1) ){

e=rnorm(1,0,sig2_p[r])

Mu[r,s+1]=(Mu[r,s]^b7_p[r])*exp(u_p[r]+e)
}}

sigob=1000
for (r in 1:90000){
for (s in 1:P ){

X[r,s]=rnorm(1,Mu[r,s], sigob)

}}

#for (r in 1:90){
#for (s in 1:P ){
#X[r,s]=GP.r(Mu[r,s]*(1-lambda_p[r]), lambda_p[r])
#}}

#X=Mu

Xm=apply(X,2,mean)

X5 <- apply( X , 2 , quantile, probs=0.05 )

X9 <- apply( X , 2 , quantile, probs=0.95 )

Zm=c(y,Xm)
Z5=c(y,X5)
Z9=c(y,X9)

k=3

name=c("Germany","Italy","Japan","Spain","U.K.","U.S.","Australia")
abn=c("GM","IT","JP","SP","UK","US","AU")

m=length(Zm)

setwd("./covid19modelrisk/output/forecast")
pdf(paste("M9_",abn[k],"_F.pdf",sep=""), width = 16.5, height = 8.50)

newx=c(1:m)
par(cex.axis=2.5,cex.lab=2.5,cex.main=2.5,mar=c(5, 5, 3, 0.5))
plot(Zm[1:m],ylim=c(min(Zm[1:m]),max(Zm[1:m],Z9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M2 model for ",name[k],sep=""),pch=19)
par(new=TRUE)

polygon(c(rev(newx), newx), c(rev(Z9[1:m]), Z5[1:m]), col = "grey80", border = NA)

lines(newx,Z9[1:m], lty = 'dashed', col = 'red',lwd = 2)
lines(newx, Z5[1:m], lty = 'dashed', col = 'red',lwd = 2)
par(new=TRUE)
plot(Zm[1:m],ylim=c(min(Zm[1:m]),max(Zm[1:m],Z9[1:m])),ylab="Count",xlab="Time",main=paste("In-sample fit results of M2 model for ",name[k],sep=""),pch=19)

dev.off()

###########################################################################################################################

n=length(y)

u=0.2
b7=0.98

x=c()
x[1]=100
for (i in 1:(n-1) ){

x[i+1]=(x[i]^b7)*exp(u)
}
x=round(x)
x

plot(y,ylim=c(min(y,x),max(y,x)))
par(new=TRUE)
plot(x,col="red",ylim=c(min(y,x),max(y,x)))

#############################################################
##### GM

u=0.25
b7=0.98

##### IT

u=0.25
b7=0.98

##### JP
u=0.21
b7=0.98

##### SP
u=0.25
b7=0.98

##### UK
u=0.25
b7=0.98

##### US
u=0.3
b7=0.98

##### AU
u=0.2
b7=0.98


ibp = function(n, a) {

  dishes = max(1, rpois(1, a))
  diners = data.frame(dish = seq(dishes), diners = rep(1, dishes))
  buffet = list(buffet = diners, choices = list(seq(dishes)))

  for (j in seq(n - 1)) {
      buffet = arrival(buffet, a)
    }
  buffet
  }

arrival = function(b, a) {
  config  = b$buffet
  existing_choices = b$choices
  j = length(existing_choices) + 1
  n = nrow(config)

  num_new_dishes = rpois(1, a / j)
  new_dishes     =
      if (num_new_dishes > 0) {
        (n + 1):(n + num_new_dishes)
      } else {
        numeric(0)
      }

  probs     = sapply(config$diners, function(n) { n / j })
  selection = rbinom(n, 1, prob = probs) == 1
  choices   = list(c(as.integer(row.names(config[selection,])), new_dishes))
  diners    = with(config, replace(diners, selection, diners[selection] + 1))

  buffet = data.frame(
      dish   = seq(n + num_new_dishes)
    , diners = c(diners, rep(1, num_new_dishes))
    )

  list(buffet = buffet, choices = c(existing_choices, choices))
  }

ibp_matrix = function(buffet) {
  dishes = do.call(max, buffet$choices)
  index  = function(j) { as.numeric(seq(dishes) %in% j) }
  rows   = lapply(buffet$choices, index)

  do.call(rbind, rows)
  }


# boot.r  -  very simple code used to generate the 500 bootstrap
#  samples from the lab 1 exercise.

lab2bigd <- lab2bigr <- rep(0,500)
a <- lab1$Y[1:10]    # data from group A
b <- lab1$Y[11:20]   # data from group B

for (i in 1:500) {
   ma <- mean(sample(a,10,repl=T));
   mb <- mean(sample(b,10,repl=T))

   lab2bigd[i] <- mb - ma;
   lab2bigr[i] <- mb/ma;
   }

lab2bigd <- sort(lab2bigd)
lab2bigr <- sort(lab2bigr)

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/boot.r


#' Converts a correlation metric (rho) to a z-score
#'
#' @param rho  A Pearson's r
#' @return     A z-score
fisher_r2z = function(rho) 0.5 * log((1 + rho)/(1 - rho))

#' Tests for significant correlations in a population
#'
#' @param mat  A sample matrix with [obs x samples]
#' @return     A matrix with p-values
test = function(mat, self=0) {
    mat = as.matrix(mat)
    n = ncol(mat)
    p.mat = matrix(NA, n, n, dimnames=dimnames(mat)[c(2,2)])
    diag(p.mat) = self
    for (i in 1:(n - 1))
        for (j in (i + 1):n)
            p.mat[i,j] = p.mat[j,i] = cor.test(mat[,i], mat[,j])$p.value
    p.mat
}

#' Tests for significant changes in correlation between two populations
#'
#' TODO: all stat tests should return a data.frame
#'
#' @param x  A sample matrix with [obs x variables]
#' @param y  A samples matrix with [obs x variables]
#' @param return_cor  Return cor matrices of x and y (default: FALSE)
#' @param pad  Pad cor(x/y) assuming zero correlation
#' @return   A symmetric matrix of p-values [variables x variables]
diff_test = function(x, y, return_cor=FALSE, pad=FALSE) {
    if (pad) {
        cboth = narray::stack(list(x=cor(x), y=cor(y)), along=3, fill=0)
        corx = cboth[,,"x"]
        cory = cboth[,,"y"]
    } else {
        narray::intersect(x, y, along=2)
        corx = cor(x)
        cory = cor(y)
    }
    delta_cor = cory - corx

    za = fisher_r2z(corx)
    zb = fisher_r2z(cory)

    na = narray::rrep(apply(x, 2, function(x) sum(!is.na(x))), ncol(x))
    nb = narray::rrep(apply(y, 2, function(x) sum(!is.na(x))), ncol(y))

    se = sqrt((1/(na-3))+(1/(nb-3)))
    z = (za-zb)/se

    pval = 2*pnorm(-abs(z))

    if (return_cor)
        list(x=corx, y=cory, delta_cor = delta_cor, p.value = pval)
    else
        list(delta_cor = delta_cor, p.value = pval)
}


counting_sort <- function(arr, minval, maxval) {
  r <- arr
  z <- 1
  for(i in minval:maxval) {
    cnt = sum(arr == i)
    while(cnt > 0) {
      r[z] = i
      z <- z + 1
      cnt <- cnt - 1
    }
  }
  r
}

# 140+1 instead of 140, since random numbers generated
# by runif are always less than the given maximum;
# floor(a number at most 140.9999...) is 140
ages <- floor(runif(100, 0, 140+1))
sorted <- counting_sort(ages, 0, 140)
print(sorted)


#  Calculating a Confidence Interval From a Normal Distribution
n<-50
a<-27.3
s<-12.1
#  we will use a 99% confidence level and wish to find the confidence interval
margin <- qnorm(0.995)*s/sqrt(n)
left_i <- a-margin
right_i <- a+margin
print("Confidence interval is")
print(left_i)
print(right_i)


# Program to find the H.C.F of two input number
# define a function
hcf <- function(x, y) {
# choose the smaller number
if(x > y) {
smaller = y
} else {
smaller = x
}
for(i in 1:smaller) {
if((x %% i == 0) && (y %% i == 0)) {
hcf = i
}
}
return(hcf)
}
# take input from the user
num1 = as.integer(readline(prompt = "Enter first number: "))
num2 = as.integer(readline(prompt = "Enter second number: "))
print(paste("The H.C.F. of", num1,"and", num2,"is", hcf(num1, num2)))


#Simulate positions for n=8 sities
pos <- read.table("optimaltransport.ascii",header=F)
p = nrow(pos)
set.seed(345)
par(mfrow=c(1,1))
plot(pos)
dev.copy2pdf(file="../doc/example_trav_sale.pdf")

#Calculate pairwise distances between cities
d = as.matrix((dist(pos,diag=TRUE,upper=TRUE)))
#Convert to vector in order to access many components at a time
d = as.vector(d)

#Perform neighbor search, simulated annealing
#Random inizialization
#We implement the fact that the distribution must start and finish at home town
theta = c(1, sample(2:p,p-1), 1)

#Convert sequential pairs into index in the d-vector
ind = (theta[-p]-1)*p+theta[-1]
#Calculate total distance of order
V = sum(d[ind])
Vseq = V
Numit=50000
for(i in 1:Numit)
{
  tau = 100/i
  #tau = 1/log(i+1)
  #tau <- (0.8 + i/Numit/10)*tau
  #we never change the position of index=1 (home)
  ind2 = sample(2:p,2,replace=F)
  theta2 = theta
  theta2[ind2[1]] = theta[ind2[2]]
  theta2[ind2[2]] = theta[ind2[1]]
  ind2 = (theta2[-p]-1)*p+theta2[-1]
  V2 = sum(d[ind2])
  prob = exp((V-V2)/tau)
  u = runif(1)
  if(u<prob)
  {
    theta = theta2
    V = V2
  }
  Vseq = c(Vseq,V)
}
#par(mfrow=c(2,1),mar=c(0.5,1,0.5,1))
plot(pos)
lines(pos[theta,1],pos[theta,2])
points(pos[1,1],pos[1,2], type = 'o', col = 'red')
#dev.copy2pdf(file="../doc/example_trav_sale_SA.pdf")
plot.ts(Vseq)
show(min(Vseq))


#################################################################
#################################################################
#	Code for Project for the Mathematical Modelling module 	#
#	Author:Gianpiero Cea                                   	#
#################################################################
#
#################################################################
# First we install all the required packages.
# This should work but if there are any problems refer
# to the individual documentations
#################################################################
print('Install all required packages')

install.packages("mlbench")
install.packages("Amelia")
install.packages("bnlearn")
install.packages("BDgraph")
install.packages("corrplot")
install.packages("caret")

#################################################################
# Importing all the required libraries
#################################################################
print('#########################################################')
print('Part 0: Importing all libraries that we need')

#Part 0: Importing all libraries that we need:
#mlbench used to import the dataset
library(mlbench)
#used to do imputation of the values
library(Amelia)
#main library to work with Bayesian Network
library(bnlearn)
#possibly used for indirected graphs
library(BDgraph)
#used to plot a correlation plot
library(corrplot)
#used to test accuracy and other metric of models
library(caret)

##################################################################
# Cleaning the data
##################################################################
print('#########################################################')
print('Part 1: Cleaning Data: imputation/omission, visualisation')

# Part 1: Cleaning Data: imputation/omission, visualisation

# save the data in dataframe df
data(BreastCancer)
df <- BreastCancer
# check the missing values, OUTPUT: 16 NA's in 'Bare.nuclei'
summary(df)

#Omitting missing values
df.omit = na.omit(df)

#Imputing missing values
print('Imputing missing values')
## Using Amelia II:
print('Imputing values using Amelia II...')
#to.nom(df) turns a df of factors into a df of numerical values
to.nom <-function(df){
  df2 <- data.matrix(df)
  df2 <- data.frame(df2)
  return(df2)
}
df.num <- to.nom(df)
#to use amelia we can't use factors
res = amelia(df.num)
df.imputed <-df
df.imputed$Bare.nuclei <- as.factor(abs(floor(res$imputations[[1]]$Bare.nuclei)))
#we can have a comparison of our data before and after imputations
print('Comparison of the data before and after Amelia imputations')
summary(df)
summary(df.imputed)

## Using structural.em to impute data, learn from missing data
print('Imputing values using structural.em')
res<-structural.em(df[,2:11],return.all=TRUE)
df.imputed2 <- res$imputed
bn.fit.missing <-res$fitted
bn.missing <- res$dag

# Data correlation
print('Visualising correlation plot')
bc = cor(na.omit(df.num)[,2:11]) #create an object of the features
corrplot.mixed(bc)

#Split the data , p%-(1-p)%
	split <- function(df,p){
	a = floor(nrow(df)*(p/100))
	df.train <- df[1:a,]
	df.test <- df[(a+1):nrow(df),]
	return(list(train =df.train,test =df.test))
	}

df.omit.train <- split(df.omit[,2:11],20)$train
df.omit.test <- split(df.omit[,2:11],20)$test

df.imputed.train <- split(df.imputed[,2:11],20)$train
df.imputed.test <- split(df.imputed[,2:11],20)$test

df.imputed2.train <- split(df.imputed2,20)$train
df.imputed2.test <- split(df.imputed2,20)$test
##################################################################
# Structure learning
#################################################################
print('#########################################################')
print('Structural learning')
# Part 2: Structure Learning

#the following functions applies several algorithms  to the data and returns
#the structure learned
struc.learn <- function(df){
	#Classifiers

	bn.naive.bayes <- naive.bayes(df,"Class")
	bn.tree.bayes <- tree.bayes(df,"Class")

	#Score Based
	bn.hc <-hc(df)
	bn.tabu <-tabu(df)

	#Constraint Based
	#here we give the option parameter test
	bn.gs <- gs(df)
	bn.iamb <-iamb(df)
	bn.fast.iamb <- fast.iamb(df)
	bn.inter.iamb <-inter.iamb(df)
	bn.mmpc <- mmpc(df)
	bn.si.hiton.pc <- si.hiton.pc(df)

	return(list(naive.bayes = bn.naive.bayes,tree.bayes = bn.tree.bayes, hc = bn.hc,tabu=bn.tabu, gs=bn.gs,iamb =bn.iamb,fast.iamb =bn.fast.iamb,mmpc=bn.mmpc,si.hiton.pc=bn.si.hiton.pc))
}

# Here we do strucutural learning for the three different datasets
# ...omit, imputed and imputed2

structures.omit <- struc.learn(df.omit.train)
#we also had the bn learned from the missing data!
structures.omit[[length(structures.omit)+1]] <- bn.missing
print('Structures learnt for omit dataset')

structures.imputed <-struc.learn(df.imputed.train)
print('Structures learnt for imputed dataset')

structures.imputed2 <- struc.learn(df.imputed2.train)
print('Structures learnt for imputed2 dataset')

# We plot all the different structures learned for structures.omit
par(mfrow=c(3,3))
for(i in 1:9){plot(structures.omit[[i]],main=names(structures.omit)[[i]])}
plot(structures.omit[[10]],main=names(structures.omit)[[10]])

# We plot all the different structures learned for structures.imputed
par(mfrow=c(3,3))
for(i in 1:9){plot(structures.imputed[[i]],main=names(structures.imputed)[[i]])}

# We plot all the different structures learned for structures.imputed2
par(mfrow=c(3,3))
for(i in 1:9){plot(structures.imputed2[[i]],main=names(structures.imputed2)[[i]])}

##Compare the hc and tabu graph. OUTPUT: they are the same
compare(structures.imputed2$hc,structures.imputed2$tabu)
##Get a string representing the model:
##OUTPUT:"[Cell.size][Class|Cell.size][Cl.thickness|Class][Cell.shape|Class][Marg.adhesion|Class][Epith.c.size|Class][Bare.nuclei|Class][Bl.cromatin|Class][Normal.nucleoli|Class][Mitoses|Class]"
modelstring(structures.imputed2$tabu)

# Compare graphically the structures
graphviz.compare(structures.omit$naive.bayes,structures.omit$tree.bayes)
##################################################################
# Parameter learning
##################################################################
print('#########################################################')
print('Part 3: Parameter Learning')
# Part 3: Parameter Learning
## Maximum Likelihood Estimate
#we pick an ordering of the variables to assign a direction to the Constraint
#based structures (gs,iamb...)
ordering = node.ordering(structures.imputed2$tree.bayes)
#lapply({function(x)pdag2dag(structures.omit$x,names(df.omit.train))},df.omit.train[4:9])
#bn.fit.omit <-lapply({function(dag)bn.fit(dag,method='mle')},structures.omit)
 gs<-pdag2dag(structures.omit$gs,ordering)
 iamb<-pdag2dag(structures.omit$iamb,ordering)
 fast.iamb<-pdag2dag(structures.omit$fast.iamb,ordering)
 mmpc<-pdag2dag(structures.omit$mmpc,ordering)
 si.hiton.pc<-pdag2dag(structures.omit$si.hiton.pc,ordering)

structures.omit$gs = gs
structures.omit$iamb = iamb
structures.omit$fast.iamb = fast.iamb
structures.omit$mmpc = mmpc
structures.omit$si.hiton.pc = si.hiton.pc

structures.imputed2$gs = gs
structures.imputed2$iamb = iamb
structures.imputed2$fast.iamb = fast.iamb
structures.imputed2$mmpc = mmpc
structures.imputed2$si.hiton.pc = si.hiton.pc

structures.imputed$gs = gs
structures.imputed$iamb = iamb
structures.imputed$fast.iamb = fast.iamb
structures.imputed$mmpc = mmpc
structures.imputed$si.hiton.pc = si.hiton.pc

#Parameter Learning for omit data
bn.fit.omit <-lapply(structures.omit,{function(dag)bn.fit(dag,method='mle',data=df.omit.train)})
bn.fit.omit.bayes <-lapply(structures.omit,{function(dag)bn.fit(dag,method='bayes',data=df.omit.train)})
#Parameter Learning for imputed data
bn.fit.imputed <-lapply(structures.imputed,{function(dag)bn.fit(dag,method='mle',data=df.imputed.train)})
bn.fit.imputed.bayes <-lapply(structures.imputed,{function(dag)bn.fit(dag,method='bayes',data=df.imputed.train)})
#Parameter Learning for imputed2 data
bn.fit.imputed2 <-lapply(structures.imputed2,{function(dag)bn.fit(dag,method='mle',data=df.imputed2.train)})
bn.fit.imputed2.bayes <-lapply(structures.imputed2,{function(dag)bn.fit(dag,method='bayes',data=df.imputed2.train)})

#Visualise as an example one of the node Conditional probability table:
bn.fit.barchart(bn.fit.imputed2$tabu$Cl.thickness)

##################################################################
# Accuracy comparison & Inference
##################################################################
print('#########################################################')
print('Part 4: Accuracy comparison & Inference')
# Part 4: Accuracy comparison & Inference
# gets the predictions on the three kinds of test sets (omit,imputed, imputed2)
predicted.omit <- lapply(bn.fit.omit,{function(fit)predict(fit, node = "Class", data = df.omit.test)})
predicted.omit.bayes <- lapply(bn.fit.omit.bayes,{function(fit)predict(fit, node = "Class", data = df.omit.test)})

predicted.imputed <- lapply(bn.fit.imputed,{function(fit)predict(fit, node = "Class", data = df.imputed.test)})
predicted.imputed.bayes <- lapply(bn.fit.imputed.bayes,{function(fit)predict(fit, node = "Class", data = df.imputed.test)})

predicted.imputed2 <- lapply(bn.fit.imputed,{function(fit)predict(fit, node = "Class", data = df.imputed.test)})
predicted.imputed2.bayes <- lapply(bn.fit.imputed.bayes,{function(fit)predict(fit, node = "Class", data = df.imputed2.test)})

#print everything
##############################################################################
print('imputed')
for(i in 1:9){
	print(names(predicted.imputed)[[i]])
	print(confusionMatrix(unlist(predicted.imputed[i]),unlist(df.imputed.test$Class)))
}
for(i in 1:9){
	print(names(predicted.imputed.bayes)[[i]])
	print(confusionMatrix(unlist(predicted.imputed.bayes[i]),unlist(df.imputed.test$Class)))
}
##############################################################################
print('omit')
for(i in 1:10){
	print(names(predicted.omit)[[i]])
	print(confusionMatrix(unlist(predicted.omit[i]),unlist(df.omit.test$Class)))
}
for(i in 1:10){
	print(names(predicted.omit.bayes)[[i]])
	print(confusionMatrix(unlist(predicted.omit.bayes[i]),unlist(df.omit.test$Class)))
}
##############################################################################
print('imputed2')
for(i in 1:9){
	print(names(predicted.imputed2)[[i]])
	print(confusionMatrix(unlist(predicted.imputed2[i]),unlist(df.imputed2.test$Class)))
}
for(i in 1:9){
	print(names(predicted.imputed2.bayes)[[i]])
	print(confusionMatrix(unlist(predicted.imputed2.bayes[i]),unlist(df.imputed2.test$Class)))
}

#Approximate inference

#example: What is the probability that the tumor is malignant if we a Cell.size
#of 4 and Bare.nuclei of 2

#we need to repeat since the function cpquery is stochastic

l<-vector("list", 2000)
for( i in 1:2000)
{
l[i] <- cpquery(bn.fit.imputed$naive.bayes,event=(Class == "malignant"),evidence=(Cell.size=="4")&(Bare.nuclei=="2"))
}

mean(as.numeric(l))
############################################################################
# UNDIRECTED GRAPH:

library(BDgraph)
#problem with bigger iter
 res<-bdgraph(df.imputed2,method ="gcgm", iter= 100, print = 10)
summary(res)

#we can also learn another structure using Marginal Pseudo Likelihhod
res2<-bdgraph.mpl(df.imputed2,iter= 1000)
summary(res2)

#################################################################


# load packages needed to run this code
library(tidyverse)
library(cowplot)
library(gganimate)
library(magick)

# this function calculates true positive rate and false positive rate to make an ROC curve
calc_ROC <- function(probabilities, known_truth, model.name = NULL) {
  outcome <- as.numeric(factor(known_truth)) - 1
  pos <- sum(outcome) # total known positives
  neg <- sum(1 - outcome) # total known negatives
  pos_probs <- outcome * probabilities # probabilities for known positives
  neg_probs <- (1 - outcome) * probabilities # probabilities for known negatives
  true_pos <- sapply(
    probabilities,
    function(x) sum(pos_probs >= x) / pos
  ) # true pos. rate
  false_pos <- sapply(
    probabilities,
    function(x) sum(neg_probs >= x) / neg
  )
  if (is.null(model.name)) {
    result <- data.frame(true_pos, false_pos)
  } else {
    result <- data.frame(true_pos, false_pos, model.name)
  }

  result %>% add_row(true_pos = 0, false_pos = 0) %>% arrange(false_pos, true_pos)
}

# this function calculates precision and recall
calc_PR <- function(probabilities, known_truth, model.name = NULL) {
  outcome <- as.numeric(factor(known_truth)) - 1
  pos <- sum(outcome) # total known positives
  pos_probs <- outcome * probabilities # probabilities for known positives
  neg_probs <- (1 - outcome) * probabilities # probabilities for known negatives
  recall <- sapply(
    probabilities,
    function(x) sum(pos_probs >= x) / pos
  )
  precision <- sapply(
    probabilities,
    function(x) sum(pos_probs >= x) / (sum(pos_probs >= x) + sum(neg_probs >= x))
  )
  if (is.null(model.name)) {
    result <- data.frame(precision, recall)
  } else {
    result <- data.frame(precision, recall, model.name)
  }

  result %>% arrange(recall, desc(precision))
}
# set seed to reproduce the given results
set.seed(1234)

# simulate predictor values for 2 different outcomes
# predictors will be normally distributed
# two classes are balanced at time 1
outcome1 <- data.frame(predictor = rnorm(1000, mean = -5, sd = 5), outcome = 1, time = 1)
outcome2 <- data.frame(predictor = rnorm(1000, mean = 5, sd = 5), outcome = 2, time = 1)
outcome1 %>% rbind(outcome2) -> df_t1

# two classes are imbalanced at time 2
outcome1 <- outcome1 %>% mutate(time = 2)
outcome2 <- data.frame(predictor = rnorm(50, mean = 5, sd = 5), outcome = 2, time = 2)
outcome1 %>% rbind(outcome2) -> df_t2

# combine the two datasets
rbind(df_t1, df_t2) -> anim_data

# make an animation with distributions of linear predictors
p_dist <- ggplot(anim_data) +
  geom_density(aes(x = predictor, fill = factor(outcome), stat(count)), alpha = 0.7, color = NA) +
  geom_hline(yintercept = 0, color = "black", size = 0.5, linetype = 2) +
  scale_x_continuous(limits = c(-30, 30)) +
  scale_fill_manual(values = c("#C04A56", "#3D8CF1")) +
  transition_states(time, transition_length = 1, state_length = 1) +
  ggtitle(" ") + # adding an emtpy title to align y axis with ROC plot
  theme_cowplot() +
  theme(legend.position = "none")

# calculate ROC curves and AUC values
anim_data %>%
  mutate(probabilities = exp(predictor) / (1 + exp(predictor))) %>% # calculate probabilities for linear predictors
  group_by(time) %>%
  do(results = calc_ROC(
    probabilities = .$probabilities, # calculate TP rate and FP rate for every possible cutoff
    known_truth = .$outcome
  )) %>%
  group_by(time) %>%
  do(as.data.frame(.$results)) %>% # store output from calc_ROC() in the data frame
  mutate(delta = false_pos - lag(false_pos)) %>% # calculate AUC values
  mutate(AUC = sprintf("%.3f", sum(delta * true_pos, na.rm = T))) -> ROC

# reverse factor in `AUC` variable so the AUC values match to the timing of the animation
ROC$AUC <- fct_inorder(ROC$AUC)

# calculate precision-recall curves
anim_data %>%
  mutate(probabilities = exp(predictor) / (1 + exp(predictor))) %>% # calculate probabilities for linear predictors
  group_by(time) %>%
  do(results = calc_PR(
    probabilities = .$probabilities, # calculate precision and recall
    known_truth = .$outcome
  )) %>%
  group_by(time) %>%
  do(as.data.frame(.$results)) -> PR

# make an animation with ROC curves
p_ROC <- ggplot(data = ROC, aes(x = false_pos, y = true_pos)) +
  geom_line(size = 1) +
  geom_abline(intercept = 0, slope = 1) +
  transition_states(AUC, transition_length = 1, state_length = 1) +
  labs(title = "AUC = {closest_state}") +
  scale_x_continuous(name = "false positive rate") +
  scale_y_continuous(name = "true positive rate") +
  theme_cowplot()

# make an animation with precision-recall curves
p_PR <- ggplot(data = PR, aes(x = recall, y = precision)) +
  geom_line(size = 1) +
  transition_states(time, transition_length = 1, state_length = 1) +
  scale_x_continuous(limits = c(0, 1)) +
  scale_y_continuous(limits = c(0, 1)) +
  ggtitle(" ") + # adding an emtpy title to align y axis with ROC plot
  theme_cowplot()

# save each animation as individual frames
# each frame will be saved as a PNG image
p_dist_gif <- animate(p_dist,
  device = "png",
  width = 400,
  height = 400,
  renderer = file_renderer("../animations/gganim_imbalance", prefix = "p_dist", overwrite = TRUE)
)
p_ROC_gif <- animate(p_ROC,
  device = "png",
  width = 400,
  height = 400,
  renderer = file_renderer("../animations/gganim_imbalance", prefix = "p_ROC", overwrite = TRUE)
)
p_PR_gif <- animate(p_PR,
  device = "png",
  width = 400,
  height = 400,
  renderer = file_renderer("../animations/gganim_imbalance", prefix = "p_PR", overwrite = TRUE)
)

# stitch animations together
# read the first image (frame) of each animation
a <- image_read(p_dist_gif[[1]])
b <- image_read(p_ROC_gif[[1]])
c <- image_read(p_PR_gif[[1]])
# combine the two images into a single image
combined <- image_append(c(a, b, c))
new_gif <- c(combined)
for (i in 2:100) { # combine images frame by frame
  a <- image_read(p_dist_gif[[i]])
  b <- image_read(p_ROC_gif[[i]])
  c <- image_read(p_PR_gif[[i]])
  combined <- image_append(c(a, b, c))
  new_gif <- c(new_gif, combined)
}

# make an animation of the combined images
combined_gif <- image_animate(new_gif)
# save as gif
image_write(combined_gif, "../animations/imbalance.gif")


#' @title Create objects of type '"BasicBayesian"'.
#' @description
#' A Basic Bayesian Object is with following conditional dependency structure:
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{X|theta \sim F(theta)}
#' Where H(gamma) is usually called "the prior distribution", F(theta) is called "the observation distribution". Objects of type "LinearGaussianGaussian", "GaussianGaussian", "GaussianInvWishart", "GaussianNIW", "GaussianNIG", "CatDirichlet" and "CatDP" are all "BasicBayesian"s.
#'
#' @seealso \code{\link{LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{CatDP}} for Categorical-DP conjugate structure ...
#' @param ENV The environment where you want to create the BasicBayesian object
#' @return An object of class "BasicBayesian".
#' @export
BasicBayesian <- function(ENV=parent.frame()){
    object <- new.env(parent = ENV)

    object$gamma <- list()
    object$H <- character(0)
    object$F <- character(0)

    class(object) <- c("BasicBayesian","BayesianBrick")
    return(object)

}

#' @title Get sample sufficient statistics
#' @description
#' This is a generic function that will generate the sufficient statistics of a given Bayesian bricks object. i.e. \cr
#' for the model structure:
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' get the sufficient statistics T(x). \cr
#' For a given sample set x, each row of x is an observation, and a Bayesian bricks object obj. \code{sufficientStatistics()} return the sufficient statistics for different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' The sufficient statistics are:
#' \itemize{
#'  \item   SA = \eqn{sum_{i=1:N} A_i^T Sigma^{-1} A_i}
#'  \item  SAx = \eqn{sum_{i=1:N} A_i^T Sigma^{-1} (x_i-b_i)}
#' }
#' See \code{?sufficientStatistics.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' The sufficient statistics are:
#' \itemize{
#' \item N: the effective number of samples.
#' \item xsum: the row sums of the samples.
#' }
#' See \code{?sufficientStatistics.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known. \cr
#' The sufficient statistics are:
#' \itemize{
#' \item N: the effective number of samples.
#' \item xsum: the sample scatter matrix centered on the mean vector.
#' }
#' See \code{?sufficientStatistics.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' The sufficient statistics are:
#' \itemize{
#' \item N: the effective number of samples.
#' \item xsum: the row sums of the samples.
#' \item S: the uncentered sample scatter matrix.
#' }
#' See \code{?sufficientStatistics.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' The sufficient statistics are:
#' \itemize{
#' \item N: the effective number of samples.
#' \item SXx: covariance of X and x
#' \item SX: the uncentered sample scatter matrix.
#' \item Sx: the variance of x
#' }
#' See \code{?sufficientStatistics.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' The sufficient statistics of CatDirichlet object can either be x itself, or the counts of the unique labels in x.\cr
#' See \code{?sufficientStatistics.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' The sufficient statistics of CatDP object can either be x itself, or the counts of the unique labels in x.\cr
#' See \code{?sufficientStatistics.CatDP} for details.
#' }
#' \subsection{class(obj)="DP"}{
#' Where
#'      \deqn{pi|alpha \sim DP(alpha,U)}
#'     \deqn{z|pi \sim Categorical(pi)}
#'      \deqn{theta_z|psi \sim H0(psi)}
#'      \deqn{x|theta_z,z \sim F(theta_z)}
#' The sufficient statistics of "DP" object is the same sufficient statistics of the "BasicBayesian" inside the "DP".
#' See \code{?sufficientStatistics.DP} for details.
#' }
#' \subsection{class(obj)="HDP"}{
#' Where
#'      \deqn{G|gamma \sim DP(gamma,U)}
#'      \deqn{pi_j|G,alpha \sim DP(alpha,G), j = 1:J}
#'      \deqn{z|pi_j \sim Categorical(pi_j)}
#'      \deqn{k|z,G \sim Categorical(G),\textrm{ if z is a sample from the base measure G}}
#'      \deqn{theta_k|psi \sim H0(psi)}
#' The sufficient statistics of "HDP" object is the same sufficient statistics of the "BasicBayesian" inside the "HDP".
#' See \code{?sufficientStatistics.HDP} for details.
#' }
#' \subsection{class(obj)="HDP2"}{
#' Where
#'      \deqn{G |eta \sim DP(eta,U)}
#'      \deqn{G_m|gamma,G \sim DP(gamma,G), m = 1:M}
#'      \deqn{pi_{mj}|G_m,alpha \sim DP(alpha,G_m), j = 1:J_m}
#'      \deqn{z|pi_{mj} \sim Categorical(pi_{mj})}
#'      \deqn{k|z,G_m \sim Categorical(G_m),\textrm{ if z is a sample from the base measure} G_m}
#'      \deqn{u|k,G \sim Categorical(G),\textrm{ if k is a sample from the base measure} G}
#'      \deqn{theta_u|psi \sim H0(psi)}
#'      \deqn{x|theta_u,u \sim F(theta_u)}
#' The sufficient statistics of "HDP2" object is the same sufficient statistics of the "BasicBayesian" inside the "HDP2".
#' See \code{?sufficientStatistics.HDP2} for details.
#' }
#'
#' @seealso \code{\link{sufficientStatistics.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{sufficientStatistics.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{sufficientStatistics.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{sufficientStatistics.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{sufficientStatistics.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{sufficientStatistics.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{sufficientStatistics.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj a "BayesianBrick" object used to select a method.
#' @param x a set of samples.
#' @param ... further arguments passed to or from other methods.
#' @return An object of corresponding sufficient statistics class, such as "ssGaussian"
#' @export
#' @examples
#' x <- rGaussian(10,mu = 1,Sigma = 1)
#' obj <- GaussianNIW()                    #an GaussianNIW object
#' sufficientStatistics(obj=obj,x=x)
sufficientStatistics <- function(obj,x,...) UseMethod("sufficientStatistics")

#' @title Get weighted sample sufficient statistics
#' @description
#' This is a generic function that will generate the weighted sufficient statistics of a given "BayesianBrick" object. That is, for the model structure:
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' get the weighted sufficient statistics T(x).
#' For a given sample set x, each row of x is an observation, the sample weights w, and a Bayesian bricks object obj. \code{sufficientStatistics_Weighted()} return the weighted sufficient statistics for different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' The sufficient statistics are:
#' \itemize{
#'  \item   SA = \eqn{sum_{i=1:N} w_i A_i^T Sigma^{-1} A_i}
#'  \item  SAx = \eqn{sum_{i=1:N} w_i A_i^T Sigma^{-1} (x_i-b_i)}
#' }
#' See \code{?sufficientStatistics.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' The sufficient statistics are:
#' \itemize{
#' \item N: the effective number of samples.
#' \item xsum: the row sums of the samples.
#' }
#' See \code{?sufficientStatistics_Weighted.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known. \cr
#' The sufficient statistics are:
#' \itemize{
#' \item N: the effective number of samples.
#' \item xsum: the sample scatter matrix centered on the mean vector.
#' }
#' See \code{?sufficientStatistics_Weighted.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' The sufficient statistics are:
#' \itemize{
#' \item N: the effective number of samples.
#' \item xsum: the row sums of the samples.
#' \item S: the uncentered sample scatter matrix.
#' }
#' See \code{?sufficientStatistics_Weighted.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' The sufficient statistics are:
#' \itemize{
#' \item N: the effective number of samples.
#' \item SXx: covariance of X and x
#' \item SX: the uncentered sample scatter matrix.
#' \item Sx: the variance of x
#' }
#' See \code{?sufficientStatistics_Weighted.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' The sufficient statistics of CatDirichlet object can either be x itself, or the counts of the unique labels in x.\cr
#' See \code{?sufficientStatistics_Weighted.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' The sufficient statistics of CatDP object can either be x itself, or the counts of the unique labels in x.\cr
#' See \code{?sufficientStatistics_Weighted.CatDP} for details.
#' }
#' \subsection{class(obj)="DP"}{
#' Where
#'      \deqn{pi|alpha \sim DP(alpha,U)}
#'     \deqn{z|pi \sim Categorical(pi)}
#'      \deqn{theta_z|psi \sim H0(psi)}
#'      \deqn{x|theta_z,z \sim F(theta_z)}
#' The sufficient statistics of "DP" object is the same sufficient statistics of the "BasicBayesian" inside the "DP".
#' See \code{?sufficientStatistics_Weighted.DP} for details.
#' }
#' \subsection{class(obj)="HDP"}{
#' Where
#'      \deqn{G|gamma \sim DP(gamma,U)}
#'      \deqn{pi_j|G,alpha \sim DP(alpha,G), j = 1:J}
#'      \deqn{z|pi_j \sim Categorical(pi_j)}
#'      \deqn{k|z,G \sim Categorical(G),\textrm{ if z is a sample from the base measure G}}
#'      \deqn{theta_k|psi \sim H0(psi)}
#' The sufficient statistics of "HDP" object is the same sufficient statistics of the "BasicBayesian" inside the "HDP".
#' See \code{?sufficientStatistics_Weighted.HDP} for details.
#' }
#' \subsection{class(obj)="HDP2"}{
#' Where
#'      \deqn{G |eta \sim DP(eta,U)}
#'      \deqn{G_m|gamma,G \sim DP(gamma,G), m = 1:M}
#'      \deqn{pi_{mj}|G_m,alpha \sim DP(alpha,G_m), j = 1:J_m}
#'      \deqn{z|pi_{mj} \sim Categorical(pi_{mj})}
#'      \deqn{k|z,G_m \sim Categorical(G_m),\textrm{ if z is a sample from the base measure } G_m}
#'      \deqn{u|k,G \sim Categorical(G),\textrm{ if k is a sample from the base measure } G_m}
#'      \deqn{theta_u|psi \sim H0(psi)}
#'      \deqn{x|theta_u,u \sim F(theta_u)}
#' The sufficient statistics of "HDP2" object is the same sufficient statistics of the "BasicBayesian" inside the "HDP2".
#' See \code{?sufficientStatistics_Weighted.HDP2} for details.
#' }
#' @seealso \code{\link{sufficientStatistics_Weighted.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{sufficientStatistics_Weighted.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{sufficientStatistics_Weighted.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{sufficientStatistics_Weighted.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{sufficientStatistics_Weighted.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{sufficientStatistics_Weighted.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{sufficientStatistics_Weighted.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj a "BayesianBrick" object used to select a method.
#' @param x a set of samples.
#' @param w numeric, sample weights.
#' @param ... further arguments passed to or from other methods.
#' @return An object of corresponding sufficient statistics class, such as "ssGaussian"
#' @export
#' @examples
#' \donttest{
#' x <- rGaussian(10,mu = 1,Sigma = 1)
#' w <- runif(10)
#' obj <- GaussianNIW()                    #an GaussianNIW object
#' sufficientStatistics_Weighted(obj=obj,x=x,w=w)
#' }
sufficientStatistics_Weighted <- function(obj,x,w,...) UseMethod("sufficientStatistics_Weighted")

#' @title update the prior distribution with sufficient statistics
#' @description update the prior distribution with sufficient statistics
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return None, or an error message if the update fails.
posterior_bySufficientStatistics <- function(obj,...) UseMethod("posterior_bySufficientStatistics")

#' @title update the prior distribution with sufficient statistics
#' @description
#' This is a generic function that will update the prior distribution of a "BayesianBrick" object by adding information of the observation's sufficient statistics. i.e. for the model structure:
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' update gamma to gamma_posterior by adding the information of x to gamma.\cr
#' For a given sample set x or it's sufficient statistics ss, and a Bayesian bricks object obj, \code{posterior()} will update the posterior parameters in obj for different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{posterior()} will update m and S in obj.
#' See \code{?posterior.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{posterior()} will update m and S in obj.
#' See \code{?posterior.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{posterior()} will update v and S in obj.
#' See \code{?posterior.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{posterior()} will update m, k, v and S in obj.
#' See \code{?posterior.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' \code{posterior()} will update m, V, a and b in obj.
#' See \code{?posterior.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{posterior()} will update alpha in obj.
#' See \code{?posterior.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' \code{posterior()} will update alpha in obj.
#' See \code{?posterior.CatDP} for details.
#' }
#' \subsection{class(obj)="DP"}{
#' Where
#'      \deqn{pi|alpha \sim DP(alpha,U)}
#'     \deqn{z|pi \sim Categorical(pi)}
#'      \deqn{theta_z|psi \sim H0(psi)}
#'      \deqn{x|theta_z,z \sim F(theta_z)}
#' \code{posterior()} will update alpha and psi in obj.
#' See \code{?posterior.DP} for details.
#' }
#' \subsection{class(obj)="HDP"}{
#' Where
#'      \deqn{G|gamma \sim DP(gamma,U)}
#'      \deqn{pi_j|G,alpha \sim DP(alpha,G), j = 1:J}
#'      \deqn{z|pi_j \sim Categorical(pi_j)}
#'      \deqn{k|z,G \sim Categorical(G),\textrm{ if z is a sample from the base measure G}}
#'      \deqn{theta_k|psi \sim H0(psi)}
#' \code{posterior()} will update gamma, alpha and psi in obj.
#' See \code{?posterior.HDP} for details.
#' }
#' \subsection{class(obj)="HDP2"}{
#' Where
#'      \deqn{G |eta \sim DP(eta,U)}
#'      \deqn{G_m|gamma,G \sim DP(gamma,G), m = 1:M}
#'      \deqn{pi_{mj}|G_m,alpha \sim DP(alpha,G_m), j = 1:J_m}
#'      \deqn{z|pi_{mj} \sim Categorical(pi_{mj})}
#'      \deqn{k|z,G_m \sim Categorical(G_m),\textrm{ if z is a sample from the base measure } G_m}
#'      \deqn{u|k,G \sim Categorical(G),\textrm{ if k is a sample from the base measure} G}
#'      \deqn{theta_u|psi \sim H0(psi)}
#'      \deqn{x|theta_u,u \sim F(theta_u)}
#' \code{posterior()} will update eta, gamma, alpha and psi in obj.
#' See \code{?posterior.HDP2} for details.
#' }
#'
#' @seealso \code{\link{posterior.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{posterior.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{posterior.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{posterior.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{posterior.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{posterior.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{posterior.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return None, or an error message if the update fails.
#' @export
posterior <- function(obj,...) UseMethod("posterior")

#' @title update the prior distribution with sufficient statistics
#' @description update the prior distribution with sufficient statistics
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... other parameters.
#' @return None, or an error message if the update fails.
posteriorDiscard_bySufficientStatistics <- function(obj,...) UseMethod("posteriorDiscard_bySufficientStatistics")

#' @title update the prior distribution with sufficient statistics
#' @description
#' Contrary to posterior(), posteriorDiscard() a generic function that will update the prior distribution of a "BayesianBrick" object by removing the information provided by the observation's sufficient statistics. i.e. for the model structure:
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' update gamma to gamma_posterior by removing the information of x from gamma.
#' For a given sample set x or it's sufficient statistics ss, and a Bayesian bricks object obj, \code{posteriorDiscard()} will update the posterior parameters in obj for different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{posteriorDiscard()} will update m and S in obj.
#' See \code{?posteriorDiscard.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{posteriorDiscard()} will update m and S in obj.
#' See \code{?posteriorDiscard.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{posteriorDiscard()} will update v and S in obj.
#' See \code{?posteriorDiscard.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{posteriorDiscard()} will update m, k, v and S in obj.
#' See \code{?posteriorDiscard.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#  X is a row vector, or a design matrix where each row is an obervation.
#' \code{posteriorDiscard()} will update m, V, a and b in obj.
#' See \code{?posteriorDiscard.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{posteriorDiscard()} will update alpha in obj.
#' See \code{?posteriorDiscard.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' \code{posteriorDiscard()} will update alpha in obj.
#' See \code{?posteriorDiscard.CatDP} for details.
#' }
#' \subsection{class(obj)="DP"}{
#' Where
#'      \deqn{pi|alpha \sim DP(alpha,U)}
#'     \deqn{z|pi \sim Categorical(pi)}
#'      \deqn{theta_z|psi \sim H0(psi)}
#'      \deqn{x|theta_z,z \sim F(theta_z)}
#' \code{posteriorDiscard()} will update alpha and psi in obj.
#' See \code{?posteriorDiscard.DP} for details.
#' }
#' \subsection{class(obj)="HDP"}{
#' Where
#'      \deqn{G|gamma \sim DP(gamma,U)}
#'      \deqn{pi_j|G,alpha \sim DP(alpha,G), j = 1:J}
#'      \deqn{z|pi_j \sim Categorical(pi_j)}
#'      \deqn{k|z,G \sim Categorical(G),\textrm{ if z is a sample from the base measure } G}
#'      \deqn{theta_k|psi \sim H0(psi)}
#' \code{posteriorDiscard()} will update gamma, alpha and psi in obj.
#' See \code{?posteriorDiscard.HDP} for details.
#' }
#' \subsection{class(obj)="HDP2"}{
#' Where
#'      \deqn{G |eta \sim DP(eta,U)}
#'      \deqn{G_m|gamma,G \sim DP(gamma,G), m = 1:M}
#'      \deqn{pi_{mj}|G_m,alpha \sim DP(alpha,G_m), j = 1:J_m}
#'      \deqn{z|pi_{mj} \sim Categorical(pi_{mj})}
#'      \deqn{k|z,G_m \sim Categorical(G_m),\textrm{ if z is a sample from the base measure } G_m}
#'      \deqn{u|k,G \sim Categorical(G),\textrm{ if k is a sample from the base measure } G}
#'      \deqn{theta_u|psi \sim H0(psi)}
#'      \deqn{x|theta_u,u \sim F(theta_u)}
#' \code{posteriorDiscard()} will update eta, gamma, alpha and psi in obj.
#' See \code{?posteriorDiscard.HDP2} for details.
#' }
#'
#' @seealso \code{\link{posteriorDiscard.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{posteriorDiscard.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{posteriorDiscard.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{posteriorDiscard.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{posteriorDiscard.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{posteriorDiscard.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{posteriorDiscard.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return None, or an error message if the update fails.
#' @export
posteriorDiscard <- function(obj,...) UseMethod("posteriorDiscard")

#' @title Get the Maximum A Posteriori(MAP) estimate of a "BayesianBrick" object
#' @description
#' This is a generic function that will generate the MAP estimate of a given "BayesianBrick" object. For the model structure:  \cr
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' MAP estimate of theta is theta_MAP = argmax_theta p(theta|gamma,x).
#' For a given Bayesian bricks object obj, the MAP estimate will be:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#' Where
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{MAP()} will return the MAP estimate of z.
#' See \code{?MAP.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{MAP()} will return the MAP estimate of mu.
#' See \code{?MAP.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{MAP()} will return the MAP estimate of Sigma.
#' See \code{?MAP.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{MAP()} will return the MAP estimate of mu and Sigma.
#' See \code{?MAP.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' \code{MAP()} will return the MAP estimate of beta and sigma^2.
#' See \code{?MAP.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{MAP()} will return the MAP estimate of pi.
#' See \code{?MAP.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' \code{MAP()} will return the MAP estimate of pi.
#' See \code{?MAP.CatDP} for details.
#' }
#' @seealso \code{\link{MAP.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{MAP.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{MAP.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{MAP.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{MAP.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{MAP.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{MAP.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return A list of the MAP estimates
#' @export
MAP <- function(obj,...) UseMethod("MAP")

#' @title Get the Mean Posterior Estimate(MPE) of a "BayesianBrick" object
#' @description
#' This is a generic function that will generate the MPE estimate of a given "BayesianBrick" object. i.e. for the model structure: \cr
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' MPE estimate of theta is theta_MPE = E(theta|gamma,x), E() is the expectation function.
#' For a given Bayesian bricks object obj, the MPE estimate will be:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#' Where
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{MPE()} will return the MPE estimate of z.
#' See \code{?MPE.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{MPE()} will return the MPE estimate of mu.
#' See \code{?MPE.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{MPE()} will return the MPE estimate of Sigma.
#' See \code{?MPE.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{MPE()} will return the MPE estimate of mu and Sigma.
#' See \code{?MPE.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' \code{MPE()} will return the MPE estimate of beta and sigma^2.
#' See \code{?MPE.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{MPE()} will return the MPE estimate of pi.
#' See \code{?MPE.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' \code{MPE()} will return the MPE estimate of pi.
#' See \code{?MPE.CatDP} for details.
#' }
#' @seealso \code{\link{MPE.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{MPE.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{MPE.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{MPE.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{MPE.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{MPE.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{MPE.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return A list of MPE estimates
#' @export
MPE <- function(obj,...) UseMethod("MPE")

#' @title Get the density from the posterior distribution.
#' @description
#' This is a generic function that will generate the the density value of the posterior distribution. i.e. for the model structure: \cr
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' get the probability density/mass from the distribution \eqn{theta \sim H(gamma)}.
#' For a given Bayesian bricks object obj and an observation of theta, \code{dPosterior()} will calculate the density value for different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#' Where
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{dPosterior()} will return p(theta|m,S)
#' See \code{?dPosterior.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{dPosterior()} will return p(mu|m,S)
#' See \code{?dPosterior.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{dPosterior()} will return p(Sigma|v,S)
#' See \code{?dPosterior.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{dPosterior()} will return p(mu,Sigma|m,k,v,S)
#' See \code{?dPosterior.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' \code{dPosterior()} will return p(beta,sigma^2|m,V,a,b)
#' See \code{?dPosterior.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{dPosterior()} will return p(pi|alpha)
#' See \code{?dPosterior.CatDirichlet} for details.
#' }
#' @seealso \code{\link{dPosterior.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{dPosterior.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{dPosterior.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{dPosterior.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{dPosterior.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{dPosterior.CatDirichlet}} for Categorical-Dirichlet conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return numeric, the density value
#' @export
dPosterior <- function(obj,...) UseMethod("dPosterior")

#' @title Generate random samples from the posterior distribution
#' @description
#' This is a generic function that will generate random samples from the posterior distribution. i.e. for the model structure: \cr
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' generate random sampels of theta from the distribution \eqn{theta \sim H(gamma)}.
#' For a given Bayesian bricks object obj, \code{rPosterior()} will generate random samples for different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#' Where
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{rPosterior()} will generate random samples from Gaussian(m,S)
#' See \code{?rPosterior.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{rPosterior()} will generate random samples from Gaussian(m,S)
#' See \code{?rPosterior.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{rPosterior()} will generate random samples from InvWishart(v,S)
#' See \code{?rPosterior.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{rPosterior()} will generate random samples from NIW(m,k,v,S)
#' See \code{?rPosterior.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' \code{rPosterior()} will generate random samples from NIG(m,V,a,b)
#' See \code{?rPosterior.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{rPosterior()} will generate random samples from Dirichlet(alpha)
#' See \code{?rPosterior.CatDirichlet} for details.
#' }
#' @seealso \code{\link{rPosterior.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{rPosterior.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{rPosterior.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{rPosterior.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{rPosterior.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{rPosterior.CatDirichlet}} for Categorical-Dirichlet conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return numeric, the density value
#' @export
rPosterior <- function(obj,...) UseMethod("rPosterior")

#' @title Get the marginal likelihood of a "BayesianBrick" object
#' @description
#' This is a generic function that will generate the marginal likelihood of a set of observations conditioned on a given "BayesianBrick" object. i.e. for the model structure: \cr
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' Marginal likelihood is p(x|gamma), p() is the probability density/mass function for continuous/discrete x.
#' For a given Bayesian bricks object obj and a sample set x, \code{marginalLikelihood_bySufficientStatistics()} will calculate the marginal likelihood for different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#' Where
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{marginalLikelihood_bySufficientStatistics()} will return p(x|m,S,A,b,Sigma)
#' See \code{?marginalLikelihood_bySufficientStatistics.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{marginalLikelihood_bySufficientStatistics()} will return p(x|m,S,Sigma)
#' See \code{?marginalLikelihood_bySufficientStatistics.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{marginalLikelihood_bySufficientStatistics()} will return p(x|mu,v,S)
#' See \code{?marginalLikelihood_bySufficientStatistics.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{marginalLikelihood_bySufficientStatistics()} will return p(x|m,k,v,S)
#' See \code{?marginalLikelihood_bySufficientStatistics.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' \code{marginalLikelihood_bySufficientStatistics()} will return p(x,X|m,V,a,b)
#' See \code{?marginalLikelihood_bySufficientStatistics.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{marginalLikelihood_bySufficientStatistics()} will return p(x|alpha)
#' See \code{?marginalLikelihood_bySufficientStatistics.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' \code{marginalLikelihood_bySufficientStatistics()} will return p(x|alpha)
#' See \code{?marginalLikelihood_bySufficientStatistics.CatDP} for details.
#' }
#' @seealso \code{\link{marginalLikelihood_bySufficientStatistics.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{marginalLikelihood_bySufficientStatistics.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{marginalLikelihood_bySufficientStatistics.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{marginalLikelihood_bySufficientStatistics.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{marginalLikelihood_bySufficientStatistics.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{marginalLikelihood_bySufficientStatistics.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{marginalLikelihood_bySufficientStatistics.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return numeric, the marginal likelihood
#' @export
marginalLikelihood_bySufficientStatistics <- function(obj,...) UseMethod("marginalLikelihood_bySufficientStatistics")

#' @title Get the marginal likelihood of a "BayesianBrick" object
#' @description
#' This is a generic function that will generate the marginal likelihood of a set of observations conditioned on a given "BayesianBrick" object. i.e. for the model structure: \cr
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' Marginal likelihood is p(x|gamma), p() is the probability density/mass function for continuous/discrete x.
#' For a given Bayesian bricks object obj and a sample set x, \code{marginalLikelihood()} will calculate the marginal likelihood for different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#' Where
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{marginalLikelihood()} will return p(x|m,S,A,b,Sigma)
#' See \code{?marginalLikelihood.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{marginalLikelihood()} will return p(x|m,S,Sigma)
#' See \code{?marginalLikelihood.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{marginalLikelihood()} will return p(x|mu,v,S)
#' See \code{?marginalLikelihood.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{marginalLikelihood()} will return p(x|m,k,v,S)
#' See \code{?marginalLikelihood.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' \code{marginalLikelihood()} will return p(x,X|m,V,a,b)
#' See \code{?marginalLikelihood.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{marginalLikelihood()} will return p(x|alpha)
#' See \code{?marginalLikelihood.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' \code{marginalLikelihood()} will return p(x|alpha)
#' See \code{?marginalLikelihood.CatDP} for details.
#' }
#' @seealso \code{\link{marginalLikelihood.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{marginalLikelihood.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{marginalLikelihood.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{marginalLikelihood.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{marginalLikelihood.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{marginalLikelihood.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{marginalLikelihood.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return numeric, the marginal likelihood
#' @export
marginalLikelihood <- function(obj,...) UseMethod("marginalLikelihood")

#' @title Get the density value of the posterior predictive distribution
#' @description
#' This is a generic function that will generate the the density value of the posterior predictive distribution. i.e. for the model structure: \cr
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' get the probability density/mass of the posterior predictive distribution of a new sample x_new: p(x_new|gamma).
#' For a given Bayesian bricks object obj and a new sample x, \code{dPosteriorPredictive()} will calculate the marginal likelihood for different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#' Where
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{dPosteriorPredictive()} will return p(x|m,S,A,b,Sigma)
#' See \code{?dPosteriorPredictive.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{dPosteriorPredictive()} will return p(x|m,S,Sigma)
#' See \code{?dPosteriorPredictive.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{dPosteriorPredictive()} will return p(x|mu,v,S)
#' See \code{?dPosteriorPredictive.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{dPosteriorPredictive()} will return p(x|m,k,v,S)
#' See \code{?dPosteriorPredictive.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' \code{dPosteriorPredictive()} will return p(x,X|m,V,a,b)
#' See \code{?dPosteriorPredictive.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{dPosteriorPredictive()} will return p(x|alpha)
#' See \code{?dPosteriorPredictive.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' \code{dPosteriorPredictive()} will return p(x|alpha)
#' See \code{?dPosteriorPredictive.CatDP} for details.
#' }
#' @seealso \code{\link{dPosteriorPredictive.LinearGaussianGaussian}} for Linear Gaussian and Gaussian conjugate structure, \code{\link{dPosteriorPredictive.GaussianGaussian}} for Gaussian-Gaussian conjugate structure, \code{\link{dPosteriorPredictive.GaussianInvWishart}} for Gaussian-Inverse-Wishart conjugate structure, \code{\link{dPosteriorPredictive.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{dPosteriorPredictive.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{dPosteriorPredictive.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{dPosteriorPredictive.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param ... further arguments passed to or from other methods.
#' @return numeric, the density value
#' @export
dPosteriorPredictive <- function(obj,...) UseMethod("dPosteriorPredictive")

#' @title Generate random samples from the posterior predictive distribution
#' @description
#' This is a generic function that will generate random samples from the posterior predictive distribution. i.e. for the model structure: \cr
#'      \deqn{theta|gamma \sim H(gamma)}
#'      \deqn{x|theta \sim F(theta)}
#' generate x_new from the posterior predictive distribution of x|gamma.
#' For a given Bayesian bricks object obj, \code{rPosteriorPredictive()} will generate random samples from different model structures:
#' \subsection{class(obj)="LinearGaussianGaussian"}{
#' Where
#'      \deqn{x \sim Gaussian(A z + b, Sigma)}
#'      \deqn{z \sim Gaussian(m,S)}
#' \code{rPosteriorPredictive()} will generate samples from the distribution of x|m,S,A,b,Sigma
#' See \code{?rPosteriorPredictive.LinearGaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianGaussian"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{mu \sim Gaussian(m,S)}
#' Sigma is known.
#' \code{rPosteriorPredictive()} will generate samples from the distribution of x|m,S,Sigma
#' See \code{?rPosteriorPredictive.GaussianGaussian} for details.
#' }
#' \subsection{class(obj)="GaussianInvWishart"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' mu is known.
#' \code{rPosteriorPredictive()} will generate samples from the distribution of x|mu,v,S
#' See \code{?rPosteriorPredictive.GaussianInvWishart} for details.
#' }
#' \subsection{class(obj)="GaussianNIW"}{
#' Where
#' \deqn{x \sim Gaussian(mu,Sigma)}
#' \deqn{Sigma \sim InvWishart(v,S)}
#' \deqn{mu \sim Gaussian(m,Sigma/k)}
#' \code{rPosteriorPredictive()} will generate samples from the distribution of x|m,k,v,S
#' See \code{?rPosteriorPredictive.GaussianNIW} for details.
#' }
#' \subsection{class(obj)="GaussianNIG"}{
#' Where
#' \deqn{x \sim Gaussian(X beta,sigma^2)}
#' \deqn{sigma^2 \sim InvGamma(a,b)}
#' \deqn{beta \sim Gaussian(m,sigma^2 V)}
#' X is a row vector, or a design matrix where each row is an obervation.
#' \code{rPosteriorPredictive()} will generate samples from the distribution of x,X|m,V,a,b
#' See \code{?rPosteriorPredictive.GaussianNIG} for details.
#' }
#' \subsection{class(obj)="CatDirichlet"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim Dirichlet(alpha)}
#' \code{rPosteriorPredictive()} will generate samples from the distribution of x|alpha
#' See \code{?rPosteriorPredictive.CatDirichlet} for details.
#' }
#' \subsection{class(obj)="CatDP"}{
#' Where
#' \deqn{x \sim Categorical(pi)}
#' \deqn{pi \sim DirichletProcess(alpha)}
#' \code{rPosteriorPredictive()} will generate samples from the distribution of x|alpha
#' See \code{?rPosteriorPredictive.CatDP} for details.
#' }
#' @seealso \code{\link{rPosteriorPredictive.GaussianNIW}} for Gaussian-NIW conjugate structure, \code{\link{rPosteriorPredictive.GaussianNIG}} for Gaussian-NIG conjugate structure, \code{\link{rPosteriorPredictive.CatDirichlet}} for Categorical-Dirichlet conjugate structure, \code{\link{rPosteriorPredictive.CatDP}} for Categorical-DP conjugate structure ...
#' @param obj A "BayesianBrick" object used to select a method.
#' @param n integer, specify the number of samples to be generated.
#' @param ... further arguments passed to or from other methods.
#' @return a matrix or vector or list of random samples, depends on the type of 'obj'.
#' @export
rPosteriorPredictive <- function(obj,n,...) UseMethod("rPosteriorPredictive")

#' Print the content of an BasicBayesian object
#' @param x An object of the target type.
#' @param ... other parameters passed to print.
#' @return None.
#' @export
print.BasicBayesian <- function(x,...){
    cat("Prior distribution: ",x$H,"\n")
    cat("Observation distribution: ",x$F,"\n")
    cat("Parameters for prior distribution:\n")
    print(x$gamma)
}

#' a internal version of "is", only for this package
#' @param object an object to be test with
#' @param class2 the class you want to test
#' @return logical, return TRUE if 'class2' is in 'class(object)'.
#' @noRd
.is <- function(object,class2){
    isTRUE(class2 %in% class(object))
}

#' log multivariate gamma function
#' @param a numeric, a numeric vector to be evaluated.
#' @param p numeric, the dimension.
#' @return numeric, the log value of the multivariate gamma function.
#' @noRd
.lmvgamma <- function(a,p){
    sapply(a,function(ai){
        p*(p-1)/4*log(pi)+ sum(lgamma(ai+(1-(1:p))/2))
    },simplify = TRUE)
}

#' determinant of a matrix
#' @param m numeric or matrix. When m is a numeric vector, it's treated as a diagonal matrix.
#' @return logical, return TRUE if 'class2' is in 'class(object)'.
#' @noRd
.det <- function(m){
    if(is.matrix(m)){
        base::det(m)
    }else if(is.vector(m)){
        base::prod(m)
    }
}

#' @title log sum exp
#' @description For each row l of a matrix x, calculate log(sum(exp(l))).
#' @param x matrix, the values in x a all logged. If x is a numeric vector, it will be converted to a matrix with 1 row.
#' @return numeric, the logsumexp of each row of x.
#' @export
#' @examples
#' \donttest{
#' ## Normalize the rows of x to make them sum up to 1
#' x <- matrix(runif(6,-1000,-20),nrow=2)
#' x <- x-logsumexp(x)
#' x <- exp(x)
#' rowSums(x)
#' }
logsumexp <- function(x){
    if(is.vector(x)) x <- matrix(x,nrow =1L)
    else if(!is.matrix(x)) x <- as.matrix(x)
    x <- as.matrix(x)
    a <- apply(x,1,max)
    log(rowSums(exp(x-a)))+a
}

#' @title Inverse of a positive definite symmetric matrix
#' @description Use Cholesky decomposition to calculate the inverse of S,  where \eqn{S = A'A}, A is a upper diagonal matrix. inv(S) = inv(A)inv(A)'.
#' @param S a symmetric positive definitive matrix.
#' @param returnUpper logical, return inv(A) if returnUpper=TRUE,return inv(S) if returnUpper=FALSE, default FALSE.
#' @return A matrix, the inverse of "S".
#' @export
#' @examples
#' Sigma = matrix(c(2,1,1,2),2,2)      # some positive definite symmetric matrix
#' pdsInverse(Sigma)                   # get inv(Sigma)
#' pdsInverse(Sigma,returnUpper=TRUE)  # get inv(A), where Sigma=A'A, A is upper triangle
pdsInverse <- function(S,returnUpper=FALSE){
    if(missing(S)) stop("'S' not specified!")
    if(length(S)==1L){
        if(returnUpper==FALSE)
            return(1/S)
        else
            return(sqrt(1/S))
    }else{
        A <- chol(S)                              #Cholesky decomposition S=A'A
        Ai <- backsolve(A,diag(nrow(S)))          #A_i = A^(-1)
        if(returnUpper==FALSE)
            return(crossprod(t(Ai)))
        else
            return(Ai)
    }
}

#' @title determinant of a positive definite symmetric matrix
#' @description Use Cholesky decomposition to calculate the determinant of S, where \eqn{S = A'A}, A is a upper diagonal matrix. det(S) = det(A)*det(A).
#' @param S a symmetric positive definitive matrix.
#' @param LOG logical, return log(det(S)) if TRUE, return det(S) if FALSE, default FALSE.
#' @return A matrix, the determinant of "S".
#' @export
#' @examples
#' Sigma = matrix(c(1.3,1,1,2),2,2)      # some positive definite symmetric matrix
#' pdsDeterminant(Sigma)                 # get inv(Sigma)
#' pdsDeterminant(Sigma,LOG=TRUE)        # get inv(Sigma)
#' pdsInverse(Sigma,returnUpper=TRUE)  # get inv(A), where Sigma=A'A, A is upper triangle
pdsDeterminant <- function(S,LOG=FALSE){
    if(missing(S)) stop("'S' not specified!")
    if(length(S)==1L){
        return(S)
    }else{
        A <- chol(S)                              #Cholesky decomposition S=A'A
        if(LOG){
            return(sum(log(diag(A))*2))
        }else{
            return(prod(diag(A))^2)
        }
    }
}

#' @title additional release questions
#' @description This is a list of additional questions you want devtools::release() to ask when releasing your package.
release_questions <- function(){
    c("Have you run 'R CMD build PACKAGE_FOLDER' and 'R CMD check PACKAGE_VERSION.tar.gz' before the release?",
      "Have you removed underscores '_' in \\text{...}? For exmple \\text{G_m} is not allowed!!",
      "Have you set the correct version number?",
      "Have you removed the irrelevant code blocks, such as 'if(FALSE){...}', from your R files?",
      "Have you add all the files in ./R folder to DESCRIPTION?",
      "Have you removed the unfinished examples from the vignette?",
      "Have you add all the references to README and function documentation?",
      "Have you replaced all of the dontrun{} with donttest{}?",
      "Have you rebuilt README.md from README.raw.md, using publish_markdown.r? Note that you have to rebuild README.md whenever you modified README.raw.md.",
      "Have you removed all the par() settings in the examples? Check your documentations by run \"grep 'par(' ./man/*\" from the terminal."
      )
}


#' Find Basic Feasible Solutions
#'
#' @param A
#' Coefficient matrix of the convex set.
#' @param b
#' Right hand side.
#'
#' @return
#' A 'bfs' object.
#'
#' @export
find.bfs <- function(A, b)
{
  combs <- combn(ncol(A), nrow(A))
  len.out <- ncol(combs)

  bfs <- vector(mode="list", length=len.out)
  indices <- vector(mode="list", length=len.out)

  for (ind in 1:len.out)
  {
    columns <- combs[, ind]

    B <- A[, columns]

    if (det(B) == 0)
    {
      bfs[[ind]] <- "Not defined"
      indices[[ind]] <- columns
      next
    }

    # B^{-1}b
    bfs[[ind]] <- solve(B, b)
    indices[[ind]] <- columns
  }

  ret <- list(bfs=bfs, indices=indices, n=ncol(A))
  class(ret) <- "bfs"
  ret
}

#' Find Extreme Points
#'
#' Find extreme points.
#'
#' @param bfs
#' A bfs object, returned from \code{find.bfs()}.
#'
#' @return
#' An 'ep' class object.
#'
#' @export
find.ep <- function(bfs)
{
  if (class(bfs) != "bfs")
    stop("Argument 'bfs' must be a 'bfs' object.")

  eps <- list()
  epsind <- 1L

  for (ind in 1:length(bfs$bfs))
  {
    Binv_b <- bfs$bfs[[ind]]

    inds <- bfs$indices[[ind]]

    if (is.character(Binv_b))
      next
    else if (all(Binv_b >= 0))
    {
      sol <- rep(0, bfs$n)
      sol[inds] <- Binv_b

      eps[[epsind]] <- sol
      epsind <- epsind + 1L
    }
  }

  class(eps) <- "ep"
  eps
}

optimize_lp <- function(z, ep, optfun)
{
  if (class(ep) != "ep")
    stop("Argument 'ep' must be of class 'ep'")

  z <- c(z, rep(0, length(ep[[1]])-length(z)))
#  if (length(z) != length(ep[[1]]))
#    stop("Objective function coefficients 'z' must match the number of coefficients of the ep's")

  if (class(optfun) != "function")
    stop("Argument 'optfun' must be a function of a single variable")

  zfun <- function(x) crossprod(z, x)
  vals <- sapply(ep, zfun)
  op <- optfun(vals)
  at <- which(op == vals)

  optimum <- list(optimum=op, soln=ep[[at]])
  class(optimum) <- "lp_solution"

  optimum
}

#' Optimize Linear Programming Problem
#'
#' Given a set of extreme points and the coefficients of an
#' objective function
#'
#' @param z
#' The coefficients of the objective function, including zeros from
#' slack variables if applicable.
#' @param ep
#' A set of extreme points (the output of \code{find.ep()}).
#'
#' @name optimize
#' @rdname optimize
#' @export
minimize <- function(z, ep)
{
  optimum <- optimize_lp(z=z, ep=ep, optfun=min)
  optimum$type <- "minimum"

  optimum
}

#' @rdname optimize
#' @export
maximize <- function(z, ep)
{
  optimum <- optimize_lp(z=z, ep=ep, optfun=max)
  optimum$type <- "maximum"

  optimum
}


sigmoid <- function(x) {
    if (x < 0.0) {
        z <- exp(x)
        return(z / (1.0 + z))
    }
    return(1.0 / (1.0 + exp(-x)))
}


library(deSolve)
library(ggplot2)
library(reshape2)

sis_ode <- function(times,x,parms){
  with(as.list(c(parms,x)),{
    # ODEs
    SH<-nH-x[[1]] #Calculate SH as nH-IH
    SL<-(1-nH)-x[[2]] #Calculate SL as nL-IL
    dIH <-+(betaHH*IH+betaHL*IL)*SH-gamma*IH
    dIL <-+(betaLH*IH+betaLL*IL)*SL-gamma*IL

    der<-c(dIH,dIL)
    list(der)
  })
}

parms <- c(betaHH=10,betaHL=0.1,betaLH=0.1,betaLL=1,gamma=1,nH=0.2)
x <- c(IH=0.00001,IL=0.001)
times <-seq(0,15,1)
sis_out <- as.data.frame(lsoda(x,times,sis_ode,parms))

sis_out_long <- melt(sis_out,"time") #Collapse dataset from "wide" to "long" format for plotting
ggplot(sis_out_long,aes(x=time,y=value,colour=variable,group=variable)) + geom_line(lwd=2) +
  labs(x="Time (Years)",y="Proportion of Population",color="Risk Group")