Latent Profile Analysis (LPA) tries to identify clusters of individuals (i.e., latent profiles) based on responses to a series of continuous variables (i.e., indicators). LPA assumes that there are unobserved latent profiles that generate patterns of responses on indicator items.
潜在剖⾯分析要做的事情就是根据个体在连续变量上的响应情况将个体分为互斥的，或者说互斥的剖⾯。
⼤家肯定还听过潜在类别分析，其实潜在剖⾯分析和潜在类别分析在统计上都是⼀样的，唯⼀的不同就是显变变量是分类变量（⼆分类）的时候我们叫它潜在类别，显变量是连续变量的时候我们叫潜在剖⾯。
The difference between LPA and LCA is conceptual, not computational: LPA uses continuous indicators and LCA uses binary indicators
⼤家记住下⾯这张图：
⽼规矩，今天还是带着⼤家做⼀个潜在剖⾯分析的实例。
实例操练
今天⼿上有997个学⽣样本的数据集interests_clean.csv，对于每个学⽣我们都调查了他的兴趣爱好，总共有32个兴趣爱好，我们会让学⽣对每⼀个兴趣的爱好程度以1-5分进⾏打分，就得到了⼀个如下图的数据集：
今天要做的就是对此数据集进⾏潜剖⾯分析，我们希望通过学⽣对每个兴趣的响应将学⽣分为不同的剖⾯。
在进⾏潜剖⾯分析的时候需要我们的数据是没有缺失值的，同时我们有必要将所有的值进⾏标准化处理，以便观察不同剖⾯的差异从⽽给每个剖⾯命名。
interests_clustering <- interests_clean %>%
mutate_all(list(scale))
上⾯的代码就将原始数据集进⾏了缺失删除处理和标准化。
接下来我们⾸先探索⼀下对于我们的数据我们应该分为⼏个剖⾯，这个问题⼀般情况下我们可以使⽤mclust包的mclustBIC看不同剖⾯模型的BIC，通常我们可以将不同模型的BIC画出来：
library(mclust)
BIC <- mclustBIC(interests_clustering)
plot(BIC)
summary(BIC)
看上⾯的BIC的变化图和summaryBIC的结果，初步得到，对于我们的数据划分3个剖⾯是⽐较合适的。
还有⼀个和BIC差不多的判断剖⾯个数的指标叫做ICL，Integrated Completed Likelikood，ICL对模型的不稳定性会进⾏惩罚，所以以ICL为标准得到的模型个数会更加稳定，要得到ICL指标只需要运⾏以下代码：
ICL <- mclustICL(interests_clustering)
plot(ICL)
summary(ICL)
看上⾯的ICL的变化图和summaryICL的结果，也同样得到，对于我们的数据划分3个剖⾯是⽐较合适的。
还有⼀个指标也是帮我们确定剖⾯个数的，叫做BLRT：
Bootstrap Likelihood Ratio Test (BLRT) which compares model fit between k-1 and k cluster models. In other words, it looks to see if an increase in profiles increases fit。
怎么做数据分析如上⾯的英⽂说明，这个指标就是帮我们看看，第 k-1 and k个模型之间是不是有差异，也就是说看看在k-1个剖⾯的基础上增加1个剖⾯后模型是不是会更好。
那么，我也来瞅瞅我的数据的BLRT指标的结果：
mclustBootstrapLRT(interests_clustering, modelName = "VEE")
可以看到，BLRT这个指标显⽰剖⾯个数从1增加到2，从2增加到3都是有显著性意义的，然后从3增加到4模型优度就并没有显著变好，所以BLRT依然显⽰我们的数据适合划分为3个剖⾯，那么现在我们就可以放⼼⼤胆地去做啦。
拟合模型
模型拟合超级简单哦。
只需要⽤到Mclust这个函数，然后把你的数据喂给它然后，规定好你要⼏个剖⾯就⾏。
mod1 <- Mclust(interests_clustering, G = 3)
就这么简单。可以看到3个剖⾯中，每个剖⾯有多少个体等等信息。
潜剖⾯模型可视化
潜剖⾯模型的可视化可以帮助我们知道⼈剖⾯在不同的显变量上的反应的平均⽔平：
we want to see how the profiles differ on the indicators, that is, the items that made up the profiles. If the solution is theoretically meaningful, we should see differences that make sense.
所以，⾸先我们就需要把剖⾯显变量的均值给它从模型中提取出来，代码如下：
means <- data.frame(mod1$parameters$mean, stringsAsFactors = FALSE) %>%
rownames_to_column() %>%
rename(Interest = rowname) %>%
melt(id.vars = "Interest", variable.name = "Profile", value.name = "Mean") %>%
mutate(Mean = round(Mean, 2),
Mean = ifelse(Mean > 1, 1, Mean))
运⾏上⾯的代码就可以得到每个剖⾯的所有显变量上的均值，上⾯代码的思路如下：⾸先提取模型均值，然后将提取出的均值数据框列名变成变量，对列名变量改名后将数据由宽型数据变化为长形数据，考虑到我们画图时的纵坐标是从0起的，所以对于已经标准化的数据我们要将其最⼤值改1。
好吧，估计好多⼈看不懂了，但是你们先收藏着，代码就在上⾯你们⾃⼰套⾃⼰的数据就⾏。
均值提取完了之后，我们开始作图啦
作图要达到的结果就是：通过图显⽰出不同剖⾯在各个指标上的响应均值，从⽽帮助我们给剖⾯起名字。
对于本例，作图代码如下：
means %>%
ggplot(aes(Interest, Mean, group = Profile, color = Profile)) +
geom_point(size = 2.25) +
geom_line(size = 1.25) +
scale_x_discrete(limits = c("Active sport", "Adrenaline sports", "Passive sport",
"Countryside, outdoors", "Gardening", "Cars",
"Art exhibitions", "Dancing", "Musical instruments", "Theatre", "Writing", "Reading",
"Geography", "History", "Law", "Politics", "Psychology", "Religion", "Foreign languages",
"Biology", "Chemistry", "Mathematics", "Medicine", "Physics", "Science and technology",
"Internet", "PC",
"Celebrities", "Economy Management", "Fun with friends", "Shopping", "Pets")) +
labs(x = NULL, y = "Standardized mean interest") +
theme_bw(base_size = 14) +
= element_text(angle = 45, hjust = 1), legend.position = "top")
上⾯都是很基本的ggplot2语法哈，我这⼉将指标进⾏了重新排序，把⽐较相近的指标放在了⼀起，⽐如所有的sport放在⼀起等等，这样也是为了⽅便看图给剖⾯起名字。
运⾏上⾯的代码，就可以得到输出啦：
看，剖⾯3中的这些学⽣就属于兴趣爱好中规中矩的，剖⾯1的学⽣尤其喜爱⽣物，化学和医学，我们不妨将这个剖⾯命名为“理科爱好者”，同样的剖⾯2的学⽣尤其喜欢互联⽹，PC，聚会，我们不妨将这个剖⾯的学⽣命名为“爱好玩耍者”，还有剖⾯3的学⽣尤其对园艺和户外活动感兴趣，所以我将它命名为“户外运动爱好者”。
然后，给上图改改图例吧，改成我们的新的剖⾯命名：
发布评论