R/as.HMSCprior.R

Defines functions as.HMSCprior

Documented in as.HMSCprior

as.HMSCprior <-
function(HMSCparam,means0=NULL,kappa0,nu0,Lambda0,sigma0=NULL,priorRandom=NULL){
#### F. Guillaume Blanchet - February 2013, April 2013, July 2013, August 2013
##########################################################################################
	if(!any(class(HMSCparam)=="HMSCparamTr")){
		if(length(means0)!=length(HMSCparam$means)){
			stop("'means0' should have the same length as 'means'")
		}
	
		if(!isSymmetric(Lambda0)){
			stop("'Lambda0' should be symmetric")
		}
	
		if(nrow(Lambda0)!=nrow(HMSCparam$sigma)){
			stop("'Lambda0' should have the same length as 'HMSCparam$sigma'")
		}
	
		if(ncol(Lambda0)!=ncol(HMSCparam$sigma)){
			stop("'Lambda0' should have the same length as 'HMSCparam$sigma'")
		}
	
		if(is.null(names(means0))){
			names(means0)<-names(HMSCparam$means)
			print("names were added to 'means0' in such a way that they match the names in 'HMSCparam$means'")
		}
		if(!is.null(sigma0)){
			if(length(sigma0)>1){
				stop("'sigma0' should be a single value")
			}
		}
		
		if(is.null(sigma0)){
			res<-list(means0=means0,kappa0=kappa0,nu0=nu0,Lambda0=Lambda0)
		}
		if(!is.null(sigma0)){
			res<-list(means0=means0,kappa0=kappa0,nu0=nu0,Lambda0=Lambda0,sigma0=sigma0)
		}
	}else{
		if(!isSymmetric(Lambda0)){
			stop("'Lambda0' should be symmetric")
		}
	
		if(nrow(Lambda0)!=nrow(HMSCparam$sigma)){
			stop("'Lambda0' should have the same length as 'HMSCparam$sigma'")
		}
	
		if(ncol(Lambda0)!=ncol(HMSCparam$sigma)){
			stop("'Lambda0' should have the same length as 'HMSCparam$sigma'")
		}
		if(!is.null(sigma0)){
			if(length(sigma0)>1){
				stop("'sigma0' should be a single value")
			}
		}
		
		if(is.null(sigma0)){
			res<-list(kappa0=kappa0,nu0=nu0,Lambda0=Lambda0)
		}
		if(!is.null(sigma0)){
			res<-list(kappa0=kappa0,nu0=nu0,Lambda0=Lambda0,sigma0=sigma0)
		}
	}
	
	if(any(class(HMSCparam)=="HMSCparamRandom")){
		if(length(priorRandom)!=2){
			stop("'priorRandom' should have two values defining the mean and standard deviation of the prior for 'RandomVar'")
		}
	}
	
	class(res)<-"HMSCprior"
	return(res)
}

Try the HMSC package in your browser

Any scripts or data that you put into this service are public.

HMSC documentation built on May 2, 2019, 6:53 p.m.