add in some allele frq functions

CHANGELOG

@@ -1,3 +1,4 @@
+	Added in functions for allele frequency specification in populations and stages.
 	Changed the test for surv matrix norm 12/17/18
 
 You can always use "install_github("stranda/rmetasim") to get the most up to date copy of rmetasim.

DESCRIPTION

@@ -1,9 +1,9 @@
 Package: rmetasim
-Version: 3.1.8
+Version: 3.1.9
 Author: Allan Strand <stranda@cofc.edu>, 
 	James Niehaus
 Maintainer: Allan Strand <stranda@cofc.edu>
-Date: 2018-2-15
+Date: 2019-05-06
 Depends: R (>= 3.4.0)
 Imports: pegas,
 	 ade4,

NAMESPACE

@@ -50,3 +50,5 @@ export(landscape.mig.matrix)
 export(landscape.make.genind,landscape.make.genpop)
 export(landscape.ind.freq)
 export(landscape.freq.locnames)
+export(landscape.setallelefreq)
+export(landscape.setpopfreq)

R/is_landscape.R

@@ -80,7 +80,7 @@ is.landscape <- function(Rland=NULL,verb=TRUE,exact=FALSE)
               }
 
             if (max(apply(Rland$demography$localdem[[i]]$LocalS,2,sum))>1)
-              {
+            {
                 if (verb) {print(paste("Local survival matrix",i,"has a column that sums to a number greater than one"))}
                 ok <- FALSE
               }

R/landscape.setallelefreq.R

@@ -0,0 +1,105 @@
+
+##
+## function to specify allele frequencies on a per stage/per locus level
+##
+## rland is a landscape object
+## af is a heirarchical list with population/habitat as the top level
+## and locus as intermediate.  This object needs to have names in the top
+## level corresponding to stages and names on the next level corresponding
+## loci
+## all this function does is expand the populations into thier consitutent
+## stages and then calls landscape.setallelefreq with an updated "af"
+
+landscape.setpopfreq <- function(rland,af=NULL,states=TRUE)
+{
+    if (FALSE)
+    {
+        af <- list('1'=list('1'=c('1'=0.5,'2'=0.25,'5'=0.25),   #population 1 locus 1 
+                            '2'=c('1'=0.5,'2'=0.25,'3'=0.25)),  #population 1 locus 2
+                   '2'=list('1'=c('3'=0.5,'2'=0.35,'5'=0.15),   #population 2 locus 1
+                            '2'=c('2'=0.25,'3'=0.75)))          ##population 2 locus 2
+    }
+    posspops <- sort(unique(landscape.populations(rland)))
+    s=rland$intparam$stages
+    h=rland$intparam$habitats
+    newaf <- NULL
+    for (p in names(af))
+    {
+        pnum <- as.numeric(p)
+        stages <- ((pnum-1)*s):((pnum-1)*s + (s) - 1)
+        a <- af[[p]]
+        newaf <- c(newaf,lapply(stages,function(s)
+        {
+            lst <- list(a)
+            names(lst) <- s
+            lst
+        })
+        )
+    }
+    newaf <- unlist(newaf,recursive=F)
+    landscape.setallelefreq(rland,newaf,states)
+}
+
+
+
+
+##
+## function to specify allele frequencies on a per stage/per locus level
+##
+## rland is a landscape object
+## af is a heirarchical list with stage as the top level
+
+## and locus as intermediate.  This object needs to have names in the top
+## level corresponding to stages and names on the next level corresponding
+## loci
+
+landscape.setallelefreq <- function(rland,af=NULL,states=TRUE)
+{
+    if (FALSE)
+    {
+        af <- list('0'=list('1'=c('1'=0.5,'2'=0.25,'5'=0.25),'2'=c('1'=0.5,'2'=0.25,'3'=0.25)),
+                   '2'=list('1'=c('1'=0.5,'2'=0.35,'5'=0.15),'2'=c('1'=0.10,'2'=0.15,'3'=0.75)))
+    }
+
+    if (is.null(af))
+    {
+        print("specify at least some allele frequencies")
+    } else #there was an attempt to specify allelefreqs
+    {
+        locposition <- landscape.locusvec(rland) 
+        possLoc <- as.character(1:length(rland$loci))
+        possStgs <- as.character(0:((rland$intparam$habitats*rland$intparam$stages)-1))
+        ##check to see if stage names in af correspond to possStgs
+        if (length(which(!(names(af) %in% possStgs)))>0)
+        {
+            stop(paste("some stages in af do not exist in landscape"))
+        } else { #looks like we can truck through the stages
+            for (s in names(af)) #each s is a stage
+            {
+                inds <- rland$individuals[rland$individuals[,1]==as.numeric(s),]
+                for (l in names(af[[s]])) #cruise through the loci
+                    if (length(which(!(l%in%possLoc)))>0)
+                    {
+                        stop(paste("a locus name is not found in the landscape"))
+                    } else { #this locus is legal, lets make the changes
+                        av <- af[[s]][[l]] #this should be the allele frequency vector for l/pop
+                        if (sum(av)>1) {stop("allele freq vector sums to > 1")}
+                        lcols <- (which(as.character(locposition)==l)+landscape.democol())
+                        n=dim(inds)[1]
+
+                        if (states)
+                            {
+                                ai <- landscape.locus.states(rland,as.numeric(l))
+                                aindex <- ai$aindex[ai$state %in% names(av)]
+                            } else aindex <- names(av)
+print(lcols)
+                        for (a in lcols)
+                            inds[,a] <- as.numeric(sample(aindex,n,replace=T,prob=av))
+                    }
+                rland$individuals[s==as.character(rland$individuals[,1]),] <- inds
+            }
+
+        }
+    }
+    rland
+}

man/landscape.setallelefreq.Rd

@@ -0,0 +1,57 @@
+\name{landscape.setallelefreq}
+\alias{landscape.setallelefreq}
+\title{Set Allele frequencies in (a) specific stage(s)}
+
+\description{
+  This function takes a landscape and changes the allele frequencies in
+  different stages based on the list 'af'}
+\usage{
+## must be called AFTER landscape has been created and populated
+landscape.setallelefreq(rland,af=NULL,states=TRUE)
+}
+\arguments{
+  \item{rland}{landscape object, required}
+  \item{af}{a named list of named lists that specifies states, loci
+  and allele frequencies, see details}
+  \item{states}{(default=TRUE) are the alleles specified by state or by
+  allele index (allele indices are stored in the 'individuals'
+  sub-object}
+}
+
+\details{
+  The individual initilization function uses a global table of allele
+  frequencies (specified with landscape.new.locus()).  This function
+  re-writes the genotypes for specific demographic states and loci with new
+  values.  This way it is possible to create demographic state-specifc allele
+  frequency variation.
+
+  First the landscape passed to landscape.setpopfreq() must be
+  populated, usually by a call to landscape.new.individuals().  This
+  function cannot be used to add new loci or new alleles to the global
+  system.  
+
+  This function depends on the data structure 'af' which is a
+  hierarchical set of lists.  The highest level in the hierarchy is a
+  named list of demographic state (the first column of the 'individuals'
+  object).  Legal values for the names are the integers 0:(number of
+  states-1) then converted to characters.  Each element of this list is
+  itself a named list of loci.  Legal values for the names are the integers 1:number of
+  loci then converted to characters.  Each element of the loci list is a
+  named vector of allele frequencies.  The names for these vectors
+  correspond to either: allele states (including DNA sequences) or
+  allele indices (the numbers entered in the 'individuals' subobject as
+  genotypes).  The parameter states=TRUE results in the former behavior
+  and states=FALSE, the latter.
+  }
+
+\examples{
+  exampleland <- landscape.new.empty()
+  af <- list('0'=list('1'=c('1'=0.5,'2'=0.25,'5'=0.25),
+                      '2'=c('1'=0.5,'2'=0.25,'3'=0.25)),
+             '2'=list('1'=c('1'=0.5,'2'=0.35,'5'=0.15),
+                      '2'=c('1'=0.10,'2'=0.15,'3'=0.75)))
+
+  landscape.allelefreq(exampleland)
+  landscape.allelefreq(landscape.setallelefreq(exampleland, af))
+}
+\keyword{misc}

man/landscape.setpopfreq.Rd

@@ -0,0 +1,56 @@
+\name{landscape.setpopfreq}
+\alias{landscape.setpopfreq}
+\title{Set Allele frequencies in (a) specific population(s)}
+
+\description{
+  This function takes a landscape and changes the allele frequencies in
+  different populations based on the list 'af'}
+\usage{
+## must be called AFTER landscape has been created and populated
+landscape.setpopfreq(rland,af=NULL,states=TRUE)
+}
+\arguments{
+  \item{rland}{landscape object, required}
+  \item{af}{a named list of named lists that specifies populations, loci
+  and allele frequencies, see details}
+  \item{states}{(default=TRUE) are the alleles specified by state or by
+  allele index (allele indices are stored in the 'individuals'
+  sub-object}
+}
+
+\details{
+  The individual initilization function uses a global table of allele
+  frequencies (specified with landscape.new.locus()).  This function
+  re-writes the genotypes for specific populations and loci with new
+  values.  This way it is possible to create population-specifc allele
+  frequency variation.
+
+  First the landscape passed to landscape.setpopfreq() must be
+  populated, usually by a call to landscape.new.individuals().  This
+  function cannot be used to add new loci or new alleles to the global
+  system.  
+
+  This function depends on the data structure 'af' which is a
+  hierarchical set of lists.  The highest level in the hierarchy is a
+  named list of populations.  Legal values for the names are the integers 1:number of
+  pops then converted to characters.  Each element of this list is
+  itself a named list of loci.  Legal values for the names are the integers 1:number of
+  loci then converted to characters.  Each element of the loci list is a
+  named vector of allele frequencies.  The names for these vectors
+  correspond to either: allele states (including DNA sequences) or
+  allele indices (the numbers entered in the 'individuals' subobject as
+  genotypes).  The parameter states=TRUE results in the former behavior
+  and states=FALSE, the latter.
+  }
+
+\examples{
+  exampleland <- landscape.new.empty()
+  af <- list('1'=list('1'=c('1'=0.5,'2'=0.25,'5'=0.25),   #population 1 locus 1 
+                      '2'=c('1'=0.5,'2'=0.25,'3'=0.25)),  #population 1 locus 2
+             '2'=list('1'=c('3'=0.5,'2'=0.35,'5'=0.15),   #population 2 locus 1
+                      '2'=c('2'=0.25,'3'=0.75)))          ##population 2 locus 2
+
+  landscape.allelefreq(exampleland)
+  landscape.allelefreq(landscape.setpopfreq(exampleland, af))
+}
+\keyword{misc}