#' VMS DataBase Select GUI
#'
#' The \code{gui_vms_db_sel} function implement the graphical user interface for the
#' VMS DataBase Select routine.
#'
#' This function, with a VMS DataBase (see \code{\link{gui_vms_db_stat}}),
#' enables the user to perform queries on, and extract data from, the submitted VMS DataBase.
#'
#' @param vms_db_name The path of a VMS DataBase
#'
#' @return This function does not return a value.
#'
#' @usage gui_vms_db_sel(vms_db_name = "")
#'
#'
#' @seealso \code{\link{gui_vms_db_stat}}
gui_vms_db_sel <- function(vms_db_name = "") {
vms_DB <- vms_DB$new()
que_vms_DB <- que_vms_DB$new()
if (vms_db_name == "") {
vms_db_name <- gfile(
text = "Select VMS DataBase file",
type = "open",
filter = list("VMS DB file" = list(patterns = c("*.vms.sqlite")))
)
}
vms_DB$db <- vms_db_name
min_date <- as.numeric(sqldf("select min(DATE) from ping", dbname = vms_DB$db)[, 1])
max_date <- as.numeric(sqldf("select max(DATE) from ping", dbname = vms_DB$db)[, 1])
min_date_l <- paste("First: ", days(min_date), "/", months(min_date), "/", years(min_date), sep = "")
max_date_l <- paste("Last: ", days(max_date), "/", months(max_date), "/", years(max_date), sep = "")
sel_vms_win <- gwindow("VMS Select Tool", height = 600, visible = FALSE)
sel_big_g <- ggroup(container = sel_vms_win, horizontal = FALSE)
sel_vms_top <- ggroup(horizontal = TRUE, container = sel_big_g)
sel_vms_bot <- ggroup(horizontal = TRUE, container = sel_big_g, expand = TRUE)
### FROM
sel_tab_f <- gframe(text = "Table", container = sel_vms_top)
addSpring(sel_tab_f)
from_cb <- gdroplist(c("Tracks", "Pings"),
container = sel_tab_f,
handler = function(h, ...) {
enabled(sel_area_f) <- !enabled(sel_area_f)
enabled(sel_met_f) <- !enabled(sel_met_f)
enabled(sel_fish_f) <- !enabled(sel_fish_f)
}
)
addSpring(sel_tab_f)
### DATE
sel_date_f <- gframe(text = "Date", horizontal = FALSE, container = sel_vms_top)
addSpring(sel_date_f)
temp_bar <- gbutton(text = "View Date\nFrequencies", container = sel_date_f, handler = function(h, ..) {
temp_win <- gwindow("VMS Date Frequencies Tool", width = 500, visible = FALSE)
theplot <- ggraphics(container = temp_win, expand = TRUE)
utc <- sqldf("select DATE from ping", dbname = vms_DB$db)
utc <- as.numeric(utc[, 1])
nbars <- 20
min_utc <- floor(min(utc))
max_utc <- ceiling(max(utc))
bre_utc <- seq(min_utc, max_utc, length = nbars)
bar_utc <- as.numeric(table(findInterval(utc, bre_utc)))
col_utc <- plotrix::color.scale(1:length(bre_utc), extremes = c("olivedrab1", "forestgreen"))
bar_names <- chron(floor(bre_utc[-length(bre_utc)]))
visible(temp_win) <- TRUE
par(lwd = 0.01, las = 2, cex = 0.7, mar = c(5, 7, 5, 5))
barplot(bar_utc, horiz = TRUE, axes = T, col = col_utc, names.arg = bar_names, xlab = "Num. of Pings")
enabled(temp_bar) <- FALSE
addHandlerDestroy(temp_win, handler = function(h, ..) {
enabled(temp_bar) <- TRUE
})
})
fro_to_g <- ggroup(horizontal = FALSE, container = sel_date_f)
addSpring(fro_to_g)
min_date_vms <- glabel(min_date_l, container = fro_to_g)
sel_fro_f <- gframe(text = "From", container = fro_to_g)
fro_d <- gdroplist(levels(days(min_date)), container = sel_fro_f)
svalue(fro_d) <- days(min_date)
fro_m <- gdroplist(levels(months(min_date)), container = sel_fro_f)
svalue(fro_m) <- months(min_date)
fro_y <- gdroplist(levels(years(min_date)), container = sel_fro_f)
svalue(fro_y) <- years(min_date)
sel_to_f <- gframe(text = "To", container = fro_to_g)
to_d <- gdroplist(levels(days(max_date)), container = sel_to_f)
svalue(to_d) <- days(max_date)
to_m <- gdroplist(levels(months(max_date)), container = sel_to_f)
svalue(to_m) <- months(max_date)
to_y <- gdroplist(levels(years(max_date)), container = sel_to_f)
svalue(to_y) <- years(max_date)
max_date_vms <- glabel(max_date_l, container = fro_to_g)
addSpring(fro_to_g)
# use_date_g <- ggroup(container = fro_to_g, horizontal = TRUE)
# glabel("Specify Date?", container = use_date_g)
# use_date_r <- gradio(c("Yes", "No"), container = use_date_g, horizontal = TRUE)
addSpring(sel_date_f)
### AREA
sel_area_f <- gframe(text = "Area", horizontal = FALSE, container = sel_vms_top)
addSpring(sel_area_f)
sel_gsa_f <- gframe(text = "", horizontal = FALSE, container = sel_area_f)
# gsa
if (sqldf("select count(*) from p_area", dbname = vms_DB$db) == 0) {
g_are_0 <- ggroup(horizontal = TRUE, container = sel_gsa_f)
g_are_l <- glabel("No Area data\nRun Assign Area")
enabled(sel_area_f) <- FALSE
} else {
gsas <- sqldf("select distinct(AREA) from p_area order by area", dbname = vms_DB$db)[, 1]
n_gsa <- length(gsas)
gsas_li <- vector("list", n_gsa)
for (i in 1:n_gsa)
{
if (((i - 1) %% 4) == 0) {
new_gr <- paste("g_are_", i, sep = "")
assign(new_gr, ggroup(horizontal = TRUE, container = sel_gsa_f))
addSpring(get(new_gr))
}
gsas_li[[i]] <- gcheckbox(gsas[i], container = get(new_gr))
addSpring(get(new_gr))
}
}
# in_area <- gdroplist(c( "All", paste("GSA - ", 1:27, sep = "")), container = sel_area_f)
addSpring(sel_area_f)
use_area_g <- ggroup(container = sel_area_f, horizontal = TRUE)
glabel("Specify Area?", container = use_area_g)
use_area_r <- gradio(c("Yes", "No"),
container = use_area_g, horizontal = TRUE,
handler = function(h, ...) {
enabled(sel_gsa_f) <- !enabled(sel_gsa_f)
}
)
### METIER
sel_met_f <- gframe(text = "Metier", horizontal = FALSE, container = sel_vms_top)
addSpring(sel_met_f)
sel_met_g <- ggroup(horizontal = FALSE, container = sel_met_f)
# gsa
if (sqldf("select count(*) from vms_lb", dbname = vms_DB$db) == 0) {
g_met_0 <- ggroup(horizontal = TRUE, container = sel_met_g)
g_are_l <- glabel("No Metier data\nRun VMS-LB Match")
enabled(sel_met_f) <- FALSE
} else {
met_fou <- sqldf("select distinct(met_des) from vms_lb order by met_des", dbname = vms_DB$db)[, 1]
n_met <- length(met_fou)
mets_li <- vector("list", n_met)
for (i in 1:n_met)
{
if (((i - 1) %% 2) == 0) {
new_gr <- paste("g_met_", i, sep = "")
assign(new_gr, ggroup(horizontal = TRUE, container = sel_met_g))
addSpring(get(new_gr))
}
mets_li[[i]] <- gcheckbox(met_fou[i], container = get(new_gr))
addSpring(get(new_gr))
}
}
addSpring(sel_met_f)
use_met_g <- ggroup(container = sel_met_f, horizontal = TRUE)
glabel("Specify Metier?", container = use_met_g)
use_area_r <- gradio(c("Yes", "No"),
container = use_met_g, horizontal = TRUE,
handler = function(h, ...) {
enabled(sel_met_g) <- !enabled(sel_met_g)
}
)
### FISH
sel_fish_f <- gframe(text = "Fishing Point", horizontal = FALSE, container = sel_vms_top)
addSpring(sel_fish_f)
glabel("Fishing Only", container = sel_fish_f)
fishin_r <- gradio(c("Yes", "No"), container = sel_fish_f, horizontal = TRUE)
# addSpring(sel_fish_f)
##############
sel_go_g <- ggroup(horizontal = FALSE, expand = TRUE, container = sel_vms_top)
sel_go_b <- gbutton(text = "\n\n\nGO\n\n\n", container = sel_go_g, handler = function(h, ...) {
from <- switch(svalue(from_cb), "Tracks" = "intrp", "Pings" = "ping")
date_fro <- as.numeric(chron(dates. = dates(paste(which(levels(months(min_date)) == (svalue(fro_m))), svalue(fro_d), svalue(fro_y), sep = "/")), times. = times("00:00:00"), format = c(dates = "m/d/y", times = "h:m:s")))
date_to <- as.numeric(chron(dates. = dates(paste(which(levels(months(max_date)) == (svalue(to_m))), svalue(to_d), svalue(to_y), sep = "/")), times. = times("00:00:00"), format = c(dates = "m/d/y", times = "h:m:s")))
if (from == "ping") {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
sep = ""
)
}
if (from == "intrp") {
if (svalue(use_area_r) == "No") {
if (svalue(fishin_r) == "Yes") {
que_vms_DB$que <- paste("select * from ", from,
", p_fish where DATE > ", date_fro,
" and DATE < ", date_to,
" and FISH = 1 and intrp.rowid = i_id",
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
sep = ""
)
}
}
if (svalue(use_area_r) == "Yes") {
date_fro <- as.numeric(chron(dates. = dates(paste(which(levels(months(min_date)) == (svalue(fro_m))), svalue(fro_d), svalue(fro_y), sep = "/")), times. = times("00:00:00"), format = c(dates = "m/d/y", times = "h:m:s")))
date_to <- as.numeric(chron(dates. = dates(paste(which(levels(months(max_date)) == (svalue(to_m))), svalue(to_d), svalue(to_y), sep = "/")), times. = times("00:00:00"), format = c(dates = "m/d/y", times = "h:m:s")))
num_are <- length(gsas_li)
selec <- character(num_are)
for (j in 1:num_are)
{
if (svalue(gsas_li[[j]]) == TRUE) {
selec[j] <- gsas_li[[j]][]
}
}
num_met <- length(mets_li)
selem <- character(num_met)
for (l in 1:num_met)
{
if (svalue(mets_li[[l]]) == TRUE) {
selem[l] <- mets_li[[l]][]
}
}
num_sel <- length(which(selec != ""))
num_sem <- length(which(selem != ""))
############ SEL 0
if (num_sel == 0) {
if (num_sem == 0) {
if (svalue(fishin_r) == "Yes") {
from <- paste(from, ", p_fish", sep = "")
plu_fis <- " and FISH = 1 and intrp.rowid = i_id"
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_fis,
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
sep = ""
)
}
}
if (num_sem == 1) {
mete <- paste(" and met_des = '", mets_li[[which(selem != "")]][], "'", sep = "")
from <- paste(from, ", vms_lb", sep = "")
plu_met <- " and intrp.I_NCEE = vms_lb.vessel and intrp.T_NUM = vms_lb.track"
if (svalue(fishin_r) == "Yes") {
from <- paste(from, ", p_fish", sep = "")
plu_fis <- " and FISH = 1 and intrp.rowid = i_id"
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_fis,
plu_met,
mete,
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_met,
mete,
sep = ""
)
}
}
if (num_sem > 1) {
mete <- " and( "
for (k in 1:num_sem)
{
value <- which(selem != "")[k]
if (k == num_sem) {
mete <- paste(mete, "met_des = '",
mets_li[[value]][],
"') ",
sep = ""
)
} else {
mete <- paste(mete, "met_des = '",
mets_li[[value]][],
"' or ",
sep = ""
)
}
}
from <- paste(from, ", vms_lb", sep = "")
plu_met <- " and intrp.I_NCEE = vms_lb.vessel and intrp.T_NUM = vms_lb.track"
if (svalue(fishin_r) == "Yes") {
from <- paste(from, ", p_fish", sep = "")
plu_fis <- " and FISH = 1 and intrp.rowid = i_id"
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_fis,
plu_met,
mete,
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_met,
mete,
sep = ""
)
}
}
}
############ SEL 1
if (num_sel == 1) {
area <- paste(" and AREA = ", gsas_li[[which(selec != "")]][], sep = "")
from <- paste(from, ", p_area", sep = "")
plu_are <- " and intrp.T_NUM = p_area.T_NUM and I_NCEE = p_area.vess_id"
if (num_sem == 0) {
if (svalue(fishin_r) == "Yes") {
from <- paste(from, ", p_fish")
plu_fis <- " and FISH = 1 and intrp.rowid = i_id"
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_fis,
plu_are,
area,
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_are,
area,
sep = ""
)
}
}
if (num_sem == 1) {
mete <- paste(" and met_des = '", mets_li[[which(selem != "")]][], "'", sep = "")
from <- paste(from, ", vms_lb", sep = "")
plu_met <- " and intrp.I_NCEE = vms_lb.vessel and intrp.T_NUM = vms_lb.track"
if (svalue(fishin_r) == "Yes") {
from <- paste(from, ", p_fish", sep = "")
plu_fis <- " and FISH = 1 and intrp.rowid = i_id"
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_fis,
plu_met,
mete,
plu_fis,
plu_are,
area,
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_met,
mete,
plu_are,
area,
sep = ""
)
}
}
if (num_sem > 1) {
mete <- " and( "
for (k in 1:num_sem)
{
value <- which(selem != "")[k]
if (k == num_sem) {
mete <- paste(mete, "met_des = '",
mets_li[[value]][],
"') ",
sep = ""
)
} else {
mete <- paste(mete, "met_des = '",
mets_li[[value]][],
"' or ",
sep = ""
)
}
}
from <- paste(from, ", vms_lb", sep = "")
plu_met <- " and intrp.I_NCEE = vms_lb.vessel and intrp.T_NUM = vms_lb.track"
if (svalue(fishin_r) == "Yes") {
from <- paste(from, ", p_fish", sep = "")
plu_fis <- " and FISH = 1 and intrp.rowid = i_id"
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_fis,
plu_met,
mete,
plu_fis,
plu_are,
area,
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_met,
mete,
plu_are,
area,
sep = ""
)
}
}
}
############ SEL 2
if (num_sel > 1) {
area <- " and( "
for (k in 1:num_sel)
{
value <- which(selec != "")[k]
if (k == num_sel) {
area <- paste(area, "AREA = ",
gsas_li[[value]][],
") ",
sep = ""
)
} else {
area <- paste(area, "AREA = ",
gsas_li[[value]][],
" or ",
sep = ""
)
}
}
from <- paste(from, ", p_area", sep = "")
plu_are <- " and I_NCEE = p_area.vess_id and intrp.T_NUM = p_area.T_NUM"
if (num_sem == 0) {
if (svalue(fishin_r) == "Yes") {
from <- paste(from, ", p_fish")
plu_fis <- " and FISH = 1 and intrp.rowid = i_id"
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_fis,
plu_are,
area,
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_are,
area,
sep = ""
)
}
}
if (num_sem == 1) {
mete <- paste(" and met_des = '", mets_li[[which(selem != "")]][], "'", sep = "")
from <- paste(from, ", vms_lb", sep = "")
plu_met <- " and intrp.I_NCEE = vms_lb.vessel and intrp.T_NUM = vms_lb.track "
if (svalue(fishin_r) == "Yes") {
from <- paste(from, ", p_fish", sep = "")
plu_fis <- " and FISH = 1 and intrp.rowid = i_id"
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_fis,
plu_met,
mete,
plu_fis,
plu_are,
area,
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_met,
mete,
plu_are,
area,
sep = ""
)
}
}
if (num_sem > 1) {
mete <- " and( "
for (k in 1:num_sem)
{
value <- which(selem != "")[k]
if (k == num_sem) {
mete <- paste(mete, "met_des = '",
mets_li[[value]][],
"') ",
sep = ""
)
} else {
mete <- paste(mete, "met_des = '",
mets_li[[value]][],
"' or ",
sep = ""
)
}
}
from <- paste(from, ", vms_lb", sep = "")
plu_met <- " and intrp.I_NCEE = vms_lb.vessel and intrp.T_NUM = vms_lb.track "
if (svalue(fishin_r) == "Yes") {
from <- paste(from, ", p_fish", sep = "")
plu_fis <- " and FISH = 1 and intrp.rowid = i_id"
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_fis,
plu_met,
mete,
plu_fis,
plu_are,
area,
sep = ""
)
} else {
que_vms_DB$que <- paste("select * from ", from,
" where DATE > ", date_fro,
" and DATE < ", date_to,
plu_met,
mete,
plu_are,
area,
sep = ""
)
}
}
}
}
}
#############
# cat("\n", que_vms_DB$que, "\n", sep = "")
que_res_df <- sqldf(que_vms_DB$que, dbname = vms_DB$db)
que_res <- gtable(que_res_df, expand = T)
add(query_nb, que_res, label = "Query")
enabled(export_que) <- TRUE
enabled(save_que) <- TRUE
})
################
export_que <- gbutton(text = "Export Query\n to CSV", container = sel_go_g, handler = function(h, ...) {
write.table(sqldf(que_vms_DB$que, dbname = vms_DB$db),
file = paste(gfile(
text = "Save VMS query",
type = "save"
),
".csv",
sep = ""
),
sep = ";", dec = "."
)
})
enabled(export_que) <- FALSE
save_que <- gbutton(text = "Save Query\nto new DB", container = sel_go_g, handler = function(h, ...) {
vms_db_win <- gwindow("Create New VMS DataBase", visible = TRUE)
one <- ggroup(horizontal = FALSE, container = vms_db_win)
glabel("To proceed with the creation of a VMS Database,
first enter a name for the new DB and press enter...", container = one)
c_name <- ggroup(horizontal = TRUE, container = one)
addSpring(c_name)
dbname <- gedit(
initial.msg = "New VMS DB name...",
container = c_name, handler = function(h, ...) {
enabled(go) <- TRUE
}
)
addSpring(c_name)
gimage(system.file("ico/go-down-3.png", package = "vmsbase"), container = one)
glabel("Provide a destination for the VMS DB
clicking on the \'Create DB\' button.", container = one)
go <- gbutton("Create DB", container = one, handler = function(h, ...) {
que_vms_DB$dir <- gfile(
text = "Select VMS DB destination",
type = "selectdir",
filter = list("VMS DB data" = list(patterns = c("*.vms.sqlite")))
)
que_vms_DB$db <- paste(que_vms_DB$dir, "/", svalue(dbname), ".vms.sqlite", sep = "")
request <- sqldf(que_vms_DB$que, dbname = vms_DB$db)
dbConnect(SQLite(), dbname = que_vms_DB$db)
cat("\nCreating tables... ", sep = "")
sqldf("CREATE TABLE query AS SELECT * FROM `request`", dbname = que_vms_DB$db)
sqldf("CREATE TABLE ping(I_NCEE INT, LAT REAL, LON REAL, DATE REAL, SPE REAL, HEA INT)", dbname = que_vms_DB$db)
sqldf("CREATE TABLE warn(p_id INT, W_DUPL INT, W_HARB INT, W_LAND INT, W_COHE INT)", dbname = que_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 = que_vms_DB$db)
sqldf("CREATE TABLE intrp(I_NCEE INT, LAT REAL, LON REAL, DATE REAL, SPE REAL, HEA REAL, W_HARB INT, T_NUM INT, P_ID INT, P_INT INT, T_ID INT)", dbname = que_vms_DB$db)
sqldf("CREATE TABLE p_depth(i_id INT, vess_id INT, DEPTH REAL)", dbname = que_vms_DB$db)
sqldf("CREATE TABLE p_area(vess_id INT, t_num INT, AREA INT)", dbname = que_vms_DB$db)
sqldf("CREATE TABLE vms_lb(vessel INT, track INT, logbook INT, log_id INT, met_des CHAR)", dbname = que_vms_DB$db)
sqldf("CREATE TABLE p_fish(i_id INT, F_SPE INT, F_DEP INT, F_DIS INT, FISH INT)", dbname = que_vms_DB$db)
if (svalue(from_cb) == "Pings") {
sqldf("INSERT INTO ping SELECT * FROM `request`", dbname = que_vms_DB$db)
}
if (svalue(from_cb) == "Tracks") {
cat("\nLoading interpolated... ", sep = "")
ntr_dat <- request[, 1:11]
sqldf("INSERT INTO intrp SELECT * FROM `ntr_dat`", dbname = que_vms_DB$db)
cat("\nLoading tracks... ", sep = "")
tracks <- request[!is.na(request[, "T_ID"]), "T_ID"]
tra_dat <- data.frame()
for (i in 1:length(tracks))
{
# cat(".", sep = "")
tra_dat <- rbind(
tra_dat,
fn$sqldf("select * from track where ROWID = `tracks[i]`",
dbname = vms_DB$db
)
)
}
sqldf("INSERT INTO track SELECT * FROM `tra_dat`", dbname = que_vms_DB$db)
cat(" Complete!", sep = "")
cat("\nLoading pings... ", sep = "")
pings <- request[!is.na(request[, "P_ID"]), "P_ID"]
pin_dat <- data.frame()
war_dat <- data.frame()
for (j in 1:length(pings))
{
# cat(".", sep = "")
pin_dat <- rbind(
pin_dat,
fn$sqldf("select * from ping where ROWID = `pings[j]`",
dbname = vms_DB$db
)
)
war_dat <- rbind(
war_dat,
fn$sqldf("select * from warn where ROWID = `pings[j]`",
dbname = vms_DB$db
)
)
}
cat(" Complete!", sep = "")
sqldf("INSERT INTO ping SELECT * FROM `pin_dat`", dbname = que_vms_DB$db)
sqldf("INSERT INTO warn SELECT * FROM `war_dat`", dbname = que_vms_DB$db)
cat("\nLoading depth, area, match... ", sep = "")
vssl <- unique(request[, "I_NCEE"])
for (l in 1:length(vssl))
{
cat(".", sep = "")
are_dat <- fn$sqldf("select * from p_area where vess_id = `vssl[l]`",
dbname = vms_DB$db
)
if (nrow(are_dat) != 0) {
sqldf("INSERT INTO p_area SELECT * FROM `are_dat`", dbname = que_vms_DB$db)
}
cou_dat <- fn$sqldf("select * from vms_lb where vessel = `vssl[l]`",
dbname = vms_DB$db
)
if (nrow(cou_dat) != 0) {
sqldf("INSERT INTO vms_lb SELECT * FROM `cou_dat`", dbname = que_vms_DB$db)
}
dep_dat <- fn$sqldf("select * from p_depth where vess_id = `vssl[l]`",
dbname = vms_DB$db
)
if (nrow(dep_dat) != 0) {
sqldf("INSERT INTO p_depth SELECT * FROM `dep_dat`", dbname = que_vms_DB$db)
}
}
cat(" Complete!", sep = "")
cat("\nLoading fishing points... ", sep = "")
fisi <- request[which(!is.na(request[, "i_id"])), "i_id"]
for (m in 1:length(fisi))
{
cat(".", sep = "")
fis_dat <- fn$sqldf("select * from p_fish where i_id = `fisi[m]`", dbname = vms_DB$db)
if (nrow(fis_dat) != 0) {
sqldf("INSERT INTO p_fish SELECT * FROM `fis_dat`", dbname = que_vms_DB$db)
}
}
cat(" Complete!", sep = "")
cat("\n\n --- VMS DataBase Deploy Complete ---\n\n", sep = "")
}
gconfirm("VMS DataBase deploy complete!",
title = "Confirm",
icon = "info",
parent = vms_db_win,
handler = function(h, ...) {
dispose(vms_db_win)
}
)
})
enabled(go) <- FALSE
})
enabled(save_que) <- FALSE
query_nb <- gnotebook(tab.pos = 3, closebuttons = TRUE, container = sel_vms_bot, expand = T)
visible(sel_vms_win) <- TRUE
}
# if(num_sel == 1)
# {
#
# area <- paste("and AREA = ",gsas_li[[which(selec != "")]][], sep = "")
# from <- paste(from, ", p_area", sep = "")
# plu_are <- " and intrp.T_NUM = p_area.T_NUM "
# if(svalue(fishin_r) == "Yes")
# {
# from <- paste(from, ", p_fish")
# plu_fis <- " and I_NCEE = vess_id and FISH = 1 and intrp.rowid = i_id"
# que_vms_DB$que <- paste("select * from ", from,
# " where DATE > ", date_fro,
# " and DATE < ", date_to,
# plu_fis,
# plu_are,
# area,
# sep = "")
# }else{
# que_vms_DB$que <- paste("select * from ", from,
# " where DATE > ", date_fro,
# " and DATE < ", date_to,
# plu_are,
# area,
# sep = "")
# }
#
#
#
#
#
# }
#
#
# if(num_sel > 1)
# {
# area = " and( "
# for(k in 1:num_sel)
# {
# value <- which(selec != "")[k]
# if(k == num_sel){
# area <- paste(area, "AREA = ",
# gsas_li[[value]][],
# ") ", sep = "")
# }else{
# area <- paste(area, "AREA = ",
# gsas_li[[value]][],
# " or ", sep = "")
# }
# }
#
# if(svalue(fishin_r) == "Yes")
# {
# que_vms_DB$que <- paste("select * from ", from,
# ", p_area, p_fish where I_NCEE = vess_id and intrp.rowid = i_id and FISH = 1 and ",
# from, ".T_NUM = p_area.T_NUM ",
# area,
# " and DATE > ", date_fro,
# " and DATE < ", date_to,
# sep = "")
# }else{
#
# que_vms_DB$que <- paste("select * from ", from,
# ", p_area where I_NCEE = vess_id and ",
# from, ".T_NUM = p_area.T_NUM ",
# area,
# " and DATE > ", date_fro,
# " and DATE < ", date_to,
# sep = "")
# }
# }
#
# }
# }
#
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.