## Not run: # perfectly good example but takes longer to run than CRAN allows
# data(echinacea)
# #### estimate MLE (simpler model than in Biometrika paper cited, not as good)
# hdct <- as.numeric(grepl("hdct", as.character(echinacea$redata$varb)))
# modmat <- model.matrix(resp ~ varb + nsloc + ewloc + pop * hdct - pop,
# data = echinacea$redata)
# tau.hat <- as.numeric(t(modmat) %*% echinacea$redata$resp)
# beta.hat <- transformUnconditional(tau.hat, modmat, echinacea,
# from = "tau", to = "beta")
# inverse.fisher <- jacobian(tau.hat, echinacea, transform = "unconditional",
# from = "tau", to = "beta", modmat = modmat)
# #### now have MLE (beta.hat) and pseudo-inverse of Fisher information
# #### (inverse.fisher), pseudo-inverse because modmat is not full rank
# foo <- cbind(beta.hat, sqrt(diag(inverse.fisher)))
# foo <- cbind(foo, foo[ , 1]/foo[ , 2])
# foo <- cbind(foo, 2 * pnorm(- abs(foo[ , 3])))
# dimnames(foo) <- list(colnames(modmat),
# c("Estimate", "Std. Error", "z value", "Pr(>|z|)"))
# printCoefmat(foo)
# #### coeffients constrained to be zero because parameterization is not
# #### identifiable have estimate zero and std. error zero (and rest NA)
#
# #### estimate fitness in populations
# #### generate new data with one individual in each pop at location (0, 0)
# pop.names <- levels(echinacea$redata$pop)
# pop.idx <- match(pop.names, as.character(echinacea$redata$pop))
# pop.id <- echinacea$redata$id[pop.idx]
# newdata <- subset(echinacea, echinacea$redata$id %in% pop.id)
# newdata$redata[ , "nsloc"] <- 0
# newdata$redata[ , "ewloc"] <- 0
# hdct <- as.integer(grepl("hdct", as.character(newdata$redata$varb)))
# #### modmat for new data
# newmodmat <- model.matrix(resp ~ varb + nsloc + ewloc + pop * hdct - pop,
# data = newdata$redata)
# #### matrix that when multiplied mean value parameter vector gives fitness
# #### in each pop
# amat <- matrix(NA, nrow = length(pop.id), ncol = nrow(newmodmat))
# for (i in 1:nrow(amat))
# amat[i, ] <- as.numeric(grepl(paste("^", pop.id[i], ".hdct", sep = ""),
# rownames(newmodmat)))
# #### transform to expected fitness parameters
# efit <- transformUnconditional(beta.hat, newmodmat, newdata,
# from = "beta", to = "mu")
# efit <- as.numeric(amat %*% efit)
# #### jacobian matrix of this transformation
# jack <- jacobian(beta.hat, newdata, transform = "unconditional",
# from = "beta", to = "mu", modmat = newmodmat)
# #### delta method standard errors
# sefit <- sqrt(diag(amat %*% jack %*% inverse.fisher %*% t(jack) %*% t(amat)))
# foo <- cbind(efit, sefit)
# dimnames(foo) <- list(pop.names, c("Est. fitness", "Std. Error"))
# print(foo)
# ## End(Not run)
Run the code above in your browser using DataLab