Nothing
#' VMS DB View Interpolated Data GUI
#'
#' The \code{gui_vms_view_intrp} function implements the graphical user interface for the
#' VMS DB routine to view interpolated data.
#'
#' This function, with a VMS database,
#' plots vessel and track data.
#'
#' @param vms_db_name The path of a VMS DataBase
#' @param bathy_file_name The path of a Bathymetry file
#'
#' @return This function does not return a value.
#'
#' @usage gui_vms_view_intrp(vms_db_name = "", bathy_file_name = "")
#'
#'
#' @seealso \code{\link{gui_vms_view_ping}} \code{\link{gui_vms_view_track}} \code{\link{gui_vms_save_bat}}
gui_vms_view_intrp <- function(vms_db_name = "", bathy_file_name = "") {
harb <- harbCoo$new()
vms_DB <- vms_DB$new()
vms_DB$db <- vms_db_name
bathy <- bathymetry$new()
bathy$path <- bathy_file_name
vnum <- 0
trackn <- 0
intrp_view_win <- gwindow("Interpolated VMS Viewer", visible = FALSE)
big_g <- ggroup(horizontal = T, container = intrp_view_win)
left_g <- ggroup(horizontal = F, container = big_g)
chk_g3 <- ggroup(horizontal = TRUE, container = left_g)
expo_gr <- ggroup(horizontal = TRUE, container = left_g)
#################
addSpring(chk_g3)
vms_db_f <- gframe(text = "VMS DB file", horizontal = TRUE, container = chk_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")))
)
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]])])
incee <- sqldf("select distinct I_NCEE from intrp order by I_NCEE", dbname = vms_DB$db)
selves[] <- incee
turn_wdgt_on(c(selves, vestra))
}
)
gimage(system.file("ico/application-exit-5.png", package = "vmsbase"),
container = vms_db_f,
handler = function(h, ...) {
vms_DB$db <- ""
turn_wdgt_off(c(selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, expo_gr))
# enabled(selves) <- FALSE
# enabled(vestra) <- FALSE
svalue(sel_vms_f) <- "Select VMS DB file"
}
)
addSpring(chk_g3)
#################
addSpring(expo_gr)
save_ves_jpeg <- gbutton(text = "save jpeg", container = expo_gr, handler = function(h, ...) {
enabled(intrp_view_win) <- FALSE
# turn_wdgt_off(c(left_g1, selves, vestra, cus_dep_g, vms_db_f))
if (vnum != 0) {
enabled(save_ves_jpeg) <- FALSE
xle <- par()$pin[1]
yle <- par()$pin[2]
turn_wdgt_off(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
jpeg(
filename = gfile(
text = "Jpeg file path and name",
initialfilename = "*.jpeg",
type = "save"
),
width = round(1000 * xle), height = round(1000 * yle),
quality = 100, bg = "aliceblue", pointsize = 80
)
par(lwd = 10)
if (trackn == 0) {
vessel <- fn$sqldf("select * from intrp where I_NCEE = `vnum` order by DATE", dbname = vms_DB$db)
if (nrow(vessel) != 0) {
xrange <- c(svalue(mi_lo), svalue(ma_lo))
yrange <- c(svalue(mi_la), svalue(ma_la))
trackview(vessel, bathy, xrange, yrange)
}
} else {
fishi <- sqldf("select count(*) from p_fish", dbname = vms_DB$db)
if (fishi == 0) {
track <- fn$sqldf("select * from intrp where I_NCEE = `vnum` and T_NUM = `trackn` order by DATE", dbname = vms_DB$db)
} else {
track <- fn$sqldf("select * from intrp, p_fish where I_NCEE = `vnum` and T_NUM = `trackn` and intrp.rowid = i_id order by DATE", dbname = vms_DB$db)
if (nrow(track) == 0) {
track <- fn$sqldf("select * from intrp where I_NCEE = `vnum` and T_NUM = `trackn` order by DATE", dbname = vms_DB$db)
fishi <- 0
}
}
xrange <- c(svalue(mi_lo), svalue(ma_lo))
yrange <- c(svalue(mi_la), svalue(ma_la))
if (nrow(track) > 3) {
intrpview2(track, trackn, bathy, fishi = ifelse((svalue(sho_fis) == "Yes" & fishi != 0), TRUE, FALSE), xrange, yrange)
} else {
pingview(vessel = track, bathy, xrange, yrange)
cat("\nNot enough data for track ", trackn, ", showing points only", sep = "")
}
}
dev.off()
enabled(save_ves_jpeg) <- TRUE
turn_wdgt_on(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
}
enabled(intrp_view_win) <- TRUE
})
# enabled(save_ves_jpeg) <- FALSE
#################
addSpring(expo_gr)
export_csv <- gbutton(text = "export csv", container = expo_gr, handler = function(h, ...) {
turn_wdgt_off(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
if (vnum != 0) {
if (trackn == 0) {
vessel <- fn$sqldf("select * from intrp where I_NCEE = `vnum` order by DATE", dbname = vms_DB$db)
if (nrow(vessel) != 0) {
csv_fil_na <- gfile(
text = "Saving vessel route as CSV file", type = "save", initialfilename = "*.csv",
filter = list(
"All files" = list(patterns = c("*")), "CSV files" =
list(patterns = "*.csv")
)
)
if (length(unlist(strsplit(csv_fil_na, "[.]"))) == 1) {
csv_fil_na <- paste(csv_fil_na, ".csv", sep = "")
}
write.table(vessel,
file = csv_fil_na,
append = FALSE,
sep = ";",
dec = ".",
row.names = FALSE,
col.names = TRUE
)
}
} else {
fishi <- sqldf("select count(*) from p_fish", dbname = vms_DB$db)
if (fishi == 0) {
track <- fn$sqldf("select * from intrp where I_NCEE = `vnum` and T_NUM = `trackn` order by DATE", dbname = vms_DB$db)
csv_fil_na <- gfile(
text = "Saving single vessel track as CSV file", type = "save", initialfilename = "*.csv",
filter = list(
"All files" = list(patterns = c("*")), "CSV files" =
list(patterns = "*.csv")
)
)
if (length(unlist(strsplit(csv_fil_na, "[.]"))) == 1) {
csv_fil_na <- paste(csv_fil_na, ".csv", sep = "")
}
write.table(track,
file = csv_fil_na,
append = FALSE,
sep = ";",
dec = ".",
row.names = FALSE,
col.names = TRUE
)
} else {
track <- fn$sqldf("select * from intrp, p_fish where I_NCEE = `vnum` and T_NUM = `trackn` and intrp.rowid = i_id order by DATE", dbname = vms_DB$db)
if (nrow(track) == 0) {
track <- fn$sqldf("select * from intrp where I_NCEE = `vnum` and T_NUM = `trackn` order by DATE", dbname = vms_DB$db)
}
csv_fil_na <- gfile(
text = "Saving single vessel track as CSV file", type = "save", initialfilename = "*.csv",
filter = list(
"All files" = list(patterns = c("*")), "CSV files" =
list(patterns = "*.csv")
)
)
if (length(unlist(strsplit(csv_fil_na, "[.]"))) == 1) {
csv_fil_na <- paste(csv_fil_na, ".csv", sep = "")
}
write.table(track,
file = csv_fil_na,
append = FALSE,
sep = ";",
dec = ".",
row.names = FALSE,
col.names = TRUE
)
}
}
turn_wdgt_on(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
}
})
addSpring(expo_gr)
enabled(expo_gr) <- FALSE
bbox_exp <- gexpandgroup(text = "Custom B-Box", container = left_g, horizontal = TRUE)
addSpring(bbox_exp)
bbox_lay <- glayout(container = bbox_exp)
bbox_lay[1, 2] <- ggroup(horizontal = FALSE)
glabel("Max Lat", container = bbox_lay[1, 2])
ma_la <- gspinbutton(from = -90, to = 90, by = 0.5, value = 0, container = bbox_lay[1, 2])
bbox_lay[2, 1] <- ggroup(horizontal = FALSE)
glabel("Min Lon", container = bbox_lay[2, 1])
mi_lo <- gspinbutton(from = -180, to = 180, by = 0.5, value = 0, container = bbox_lay[2, 1])
bbox_lay[2, 3] <- ggroup(horizontal = FALSE)
glabel("Max Lon", container = bbox_lay[2, 3])
ma_lo <- gspinbutton(from = -180, to = 180, by = 0.5, value = 0, container = bbox_lay[2, 3])
bbox_lay[3, 2] <- ggroup(horizontal = FALSE)
glabel("Min Lat", container = bbox_lay[3, 2])
mi_la <- gspinbutton(from = -90, to = 90, by = 0.5, value = 0, container = bbox_lay[3, 2])
re_plot <- gbutton(text = "Custom Plot", container = bbox_exp, handler = function(h, ...) {
turn_wdgt_off(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
vnum <- svalue(selves)
if (trackn == 0) {
vessel <- fn$sqldf("select * from intrp where I_NCEE = `vnum` order by DATE", dbname = vms_DB$db)
if (nrow(vessel) != 0) {
xrange <- c(svalue(mi_lo), svalue(ma_lo))
yrange <- c(svalue(mi_la), svalue(ma_la))
if (nrow(vessel) > 1) {
trackview(vessel, bathy, xrange, yrange)
} else {
pingview(vessel, bathy, xrange, yrange)
}
}
} else {
fishi <- sqldf("select count(*) from p_fish", dbname = vms_DB$db)
if (fishi == 0) {
track <- fn$sqldf("select * from intrp where I_NCEE = `vnum` and T_NUM = `trackn` order by DATE", dbname = vms_DB$db)
} else {
track <- fn$sqldf("select * from intrp, p_fish where I_NCEE = `vnum` and T_NUM = `trackn` and intrp.rowid = i_id order by DATE", dbname = vms_DB$db)
if (nrow(track) == 0) {
track <- fn$sqldf("select * from intrp where I_NCEE = `vnum` and T_NUM = `trackn` order by DATE", dbname = vms_DB$db)
fishi <- 0
}
}
xrange <- c(svalue(mi_lo), svalue(ma_lo))
yrange <- c(svalue(mi_la), svalue(ma_la))
if (nrow(track) > 3) {
intrpview2(track, trackn, bathy, fishi = ifelse((svalue(sho_fis) == "Yes" & fishi != 0), TRUE, FALSE), xrange, yrange)
} else {
pingview(vessel = track, bathy, xrange, yrange)
cat("\nNot enough data for track ", trackn, ", showing points only", sep = "")
}
}
turn_wdgt_on(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
})
enabled(bbox_exp) <- FALSE
#################
left_g1 <- gframe(horizontal = T, container = left_g)
glabel("show Fishing Points", container = left_g1)
sho_fis <- gradio(c("Yes", "No"), horizontal = TRUE, container = left_g1)
left_g2 <- gframe(horizontal = T, container = left_g, expand = T)
selves <- gtable(data.frame("Vessel" = numeric(0)), chosencol = 1, container = left_g2, expand = T, handler = function(h, ...) {
turn_wdgt_off(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
trackn <<- 0
vnum <<- svalue(selves)
vessel <- fn$sqldf("select * from intrp where I_NCEE = `vnum` order by DATE", dbname = vms_DB$db)
vestra[] <- unique(vessel["T_NUM"])
if (nrow(vessel) != 0) {
span <- 0.25
xrange <- extendrange(x = vessel["LON"], f = span)
yrange <- extendrange(x = vessel["LAT"], f = span)
svalue(ma_la) <- yrange[2]
svalue(mi_lo) <- xrange[1]
svalue(ma_lo) <- xrange[2]
svalue(mi_la) <- yrange[1]
if (nrow(vessel) > 1) {
trackview(vessel, bathy, xrange, yrange)
} else {
pingview(vessel, bathy, xrange, yrange)
}
}
turn_wdgt_on(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
})
enabled(selves) <- FALSE
vestra <- gtable(data.frame("Track" = numeric(0)), chosencol = 1, container = left_g2, expand = T, handler = function(h, ...) {
turn_wdgt_off(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
trackn <<- svalue(vestra)
fishi <- sqldf("select count(*) from p_fish", dbname = vms_DB$db)
if (fishi == 0) {
track <- fn$sqldf("select * from intrp where I_NCEE = `vnum` and T_NUM = `trackn` order by DATE", dbname = vms_DB$db)
} else {
track <- fn$sqldf("select * from intrp, p_fish where I_NCEE = `vnum` and T_NUM = `trackn` and intrp.rowid = i_id order by DATE", dbname = vms_DB$db)
if (nrow(track) == 0) {
track <- fn$sqldf("select * from intrp where I_NCEE = `vnum` and T_NUM = `trackn` order by DATE", dbname = vms_DB$db)
fishi <- 0
}
}
span <- 0.25
xrange <- extendrange(x = track["LON"], f = span)
yrange <- extendrange(x = track["LAT"], f = span)
svalue(ma_la) <- yrange[2]
svalue(mi_lo) <- xrange[1]
svalue(ma_lo) <- xrange[2]
svalue(mi_la) <- yrange[1]
if (nrow(track) > 3) {
intrpview2(track, trackn, bathy, fishi = ifelse((svalue(sho_fis) == "Yes" & fishi != 0), TRUE, FALSE), xrange, yrange)
} else {
pingview(vessel = track, bathy, xrange, yrange)
cat("\nNot enough data for track ", trackn, ", showing points only", sep = "")
}
turn_wdgt_on(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, bbox_exp, expo_gr))
})
enabled(vestra) <- FALSE
###################
cus_dep_g <- gframe(text = "Bathymetry File", horizontal = TRUE, container = left_g)
addSpring(cus_dep_g)
cus_dep_lab <- glabel("Select Bathymetry File", container = cus_dep_g)
addSpring(cus_dep_g)
gimage(system.file("ico/folder-download.png", package = "vmsbase"),
container = cus_dep_g,
handler = function(h, ...) {
bathy$path <- gfile(
text = "Select Bathymetry File",
type = "open",
filter = list("bathy data" = list(patterns = c("*sqlitebathy.rData")))
)
svalue(cus_dep_lab) <- paste("File: ", strsplit(bathy$path, "/")[[1]][length(strsplit(bathy$path, "/")[[1]])], sep = "")
bathy$data <- readRDS(bathy$path)
}
)
gimage(system.file("ico/application-exit-5.png", package = "vmsbase"),
container = cus_dep_g,
handler = function(h, ...) {
bathy$path <- ""
svalue(cus_dep_lab) <- "Select Bathymetry File"
}
)
###################
right_g <- gframe(horizontal = F, container = big_g, expand = T)
theplot <- ggraphics(container = right_g, expand = T)
visible(intrp_view_win) <- TRUE
maps::map("world", col = "black", bg = "lightsteelblue1", mar = c(6, 6, 0, 0), fill = TRUE, interior = FALSE)
maps::map.axes()
title(main = "Interpolation Viewer", line = 0.3)
title(xlab = "Lon", ylab = "Lat", line = 2)
if (vms_DB$db != "") {
enabled(intrp_view_win) <- FALSE
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]])])
incee <- sqldf("select distinct I_NCEE from intrp order by I_NCEE", dbname = vms_DB$db)
selves[] <- incee
enabled(intrp_view_win) <- TRUE
turn_wdgt_on(c(left_g1, selves, vestra, save_ves_jpeg, cus_dep_g, vms_db_f, expo_gr))
}
if (bathy$path != "") {
svalue(cus_dep_lab) <- paste("File: ", ifelse(.Platform$OS.type == "windows", strsplit(bathy$path, "\\\\")[[1]][length(strsplit(bathy$path, "\\\\")[[1]])], strsplit(bathy$path, "/")[[1]][length(strsplit(bathy$path, "/")[[1]])]), sep = "")
bathy$data <- readRDS(bathy$path)
}
}
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.