R/RSE.R

In secr: Spatially Explicit Capture-Recapture

## extract relative standard error from fitted secr or openCR model
## default is vector for all parameters in model

## 2020-05-06 RSE may return matrix of values

RSE <- function (fit, parm = NULL, newdata = NULL) {
    if (inherits(fit, 'secrlist')) {
        lapply (fit, RSE, parm = parm, newdata = newdata)
    }
    else {
        if (is.null(parm)) {
            parm <- names(fit$parindx)
        }
        if (length(parm) > 1) {
            sapply(parm, RSE, fit = fit, newdata = newdata)
        }
        else {
            ## condition ensures 
            ## (i) parm in model (ii) no modelled variation in parm
            pindex <- length(fit$parindx[[parm]])
            if (pindex == 0) {
                warning ("parameter ", parm, " not in model")
            }
            else if (pindex == 1 && fit$link[[parm]] == 'log') {
                if (!is.null(newdata)) {
                    warning ("non-null newdata ignored for ", parm)
                }
                ## Efford & Boulanger MEE 2019
                sqrt(exp(vcov(fit)[parm, parm])-1)    
            }
            else {
                if (pindex > 1 && is.null(newdata)) {
                    warning ("parameter ", parm, " varies in model; consider specifying newdata")
                }
                pred <- predict(fit, newdata = newdata)
                if (parm %in% rownames(pred)) {
                    pred[parm, 'SE.estimate'] / pred[parm, 'estimate']
                }
                else if (parm %in% rownames(pred[[1]])) {
                    # modified 2020-05-06 to return all
                    getone <- function (x) {
                        x[parm, 'SE.estimate'] / x[parm, 'estimate']
                    }
                    sapply(pred, getone)
                }
                else if (parm %in% names(pred)) {
                    pred[[parm]][1,'SE.estimate'] / pred[[parm]][1,'estimate']
                }
                else NA
            }
        }
    }
}