R/initBN.fromVars.R

In fbnet: Forensic Bayesian Networks

#' initBN.fromVars: a function to initialize the bayesian network.
#'
#' @param bplotped An alternative ped object to be compared. 
#' @import graphics
#' @export
#' @return A bayesian network.

initBN.fromVars<-function(bplotped){
locus <- paux <- NULL
persons <- pid <- mid <- sex <- systems <- lLociFreq <- linkageR <- bSimuData <- simuKnownIds <- QP <- NULL
myloci <- list()
for(i in seq_along(systems)){
 if(!systems[i]%in%names(lLociFreq)) next
 freqs <- lLociFreq[[systems[i]]][,"freq"]
 anames<- lLociFreq[[systems[i]]][,"Alelo"]
 anames[anames=="0"]<-"zero"
 if(sum(freqs)>1) freqs<-freqs/sum(freqs)
 if(1-sum(freqs)>1e-4){
  freqs<-c(freqs,1-freqs)
  anames<-c(anames,"ExtraAlelle")
 } 
 myloci[[systems[i]]]<-locus
}

markerLinkage<- data.frame(linkedTo=rep("",length(systems)),
                           recomb=rep(0.5,length(systems)),stringsAsFactors=FALSE)
rownames(markerLinkage)<-systems
for(i in seq_along(linkageR)){
 if(linkageR[i]!=0.5 & i>1){
  markerLinkage[i,"linkedTo"] <- rownames(markerLinkage)[i-1]
  markerLinkage[i,"recomb"]   <- linkageR[i]  
 }
}

 

if(bSimuData){ 
  knownIds <- simuKnownIds
  datamatrix<-c()
  for(i in seq_along(systems)){
   afreq <- myloci[[i]]$alleles
 
   m <- c(matrix(paux$markerdata[[1]],ncol=2))
   m[m!=0]<-attr(paux$markerdata[[1]],"alleles")[m[m!=0]]
   mallele<- matrix(m,ncol=2)
   colnames(mallele)<-paste(paste0("locus",i),c("p","m"),sep=".")
   rownames(mallele)<-paux$orig.ids
   
   datamatrix<-cbind(datamatrix,mallele)
   datamatrix[datamatrix=="0"]<-NA   
   
  }    
 }else{

  rownames(datamatrix)<-persons              
  knownIds <- rownames(datamatrix)[!is.na(datamatrix[,1])]
  for(i in seq_along(systems)){
   freqs <- lLociFreq[[systems[i]]][,"freq"]
   anames<- lLociFreq[[systems[i]]][,"Alelo"]
   anames[anames=="0"]<-"100"
   if(sum(freqs)>1) freqs<-freqs/sum(freqs)
   if(1-sum(freqs)>1e-4){ 
    freqs<-c(freqs,1-freqs)
    anames<-c(anames,"ExtraAlelle")
   }   
  
  } 
  
} 
if(!is.null(QP)){
 

 auxped$pedigree[auxped$orig.ids%in%QP,"AFF"]<-2
}

if(bplotped){
	graphics::plot(auxped,mark=1:min(3,length(myloci)))
 graphics::mtext(paste("H1:",length(myloci),"markers"))
}


 alelFreq <- lapply(auxped$markerdata,function(x){
                         res<-attr(x,"afreq");
                         names(res)<-attr(x,"alleles")
                         return(res)
                         })
 names(alelFreq) <- unlist(lapply(auxped$markerdata,function(x){
                         res<-attr(x,"name");
                         return(res)
                         })) 

 knownIds <- knownIds[!knownIds%in%QP]
                         
 m <- datamatrix[knownIds,]
 colnames(m)<-paste(rep(systems,each=2),c("p","m"),sep="_")
 markerEvidence<-t(apply(m,1,as.character))
 colnames(markerEvidence)<-colnames(m)
 rownames(markerEvidence)<-rownames(m)
 
 mmodel <- list()
 mmodel[["hombre"]]<-list(none=c())
 mmodel[["mujer"]]<-list(none=c())
 
  return(list(ped=auxped, markerEvidence=markerEvidence,markerLinkage=markerLinkage,alelFreq=alelFreq,
              mmodel=mmodel))
 
}