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%")) ) ) ) [/code] server.Rの内容 [code language="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])) }) }) [/code] ・キャラカラーとキャラ名カラーのパレットデータと取得コード けものフレンズ公式サイトにアクセスします。短時間に連続での実行は注意が必要です。RData形式です。RStudioで簡単に読み込めます。 [wpdm_package id='9649'] [wpdm_package id='9650']
・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) ######## } [/code]


実行例


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

スポンサードリンク

関連コンテンツ


スポンサードリンク