けものフレンズ公式サイト「けもフレ図鑑」に掲載の80種類のキャラクターおよびキャラ名画像をRで処理して得られた各カラーコードから、キャラクターは出現数上位9位、キャラクター名は出現数1位をカラーパレットとしました。紹介コマンドをコピー後にRStudioを利用し「ui.R」と「server.R」を用意、メニューのRun Appを実行で動作します。
・けものフレンズ公式サイト
http://kemono-friends.jp/
残り２話、けものはどこに向かうのだろうか？
RStudioのversion 1.0.136。windows 10のR version 3.3.3で動作を確認しています。
コマンドの紹介
詳細はコマンド、各パッケージのヘルプを確認してください。RStudioの他に必要なパッケージは「DT」、「gsheet」、[shiny]パッケージです。
なお、Shiny実行時に使用するカラーパレットのデータはGoogleDocsからダウンロードするので別途データの用意は必要ありません。参考までに、下部にカラーパレットのデータを掲載しています。
ui.Rの内容
#ui.R
#パッケージの読み込み
#キャラ名カラーパレットデータ
MasterNameData <- gsheet2tbl("https://drive.google.com/open?id=18vnUnvXL9Qh-OuvtnXCdZ6ccZngQJ8H6euvi7bvOy_A")
shinyUI(fluidPage(
#タイトルを指定
titlePanel("けものフレンズ カラーパレット80種"),
#UI設定
fluidRow(
#1列目
column(2,
selectInput(inputId = "SelectName",
label = "キャラクター名を選択",
choices = MasterNameData[, 1]),
DT::dataTableOutput("DTable")),
#2列目
column(3, plotOutput("Plot", width = "100%"))
)
)
)server.Rの内容
#server.R
#パッケージの読み込み
if (!require("DT")) {
install.packages("DT")}
if (!require("gsheet")) {
install.packages("gsheet")}
if (!require("shiny")) {
install.packages("shiny")}
###データ例の作成#####
n <- 150
TestData <- data.frame(Data1 <- sample(1:20, n, replace = TRUE),
Data2 <- sample(1:20, n, replace = TRUE))
########
#データをGoogleSheetから取得:gsheetパッケージ
#キャラ画像カラーパレットデータ
MasterCharaData <- gsheet2tbl("https://drive.google.com/open?id=1gewqpvl3BEwPk0Bor1tD1l6A7_sWI2k7tGMxYV1QDz0")
#キャラ名カラーパレットデータ
MasterNameData <- gsheet2tbl("https://drive.google.com/open?id=18vnUnvXL9Qh-OuvtnXCdZ6ccZngQJ8H6euvi7bvOy_A")
shinyServer(function(input, output) {
#キャラカラーを取得
GetCharcolData <- reactive({
CharaCol <- subset(MasterCharaData, MasterCharaData[, 1] == input$SelectName)
CharaCol <- as.data.frame(CharaCol)
})
# #キャラ名カラーを取得
# GetNamecolData <- reactive({
# NameCol <- subset(MasterNameData, MasterNameData[, 1] == input$SelectName)
# })
#プロットを描写
output$Plot <- renderPlot({
CharaCol <- GetCharcolData()
par(bg = "black")
plot(x = TestData[, 1], y = TestData[, 2],
col = CharaCol[, 2], pch = 15, cex = 3,
axes = FALSE, xlab = "", ylab = "")
})
#テーブルを描写
output$DTable <- DT::renderDataTable({
CharaCol <- GetCharcolData()
ColCodeData <- data.frame(CharaCol[, 2], rep("", nrow(CharaCol)))
colnames(ColCodeData) <- c("カラーコード", "カラー")
datatable(ColCodeData, rownames = FALSE, options = list(dom = "t")) %>%
formatStyle("カラー", valueColumns = "カラーコード",
backgroundColor = styleEqual(ColCodeData[, 1], ColCodeData[, 1]))
})
})・Shiny実行
・Googleスプレッドシート
けものキャラカラー
https://drive.google.com/open?id=1gewqpvl3BEwPk0Bor1tD1l6A7_sWI2k7tGMxYV1QDz0
けもの名前カラー
https://drive.google.com/open?id=18vnUnvXL9Qh-OuvtnXCdZ6ccZngQJ8H6euvi7bvOy_A
#必要パッケージの読み込み
if (!require("png")) {
install.packages("png")}
if (!require("tcltk")) {
install.packages("tcltk")}
if (!require("colorspace")) {
install.packages("colorspace")}
if (!require("scales")) {
install.packages("scales")}
#キャラ名を設定
CharaName <- c("サーバル", "キタキツネ", "カラカル", "アライグマ", "フェネック",
"トキ", "コアラ", "トラ", "ライオン", "タイリクオオカミ",
"ニホンオオカミ", "チーター", "ショウジョウトキ", "シヴァテリウム",
"シロサイ", "クロサイ", "アラビアオリックス", "トムソンガゼル",
"アフリカゾウ", "インドゾウ", "クロハゲワシ", "セグロジャッカル",
"イワハイラックス", "アクシスジカ", "タスマニアデビル", "オーストラリアデビル",
"ハクトウワシ", "オオタカ", "コウテイペンギン", "ジェンツーペンギン",
"イワトビペンギン", "フンボルトペンギン", "ロイヤルペンギン", "ヒョウ",
"クロヒョウ", "ピューマ", "ジャイアントペンギン", "メキシコサラマンダー",
"アゴヒゲアザラシ", "人面魚", "アフリカオオコノハズク", "ワシミミズク",
"アードウルフ", "スナネコ", "キンシコウ", "ホワイトタイガー", "ゴールデンタビータイガー",
"マルタタイガー", "ニシツノドリ", "ジャイアントパンダ", "レッサーパンダ", "ヒグマ",
"ホッキョクグマ", "オカピ", "エリマキトカゲ", "ミナミコアリクイ", "カバ", "ニホンカワウソ",
"コツメカワウソ", "アカカンガルー", "エゾヒグマ", "カムチャッカオオヒグマ", "コディアックヒグマ",
"マーゲイ", "オセロット", "ギンギツネ", "オイナリサマ", "キュウビキツネ", "トナカイ",
"ニホンジカ", "ヘラジカ", "ジャガー", "ブラックジャガー", "アミメキリン", "ヨーロッパビーバー",
"アメリカビーバー", "オグロプレーリードッグ", "アルパカ・スリ", "ツチノコ", "リカオン")
#キャラ・名前画像を保存するフォルダを選択
FoldPath <- paste(as.character(tkchooseDirectory(title = "フォルダを選択"), sep = "", collapse =""))
#キャラ画像を取得
for(n in seq(CharaName)){
GetUrl <- paste0("http://kemono-friends.jp/wp-content/themes/kemono-friends/assets/zoo/img/detail/",
formatC(n, width = 3, flag = "0"), "/chara.png")
download.file(GetUrl, destfile = paste0("chara_", formatC(n, width = 3, flag = "0"), ".png"), mode="wb")
}
#名前画像を取得
for(n in seq(CharaName)){
GetUrl <- paste0("http://kemono-friends.jp/wp-content/themes/kemono-friends/assets/zoo/img/detail/",
formatC(n, width = 3, flag = "0"), "/name.png")
download.file(GetUrl, destfile = paste0("name_", formatC(n, width = 3, flag = "0"), ".png"), mode="wb")
}
#画像名を取得
ItemList <- list.files(path = FoldPath)
#キャラ画像名を取得
CharaFile <- ItemList[ItemList %in% grep("chara", ItemList, value = TRUE)]
#名前画像名を取得
NameFile <- ItemList[ItemList %in% grep("name", ItemList, value = TRUE)]
#データ格納用の引数
MasterCharaData <- MasterNameData <- NULL
for(i in seq(CharaName)){
###キャラ画像を読み込み########
selectChara <- paste(FoldPath, "/", CharaFile[i],
sep = "", collapse = "")
#画像をカラーコード化
CharaImage <- readPNG(selectChara)
CharaLABCol <- as(RGB(as.vector(CharaImage[,, 1]), as.vector(CharaImage[,, 2]), as.vector(CharaImage[,, 3])), "LAB")
CharaRGBCol <- cbind(CharaLABCol@coords[,1:3], hex(CharaLABCol))
#マスターデータのデータフレーム化
CharaRGBCol <- as.data.frame(CharaRGBCol)
#特定の色を削除。白色系を削除
CharaRGBCol <- subset(CharaRGBCol, CharaRGBCol[, 4] != "#FFFFFF")
CharaRGBCol <- subset(CharaRGBCol, !(CharaRGBCol[, 4] %in% grep("#FDF", CharaRGBCol[, 4], value = TRUE)))
CharaRGBCol <- subset(CharaRGBCol, CharaRGBCol[, 4] != "#90B194")
#画像で使用されているカラーコードを集計
CharaRGBCol <- as.data.frame(table(CharaRGBCol[, 4]))
#集計データをカラーコードで並び替え
CharaRGBCol <- CharaRGBCol[order(CharaRGBCol[, 2], decreasing = TRUE), ]
#上位9を選択
CharaRGBCol <- as.character(CharaRGBCol[1:9, 1])
#show_col(CharaRGBCol)
#データを結合
CharaData <- cbind(CharaName[i], CharaRGBCol)
MasterCharaData <- rbind(MasterCharaData, CharaData)
########
###名前画像を読み込み#####
selectName <- paste(FoldPath, "/", NameFile[i],
sep = "", collapse = "")
###画像をカラーコード化#####
NameImage <- readPNG(selectName)
NameLABCol <- as(RGB(as.vector(NameImage[,, 1]), as.vector(NameImage[,, 2]), as.vector(NameImage[,, 3])), "LAB")
NameRGBCol <- cbind(NameLABCol@coords[,1:3], hex(NameLABCol))
#マスターデータのデータフレーム化
NameRGBCol <- as.data.frame(NameRGBCol)
#がさっと白色系を削除
NameRGBCol <- subset(NameRGBCol, NameRGBCol[, 4] != "#FFFFFF")
NameRGBCol <- subset(NameRGBCol, !(NameRGBCol[, 4] %in% grep("#FDF", NameRGBCol[, 4], value = TRUE)))
NameRGBCol <- subset(NameRGBCol, NameRGBCol[, 4] != "#90B194")
#画像で使用されているカラーコードを集計
NameRGBCol <- as.data.frame(table(NameRGBCol[, 4]))
#集計データをカラーコードで並び替え
NameRGBCol <- NameRGBCol[order(NameRGBCol[, 2], decreasing = TRUE), ]
#上位1を選択
NameRGBCol <- as.character(NameRGBCol[1, 1])
#show_col(NameRGBCol)
#データを結合
NameData <- cbind(CharaName[i], NameRGBCol)
MasterNameData <- rbind(MasterNameData, NameData)
########
}実行例
少しでも、何かの参考になりますように！！
