.packageName <- "cslogistic"

"BayesCslogistic"<-function(formula, type = TRUE, intercept = TRUE, burnin = 1000, mcmc = 10000,
           thin=1, tune=1.1, beta.start = NA, b0 = 0, B0 = 0, ...)
{
	cl <- match.call()
	mf <- match.call(expand.dots = FALSE)
	m <- match(c("formula", "data","na.action"), names(mf), 0)
	mf <- mf[c(1, m)]
	mf$drop.unused.levels <- TRUE
	mf[[1]] <- as.name("model.frame")
	mf <- eval(mf, parent.frame())
	
	y<- model.response(mf,"numeric")
	n<-dim(y)[2]
	nrec<-length(y[,1])
	x<-as.matrix(model.matrix(formula))
	p<-dim(x)[2]
	dima<-n*(n-1)/2
	perm<-matrix(0,nrow=(2**n),ncol=n)
        arate<-0
        nstore<-mcmc/thin
        sam<-sample(1:29000,3)
        
        ## seeds
        seed1<-sam[1]
        seed2<-sam[2]
        seed3<-sam[3]

        ## equal effect model
        if(type){  
                ## dimension
                
                dimen<-p+dima
                
                ## maximum likelihood estimates
                
                fit0<-MleCslogistic(formula)
                
                ## starting values
                
                if(is.na(beta.start)) beta.start <- fit0$coeff

                ## prior
                
                if(b0==0)b0<-rep(0,dimen)
                if(B0==0)B0<-diag(rep(1000,dimen))
    
                ## covariance matrix for metropolis algorithm
                
                propv<-diag(tune,dimen)%*%(solve(solve(fit0$cov)+solve(B0)))%*%diag(tune,dimen)

                ## working variables
                
                betac<-rep(0,dimen)
                workv1<-rep(0,dimen)
                workv2<-rep(0,dimen)
                workv3<-rep(0,dimen)
                workm1<-rep(0,(dimen*(dimen+1)/2))
                workm2<-matrix(0,nrow=dimen,ncol=dimen)
                workm3<-matrix(0,nrow=dimen,ncol=dimen)
                iflag<-rep(0,dimen)
                storemat<-matrix(0,nrow=nstore,ncol=dimen)

                ## call the fortran function to fit the model

                a<-.Fortran("mha",mcmc=as.integer(mcmc),burnin=as.integer(burnin),thin=as.integer(thin),
                                  nstore=as.integer(nstore),as.integer(seed1),as.integer(seed2),as.integer(seed3),
                                  propv=as.double(propv),p=as.integer(p),dima=as.integer(dima),dimen=as.integer(dimen),
                                  n=as.integer(n),nrec=as.integer(nrec),y=as.integer(y),x=as.double(x),as.integer(perm),
                                  beta.start=as.double(beta.start),as.double(betac),b0=as.double(b0),
                                  B0=as.double(B0),mat=as.double(storemat),arate=as.double(arate),
                                  as.double(workm1),as.double(workm2),as.double(workm3),
                                  as.double(workv1),as.double(workv2),as.double(workv3),
                                  as.integer(iflag),PACKAGE="cslogistic")

                ## save names of original covariates
                
	        pnames<-c(dimnames(x)[[2]])
	        for(i in 1:(n-1)){
	           for(j in (i+1):n){
	                bn<-paste("alpha",i,j,sep="")
	           	pnames<-c(pnames,bn)
	           }
	        }
        }        

        ## different effect models               
        else{  
        
                ## different intercept only
                
                if(intercept){
                     ## dimension  
                     
                     dimen<-n+(p-1)+dima

                     ## maximum likelihood estimates
                
                     fit1<-MleCslogistic(formula,type=type)
     
                     ## starting values
                  
                     if(is.na(beta.start)) beta.start <- fit1$coeff

                     ## prior
                
                     if(b0==0)b0<-rep(0,dimen)
                     if(B0==0)B0<-diag(rep(1000,dimen))
       
                     ## covariance matrix for metropolis algorithm
                
                     propv<-diag(tune,dimen)%*%(solve(solve(fit1$cov)+solve(B0)))%*%diag(tune,dimen)

                     ## working variables
                
                     betac<-rep(0,dimen)
                     workv1<-rep(0,dimen)
                     workv2<-rep(0,dimen)
                     workv3<-rep(0,dimen)
                     workm1<-rep(0,(dimen*(dimen+1)/2))
                     workm2<-matrix(0,nrow=dimen,ncol=dimen)
                     workm3<-matrix(0,nrow=dimen,ncol=dimen)
                     iflag<-rep(0,dimen)
                     storemat<-matrix(0,nrow=nstore,ncol=dimen)

                     ## call the fortran function to fit the model

                     a<-.Fortran("mhc",mcmc=as.integer(mcmc),burnin=as.integer(burnin),thin=as.integer(thin),
                                       nstore=as.integer(nstore),as.integer(seed1),as.integer(seed2),as.integer(seed3),
                                       propv=as.double(propv),p=as.integer(p),dima=as.integer(dima),dimen=as.integer(dimen),
                                       n=as.integer(n),nrec=as.integer(nrec),y=as.integer(y),x=as.double(x),as.integer(perm),
                                       beta.start=as.double(beta.start),as.double(betac),b0=as.double(b0),
                                       B0=as.double(B0),mat=as.double(storemat),arate=as.double(arate),
                                       as.double(workm1),as.double(workm2),as.double(workm3),
                                       as.double(workv1),as.double(workv2),as.double(workv3),
                                       as.integer(iflag),PACKAGE="cslogistic")
  
                     ## save names of original covariates       
     
                     pnames<-c(dimnames(x)[[2]])                     
                     pnames0<-paste(pnames[1],seq(1:n),sep=":")
                     pnames1<-pnames[-1]
                     pnames<-c(pnames0,pnames1)
                     
                     for(i in 1:(n-1)){
		         for(j in (i+1):n){
                             bn<-paste("alpha",i,j,sep="")
                             pnames<-c(pnames,bn)
                         }
                     }
                }


                ## different effects in all the covariates
                
                else{
                     ## dimension  
                     
                     dimen<-n*p+dima

                     ## maximum likelihood estimates
                
                     fit2<-MleCslogistic(formula,type=type,intercept=intercept)
                     

                     ## starting values
                  
                     if(is.na(beta.start)) beta.start <- fit2$coeff

                     ## prior
                
                     if(b0==0)b0<-rep(0,dimen)
                     if(B0==0)B0<-diag(rep(1000,dimen))
       
                     ## covariance matrix for metropolis algorithm
                
                     propv<-diag(tune,dimen)%*%(solve(solve(fit2$cov)+solve(B0)))%*%diag(tune,dimen)

                     ## working variables
                
                     betac<-rep(0,dimen)
                     workv1<-rep(0,dimen)
                     workv2<-rep(0,dimen)
                     workv3<-rep(0,dimen)
                     workm1<-rep(0,(dimen*(dimen+1)/2))
                     workm2<-matrix(0,nrow=dimen,ncol=dimen)
                     workm3<-matrix(0,nrow=dimen,ncol=dimen)
                     iflag<-rep(0,dimen)
                     storemat<-matrix(0,nrow=nstore,ncol=dimen)

                     ## call the fortran function to fit the model

                     a<-.Fortran("mhb",mcmc=as.integer(mcmc),burnin=as.integer(burnin),thin=as.integer(thin),
                                       nstore=as.integer(nstore),as.integer(seed1),as.integer(seed2),as.integer(seed3),
                                       propv=as.double(propv),p=as.integer(p),dima=as.integer(dima),dimen=as.integer(dimen),
                                       n=as.integer(n),nrec=as.integer(nrec),y=as.integer(y),x=as.double(x),as.integer(perm),
                                       beta.start=as.double(beta.start),as.double(betac),b0=as.double(b0),
                                       B0=as.double(B0),mat=as.double(storemat),arate=as.double(arate),
                                       as.double(workm1),as.double(workm2),as.double(workm3),
                                       as.double(workv1),as.double(workv2),as.double(workv3),
                                       as.integer(iflag),PACKAGE="cslogistic")
  
                     ## save names of original covariates       
                     
                     pnames<-c(dimnames(x)[[2]])
                     pnames<-paste(pnames,1,sep=":")
                     
                     for(i in 2:n){
                        nbv<-paste(dimnames(x)[[2]],":",i,sep="")
                        pnames<-c(pnames,nbv)
                     }
                     for(i in 1:(n-1)){
                         for(j in (i+1):n){
                             bn<-paste("alpha",i,j,sep="")
                             pnames<-c(pnames,bn)
                         }
                     }
                }      
        }        

        mat<-matrix(a$mat,nstore,dimen,byrow=FALSE)
        colnames(mat)<-pnames
        
        coeff<-rep(0,dimen)
        for(i in 1:dimen){
            coeff[i]<-mean(mat[,i])
        }
        names(coeff)<-pnames

        arate<-a$arate
 
        
        model.name<-"Bayesian conditionally specified logistic regression model"
        z <- list(modelname = model.name,call=cl,coefficients = coeff,mcmc=mcmc,burnin=burnin,
                  thin=thin,mat=mat,arate=arate,dimen=dimen,pnames=pnames)
        class(z)<-c("BayesCslogistic")
        z
}



"MleCslogistic"<-function(formula,type=TRUE,intercept=TRUE,method="BFGS",maxiter=1000,data,...)
{
	cl <- match.call()
	mf <- match.call(expand.dots = FALSE)
	m <- match(c("formula", "data","na.action"), names(mf), 0)
	mf <- mf[c(1, m)]
	mf$drop.unused.levels <- TRUE
	mf[[1]] <- as.name("model.frame")
	mf <- eval(mf, parent.frame())
	
	y<- model.response(mf,"numeric")
	n<-dim(y)[2]
	nrec<-length(y[,1])
	x<-as.matrix(model.matrix(formula))
	p<-dim(x)[2]
	dima<-n*(n-1)/2
	perm<-matrix(0,nrow=(2**n),ncol=n)
	loglike<-0
    
        if(type){  
                dimx<-p+dima
        	coeff<-rep(0,dimx)
        	
        	neg.loglike<-function(coeff)
        	{
        		.Fortran("cloga",as.integer(n),as.integer(nrec),as.integer(p),
        	         as.integer(dima),as.integer(y),as.double(x),
        	         as.double(coeff),as.integer(perm),loglike=as.double(loglike),PACKAGE="cslogistic")$loglike
                }
                
	        a<-optim(rep(1.2,dimx),fn=neg.loglike,method=method,hessian = TRUE,control=list(maxiter=maxiter))
	        pnames<-c(dimnames(x)[[2]])
	        for(i in 1:(n-1)){
	           for(j in (i+1):n){
	                bn<-paste("alpha",i,j,sep="")
	           	pnames<-c(pnames,bn)
	           }
	        }
        }        
                
        else{  
        
        
                if(intercept){
                     dimx<-n+(p-1)+dima
                     coeff<-rep(0,dimx)
                     neg.loglike<-function(coeff)
                     {
        		.Fortran("clogc",as.integer(n),as.integer(nrec),as.integer(p),
        	         as.integer(dima),as.integer(y),as.double(x),
        	         as.double(coeff),as.integer(perm),loglike=as.double(loglike),PACKAGE="cslogistic")$loglike
                     }
                     a<-optim(rep(1.2,dimx),fn=neg.loglike,method=method,hessian = TRUE,control=list(maxiter=maxiter))
                     pnames<-c(dimnames(x)[[2]])                     
                     pnames0<-paste(pnames[1],seq(1:n),sep=":")
                     pnames1<-pnames[-1]
                     pnames<-c(pnames0,pnames1)
                     
                     for(i in 1:(n-1)){
		         for(j in (i+1):n){
                             bn<-paste("alpha",i,j,sep="")
                             pnames<-c(pnames,bn)
                             }
                     }
                }
                
                else{
                     dimx<-n*p+dima
                     coeff<-rep(0,dimx)
                     neg.loglike<-function(coeff)
                     {
        		.Fortran("clogb",as.integer(n),as.integer(nrec),as.integer(p),
        	         as.integer(dima),as.integer(y),as.double(x),
        	         as.double(coeff),as.integer(perm),loglike=as.double(loglike),PACKAGE="cslogistic")$loglike
                     }
                
                     a<-optim(rep(1.2,dimx),fn=neg.loglike,method=method,hessian = TRUE,control=list(maxiter=maxiter))
                     pnames<-c(dimnames(x)[[2]])
                     pnames<-paste(pnames,1,sep=":")
                     
		
                     for(i in 2:n){
                        nbv<-paste(dimnames(x)[[2]],":",i,sep="")
                        pnames<-c(pnames,nbv)
                     }
                     for(i in 1:(n-1)){
                         for(j in (i+1):n){
                             bn<-paste("alpha",i,j,sep="")
                             pnames<-c(pnames,bn)
                         }
                     }
                }      
        }        

	coeff<-a$par
	names(coeff)<-pnames
	
        loglike<--a$value  
        
        conv<--a$convergence
        covb<--solve(-a$hessian)
        colnames(covb)<-pnames
        rownames(covb)<-pnames

        se<-sqrt(diag(covb)) 
        names(se)<-pnames
        
        corr<-covb/outer(se, se)
        colnames(corr)<-pnames
        rownames(corr)<-pnames
        
        tvalue<-coeff/se
        
        model.name<-"Conditional specified logistic regression model"
        z <- list(modelname = model.name,call=cl,coefficients = coeff,se=se,tvalue=tvalue,nvar=n,method=method,
        	  loglike=loglike,np=dimx,cov=covb,corr=corr,nrec=nrec)
        class(z)<-c("MleCslogistic")
        
        if(conv!=0)stop("Convergence criteria not achieved, code # ",conv)
        z
}


.onAttach <- function(...) {
     cat("##\n## Conditionally Specified Logistic Regression Model Package (cslogistic)\n")
     cat("## Copyright (C) 2005, Alejandro Jara and Maria Jose Garcia-Zattera \n")
     cat("##\n## Support provided by the Katholieke Universiteit Leuven \n")
     cat("## (Research Grant OT / 00 / 35) \n##\n")
}

.onUnload <- function(libpath) {
    library.dynam.unload("cslogistic", libpath)
}
"print.BayesCslogistic"<-function (x, digits = max(3, getOption("digits") - 3), ...) 
{
    cat("\n",x$modelname,"\n\nCall:\n", deparse(x$call), "\n\n", sep = "")
    if (length(coef(x))) {
        cat("Posterior Inference of Coefficients:\n")
        print.default(format(x$coefficients, digits = digits), print.gap = 2, 
            quote = FALSE)
    }
    else cat("No coefficients\n")
    cat("\nAcceptation Rate for the Metropolis Algorihtm = ",x$arate,"\n")    
    cat("\n\n")
    invisible(x)
}



"print.MleCslogistic"<-function (x, digits = max(3, getOption("digits") - 3), ...) 
{
    cat("\n",x$modelname,"\n\nCall:\n", deparse(x$call), "\n\n", sep = "")
    if (length(coef(x))) {
        cat("Coefficients:\n")
        print.default(format(x$coefficients, digits = digits), print.gap = 2, 
            quote = FALSE)
    }
    else cat("No coefficients\n")
    cat("\nlog-likelihood",x$loglike,"\n")    
    cat("\n\n")
    invisible(x)
}


"summary.BayesCslogistic"<-function(object, ...) 
{
    dimen<-object$dimen
    coef.p<-object$coefficients
    
    coef.sd<-rep(0,dimen)
    coef.se<-rep(0,dimen)
    coef.l<-rep(0,dimen)
    coef.u<-rep(0,dimen)
    coef.m<-rep(0,dimen)
    
    names(coef.sd)<-object$pnames
    names(coef.l)<-object$pnames
    names(coef.u)<-object$pnames
    
    alpha<-0.05
    
    for(i in 1:dimen){
        alow<-rep(0,2)
        aupp<-rep(0,2)
        coef.sd[i]<-sqrt(var(object$mat[,i]))
        coef.m[i]<-median(object$mat[,i])
        vec<-object$mat[,i]
        n<-length(vec)
        
        a<-.Fortran("hpd",n=as.integer(n),alpha=as.double(alpha),x=as.double(vec),
                     alow=as.double(alow),aupp=as.double(aupp),PACKAGE="cslogistic")
        coef.l[i]<-a$alow[1]            
        coef.u[i]<-a$aupp[1]            
    }

    coef.se<-coef.sd/sqrt(n)

    coef.table <- cbind(coef.p, coef.m, coef.sd, coef.se , coef.l , coef.u)
    dimnames(coef.table) <- list(names(coef.p), c("Mean", "Median", "Std. Dev.", "Naive Std.Error",
                "95%HPD-Lower","95%HPD-Upper"))

    ans <- c(object[c("call", "modelname","arate")])
    ans$coefficients<-coef.table
    class(ans) <- "BayesCslogistic"
    return(ans)
    plotBayesCslogistic(object)
}



"summary.MleCslogistic"<-function(object, ...) 
{
    p<-object$dimx
    coef.p<-object$coefficients
    s.err<-object$se
    tvalue<-object$tvalue
    pvalue <- 2 * pnorm(-abs(tvalue))
    or<-exp(coef.p)
    ic.l<-exp(coef.p-qnorm(0.975)*s.err)
    ic.u<-exp(coef.p+qnorm(0.975)*s.err)
    coef.table <- cbind(coef.p, s.err, or,ic.l,ic.u, pvalue)
    dimnames(coef.table) <- list(names(coef.p), c("Estimate", "Std. Error", 
                " OR ", "Lower","Upper" ,"Pr(>|z|)"))

    ans <- c(object[c("call", "loglike","modelname")])
    ans$coefficients<-coef.table
    class(ans) <- "MleCslogistic"
    return(ans)
}



"plot.BayesCslogistic"<-function(x, ...) 
{
      object<-x
      dimen<-object$dimen
      par(mfrow=c(3,2))
      for(i in 1:dimen){
        nx<-round(i/4,0)
        mx<-nx*4
        if(i==mx){
           par(mfrow=c(3,2))
        }
        title1<-paste("Trace of",object$pnames[i],sep=" ")
        title2<-paste("Density of",object$pnames[i],sep=" ")
        plot(object$mat[,i],type='l',main=title1,xlab="Iterations",ylab=" ")
        plot(density(object$mat[,i]),type='l',main=title2,xlab="Values", ylab="Density")
      }  
}
