潜在プロファイル分析の標準書式での書き換え

mclustパッケージを使った潜在プロファイル分析のエントリではパイプ演算子によるコードを使用していた。

ides.hatenablog.com

パイプを使わずにRの標準書式での記述を示しておきたい。参考までに、パイプ演算子での表記も併記しておく。

まず、young_people.csvのHistoryからPetsの列を抜き出す作業。
dplyrは変数名で吹き出すことができるのでselect(History:Pets)となるが、Rの標準コードは行数で抜き出すので、以下のようになる。

標準コード

d1 <- read.csv("https://raw.githubusercontent.com/whipson/tidytuesday/master/young_people.csv")
survey <-d1[,32:63]

パイプ演算子

library(tidyverse)
survey <- read_csv("https://raw.githubusercontent.com/whipson/tidytuesday/master/young_people.csv") %>% select(History:Pets)

マハラノビス距離で多変量の外れ値を探す。

標準コード

library(careless)
library(psych)
md <- outlier(survey , plot = FALSE)  ## psychパッケージ。マハラノビス平方距離
string <- longstring(survey) ## carelessパッケージ。各観測の同一の連続した応答の最長文字列を識別する
interests <- cbind(survey, md, string) ## 34, 35行目にmdとstringの列をくっつける

パイプ演算子

library(careless)
library(psych)
interests <- survey %>%
  mutate(string = longstring(.)) %>%
  mutate(md = outlier(., plot = FALSE))

標準コード

cutoff <- (qchisq(p = 1 - .001, df = ncol(interests))) ## カットオフ値の設定
interests2 <-interests[interests$string <= 10 &  interests$md < cutoff, ] ## stringが10以下、mdがカットオフ未満の値を抽出
interests_clean<- interests2[,1:32] ## 33行目のstringと34行目のmdを除いた行を抽出

パイプ演算子

cutoff <- (qchisq(p = 1 - .001, df = ncol(interests)))
interests_clean <- interests %>%
  filter(string <= 10,
         md < cutoff) %>%
  select(-string, -md)

標準コード

library(mclust)
interests_clean1 <- na.omit(interests_clean)  ## 欠損値を含む行を削除
interests_clustering <- as.data.frame(scale(interests_clean1)) ## 標準化＋データフレーム化
BIC <- mclustBIC(interests_clustering)

パイプ演算子

library(mclust)
interests_clustering <- interests_clean %>%
  na.omit() %>%
  mutate_all(list(scale))
BIC <- mclustBIC(interests_clustering)