R/gui_vms_db_cut.R

In vmsbase: GUI Tools to Process, Analyze and Plot Fisheries Data

#' VMS DB Cut GUI
#'
#' The \code{gui_vms_db_cut} function implements the graphical user interface for the
#'  VMS Track cutting routine.
#'
#' This function, with a VMS cleaned database (see \code{\link{gui_vms_db_clean}}),
#'  assign track numbers to the raw pings of each vessel in the VMS DB.
#'
#' @param vms_db_name The path of a VMS DataBase
#'
#' @return This function does not return a value.
#'
#' @usage gui_vms_db_cut(vms_db_name = "")
#'
#'
#' @seealso \code{\link{gui_vms_db_clean}}

gui_vms_db_cut <- function(vms_db_name = "") {
  vms_DB <- vms_DB$new()
  vms_DB$db <- vms_db_name

  vms_db_cut_win <- gwindow("VMS Track Cutter Utility", visible = FALSE)

  # TRACK CUTTER
  cut_g <- gframe(horizontal = FALSE, container = vms_db_cut_win)
  cut_g2 <- ggroup(horizontal = TRUE, container = cut_g)
  addSpring(cut_g2)
  gimage(system.file("ico/retroshare1.png", package = "vmsbase"), container = cut_g2)
  proglab_cut <- glabel("Track Cutter", container = cut_g2)
  addSpring(cut_g2)

  cut_g3 <- ggroup(horizontal = TRUE, container = cut_g)

  #################
  addSpring(cut_g3)
  vms_db_f <- gframe(text = "VMS DB file", horizontal = TRUE, container = cut_g3)
  addSpring(vms_db_f)
  sel_vms_f <- glabel("Select VMS DB file", container = vms_db_f)
  addSpring(vms_db_f)
  gimage(system.file("ico/folder-blue.png", package = "vmsbase"),
    container = vms_db_f,
    handler = function(h, ...) {
      vms_DB$db <- gfile(
        text = "Select VMS DataBase file",
        type = "open",
        filter = list("VMS DB file" = list(patterns = c("*.vms.sqlite")))
      )
      cat(vms_DB$db)
      svalue(sel_vms_f) <- ifelse(.Platform$OS.type == "windows", strsplit(vms_DB$db, "\\\\")[[1]][length(strsplit(vms_DB$db, "\\\\")[[1]])], strsplit(vms_DB$db, "/")[[1]][length(strsplit(vms_DB$db, "/")[[1]])])
      enabled(start_b) <- TRUE
    }
  )
  gimage(system.file("ico/application-exit-5.png", package = "vmsbase"),
    container = vms_db_f,
    handler = function(h, ...) {
      vms_DB$db <- ""
      enabled(start_b) <- FALSE
      svalue(sel_vms_f) <- "Select VMS DB file"
    }
  )
  addSpring(cut_g3)
  ################

  cut_opt <- ggroup(horizontal = TRUE, container = cut_g)

  addSpring(cut_opt)
  opt_f <- gframe(text = "Split Options", horizontal = FALSE, container = cut_opt, expand = TRUE)
  addSpace(opt_f, 20)
  opt_out_g <- ggroup(horizontal = TRUE, container = opt_f)
  addSpring(opt_out_g)
  opt_out_c <- gcheckbox("Use Outliers", checked = TRUE, container = opt_out_g)
  addSpring(opt_out_g)
  addSpace(opt_f, 20)
  opt_med_g <- ggroup(horizontal = TRUE, container = opt_f)
  addSpring(opt_med_g)
  opt_med_c <- gcheckbox("Lag > Median", checked = TRUE, container = opt_med_g)
  addSpring(opt_med_g)
  addSpace(opt_f, 20)
  glabel(text = "Lag > Minutes", container = opt_f)
  opt_hou_s <- gslider(
    from = 30, to = 360, by = 5,
    value = 120, horizontal = TRUE, container = opt_f
  )
  addSpace(opt_f, 20)
  addSpring(cut_opt)

  ################
  addSpring(cut_g)
  infolab_cut <- glabel("", container = cut_g)
  addSpring(cut_g)
  start_b <- gbutton("Start cutting", container = cut_g, handler = function(h, ...) {
    enabled(vms_db_f) <- FALSE
    enabled(start_b) <- FALSE

    if (sqldf("select count(*) from warn", dbname = vms_DB$db) > 0) {
      svalue(infolab_cut) <- "Updating...\nVMS DataBase"
      sqldf("drop table if exists track", dbname = vms_DB$db)
      sqldf("CREATE TABLE track(I_NCEE INT, LAT REAL, LON REAL, DATE REAL, SPE REAL, HEA REAL, W_HARB INT, T_NUM INT, P_ID INT)", dbname = vms_DB$db)
      cat("\n\n   ---   Track Cutting Started   ---\n")
      incee <- sqldf("select distinct I_NCEE from ping", dbname = vms_DB$db)
      num_incee <- nrow(incee)
      for (v in 1:num_incee)
      {
        svalue(infolab_cut) <- paste("Processing...\nVessel: ", v, " of ", num_incee, spe = "")
        cat("\nVessel: ", v, " of ", num_incee, spe = "")
        vessel <- fn$sqldf("select I_NCEE, LAT, LON, DATE, SPE, HEA, warn.* from ping, warn where ping.ROWID = warn.p_id and I_NCEE = `incee[v,1]` and W_DUPL = 0 and W_COHE != 0 and W_LAND = 0 order by DATE ", dbname = vms_DB$db)
        if (nrow(vessel) == 0) {
          cat(" - Skipped, no pings", sep = "")
        } else {
          numlines <- nrow(vessel)
          cat(" with ", numlines, " pings ", sep = "")
          track_data <- data.frame(
            "I_NCEE" = numeric(numlines),
            "LAT" = numeric(numlines),
            "LON" = numeric(numlines),
            "DATE" = numeric(numlines),
            "SPE" = numeric(numlines),
            "HEA" = numeric(numlines),
            "W_HARB" = integer(numlines),
            "T_NUM" = numeric(numlines),
            "ROWID" = numeric(numlines)
          )

          track_data["ROWID"] <- vessel["p_id"]
          track_data["I_NCEE"] <- vessel["I_NCEE"]
          track_data["LAT"] <- vessel["LAT"]
          track_data["LON"] <- vessel["LON"]
          track_data["DATE"] <- vessel["DATE"]
          track_data["SPE"] <- vessel["SPE"]
          track_data["HEA"] <- vessel["HEA"]
          track_data["W_HARB"] <- vessel["W_HARB"]
          spe3qua <- quantile(as.numeric(vessel[, "SPE"]), probs = 0.75)
          useharb <- unique(cbind(
            vessel[which(vessel$W_HARB == 1), "LON"],
            vessel[which(vessel$W_HARB == 1), "LAT"]
          ))
          # assign raw track numbers and add in harbour points
          tr_num <- 1
          for (j in 1:numlines)
          {
            tr_lin <- nrow(track_data)
            delta <- tr_lin - numlines
            if (vessel[j, "W_HARB"] == 1 | vessel[j, "W_LAND"] == 1) {
              track_data[j + delta, "T_NUM"] <- 0
              next
            } else {
              track_data[j + delta, "T_NUM"] <- tr_num
              if (nrow(useharb) == 0) {
                next
              }
              if (nrow(useharb) > 1) {
                dist <- spDistsN1(useharb[, 1:2],
                  as.matrix(c(
                    vessel[j, "LON"],
                    vessel[j, "LAT"]
                  )),
                  longlat = TRUE
                )
              }
              if (nrow(useharb) == 1) {
                dist <- spDists(cbind(useharb[, 1], useharb[, 2]),
                  (cbind(vessel[j, "LON"], vessel[j, "LAT"])),
                  longlat = TRUE
                )
              }
              hdist <- min(dist)
              nearh <- which(dist == hdist)
              if (j > 1) {
                if (vessel[j - 1, "W_HARB"] == 1) {
                  newdate <- vessel[j, "DATE"] - ((1 / 24) * (hdist / spe3qua))
                  track_data <- rbind(
                    track_data[1:(j + delta - 1), ],
                    c(
                      vessel[j, "I_NCEE"],
                      useharb[nearh[1], 2],
                      useharb[nearh[1], 1],
                      ifelse(vessel[j - 1, "DATE"] < newdate & newdate != Inf & newdate != -Inf, newdate, vessel[j - 1, "DATE"]),
                      0,
                      0,
                      1,
                      tr_num
                    ),
                    track_data[(j + delta):nrow(track_data), ]
                  )
                }
              }
              tr_lin <- nrow(track_data)
              delta <- tr_lin - numlines
              if (j < nrow(vessel)) {
                if (vessel[j + 1, "W_HARB"] == 1) {
                  newdate <- vessel[j, "DATE"] + ((1 / 24) * (hdist / spe3qua))
                  track_data <- rbind(
                    track_data[1:(j + delta), ],
                    c(
                      vessel[j, "I_NCEE"],
                      useharb[nearh[1], 2],
                      useharb[nearh[1], 1],
                      ifelse(vessel[j + 1, "DATE"] > newdate & newdate != Inf & newdate != -Inf, newdate, vessel[j + 1, "DATE"]),
                      0, 0, 1, tr_num
                    ),
                    track_data[(j + delta + 1):nrow(track_data), ]
                  )
                  tr_num <- tr_num + 1
                }
              }
            }
          }
          track_data <- track_data[which(track_data$T_NUM > 0), ]
          if (nrow(track_data) > 0) {
            # pingfreq <- diff(track_data$DATE[which(track_data$W_HARB == 0)])
            pingfreq <- diff(track_data$DATE)

            if (svalue(opt_out_c) == TRUE) {
              out <- boxplot(diff(track_data$DATE[which(track_data$W_HARB == 0)]), plot = F)$out

              if (length(out) > 0) {
                if (svalue(opt_med_c) == TRUE) {
                  da_to <- which(out > median(pingfreq) & out > (1 / 24) * (svalue(opt_hou_s) / 60))
                } else {
                  da_to <- which(out > (1 / 24) * (svalue(opt_hou_s) / 60))
                }

                if (length(da_to) > 0) {
                  outmin <- min(out[da_to])
                  outliers <- which((diff(track_data$DATE) >= outmin | diff(track_data$DATE) >= 0.125) & track_data$W_HARB[-c(nrow(track_data))] != 1)
                  if (length(outliers) > 0) {
                    cat(" - Splitting Tracks ", sep = "")
                    for (k in 1:length(outliers))
                    {
                      cat(":", sep = "")
                      if (nrow(useharb) == 0) {
                        newdate1 <- track_data[(outliers[k]), "DATE"] + 0.0002
                        newdate2 <- newdate1
                        track_data <- rbind(
                          track_data[1:(outliers[k]), ],
                          c(track_data[(outliers[k]), "I_NCEE"], track_data[(outliers[k]), "LAT"], track_data[(outliers[k]), "LON"], newdate1, 0, 0, 0, (track_data[(outliers[k]), "T_NUM"])),
                          c(track_data[(outliers[k] + 1), "I_NCEE"], track_data[(outliers[k] + 1), "LAT"], track_data[(outliers[k] + 1), "LON"], newdate2, 0, 0, 0, (track_data[(outliers[k] + 1), "T_NUM"])),
                          track_data[(outliers[k] + 1):nrow(track_data), ]
                        )
                        track_data$T_NUM[(outliers[k] + 2):nrow(track_data)] <- track_data$T_NUM[(outliers[k] + 2):nrow(track_data)] + 1
                        outliers <- outliers + 2
                        next
                      }
                      if (nrow(useharb) > 1) {
                        dist1 <- spDistsN1(useharb[, 1:2],
                          as.matrix(c(track_data[outliers[k], "LON"], track_data[outliers[k], "LAT"])),
                          longlat = TRUE
                        )
                      }

                      if (nrow(useharb) == 1) {
                        dist1 <- spDists(cbind(useharb[, 1], useharb[, 2]),
                          (cbind(track_data[outliers[k], "LON"], track_data[outliers[k], "LAT"])),
                          longlat = TRUE
                        )
                      }
                      hdist1 <- min(dist1)
                      nearh1 <- which(dist1 == hdist1)
                      if (nrow(useharb) > 1) {
                        dist2 <- spDistsN1(useharb[, 1:2],
                          as.matrix(c(track_data[(outliers[k] + 1), "LON"], track_data[(outliers[k] + 1), "LAT"])),
                          longlat = TRUE
                        )
                      }
                      if (nrow(useharb) == 1) {
                        dist2 <- spDists(cbind(useharb[, 1], useharb[, 2]),
                          (cbind(track_data[(outliers[k] + 1), "LON"], track_data[(outliers[k] + 1), "LAT"])),
                          longlat = TRUE
                        )
                      }
                      hdist2 <- min(dist2)
                      nearh2 <- which(dist2 == hdist2)
                      newdate1 <- track_data[(outliers[k]), "DATE"] + ((1 / 24) * (spe3qua / hdist1))
                      newdate1 <- ifelse(track_data[(outliers[k] + 1), "DATE"] > newdate1 & newdate1 != Inf & newdate1 != -Inf,
                        newdate1,
                        track_data[(outliers[k]), "DATE"] + 0.0002
                      )
                      newdate2 <- track_data[(outliers[k] + 1), "DATE"] - ((1 / 24) * (spe3qua / hdist2))
                      newdate2 <- ifelse(newdate1 < newdate2 & newdate2 != Inf & newdate2 != -Inf,
                        newdate2,
                        newdate1
                      )
                      track_data <- rbind(
                        track_data[1:(outliers[k]), ],
                        c(track_data[(outliers[k]), "I_NCEE"], useharb[nearh[1], 2], useharb[nearh[1], 1], newdate1, 0, 0, 1, (track_data[(outliers[k]), "T_NUM"]), NA),
                        c(track_data[(outliers[k] + 1), "I_NCEE"], useharb[nearh2[1], 2], useharb[nearh2[1], 1], newdate2, 0, 0, 1, (track_data[(outliers[k] + 1), "T_NUM"]), NA),
                        track_data[(outliers[k] + 1):nrow(track_data), ]
                      )
                      track_data$T_NUM[(outliers[k] + 2):nrow(track_data)] <- track_data$T_NUM[(outliers[k] + 2):nrow(track_data)] + 1
                      outliers <- outliers + 2
                    }
                  }
                } else {
                  cat(" -  No Ping Frequency outliers found ", sep = "")
                }
              } else {
                cat(" -  No Ping Frequency outliers found ", sep = "")
              }
            } else {
              if (svalue(opt_med_c) == TRUE) {
                outliers <- which(pingfreq > median(pingfreq) | pingfreq > (1 / 24) * (svalue(opt_hou_s) / 60))
              } else {
                outliers <- which(pingfreq > (1 / 24) * (svalue(opt_hou_s) / 60))
              }
              out_harb <- which(track_data$W_HARB[outliers] == 1)
              if (length(out_harb) > 0) {
                outliers <- outliers[-out_harb]
              }

              if (length(outliers) > 0) {
                cat(" - Splitting Tracks ", sep = "")
                for (k in 1:length(outliers))
                {
                  cat(":", sep = "")
                  if (nrow(useharb) == 0) {
                    newdate1 <- track_data[(outliers[k]), "DATE"] + 0.0002
                    newdate2 <- newdate1
                    track_data <- rbind(
                      track_data[1:(outliers[k]), ],
                      c(track_data[(outliers[k]), "I_NCEE"], track_data[(outliers[k]), "LAT"], track_data[(outliers[k]), "LON"], newdate1, 0, 0, 0, (track_data[(outliers[k]), "T_NUM"])),
                      c(track_data[(outliers[k] + 1), "I_NCEE"], track_data[(outliers[k] + 1), "LAT"], track_data[(outliers[k] + 1), "LON"], newdate2, 0, 0, 0, (track_data[(outliers[k] + 1), "T_NUM"])),
                      track_data[(outliers[k] + 1):nrow(track_data), ]
                    )
                    track_data$T_NUM[(outliers[k] + 2):nrow(track_data)] <- track_data$T_NUM[(outliers[k] + 2):nrow(track_data)] + 1
                    outliers <- outliers + 2
                    next
                  }
                  if (nrow(useharb) > 1) {
                    dist1 <- spDistsN1(useharb[, 1:2],
                      as.matrix(c(track_data[outliers[k], "LON"], track_data[outliers[k], "LAT"])),
                      longlat = TRUE
                    )
                  }

                  if (nrow(useharb) == 1) {
                    dist1 <- spDists(cbind(useharb[, 1], useharb[, 2]),
                      (cbind(track_data[outliers[k], "LON"], track_data[outliers[k], "LAT"])),
                      longlat = TRUE
                    )
                  }
                  hdist1 <- min(dist1)
                  nearh1 <- which(dist1 == hdist1)
                  if (nrow(useharb) > 1) {
                    dist2 <- spDistsN1(useharb[, 1:2],
                      as.matrix(c(track_data[(outliers[k] + 1), "LON"], track_data[(outliers[k] + 1), "LAT"])),
                      longlat = TRUE
                    )
                  }
                  if (nrow(useharb) == 1) {
                    dist2 <- spDists(cbind(useharb[, 1], useharb[, 2]),
                      (cbind(track_data[(outliers[k] + 1), "LON"], track_data[(outliers[k] + 1), "LAT"])),
                      longlat = TRUE
                    )
                  }
                  hdist2 <- min(dist2)
                  nearh2 <- which(dist2 == hdist2)
                  newdate1 <- track_data[(outliers[k]), "DATE"] + ((1 / 24) * (spe3qua / hdist1))
                  newdate1 <- ifelse(track_data[(outliers[k] + 1), "DATE"] > newdate1 & newdate1 != Inf & newdate1 != -Inf,
                    newdate1,
                    track_data[(outliers[k]), "DATE"] + 0.0002
                  )
                  newdate2 <- track_data[(outliers[k] + 1), "DATE"] - ((1 / 24) * (spe3qua / hdist2))
                  newdate2 <- ifelse(newdate1 < newdate2 & newdate2 != Inf & newdate2 != -Inf,
                    newdate2,
                    newdate1
                  )
                  track_data <- rbind(
                    track_data[1:(outliers[k]), ],
                    c(track_data[(outliers[k]), "I_NCEE"], useharb[nearh[1], 2], useharb[nearh[1], 1], newdate1, 0, 0, 1, (track_data[(outliers[k]), "T_NUM"]), NA),
                    c(track_data[(outliers[k] + 1), "I_NCEE"], useharb[nearh2[1], 2], useharb[nearh2[1], 1], newdate2, 0, 0, 1, (track_data[(outliers[k] + 1), "T_NUM"]), NA),
                    track_data[(outliers[k] + 1):nrow(track_data), ]
                  )

                  track_data$T_NUM[(outliers[k] + 2):nrow(track_data)] <- track_data$T_NUM[(outliers[k] + 2):nrow(track_data)] + 1
                  outliers <- outliers + 2
                }
              }
            }
            sqldf("insert into track select * from `track_data`", dbname = vms_DB$db)
          }
        }
      }
      cat("\n\n   ---   End Track Cutting   ---\n", sep = "")
      gconfirm("VMS DB Track Cutting Completed!",
        title = "Confirm",
        icon = "info",
        parent = vms_db_cut_win,
        handler = function(h, ...) {
          dispose(vms_db_cut_win)
        }
      )
    } else {
      gconfirm("Warning data not available\n\nExecute DB Cleaning first!",
        title = "Error",
        icon = "error",
        parent = vms_db_cut_win,
        handler = function(h, ...) {
          dispose(vms_db_cut_win)
        }
      )
    }
  })
  enabled(start_b) <- FALSE
  if (vms_DB$db != "") {
    svalue(sel_vms_f) <- ifelse(.Platform$OS.type == "windows", strsplit(vms_DB$db, "\\\\")[[1]][length(strsplit(vms_DB$db, "\\\\")[[1]])], strsplit(vms_DB$db, "/")[[1]][length(strsplit(vms_DB$db, "/")[[1]])])
    enabled(start_b) <- TRUE
  }
  visible(vms_db_cut_win) <- TRUE
}