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

  • RFSP根据群集质量度量或MDS维度对序列对象进行排序 .

  • 它将序列对象拆分为k个子组 .

  • 它计算每个子组的medoid .

  • 然后仅在序列索引图中绘制medoid序列 .

  • 每个亚组的箱形图与序列索引图一起显示，显示每个亚组中对类囊体的不熟悉 .

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

Sequence Index Plot

Relative Frequency Sequence Plot

RFSP的一大优势是进一步减少了信息，避免了序列索引图中有多个序列的“过度绘图”，同时提供了关于这种减少的拟合统计数据 .

来自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 或由包装提供的加权聚类措施来完成 . WeightedCluster . 第二步，我认为会更加困难，因为可能有必要的分裂"in cases"夸大权重 . 对于这些情况，有必要允许加权案例属于多个组 . 然后可以像往常一样遵循步骤3到5 .

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

References
Fasang，Anette E.和Tim Futing Liao，2014：可视化社会科学中的序列：相对频率序列图，参见：社会学方法与研究43，S . 643-676 .

r traminer