Data001: lvsem デモ

概要

このノートは、ローカルにパッケージ化した lvsem を使って、ラグジュアリー消費に関する公開マーケティングデータを分析するデモです。

分析の流れは次の通りです。

lvsem を読み込む
観測変数ブロックと構造パス行列を定義する
潜在変数スコアを作成する
パス係数と効果を推定する
bootstrap でパス係数のばらつきを確認する
測定モデルと構造モデルを簡単な図として描く

パッケージ

rm(list = ls(all = TRUE))

library(lvsem)
library(ggplot2)
library(knitr)

データ読み込み

data_file <- "1-s2.0-S2352340918312496-mmc2.csv"
data_candidates <- c(
  file.path("data001", data_file),
  data_file,
  file.path("..", "data001", data_file)
)
data_path <- data_candidates[file.exists(data_candidates)][1]

if (is.na(data_path)) {
  stop("CSVファイルが見つかりません: ", data_file)
}

data_dir <- dirname(data_path)
raw_data <- read.csv(data_path, check.names = TRUE)

dim(raw_data)

## [1] 157  31

head(raw_data)

##   Respondents M1 M2 M3 M4 M5 M6 M7 E1 E2 E3 E4 PQ1 PQ2 PQ3 PQ4 PQ5 PQ6 BC1 BC2
## 1           1  3  4  3  3  3  3  3  3  3  3  4   4   4   2   4   4   4   3   3
## 2           2  2  4  3  4  4  4  3  4  4  3  4   4   3   4   4   3   3   4   4
## 3           3  3  4  5  3  3  3  4  4  4  3  3   4   3   3   4   3   3   3   4
## 4           4  4  4  4  2  4  2  2  3  3  4  4   4   4   3   3   4   4   4   4
## 5           5  2  2  4  4  2  2  2  2  3  4  3   4   4   4   4   4   4   4   4
## 6           6  4  4  3  4  4  2  4  4  3  5  4   3   4   5   3   4   4   4   4
##   BC3 BC4 BC5 BC6 BC7 BC8 LC1 LC2 LC3 LC4 LC5
## 1   1   1   3   3   3   3   3   3   3   2   2
## 2   4   4   2   2   2   3   2   2   3   2   2
## 3   4   4   3   3   3   4   4   4   3   3   4
## 4   2   2   2   4   2   2   3   3   4   4   4
## 5   4   4   4   2   4   2   2   3   1   3   3
## 6   4   3   4   4   4   4   4   3   5   4   3

モデル定義

この例では、次の5つの潜在変数を使います。

M: 物質主義
E: 排他性
PQ: 知覚品質
BC: ブランド意識
LC: ラグジュアリー消費

blocks <- list(
  M  = paste0("M", 2:7),
  E  = c("E1", "E2", "E4"),
  PQ = paste0("PQ", 1:4),
  BC = c("BC1", "BC3", "BC5", "BC6", "BC7", "BC8"),
  LC = c("LC1", "LC2", "LC4", "LC5")
)

latent_vars <- names(blocks)
path <- matrix(
  0,
  nrow = length(latent_vars),
  ncol = length(latent_vars),
  dimnames = list(latent_vars, latent_vars)
)

path["LC", c("E", "M", "PQ", "BC")] <- 1
path

##    M E PQ BC LC
## M  0 0  0  0  0
## E  0 0  0  0  0
## PQ 0 0  0  0  0
## BC 0 0  0  0  0
## LC 1 1  1  1  0

潜在変数スコア

lv_scores <- make_lv_scores(raw_data, blocks, path)

head(lv_scores)

##             M           E         PQ          BC         LC
## 1 -0.25918190  0.05816605 0.13285573 -0.58030774 -0.7844784
## 2  0.06124275  0.44938759 0.20561058 -0.49021370 -1.5066858
## 3  0.26973192  0.25781576 0.10869196  0.03915827  0.9326481
## 4 -0.39581072  0.05816605 0.10054925 -0.74259561  0.5018283
## 5 -0.47038729 -0.32381751 0.32669298 -0.11967136 -0.5301584
## 6  0.10783282  0.24857779 0.08760694  0.52891422  0.5388958

round(cor(lv_scores), 3)

##        M     E    PQ    BC    LC
## M  1.000 0.765 0.672 0.804 0.677
## E  0.765 1.000 0.662 0.621 0.793
## PQ 0.672 0.662 1.000 0.578 0.675
## BC 0.804 0.621 0.578 1.000 0.717
## LC 0.677 0.793 0.675 0.717 1.000

構造モデル

path_coefficients <- estimate_paths(lv_scores, path)
path_effects <- effects_from_beta(path_coefficients)

path_coefficients

##       path       beta
## 1  M_to_LC -0.2762176
## 2  E_to_LC  0.5788978
## 3 PQ_to_LC  0.2143957
## 4 BC_to_LC  0.4558854

path_effects

##   relationships     direct indirect      total
## 1      BC -> LC  0.4558854        0  0.4558854
## 2       E -> LC  0.5788978        0  0.5788978
## 3       M -> LC -0.2762176        0 -0.2762176
## 4      PQ -> LC  0.2143957        0  0.2143957

lm_fit <- lm(LC ~ E + M + PQ + BC, data = as.data.frame(scale(lv_scores)))
r2_lc <- summary(lm_fit)$r.squared
r2_lc

## [1] 0.7433989

Bootstrap

set.seed(123)
boot_paths <- bootstrap_paths(raw_data, blocks, path, br = 1000, seed = 123)

kable(
  data.frame(
    path = boot_paths$path,
    round(boot_paths[, c("beta", "boot_se", "t_value")], 3)
  ),
  caption = "Bootstrapによる構造パス"
)

Bootstrapによる構造パス
path	beta	boot_se	t_value
M_to_LC	-0.276	0.138	2.005
E_to_LC	0.579	0.074	7.777
PQ_to_LC	0.214	0.062	3.448
BC_to_LC	0.456	0.134	3.394

測定モデルの要約

measures <- measurement_summary(raw_data, blocks, lv_scores)

kable(
  data.frame(
    block = measures$reliability$block,
    round(measures$reliability[, c("alpha", "composite_reliability", "ave")], 3)
  ),
  caption = "信頼性とAVE"
)

信頼性とAVE
block	alpha	composite_reliability	ave
M	0.789	0.845	0.481
E	0.757	0.863	0.679
PQ	0.776	0.849	0.586
BC	0.798	0.850	0.489
LC	0.813	0.877	0.643

kable(
  data.frame(
    block = measures$loadings$block,
    item = measures$loadings$item,
    loading = round(measures$loadings$loading, 3)
  ),
  caption = "外部負荷量"
)

外部負荷量
block	item	loading
M	M2	0.663
M	M3	0.690
M	M4	0.764
M	M5	0.666
M	M6	0.518
M	M7	0.823
E	E1	0.873
E	E2	0.874
E	E4	0.714
PQ	PQ1	0.858
PQ	PQ2	0.759
PQ	PQ3	0.674
PQ	PQ4	0.760
BC	BC1	0.599
BC	BC3	0.658
BC	BC5	0.831
BC	BC6	0.707
BC	BC7	0.618
BC	BC8	0.754
LC	LC1	0.860
LC	LC2	0.801
LC	LC4	0.688
LC	LC5	0.848

モデル図

node_df <- data.frame(
  block = c("M", "E", "PQ", "BC", "LC"),
  label = c(
    "物質主義\n(M)",
    "排他性\n(E)",
    "知覚品質\n(PQ)",
    "ブランド意識\n(BC)",
    "ラグジュアリー消費\n(LC)"
  ),
  x = c(0, 0, 0, 0, 3.2),
  y = c(3, 2, 1, 0, 1.5)
)

edge_df <- data.frame(
  from = sub("_to_LC", "", boot_paths$path),
  to = "LC",
  beta = boot_paths$beta,
  t_value = boot_paths$t_value,
  label = sprintf("beta = %.3f\nT = %.3f", boot_paths$beta, boot_paths$t_value)
)

edge_df <- merge(
  edge_df,
  node_df[, c("block", "x", "y")],
  by.x = "from",
  by.y = "block"
)
names(edge_df)[names(edge_df) %in% c("x", "y")] <- c("x_from", "y_from")

edge_df <- merge(
  edge_df,
  node_df[, c("block", "x", "y")],
  by.x = "to",
  by.y = "block"
)
names(edge_df)[names(edge_df) %in% c("x", "y")] <- c("x_to", "y_to")

edge_df$x_label <- (edge_df$x_from + edge_df$x_to) / 2
edge_df$y_label <- (edge_df$y_from + edge_df$y_to) / 2 + c(-0.18, 0.16, 0.10, -0.12)

item_df <- measures$loadings
item_df$i <- ave(seq_len(nrow(item_df)), item_df$block, FUN = seq_along)
item_df$n <- ave(seq_len(nrow(item_df)), item_df$block, FUN = length)
item_df <- merge(item_df, node_df[, c("block", "x", "y")], by = "block")
names(item_df)[names(item_df) %in% c("x", "y")] <- c("x_node", "y_node")
item_df$x <- ifelse(item_df$block == "LC", item_df$x_node + 1.25, item_df$x_node - 1.20)
item_df$y <- item_df$y_node + (item_df$i - (item_df$n + 1) / 2) * 0.18
item_df$label <- sprintf("%s\n%.3f", item_df$item, item_df$loading)

model_plot <- ggplot() +
  geom_segment(
    data = edge_df,
    aes(x = x_from + 0.45, y = y_from, xend = x_to - 0.55, yend = y_to),
    arrow = arrow(length = unit(0.22, "cm")),
    linewidth = 0.8,
    color = "#2f3a45"
  ) +
  geom_label(
    data = item_df,
    aes(x = x, y = y, label = label),
    size = 3,
    label.size = 0.25,
    fill = "#f7fbff",
    color = "#2a3340"
  ) +
  geom_segment(
    data = item_df,
    aes(
      x = ifelse(block == "LC", x - 0.30, x + 0.30),
      y = y,
      xend = ifelse(block == "LC", x_node + 0.62, x_node - 0.62),
      yend = y_node
    ),
    linewidth = 0.35,
    color = "#8b97a5"
  ) +
  geom_label(
    data = node_df,
    aes(x = x, y = y, label = label),
    size = 4.2,
    fontface = "bold",
    label.size = 0.35,
    fill = "#ffffff",
    color = "#111827"
  ) +
  geom_label(
    data = edge_df,
    aes(x = x_label, y = y_label, label = label),
    size = 3.2,
    label.size = 0,
    fill = "#ffffff",
    color = "#111827"
  ) +
  annotate(
    "label",
    x = 3.2,
    y = 0.72,
    label = sprintf("R2 = %.3f", r2_lc),
    size = 3.6,
    label.size = 0.25,
    fill = "#eef7f2"
  ) +
  coord_cartesian(xlim = c(-1.75, 4.85), ylim = c(-0.55, 3.55), clip = "off") +
  theme_void() +
  labs(title = "lvsemによる測定モデルと構造モデル")

model_plot

ggsave(file.path(data_dir, "data001_lvsem_demo_model.png"),
       model_plot, width = 11, height = 7, dpi = 180)

出力の確認

cat("サンプルサイズ:", nrow(raw_data), "\n")

## サンプルサイズ: 157

cat("ラグジュアリー消費のR2:", round(r2_lc, 3), "\n")

## ラグジュアリー消費のR2: 0.743

参考

Maziriri & Madinga (2018), Data in Brief, DOI: 10.1016/j.dib.2018.10.032
ローカルパッケージ: lvsem

Data001: lvsem デモ

Analysis

2026-05-10

概要

パッケージ

データ読み込み

モデル定義

潜在変数スコア

構造モデル

Bootstrap

測定モデルの要約

モデル図

出力の確認

参考