For loop cycling through all individuals in 1 group but not the other group-CodePudding

The goal of the for loop is to calculate distance between each deer and each cow at every simultaneous time stamp and put it into a data frame. The loop is working for deer 1 and all cattle (deer1- cow1,cow2,cow3...) but it does not loop to deer 2 (deer2- cow1,cow2,cow3...). It stops and produces Error in linfol[[j]] : subscript out of bounds In addition: Warning messages: 1: In min(table(id)) : no non-missing arguments to min; returning Inf 2: In min(table(burst)) : no non-missing arguments to min; returning Inf Any ideas on how to fix this? I appreciate all of your help.

library(lubridate)
require(rgdal)
library(adehabitatHR)
library(rgeos)
library(wildlifeDI)
library(sf)
library(tidyr)
library(purrr)
library(dplyr)
library(ggplot2)
library(rowr)
library(qpcR)
library(tidyverse)

del6 <- structure(list(Id = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 5L, 5L, 5L, 5L, 
5L, 5L, 5L, 5L, 5L, 5L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L
), .Label = c("A82117", "A82118", "A82119", "A82120", "A628", 
"A629", "A630", "A631"), class = "factor"), Species = structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("deer", "cow"), class = "factor"), 
    DateTime = structure(c(1559365200, 1559367000, 1559368800, 
    1559370600, 1559372400, 1559374200, 1559376000, 1559377800, 
    1559379600, 1559381400, 1559365200, 1559367000, 1559368800, 
    1559370600, 1559372400, 1559374200, 1559376000, 1559377800, 
    1559379600, 1559381400, 1559367000, 1559368800, 1559370600, 
    1559372400, 1559374200, 1559376000, 1559377800, 1559379600, 
    1559381400, 1559383200, 1559365200, 1559367000, 1559368800, 
    1559370600, 1559372400, 1559374200, 1559376000, 1559377800, 
    1559379600, 1559381400), class = c("POSIXct", "POSIXt"), tzone = "CST6CDT"), 
    x = c(654371.334599288, 654425.757711813, 654413.001859601, 
    654396.842641521, 654346.593176651, 654337.090447315, 654334.818175218, 
    654326.530950149, 654289.118946121, 654261.853959498, 651805.18706951, 
    651799.382793396, 651810.067280183, 651799.620449496, 651801.683057562, 
    651816.964086015, 651821.993327341, 651714.361813341, 651693.011227868, 
    651747.458989254, 652385.114529054, 652374.225278371, 652093.206807523, 
    652083.440205417, 652092.516704872, 652082.345404556, 652092.556187695, 
    652084.159078257, 652084.674447443, 652087.858880835, 652907.574768764, 
    652913.940744582, 652915.348511677, 652902.805542879, 652905.971983537, 
    652902.58817731, 652860.819066119, 652821.735425028, 652834.71368795, 
    652834.27029922), y = c(2939470.93183362, 2939450.68389254, 
    2939464.95474789, 2939471.49537518, 2939472.88154388, 2939478.49457091, 
    2939481.02639993, 2939460.28537739, 2939318.72673479, 2939260.75137547, 
    2938855.09928731, 2938836.31751033, 2938839.33629436, 2938838.11516351, 
    2938842.28331314, 2938829.93458363, 2938834.30422344, 2938857.68619733, 
    2938936.41572119, 2938907.99144485, 2942314.3327499, 2942310.36910381, 
    2942154.52809203, 2942165.81205587, 2942159.77141252, 2942159.06281473, 
    2942160.63606412, 2942162.33067677, 2942160.0434262, 2942160.29193881, 
    2943229.61402449, 2943227.81804756, 2943239.146907, 2943270.14022283, 
    2943280.16067867, 2943263.35708588, 2943347.8117451, 2943406.05189864, 
    2943415.94632734, 2943428.82622347)), row.names = c(NA, -40L
), class = "data.frame")

#subset by animal of interest
deers <- del6 %>%
  filter(Species=='deer') %>%
  droplevels()
summary(deers)

cows <- del6 %>%
  filter(Species=='cow') %>%
  droplevels()
summary(cows)


Dist_df<-NA 

for(a in 1:length(deers)) {
  deersIDs <- unique(deers$Id)
  
  for(b in 1:length(cows)) {
    cowsIDs <- unique(cows$Id)

for (i in 1:length(deersIDs)){
  deerID <- deersIDs[i]
  deer <- filter(deers, Id == deerID)
  deer.traj <- as.ltraj(xy = deer[,c("x","y")], date = deer$DateTime,
                        id=deerID, typeII = T)
  for (j in 1:length(cowsIDs)){
    cowID <- cowsIDs[j]
    cow <- filter(cows, Id == cowID)
    cow.traj <- as.ltraj(xy = cow[,c("x","y")], date = cow$DateTime,
                         id=cowID, typeII = T)
    sim <- GetSimultaneous(deer.traj,cow.traj,tc=30*60)
    deer.sim <- sim[1]
    cow.sim <- sim[2]
    dist <- Prox(deer.sim,cow.sim, local=T) 
    dist <- select(dist,-dt)
    Dist_df <- na.omit(Dist_df)
    dist$Id <- paste0(deerID[a], cowID[b])
Dist_df<-rbind(Dist_df, dist)}}}}

CodePudding user response：

Consider expand.grid and Map and avoid the four nested for loops, especially avoing the hazard of growing objects in a loop with rbind. See Patrick Burns' R Inferno - Circle 2: Growing Objects.

deers <- del6 %>% filter(Species=='deer') %>% droplevels()
summary(deers)

cows <- del6 %>% filter(Species=='cow') %>% droplevels() 
summary(cows)

# GENERALIZED METHOD TO HANDLE EACH PAIR OF DEER AND COW ID
calculate_distance <- function(deerID, cowID) {
    deer <- filter(deers, Id == deerID)
    deer.traj <- as.ltraj(
        xy=deer[,c("x","y")], date=deer$DateTime, id=deerID, typeII=TRUE
    )

    cow <- filter(cows, Id == cowID)
    cow.traj <- as.ltraj(
        xy=cow[,c("x","y")], date=cow$DateTime, id=cowID, typeII=TRUE
    ) 

    sim <- GetSimultaneous(deer.traj, cow.traj, tc=30*60) 
    deer.sim <- sim[1] 
    cow.sim <- sim[2] 
    dist <- Prox(deer.sim, cow.sim, local=TRUE) 
    dist <- select(dist, -dt) 

    dist$Id <- paste0(deerID, "_", cowID)

    return(dist)
}

# RETRIEVE ALL PAIRWISE MATCHES OF IDs
cross_join_ids <- expand.grid(
    deerID = unique(deers$Id), cowID = unique(cows$Id)
)

# BUILD LIST OF DATA FRAMES
dist_dfs <- Map(
    calculate_distance, cross_join_ids$deerID, cross_join_ids$cowID
)

# COMPILE SINGLE DATA FRAME
master_dist <- dplyr::bind_rows(dist_dfs)

For any problematic calculations you can wrap processing in tryCatch to print errors to console and return NULLs (which bind_rows will remove from final compilation):

calculate_distance <- function(deerID, cowID) {
  tryCatch({
    deer <- filter(deers, Id == deerID)
    deer.traj <- as.ltraj(
        xy=deer[,c("x","y")], date=deer$DateTime, id=deerID, typeII=TRUE
    )

    cow <- filter(cows, Id == cowID)
    cow.traj <- as.ltraj(
        xy=cow[,c("x","y")], date=cow$DateTime, id=cowID, typeII=TRUE
    ) 

    sim <- GetSimultaneous(deer.traj, cow.traj, tc=30*60) 
    deer.sim <- sim[1] 
    cow.sim <- sim[2] 
    dist <- Prox(deer.sim, cow.sim, local=TRUE) 
    dist <- select(dist, -dt) 

    dist$Id <- paste0(deerID, "_", cowID)

    return(dist)
  }, error = function(e) {
    print(e)
    return(NULL)
  })
}