R/as.HMSCparam.R

In HMSC: Hierarchical modelling of species community

as.HMSCparam <-
function(HMSCdata,paramX,paramTr=NULL,paramRandom=NULL,means=NULL,sigma,RandomVar=NULL,RandomCommSp=NULL){
#### F. Guillaume Blanchet - February 2013, February 2014
##########################################################################################
	### Name checks paramX
	if(is.null(colnames(paramX))){
		colnames(paramX)<-paste("p",1:ncol(paramX),sep="")
		print("generic column names were added to 'paramX'")
	}
	
	if(is.null(rownames(paramX))){
		rownames(paramX)<-colnames(HMSCdata$Y)
		print("row names were added to'paramX' using the column names of 'HMSCdata$Y'")
	}else{
		if(!all(rownames(paramX)%in%colnames(HMSCdata$Y))){
			stop("At least one row name from 'paramX' is different from the column names of 'HMSCdata$Y'")
		}
	}
	
	### Check dimensions
	if(nrow(paramX)!=ncol(HMSCdata$Y)){
		stop("The number of rows in 'paramX' should be the same as the number of column in 'HMSCdata$Y'")
	}
	
	### Random effect
	if(any(class(HMSCdata)=="HMSCdataRandom")){
		#==============
		### paramRandom
		#==============
		if(is.null(colnames(paramRandom))){
			colnames(paramRandom)<-paste("r",1:ncol(paramRandom),sep="")
			print("generic column names were added to 'paramRandom'")
		}
		
		if(is.null(rownames(paramRandom))){
			rownames(paramRandom)<-colnames(HMSCdata$Y)
			print("row names were added to 'paramRandom' using the column names of 'HMSCdata$Y'")
		}else{
			if(!all(rownames(paramRandom)%in%colnames(HMSCdata$Y))){
				stop("At least one row name from 'paramRandom' is different from the column names of 'HMSCdata$Y'")
			}
		}
		
		### Check dimensions
		if(nrow(paramRandom)!=ncol(HMSCdata$Y)){
			stop("The number of rows in 'paramRandom' should be the same as the number of column in 'HMSCdata$Y'")
		}
		#============
		### RandomVar # This might need to be tweaked when RandomCommSp will be estimated
		#============
		if(is.null(RandomVar)){
			stop("'RandomVar' needs to be larger than 'RandomCommSp'")
		}
		
		if(length(RandomVar)!=1 | is.list(RandomCommSp)){
			stop("'RandomVar' needs to be a scalar")
		}
		
		if(RandomVar <= RandomCommSp){
			stop("'RandomVar' needs to be larger than 'RandomCommSp'")
		}
		
		#===============
		### RandomCommSp # All of this will have to be removed when this parameter will be estimated
		#===============
		if(is.null(RandomCommSp)){
			stop("'RandomCommSp' needs to range from 0 to 1")
		}
		
		if(length(RandomCommSp)!=1 | is.list(RandomCommSp)){
			stop("'RandomCommSp' needs to be a scalar that ranges from 0 to 1")
		}
		
		if(!(RandomCommSp >= 0 & RandomCommSp < RandomVar)){
			stop("'RandomCommSp' needs to be a scalar that is larger than or equal to 0 but smaller than 'RandomVar'")
		}
	
		### Log transform "RandomVar"
#		RandomVar<-log(RandomVar)
#		print("'RandomVar' has been log transformed")
	}
	
	### Traits
	if(!any(class(HMSCdata)=="HMSCdataTrait")){
		if(length(means)!=ncol(paramX)){
			stop("'means' should have the same length as there are columns in 'paramX'")
		}
		if(is.null(names(means))){
			names(means)<-colnames(paramX)
			print("names were added to'means'")
		}
	
		if(!any(colnames(paramX)%in%names(means))){
			stop("The colnames of 'paramX' should be the same as the names of 'means'")
		}
	}
	
	if(any(class(HMSCdata)=="HMSCdataTrait")){
		if(!is.null(means)){
			if(is.null(paramTr)){
				stop("'paramTr' should be given")
			}
			if(length(dim(means))!=2){
				stop("'means' should be a table with 2 dimensions")
			}
			if(is.null(colnames(means))){
				colnames(means)<-colnames(HMSCdata$Y)
				print("column names were added to 'means'")
			}
			if(is.null(rownames(means))){
				rownames(means)<-colnames(paramX)
				print("row names were added to 'means'")
			}
		}
		
		if(is.null(colnames(paramTr))){
			colnames(paramTr)<-paste("t",1:ncol(paramTr),sep="")
			print("generic column names were added to 'paramTr'")
		}
		
		if(is.null(rownames(paramTr))){
			rownames(paramTr)<-paste("p",1:ncol(paramX),sep="")
			print("generic row names were added to 'paramTr'")
		}
	}
	
	### Check names for sigma
	if(is.null(colnames(sigma))){
		colnames(sigma)<-colnames(paramX)
		print("column names were added to'sigma'")
	}
	
	if(is.null(rownames(sigma))){
		rownames(sigma)<-colnames(paramX)
		print("row names were added to'sigma'")
	}
	
	if(!any(colnames(sigma)%in%rownames(sigma))){
		stop("'sigma' should have row names that matches columns names")
	}
	
	if(!any(colnames(paramX)%in%colnames(sigma))){
		stop("The column names of 'paramX' and 'sigma' do not match and they should")
	}
	
	if(!any(class(HMSCdata)=="HMSCdataTrait")){
		if(!any(names(means)%in%colnames(sigma))){
			stop("The column names of 'sigma' and the names of 'means' do not match and they should")
		}
	}
	
	if(!any(class(HMSCdata)=="HMSCdataRandom")){
		if(!any(class(HMSCdata)=="HMSCdataTrait")){
			res<-list(paramX=paramX,means=means,sigma=sigma)
		}else{
			res<-list(paramX=paramX,paramTr=paramTr,means=means,sigma=sigma)
		}
	}else{
		if(!any(class(HMSCdata)=="HMSCdataTrait")){
			res<-list(paramX=paramX,paramRandom=paramRandom,means=means,sigma=sigma,RandomVar=RandomVar,RandomCommSp=RandomCommSp)
		}else{
			res<-list(paramX=paramX,paramRandom=paramRandom,paramTr=paramTr,means=means,sigma=sigma,RandomVar=RandomVar,RandomCommSp=RandomCommSp)
		}
	}
	
	if(any(class(HMSCdata)=="HMSCdataTrait") & any(class(HMSCdata)=="HMSCdataRandom")){
		class(res)<-c("HMSCparam","HMSCparamTrait","HMSCparamRandom")
	}else{
		if(any(class(HMSCdata)=="HMSCdataTrait")){
			class(res)<-c("HMSCparam","HMSCparamTrait")
		}
		if(any(class(HMSCdata)=="HMSCdataRandom")){
			class(res)<-c("HMSCparam","HMSCparamRandom")
		}
		if(all(class(HMSCdata)=="HMSCdata")){
			class(res)<-"HMSCparam"
		}
	}
	
	return(res)
}