如何使用TraMineR创建具有（采样）权重和组的相对频率序列图？

Question

Fasang / Liao（2014）提出了相对频率序列图（RFSP）作为序列图的平滑方法：

1. RFSP根据群集质量度量或MDS维度对序列对象进行排序。
2. 它将序列对象拆分为 k 子组。
3. 它计算每个子组的medoid。
4. 然后只在序列索引图中绘制medoid序列。
5. 每个亚组的箱形图与序列索引图一起显示，显示每个亚组中对于medoid的不熟悉。

为了显示差异，您可以在下面找到序列索引图（按第一个MDS维度排序）和RFSP：



RFSP的一大优势是进一步减少信息，避免过度绘制＆＃34;在具有许多序列的序列索引图中，同时呈现关于该减少的拟合优度统计。

Fasang / Liao的原始文章未提及权重，但它从同一数据集中为两组（东/西德）生成RFSP。 R-package TraMineRextras中的函数seqplot.rf可以生成RFSP。但它既不允许使用权重，也不允许对群体进行区分。由于权重是非常常见的，并且通常需要控制样本中的不同群体（例如，女性/男性，年轻/年老，来自先前序列分析的群集），我正在尝试找到实施权重和群体的合适方式。

以下是使用seqplot.rf代码的工作示例，尚未使用权重和组：

library(TraMineR)
library(TraMineRextras)

# Define Sequence Object --------------------------------------------------
data(mvad)
mvad.alphabet <- c("employment", "FE", "HE", "joblessness", "school",
                   "training")
mvad.labels <- c("Employment", "Further Education", "Higher Education",
                 "Joblessness", "School", "Training")
mvad.scodes <- c("EM", "FE", "HE", "JL", "SC", "TR")

seqdata <- seqdef(mvad[, 17:86], alphabet = mvad.alphabet, 
                  states = mvad.scodes, labels = mvad.labels)
                  #weights = mvad$weight)



# Calculate distance and define settings ----------------------------------
diss <- seqdist(seqdata, method="HAM") # Use Hamming Distance as example 
k=100

sortv=NULL
use.hclust=FALSE
hclust_method="ward.D"
use.quantile=FALSE
yaxis=FALSE
main=NULL

# Code from seqplot.rf -----------------------------------------------------
message(" [>] Using k=", k, " frequency groups")

#Extract medoid, possibly weighted
gmedoid.index <- disscenter(diss, medoids.index="first")

gmedoid.dist <-diss[, gmedoid.index] #Extract distance to general medoid

##Vector where distance to k medoid will be stored
kmedoid.dist <- rep(0, nrow(seqdata))
#index of the k-medoid for each sequence
kmedoid.index <- rep(0, nrow(seqdata))
#calculate qij - distance to frequency group specific medoid within frequency group
if(is.null(sortv) && !use.hclust){
  sortv <- cmdscale(diss, k = 1)

}
if(!is.null(sortv)){
  ng <- nrow(seqdata) %/% k
  r <- nrow(seqdata) %% k
  n.per.group <- rep(ng, k)
  if(r>0){
    n.per.group[order(runif(r))] <- ng+1
  }
  mdsk <- rep(1:k, n.per.group)
  mdsk <- mdsk[rank(sortv, ties.method = "random")]
}else{
  hh <- hclust(as.dist(diss), method=hclust_method)
  mdsk <- factor(cutree(hh, k))
  medoids <- disscenter(diss, group=mdsk, medoids.index="first")
  medoids <- medoids[levels(mdsk)]
  #ww <- xtabs(~mdsk)
  mds <- cmdscale(diss[medoids, medoids], k=1)
  mdsk <- as.integer(factor(mdsk, levels=levels(mdsk)[order(mds)]))
}
kun <- length(unique(mdsk))
if(kun!=k){
  warning(" [>] k value was adjusted to ", kun)
  k <- kun
  mdsk <- as.integer(factor(mdsk, levels=sort(unique(mdsk))))
}
#sortmds.seqdata$mdsk<-c(rep(1:m, each=r+1),rep({m+1}:k, each=r))
##pmdse <- 1:k
#pmdse20<-1:20

##for each k
for(i in 1:k){
  ##Which individuals are in the k group
  ind <- which(mdsk==i)
  if(length(ind)==1){
    kmedoid.dist[ind] <- 0
    ##Index of the medoid sequence for each seq
    kmedoid.index[ind] <- ind
  }else{
    dd <- diss[ind, ind]
    ##Indentify medoid
    kmed <- disscenter(dd, medoids.index="first")
    ##Distance to medoid for each seq
    kmedoid.dist[ind] <- dd[, kmed]
    ##Index of the medoid sequence for each seq
    kmedoid.index[ind] <- ind[kmed]
  }
  ##Distance matrix for this group

}

##Attribute to each sequences the medoid sequences
seqtoplot <- seqdata[kmedoid.index, ]

##Correct weights to their original weights (otherwise we use the medoid weights)
attr(seqtoplot, "weights") <- NULL
opar <- par(mfrow=c(1,2), oma=c(3,0,(!is.null(main))*3,0), mar=c(1, 1, 2, 0))
on.exit(par(opar))
seqIplot(seqtoplot, withlegend=FALSE, sortv=mdsk, title="Sequences medoids")
##seqIplot(seqtoplot, withlegend=FALSE, sortv=mdsk)
heights <- xtabs(~mdsk)/nrow(seqdata)
at <- (cumsum(heights)-heights/2)/sum(heights)*length(heights)
if(!yaxis){
  par(yaxt="n")
}

boxplot(kmedoid.dist~mdsk, horizontal=TRUE, width=heights, frame=FALSE,  
        main="Dissimilarities to medoid", ylim=range(as.vector(diss)), at=at)

#calculate R2
R2 <-1-sum(kmedoid.dist^2)/sum(gmedoid.dist^2)
#om K=66 0.5823693


#calculate F
ESD <-R2/(k-1) # averaged explained variance
USD <-(1-R2)/(nrow(seqdata)-k) # averaged explained variance
Fstat <- ESD/USD

message(" [>] Pseudo/median-based-R2: ", format(R2))
message(" [>] Pseudo/median-based-F statistic: ", format(Fstat))
##cat(sprintf("Representation quality: R2=%0.2f F=%0.2f", R2, Fstat))
title(main=main, outer=TRUE)
title(sub=sprintf("Representation quality: R2=%0.2f and F=%0.2f", R2, Fstat), outer=TRUE, line=2)

一般来说，我认为应该可以为RFSP实施权重和组：

对于频率权重，似乎有一种相当简单的方法：我可以相应地扩展数据集中的个案数量。但是，这可能会导致巨大的数据集和相关的内存或速度问题。对于通常为小数的抽样权重，这不起作用 因此，更通用的方法会有所帮助。产生RFSP的第一步可以使用来自纯素包的wcmdscale的权重或由包lige提供的加权聚类措施来完成。 WeightedCluster。第二步，我认为会更难，因为可能存在必要的分裂＆＃34;在情况下＃34;被重量过度夸大。对于这些情况，有必要允许加权案例属于多个组。然后可以照常执行步骤3到5。

对于小组，我认为应该可以分别对每个小组分别执行步骤1到5，如果一个小组不想将这些小组与一般的medoid进行比较。这意味着，如果距离测量对不存在/现在的情况不敏感（例如通过使用基于转换的每个组的替换成本），则可以对所有组使用相同但不同的子集化距离矩阵。

参考
   _{Fasang，Anette E.和Tim Futing Liao，2014：可视化社会科学中的序列：相对频率序列图，在：社会学方法＆amp;研究43，S。643-676。}