Data Driven Knowledgebase

# 必要なパッケージの読み込み

library(ggplot2)

library(dplyr)



# サンプルデータの生成

set.seed(123)

# A店舗：やや高い満足度だが分布が歪んでいる

store_A <- c(6, 7, 8, 7, 9, 6, 8, 7, 9, 10, 5, 8, 7, 9, 8)

# B店舗：やや低い満足度で外れ値あり

store_B <- c(4, 5, 6, 5, 7, 4, 6, 5, 3, 8, 5, 6, 4, 2, 7)



# データの確認

cat("A店舗の満足度:", store_A, "\n")

cat("B店舗の満足度:", store_B, "\n")



# 基本統計量

cat("\n=== 基本統計量 ===\n")

cat("A店舗 - 中央値:", median(store_A), ", 平均:", round(mean(store_A), 2), "\n")

cat("B店舗 - 中央値:", median(store_B), ", 平均:", round(mean(store_B), 2), "\n")



# ウィルコクソンの順位和検定（マン・ホイットニーのU検定）

wilcox_result <- wilcox.test(store_A, store_B, alternative = "two.sided", exact = FALSE)



cat("\n=== ウィルコクソンの順位和検定結果 ===\n")

cat("検定統計量 W:", wilcox_result$statistic, "\n")

cat("p値:", round(wilcox_result$p.value, 4), "\n")

cat("結論:", ifelse(wilcox_result$p.value < 0.05,

"有意水準5%で2つの店舗に有意差あり",

"有意水準5%で2つの店舗に有意差なし"), "\n")



# データの可視化

data_plot <- data.frame(

satisfaction = c(store_A, store_B),

store = c(rep("A", length(store_A)), rep("B", length(store_B)))

)



# ボックスプロット（タイトルとラベルを大きく表示）

p1 <- ggplot(data_plot, aes(x = store, y = satisfaction, fill = store)) +

geom_boxplot(alpha = 0.7) +

geom_jitter(width = 0.2, alpha = 0.6) +

labs(title = "Store Satisfaction Distribution",

x = "Store",

y = "Satisfaction Score") +

theme_minimal() +

theme(legend.position = "none",

plot.title = element_text(size = 20, face = "bold", hjust = 0.5),

axis.title.x = element_text(size = 16, face = "bold"),

axis.title.y = element_text(size = 16, face = "bold"),

axis.text = element_text(size = 14))



print(p1)

A店舗の満足度: 6 7 8 7 9 6 8 7 9 10 5 8 7 9 8

B店舗の満足度: 4 5 6 5 7 4 6 5 3 8 5 6 4 2 7



=== 基本統計量 ===

A店舗 - 中央値: 8 , 平均: 7.6

B店舗 - 中央値: 5 , 平均: 5.13



=== ウィルコクソンの順位和検定結果 ===

検定統計量 W: 198

p値: 4e-04

結論: 有意水準5%で2つの店舗に有意差あり

# 対応のあるデータ（研修前後のスコア）

set.seed(456)

employee_id <- 1:20



# 研修前スコア（60-80点台が中心）

before_training <- c(65, 72, 68, 59, 74, 61, 69, 75, 63, 71,

66, 73, 67, 70, 64, 76, 68, 69, 62, 74)



# 研修後スコア（研修効果でやや上昇、但し個人差あり、一部は下がる）

after_training <- c(70, 78, 71, 63, 79, 58, 75, 80, 69, 76,

72, 69, 73, 75, 62, 81, 74, 73, 59, 78)



# データフレーム作成

training_data <- data.frame(

employee_id = employee_id,

before = before_training,

after = after_training,

difference = after_training - before_training

)



# データの確認

cat("研修前後のスコアデータ（最初の10名）:\n")

print(head(training_data, 10))



# 基本統計量

cat("\n=== 基本統計量 ===\n")

cat("研修前 - 中央値:", median(before_training), ", 平均:", round(mean(before_training), 2), "\n")

cat("研修後 - 中央値:", median(after_training), ", 平均:", round(mean(after_training), 2), "\n")

cat("差の中央値:", median(training_data$difference), ", 平均:", round(mean(training_data$difference), 2), "\n")



# 符号付き順位検定（ウィルコクソンの符号付き順位検定）

signed_rank_result <- wilcox.test(after_training, before_training,

paired = TRUE, alternative = "greater", exact = FALSE)



cat("\n=== 符号付き順位検定結果 ===\n")

cat("検定統計量 V:", signed_rank_result$statistic, "\n")

cat("p値:", round(signed_rank_result$p.value, 4), "\n")

cat("結論:", ifelse(signed_rank_result$p.value < 0.05,

"有意水準5%で研修効果あり（スコア向上）",

"有意水準5%で研修効果なし"), "\n")



# 改善の方向性分析

positive_changes <- sum(training_data$difference > 0)

negative_changes <- sum(training_data$difference < 0)

no_change <- sum(training_data$difference == 0)



cat("\n=== 改善方向の分析 ===\n")

cat("スコア向上した人数:", positive_changes, "名\n")

cat("スコア低下した人数:", negative_changes, "名\n")

cat("変化なし:", no_change, "名\n")



# データの可視化

# 研修前後の比較

p2 <- ggplot(training_data, aes(x = before, y = after)) +

geom_point(alpha = 0.7, size = 3, color = "steelblue") +

geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "red") +

geom_smooth(method = "lm", se = FALSE, color = "green", alpha = 0.6, formula = y ~ x) +

labs(title = "Training Score Comparison: Before vs After",

x = "Before Training Score",

y = "After Training Score") +

annotate("text", x = 60, y = 80,

label = "Red line: No change\nGreen line: Actual trend",

hjust = 0, vjust = 1, size = 4) +

theme_minimal() +

theme(plot.title = element_text(size = 18, face = "bold", hjust = 0.5),

axis.title.x = element_text(size = 15, face = "bold"),

axis.title.y = element_text(size = 15, face = "bold"),

axis.text = element_text(size = 12))



print(p2)



# 差分の分布

p3 <- ggplot(training_data, aes(x = difference)) +

geom_histogram(bins = 8, fill = "lightblue", color = "black", alpha = 0.7) +

geom_vline(xintercept = 0, linetype = "dashed", color = "red", linewidth = 1) +

geom_vline(xintercept = median(training_data$difference),

linetype = "solid", color = "blue", linewidth = 1) +

labs(title = "Distribution of Score Changes",

x = "Score Change (After - Before)",

y = "Frequency") +

annotate("text", x = 2, y = 4,

label = paste("Median:", median(training_data$difference)),

color = "blue", size = 4) +

theme_minimal() +

theme(plot.title = element_text(size = 18, face = "bold", hjust = 0.5),

axis.title.x = element_text(size = 15, face = "bold"),

axis.title.y = element_text(size = 15, face = "bold"),

axis.text = element_text(size = 12))



print(p3)

研修前後のスコアデータ（最初の10名）:

   employee_id before after difference

1            1     65    70          5

2            2     72    78          6

3            3     68    71          3

4            4     59    63          4

5            5     74    79          5

6            6     61    58         -3

7            7     69    75          6

8            8     75    80          5

9            9     63    69          6

10          10     71    76          5



=== 基本統計量 ===

研修前 - 中央値: 68.5 , 平均: 68.3

研修後 - 中央値: 73 , 平均: 71.75

差の中央値: 5 , 平均: 3.45



=== 符号付き順位検定結果 ===

検定統計量 V: 196.5

p値: 3e-04

結論: 有意水準5%で研修効果あり（スコア向上）



=== 改善方向の分析 ===

スコア向上した人数: 16 名

スコア低下した人数: 4 名

変化なし: 0 名