1

Morning, Afternoon or Evening

I have the following data (ships transect ):

# R-4.0.2
set.seed(123)
#
lats  <- c(seq(50, 49, by = -0.05), seq(49, 50, by = 0.05), seq(50, 49, by = -0.05))
lngs  <- c(seq(-6, -5, by = 0.05),  rep(-5, 21)           , seq(-5, -5.5, by = -0.025))
times <- c(seq(from=as.POSIXct("2020-10-10 10:00", tz="GMT"),
               to=as.POSIXct("2020-10-10 10:20", tz="GMT"), by="min"),
           seq(from=as.POSIXct("2020-10-10 10:20", tz="GMT"),
               to=as.POSIXct("2020-10-11 07:00", tz="GMT"), by="hour"),
           seq(from=as.POSIXct("2020-10-11 07:00", tz="GMT"),
               to=as.POSIXct("2020-10-11 07:20", tz="GMT"), by="min"))
value <- sample(1:100, 63, replace=TRUE) 
#
df <- data.frame(lats, lngs, times, value)

Using this data, I am able to produce a meta-explorer (Fig. 1), with much help from user @Wimpel in my earlier question on the same subject

Fig. 2 Metadata explorer, code to produce found at bottom of question Figure 1. Metadata explorer, code to produce found at bottom of question

This is great, but, where the transect crosses itself the result is a high number of data points and odd average time. Demonstrated in Fig. 1s popup.

What I would like to achieve is for the pop up to display the number of times the ship has been in the area, the average time for that passage (not time taken) and the number of data points for that passage.

I think the answer is hidden within the following function, but my lack of understand impinges me.

for(i in 1:length(polys)) {
  numofimg[i] = length(df$value[which(!is.na(over(x=df,y=polys[i])))])
}

I realise this is asking quite a bit, so even pointers are welcome.

Code to create map

library( sf )
library( sp )

coordinates(df) <- c("lngs","lats")
proj4string(df) <- CRS("+proj=longlat")
grd <- GridTopology(cellcentre.offset=bbox(df)[,1],
                    cellsize=c(0.05,0.05), cells.dim=c(200,130))

polys <- as.SpatialPolygons.GridTopology(grd) 
proj4string(polys) <- CRS("+proj=longlat")

meantime <- rep(0, length(polys))
numofimg <- rep(0, length(polys))


for(i in 1:length(polys)) {
  meantime[i] = mean(df$times[which(!is.na(over(x=df,y=polys[i])))])
}
for(i in 1:length(polys)) {
  numofimg[i] = length(df$value[which(!is.na(over(x=df,y=polys[i])))])
}

times <- as.list(meantime)

convertback <- function(x){
  as.POSIXct(x, origin="1970-01-01")
}

times <- lapply(times, convertback)

times <- do.call("c", times)

polys$meantime <- times
polys$numofimg <- numofimg

library(leaflet)
library(htmlwidgets)
library(htmltools)
library(colourvalues)
library(leafgl)

pal <- colorNumeric(
  palette = "viridis",
  domain = polys$numofimg)


clipped <- polys[polys@data$numofimg > 0, ]

leaflet() %>%
  addProviderTiles('Esri.WorldGrayCanvas') %>%
  leafgl::addGlPolygons(data = clipped,
              weight = 1,
              fillColor = ~pal(numofimg),
              fillOpacity = 0.8,popup = ~paste("<h3>Cell Info:</h3>",
                                               "<b>Mean Cell time: </b>",
                                               as.character(meantime),
                                               "<br>",
                                               "<b>Number of datapoints: </b>",
                                               value)
  ) %>% 
  addPolylines(group = "Ships Path",
               data = df,
               lng = ~lngs,
               lat = ~lats,
               color = "black",
               weight = 1)
Jim
  • 558
  • 4
  • 13

0 Answers0