循环遍历一组中的所有个体，但不遍历另一组
For loop cycling through all individuals in 1 group but not the other group
for 循环的目标是在每个同时时间戳计算每只鹿和每头牛之间的距离，并将其放入数据框中。该循环适用于鹿 1 和所有牛（deer1- cow1、cow2、cow3 ...），但它不会循环到 deer 2（deer2- cow1、cow2、cow3 ...）。它停止并产生 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 关于如何解决这个问题的任何想法？感谢您的帮助。
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)}}}}
考虑 expand.grid 和 Map 并避免四个嵌套 for 循环，尤其是避免在 rbind 循环中增加对象的危险。参见 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)
对于任何有问题的计算，您可以在 tryCatch 中包装处理以将错误打印到控制台和 return NULL（bind_rows 将从最终编译中删除）：
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)
})
}
for 循环的目标是在每个同时时间戳计算每只鹿和每头牛之间的距离，并将其放入数据框中。该循环适用于鹿 1 和所有牛（deer1- cow1、cow2、cow3 ...），但它不会循环到 deer 2（deer2- cow1、cow2、cow3 ...）。它停止并产生 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 关于如何解决这个问题的任何想法？感谢您的帮助。
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)}}}}
考虑 expand.grid 和 Map 并避免四个嵌套 for 循环，尤其是避免在 rbind 循环中增加对象的危险。参见 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)
对于任何有问题的计算，您可以在 tryCatch 中包装处理以将错误打印到控制台和 return NULL（bind_rows 将从最终编译中删除）：
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)
})
}