如何编写函数为每个Telemetry对象生成独立变异函数列表

要实现将每个年度Telemetry对象的变异函数保存为独立列表的需求，只需对现有代码做两处关键修改：让计算函数返回结果，再将结果以指定名称存入全局环境。

修改后的完整代码 #

library(ctmm) 
library(ggplot2) 
library(dplyr) 
library(stringr) 
library(lubridate) 
library(sf) 
library(tidyverse) 
library(sp) 
library(scales) 
library(tidyr) 
library(tibble)

data("buffalo")

# 整理原始数据
Cilla <- as.data.frame(buffalo$Cilla) %>% mutate(id = "Cilla")
Gabs <- as.data.frame(buffalo$Gabs) %>% mutate(id = "Gabs")
Mvubu <- as.data.frame(buffalo$Mvubu) %>% mutate(id = "Mvubu")
Pepper <- as.data.frame(buffalo$Pepper) %>% mutate(id = "Pepper")
Queen <- as.data.frame(buffalo$Queen) %>% mutate(id = "Queen")
Toni <- as.data.frame(buffalo$Toni) %>% mutate(id = "Toni")

buffalo2 <- bind_rows(Cilla, Gabs, Mvubu, Pepper, Queen, Toni) %>%
  mutate(Year = factor(year(timestamp)),
         UTM.zone = "12 +datum=NAD27",
         timestamp = ymd_hms(timestamp),
         Timestamp = timestamp) %>%
  separate(timestamp, c("date", "time"), sep = " ", remove = TRUE, extra = "merge") %>%
  select(8,9,1,2,6,7,11,10)

# 按年份筛选并转为Telemetry对象
data2005 <- buffalo2 %>% filter(Year == 2005)
data2006 <- buffalo2 %>% filter(Year == 2006)

Tdata2005 <- as.telemetry(data2005, timeformat="auto", timezone="UTC", 
                          timeout=Inf, datum="NAD27",
                          na.rm="row", mark.rm=FALSE, keep=FALSE, drop=FALSE)
Tdata2006 <- as.telemetry(data2006, timeformat="auto", timezone="UTC", 
                          timeout=Inf, datum="NAD27",
                          na.rm="row", mark.rm=FALSE, keep=FALSE, drop=FALSE)

Tdata <- list(Tdata2005 = Tdata2005, Tdata2006 = Tdata2006)

# 修改后的变异函数计算函数：返回变异函数列表
SVF <- function(x, date) {
  variogram_list <- list()
  for (i in 1:length(x)) {    
    variogram_list[[i]] <- variogram(x[[i]])
    plot(variogram_list[[i]], main = paste(names(x[i]), "(", date, ")"))
  }
  # 为列表元素命名（对应个体ID）
  names(variogram_list) <- names(x)
  return(variogram_list)
}

# 处理整个Telemetry列表，生成并保存独立的年度变异函数列表
imap(Tdata, function(telemetry_obj, telemetry_name) {
  # 提取年份（从Telemetry对象名称中）
  year_str <- str_extract(telemetry_name, "\\d{4}")
  # 计算变异函数
  vario_list <- SVF(telemetry_obj, year_str)
  # 生成目标变量名
  target_name <- paste0("Variograms_", telemetry_name)
  # 将列表存入全局环境
  assign(target_name, vario_list, envir = .GlobalEnv)
})

关键修改说明 #

• 修改SVF函数：将内部存储变异函数的变量名改为variogram_list（避免与函数名冲突），并在最后返回该列表，同时为列表元素添加个体ID名称，方便后续查看。
• 使用imap替代lapply：imap可以同时获取列表的元素和对应的名称，无需额外维护年份向量，直接从Tdata的名称中提取年份信息。
• 用assign存入全局环境：通过paste0生成Variograms_Tdata2005、Variograms_Tdata2006这类目标名称，再用assign将计算好的变异函数列表存入全局环境，后续可直接调用这些变量。

执行完代码后，你可以在全局环境中找到Variograms_Tdata2005和Variograms_Tdata2006两个列表，每个列表中存储对应年度下所有个体的变异函数结果。

内容的提问来源于stack exchange，提问作者Jason Edelkind