Initial commit of the glatos to ATO functions

R/ato_dep_from_glatos.R

@@ -0,0 +1,117 @@
+ato_dep_from_glatos <- function(glatos_file, glatos_detection_data = "", type = "meta") {
+  # Read in the file we've been given if we haven't been handed a dataframe.
+  glatos_data <- load_file(glatos_file)
+
+  # Detection data is an optional pass-through but if we have it, we can join it to the receiver dataframe to get additional transmitter data.
+  if (glatos_detection_data != "" && is.data.frame(glatos_detection_data)) {
+    # TODO: Join the two dataframes to get transmitter data passed through.
+  }
+
+  # If we've been given a metadata file, we read it in as one.
+  if (type == "meta") {
+    # This we can pull directly from the metadata.
+    dep <- make_dep(
+      receiver_model = glatos_data$ins_model_no,
+      receiver_serial = glatos_data$ins_serial_no,
+      receiver_codeset = glatos_data$code_map,
+      deploy_location = glatos_data$station,
+      deploy_datetime = as.POSIXct(glatos_data$deploy_date_time),
+      tz = "UTC",
+      deploy_lat = glatos_data$deploy_lat,
+      deploy_lon = glatos_data$deploy_long,
+      deploy_z = glatos_data$bottom_depth,
+      recover_datetime = as.POSIXct(glatos_data$recover_date_time),
+      recover_lat = glatos_data$recover_lat,
+      recover_lon = glatos_data$recover_long,
+      transmitter = NA_character_, # ???
+      transmitter_manufacturer = NA_character_, # ???
+      transmitter_ping_rate = as.numeric(glatos_data$glatos_ins_frequency), # is this accurate? I think this mapping is right.
+      transmitter_model = NA_character_, # ???
+      transmitter_serial = NA_integer_
+    )
+    return(dep)
+  } else if (type == "extract") {
+    # In the case where we don't have a metadata file to work with, we can use a similar setup to how we derive
+    # receiver data from detection extracts for IMOS.
+
+    # To start, we will filter the releases out of our detections dataframe.
+    no_releases <- glatos_data %>% filter(receiver_sn != "release")
+
+    # The first thing we need to do is gin up some inferred min and max deployment dates.
+    # We'll use the following code to do so.
+    rcvr_grouped <- NULL
+
+    # Start by grouping the detections by station, and ordering them by date.
+    rcvr_grouped_list <- no_releases %>%
+      group_by(station) %>%
+      arrange(detection_timestamp_utc, .by_group = TRUE)
+
+    # Set min date and max date to null.
+    minDate <- NULL
+    maxDate <- NULL
+
+    # Create a 'lead' dataframe for us to compare our current dataframe against.
+    rcvr_grouped_list_next <- lead(rcvr_grouped_list)
+
+    # For each row in the list
+    for (i in 1:nrow(rcvr_grouped_list)) {
+      row <- rcvr_grouped_list[i, ]
+
+      # If minDate is null, set it to the currently available date. minDate being null implies that
+      # we're just starting with this station (see where it's set to Null, below)
+      if (is.null(minDate)) {
+        minDate <- row$detection_timestamp_utc
+      }
+
+      # Get the next row from our "lead" frame.
+      nextStation <- rcvr_grouped_list_next[i, ]
+
+      # If our next station is Null (i.e, we're at the end of the frame), or the next station is different from
+      # the current one (i.e, we've reached the end of this time chunk)...
+      if (is.na(nextStation$receiver_sn) || nextStation$receiver_sn != row$receiver_sn) {
+        # Set Maxdate to our current date.
+        maxDate <- row$detection_timestamp_utc
+
+        # Add the min and max dates as entries in the row.
+        row <- row %>% mutate(
+          minDetectionDate = minDate,
+          maxDetectionDate = maxDate
+        )
+
+        # if rcvr_group hasn't been instantiated yet, use row to create it.
+        if (is.null(rcvr_grouped)) {
+          rcvr_grouped <- row
+        }
+        # Otherwise, just add the row to the group of receivers.
+        else {
+          rcvr_grouped <- rbind(rcvr_grouped, row)
+        }
+
+        # reset our min and max date to null so the next group will be handled properly.
+        minDate <- NULL
+        maxDate <- NULL
+      }
+    }
+
+    dep <- make_dep(
+      receiver_model = NA_character_,
+      receiver_serial = as.integer(rcvr_grouped$receiver_sn),
+      receiver_codeset = NA_character_,
+      deploy_location = rcvr_grouped$station,
+      deploy_datetime = as.POSIXct(rcvr_grouped$minDetectionDate),
+      deploy_lat = rcvr_grouped$deploy_lat,
+      deploy_lon = rcvr_grouped$deploy_long,
+      recover_datetime = as.POSIXct(rcvr_grouped$maxDetectionDate),
+      recover_lat = NA_real_,
+      recover_lon = NA_real_,
+      transmitter = paste(rcvr_grouped$transmitter_codespace, "-", rcvr_grouped$transmitter_id, sep = ""),
+      transmitter_model = NA_character_,
+      transmitter_serial = rcvr_grouped$transmitter_id,
+      tz = "UTC"
+    )
+
+    return(dep)
+  } else {
+    message("Invalid type specified. Use either 'meta' (if loading from a metadata file) or 'extract' (if deriving deployment metadata from a detection extract).")
+  }
+}

R/ato_dep_from_otn.R

@@ -6,6 +6,8 @@ ato_dep_from_otn <- function(otn_file, type = "meta") {
     # If it's a parquet, read it in as one...
     if (extension == "parquet") {
       otn_file <- read_parquet(otn_detections)
+    } else if (extension == "xlsx" || extension == "xls") {
+      otn_file <- read_excel(otn_detections)
     } else {
       # Otherwise bring it in as a CSV.
       otn_file <- read.csv(otn_detections, na = c("", "null", "NA"))

R/ato_tag_from_otn.R

@@ -6,6 +6,8 @@ ato_tag_from_otn <- function(otn_file, type = "meta") {
     # If it's a parquet, read it in as one...
     if (extension == "parquet") {
       otn_file <- read_parquet(otn_detections)
+    } else if (extension == "xlsx" || extension == "xls") {
+      otn_file <- read_excel(otn_detections)
     } else {
       # Otherwise bring it in as a CSV.
       otn_file <- read.csv(otn_detections, na = c("", "null", "NA"))
@@ -22,12 +24,12 @@ ato_tag_from_otn <- function(otn_file, type = "meta") {
       ping_rate = NA_real_, # ???
       ping_variation = NA_real_, # ???
       serial = otn_file$TAG_SERIAL_NUMBER,
-      transmitter = NA_character_, # ???
+      transmitter = paste(otn_file$TAG_CODE_SPACE, "-", TAG_ID_CODE),
       activation_datetime = as.POSIXct(otn_file$TAG_ACTIVATION_DATE),
       battery_life = otn_file$EST_TAG_LIFE,
       sensor_type = NA_character_, # ???
       sensor_unit = NA_character_, # ???
-      animal = NA_character_,
+      animal = otn_file$ANIMAL_ID,
       tz = "UTC"
     )
     return(tag)

R/glatos_to_ato.R

@@ -0,0 +1,63 @@
+##' @title Convert GLATOS detection data to an ATO object.
+##'
+##' @description Takes a GLATOS detection sheet and optionally receiver/tag metadata and returns an ATO object.
+##'
+##' @param otn_detections The dataframe containing detection information.
+##' @param otn_receivers The dataframe containing receiver information.
+##' @param otn_tags The dataframe containing tag information.
+##'
+##' @importFrom dplyr select '%>%' mutate rename group_by arrange distinct filter left_join
+##' @importFrom tidyr unite
+##' @importFrom lubridate ymd as_date
+##' @importFrom nanoparquet read_parquet
+##'
+##' @return Returns an ATO object.
+##' @export
+##'
+
+glatos_to_ato <- function(glatos_detections, glatos_receivers = "", glatos_tags = "") {
+  glatos_detections <- load_file(glatos_detections)
+
+  # Now we have a dataframe we can start loading into an ATO object. Let's make an instance of the object.
+  GLATOS_ATO <- new("ATO")
+
+  # Make the "detections" object,
+  det <- make_det(
+    datetime = as.POSIXct(glatos_detections$detection_timestamp_utc),
+    frac_second = NA_real_,
+    receiver_serial = as.integer(glatos_detections$receiver_sn),
+    transmitter = paste(glatos_detections$transmitter_codespace, "-", glatos_detections$transmitter_id, sep = ""), # Might have to synthesize this from other fields
+    sensor_value = as.numeric(glatos_detections$sensor_value),
+    tz = "UTC"
+  )
+
+  GLATOS_ATO <- add(GLATOS_ATO, det)
+
+  # I used to have a 'derive' argument as in some of the original OTN-to-IMOS functions but then I realised it was safer to just
+  # automatically try to derive receiver/tag metadata from the extract if no file is supplied.
+  dep <- ""
+  tag <- ""
+
+  # In both cases, if a file is supplied, we'll make the metadata objects using the information therein;
+  # otherwise, we'll attempt to make approximately correct receiver/tag metadata from only what's contained in
+  # the extract.
+  if (glatos_receivers != "") {
+    dep <- ato_dep_from_glatos(glatos_receivers, type = "meta")
+  } else {
+    dep <- ato_dep_from_glatos(glatos_detections, type = "extract")
+  }
+
+  GLATOS_ATO <- add(GLATOS_ATO, dep)
+
+  # In the detection extract zip I had for reference there didn't seem to be a bespoke Tag metadata file. I'll leave this structure here in case we need to build it out further but I think it's only ever going to flop into the else.
+  # if (glatos_tags != "") {
+  #  tag <- ato_tag_from_glatos(glatos_tags, type = "meta")
+
+  # } else {
+  #  tag <- ato_tag_from_glatos(glatos_detections, type = "extract")
+  # }
+
+  # GLATOS_ATO <- add(GLATOS_ATO, tag)
+
+  return(GLATOS_ATO)
+}

R/otn_to_ato.R

@@ -5,10 +5,6 @@
 ##' @param otn_detections The dataframe containing detection information.
 ##' @param otn_receivers The dataframe containing receiver information.
 ##' @param otn_tags The dataframe containing tag information.
-##' @param derive An optional flag that allows the user to pass in fewer than all three files. If given, the code will use the detection
-##' extract dataframe to generate dataframes for either or both of the receiver and tag dataframes, if they are not passed in. Although
-##' this will result in missing information, it does let the user supply only a detection extract file, which is a situation some may
-##' find themselves in.
 ##'
 ##' @importFrom dplyr select '%>%' mutate rename group_by arrange distinct filter left_join
 ##' @importFrom tidyr unite
@@ -52,6 +48,7 @@ otn_to_ato <- function(otn_detections, otn_receivers = "", otn_tags = "") {
   # automatically try to derive receiver/tag metadata from the extract if no file is supplied.
   dep <- ""
   tag <- ""
+  ani <- "" # We don't have an "animals" file so this object will all have to be derived.
 
   # In both cases, if a file is supplied, we'll make the metadata objects using the information therein;
   # otherwise, we'll attempt to make approximately correct receiver/tag metadata from only what's contained in
@@ -72,5 +69,6 @@ otn_to_ato <- function(otn_detections, otn_receivers = "", otn_tags = "") {
 
   OTN_ATO <- add(OTN_ATO, tag)
 
+
   return(OTN_ATO)
 }

R/utils.R

@@ -0,0 +1,18 @@
+load_file <- function(input_file) {
+  if (!is.data.frame(input_file)) {
+    # Grab the extension.
+    extension <- tools::file_ext(input_file)
+    # If it's a parquet, read it in as one...
+    if (extension == "parquet") {
+      output_frame <- read_parquet(input_file)
+    } else if (extension == "xlsx" || extension == "xls") {
+      output_frame <- read_excel(input_file)
+    } else {
+      # Otherwise bring it in as a CSV.
+      output_frame <- read.csv(input_file, na = c("", "null", "NA"))
+    }
+    return(output_frame)
+  } else {
+    return(input_file)
+  }
+}