Nothing
#' Mark Fishing Points GUI
#'
#'
#' The \code{gui_mark_fis_poi} function implements the graphical user interface for the
#' Fishing Point Marking routine.
#'
#' This function, with a VMS database and a shape file with harbours points, performs a filtered search over the whole
#' db assigning fishing status to the vms interpolated data.
#'
#' @param vms_db_name The path of a VMS DataBase
#' @param harb_file_name The path of a shape file with harbours point data
#'
#' @return This function does not return a value.
#'
#' @usage gui_mark_fis_poi(vms_db_name = "", harb_file_name = "")
#'
#'
gui_mark_fis_poi <- function(vms_db_name = "", harb_file_name = "") {
vms_DB <- vms_DB$new()
vms_DB$db <- vms_db_name
harb <- harbCoo$new()
harb$path <- harb_file_name
met_list <- data.frame()
mark_fis_poi_win <- gwindow(
title = "Mark Fishing Points Tool",
visible = FALSE,
width = 950,
height = 350
)
big_g <- ggroup(horizontal = FALSE, container = mark_fis_poi_win, use.scrollwindow = TRUE)
g_input <- ggroup(horizontal = TRUE, container = big_g)
#### Load VMS DB
addSpring(g_input)
vms_db_f <- gframe(text = "VMS DB file", horizontal = TRUE, container = g_input)
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")))
)
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]])])
# nn_tab <- as.numeric(sqldf("SELECT count(*) FROM sqlite_master WHERE type='table' AND name='pre_nn'", dbname = vms_DB$db))
# if(nn_tab == 1)
# {
# nn_tab <- as.numeric(sqldf("SELECT count(*) FROM sqlite_master WHERE type='table' AND name='nn_clas'", dbname = vms_DB$db))
# if(nn_tab == 1)
# {
enabled(gri_g3f4) <- TRUE
# }
met_list <<- sqldf("select distinct met_des from vms_lb", dbname = vms_DB$db)
if (nrow(met_list) == 0) {
nn_tab <- as.numeric(sqldf("SELECT count(*) FROM sqlite_master WHERE type='table' AND name='nn_:clas'", dbname = vms_DB$db))
if (nn_tab == 1) {
met_list <<- sqldf("select distinct met_des from nn_clas", dbname = vms_DB$db)
}
}
if (nrow(met_list) > 0) {
delete(big_g, up_g)
up_g <<- gframe(text = "Filter Parameters", horizontal = TRUE, container = big_g)
addSpring(up_g)
lay_win <<- glayout(spacing = 5, container = up_g)
lay_win[1, 1, anchor = 0] <- "Metier"
lay_win[1, 2, anchor = 0] <- "Min Vel Kn"
lay_win[1, 3, anchor = 0] <- "Max Vel Kn"
lay_win[1, 4, anchor = 0] <- "Min Depth Mt"
lay_win[1, 5, anchor = 0] <- "Max Depth Mt"
lay_win[1, 6, anchor = 0] <- "Harb Dist Km"
addSpring(up_g)
for (i in 1:nrow(met_list)) {
lay_win[i + 1, 1] <- as.character(met_list[i, 1])
lay_win[i + 1, 2] <- gedit(text = "0", width = 10, container = lay_win)
lay_win[i + 1, 3] <- gedit(text = "Inf", width = 10, container = lay_win)
lay_win[i + 1, 4] <- gedit(text = "0", width = 10, container = lay_win)
lay_win[i + 1, 5] <- gedit(text = "-Inf", width = 10, container = lay_win)
lay_win[i + 1, 6] <- gedit(text = 3 * 1.85200, width = 10, container = lay_win)
}
}
if (harb$path != "") {
enabled(gri_alg) <- TRUE
enabled(b_mark_fis_poi) <- TRUE
}
}
}
)
gimage(system.file("ico/application-exit-5.png", package = "vmsbase"),
container = vms_db_f,
handler = function(h, ...) {
vms_DB$db <- ""
delete(big_g, up_g)
#######################
up_g <<- gframe(text = "Filter Parameters", horizontal = TRUE, container = big_g)
# add(big_g, up_g)
#######################
addSpring(up_g)
lay_win <<- glayout(spacing = 5, container = up_g)
lay_win[1, 1, anchor = 0] <- "Metier"
lay_win[1, 2, anchor = 0] <- "Min Vel Kn"
lay_win[1, 3, anchor = 0] <- "Max Vel Kn"
lay_win[1, 4, anchor = 0] <- "Min Depth Mt"
lay_win[1, 5, anchor = 0] <- "Max Depth Mt"
lay_win[1, 6, anchor = 0] <- "Harb Dist Km"
addSpring(up_g)
#######################
enabled(b_mark_fis_poi) <- FALSE
enabled(gri_g3f4) <- FALSE
enabled(gri_alg) <- FALSE
svalue(sel_vms_f) <- "Select VMS DB file"
}
)
addSpring(g_input)
#######################
#### Load Harbours file
cus_har_g <- gframe(text = "Harbours Shape File", horizontal = TRUE, container = g_input)
addSpring(cus_har_g)
cus_har_lab <- glabel("Select Harbours Shape File", container = cus_har_g)
addSpring(cus_har_g)
gimage(system.file("ico/folder-man.png", package = "vmsbase"),
container = cus_har_g,
handler = function(h, ...) {
harb$path <- gfile(
text = "Select ShapePoints map",
type = "open",
filter = list("shp data" = list(patterns = c("*.shp")))
)
# svalue(cus_har_lab) <- paste("Harbour: ", strsplit(harb, "/")[[1]][length(strsplit(harb, "/")[[1]])], sep = "")
svalue(cus_har_lab) <- paste("Harbour: ", ifelse(.Platform$OS.type == "windows", strsplit(harb$path, "\\\\")[[1]][length(strsplit(harb$path, "\\\\")[[1]])], strsplit(harb$path, "/")[[1]][length(strsplit(harb$path, "/")[[1]])]), sep = "")
if (harb$path != "" & vms_DB$db != "") {
enabled(b_mark_fis_poi) <- TRUE
enabled(gri_alg) <- TRUE
}
}
)
gimage(system.file("ico/application-exit-5.png", package = "vmsbase"),
container = cus_har_g,
handler = function(h, ...) {
harb$path <- ""
svalue(cus_har_lab) <- "Select Harbours Shape File"
enabled(b_mark_fis_poi) <- FALSE
enabled(gri_alg) <- FALSE
}
)
addSpring(g_input)
#######################
#### Select Data Source
addSpring(g_input)
gri_g3f4 <- ggroup(horizontal = TRUE, container = g_input)
addSpring(gri_g3f4)
dat_sel_f <- gframe(text = "Metier Data Source", horizontal = TRUE, container = gri_g3f4)
met_da_su <- gdroplist(c("VMS-LB Match", "NN Prediction"),
selected = 1, container = dat_sel_f,
handler = function(h, ...) {
if (svalue(met_da_su) == "VMS-LB Match") {
met_list <<- sqldf("select distinct met_des from vms_lb", dbname = vms_DB$db)
} else {
met_list <<- sqldf("select distinct met_des from nn_clas", dbname = vms_DB$db)
}
if (nrow(met_list) > 0) {
delete(big_g, up_g)
#######################
up_g <<- gframe(text = "Filter Parameters", horizontal = TRUE, container = big_g)
# add(big_g, up_g)
#######################
addSpring(up_g)
lay_win <<- glayout(spacing = 5, container = up_g)
lay_win[1, 1, anchor = 0] <- "Metier"
lay_win[1, 2, anchor = 0] <- "Min Vel Kn"
lay_win[1, 3, anchor = 0] <- "Max Vel Kn"
lay_win[1, 4, anchor = 0] <- "Min Depth Mt"
lay_win[1, 5, anchor = 0] <- "Max Depth Mt"
lay_win[1, 6, anchor = 0] <- "Harb Dist Km"
addSpring(up_g)
#######################
for (i in 1:nrow(met_list)) {
lay_win[i + 1, 1] <- as.character(met_list[i, 1])
lay_win[i + 1, 2] <- gedit(text = "0", width = 10, container = lay_win)
lay_win[i + 1, 3] <- gedit(text = "Inf", width = 10, container = lay_win)
lay_win[i + 1, 4] <- gedit(text = "0", width = 10, container = lay_win)
lay_win[i + 1, 5] <- gedit(text = "-Inf", width = 10, container = lay_win)
lay_win[i + 1, 6] <- gedit(text = 3 * 1.85200, width = 10, container = lay_win)
}
}
}
)
addSpring(gri_g3f4)
enabled(gri_g3f4) <- FALSE
#### Select Algorithm
addSpring(g_input)
gri_alg <- ggroup(horizontal = TRUE, container = g_input)
addSpring(gri_alg)
alg_sel_f <- gframe(text = "Method", horizontal = TRUE, container = gri_alg)
sel_alg <- gdroplist(c("Slow & Ligth", "Fast & Heavy"), selected = 1, container = alg_sel_f)
addSpring(gri_alg)
enabled(gri_alg) <- FALSE
addSpring(g_input)
b_mark_fis_poi <- gbutton(text = "\n Start \n", container = g_input, handler = function(h, ...) {
enabled(big_g) <- FALSE
harbs <- readShapePoints(harb$path)
sta_met <- cbind(met_list, matrix(0, ncol = 5, nrow = nrow(met_list)))
colnames(sta_met) <- c("Metier", "min_vel_kn", "max_vel_kn", "min_depth_mt", "max_depth_mt", "harb_dist_km")
for (m in 1:nrow(sta_met)) {
sta_met[m, 2:6] <- as.numeric(eval(parse(text = paste("c(", paste("svalue(lay_win[", m + 1, ",", 2:6, "])", sep = "", collapse = ", "), ")", sep = ""))))
}
cat("\n\n --- Fishing Point Analysis Started ---\n", sep = "")
sqldf("drop table if exists p_fish", dbname = vms_DB$db)
sqldf("CREATE TABLE p_fish(i_id INT, F_SPE INT, F_DEP INT, F_DIS INT, FISH INT)", dbname = vms_DB$db)
sqldf("drop table if exists p_fish_nn", dbname = vms_DB$db)
sqldf("CREATE TABLE p_fish_nn(i_id INT, F_SPE INT, F_DEP INT, F_DIS INT, FISH INT)", dbname = vms_DB$db)
if (svalue(sel_alg) == "Slow & Ligth") {
incee_vms <- sqldf("select distinct I_NCEE from intrp", dbname = vms_DB$db)
num_vess <- nrow(incee_vms)
cat("\n - Metier Data Source: ", svalue(met_da_su), " -\n", sep = "")
for (i in 1:num_vess) {
cat("\nVessel: ", incee_vms[i, 1], " - N.", i, " of ", num_vess, sep = "")
if (svalue(met_da_su) == "VMS-LB Match") {
match <- fn$sqldf("select vessel, track, met_des from vms_lb where vessel = `incee_vms[i,1]`", dbname = vms_DB$db)
} else {
match <- fn$sqldf("select I_NCEE, T_NUM, met_des from nn_clas where I_NCEE = `incee_vms[i,1]`", dbname = vms_DB$db)
colnames(match) <- c("vessel", "track", "met_des")
}
num_track <- nrow(match)
if (num_track == 0) {
cat(" - Skipped, VMS-LogBook Match not found!")
next
}
for (k in 1:num_track) {
# cat("\nTrack: ", k, " of ", num_track, sep = "")
cat(".", sep = "")
eff_tra <- match[k, "track"]
sin_tra <- fn$sqldf("select * from intrp, p_depth where I_NCEE = `incee_vms[i,1]` and T_NUM = `eff_tra` and intrp.rowid = i_id", dbname = vms_DB$db)
if (nrow(sin_tra) == 0) {
cat("-", sep = "")
next
}
tra_met <- match[k, "met_des"]
sta_met_num <- which(sta_met[, "Metier"] == tra_met)
sin_tra <- cbind(sin_tra, 0, 0, 0, 0)
colnames(sin_tra)[(ncol(sin_tra) - 3):ncol(sin_tra)] <- c("F_SPE", "F_DEP", "F_DIS", "FISH")
# cat(" - Checking Speed... ", sep = "")
sin_tra[which((sin_tra[, "SPE"] * 0.539956803456) > sta_met[sta_met_num, "min_vel_kn"] & (sin_tra[, "SPE"] * 0.539956803456) < sta_met[sta_met_num, "max_vel_kn"]), "F_SPE"] <- 1
# cat("Depth... ", sep = "")
sin_tra[which(sin_tra[, "DEPTH"] < sta_met[sta_met_num, "min_depth_mt"] & sin_tra[, "DEPTH"] > sta_met[sta_met_num, "max_depth_mt"]), "F_DEP"] <- 1
# cat("Distance... ", sep = "")
for (j in 1:nrow(sin_tra)) {
nea_har <- which(spDistsN1(harbs, as.numeric(sin_tra[j, c("LON", "LAT")]), longlat = TRUE) > (sta_met[sta_met_num, "harb_dist_km"]))
if (length(nea_har) != 0) {
sin_tra[j, "F_DIS"] <- 1
}
}
fis_poi <- which(sin_tra[, "F_SPE"] == 1 & sin_tra[, "F_DEP"] == 1 & sin_tra[, "F_DIS"] == 1)
if (length(fis_poi) != 0) {
cat("+", sep = "")
sin_tra[fis_poi, "FISH"] <- 1
}
result <- sin_tra[, c("i_id", "F_SPE", "F_DEP", "F_DIS", "FISH")]
rm(sin_tra)
gc()
# cat("\n - DB update... -\n", sep = "")
if (svalue(met_da_su) == "VMS-LB Match") {
sqldf("insert into p_fish select * from `result`", dbname = vms_DB$db)
} else {
sqldf("insert into p_fish_nn select * from `result`", dbname = vms_DB$db)
}
rm(result)
gc()
}
}
} else {
if (svalue(met_da_su) == "VMS-LB Match") {
the_met <- sqldf("select distinct met_des from vms_lb", dbname = vms_DB$db)
} else {
the_met <- sqldf("select distinct met_des from nn_clas", dbname = vms_DB$db)
}
to_cle <- which(is.na(the_met[, 1]))
if (length(to_cle) > 0) {
the_met <- the_met[-to_cle, ]
} else {
the_met <- the_met[, 1]
}
num_met <- length(the_met)
cat("\n - Metier Data Source: ", svalue(met_da_su), " -\n", sep = "")
for (i in 1:num_met) {
cat("\n - Analyzing Metier ", the_met[i], " -\n", sep = "")
cat("\n - Loading DB data ", sep = "")
if (svalue(met_da_su) == "VMS-LB Match") {
# cat("from ", svalue(met_da_su), " ", sep = "")
sin_tra <- fn$sqldf("select * from p_depth join (select intrp.ROWID as i_id, * from intrp join (select vessel as I_NCEE, track as T_NUM, met_des from vms_lb where met_des = '`the_met[i]`') using (I_NCEE, T_NUM)) using (i_id)", dbname = vms_DB$db)
} else {
# cat("from ", svalue(met_da_su), " ", sep = "")
sin_tra <- fn$sqldf("select * from p_depth join (select intrp.ROWID as i_id, * from intrp join (select I_NCEE, T_NUM, met_des from nn_clas where met_des = '`the_met[i]`') using (I_NCEE, T_NUM)) using (i_id)", dbname = vms_DB$db)
}
cat(nrow(sin_tra), " points -\n", sep = "")
if (nrow(sin_tra) == 0) {
cat(" - Skipped, no data!")
next
}
sta_met_num <- which(sta_met[, "Metier"] == the_met[i])
sin_tra <- sin_tra[, -c(2, 7, 9, 10, 12, 13, 14)]
sin_tra <- cbind(sin_tra, 0, 0, 0, 0)
colnames(sin_tra)[(ncol(sin_tra) - 3):ncol(sin_tra)] <- c("F_SPE", "F_DEP", "F_DIS", "FISH")
cat("\n - Checking Speed... -\n", sep = "")
to_spe <- which((sin_tra[, "SPE"] * 0.539956803456) > sta_met[sta_met_num, "min_vel_kn"] & (sin_tra[, "SPE"] * 0.539956803456) < sta_met[sta_met_num, "max_vel_kn"])
if (length(to_spe) > 0) {
sin_tra[to_spe, "F_SPE"] <- 1
}
gc()
cat("\n - Depth... -\n", sep = "")
to_dep <- which(sin_tra[, "DEPTH"] < sta_met[sta_met_num, "min_depth_mt"] & sin_tra[, "DEPTH"] > sta_met[sta_met_num, "max_depth_mt"])
if (length(to_dep) > 0) {
sin_tra[to_dep, "F_DEP"] <- 1
}
gc()
cat("\n - Distance", sep = "")
tochk <- which(sin_tra[, "F_SPE"] == 1 & sin_tra[, "F_DEP"] == 1)
gc()
if (length(tochk) > 0) {
if (length(tochk) <= 10000) {
cat("...", sep = "")
dismat <- spDists(as.matrix(sin_tra[tochk, c("LON", "LAT")]), as.matrix(harbs@coords), longlat = TRUE)
tmp_rem <- which(dismat < sta_met[sta_met_num, "harb_dist_km"], arr.ind = TRUE)[, 1]
if (length(tmp_rem) > 0) {
tochk <- tochk[-tmp_rem]
}
rm(dismat)
gc()
if (length(tochk) > 0) {
sin_tra[tochk, "F_DIS"] <- 1
}
} else {
nTock <- ceiling(length(tochk) / 10000)
to_remo <- vector()
for (nto in 1:nTock) {
cat(".", sep = "")
r1 <- 10000 * (nto - 1) + 1
r2 <- min(length(tochk), r1 + 10000 - 1)
dismat <- spDists(as.matrix(sin_tra[tochk[r1:r2], c("LON", "LAT")]), as.matrix(harbs@coords), longlat = TRUE)
to_remo_par <- which(dismat < sta_met[sta_met_num, "harb_dist_km"], arr.ind = TRUE)[, 1]
if (length(to_remo_par) > 0) {
to_remo <- c(to_remo, to_remo_par + r1 - 1)
}
rm(dismat)
rm(to_remo_par)
gc()
}
if (length(to_remo) > 0) {
sin_tra[tochk[-to_remo], "F_DIS"] <- 1
} else {
sin_tra[tochk, "F_DIS"] <- 1
}
rm(tochk)
rm(to_remo)
gc()
}
}
fis_poi <- which(sin_tra[, "F_SPE"] == 1 & sin_tra[, "F_DEP"] == 1 & sin_tra[, "F_DIS"] == 1)
if (length(fis_poi) != 0) {
cat("\n - ", length(fis_poi), " fishing point founded -\n", sep = "")
sin_tra[fis_poi, "FISH"] <- 1
} else {
cat("\n - No fishing point founded -\n", sep = "")
}
rm(fis_poi)
gc()
result <- sin_tra[, c("i_id", "F_SPE", "F_DEP", "F_DIS", "FISH")]
rm(sin_tra)
gc()
cat("\n - DB update... -\n", sep = "")
if (svalue(met_da_su) == "VMS-LB Match") {
sqldf("insert into p_fish select * from `result`", dbname = vms_DB$db)
} else {
sqldf("insert into p_fish_nn select * from `result`", dbname = vms_DB$db)
}
rm(result)
gc()
}
}
cat("\n\n --- END Fishing Point Analysis ---\n\n", sep = "")
gconfirm("Fishing Point Analysis complete!",
title = "Confirm",
icon = "info",
parent = mark_fis_poi_win,
handler = function(h, ...) {
dispose(mark_fis_poi_win)
}
)
})
addSpring(g_input)
#######################
up_g <- gframe(text = "Filter Parameters", horizontal = TRUE)
add(big_g, up_g)
#######################
addSpring(up_g)
lay_win <<- glayout(spacing = 5, container = up_g)
lay_win[1, 1, anchor = 0] <- "Metier"
lay_win[1, 2, anchor = 0] <- "Min Vel Kn"
lay_win[1, 3, anchor = 0] <- "Max Vel Kn"
lay_win[1, 4, anchor = 0] <- "Min Depth Mt"
lay_win[1, 5, anchor = 0] <- "Max Depth Mt"
lay_win[1, 6, anchor = 0] <- "Harb Dist Km"
addSpring(up_g)
#######################
enabled(b_mark_fis_poi) <- FALSE
if (vms_DB$db != "") {
# svalue(sel_vms_f) <- strsplit(vms_DB, "/")[[1]][length(strsplit(vms_DB, "/")[[1]])]
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]])])
# nn_tab <- as.numeric(sqldf("SELECT count(*) FROM sqlite_master WHERE type='table' AND name='nn_clas'", dbname = vms_DB$db))
# if(nn_tab == 1)
# {
enabled(gri_g3f4) <- TRUE
# }
}
if (harb$path != "") {
svalue(cus_har_lab) <- paste("Harbour: ", ifelse(.Platform$OS.type == "windows", strsplit(harb$path, "\\\\")[[1]][length(strsplit(harb$path, "\\\\")[[1]])], strsplit(harb$path, "/")[[1]][length(strsplit(harb$path, "/")[[1]])]), sep = "")
}
if (harb$path != "" & vms_DB$db != "") {
enabled(b_mark_fis_poi) <- TRUE
enabled(gri_alg) <- TRUE
}
visible(mark_fis_poi_win) <- TRUE
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.