Rで解析：Shinyで習作３。けものフレンズ８０種類のカラーパレット

けものフレンズ公式サイト「けもフレ図鑑」に掲載の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")) %&gt;%
      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)
  ########
}

実行例

少しでも、何かの参考になりますように！！