データ１

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

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

colnames(d) <- c("チワワ",
                 "トイプードル",
                 "豆柴")
library(kableExtra)
kable(d,caption = "販売数[匹]")
販売数[匹]
チワワ トイプードル 豆柴
2022年5月 5 1 9
2022年6月 8 2 8
2022年7月 4 3 7
2022年8月 9 4 5

積み上げ棒グラフ

# カラーパレット
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("2022年5月", "2022年6月", "2022年7月", "2022年8月")

# データフレームをkableExtraで表示
kable(d, caption = "販売数[匹]") %>%
  kable_styling()
販売数[匹]
チワワ| ト プードル| 豆柴|
2022年5月 | 5| 1| 9|
2022年6月 | 8| 2| 8|
2022年7月 | 4| 3| 7|
2022年8月 | 9| 4| 5| 
# 行名を新しい列として追加
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 = "データ提供: 2022年5月〜2022年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, 4),
  豆柴 = c(9, 8, 7, 5)
)

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

# POSIXct形式の時刻オブジェクトの作成
px <- as.POSIXct(c("2022-05-01", "2022-06-01", "2022-07-01", "2022-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)
cor(d$チワワ, d$トイプードル)
## [1] 0.8677218
cor(d$チワワ, d$豆柴)
## [1] -0.532948
cor(d$トイプードル,d$豆柴)
## [1] -0.8315218

無相関検定

(uv <- cor.test(d$チワワ, d$トイプードル)) # 無相関検定
## 
##  Pearson's product-moment correlation
## 
## data:  d$チワワ and d$トイプードル
## t = 2.4689, df = 2, p-value = 0.1323
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.5622931  0.9971933
## sample estimates:
##       cor 
## 0.8677218
ifelse(uv$p.value < 0.05, '有意', '有意でない')
## [1] "有意でない"
(uw <- cor.test(d$チワワ, d$豆柴))
## 
##  Pearson's product-moment correlation
## 
## data:  d$チワワ and d$豆柴
## t = -0.89075, df = 2, p-value = 0.4671
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.9879816  0.8777109
## sample estimates:
##       cor 
## -0.532948
ifelse(uw$p.value < 0.05, '有意', '有意でない')
## [1] "有意でない"
(vw <- cor.test(d$トイプードル, d$豆柴))
## 
##  Pearson's product-moment correlation
## 
## data:  d$トイプードル and d$豆柴
## t = -2.117, df = 2, p-value = 0.1685
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.9963561  0.6451325
## sample estimates:
##        cor 
## -0.8315218
ifelse(vw$p.value < 0.05, '有意', '有意でない')
## [1] "有意でない"

データ２

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

library(DT)
datatable(e,caption = 'マンガを読んだ人の割合[%]')

ヒストグラム

ヒストグラムの作成

# 必要なライブラリの読み込み
library(ggplot2)
library(dplyr)
## 
##  次のパッケージを付け加えます: 'dplyr'
##  以下のオブジェクトは 'package:kableExtra' からマスクされています:
## 
##     group_rows
##  以下のオブジェクトは 'package:stats' からマスクされています:
## 
##     filter, lag
##  以下のオブジェクトは 'package:base' からマスクされています:
## 
##     intersect, setdiff, setequal, union
# データの読み込み
e <- read.csv(file = 'https://stats.dip.jp/01_ds/data/rate_manga_read.csv')

# データフレームの構造確認
str(e)
## 'data.frame':    47 obs. of  3 variables:
##  $ 都道府県: chr  "北海道" "青森県" "岩手県" "宮城県" ...
##  $ 男      : num  39.1 32.7 33.7 41.5 33.2 36.6 38.4 37.7 35.3 38.5 ...
##  $ 女      : num  32.4 26.3 29.1 36.4 27 29 30.3 31.6 30.6 31.2 ...
# 列名の確認
names(e)
## [1] "都道府県" "男"       "女"
# 女性の割合列が数値として読み込まれているか確認し、数値として変換
e$女 <- as.numeric(as.character(e$女))

# NAが含まれていないか確認
sum(is.na(e$女性))
## [1] 0
# ヒストグラムの作成
ggplot(e, aes(x = 女)) +
  geom_histogram(binwidth = 5, fill = "pink", color = "black") +
  labs(title = "女性がマンガを読んだ割合のヒストグラム",
       x = "女性がマンガを読んだ割合 [%]",
       y = "都道府県数 [箇所]") +
  theme_minimal()

箱ひげ図

箱ひげ図

A <- as.numeric(as.character(e$男))
B <- as.numeric(as.character(e$女))

COL <- c("skyblue", "pink")

boxplot(A,B, col = COL,
        names = c('男性', '女性'),
        main = 'マンガを読んだ人の割合',
        xlab = '性別',
        ylab = '割合[%]')

abline(h = seq(-50, 50, 5), lty = 2, col = gray(0.5))

外れ値

男性：1つ

女性：２つ