Rで解析:Shinyで習作3。けものフレンズ80種類のカラーパレット


けものフレンズ公式サイト「けもフレ図鑑」に掲載の80種類のキャラクターおよびキャラ名画像をRで処理して得られた各カラーコードから、キャラクターは出現数上位9位、キャラクター名は出現数1位をカラーパレットとしました。紹介コマンドをコピー後にRStudioを利用し「ui.R」と「server.R」を用意、メニューのRun Appを実行で動作します。

・けものフレンズ公式サイト
 http://kemono-friends.jp/
 
残り2話、けものはどこに向かうのだろうか?

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]))
  })
})

・キャラカラーとキャラ名カラーのパレットデータと取得コード
けものフレンズ公式サイトにアクセスします。短時間に連続での実行は注意が必要です。RData形式です。RStudioで簡単に読み込めます。



・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)
########
}

実行例


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

スポンサードリンク

おすすめコンテンツ


スポンサードリンク