计算覆盖度量以评估变化点检测方法的性能

Question

我想计算覆盖度量（CM）来评估变点检测方法在 10 个实现的数据分割上的性能。 为了简要说明 CM，令 i=1,..,k 的真实变化位置 τ_i 定义区间 {1,2,...,T} 的划分 P 为不相交的集合 S_i，使得 S _i 是线段 {τ_i−1 + 1,...,τ_i}。类似地，对于 i=1，k'_i 的估计变化位置 {τ'_i} 给出的分区 P' 为 段 S'_i。那么覆盖度量定义为 C(P',P)=(1/T)sum{|S|*max{|SnS'|/|SuS'|}, 其中 T 是数据的长度，n 是交集，u 是并集。

为此，我尝试编写适用于一种实现的代码。我还将它扩展了 10 个实现，但它解决了确定 |SnS'| 的问题。和 |SuS'|。

为了一个认识

library(DeCAFS)
set.seed(2001)
x=rep(c(0,2,-2,2,-2), c(200,200,200,200, 200))+rnorm(1000) 
TCP=c(200,400,600,800)
splitAt <- function(x, pos) unname(split(x, cumsum(seq_along(x) %in% (pos+1)))) 
split_by_TCP=splitAt(x, TCP)

estCP=DeCAFS(x,warningMessage = FALSE)$changepoints
split_by_estCP=splitAt(x, estCP)
intersec=(Map(\(split_by_TCP, split_by_estCP) intersect(split_by_TCP, split_by_estCP), split_by_TCP, split_by_estCP))
cardinality_intersection=sapply(intersec,length)
unionn=(Map(\(split_by_TCP, split_by_estCP) union(split_by_TCP, split_by_estCP), split_by_TCP, split_by_estCP))
cardinality_union=sapply(unionn, length)
print(max((cardinality_intersection)/(cardinality_intersection)))

对于10次实现，我使用了以下代码进行

DeCAFS

变化点检测方法，但是失败了

set.seed(11111)
y=as.data.frame(replicate(10,rep(c(0,2,-2,2,-2), c(200,200,200,200, 200))+rnorm(1000)))
decafs = function (x) DeCAFS(x, warningMessage = FALSE)$changepoints
mw=sapply(y, decafs)
ps=head(seq(4, 40, by=4),-1) 
d=rep(c(200,400,600,800),10)
splitAt <- function(x, pos) unname(split(x, cumsum(seq_along(x) %in% (pos+1)))) 
c=splitAt(d, ps)
m=mapply(splitAt,x=y, pos=c)
splitAt <-function (x, pos) unname(split(x, cumsum(seq_along(x) %in% (pos+1))))
r=mapply(splitAt,x=y,pos=mw)

Answer 1

我认为您的意思是使用 R 中的覆盖度量来评估变化点检测方法。为此，您首先需要为每个实现提供真实的变化点

tau

和估计的变化点

tau_prime

。然后，您将计算每个实现的覆盖指标，最后取所有实现的平均值。使用此代码片段您可以实现这一点：

# Function to calculate covering metric for one realization
calculate_covering_metric <- function(tau, tau_prime, T) {
  # Define function to compute intersection and union of two sets
  intersection <- function(x, y) length(intersect(x, y))
  union <- function(x, y) length(union(x, y))
  
  # Initialize covering metric
  covering_metric <- 0
  
  # Compute covering metric for each true change point
  for (i in 1:length(tau)) {
    S <- tau[[i]] # True segment
    S_prime <- tau_prime[[i]] # Estimated segment
    
    # Calculate intersection and union
    intersection_size <- intersection(S, S_prime)
    union_size <- union(S, S_prime)
    
    # Update covering metric
    covering_metric <- covering_metric + (length(S) * max(intersection_size / union_size))
  }
  
  # Normalize covering metric by T
  covering_metric <- covering_metric / T
  
  return(covering_metric)
}

# Example usage for one realization
tau <- list(c(1, 10), c(20, 30), c(40, 50))  # True change points
tau_prime <- list(c(1, 9), c(19, 30), c(41, 50))  # Estimated change points
T <- 100  # Length of the data

covering_metric <- calculate_covering_metric(tau, tau_prime, T)
print(covering_metric)

# Function to calculate covering metric for multiple realizations
calculate_average_covering_metric <- function(realizations, T) {
  total_covering_metric <- 0
  
  for (i in 1:length(realizations)) {
    tau <- realizations[[i]]$tau
    tau_prime <- realizations[[i]]$tau_prime
    total_covering_metric <- total_covering_metric + calculate_covering_metric(tau, tau_prime, T)
  }
  
  average_covering_metric <- total_covering_metric / length(realizations)
  
  return(average_covering_metric)
}

# Example usage for 10 realizations
# Assuming realizations is a list containing the true and estimated change points for each realization
# realizations <- list(realization1, realization2, ..., realization10)
average_covering_metric <- calculate_average_covering_metric(realizations, T)
print(average_covering_metric)

此代码定义了一个函数

calculate_covering_metric

来计算一个实现的覆盖度量，另一个函数

calculate_average_covering_metric

来计算多个实现的平均覆盖度量。您可以调整此代码以适应您的特定数据结构和要求。这个答案受到这两个链接1和2

的影响