[Ipmpack-users] sensParams problem
Eelke Jongejans
e.jongejans at science.ru.nl
Tue Apr 2 11:45:52 CEST 2013
Dear Kimmy,
you asked why sensParams doesn't work when all offspring go to discrete
classes. We have found the bug (offspringRel (i.e. the relationship
between offspring size and parent size) is, of course, not defined in
such a case). Below you can find a fixed version of sensParams that will
take this into account. It will also be in the next version of IPMpack.
best wishes,
Jess, Eelke
-----------------------------------------
Hey all,
I am trying to use sensParams on my IPM, and am getting the error message
"Error infecObj at offspringRel <http://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/ipmpack-users>$coeff :
object of type 'S4' is not subsettable"
My fecObj is : fvS<-makeFecObj(SIPM,Formula=(fec2~size),Family="binomial",fecConstants
= data.frame(seedlingsPerRep=2.5),
offspringSplitter=data.frame(continuous=0,Seedling=1),
)
and the offspringRE1 slot says:
Slot "offspringRel":
<S4 Type Object>
attr(,".S3Class")
[1] "lm"
Anyone know how to make it NOT an S4 type object?? Thanks!!
-Kimmy Kellett
------------------------------------------
## Sensitivity of parameters - works for an IPM built out of
## growth, survival, discreteTrans, fecundity and clonality objects.
##
sensParams <- function (growObj, survObj, fecObj=NULL, clonalObj=NULL,
nBigMatrix, minSize, maxSize,
chosenCov = data.frame(covariate = 1), discreteTrans = 1,
integrateType = "midpoint", correction = "none", preCensus = TRUE,
delta = 1e-04, response="lambda", chosenBin=1) {
if (response!="lambda" & response!="R0" & response !="lifeExpect")
stop("response must be one of lambda or R0 or lifeExpect")
nmes <- elam <- slam <- c()
# get the base
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix, minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize, growObj = growObj,
survObj = survObj, discreteTrans = discreteTrans,
integrateType = integrateType,
correction = correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix, minSize =
minSize,
chosenCov = chosenCov, maxSize = maxSize, fecObj = fecObj,
integrateType = integrateType, correction = correction,
preCensus = preCensus, survObj = survObj, growObj =
growObj)
} else {Fmatrix <- Pmatrix*0 }
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix, minSize =
minSize,
chosenCov = chosenCov, maxSize = maxSize, clonalObj =
clonalObj,
integrateType = integrateType, correction = correction,
preCensus = preCensus, survObj = survObj, growObj =
growObj)
} else {Cmatrix <- Pmatrix*0 }
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc1 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc1 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc1 <- meanLifeExpect(Pmatrix)[chosenBin]
# 1. survival
for (j in 1:length(survObj at fit$coeff)) {
survObj at fit$coefficients[j] <- survObj at fit$coefficients[j] * (1
+ delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj = growObj,
survObj = survObj, discreteTrans = discreteTrans,
chosenCov = chosenCov, integrateType = integrateType,
correction = correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, fecObj = fecObj,
integrateType = integrateType, correction = correction,
chosenCov = chosenCov, preCensus = preCensus,
survObj = survObj,
growObj = growObj)
}
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize, clonalObj
= clonalObj,
integrateType = integrateType, correction = correction,
preCensus = preCensus, survObj = survObj, growObj =
growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
survObj at fit$coefficients[j] <- survObj at fit$coefficients[j]/(1 +
delta)
slam <- c(slam, (rc2 -
rc1)/((as.numeric(survObj at fit$coefficients[j]))* delta))
elam <- c(elam, (rc2 - rc1)/(rc1 *delta))
nmes <- c(nmes,
as.character(paste("survival:",names(survObj at fit$coeff)[j])))
}
# 2 growth
for (j in 1:length(growObj at fit$coeff)) {
growObj at fit$coefficients[j] <- growObj at fit$coefficients[j] * (1
+ delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj = growObj,
chosenCov = chosenCov, survObj = survObj, discreteTrans
= discreteTrans,
integrateType = integrateType, correction = correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, fecObj = fecObj,
chosenCov = chosenCov, integrateType = integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj,
growObj = growObj)
}
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize, clonalObj
= clonalObj,
integrateType = integrateType, correction = correction,
preCensus = preCensus, survObj = survObj, growObj =
growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
growObj at fit$coefficients[j] <- growObj at fit$coefficients[j]/(1 +
delta)
slam <- c(slam, (rc2 -
rc1)/(as.numeric(growObj at fit$coefficients[j]) * delta))
elam <- c(elam, (rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,
as.character(paste("growth:",names(growObj at fit$coeff)[j])))
}
growObj at sd <- growObj at sd * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix, minSize = minSize,
maxSize = maxSize, growObj = growObj, survObj = survObj,
chosenCov = chosenCov, discreteTrans = discreteTrans,
integrateType = integrateType, correction = correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix, minSize =
minSize,
maxSize = maxSize, fecObj = fecObj, integrateType =
integrateType,
chosenCov = chosenCov, correction = correction,
preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix, minSize =
minSize,
chosenCov = chosenCov, maxSize = maxSize, clonalObj =
clonalObj,
integrateType = integrateType, correction = correction,
preCensus = preCensus, survObj = survObj, growObj =
growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <- meanLifeExpect(Pmatrix)[chosenBin]
growObj at sd <- growObj at sd / (1 + delta)
slam <- c(slam,(rc2 - rc1)/(growObj at sd * delta))
elam <- c(elam, (rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes, "growth: sd")
# 3. DiscreteTrans
if (class(discreteTrans)=="discreteTrans") {
for (j in 1:(ncol(discreteTrans at discreteTrans)-1)) {
for (i in 1:(nrow(discreteTrans at discreteTrans)-1)) {
discreteTrans at discreteTrans[i,j]<-discreteTrans at discreteTrans[i,j] * (1
+ delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, growObj = growObj, survObj =
survObj,
chosenCov = chosenCov, discreteTrans =
discreteTrans,
integrateType = integrateType, correction =
correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix =
nBigMatrix, minSize = minSize,
maxSize = maxSize, fecObj = fecObj,
integrateType = integrateType,
chosenCov = chosenCov, correction =
correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix =
nBigMatrix, minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
discreteTrans at discreteTrans[i,j]<-discreteTrans at discreteTrans[i,j] / (1
+ delta)
slam <- c(slam,(rc2 -
rc1)/(discreteTrans at discreteTrans[i,j] * delta))
elam <- c(elam, (rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,
as.character(paste("discrete:",dimnames(discreteTrans at discreteTrans)[[2]][j],"to",dimnames(discreteTrans at discreteTrans)[[1]][i])))
}
}
#if there is more than 2 discrete stages (beyond "continuous"
"dead" and one discrete stage)
#then survToDiscrete tells you how many of surviving continuous
individuals are going into
#discrete classes, but how they distributed also; which is the
last column in discreteTrans
if (nrow(discreteTrans at discreteTrans)>3) {
for (i in 1:(nrow(discreteTrans at discreteTrans)-2)) {
discreteTrans at discreteTrans[i,"continuous"]<-discreteTrans at discreteTrans[i,"continuous"]
* (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, growObj = growObj, survObj =
survObj,
chosenCov = chosenCov, discreteTrans =
discreteTrans,
integrateType = integrateType, correction =
correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix =
nBigMatrix, minSize = minSize,
maxSize = maxSize, fecObj = fecObj,
integrateType = integrateType,
chosenCov = chosenCov, correction =
correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix =
nBigMatrix, minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
discreteTrans at discreteTrans[i,"continuous"]<-discreteTrans at discreteTrans[i,"continuous"]
/ (1 + delta)
slam <- c(slam,(rc2 -
rc1)/(discreteTrans at discreteTrans[i,"continuous"] * delta))
elam <- c(elam, (rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes, as.character(paste("discrete:
Continuous to",dimnames(discreteTrans at discreteTrans)[[1]][i])))
}
}
for (j in 1:length(discreteTrans at meanToCont)) {
discreteTrans at meanToCont[1,j]<-discreteTrans at meanToCont[1,j] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, growObj = growObj, survObj =
survObj,
chosenCov = chosenCov, discreteTrans = discreteTrans,
integrateType = integrateType, correction = correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, fecObj = fecObj,
integrateType = integrateType,
chosenCov = chosenCov, correction = correction,
preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
discreteTrans at meanToCont[1,j]<-discreteTrans at meanToCont[1,j] / (1 + delta)
slam <- c(slam,(rc2 - rc1)/(discreteTrans at meanToCont[1,j] *
delta))
elam <- c(elam, (rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes, as.character(paste("discrete:
meanToCont",dimnames(discreteTrans at meanToCont)[[2]][j])))
}
for (j in 1:length(discreteTrans at sdToCont)) {
discreteTrans at sdToCont[1,j]<-discreteTrans at sdToCont[1,j] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, growObj = growObj, survObj =
survObj,
chosenCov = chosenCov, discreteTrans = discreteTrans,
integrateType = integrateType, correction = correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, fecObj = fecObj,
integrateType = integrateType,
chosenCov = chosenCov, correction = correction,
preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
discreteTrans at sdToCont[1,j]<-discreteTrans at sdToCont[1,j] / (1 + delta)
slam <- c(slam,(rc2 - rc1)/(discreteTrans at sdToCont[1,j] *
delta))
elam <- c(elam, (rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes, as.character(paste("discrete:
sdToCont",dimnames(discreteTrans at sdToCont)[[2]][j])))
}
for (j in 1:length(discreteTrans at survToDiscrete$coef)) {
discreteTrans at survToDiscrete$coefficients[j]<-discreteTrans at survToDiscrete$coefficients[j]
* (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, growObj = growObj, survObj =
survObj,
chosenCov = chosenCov, discreteTrans = discreteTrans,
integrateType = integrateType, correction = correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, fecObj = fecObj,
integrateType = integrateType,
chosenCov = chosenCov, correction = correction,
preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
discreteTrans at survToDiscrete$coefficients[j]<-discreteTrans at survToDiscrete$coefficients[j]
/ (1 + delta)
slam <- c(slam,(rc2 -
rc1)/(as.numeric(discreteTrans at survToDiscrete$coefficients[j]) * delta))
elam <- c(elam, (rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes, as.character(paste("discrete:
survToDiscrete",names(discreteTrans at survToDiscrete$coefficients)[j])))
}
}
# 4. Fecundity
if (!is.null(fecObj)) {
for (i in 1:length(fecObj at fitFec)) {
for (j in 1:length(fecObj at fitFec[[i]]$coefficients)) {
fecObj at fitFec[[i]]$coefficients[j] <-
fecObj at fitFec[[i]]$coefficients[j] *
(1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, fecObj =
fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix =
nBigMatrix, minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
fecObj at fitFec[[i]]$coefficients[j] <-
fecObj at fitFec[[i]]$coefficients[j]/(1 + delta)
slam <- c(slam,(rc2 -
rc1)/((as.numeric(fecObj at fitFec[[i]]$coefficients[j]) * delta)))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,paste("fecundity: func", i,
names(fecObj at fitFec[[i]]$coefficients)[j]))
}
}
chs <- which(!is.na(as.numeric(fecObj at fecConstants)), arr.ind =
TRUE)
if (length(chs) > 0) {
for (j in 1:length(chs)) {
fecObj at fecConstants[1,chs[j]] <-
fecObj at fecConstants[1,chs[j]] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, fecObj =
fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix =
nBigMatrix, minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
fecObj at fecConstants[1, chs[j]] <-
fecObj at fecConstants[1,chs[j]]/(1 + delta)
slam <- c(slam,(rc2 -
rc1)/(as.numeric(fecObj at fecConstants[1,chs[j]] * delta)))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,paste("fecundity:
constant",names(fecObj at fecConstants)[chs[j]]))
}
}
if (max(fecObj at offspringSplitter)<1) {
for (j in which(fecObj at offspringSplitter>0)) {
fecObj at offspringSplitter[j] <-
fecObj at offspringSplitter[j] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, fecObj =
fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix =
nBigMatrix, minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
fecObj at offspringSplitter[j] <-
fecObj at offspringSplitter[j] / (1 + delta)
slam <- c(slam,(rc2 -
rc1)/(as.numeric(fecObj at offspringSplitter[j] * delta)))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,paste("fecundity:
offspringSplitter",names(fecObj at offspringSplitter[j])))
}
}
chs <- which(!is.na(as.numeric(fecObj at fecByDiscrete)), arr.ind
= TRUE)
if (length(chs) > 0) {
for (j in 1:length(chs)) {
fecObj at fecByDiscrete[1,chs[j]] <-
fecObj at fecByDiscrete[1,chs[j]] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, fecObj =
fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix =
nBigMatrix, minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
fecObj at fecByDiscrete[1,chs[j]] <-
fecObj at fecByDiscrete[1,chs[j]] / (1 + delta)
slam <- c(slam,(rc2 -
rc1)/(as.numeric(fecObj at fecByDiscrete[1,chs[j]] * delta)))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,paste("fecundity:
fecByDiscrete",names(fecObj at fecByDiscrete)[chs[j]]))
}
}
if (class(fecObj at offspringRel)=="lm") {
for (j in 1:length(fecObj at offspringRel$coeff)) {
fecObj at offspringRel$coefficients[j] <-
fecObj at offspringRel$coefficients[j] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, fecObj =
fecObj,
integrateType = integrateType, correction =
correction,
chosenCov = chosenCov, preCensus = preCensus,
survObj = survObj,
growObj = growObj)
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix =
nBigMatrix, minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
fecObj at offspringRel$coefficients[j] <-
fecObj at offspringRel$coefficients[j]/(1 + delta)
slam <- c(slam,(rc2 -
rc1)/(as.numeric(fecObj at offspringRel$coefficients[j]) *delta))
elam <- c(elam,(rc2 - rc1)/(rc1 *delta))
nmes <- c(nmes, as.character(paste("fecundity:
offspring rel ",names(fecObj at offspringRel$coeff)[j])))
}
fecObj at sdOffspringSize <- fecObj at sdOffspringSize * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, growObj = growObj, chosenCov =
chosenCov,
survObj = survObj, discreteTrans = discreteTrans,
integrateType = integrateType,
correction = correction)
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, fecObj = fecObj, chosenCov =
chosenCov,
integrateType = integrateType, correction = correction,
preCensus = preCensus, survObj = survObj, growObj =
growObj)
if (!is.null(clonalObj)) {
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
}
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
fecObj at sdOffspringSize <- fecObj at sdOffspringSize/(1 + delta)
slam <- c(slam,(rc2 - rc1)/(fecObj at sdOffspringSize * delta))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes, "fecundity: sd offspring size")
}
}
# 5. Clonality
if (!is.null(clonalObj)) {
for (i in 1:length(clonalObj at fitFec)) {
for (j in 1:length(clonalObj at fitFec[[i]]$coefficients)) {
clonalObj at fitFec[[i]]$coefficients[j] <-
clonalObj at fitFec[[i]]$coefficients[j] *
(1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize,
fecObj = fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
clonalObj at fitFec[[i]]$coefficients[j] <-
clonalObj at fitFec[[i]]$coefficients[j]/(1 + delta)
slam <- c(slam,(rc2 -
rc1)/((as.numeric(clonalObj at fitFec[[i]]$coefficients[j]) * delta)))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,paste("clonality: func", i,
names(clonalObj at fitFec[[i]]$coefficients)[j]))
}
}
chs <- which(!is.na(as.numeric(clonalObj at fecConstants)),
arr.ind = TRUE)
if (length(chs) > 0) {
for (j in 1:length(chs)) {
clonalObj at fecConstants[1,chs[j]] <-
clonalObj at fecConstants[1,chs[j]] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize,
fecObj = fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
clonalObj at fecConstants[1, chs[j]] <-
clonalObj at fecConstants[1,chs[j]]/(1 + delta)
slam <- c(slam,(rc2 -
rc1)/(as.numeric(clonalObj at fecConstants[1,chs[j]] * delta)))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,paste("clonality:
constant",names(clonalObj at fecConstants)[chs[j]]))
}
}
if (max(clonalObj at offspringSplitter)<1) {
for (j in which(clonalObj at offspringSplitter>0)) {
clonalObj at offspringSplitter[j] <-
clonalObj at offspringSplitter[j] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize,
fecObj = fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
clonalObj at offspringSplitter[j] <-
clonalObj at offspringSplitter[j] / (1 + delta)
slam <- c(slam,(rc2 -
rc1)/(as.numeric(clonalObj at offspringSplitter[j] * delta)))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,paste("clonality:
offspringSplitter",names(clonalObj at offspringSplitter[j])))
}
}
chs <- which(!is.na(as.numeric(clonalObj at fecByDiscrete)),
arr.ind = TRUE)
if (length(chs) > 0) {
for (j in 1:length(chs)) {
clonalObj at fecByDiscrete[1,chs[j]] <-
clonalObj at fecByDiscrete[1,chs[j]] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize,
fecObj = fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
clonalObj at fecByDiscrete[1,chs[j]] <-
clonalObj at fecByDiscrete[1,chs[j]] / (1 + delta)
slam <- c(slam,(rc2 -
rc1)/(as.numeric(clonalObj at fecByDiscrete[1,chs[j]] * delta)))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes,paste("clonality:
fecByDiscrete",names(clonalObj at fecByDiscrete)[chs[j]]))
}
}
if (class(clonalObj at offspringRel)=="lm") {
for (j in 1:length(clonalObj at offspringRel$coeff)) {
clonalObj at offspringRel$coefficients[j] <-
clonalObj at offspringRel$coefficients[j] * (1 + delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, growObj =
growObj,
chosenCov = chosenCov, survObj = survObj,
discreteTrans = discreteTrans,
integrateType = integrateType, correction =
correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize,
fecObj = fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize,
clonalObj = clonalObj,
integrateType = integrateType, correction =
correction,
preCensus = preCensus, survObj = survObj,
growObj = growObj)
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
clonalObj at offspringRel$coefficients[j] <-
clonalObj at offspringRel$coefficients[j]/(1 + delta)
slam <- c(slam,(rc2 -
rc1)/(as.numeric(clonalObj at offspringRel$coefficients[j]) *delta))
elam <- c(elam,(rc2 - rc1)/(rc1 *delta))
nmes <- c(nmes, as.character(paste("clonality:
offspring rel ",names(clonalObj at offspringRel$coeff)[j])))
}
clonalObj at sdOffspringSize <- clonalObj at sdOffspringSize * (1
+ delta)
Pmatrix <- createIPMPmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
maxSize = maxSize, growObj = growObj, chosenCov =
chosenCov,
survObj = survObj, discreteTrans = discreteTrans,
integrateType = integrateType,
correction = correction)
if (!is.null(fecObj)) {
Fmatrix <- createIPMFmatrix(nBigMatrix = nBigMatrix,
minSize = minSize, maxSize = maxSize, fecObj =
fecObj,
chosenCov = chosenCov, integrateType =
integrateType,
correction = correction, preCensus = preCensus,
survObj = survObj, growObj = growObj)
}
Cmatrix <- createIPMCmatrix(nBigMatrix = nBigMatrix,
minSize = minSize,
chosenCov = chosenCov, maxSize = maxSize, clonalObj
= clonalObj,
integrateType = integrateType, correction = correction,
preCensus = preCensus, survObj = survObj, growObj =
growObj)
IPM <- Pmatrix + Fmatrix + Cmatrix
if (response=="lambda") rc2 <- Re(eigen(IPM)$value[1])
if (response=="R0") rc2 <- R0Calc(Pmatrix, Fmatrix+Cmatrix)
if (response=="lifeExpect") rc2 <-
meanLifeExpect(Pmatrix)[chosenBin]
clonalObj at sdOffspringSize <- clonalObj at sdOffspringSize/(1 +
delta)
slam <- c(slam,(rc2 - rc1)/(clonalObj at sdOffspringSize * delta))
elam <- c(elam,(rc2 - rc1)/(rc1 * delta))
nmes <- c(nmes, "clonality: sd offspring size")
}
}
names(slam) <- nmes
names(elam) <- nmes
return(list(sens = slam, elas = elam))
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.r-forge.r-project.org/pipermail/ipmpack-users/attachments/20130402/d0ff9131/attachment-0001.html>
More information about the IPMpack-users
mailing list