R/class_conversion.R

In polysat: Tools for Polyploid Microsatellite Analysis

# Function to find unique alleles at a locus
.unal1loc <- function(object, samples, locus){
  if(!is(object, "genambig"))
    stop("Object must be of class genambig")
  if(missing(samples)) samples <- Samples(object)
  if(missing(locus)) stop("locus argument needed.")
  
  if(length(samples) == 1){
    al <- sort(unique(Genotype(object, samples, locus)))
  } else {
    al <- sort(unique(stack(object@Genotypes[samples,locus])$values))
  }
  al <- al[al != Missing(object)]
  return(al)
}

genambig.to.genbinary <- function(object, samples=Samples(object), loci=Loci(object)){
    # set up the object that will ultimately be returned
    objectN <- new("genbinary", samples, loci)

    # fill in the slots that will be identical
    PopNames(objectN) <- PopNames(object)
    if(!all(is.na(PopInfo(object)[samples]))){
      PopInfo(objectN) <- PopInfo(object)[samples]
    }
    Usatnts(objectN) <- Usatnts(object)[loci]
    Description(objectN) <- Description(object)
    if(is(object@Ploidies, "ploidyone")){
      objectN@Ploidies <- object@Ploidies
    }
    if(is(object@Ploidies, "ploidysample")){
      objectN@Ploidies <- new("ploidysample", samples=samples)
      Ploidies(objectN) <- Ploidies(object)[samples]
    }
    if(is(object@Ploidies, "ploidylocus")){
      objectN@Ploidies <- new("ploidylocus", loci=loci)
      Ploidies(objectN) <- Ploidies(object)[loci]
    }
    if(is(object@Ploidies, "ploidymatrix")){
      Ploidies(objectN) <- Ploidies(object)[samples, loci]
    }

    # find all unique alleles for each locus
    locvector<-c()
    allelevector<-c()
    for(L in loci){
      # skip if there are no genotypes
      if(all(isMissing(object, samples, L))) next
      # find the alleles
      thesealleles <- .unal1loc(object, samples, L)
      locvector <- c(locvector, rep(L, length(thesealleles)))
      allelevector <- c(allelevector, thesealleles)
    }

    # Build data frame of locus and allele information
    colinfo <- data.frame(Loci=locvector, Alleles=allelevector,
                          stringsAsFactors=FALSE)
    # Set up matrix to ultimately put in the Genotypes slot
    domdata <- matrix(nrow = length(samples), ncol=dim(colinfo)[1],
                      dimnames=list(samples, paste(locvector, allelevector,
                      sep=".")))
    # Fill the matrix
    for(m in 1:dim(colinfo)[1]){
        for(s in samples){
            if(isMissing(object, s, colinfo[m,1])){
                domdata[s,m] <- Missing(objectN)
            } else {
                if(colinfo[[m,2]] %in% Genotype(object, s, colinfo[m,1])){
                    domdata[s,m] <- Present(objectN)
                } else { domdata[s,m] <- Absent(objectN) }
            }
        }
    }

    # Fill in genotypes slot
    Genotypes(objectN) <- domdata

    # return the converted object
    return(objectN)
}

genbinary.to.genambig <- function(object, samples = Samples(object),
                                  loci = Loci(object)){
    # set up new genambig object
    objectN <- new("genambig", samples, loci)

    # fill in the slots that will be identical
    PopNames(objectN) <- PopNames(object)
    if(!all(is.na(PopInfo(object)[samples]))){
      PopInfo(objectN) <- PopInfo(object)[samples]
    }
    Usatnts(objectN) <- Usatnts(object)[loci]
    Description(objectN) <- Description(object)
    if(is(object@Ploidies, "ploidyone")){
      objectN@Ploidies <- object@Ploidies
    }
    if(is(object@Ploidies, "ploidysample")){
      objectN@Ploidies <- new("ploidysample", samples=samples)
      Ploidies(objectN) <- Ploidies(object)[samples]
    }
    if(is(object@Ploidies, "ploidylocus")){
      objectN@Ploidies <- new("ploidylocus", loci=loci)
      Ploidies(objectN) <- Ploidies(object)[loci]
    }
    if(is(object@Ploidies, "ploidymatrix")){
      Ploidies(objectN) <- Ploidies(object)[samples, loci]
    }

    # Go through matrix one locus at a time to get genotypes
    for(L in loci){
        thesegen <- as.matrix(Genotypes(object, samples, L))
        # Go through each allele
        for(n in 1:dim(thesegen)[2]){
            allele <- strsplit(dimnames(thesegen)[[2]][n], split=".",
                               fixed=TRUE)[[1]][2]
            allele <- as.integer(allele)
            # Look for allele in each sample and write to new object
            for(s in samples){
                if(thesegen[s,n] == Present(object)){
                    if(isMissing(objectN, s, L)){
                        Genotype(objectN, s, L) <- allele
                    } else {
                        Genotype(objectN, s, L) <- c(Genotype(objectN, s, L),
                                                     allele)
                    }
                }
            }
        }
    }

    # return the new genambig object
    return(objectN)
}