added tagTrack.R and modified tagDeploymentDetections to correctly da…

…te order detections for flight maps

.gitignore

@@ -50,3 +50,5 @@ kiosk.cfg
 #the Logs directory
 Logs/*.txt
 
+changes.txt
+

global.R

@@ -44,7 +44,7 @@
 # Globals: libraries, modules etc.
 
 ############### Put github release version and data here ##########
-gblFooterText <- "USFWS Ankeny Hill Nature Center MOTUS Kiosk.  vsn 4.2.6  17-Apr-2023"
+gblFooterText <- "USFWS Ankeny Hill Nature Center MOTUS Kiosk.  vsn 4.2.7  19-Apr-2023"
 ############### will be rendered into footer by server() ########## 
 
 
@@ -103,6 +103,7 @@ source("modules/receiverDeploymentDetections.R")  #whats been at our receiver
 source("modules/MotusNews.R")  #whats been at our receiver
 source("modules/receiverDeploymentDetails.R")
 source("modules/AboutMotus.R")  
+source("modules/tagTrack.R")  
 
      # read the configuration file (see configUtils.R)
      #print("global calling getConfig")

modules/ReceiverDetections.R

@@ -408,39 +408,45 @@ SERVER_ReceiverDetections <- function(id, i18n_r, lang, rcvr) {
                DebugPrint("tagDeploymentDetections request failed - try Inactive cache")
                tagflight_df <- tagDeploymentDetections(tagDepID, config.EnableReadCache, config.InactiveCacheAgeLimitMinutes)
              }
-             #add the tag deployment release point data to the flight path dataset
-             #there has to be a better way but my R convert datetime to date skills arent up to it...
-             DebugPrint(paste0("input$mytable_rows_selected observeEvent() - get release point from tag details"))
-             releasepoint_df<-tagdetails_df[c("started","species","lat","lon")]
-             my_date<-as_date(releasepoint_df$started)
-             my_site<-"Tagged"
-             my_lat = releasepoint_df$lat
-             my_lon = releasepoint_df$lon
-             my_receiverDeployment=0
-             DebugPrint(paste0("input$mytable_rows_selected observeEvent() - add point to tagflight_df"))
-
-             if(nrow(tagflight_df)<=0){ #the empty df
-               tagflight_df[nrow(tagflight_df),] <- data.frame(my_date, my_site, my_lat, my_lon,my_receiverDeployment)
-             } else { #normal df
-               tagflight_df[nrow(tagflight_df) + 1,] <- data.frame(my_date, my_site, my_lat, my_lon,my_receiverDeployment)
-             }
 
-             DebugPrint(paste0("input$mytable_rows_selected observeEvent() - sort tagflight_df"))
+             # apply any flight data exclusions from .csv file read by global.R
+             if( length(gblIgnoreDateTagReceiverDetections_df > 0 )){
+                for(i in 1:nrow(gblIgnoreDateTagReceiverDetections_df)) {
+                   row <- gblIgnoreDateTagReceiverDetections_df[i,]
+                   theDate=row[["date"]]
+                   theID=row[["receiverDeploymentID"]]
+                   theSite=row[["site"]]
+                   #print(paste0("exclude"," date:",theDate, "  id:", theID,"  site:", theSite))
+                   tagflight_df <- tagflight_df[!(tagflight_df$receiverDeploymentID == theID & tagflight_df$date == theDate),] 
+                }
+             }
+
+             #message("---  The final filtered summary flight df --------")
+             #print(tagflight_df)
+
+
+             #DebugPrint(paste0("input$mytable_rows_selected observeEvent() - sort tagflight_df"))
              #sort flight detection so most recent appears at bottom of the list
-             tagflight_df <- tagflight_df[ order(tagflight_df$date, decreasing = FALSE), ]
+             # should already be sorted,....
+             #tagflight_df <- tagflight_df[ order(tagflight_df$date, decreasing = FALSE), ]
 
-       } #end if
+       } #end if else tagDepID is not na
 
         DebugPrint(paste0("input$mytable_rows_selected observeEvent() - render tagflight_df as table"))
-
-        output$flightpath <- DT::renderDataTable(tagflight_df,
-                                 selection = "single", 
-                                 options=list(dom = 'Bfrtip',
-                                 searching = F,
-                                "pageLength" = 18,
-                                language = list(zeroRecords = "No records to display - Motus.org possibly offline.")
-                                ) #end options
-        ) #end renderDataTable()
+        df<-tagflight_df[c("date", "site","lat" ,"lon","receiverDeploymentID")]
+        output$flightpath <- DT::renderDataTable({
+                          datatable( df,
+                                    selection = "single", 
+                                    options=list(dom = 'Bfrtip',
+                                                 searching = F,
+                                                 "pageLength" = 18,
+                                                 language = list(zeroRecords = "No records to display - Motus.org possibly offline.")
+                                    ) ) %>%  formatRound(columns=c("lat","lon"),digits=2) 
+       } ) #end renderDataTable
+
+
+
+
 
         #saveRDS(subset_df, file="subset.RDS")
 
@@ -491,7 +497,8 @@ SERVER_ReceiverDetections <- function(id, i18n_r, lang, rcvr) {
             stroke=FALSE,
             fillOpacity=0.5,
             #color=~color??, # color circle 
-            popup=label_text
+            popup=label_text,
+            label=tagflight_df$site
           ) %>%
 
           # OPTIONAL: for touchscreens: we add a 2nd set of markers that have bigger radius and 
@@ -503,7 +510,7 @@ SERVER_ReceiverDetections <- function(id, i18n_r, lang, rcvr) {
             radius=15,
             stroke=FALSE,
             fillOpacity=0.0,
-            popup=label_text
+            popup=label_text,label=tagflight_df$site
           ) %>%
 
           #now add the MovingMarker layer
@@ -512,7 +519,7 @@ SERVER_ReceiverDetections <- function(id, i18n_r, lang, rcvr) {
                           layerId="movingmarker",
                           duration=8000,
                           icon = birdIcon,
-                          label="",
+                          label=selected_species,
                           popup="")
 
         } # end else tagDepID is not null

modules/tagDeploymentDetections.R

@@ -75,9 +75,9 @@ rows = function(x) lapply(seq_len(nrow(x)), function(i) lapply(x,"[",i))
 
 empty_tagDeploymentDetection_df <- function()
 {
-  df <- data.frame( matrix( ncol = 5, nrow = 1) )
+  df <- data.frame( matrix( ncol = 7, nrow = 1) )
   df <- df %>% drop_na()
-  colnames(df) <- c('date', 'site', 'lat', 'lon', 'receiverDeploymentID')
+  colnames(df) <- c('date', 'site', 'lat', 'lon', 'receiverDeploymentID', 'seq', 'use')
   return (df)
 }
 
@@ -98,11 +98,11 @@ url <- paste( c('https://motus.org/data/tagDeploymentDetections?id=',tagDeployme
 cacheFilename = paste0(config.CachePath,"/tagDeploymentDetections_",tagDeploymentID,".Rda")
 
 
-df <-readCache(cacheFilename, useReadCache, cacheAgeLimitMinutes)   #see utility_functions.R
+summaryFlight_df <-readCache(cacheFilename, useReadCache, cacheAgeLimitMinutes)   #see utility_functions.R
 
-if( is.data.frame(df)){
+if( is.data.frame(summaryFlight_df)){
   DebugPrint("tagDeploymentDetections returning cached file")
-  return(df)
+  return(summaryFlight_df)
 } #else was NA
 
 #prepare an empty dataframe we can return if we encounter errors parsing query results
@@ -165,13 +165,6 @@ DebugPrint("end initial html result testing")
 
 # *************************************************************
 
-
-
-
-
-
-
-
 tbls <- page %>% html_nodes("table")
 
 ##print(length(tbls))
@@ -190,6 +183,8 @@ site<-c()
 lat<-c()
 lon<-c() 
 receiverDeploymentID<-c()
+seq<-c()
+use<-c()
 
 #> print(class(tbl1[[1]][i]))  
 #[1] "character"
@@ -213,16 +208,15 @@ if(hasFooter == 1){
 #for(i in 1:num.rows){
 n <- 0
 for(i in 1:nrecords){
-  n <- n+1
+  n<-n+1
+
   date <- c( date,  tbl1[[1]][i]  )
   site <- c( site,  tbl1[[2]][i] )
   lat <-  c( lat,  tbl1[[3]][i]  )
   lon <-  c( lon,  tbl1[[4]][i] )
+  seq <- c(seq,n)
+  use <- c(use,TRUE)
 }
-#print(date)
-#print(site)
-#print(lat)
-#print(lon)
 
 #convert strings to correct type
 date <- as.Date(date)
@@ -258,34 +252,107 @@ for (node in a_nodes) {
     #cat("n:",n," length:", length(receiverDeploymentID), "theId:",theID, "\n")
   }
 }
-#got them...
-#print(receiverDeploymentID)
 
-df <-data.frame(date,site,lat,lon,receiverDeploymentID)
-
-# flight data exclusions from .csv file read by global.R
-if( length(gblIgnoreDateTagReceiverDetections_df > 0 )){
+summaryFlight_df <-data.frame(date,site,lat,lon,receiverDeploymentID,seq,use)
+
+# obtain the track data with so we can correctly order the daily summary data
+# tagTrack_df <- tagTrack(tagDeploymentID, config.EnableReadCache, config.ActiveCacheAgeLimitMinutes)
+
+#dont read or write cache this df is a by product used to create
+#the summary flight df so if that cached product would be the same age
+#if we wrote this to cache... ie its redundant to cache this
+tagTrack_df <- tagTrack(tagDeploymentID, 0, 0) 
+
+# we need the correct receiverDeploymentID to support the ability to filter out
+# specific wild points detections in later steps.
+# Make a compact df of all unique sites from the tagTrack_df
+# for each distinct site, use the summaryFlight_df to lookup the receiverDeploymentID
+# using the site name and replace the dummy default receiver on the tagTrack_df 
+
+distinctSites_df<-tagTrack_df[!duplicated(tagTrack_df[ , c("site") ]),]
+if( length(distinctSites_df > 0 )){
+  for(i in 1:nrow(distinctSites_df)) {
+    row <- distinctSites_df[i,]
+    theDate=row[["date"]]
+    theID=row[["receiverDeploymentID"]]
+    theSite=row[["site"]]
+
+    #search for a row in summary containing the target site name 
+    res <- subset(summaryFlight_df, site==theSite)
+    res <- subset(res, 
+                  subset = !duplicated(res[c("site", "receiverDeploymentID")]) )
+    #if found, use the receiverDeploymentID to overwrite the dummy default value
+    if(nrow(res==1)){
+      theReceiverDeploymentID<-res$receiverDeploymentID
+      tagTrack_df$receiverDeploymentID[ tagTrack_df$site == theSite] <- theReceiverDeploymentID
+    } #else site was not found on summaryFlight_df - ignore
+  } # end for each row
+} #endif length distinct sites
+
+#sort flight detection so most recent appears at bottom of the list
+tagTrack_df <- tagTrack_df[ order(tagTrack_df$usecs, decreasing = FALSE), ]
+
+# we are done with the original summary df
+# we build a new summaryFlight_df from time ordered df
+n<-0
+prior_doy<-0
+prior_rcvr<-9999
+options(digits=10)
+summaryFlight_df<-empty_tagDeploymentDetection_df()
+for (row in 1:nrow(tagTrack_df)) {
+  n<-n+1
+  theUsecs <- tagTrack_df[row, "usecs"]
+  date <- tagTrack_df[row, "date"]
+  site <- tagTrack_df[row, "site"]
+  lat <- tagTrack_df[row, "lat"]
+  lon <- tagTrack_df[row, "lon"]
+  receiverDeploymentID <- tagTrack_df[row, "receiverDeploymentID"]
+  use <- tagTrack_df[row, "use"]
+  # create a decimal yeaydoy+decimalday this will be our sort order field
+  yr <- as.numeric(strftime(date, format = "%Y"))
+  doy <- as.numeric(strftime(date, format = "%j"))
+  hr <- as.numeric(strftime(date, format = "%H"))
+  min <-as.numeric(strftime(date, format = "%M"))
+  sec <- as.numeric(strftime(date, format = "%S"))
+  x = yr*1000+doy+hr/24+min/1440+sec/86400
+  seq<-x  #overwrites seq from row data
 
-for(i in 1:nrow(gblIgnoreDateTagReceiverDetections_df)) {
-      row <- gblIgnoreDateTagReceiverDetections_df[i,]
-      theDate=row[[1]]
-      theID=row[[2]]
-      theSite=row[[3]]
-
-      #print(paste0("exclude"," date:",theDate, "  id:", theID,"  site:", theSite))
-      df <- df[!(df$receiverDeploymentID == theID & df$date == theDate),] 
-   }
-}
-#print("***** final df ******")
-#print(df)
+  #now ready truncate the datetime to date part only
+  s<-strftime(date, format = "%Y-%m-%d")
+  date<-s
+
+  #print(paste0("tagTrack flight doy:",doy, " date:",date,"  site:",site," lat:",lat," lon:",
+  #             lon," receiverDeploymentID:", receiverDeploymentID, " seq:", seq, " use:",use))
+
+  # we want to build a new data frame only using only the first detection of an animal
+  # each day at any station
+  if( (doy == prior_doy) &  (receiverDeploymentID == prior_rcvr ) ){
+    use<-FALSE
+  } else { 
+    use<-TRUE
+    # create new frame and append 
+    a_df<-data.frame(date, site, lat, lon, receiverDeploymentID,seq,use)
+    summaryFlight_df[nrow(summaryFlight_df) + 1,] <- a_df
+    prior_doy = doy
+    prior_rcvr = receiverDeploymentID
+  }
+}  #end for each row
+summaryFlight_df[,'lat']=round(summaryFlight_df[,'lat'],2)
+summaryFlight_df[,'lon']=round(summaryFlight_df[,'lon'],2)
+
+#remove any other rows with 'use' field = FALSE
+summaryFlight_df <- summaryFlight_df[!(summaryFlight_df$use == FALSE),]
+
+#double check sort flight detection so most recent appears at bottom of the list
+summaryFlight_df <- summaryFlight_df[ order(summaryFlight_df$seq, decreasing = FALSE), ]
 
 #finally, delete any rows with nulls
-df <- df %>% drop_na()
+summaryFlight_df <- summaryFlight_df %>% drop_na()
 
 if(config.EnableWriteCache == 1){
   DebugPrint("writing new cache file.")
-  saveRDS(df,file=cacheFilename)
+  saveRDS(summaryFlight_df,file=cacheFilename)
 }
 DebugPrint("tagDeploymentDetections done.")
-return(df)
+return(summaryFlight_df)
 }