Rでお遊び:シャーロット第1話「我 他人を 思う」から10シーンの色使い

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

アニメ「シャーロット」第1話、期待通りの内容でした。どのように物語と登場人物の超能力が絡んでいくのかが注目です。また、「星」がキーワードとして出現していましたが何と関係してくるのでしょうか。

非常に話の展開がよく、ストレスなく見ることができるアニメかと思います。ダンまちに続き見ていこうと思います。

早速ではありますが、個人的に印象に残った「10シーン」の色使いを解析してみました。アニメで使用されている色使いは資料作成に役に立つことが多いです。

解析結果は各場面の使用頻度TOP500色のプロットと各場面の使用頻度TOP20のカラーコードをテーブルで紹介します。

紹介コードはR version 3.2.0で動作を確認しています。

スポンサーリンク

解析に使用した10シーン

解析画像

結果

coneCol

・各場面の使用頻度TOP500色のプロット
左からシーン1〜10です。

・各場面の使用頻度TOP20のカラーコードのテーブル
モバイルの方はこちらからご覧いただくと見やすいです。
別ウィンドウで開く


実行コマンドの紹介

下記コマンドを実行してください。詳細はコメントを確認してください。

#パッケージのインストール
#install.packages(c("png", "jpeg", "colorspace", "DT"))

#パッケージの読み込み
library("tcltk")
library("png")
library("jpeg")
library("progress")
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)

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

#&#12503;&#12525;&#12464;&#12524;&#12473;&#12496;&#12540;&#12398;&#35373;&#23450;
pb <- progress_bar$new(format = "  &#20966;&#29702;&#29366;&#27841; [:bar] :percent",
                          total = ItemVol, clear = FALSE, width= 60)

for(i in seq(ItemVol)){
  #&#12503;&#12525;&#12464;&#12524;&#12473;&#12496;&#12540;&#12398;&#34920;&#31034;
  pb$tick()
  
  #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)
  
  #&#29305;&#23450;&#12398;&#33394;&#12434;&#21066;&#38500;&#12290;&#30333;&#33394;&#12434;&#21066;&#38500;
  RGBCol <- subset(RGBCol, RGBCol[, 4] != "#FFFFFF")
  
  #&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;&#12434;&#25991;&#23383;&#21015;&#21270;
  RGBCol[, 4] <- as.character(RGBCol[, 4])
  
  #&#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), ]
  
  #&#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),]
  
  #&#32080;&#21512;
  RGBCol <- cbind(formatC(i, width = 2, flag = "0"), ItemList[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", "&#12501;&#12449;&#12452;&#12523;&#21517;", "&#26126;&#24230;:l", "&#35036;&#33394;&#27425;&#20803;:a", "&#35036;&#33394;&#27425;&#20803;:b", "&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;", "&#20986;&#29694;&#25968;")

#&#12501;&#12449;&#12452;&#12523;&#12398;&#20445;&#23384;&#12289;&#35299;&#26512;&#30011;&#20687;&#25968;&#12395;&#12424;&#12387;&#12390;&#12399;&#12501;&#12449;&#12452;&#12523;&#12469;&#12452;&#12474;&#12364;&#38750;&#24120;&#12395;&#22823;&#12365;&#12356;&#22580;&#21512;&#12364;&#12354;&#12426;&#12414;&#12377;
#&#12414;&#12383;&#12289;&#12456;&#12463;&#12475;&#12523;&#12394;&#12393;&#12391;&#35501;&#12415;&#36796;&#12417;&#12394;&#12356;&#12371;&#12392;&#12364;&#12354;&#12427;&#12398;&#12391;&#12467;&#12513;&#12531;&#12488;&#12450;&#12454;&#12488;&#12375;&#12390;&#12356;&#12414;&#12377;&#12290;
#setwd(paste(as.character(tkchooseDirectory(title = "&#20445;&#23384;&#22580;&#25152;&#12434;&#36984;&#25246;"), sep = "", collapse ="")))
#write.csv(MasterRGBCol, "&#20998;&#26512;&#32080;&#26524;.csv", fileEncoding = "CP932", eol = "\r\n")
###E:&#12501;&#12457;&#12523;&#12480;&#20869;&#12398;&#20840;&#30011;&#20687;&#12363;&#12425;&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;&#12434;&#21462;&#24471;#####


###&#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:max(c(xRange, xWidth)), 0:max(c(xRange, xWidth)), type = "n", axes = FALSE, xlab = "", ylab = "")
plot(0:1, 0:1, type = "n", axes = FALSE, xlab = "", ylab = "")
box()

#&#12503;&#12525;&#12464;&#12524;&#12473;&#12496;&#12540;&#12398;&#35373;&#23450;
pb <- progress_bar$new(format = "  &#20966;&#29702;&#29366;&#27841; [:bar] :percent",
                          total = length(ItemVol), clear = FALSE, width= 60)

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

for(k in seq(ItemVol)){
  #&#12503;&#12525;&#12464;&#12524;&#12473;&#12496;&#12540;&#12398;&#34920;&#31034;
  pb$tick()
  
  #&#12487;&#12540;&#12479;&#12398;&#25277;&#20986;
  Plot <- subset(MasterRGBCol, MasterRGBCol[, 2] == ItemList[k])
  
  #&#20986;&#29694;&#25968;&#12391;&#20006;&#12403;&#26367;&#12360;&#12390;TOP500&#12434;&#25277;&#20986;
  Plot <- Plot[order(as.vector(Plot[, 7]), decreasing = TRUE),]
  Plot <- head(Plot, n = 500)
  
  #&#12503;&#12525;&#12483;&#12488;&#20869;&#23481;&#12398;&#25351;&#23450;
  #&#26126;&#24230;&#12391;&#20006;&#12403;&#26367;&#12360;
  #&#34892;&#30058;&#21495;&#12434;&#25351;&#23450;&#12377;&#12427;&#12371;&#12392;&#12391;&#20006;&#12403;&#26367;&#12360;&#12398;&#22522;&#28310;&#12434;&#22793;&#26356;&#12391;&#12365;&#12414;&#12377;
  #3&#34892;&#30446;"&#26126;&#24230;:l", 4&#34892;&#30446;"&#35036;&#33394;&#27425;&#20803;:a", 5&#34892;&#30446;"&#35036;&#33394;&#27425;&#20803;:b", 6&#34892;&#30446;"&#12459;&#12521;&#12540;&#12467;&#12540;&#12489;"
  Plot <- Plot[order(as.vector(Plot[, 6]), decreasing = TRUE),]
  
  #&#12486;&#12540;&#12502;&#12523;&#20316;&#25104;&#29992;&#12487;&#12540;&#12479;
  TableDrowData <- rbind(TableDrowData, head(Plot[, c(1, 6, 7)], n = 20))
  
  #&#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;&#20869;&#23481;&#12434;&#26119;&#38918;&#12391;&#20006;&#12403;&#26367;&#12360;
TableDrowData <- TableDrowData[order(as.vector(TableDrowData[, 1]), decreasing = FALSE),]

#&#12486;&#12540;&#12502;&#12523;&#12398;&#20316;&#25104;
DataTable <- datatable(TableDrowData, rownames = FALSE, options = list(pageLength = 10, lengthMenu = c(20, 40, 100, 200)),
                          caption = '&#12471;&#12515;&#12540;&#12525;&#12483;&#12488; 1&#35441; &#12459;&#12521;&#12540;&#12497;&#12524;&#12483;&#12488;', escape = FALSE)

#&#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[, 2], TableDrowData[, 2]))
#&#20316;&#25104;&#12486;&#12540;&#12502;&#12523;&#12434;html&#12391;&#20986;&#21147;
saveWidget(DataTable, 'DataTable.html')

少しでも、あなたのアニメ生活が充実しますように!!

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