Rでお遊び:「あの花」実写ドラマ記念!あの花カラーパレットの紹介

Rの解析に役に立つ記事
スポンサーリンク

アニメは「からだにいいもの」という信念で、仕事の合間にBGM代わりに流しています。昨日、アニメ「あの日見た花の名前を僕達はまだ知らない。(あの花)」が実写ドラマになるという、個人的にビッグなニュースが飛び込んできました。

あの花は、2011年に埼玉県秩父を舞台にした「大人も泣けるアニメ」と話題を呼んだアニメでオフィシャルHPでもキャッチに「300万人の心を掴んだ ちょっと不思議なひと夏の感動の物語」とあります。私は心を掴まれた300万人のひとりです。

実写ドラマがどのように進行し評価を受けるか非常に楽しみです。

ドラマ記念としてオフィシャルHPのキャラクター紹介画像で使用されている「Top20のカラーコード」をRで取得してみました。pngからの解析ですのでオフィシャル色指定と若干異なると思います。

あの花HP:http://www.anohana.jp/

Rを利用していてまだご覧になってない方にオススメのアニメです。また、アニメから本ページにたどり着いた方はRを是非利用してもらえればと思います。カラーパレットやテーブルを作成するコードは最下部で紹介します。

コマンドはR version 3.2.0で確認しています。


スポンサーリンク

カラーパレットを作成する準備

過去の過去記事をご覧いただければ。
・Rでお遊び:「47都道府県の代表的なアニメ」と「キャラクターの髪の色」のまとめ
https://www.karada-good.net/analyticsr/r-110/


カラーパレットの紹介

左から”宿海仁太”, “本間芽衣子”, “安城鳴子”, “久川鉄道”, “松雪集”, “鶴見知利子”の順です。

anohana

カラーテーブルの紹介

Rでは統計解析や画像の出力以外に、このようなテーブルも作成できます。ぐりぐり動きますのでいじってみてください。

モバイルの方はこちらからご覧いただくと見やすいです。
別ウィンドウで開く


作成コマンドの紹介

詳細はコメントを確認ください。

#パッケージの読み込み
library("tcltk")
library("png")
library("jpeg")
library("colorspace")

#読み込みフォルダを選択
FoldPath <- paste(as.character(tkchooseDirectory(title = "&#35501;&#12415;&#36796;&#12415;&#12501;&#12457;&#12523;&#12480;&#12434;&#36984;&#25246;"), sep = "", collapse =""))

#&#12501;&#12457;&#12523;&#12480;&#20869;&#12398;&#12450;&#12452;&#12486;&#12512;&#12434;&#21462;&#24471;
ItemList <- list.files(path = FoldPath)

#&#12461;&#12515;&#12521;&#21517;&#12434;&#35373;&#23450;
CharaName <- c("&#23487;&#28023;&#20161;&#22826;", "&#26412;&#38291;&#33469;&#34915;&#23376;", "&#23433;&#22478;&#40180;&#23376;", "&#20037;&#24029;&#37444;&#36947;", "&#26494;&#38634;&#38598;", "&#40372;&#35211;&#30693;&#21033;&#23376;")

###S:&#12501;&#12457;&#12523;&#12480;&#20869;&#12398;&#20840;&#30011;&#20687;&#12363;&#12425;&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;&#12434;&#21462;&#24471;#####
#&#12487;&#12540;&#12479;&#26684;&#32013;&#29992;&#12398;&#22793;&#25968;&#12434;&#21021;&#26399;&#21270;
MasterRGBCol <- NULL

#&#12450;&#12452;&#12486;&#12512;&#25968;&#12398;&#21462;&#24471;
ItemVol <- length(ItemList)

for(i in seq(ItemVol)){
  
  #Image&#12501;&#12449;&#12452;&#12523;&#12398;&#35501;&#12415;&#36796;&#12415;
  selectAImage <- paste(FoldPath, "/", ItemList[i],
                        sep = "", collapse = "")
  
  #jpeg/png/gif&#12501;&#12449;&#12452;&#12523;&#12398;&#21028;&#26029;
  if (unlist(strsplit(ItemList[i], "\\."))[2] == "png"){
    
    Image <- readPNG(selectAImage)
    LABCol <- as(RGB(as.vector(Image[,, 1]), as.vector(Image[,, 2]), as.vector(Image[,, 3])), "LAB")
    RGBCol <- cbind(LABCol@coords[,1:3], hex(LABCol))
    
  }else{
    
    Image <- readJPEG(selectAImage, native = FALSE)
    LABCol <- as(RGB(as.vector(Image[,, 1]), as.vector(Image[,, 2]), as.vector(Image[,, 3])), "LAB")
    RGBCol <- cbind(LABCol@coords[,1:3], hex(LABCol))
    
  }
  
  #&#12510;&#12473;&#12479;&#12540;&#12487;&#12540;&#12479;&#12398;&#12487;&#12540;&#12479;&#12501;&#12524;&#12540;&#12512;&#21270;
  RGBCol <- as.data.frame(RGBCol)
  
  #&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;&#12434;&#25991;&#23383;&#21015;&#21270;
  RGBCol[, 4] <- as.character(RGBCol[, 4])
  
  #&#36879;&#26126;&#12434;&#21066;&#38500;
  RGBCol <- RGBCol[RGBCol[, 4] != "#000000",]
  
  #&#30011;&#20687;&#12391;&#20351;&#29992;&#12373;&#12428;&#12390;&#12356;&#12427;&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;&#12434;&#38598;&#35336;
  CountColor <- as.data.frame(table(RGBCol[, 4]))
  
  
  #&#38598;&#35336;&#12487;&#12540;&#12479;&#12434;&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;&#12391;&#20006;&#12403;&#26367;&#12360;
  CountColor <- CountColor[order(CountColor[, 1], decreasing = TRUE), ]
  #head(CountColor)
  
  #&#12510;&#12473;&#12479;&#12540;&#12487;&#12540;&#12479;&#12398;&#37325;&#35079;&#12434;&#21066;&#38500;
  RGBCol <- RGBCol[!duplicated(RGBCol[, 4]),]
  
  #&#12510;&#12473;&#12479;&#12540;&#12487;&#12540;&#12479;&#12434;&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;&#12391;&#20006;&#12403;&#26367;&#12360;
  RGBCol <- RGBCol[order(RGBCol[, 4], decreasing = TRUE),]
  
  #&#12461;&#12515;&#12521;&#21517;&#12392;&#32080;&#21512;
  RGBCol <- cbind(i, CharaName[i], RGBCol, CountColor[, 2])
  
  #&#12503;&#12525;&#12483;&#12488;&#12487;&#12540;&#12479;&#12398;&#20316;&#25104;
  MasterRGBCol <- rbind(MasterRGBCol, RGBCol)
  
  #&#24517;&#35201;&#12398;&#12394;&#12356;Image,LABCol,RGBCol&#12398;&#21066;&#38500;
  rm(Image,LABCol,RGBCol)
  
}

#&#34892;&#21517;&#12398;&#20184;&#19982;
colnames(MasterRGBCol) <- c("NO", "&#12461;&#12515;&#12521;", "&#26126;&#24230;:l", "&#35036;&#33394;&#27425;&#20803;:a", "&#35036;&#33394;&#27425;&#20803;:b", "&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;", "&#20986;&#29694;&#25968;")

###&#12487;&#12540;&#12479;&#12398;&#12503;&#12525;&#12483;&#12488;#####
#&#36600;&#12398;&#35373;&#23450;
xRange <- seq(0, 1, by = 1/ItemVol)

#&#12464;&#12521;&#12501;&#24133;&#12398;&#35373;&#23450;
xWidth <- seq(1/ItemVol, 1, by = 1/ItemVol)

#&#12503;&#12525;&#12483;&#12488;&#38936;&#22495;&#12398;&#20316;&#25104;
par(bg = "#2E2E2E")
plot(0:1, 0:1, type = "n", axes = FALSE, xlab = "", ylab = "")

#&#12486;&#12540;&#12502;&#12523;&#20316;&#25104;&#29992;&#12398;&#12487;&#12540;&#12479;&#26684;&#32013;&#29992;&#22793;&#25968;
TableDrowData <- NULL

for(k in seq(ItemVol)){
  
  #&#12487;&#12540;&#12479;&#12398;&#25277;&#20986;
  Plot <- subset(MasterRGBCol, MasterRGBCol[, 2] == CharaName[k])
  
  #&#20986;&#29694;&#25968;&#12391;&#20006;&#12403;&#26367;&#12360;&#12390;TOP20&#12434;&#25277;&#20986;
  Plot <- Plot[order(as.vector(Plot[, 7]), decreasing = TRUE),]
  Plot <- head(Plot, n = 20)
  
  #&#26126;&#24230;&#12391;&#20006;&#12403;&#26367;&#12360;
  Plot <- Plot[order(as.vector(Plot[, 3]), decreasing = TRUE),]
  
  #&#12486;&#12540;&#12502;&#12523;&#20316;&#25104;&#29992;&#12487;&#12540;&#12479;
  TableDrowData <- rbind(TableDrowData, Plot[, c(1, 2, 6, 7)])
  
  #&#12487;&#12540;&#12479;&#12398;&#12503;&#12525;&#12483;&#12488;
  rasterImage(as.raster(Plot[, 6]),
              xRange[k], 0, xWidth[k], 1, interpolate = FALSE)
  
}

#&#33394;&#20184;&#12365;Java&#12486;&#12540;&#12502;&#12523;&#12398;&#20316;&#25104;
#&#12497;&#12483;&#12465;&#12540;&#12472;&#12398;&#35501;&#12415;&#36796;&#12415;
library("DT")

#HTML&#12501;&#12449;&#12452;&#12523;&#12398;&#20445;&#23384;&#22580;&#25152;&#12434;&#25351;&#23450;
setwd(paste(as.character(tkchooseDirectory(title = "&#20445;&#23384;&#22580;&#25152;&#12434;&#36984;&#25246;"), sep = "", collapse ="")))

#&#12486;&#12540;&#12502;&#12523;&#12398;&#20316;&#25104;
DataTable <- datatable(TableDrowData, rownames = FALSE, options = list(pageLength = 10, lengthMenu = c(5, 20, 40, 120)),
                       caption = '&#12354;&#12398;&#33457; &#12459;&#12521;&#12540;&#12497;&#12524;&#12483;&#12488;', escape = FALSE)

#&#12461;&#12515;&#12521;&#21517;&#12398;&#12475;&#12523;&#12398;&#33394;&#12434;&#12497;&#12452;&#12503;"%>%"&#12391;&#12388;&#12394;&#12370;&#12390;formatStyle&#12391;&#35373;&#23450;&#12375;&#12414;&#12377;
DataTable <- DataTable %>% formatStyle('&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;',
                                       backgroundColor = styleEqual(TableDrowData[, 3], TableDrowData[, 3]))
#&#20316;&#25104;&#12486;&#12540;&#12502;&#12523;&#12434;html&#12391;&#20986;&#21147;
saveWidget(DataTable, 'DataTable.html')

少しでも、あなたのアニメライフが充実し、ウェブや実験の解析が楽になりますように!!

タイトルとURLをコピーしました