R/verify.R

In secr: Spatially Explicit Capture-Recapture

############################################################################################
## package 'secr'
## verify.R
## 2009 09 18, 2009 09 19, 2009 09 20, 2009 10 02, 2009 11 05, 2009 11 13
## 2010 05 02 removed erroneous ref to 'areabinary' detector
## 2011 02 15 validpoly
## 2011 03 19 adjustments to allow unmarked; need more complete check of unmarked
## 2012 02 02 signal check applied at level of whole sound
## 2012-10-22 xylist checked
## 2013-05-09 tweak to avoid error in checkcovariatelevels when no covariates
## 2015-01-06 stop if mixture of NULL and non-NULL covariates
## 2015-10-03 resight data
## 2015-10-12 verify.traps error messages
## 2015-11-02 secr_xyinpoly moved to utility.R
## 2016-10-06 secr 3.0 revamped
## 2017-10-18 zerohist check ()
## 2017-10-19 capped detector check

## 2017-01-27 future telemetry checks:
##                cannot have occasions with no detections    
## 2020-08-14 bug in checkcovariatelevels caused by bug in stringsAsFactors
## 2020-08-27 verify.traps did not report markocc checks
## 2020-08-27 verify.capthist returns capture checks invisibly
## 2022-05-07 verify.capthist checks nontarget matrix if present
## 2026-06-29 reformat code
## 2026-06-29 report telemetry data errors
############################################################################################

verify <- function (object, report, ...) UseMethod("verify")

verify.default <- function (object, report, ...) {
    cat ('no verify method for objects of class', class(object), '\n')
}
############################################################################################

## from is.integer help page
is.wholenumber <- function(x, tol = .Machine$double.eps^0.5)  abs(x - round(x)) < tol

overlapcells <- function (xy) {
    vertexinside <- function (a,b) {
        OK <- FALSE
        for (k in 1:4) {
            temp <- insidecpp(unlist(a[k,]), 0, 3, as.matrix(b))
            if (any(temp)) OK <- TRUE
            temp <- insidecpp(unlist(b[k,]), 0, 3, as.matrix(a))
            if (any(temp)) OK <- TRUE
        }
        OK
    }
    spacex <- attr(xy, 'spacex')
    spacey <- attr(xy, 'spacey')
    fuzz <- 1e-10
    spx2 <- spacex/2 - fuzz
    spy2 <- spacey/2 - fuzz
    xy <- as.matrix(xy)
    nr <- nrow(xy)
    if (nr<2)
        FALSE
    else {
        pixel <- matrix(ncol = 2, c(-spx2,-spx2,spx2,spx2,-spx2,-spy2,spy2,spy2,-spy2,-spy2))
        overlap <- matrix(FALSE, nrow = nr, ncol = nr)
        for (i in 1:(nr-1))
            for (j in (i+1):nr)
            {
                verti <- t(apply(pixel, 1, function (x) xy[i,] + x))
                vertj <- t(apply(pixel, 1, function (x) xy[j,] + x))
                if ((length(verti)>0) & (length(vertj)>0))
                    overlap[i,j] <- vertexinside(verti,vertj)
            }
        any (overlap, na.rm=T)
    }
}
############################################################################################

overlappoly <- function (xy, polyID) {
    ## overlap of component polygons?
    vertexinside <- function (a,b) {
        OK <- FALSE
        n.a <- nrow(a)
        n.b <- nrow(b)
        a <- as.matrix(a)
        b <- as.matrix(b)
        for (k in 1:n.a) {
            temp <- insidecpp(unlist(a[k,]), 0, n.b-1, as.matrix(b))
            if (any(temp)) OK <- TRUE
        }
        for (k in 1:n.b) {
            temp <- insidecpp(unlist(b[k,]), 0, n.a-1, as.matrix(a))
            if (any(temp)) OK <- TRUE
        }
        OK
    }
    lxy <- split (xy, polyID)
    nr <- length(lxy)
    if (nr<2)
        FALSE
    else {
        overlap <- matrix(FALSE, nrow = nr, ncol = nr)
        for (i in 1:(nr-1))
            for (j in (i+1):nr)
            {
                overlap[i,j] <- vertexinside(lxy[[i]], lxy[[j]])
            }
        any (overlap, na.rm=T)
    }
}
############################################################################################

validpoly <- function (xy, polyID, nx = 500) {
    ## check intersections of perimeters with vertical lines
    OKpoly <- function (xy) {
        cross <- rep(0, nx)
        x <- seq(min(xy[,1]), max(xy[,1]), length=nx)
        for (i in 1:nx) {
            tempx <- xy[,1] - x[i]
            cross[i] <- sum (sign(tempx[-1]) != sign(tempx[-length(tempx)]))
        }
        cross <= 2
    }
    lxy <- split (xy, polyID)
    temp <- lapply(lxy, OKpoly)
    all(unlist(temp))
}
############################################################################################

xyontransect <- function (xy, trps, tol = 0.01) {
    ptontransect <- function (i,k) {
        ## is point i on transect k?
        transectxy <- as.matrix(lxy[[k]])
        nr <- nrow(transectxy)
        ontransectcpp (
            as.matrix (xy[i,,drop=FALSE]),
            as.matrix (transectxy),
            as.integer (0),
            as.integer (nr-1),
            as.double (tol))
    }
    lxy <- split (trps, transectID(trps))
    firsttransect <- function (i) {
        for (k in 1:length(lxy))
            if (ptontransect(i,k)) return(k)
        0
    }
    sapply(1:nrow(xy), firsttransect)
}
############################################################################################

checkcovariatelevels <- function (cov) {
    ## cov is a list of dataframes of covariates
    ## tweak 2013-05-09 to avoid error when no covariates
    xfactor <- function(x) {
        if ((nrow(x)>0) & (ncol(x)>0))
            names(x)[sapply(x,is.factor)]
        else
            NULL
    }
    #############################################
    ## 2020-05-15 convert all character to factor
    cov <- lapply(cov, secr_stringsAsFactors)
    #############################################
    
    factornames <- sapply(cov, xfactor)
    factornames <- unique(unlist(factornames))
    if (length(factornames) > 0) {
        if (any(sapply(cov, function(x) !all(factornames %in% names(x))))) {
            return(FALSE)
        }
        else {
            checklevels <- function(variable) {
                baselevels <- levels(cov[[1]][,variable])
                lev <- lapply(cov, function(x) levels(x[,variable]))
                all(sapply(lev[-1], function(x) identical(x,baselevels)))
            }
            return(all(sapply(factornames, checklevels)))
        }
    }
    else
        return(TRUE)
}
############################################################################################

verify.traps <- function (object, report = 2, ...) {
    
    ## Check internal consistency of 'traps' object
    ##
    ## -- Number of rows in dataframe of detector covariates differs expected
    ## -- Number of detectors in usage matrix differs from expected
    ## -- Occasions with no used detectors
    
    if (!inherits(object, 'traps')) {
        stop ("object must be of class 'traps'")
    }
    
    if (inherits(object, 'list')) {
        temp <- lapply (object, verify, report = min(report,1))
        anyerrors <- any(sapply(temp, function(x) x$errors))
        
        ## check covariate factor levels conform across sessions
        
        if (!all(sapply(covariates(object), is.null))) {
            if (any(sapply(covariates(object), is.null)))
                stop ("mixture of NULL and non-NULL trap covariates in different sessions")
            trapcovariatelevelsOK <- checkcovariatelevels(covariates(object))
            if (!trapcovariatelevelsOK & report>0) {
                warning ('Levels of factor trap covariate(s) differ between sessions - ",
                 "use shareFactorLevels()', call. = FALSE)
            }
        }
        
        if ((report == 2) & !anyerrors)
            cat('No errors found :-)\n')
        invisible(list(errors = anyerrors, bysession = temp))
    }
    else {
        
        poly <- all(detector(object) %in% c('polygon','polygonX'))
        telemonly <- all(detector(object) %in% 'telemetry')
        
        detectorsOK <- TRUE
        usagedetectorsOK <- TRUE
        usagedetectors2OK <- TRUE
        usagenonzeroOK <- TRUE
        markoccOK <- TRUE
        markocc2OK <- TRUE
        areaOK <- TRUE
        polyIDOK <- TRUE
        polyconvexOK <- TRUE
        trapcovariatesOK <- TRUE
        telemOK <- TRUE
        
        if (!is.null(covariates(object)))
            if ((ncol(covariates(object)) == 0 ) |
                (nrow(covariates(object)) == 0 )) covariates(object) <- NULL
        
        ## 1
        trapNAOK <- !any(is.na(object))
        
        ## 2
        if (!is.null(covariates(object)))
            trapcovariatesOK <- nrow(covariates(object)) == secr_ndetector(object)
        
        ## 3
        uniquedetectors <- unique(detector(object))
        nontelemetrydetectors <- uniquedetectors[uniquedetectors != "telemetry"]
        detectorsOK <- (length(uniquedetectors)==1) |
            all(nontelemetrydetectors %in% .localstuff$pointdetectors)
        
        ## 'usage' of traps
        if (!is.null(usage(object))) {
            ## 4
            usagedetectorsOK <- nrow(usage(object)) == secr_ndetector(object)
            
            ## 5
            if (length(secr_detectorcode(object))>1)
                usagedetectors2OK <- length(secr_detectorcode(object)) == ncol(usage(object))
            
            ## 6
            usagecount <- apply(usage(object),2,sum)
            usagenonzeroOK <- !any(usagecount == 0)
        }
        else usagecount <- rep(NA, ncol(object))
        
        ## 7
        if (sighting(object)) {
            if (!is.null(usage(object)))
                markoccOK <- length(markocc(object)) == ncol(usage(object))
            ## 8
            markocc2OK <- all(markocc(object) %in% c(-2,-1,0,1))
        }
        
        ## 9
        if (poly) {
            areaOK <- !overlappoly (object, polyID(object))
        }
        
        ## 10
        if (poly) {
            polyIDOK <- (length(polyID(object)) == nrow(object)) &
                is.factor(polyID(object))
        }
        
        ## 11
        if (poly) {
            polyconvexOK <- validpoly (object, polyID(object))
        }
        
        ## 12
        if (telemonly) {
            telemOK <- nrow(object) == 1
        }
        
        errors <- !all(c(trapNAOK,
                         trapcovariatesOK,
                         detectorsOK,
                         usagedetectorsOK,
                         usagedetectors2OK,
                         usagenonzeroOK,
                         markoccOK,
                         markocc2OK,
                         areaOK,
                         polyIDOK,
                         polyconvexOK,
                         telemOK))
        
        if (report > 0) {
            if (errors) {
                if (!trapNAOK) {
                    cat ('Missing detector coordinates not allowed\n')
                }
                if (!trapcovariatesOK) {
                    cat ('Wrong number of rows in dataframe of detector covariates\n')
                    cat (uniquedetectors, '\n')
                }
                if (!detectorsOK) {
                    cat ('Invalid combination of detector types\n')
                    cat ('traps :', secr_ndetector(object), 'detectors\n')
                    cat ('usage(traps) :', nrow(usage(object)), 'detectors\n')
                }
                if (!usagedetectorsOK) {
                    cat ('Conflicting number of detectors in usage matrix\n')
                    cat ('traps :', secr_ndetector(object), 'detectors\n')
                    cat ('usage(traps) :', nrow(usage(object)), 'detectors\n')
                }
                if (!usagedetectors2OK) {
                    cat ('Conflicting number of occasions in usage matrix\n')
                    cat ('detector attribute :', length(secr_detectorcode(object)), 'occasions\n')
                    cat ('usage(traps) :', ncol(usage(object)), 'occasions\n')
                }
                if (!usagenonzeroOK) {
                    cat ("Occasions when no detectors 'used'\n")
                    cat ((1:length(usagecount))[usagecount==0], '\n')
                }
                if (!markoccOK) {
                    cat ("Conflicting number of occasions in markocc and usage \n")
                    cat ('markocc : ', length(markocc(object)), 'occasions \n')
                    cat ('usage : ', ncol(usage(object)), 'occasions \n')
                }
                if (!markocc2OK) {
                    cat ("Values in markocc should be -2, -1, 0 or 1 \n")
                    cat ('markocc(object) \n')
                }
                if (!areaOK) {
                    cat ("Search areas overlap, or no search area specified \n")
                }
                if (!polyIDOK) {
                    cat ("Invalid polyID \n")
                }
                if (!polyconvexOK) {
                    cat ("The boundary of at least one polygon is concave east-west \n")
                }
                if (!telemOK) {
                    cat ("More than one row in notional traps object for telemetry \n")
                }
            }
        }
        
        if ((report == 2) & !errors) message('No errors found :-)')
        
        out <- list(errors = errors,
                    trapNAOK = trapNAOK,
                    trapcovariatesOK = trapcovariatesOK,
                    detectorsOK = detectorsOK,
                    usagedetectorsOK = usagedetectorsOK,
                    usagedetectors2OK = usagedetectors2OK,
                    usagenonzeroOK = usagenonzeroOK,
                    markoccOK = markoccOK,
                    markocc2OK = markocc2OK,
                    areaOK = areaOK,
                    polyIDOK = polyIDOK,
                    polyconvexOK = polyconvexOK,
                    usagecount = usagecount,
                    telemOK = telemOK
        )
        
        invisible(out)
        
    }
}
############################################################################################

verify.capthist <- function (object, report = 2, tol = 0.01, ...) {
    
    ## Check internal consistency of 'capthist' object
    ##
    ## -- 'traps' component present
    ## -- verify(traps)
    ## -- No live releases
    ## -- Live detection(s) after reported dead
    ## -- More than one capture in single-catch trap(s)
    
    ## -- Number of rows in 'traps' object not compatible with reported detections
    ## -- Number of rows in dataframe of individual covariates differs from capthist
    ## -- Number of occasions in usage matrix differs from capthist
    ## -- Detections at unused detectors
    
    ## -- resighting attributes Tu, Tm compatible if present
    ## -- no resightings on marking occasions, or new animals on resighting occasions
    
    if (!inherits(object, 'capthist')) {
        stop ("object must be of class 'capthist'")
    }
    
    ## multi-session    
    if (inherits(object, 'list')) {
        temp <- lapply (object, verify, report = min(report, 1))
        anyerrors <- any(sapply(temp, function(x) x$errors))
        ## check covariate factor levels conform across sessions
        if (!all(sapply(covariates(object), is.null))) {
            if (any(sapply(covariates(object), is.null)))
                stop ("mixture of NULL and non-NULL individual covariates in different sessions")
            covariatelevelsOK <- checkcovariatelevels(covariates(object))
            if (!covariatelevelsOK & report>0) {
                warning ('Levels of factor covariate(s) differ between sessions - ",
                 "use shareFactorLevels()', call. = FALSE)
            }
        }
        if ((report == 2) & !anyerrors)
            cat('No errors found :-)\n')
        invisible(list(errors = anyerrors, bysession = temp))
    }
    else {
        ## one session
        ## preliminaries
        object <- secr_check3D(object)
        detectortype <- secr_expanddet(object)  # vector length noccasions
        telemetrytype <- telemetrytype(traps(object))
        signal <- all(detectortype %in% c('signal','signalnoise'))
        unmarked <- all(detectortype %in% c('unmarked'))
        poly <- all(detectortype %in% c('polygon', 'polygonX'))
        transect <- all(detectortype %in% c('transect', 'transectX'))
        telem <- any(detectortype %in% c('telemetry'))
        
        markocc <- markocc(traps(object))
        sighting <- sighting(traps(object))
        K <- secr_ndetector(traps(object), notelem = TRUE)
        S <- secr_noccasions(object, notelem = TRUE)
        #  all non-telemetry occasions are sighting occasions?
        allsighting <- if (sighting) !any(markocc[1:S]>0) else FALSE
        
        # trapspresentOK # 1
        # trapsOK        # 2
        # detectionsOK   # 3
        NAOK             <- TRUE  
        
        cutvalOK         <- TRUE
        signalOK         <- TRUE
        
        deadOK           <- TRUE  
        zerohistOK       <- TRUE  
        binaryOK         <- TRUE  
        singleOK         <- TRUE  
        multiOK          <- TRUE  
        cappedOK         <- TRUE  
        countOK          <- TRUE  
        
        detectornumberOK <- TRUE  
        covariatesOK     <- TRUE
        usageoccasionsOK <- TRUE  
        usageOK          <- TRUE  
        detectorconflcts <- NULL  
        
        xyOK             <- TRUE  
        xyinpolyOK       <- TRUE  
        xyontransectOK   <- TRUE  
        rownamesOK       <- TRUE
        
        sightingsOK      <- TRUE
        sightingusageOK  <- TRUE
        MOK              <- TRUE
        ROK              <- TRUE
        
        telemOK          <- TRUE
        telemetryerror   <- NULL
        
        nontargetdimOK   <- TRUE
        nontargetOK      <- TRUE
        
        if (!is.null(covariates(object)))
            if ((ncol(covariates(object)) == 0 ) |
                (nrow(covariates(object)) == 0 ))
                covariates(object) <- NULL
        
        ##################
        ## trapspresentOK
        
        trapspresentOK <- !is.null(traps(object))
        
        ##################
        ## trapsOK
        
        ## standalone check of detectors
        ## this is done one session at a time
        ## so does not check between session agreement of covariates
        
        if (trapspresentOK)
            trapcheck <- verify(traps(object), report = 0)  ## delay reporting
        else
            trapcheck <- list(errors=TRUE)
        trapsOK <- !trapcheck$errors
        
        ##################
        ## detectionsOK
        
        if (length(object)==0) {
            detectionsOK <- unmarked   # obsolete 2026-06-29?
        }
        else  {
            
            detectionsOK <- sum(object[object>0]) > 0
            
            ##################
            ## NAOK
            
            NAOK <- !any(is.na(object))
            
            ##################
            ## signalOK, cutvalOK
            
            if (signal) {
                if (length(signal(object)) != sum(abs(object)))
                    signalOK <- FALSE
                ## must have cutval; deads not allowed
                if (length(attr(object,'cutval')) != 1) cutvalOK <- FALSE
                else {
                    maxbyanimal <- tapply(signal(object), animalID(object, sortorder = 'ksn'), max)
                    maxbyanimal <- maxbyanimal[!is.na(maxbyanimal)]  ## because NA OK 2012-02-10
                    if (any(maxbyanimal < attr(object,'cutval')))
                        cutvalOK <- FALSE
                }
            }
            
            ##################
            ## deadOK
            
            if (!signal) {
                fn <- function(x) {   ## tweaked 2017-11-29
                    x <- apply(x,1,min)   ## by occasion
                    dead <- min(x)<0
                    last <- tail(x[x!=0],1)
                    if (length(last)==0) last <- 0
                    dead & (last>0)
                }
                undead <- apply(object, 1, fn)
                deadOK <- !any(undead)
                if (!deadOK) {
                    reincarnated <- object[undead,,, drop=F]
                }
            }
            
            ###################
            ## zerohistOK
            
            ## all-zero histories are meaningful only for concurrent or marking telemetry and
            ## sighting-only data with known number marked
            if (!(telemetrytype %in% c("concurrent", "marking")) && !allsighting) {
                zerohistOK <- all(apply(abs(object),1,sum)>0)
            }
            
            
            ##################
            ## binaryOK
            
            ## single, multi, capped, proximity, polygonX, transectX, 
            ## signal and signalnoise must be binary
            
            detectorcodes <- secr_detectorcode(traps(object), MLonly = FALSE, noccasions = ncol(object))
            multiples <- sum(abs(object[, detectorcodes %in% c(-1,0,1,3,4,5,8,12), , drop = FALSE])>1)
            binaryOK <- multiples == 0
            
            ##################
            ## singleOK
            
            ## no more than one obs per animal and per trap on any occasion

            fn <- function (x) duplicated(abs(x)[x!=0])
            multiplei <- apply(object[, detectorcodes==-1, , drop = FALSE], 1:2, fn)
            multiplek <- apply(object[, detectorcodes==-1, , drop = FALSE], 2:3, fn)
            singleOK <- !any(unlist(multiplei)) & !any(unlist(multiplek))
            
            ##################
            ## multiOK
            
            ## no more than one obs per animal per occasion

            multiplei <- apply(object[, detectorcodes %in% c(0,3,4), , drop = FALSE], 1:2, fn)
            multiOK <- !any(unlist(multiplei))
            
            ##################
            ## cappedOK
            
            ## no more than one individual per detector per occasion
            
            multiplek <- apply(object[, detectorcodes==8, , drop = FALSE], 2:3, fn)
            cappedOK <- !any(unlist(multiplek))
            
            ###################
            ## countOK
            
            ## count, polygon, transect cannot be dead (?)

            countOK <- all(object[, detectorcodes %in% c(2,6,7), ] >= 0)

        }
        
        ###################
        ## detectornumberOK
        
        if (nrow(object) > 0) {
            if (poly | transect) {
                detectornumberOK <- length(levels(polyID(traps(object)))) == dim(object)[3]
            }
            else {
                detectornumberOK <- dim(object)[3] == nrow(traps(object))
            }
        }
        
        ###################
        ## covariatesOK

        covariatesOK <- ifelse(is.null(covariates(object)),
                               TRUE,
                               nrow(covariates(object)) == nrow(object))
        
        ## is 'usage' of traps consistent with reported detections?
        if (!is.null(usage(traps(object)))) {
            conflcts <- 0
            
            ###################
            ## usageoccasionsOK
            
            usageoccasionsOK <- ncol(usage(traps(object))) == ncol(object)
            
            if (detectionsOK) {
                # 2012-12-17
                # notused <- !usage(traps(object))   ## traps x occasions
                notused <- usage(traps(object)) == 0 ## traps x occasions
                if (trapcheck$usagedetectorsOK & usageoccasionsOK) {
                    tempobj <- aperm(object, c(2,3,1))   ## occasion, traps, animal sKn
                    tempuse <- array(t(usage(traps(object))>0), dim=dim(tempobj)) # repl to fill
                    # bug 2017-11-29 && changed to &
                    conflcts <- (abs(tempobj)>0) & (tempuse==0)
                    tempobjmat <- array(tempobj[,,1], dim= dim(tempobj)[1:2])
                    occasion <- rep(row(tempobjmat), dim(tempobj)[3])
                    detector <- rep(col(tempobjmat), dim(tempobj)[3])
                    ID <- rep(rownames(object), rep(prod(dim(tempobj)[1:2]), nrow(object)))
                    detectorconflcts <- as.data.frame(cbind(ID,detector,occasion)[conflcts,])
                }
            }
            
            ###################
            ## usageOK
            
            usageOK <- sum(conflcts)==0
            
        }
        
        ###################
        ## xyOK, xyinpolyOK
        
        if (poly) {
            xy <- xy(object)
            ## 16
            if (all(detectortype %in% c('polygon')))
                xyOK <- nrow(xy) == sum(abs(object))
            else
                xyOK <- nrow(xy) == sum(abs(object)>0)
            # assumes detection sequence is ksn in trap() and xy()
            inpoly <- secr_xyinpoly(xy(object), traps(object))
            inpoly <- inpoly == trap(object, names = FALSE, sortorder = "ksn")  
            ## 17
            xyinpolyOK <- all(inpoly)
        }

        ###################
        ## xyOK, xyontransectOK
        
        if (transect) {
            xy <- xy(object)
            ## 16 again
            if (all(detectortype == 'transect'))
                xyOK <- nrow(xy) == sum(abs(object))
            else
                xyOK <- nrow(xy) == sum(abs(object)>0)
            ontransect <- xyontransect(xy(object), traps(object), tol = tol)
            ontransect <- ontransect == trap(object, names = FALSE, sortorder = "ksn")
            ## 18
            xyontransectOK <- all(ontransect)
        }
        
        #################
        ## rownamesOK
        
        ## 2021-03-03 added condition so OK when no rows; fixed 2021-11-16
        rownamesOK <- (!any(duplicated(rownames(object))) &&  
                           !is.null(rownames(object))) || (nrow(object)==0) 
        if (!is.null(rownames(object)))
            rownamesOK <- rownamesOK & !any(is.na(rownames(object)))
        
        ################
        ## sightingsOK, sightingusageOK, MOK, ROK
        
        ## -- resighting attributes Tu, Tm compatible if present
        ## -- no resightings on marking occasions, or new animals on resighting occasions
        if (sighting) {
            Tu <- Tu(object)
            Tm <- Tm(object)
            r <- numeric(S)
            usge <- usage(traps(object))[1:K,1:S]
            if (is.null(usge)) usge <- 1
            if (length(markocc) != ncol(object)) sightingsOK <- FALSE
            ## allow scalar summed sighting counts 2015-10-31
            if (!is.null(Tu)) {
                if (length(Tu) > 1) {
                    if (any((Tu>0) & (usge==0))) sightingusageOK <- FALSE
                    if (ncol(Tu) != S) sightingsOK <- FALSE
                    if (nrow(Tu) != K) sightingsOK <- FALSE
                    r <- r + apply(Tu,2,sum)
                }
                if (any(Tu<0)) sightingsOK <- FALSE
                if (!all(is.wholenumber(Tu))) sightingsOK <- FALSE
            }
            if (!is.null(Tm)) {
                if (length(Tm) > 1) {
                    # 2016-10-13 fixed bug Tu>Tm
                    if (any((Tm>0) & (usge==0))) sightingusageOK <- FALSE
                    if (nrow(Tm) != K) sightingsOK <- FALSE
                    if (ncol(Tm) != S) sightingsOK <- FALSE
                    r <- r + apply(Tm,2,sum)
                }
                if (any(Tm<0)) sightingsOK <- FALSE
                if (!all(is.wholenumber(Tm))) sightingsOK <- FALSE
            }
            ## 23
            if (sightingsOK) {
                if (length(Tu)>1) {
                    # counts() uses summary.capthist -- overkill
                    u <- unlist(counts(object, 'u'))[1:ncol(object)]
                    if ( any((u > 0) & (markocc<1) & !allsighting) ) MOK <- FALSE
                }
                ## 24
                if (length(Tm)>1)
                    if ( any((r > 0) & (markocc[1:S]>0))) ROK <- FALSE
            }
        }
        
        ###################
        ## telemOK
        
        if (telem) {
            telemocc <- detectortype=='telemetry'
            telemdet <- apply(abs(object[,telemocc,,drop=FALSE]),1:2,sum)
            captdet <- apply(abs(object[,!telemocc,,drop=FALSE]),1:2,sum)
            
            telemdet.byoccasion <- apply(telemdet,2,sum)
            telemdet.byanimal <- apply(telemdet,1,sum)
            captdet.byanimal <- apply(captdet,1,sum)
            animaldet <- sapply(telemetryxy(object),nrow)
            telemetrd <- telemetered(object)
            if (any(telemdet.byoccasion == 0)) {
                telemOK <- FALSE
                telemetryerror <- "telemetry occasions with no detections"
            }
            if (length(animaldet) != sum(telemetrd)) {
                telemOK <- FALSE
                telemetryerror <- "mismatch of animals"
            }
            else if (any(sort(names(animaldet)) != sort(names(telemdet.byanimal[telemetrd])))) {
                telemOK <- FALSE
                telemetryerror <- "mismatch of names"
            }
            else if (any(animaldet != telemdet.byanimal[telemetrd][names(animaldet)])) {
                telemOK <- FALSE
                telemetryerror <- "number of observations does not match"
            }
            else if (telemetrytype=='dependent' && any(captdet.byanimal==0)) {
                telemOK <- FALSE
                telemetryerror <- "all-zero detection histories for dependent telemetry"
            }
            else if (telemetrytype=='marking' && !all(rownames(captdet) %in% rownames(telemdet))) {
                telemOK <- FALSE
                telemetryerror <- "one or more detection histories lacks telemetry locations (type = 'marking')"
            }
            else if (telemetrytype=='marking' && !all(rownames(telemdet) %in% rownames(captdet))) {
                telemOK <- FALSE
                telemetryerror <- "one or more telemetered animals (type = 'marking') lacks a detection history"
            }
            else if (telemetrytype=='independent' & any(captdet.byanimal[telemetrd]!=0)) {
                telemOK <- FALSE
                telemetryerror <- "non-zero detection histories for independent telemetry"
            }
        }
        
        ##############################
        ## nontargetdimOK, nontargetOK
        
        nontarget <- attr(object, 'nontarget', exact = TRUE)
        if (!is.null(nontarget)) {
            nontarget <- as.matrix(nontarget)
            if (nrow(nontarget) != dim(object)[3] ||
                ncol(nontarget) != dim(object)[2])
                nontargetdimOK <- FALSE
            if (nontargetdimOK && detectortype[1] %in% c('single', 'capped')) {
                # capture and nontarget mutually exclusive 
                obs <- t(apply(abs(object), 2:3, sum))
                if (any(obs & nontarget))
                    nontargetOK <- FALSE
            }
        }
        
        errors <- !all(c(
            trapspresentOK,
            trapsOK,
            detectionsOK,
            NAOK,
            cutvalOK,
            signalOK,
            deadOK,
            zerohistOK,
            binaryOK,
            singleOK,
            multiOK,
            cappedOK,
            countOK,
            detectornumberOK,
            covariatesOK,
            usageoccasionsOK,
            usageOK,
            xyOK,
            xyinpolyOK,
            xyontransectOK,
            rownamesOK,
            sightingsOK,
            sightingusageOK,
            MOK,
            ROK,
            telemOK,
            nontargetdimOK,
            nontargetOK
        ))
        
        if (report > 0) {
            if (errors) {
                cat ('Session', session(object), '\n')
                
                if (!trapspresentOK) {
                    cat ('No valid detectors\n')
                }
                if (!trapsOK) {
                    cat ('Errors in traps\n')
                    if (!trapcheck$trapNAOK) {
                        cat ('Missing detector coordinates not allowed\n')
                    }
                    if (!trapcheck$trapcovariatesOK) {
                        cat ('Wrong number of rows in dataframe of detector covariates\n')
                        cat ('traps(capthist) :', secr_ndetector(traps(object)), 'detectors\n')
                        cat ('covariates(traps(capthist)) :', nrow(covariates(traps(object))), 'detectors\n')
                    }
                    if (!trapcheck$usagedetectorsOK) {
                        cat ('Conflicting number of detectors in usage matrix\n')
                        cat ('traps(capthist) :', secr_ndetector(traps(object)), 'detectors\n')
                        cat ('usage(traps(capthist)) :', nrow(usage(traps(object))), 'detectors\n')
                    }
                    if (!trapcheck$usagenonzeroOK) {
                        cat ("Occasions when no detectors 'used'\n")
                        cat ((1:length(trapcheck$usagecount))[trapcheck$usagecount==0], '\n')
                    }
                }
                
                if (!detectionsOK) {
                    cat ('No live releases\n')
                }
                
                if (!NAOK) {
                    cat ('Missing values not allowed in capthist\n')
                }
                
                if (!cutvalOK) {
                    cat ('Signal less than cutval or invalid cutval\n')
                }
                
                if (!signalOK) {
                    cat ('Signal attribute does not match detections\n')
                }
                
                if (!deadOK) {
                    cat ('Recorded alive after dead\n')
                    print(reincarnated)
                }
                
                if (!zerohistOK) {
                    cat ('Empty histories allowed only with concurrent telemetry, marking telemetry or sighting-only data\n')
                }
                
                if (!binaryOK) {
                    cat ('More than one detection per detector per occasion at binary detector(s)\n')
                }
                
                if (!singleOK) {
                    cat ('More than one capture in single-catch trap(s)\n')
                }
                
                if (!multiOK) {
                    cat ('Animal trapped at more than one detector\n')
                }
                
                if (!cappedOK) {
                    cat ('More than one animal at detector\n')
                }
                
                if (!countOK) {
                    cat ('Count(s) less than zero\n')
                }
                
                if (!detectornumberOK) {
                    cat ('traps object incompatible with reported detections\n')
                    cat ('traps(capthist) :', secr_ndetector(traps(object)), 'detectors\n')
                    cat ('capthist :', dim(object)[3], 'detectors\n')
                }
                
                if (!covariatesOK) {
                    cat ('Wrong number of rows in dataframe of individual covariates\n')
                    cat ('capthist :', nrow(object), 'individuals\n')
                    cat ('covariates(capthist) :', nrow(covariates(object)), 'individuals\n')
                }
                if (!usageoccasionsOK) {
                    cat ('Conflicting number of occasions in usage matrix\n')
                    cat ('capthist :', ncol(object), 'occasions\n')
                    cat ('usage(traps(capthist)) :', ncol(usage(traps(object))), 'occasions\n')
                }
                if (!usageOK) {
                    cat ("Detections at 'unused' detectors\n")
                    print(detectorconflcts)
                }
                if (!xyOK) {
                    cat ("Polygon or telemetry detector xy coordinates of detections",
                         " do not match counts\n")
                }
                if (!xyinpolyOK) {
                    cat ("XY coordinates not in polygon\n")
                    print (xy(object)[!inpoly,])
                }
                if (!xyontransectOK) {
                    cat ("XY coordinates not on transect\n")
                    print (xy(object)[!ontransect,])
                }
                if (!rownamesOK) {
                    cat ("Duplicated or missing row names (animal ID)\n")
                }
                if (!sightingsOK) {
                    cat("Incompatible dimensions of sighting attributes markocc, Tu or Tm\n")
                }
                if (!sightingusageOK) {
                    cat("Sightings at unused detectors\n")
                    Tu <- Tu(object)
                    Tm <- Tm(object)
                    K <- secr_ndetector(traps(object), notelem = TRUE)
                    S <- secr_noccasions(object, notelem = TRUE)
                    usge <- usage(traps(object))[1:K,1:S]
                    bad <- (Tu>0) & (usge==0) & (length(Tu)>1)
                    if (sum(bad)>0) {
                        cat("Tu\n")
                        print(cbind(Detector = row(bad)[bad], Occasion = col(bad)[bad]))
                    }
                    bad <- (Tm>0) & (usge==0) & (length(Tm)>1)
                    if (sum(bad)>0) {
                        cat("Tm\n")
                        print(cbind(Detector = row(bad)[bad], Occasion = col(bad)[bad]))
                    }
                }
                if (!MOK) {
                    cat("New individual(s) on sighting-only occasion\n")
                    occ <- split(
                        occasion(object, sortorder = 'snk'), 
                        animalID(object, names = TRUE, sortorder = 'snk')
                    )
                    firstocc <- sapply(occ, '[', 1)
                    print(firstocc[firstocc %in% (1:ncol(object))[markocc(traps(object))<1]])
                }
                if (!ROK) {
                    cat("Sighting(s) on marking-only occasion\n")
                }
                if (!telemOK) {
                    cat ("Error(s) in telemetry data\n")
                    cat ("First error: ", telemetryerror, "\n")
                        }
                if (!nontargetdimOK) {
                    cat ("Nontarget dimensions do not match capthist\n")
                }
                if (!nontargetOK) {
                    cat ("Nontarget data conflict with capthist\n")
                }
            }
            
            if ((report == 2) & !errors) message('No errors found :-)')
            
        }
        
        captcheck <- list(
            detectionsOK = detectionsOK,
            NAOK = NAOK,
            cutvalOK = cutvalOK,
            signalOK = signalOK,
            deadOK = deadOK,
            zerohistOK = zerohistOK,
            binaryOK = binaryOK,
            singleOK = singleOK,
            multiOK = multiOK,
            cappedOK = cappedOK,
            countOK = countOK,
            detectornumberOK = detectornumberOK,
            covariatesOK = covariatesOK,
            usageoccasionsOK = usageoccasionsOK,
            usageOK = usageOK,
            xyOK = xyOK,
            xyinpolyOK = xyinpolyOK,
            xyontransectOK = xyontransectOK,
            rownamesOK = rownamesOK,
            sightingsOK = sightingsOK,
            sightingusageOK = sightingusageOK,
            MOK = MOK,
            ROK = ROK,
            telemOK = telemOK,
            telemetryerror = telemetryerror,
            nontargetdimOK = nontargetdimOK,
            nontargetOK = nontargetOK
        )
        
        out <- list(errors = errors, trapcheck = trapcheck, captcheck = captcheck)
        if (!is.null(detectorconflcts)) out$detections.at.unused.detectors <- detectorconflcts
        invisible(out)
    }
}
############################################################################################

verify.mask <- function (object, report = 2, ...) {
    
    ## Check internal consistency of 'mask' object
    ##
    ## valid x and y coordinates
    ## nrow(covariates) = nrow(object)
    ## ...also look at attributes?
    
    if (!inherits(object, 'mask'))
        stop ("object must be of class 'mask'")
    
    if (inherits(object, 'list')) {
        temp <- lapply (object, verify, report = min(report, 1))
        anyerrors <- any(sapply(temp, function(x) x$errors))
        
        ## check covariate factor levels conform across sessions
        if (!all(sapply(covariates(object), is.null))) {
            covariatelevelsOK <- checkcovariatelevels(covariates(object))
            if (!covariatelevelsOK & report>0) {
                warning ('Levels of factor mask covariate(s) differ between sessions - ",
                 "use shareFactorLevels()', call. = FALSE)
            }
        }
        if ((report == 2) & !anyerrors)
            cat('No errors found :-)\n')
        invisible(list(errors = anyerrors, bysession = temp))
    }
    else {
        
        ## 1
        xyOK <- !(is.null(object$x) | is.null(object$y) | any(is.na(object)))
        xyOK <- xyOK & is.numeric(unlist(object))
        
        ## 2
        
        if (!is.null(covariates(object)))
            covariatesOK <- ifelse (nrow(covariates(object))>0,
                                    nrow(object) == nrow(covariates(object)), TRUE)
        else
            covariatesOK <- TRUE
        
        errors <- !all(c(xyOK, covariatesOK))
        
        if (report > 0) {
            if (errors) {
                ## cat ('Session', session(object), '\n')
                
                if (!xyOK) {
                    cat ('Invalid x or y coordinates in mask\n')
                }
                
                if (!covariatesOK) {
                    cat ('Number of rows in covariates(mask) differs from expected\n')
                }
            }
            
            if ((report == 2) & !errors) message('No errors found :-)')
        }
        
        out <- list(errors = errors)
        invisible(out)
    }
}
############################################################################################