データ１

d <- data.frame(a = c(5,8,4,9),
                b = c(1,3,2,5),
                c = c(9,8,5,1))

rownames(d) <- c("2023年5月",
                 "2023年6月",
                 "2023年7月",
                 "2023年8月")

colnames(d) <- c("カレーライス",
                 "ハヤシライス",
                 "タコライス")
library(kableExtra)
kable(d,caption = "売上金額[百万円]")
売上金額[百万円]
カレーライス ハヤシライス タコライス
2023年5月 5 1 9
2023年6月 8 3 8
2023年7月 4 2 5
2023年8月 9 5 1

積み上げ棒グラフ

# カラーパレット
COL <- c(rgb(255,   0, 255,  55, max = 255), # ピンク
         rgb(  0,   0, 255,  55, max = 255), # ラベンダー
         rgb(  0, 255,   0,  55, max = 255),# ライトグリーン
         rgb(255,   0,   0,  105, max = 255))#赤

# 作図
m <- as.matrix(d)

barplot(m, col = COL,
        main = "売上金額[積上棒グラフ]",
        xlab = "対象メニュー",
        ylab = "金額［百万円］")

# 格子線
abline(h = seq(0, 300, 50), lty = 2, col = gray(0.5, 0.25))

# 凡例
legend("topleft", fill = COL, legend = rownames(m))

時系列グラフ

COL <- c(rgb(255,   0,   0,  255, max = 255), # 赤
         rgb(  0,   0, 255,  255, max = 255), # 青
         rgb(  0, 155,   0,  255, max = 255), # 緑
         rgb(255,   0, 255,  55, max = 255)) # 赤

# パッケージの読み込み
library(ggplot2)
library(reshape2)
library(kableExtra)

rownames(d) <- c("2023年5月", "2023年6月", "2023年7月", "2023年8月")

# データフレームをkableExtraで表示
kable(d, caption = "売上金額[百万円]") %>%
  kable_styling()
売上金額[百万円]
カレーライス| ハヤシラ ス| タコライス|
2023年5月 | 5| 1| 9|
2023年6月 | 8| 3| 8|
2023年7月 | 4| 2| 5|
2023年8月 | 9| 5| 1| 
# 行名を新しい列として追加
d$Month <- rownames(d)

# データフレームを長い形式に変換
d_long <- melt(d, id.vars = "Month", variable.name = "Type", value.name = "Sales")

# 時系列グラフの作成
ggplot(d_long, aes(x = Month, y = Sales, color = Type, group = Type)) +
  geom_line() +
  geom_point() +
  labs(title = "売上金額[時系列グラフ]", x = "月", y = "売上金額（百万円）", caption = "データ提供: 2023年5月〜2023年8月") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

# 必要なライブラリの読み込み
library(reshape2)

# データフレームの作成
d <- data.frame(
  カレーライス = c(5, 8, 4, 9),
  ハヤシライス = c(1, 3, 2, 5),
  タコライス = c(9, 8, 5, 1)
)

# 行名の設定
rownames(d) <- c("2023年5月", "2023年6月", "2023年7月", "2023年8月")

# POSIXct形式の時刻オブジェクトの作成
px <- as.POSIXct(c("2023-05-01", "2023-06-01", "2023-07-01", "2023-08-01"))

# カラーパレット
COL <- c("red", "blue", "green")

# プロット枠の作成
matplot(x = px,            # POSIXct形式の時刻オブジェクト（x軸）
        y = d,             # データフレーム（y軸；カレーライス、ハヤシライス、タコライスの時系列データ）
        type = "n",        # 線種（type）：プロットしない（"n"）
        xaxt = "n",        # x軸テキスト（xaxt）：表示しない（"n"）
        ylim = c(0, 10),   # y軸の範囲
        main = "売上金額[時系列グラフ]",
        xlab = "月",
        ylab = "売上金額（百万円）")

# x軸目盛り用時刻オブジェクト
px.g <- seq(px[1], px[length(px)], by = "month")

# x軸（side = 1）のatの位置にlabelsで示すラベルを貼付
axis(side = 1, at = px.g, labels = format(px.g, "%Y-%m"))

# 格子線の追加
abline(lty = 2,               # 線種（2：点線）
       col = gray(0.5, 0.25), # 灰色（濃さ，透過率）
       h   = seq(0, 10, 2),   # 水平線
       v   = px.g)            # 垂直線

# データのプロット
matlines(x = px, y = d$カレーライス, type = "o", pch = 1, lty = 1, col = COL[1])
matlines(x = px, y = d$ハヤシライス, type = "o", pch = 2, lty = 2, col = COL[2])
matlines(x = px, y = d$タコライス, type = "o", pch = 3, lty = 3, col = COL[3])

# 凡例の追加
legend("topright", col = COL, pch = 1:3, lty = 1:3, legend = colnames(d))

相関分析

・　相関図

# カラーパレットの設定
my_colors <- c("darkblue", "darkgreen", "darkred")

# 2種類ずつの組み合わせで散布図を作成
plot(d$カレーライス, d$ハヤシライス, 
     xlim = range(0, max(d$カレーライス, d$ハヤシライス, d$タコライス)), 
     ylim = range(0, max(d$カレーライス, d$ハヤシライス, d$タコライス)),
     xlab = "カレーライスの売上[百万円]", ylab = "ハヤシライスの売上[百万円]", 
     main = "カレーライス and ハヤシライス", col = my_colors[1])

points(d$カレーライス, d$タコライス, col = my_colors[2])
legend("topright", legend = c("ハヤシライス", "タコライス"),
       col = my_colors[1:2], pch = 1)

plot(d$カレーライス, d$タコライス, 
     xlim = range(0, max(d$カレーライス, d$ハヤシライス, d$タコライス)), 
     ylim = range(0, max(d$カレーライス, d$ハヤシライス, d$タコライス)),
     xlab = "カレーライスの売上[百万円]", ylab = "タコライスの売上[百万円]", 
     main = "カレーライス and タコライス", col = my_colors[1])

points(d$ハヤシライス, d$タコライス, col = my_colors[3])
legend("topright", legend = c("カレーライス", "ハヤシライス"),
       col = c(my_colors[1], my_colors[3]), pch = 1)

plot(d$ハヤシライス, d$タコライス, 
     xlim = range(0, max(d$カレーライス, d$ハヤシライス, d$タコライス)), 
     ylim = range(0, max(d$カレーライス, d$ハヤシライス, d$タコライス)),
     xlab = "ハヤシライスの売上[百万円]", ylab = "タコライスの売上[百万円]", 
     main = "ハヤシライス and タコライス", col = my_colors[2])

points(d$カレーライス, d$ハヤシライス, col = my_colors[1])
legend("topright", legend = c("カレーライス", "タコライス"),
       col = c(my_colors[1], my_colors[2]), pch = 1)

library(psych)
## 
##  次のパッケージを付け加えます: 'psych'
##  以下のオブジェクトは 'package:ggplot2' からマスクされています:
## 
##     %+%, alpha
pairs.panels(d)

library(corrplot)
## corrplot 0.92 loaded
# 相関行列の計算
r <- cor(d)

# 相関行列のプロット
corrplot.mixed(r, lower = 'ellipse', upper = 'number')

library(plotly)
## 
##  次のパッケージを付け加えます: 'plotly'
##  以下のオブジェクトは 'package:ggplot2' からマスクされています:
## 
##     last_plot
##  以下のオブジェクトは 'package:stats' からマスクされています:
## 
##     filter
##  以下のオブジェクトは 'package:graphics' からマスクされています:
## 
##     layout
# フォント設定
kyokasho <- list(size = 11, color = 'blue', family = 'UD Digi Kyokasho NK-R')

# Plotlyのヒートマップ作成
heatmap <- plot_ly(
  x = rownames(d),
  y = colnames(d),
  z = as.matrix(d),
  text = paste(d),
  type = 'heatmap'
) %>%
layout(
  font = kyokasho,
  title = '売上金額[相関図]',
  xaxis = list(title = '月'),
  yaxis = list(title = 'メニュー')
)

# プロットの表示
heatmap

→求めた相関係数は意味のある相関関係か？

カレーとハヤシライス：強い正の相関

カレーとタコライス：弱い負の相関

ハヤシライスとタコライス：強い負の相関

・　相関係数

library(DT)
datatable(d)
x <- c(1, 2, 3, 5)
y <- c(0, 3, 3, 6)

# cor関数で2変量の相関係数を計算する。
cor(x, y)
## [1] 0.9561829
cor(d$カレーライス, d$ハヤシライス)
## [1] 0.8609161
cor(d$カレーライス, d$タコライス)
## [1] -0.4480614
cor(d$ハヤシライス,d$タコライス)
## [1] -0.82819

・　無相関検定

(uv <- cor.test(d$カレーライス, d$ハヤシライス)) # 無相関検定
## 
##  Pearson's product-moment correlation
## 
## data:  d$カレーライス and d$ハヤシライス
## t = 2.3932, df = 2, p-value = 0.1391
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.5804166  0.9970384
## sample estimates:
##       cor 
## 0.8609161
ifelse(uv$p.value < 0.05, '有意', '有意でない')
## [1] "有意でない"
(uw <- cor.test(d$カレーライス, d$タコライス))
## 
##  Pearson's product-moment correlation
## 
## data:  d$カレーライス and d$タコライス
## t = -0.70878, df = 2, p-value = 0.5519
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.9849873  0.9010347
## sample estimates:
##        cor 
## -0.4480614
ifelse(uw$p.value < 0.05, '有意', '有意でない')
## [1] "有意でない"
(vw <- cor.test(d$ハヤシライス, d$タコライス))
## 
##  Pearson's product-moment correlation
## 
## data:  d$ハヤシライス and d$タコライス
## t = -2.0898, df = 2, p-value = 0.1718
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.9962774  0.6513373
## sample estimates:
##      cor 
## -0.82819
ifelse(vw$p.value < 0.05, '有意', '有意でない')
## [1] "有意でない"

データ２

e <- read.csv(file = 'https://stats.dip.jp/01_ds/data/heights100.csv')

library(DT)
datatable(e,caption = '身長[cm]')

ヒストグラム

hist(e$male, 
     col = "skyblue", 
     border = "white", 
     xlab = "身長 [cm]", 
     ylab = "度数",
     main = "男性の身長ヒストグラム")

箱ひげ図

・ 箱ひげ図

# 男性の身長の箱ひげ図
boxplot(e$male, col = "skyblue", main = "男性の身長の箱ひげ図")

・ 外れ値

# 男性の身長の箱ひげ図
boxplot(e$male, col = "skyblue", main = "男性の身長の箱ひげ図")

# 女性の身長の箱ひげ図
boxplot(e$female, col = "pink", main = "女性の身長の箱ひげ図")

外れ値

男性：1つ

女性：２つ