if (!requireNamespace("sp", quietly = TRUE)) {
stop("Package 'sp' needed for this function to work. Please install it.",
call. = FALSE)
}
l.spline <- function(dat,x=NULL) {
if (is.null(x)) {x<-dat$time}
f.lon<-splinefun(dat$time,dat$lon)
f.lat<-splinefun(dat$time,dat$lat)
return(data.frame(
"time"=x,
"lon"=f.lon(x),
"lat"=f.lat(x)
))
}
l.partial<-function(dat,x=NULL) {
if (is.null(x)) {x<-dat$time}
# A linear model for each interval separately for longitude and latitude
l.lons<-NULL
l.lats<-NULL
for (i in 1:(nrow(dat)-1)) {
l.lons[[i]]<-lm(lon~time,data=dat[i:(i+1),])
l.lats[[i]]<-lm(lat~time,data=dat[i:(i+1),])
}
# Find which date corresponds to which data interval
ids<-findInterval(x,dat$time,all.inside=TRUE)
# Prepare the arrays for output
lons<-rep(0,length(x))
lats<-rep(0,length(x))
# For each linear model, predict new lon,lat with the set of data points corresponding to the data interval
for (i in 1:(nrow(dat)-1)) {
x2<-data.frame("time"=x[ids==i])
lons[ids==i]<-predict(l.lons[[i]],x2)
lats[ids==i]<-predict(l.lats[[i]],x2)
}
return(data.frame(
"time"=x,
"lon"=lons,
"lat"=lats
))
}
read.TowLog <- function(filename) {
dat<-read.csv(filename,header=TRUE)
d<-data.frame(
"time" = strptime(paste(as.character(dat[["Date.UTC"]]),as.character(dat[["Time.UTC"]])),"%m/%d/%Y %H:%M",tz="UTC"),
"lon" = as.numeric(sp::char2dms(as.character(dat[["Lon"]]),chd="o")),
"lat" = as.numeric(sp::char2dms(as.character(dat[["Lat"]]),chd="o")),
"dist" = dat[["Distance"]]
)
return(d)
}
read.TowAIS <- function(filename) {
dat<-read.csv(filename,header=TRUE)
d<-data.frame(
"time" = strptime(as.character(dat[["Timestamp..UTC."]]),"%m/%d/%Y %H:%M",tz="UTC"),
"lon" = dat[["Longitude"]],
"lat" = dat[["Latitude"]]
)
return(d)
}
read.CTD <- function(filename,time.offset) {
dat<-read.csv(filename,header=FALSE,comment.char="#",as.is=TRUE)
d<-data.frame(
"time" = strptime(as.character(dat$V2),"%d.%m.%y %H:%M:%S",tz="UTC")+3600*time.offset,
"temp" = as.numeric(gsub(',','.',dat$V3)),
"pres" = as.numeric(gsub(',','.',dat$V4)),
"salin" = as.numeric(gsub(',','.',dat$V5))
)
return(d)
}
# https://www.programiz.com/r-programming/S4-class
towClass <- setClass("towClass", slots=list(tow.log="character",
tow.ais="character",
tow.ctd="character",
tow.pci="character",
tow.id="numeric",
silk.start="numeric",
silk.end="numeric",
time.offset="numeric",
data.log="data.frame",
data.ais="data.frame",
data.ctd="data.frame",
data.pci="data.frame"))
setMethod("initialize",
"towClass",
function(.Object, tow.log=NULL, tow.ais=NULL, tow.ctd=NULL, tow.pci=NULL, tow.id=NULL, silk.start=NULL, silk.end=NULL, time.offset=NULL) {
.Object@tow.id <- tow.id
.Object@time.offset <- time.offset
.Object@silk.start <- silk.start
.Object@silk.end <- silk.end
if (length(tow.log)) {
.Object@tow.log <- tow.log
.Object@data.log <- read.TowLog(.Object@tow.log)
} else {
stop("TowLog data file should be provided!")
return(NULL)
}
if (length(tow.ais)) {
.Object@tow.ais <- tow.ais
.Object@data.ais <- read.TowAIS(.Object@tow.ais)
}
if (length(tow.ctd)) {
.Object@tow.ctd <- tow.ctd
.Object@data.ctd <- read.CTD(.Object@tow.ctd,.Object@time.offset)
}
return(.Object)
})
setGeneric(name="lonlat", def=function(object,...){standardGeneric("lonlat")})
setMethod("lonlat",
"towClass",
function(object,x=NULL) {
if (length(object@tow.log) && !length(object@tow.ais)) {
return(l.partial(object@data.log,x))
} else if (length(object@tow.ais)) {
return(l.spline(object@data.ais,x))
}
return(NULL)
})
setMethod("show",
"towClass",
function(object) {
cat("Tow ID...........:", object@tow.id, "\n")
cat("Tow Log..........:", object@tow.log, "\n")
cat("Tow AIS..........:", object@tow.ais, "\n")
cat("Tow CTD..........:", object@tow.ctd, "\n")
cat("Tow PCI..........:", object@tow.pci, "\n")
cat("Silk (start, end):", sprintf("%g, %g",object@silk.start,object@silk.end), "\n")
cat("Time offset......:", object@time.offset, "\n")
})
setMethod("plot", signature(x="towClass", y="missing"),
function(x, y, dates=NULL, add=FALSE, col="black", ...) {
y <- if (is.null(dates)) {
if (length(x@tow.ais)) {
x@data.ais$time
} else {
seq(x@data.log$time[1],x@data.log$time[length(x@data.log$time)],"mins")
}
} else {
dates
}
l.dl<-lonlat(x,y)
fun <- if (!add) {plot} else {lines}
fun(l.dl$lon,l.dl$lat,type="l",lwd=1.5,col=col,xlab="Longitude",ylab="Latitude",...)
if (length(x@tow.ais))
points(x@data.ais$lon,x@data.ais$lat,pch=1,cex=1.5,col=rgb(0,0,0,0.5))
points(x@data.log$lon,x@data.log$lat,pch=16,cex=1,col="red")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.