どこにでもあるようなコードだが、走らせてみたのでメモっておこう。

サポートベクターマシンでirisデータを分類し主成分分析で次元削減をした2次元プロットをする

data("iris")
str(iris)

'data.frame':    150 obs. of  5 variables:
 $ Sepal.Length: num  5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
 $ Sepal.Width : num  3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
 $ Petal.Length: num  1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
 $ Petal.Width : num  0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
 $ Species     : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...

# データセット
df <- iris

# 訓練データとテストデータに分割
set.seed(100)
df.rows <- nrow(df) # 150
train.rate <- 0.7 # 訓練データの比率
train.index <- sample(df.rows, df.rows * train.rate)
df.train <- df[train.index,] # 訓練データ
df.test <- df[-train.index,] # テストデータ
cat("train=", nrow(df.train), " test=", nrow(df.test))

train= 105 test= 45 訓練データと測定データはおよそ7:3の比率で分割されたことが確認される。

SVMモデルの訓練を行ったうえで、テストデータでの予測を行い予測結果の検証をする。

library(kernlab)
# SVMモデルの訓練
svm <- ksvm(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, data = df.train)

# テストデータでの予測
pred = predict(svm, df.test)

# 予測結果の検証
table(pred, df.test$Species) # 予測結果と実際のラベルの比較
sum(pred == df.test$Species) / length(pred) # 正解率

pred         setosa versicolor virginica
  setosa         14          0         0
  versicolor      0         14         0
  virginica       0          2        15
[1] 0.9555556

正解率は95.6%と非常に良い結果になっている。

もともと、4つの変数を使っているため、2次元でプロットするには4次元を2次元に次元削減する必要がある。とりあえず、主成分分析を使って次元削減を行う。

# 主成分分析（PCA）
pca <- prcomp(df[, 1:4], scale. = TRUE) # PCAの実行
pca_df <- data.frame(pca$x[, 1:2]) # 主成分スコア
pca_df$Species <- df$Species # 種別ラベルの追加

ggplot2でプロットをする。

PCA結果のプロット

library(ggplot2)
ggplot(pca_df, aes(x = PC1, y = PC2, color = Species)) +
  geom_point(alpha = 0.8, size = 3) +
  labs(title = "PCA of Iris Dataset", x = "Principal Component 1", y = "Principal Component 2") +
  theme_minimal()

サポートベクターマシンでirisデータを分類しt-SNEで次元削減をした2次元プロットをする

主成分分析よりt-SNEの方がよいので、t-SNEを使って次元削減をする。気を付けないといけないのは、重複データがあると計算ができないことである。コードはほぼ同じなので、結果の検証まで一気に書く。

data("iris")
df <- iris

# 重複データの削除
df_unique <- unique(df)

# 訓練データとテストデータに分割
set.seed(100)
df.rows <- nrow(df_unique) # 重複削除後の行数
train.rate <- 0.7 # 訓練データの比率
train.index <- sample(df.rows, df.rows * train.rate)
df.train <- df_unique[train.index,] # 訓練データ
df.test <- df_unique[-train.index,] # テストデータ
cat("train=", nrow(df.train), " test=", nrow(df.test))

# SVMモデルの訓練
svm <- ksvm(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width, data = df.train)

# テストデータでの予測
pred <- predict(svm, df.test)

# 予測結果の検証
table(pred, df.test$Species) # 予測結果と実際のラベルの比較
sum(pred == df.test$Species) / length(pred) # 正解率

t-SNEの実行とデータフレームへの変換

# t-SNEの実行
tsne_results <- Rtsne(df_unique[, 1:4], dims = 2, perplexity = 30, verbose = TRUE, max_iter = 500)

# t-SNE結果をデータフレームに変換
tsne_df <- data.frame(tsne_results$Y)
colnames(tsne_df) <- c("Dim1", "Dim2")
tsne_df$Species <- df_unique$Species

# t-SNE結果のプロット
ggplot(tsne_df, aes(x = Dim1, y = Dim2, color = Species)) +
  geom_point(alpha = 0.8, size = 3) +
  labs(title = "t-SNE of Iris Dataset", x = "Dimension 1", y = "Dimension 2") +
  theme_minimal()