updating time summary to account for no marked events

devel/matchTemplateFunctions.R

@@ -1,6 +1,8 @@
 library(dplyr)
 library(PamBinaries)
 library(PAMmisc)
+library(RSQLite)
+library(lubridate)
 
 loadTemplateBinary <- function(x, names, columns) {
     bin <- loadPamguardBinaryFile(x, skipLarge=TRUE, convertDate=FALSE)
@@ -183,13 +185,18 @@ addTemplateEvents <- function(db, binFolder, data) {
 
 summariseManualEvents <- function(x, db=NULL) {
     result <- x %>%
-        filter(parentID != 'none') %>%
-        group_by(parentID) %>%
-        summarise(eventLabel = unique(eventLabel),
-                  nTemplate = sum(templateEvent != 'none'),
-                  pctTemplate = mean(templateEvent != 'none'),
-                  nDets = n())
-    nZero <- sum(result$nTemplate == 0)
+        filter(parentID != 'none')
+    if(nrow(result) > 0) {
+        result <- result %>%
+            group_by(parentID) %>%
+            summarise(eventLabel = unique(eventLabel),
+                      nTemplate = sum(templateEvent != 'none'),
+                      pctTemplate = mean(templateEvent != 'none'),
+                      nDets = n())
+        nZero <- sum(result$nTemplate == 0)
+    } else {
+        nZero <- 0
+    }
     cat('\n', nZero, ' out of ', nrow(result), ' manual event(s) had no template detections (FN).', sep='')
     if(!is.null(db)) {
         dbEv <- getDbEvent(db)
@@ -200,9 +207,12 @@ summariseManualEvents <- function(x, db=NULL) {
             ungroup()
         dbEv <- markIntervalOverlap(dbEv, tempEv)
         dbEv$parentID <- paste0('OE', dbEv$Id)
-        result <- left_join(result, dbEv[c('parentID', 'secOverlap', 'pctOverlap')], by='parentID')
-        nZeroTime <- sum(result$pctOverlap == 0)
-        cat('\n', nZeroTime, ' out of ', nrow(result), ' manual event(s) had no time overlap (FN).', sep='')
+        nZeroTime <- sum(dbEv$pctOverlap == 0)
+        cat('\n', nZeroTime, ' out of ', nrow(dbEv), ' manual event(s) had no time overlap (FN).', sep='')
+        if(nrow(result) == 0) {
+            return(dbEv)
+        }
+        result <- full_join(result, dbEv[c('parentID', 'secOverlap', 'pctOverlap')], by='parentID')
     }
     result
 }
@@ -264,9 +274,12 @@ summariseTemplateEvents <- function(x, db=NULL) {
             summarise(interval=interval(min(UTC), max(UTC))) %>%
             ungroup()
         tempEv <- markIntervalOverlap(tempEv, dbEv)
-        result <- left_join(result, tempEv[c('templateEvent', 'secOverlap', 'pctOverlap')], by='templateEvent')
-        nZeroTime <- sum(result$pctOverlap == 0)
-        cat('\n', nZeroTime, ' out of ', nrow(result), ' template event(s) had no time overlap (FN).', sep='')
+        nZeroTime <- sum(tempEv$pctOverlap == 0)
+        cat('\n', nZeroTime, ' out of ', nrow(tempEv), ' template event(s) had no time overlap (FN).', sep='')
+        if(nrow(result) == 0) {
+            return(tempEv)
+        }
+        result <- full_join(result, tempEv[c('templateEvent', 'secOverlap', 'pctOverlap')], by='templateEvent')
     }
     result
 }

devel/matchTemplateScript.R

@@ -15,6 +15,7 @@ db <- file.path(baseDir, 'PamGuard64 2_00_16e Drift-13_Final_Templates.sqlite3')
 saveFile <- file.path(baseDir, 'Drift13Template.rds')
 
 allData <- loadTemplateFolder(binFolder, names=templateNames, extraCols=extraCols, file=saveFile)
+# allData <- readRDS(saveFile)
 # these are in order of "templateNames" above. Can look at data and see if any of these need to
 # be raised/lowered
 threshVals <- c(.06, .15, .15, .15, .15, .15)
@@ -24,9 +25,11 @@ allData <- addTemplateLabels(allData, db, templateNames, threshVals)
 allData <- markGoodEvents(allData, minDets=3, maxSep=120, maxLength=120)
 
 # summary of how many of the detections in manually annotated events were tagged by template
-manualSummary <- summariseManualEvents(allData)
+# Adding the "db" argument will include the time-overlap based summary
+manualSummary <- summariseManualEvents(allData, db=db)
 # summary of how many detections tagged by template were present in manually annotated events
-templateSummary <- summariseTemplateEvents(allData)
+# Adding the "db" argument will include the time-overlap based summary
+templateSummary <- summariseTemplateEvents(allData, db=db)
 
 # adds events meeting nDets/nSeconds criteria to the database
 # make sure db is a COPY of the original for safety