気になっていた「47都道府県の代表的なアニメ」と「キャラクターの髪の色」を日本地図で表現するとともに「DTパッケージ」を利用して色とリンク付きのテーブルを作成しました。結果とコードを紹介します。
代表的なアニメは「2015年版 聖地白書に掲載」またはウェブで「都道府県名 アニメ」で検索し妥当と思われるアニメを選択しています。代表的なアニメ・キャラクターの選択は個人毎で異なると思います。何卒、ご了承ください。
キャラクターの元画像は、記事内の下部テーブルにある「参考URL」で表示されるページから取得しています。なお、解析は画像全体ではなく、髪部分の代表的な箇所を画像より切り出しpngで出力した画像を対象としています。下記が画像の状態です。
＜画像の状態＞
解析の結果は北関東がパステルでした。疑問が一つ解消したので満足です。
画像の取得方法や対象とするキャラクターを変更することで結果は変わると思います。結果は参考までにご覧ください。
「DTパッケージ」かなり使えるパッケージです。紹介で使用しているパッケージは2015/6/14時点でリリースされているものです。
必要なパッケージのインストール
対象パッケージがインストールされていなければ、下記コマンドを実行してください。
#パッケージのインストール
install.packages(”png", "jpeg", "colorspace", "DT", "ggplot2", "XLConnect", "maptools")日本地図データの準備
Global Administrative Areasへアクセスし日本を選択後Shapefileをダウンロードし、解凍します。解凍したファイルはフォルダごと任意の場所へ保存します。なお、読み込むファイルの名前はJPN_adm1.shpです。
Global Administrative Areas：http://www.gadm.org/country
過去記事:GoogleAnalyticsのアクセスデータを日本地図で表現する
https://www.karada-good.net/analyticsr/googleanalytics-2/
画像からカラーコードを取得する
画像ファイルは”読み込み順番”_”都道府県ID”_”都道府県名”.pngとしてください。”都道府県ID”と”都道府県名”の対応は下記画像を確認してください。
参考までに使用した画像切り抜きデータのダウンロードはこちらから
詳細はコメントまたは各パッケージヘルプを確認してください。
#パッケージの読み込み
library("tcltk")
library("png")
library("jpeg")
library("colorspace")
#読み込みフォルダを選択
FoldPath <- paste(as.character(tkchooseDirectory(title = "読み込みフォルダを選択"), sep = "", collapse =""))
#フォルダ内のアイテムを取得
ItemList <- list.files(path = FoldPath)
#データ格納用の変数を初期化
MasterRGBCol <- NULL
#アイテム数の取得
ItemVol <- length(ItemList)
for(i in seq(ItemVol)){
#Imageファイルの読み込み
selectAImage <- paste(FoldPath, "/", ItemList[i],
sep = "", collapse = "")
#jpeg/png/gifファイルの判断
if (unlist(strsplit(ItemList[i], "\\."))[2] == "png"){
Image <- readPNG(selectAImage)
LABCol <- as(RGB(as.vector(Image[,, 1]), as.vector(Image[,, 2]), as.vector(Image[,, 3])), "LAB")
RGBCol <- cbind(LABCol@coords[,1:3], hex(LABCol))
}else{
Image <- readJPEG(selectAImage, native = FALSE)
LABCol <- as(RGB(as.vector(Image[,, 1]), as.vector(Image[,, 2]), as.vector(Image[,, 3])), "LAB")
RGBCol <- cbind(LABCol@coords[,1:3], hex(LABCol))
}
#マスターデータのデータフレーム化
RGBCol <- as.data.frame(RGBCol)
#カラーコードを文字列化
RGBCol[, 4] <- as.character(RGBCol[, 4])
#head(RGBCol)
#画像で使用されているカラーコードを集計
CountColor <- as.data.frame(table(RGBCol[, 4]))
#集計データをカラーコードで並び替え
CountColor <- CountColor[order(CountColor[, 1], decreasing = TRUE), ]
head(CountColor)
#マスターデータの重複を削除
RGBCol <- RGBCol[!duplicated(RGBCol[, 4]),]
#マスターデータをカラーコードで並び替え
RGBCol <- RGBCol[order(RGBCol[, 4], decreasing = TRUE),]
#結合
RGBCol <- cbind(unlist(strsplit(ItemList[i], "_"))[2], unlist(strsplit(unlist(strsplit(ItemList[i], "_"))[3], "\\."))[1],
ItemList[i], RGBCol, CountColor[, 2])
#プロットデータの作成
MasterRGBCol <- rbind(MasterRGBCol, RGBCol)
#必要のないImage,LABCol,RGBColの削除
rm(Image,LABCol,RGBCol)
}
#行名の付与
colnames(MasterRGBCol) <- c("ID_1", "NAME_1", "ファイル名", "明度:l", "補色次元:a", "補色次元:b", "カラーコード", "出現数")
#ファイルの保存、解析画像数によってはファイルサイズが非常に大きい場合があります
#また、エクセルなどで読み込めないことがあるのでコメントアウトしています。
#setwd(paste(as.character(tkchooseDirectory(title = "保存場所を選択"), sep = "", collapse ="")))
#write.csv(MasterRGBCol, "分析結果.csv", fileEncoding = "CP932", eol = "\r\n")カラーコードのプロットと日本地図プロット・HTMLテーブル用のデータを作成
日本地図プロット・HTMLテーブル用のデータを作成します。必ず実行してください。
詳細はコメントまたは各パッケージヘルプを確認してください。
#軸の設定
xRange <- seq(0, 1, by = 1/ItemVol)
#グラフ幅の設定
xWidth <- seq(1/ItemVol, 1, by = 1/ItemVol)
#プロット領域の作成
par(bg = "#2E2E2E")
plot(0:1, 0:1, type = "n", axes = FALSE, xlab = "", ylab = "")
#日本地図プロットデータ格納用変数
MapDrowData <- NULL
for(k in seq(ItemVol)){
#データの抽出
Plot <- subset(MasterRGBCol, MasterRGBCol[, 3] == ItemList[k])
#出現数で並び替えてTOP1を抽出
Plot <- Plot[order(as.vector(Plot[, 8]), decreasing = TRUE),]
Plot <- head(Plot, n = 1)
#日本地図プロット用データ
MapDrowData <- rbind(MapDrowData, Plot)
#データのプロット
rasterImage(as.raster(Plot[, 7]),
xRange[k], 0, xWidth[k], 1, interpolate = FALSE)
}出力例
キャラの髪の色を日本地図で表現するコマンド
上部「日本地図データの準備」を参照して地図のデータを準備してください。
詳細はコマンド内のコメントを確認してください。
###ライブラリーの読み込み#####
library("ggplot2")
library("maptools")
########
#シェイプファイルの読み込み
#ファイルはJPN_adm1.shpです
ReadData <- paste(as.character(tkgetOpenFile(title = "マップデータを選択",
filetypes = '{"shpファイル" {".shp"}}',initialfile = "*.shp")), sep = "", collapse =" ")
MapData <- readShapeSpatial(ReadData)
#日本地図プロット用データをIDで並び替え
MapDrowData <- MapDrowData[order(type.convert(as.character(MapDrowData[, 1])), decreasing = FALSE),]
#沖縄の地図データを準備
#沖縄を抽出
OkinawaMap <- MapData[MapData$NAME_1 == "Okinawa",]
#データフレーム化
OkinawaMap <- fortify(OkinawaMap)
#抽出
OkinawaMapData <- subset(OkinawaMap, OkinawaMap[,1] > 127.5 & OkinawaMap[,1] < 128.5 & OkinawaMap[,2] > 26 & OkinawaMap[,2] < 26.9)
#X軸の描写位置を変更
OkinawaMapData[, 1] <- OkinawaMapData[, 1] + 6
#y軸の描写位置を変更
OkinawaMapData[, 2] <- OkinawaMapData[, 2] + 14
#沖縄以外の地図データの準備
#沖縄を除く
JapanMapData <- MapData[MapData$NAME_1 != "Okinawa",]
#データフレーム化
JapanMapData <- fortify(JapanMapData)
#データの抽出
JapanMapData <- subset(JapanMapData, JapanMapData[,1] > 128.5 & JapanMapData[,2] > 30)
#地図データの統合
#データの結合
AllJapanDrow <- rbind(JapanMapData, OkinawaMapData)
#おまじない
AllJapanDrow[, 7] <- type.convert(AllJapanDrow[, 7])
#境界線データの準備
BorderLine <- data.frame(DrowXaxis = c(133, 134.5, 135, 135), DrowYaxis = c(39, 39, 41, 43))
#日本地図のプロット
#時間がかかります
JapanDrow <- ggplot() +
geom_polygon(data = AllJapanDrow, aes(x = AllJapanDrow[, 1], y = AllJapanDrow[, 2], group = AllJapanDrow[, 6], fill = AllJapanDrow[, 7])) +
geom_path(data = BorderLine, aes(x = BorderLine[, 1], y = BorderLine[, 2])) +
scale_fill_gradientn(colours = MapDrowData[, 7], guide = FALSE) + labs(x = "", y = "") +
theme(axis.ticks = element_blank(), axis.text = element_blank(),
panel.grid = element_blank(), panel.background = element_rect(fill = "#2E2E2E"))
print(JapanDrow)出力例
アニメタイトルとキャラ名と参考URLをJavaScripのDataTablesで出力するコマンド
JavaScripのDataTablesを出力する「DTパッケージ」はかなり使い勝手がいいです。DTパッケージの紹介記事は下記からご覧ください。テーブル内のリンクはクリックするとアニメオフィシャルHPが開きます。
Rでウェブ解析：JavaScripのDataTablesがRから作成できます!「DTパッケージ」の紹介
https://www.karada-good.net/analyticsr/r-107/
データテーブルに使用したエクセルファイルです。
ダウンロードはこちらから
詳細はコマンド内のコメントを確認してください。
#パッケージの読み込み
library("DT")
library("XLConnect")
#HTMLファイルの保存場所を指定
setwd(paste(as.character(tkchooseDirectory(title = "保存場所を選択"), sep = "", collapse ="")))
#エクセルデータの読み込み
LoadData <- loadWorkbook(paste(as.character(tkgetOpenFile(title = "xlsxファイルを選択",
filetypes = '{"xlsxファイル" {".xlsx"}}',
initialfile = "*.xlsx")), sep = "", collapse =" "))
#シートの読み込み。読み込んだデータはデータフレームになります。
SheetData <- readWorksheet(LoadData, sheet = 1)
#セル用データをファイル名で並び替え
MapDrowData <- MapDrowData[order(type.convert(as.character(MapDrowData[, 3])), decreasing = FALSE),]
#参考URLをHTMLタグへ変換##
SheetData[, 5] <- paste0('<a href="', SheetData[, 5], '" target="_blank">', SheetData[, 5], '</a>')
#テーブルの作成
DataTable <- datatable(SheetData, rownames = FALSE, options = list(pageLength = 5, lengthMenu = c(3, 10, 25, 50, 100)),
caption = '47都道府県 アニメキャラ髪の色', escape = FALSE)
#キャラ名のセルの色をパイプ"%>%"でつなげてformatStyleで設定します
DataTable <- DataTable %>% formatStyle('キャラ',
backgroundColor = styleEqual(SheetData[, 4], MapDrowData[, 7]))
#作成テーブルをhtmlで出力
saveWidget(DataTable, 'DataTable.html')出力
ぐりぐり動きますので、いろいろいじってみてください。
スマホの方はこちらから:別ウィンドウで開く
少しでも、あなたの解析が楽になりますように！！
