本文へスキップ
からだにいいもの

Rのトピックスを中心に『まだ、まだ、知らない、役に立つ情報？』を発信します。

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

Rの解析に役に立つ記事

けものフレンズ公式サイト「けもフレ図鑑」に掲載の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で動作を確認しています。

＜おすすめのRに関する書籍です＞

サラっとできる!フリー統計ソフトEZR(Easy R)でカンタン統計解析 | 神田 善伸
サラっとできる!フリー統計ソフトEZR(Easy R)でカンタン統計解析 | 神田 善伸
Amazonで神田 善伸のサラっとできる!フリー統計ソフトEZR(Easy R)でカンタン統計解析
www.amazon.co.jp

コマンドの紹介

詳細はコマンド、各パッケージのヘルプを確認してください。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)
  ########
}
スポンサーリンク

実行例

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

＜おすすめのRに関する書籍です＞

多変量解析の基礎 II　主成分分析（改訂版）: 理論とRによる演習 | 古橋武 | 工学 | Kindleストア
多変量解析の基礎 II　主成分分析（改訂版）: 理論とRによる演習 | 古橋武 | 工学 | Kindleストア
Amazonで古橋武の多変量解析の基礎 II　主成分分析（改訂版）: 理論とRによる演習。一度購入いただいた電子書籍は、KindleおよびFire端末、スマートフォンやタブレットなど、様々な端末でもお楽しみいただけます。
www.amazon.co.jp

このコードの続きをAIに聞く

ChatGPTに聞くClaudeに聞く
SHARE
ポストはてブPocket
スポンサーリンク

関連記事

Rで解析：HTMLコードを依存ゼロで作成「hypertext」パッケージの紹介 Rで解析：baseのRグラフィックスで高度な作図！「tinyplot」パッケージ〜 Rで解析：日本地図もOK！インタラクティブなテーママップ作成「mapsf.gui」パッケージの紹介 Rで解析：クラスター誤差を考慮した操作変数法「clusterIV」パッケージの紹介
Prices and shipping availability may change. Please refer to the product page at time of purchase.
Content displayed on this site is provided by Amazon and may be updated or removed.
Amazon Associate, karada-good earns income through qualifying sales.