在R中高效将xts对象写入Delft-FEWS兼容XML文件的方法

你的代码效率低的核心原因是嵌套循环逐行创建XML节点，每次调用newXMLNode都有不小的开销，8760次循环的累积耗时会非常可观。下面提供两种高效的优化方案，均能大幅缩短处理时间：

方案一：基于原XML包的批量优化 #

通过预格式化所有时间和数值，批量生成<event>节点的XML字符串，再一次性解析并插入到XML结构中，彻底消除内层循环：

library(xts)
library(XML)

# 生成原始数据
x <- xts(data.frame(P1=c(1:8760),P2=c(1:8760)), order.by = 
           seq.POSIXt(from=as.POSIXct("2023-01-01 00:00", tz="UTC"), 
                      to=as.POSIXct("2023-12-31 23:00",tz="UTC"), by = "hour"))

s1 <- Sys.time()

# 创建根节点
root <- newXMLNode("TimeSeries")
newXMLNode("timeZone", "0.0", parent = root)

# 预格式化所有时间，避免重复计算
dates <- format(index(x), "%Y-%m-%d")
times <- format(index(x), "%H:%M:%S")

# 遍历每一列
for(p in 1:ncol(x)){
  locId <- colnames(x)[p]
  startDate <- dates[1]
  endDate <- dates[length(dates)]
  
  # 创建series及头部信息
  series <- newXMLNode("series", parent = root)
  header <- newXMLNode("header", parent = series)
  newXMLNode("type", "instantaneous", parent = header)
  newXMLNode("locationId", locId, parent = header)
  newXMLNode("timeStep", attrs = c(unit = "hour", multiplier = '1'), parent = header)
  newXMLNode("startDate", attrs = c(date = startDate, time = times[1]), parent = header)
  newXMLNode("endDate", attrs = c(date = endDate, time = times[length(times)]), parent = header)
  newXMLNode("missVal", -999.0, parent = header)
  
  # 批量生成所有event的XML字符串
  values <- round(x[,p], 2)
  events_str <- sprintf('<event date="%s" time="%s" value="%s"/>', dates, times, values)
  # 解析为XML节点集并添加到series
  events_nodes <- xmlParseString(paste0("<events>", paste(events_str, collapse = ""), "</events>"))
  addChildren(series, xmlChildren(xmlRoot(events_nodes)))
}

s2 <- Sys.time()
cat("耗时：", difftime(s2, s1, units = "secs"), "秒\n")

方案二：使用xml2包（更高效） #

xml2包基于libxml2库，处理大量XML节点的效率远高于传统的XML包，结合向量操作和批量节点添加，能进一步提升速度：

library(xts)
library(xml2)
library(purrr)

# 生成原始数据
x <- xts(data.frame(P1=c(1:8760),P2=c(1:8760)), order.by = 
           seq.POSIXt(from=as.POSIXct("2023-01-01 00:00", tz="UTC"), 
                      to=as.POSIXct("2023-12-31 23:00",tz="UTC"), by = "hour"))

s1 <- Sys.time()

# 创建根节点
root <- xml_new_root("TimeSeries")
xml_add_child(root, "timeZone", "0.0")

# 预格式化所有时间
dates <- format(index(x), "%Y-%m-%d")
times <- format(index(x), "%H:%M:%S")

# 遍历每一列
for(p in 1:ncol(x)){
  locId <- colnames(x)[p]
  startDate <- dates[1]
  endDate <- dates[length(dates)]
  
  # 创建series及头部
  series <- xml_add_child(root, "series")
  header <- xml_add_child(series, "header")
  xml_add_child(header, "type", "instantaneous")
  xml_add_child(header, "locationId", locId)
  xml_add_child(header, "timeStep", attrs = list(unit = "hour", multiplier = "1"))
  xml_add_child(header, "startDate", attrs = list(date = startDate, time = times[1]))
  xml_add_child(header, "endDate", attrs = list(date = endDate, time = times[length(times)]))
  xml_add_child(header, "missVal", "-999.0")
  
  # 批量添加event节点
  values <- round(x[,p], 2)
  walk2(map2(dates, times, ~list(date = .x, time = .y)),
        values,
        ~xml_add_child(series, "event", attrs = c(.x, value = as.character(.y))))
}

# 保存到文件
xml_save(root, "delft_fews_output.xml")

s2 <- Sys.time()
cat("耗时：", difftime(s2, s1, units = "secs"), "秒\n")

关键优化点说明 #

1. 消除内层循环：通过向量操作一次性格式化所有时间和数值，避免逐行调用节点创建函数，减少重复开销。
2. 预计算公共数据：提前格式化所有时间戳，避免在循环中重复执行format函数。
3. 选择高效工具：xml2包的底层实现更高效，处理大量节点时性能远超XML包。
4. 修正原代码小问题：原代码中startDate和endDate的time属性硬编码为01:00:00，实际应使用数据的首尾时间，优化方案中已修正。

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