この記事はR Shiny Advent Calendar 2017の23日目の記事です！

このアカウントがかっこいい

designseeds

このようなカラーチャートのことをPANTONEというらしいです。

画像からPANTONEをつくりたい

以下を実現するwebアプリケーションを作ってみたくなりました。

入力：画像ファイル
出力：素敵なPANTONE

画像からカラーコードを取得するパッケージはいくつかありますが、今回はRImagePalette packageを使います！

画像から色を抽出する手法の中で、median cut algorithmをRで実装したパッケージです。

イメージ

詳細

画像ファイルアップロード

以前の記事shinyをjQueryで拡張するでご紹介した方法を使って、画像の指定方法を３つ用意します。

イメージ(画質)

pic.twitter.com/IxZlWF8NUX
— sasaki_K_sasaki (@sasaki_K_sasaki) 2017年12月23日

１．「By upload」

一般的なファイルアップロード機能で、クリックするとフォルダが開いてファイルを選ぶ形式

２．「By URL」

画像があるページのURLを入力して、その画面をキャプチャする形式

３．「D&D」(ドラッグ&ドロップ)

ドラッグ&ドロップで画像をアップロードする形式

それぞれ見た目を整えるために、元のmaterial_file_input()やfileInput()関数の一部を書き換えています。
書き換えた関数をglobal.Rの中で定義すれば、元のパッケージに縛られないinputが作れるようになります！

例)fileInput()

fileInput_before.R

fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
                      width = NULL, buttonLabel = "Browse...", placeholder = "No file selected") {
  
  restoredValue <- restoreInput(id = inputId, default = NULL)
  
  # Catch potential edge case - ensure that it's either NULL or a data frame.
  if (!is.null(restoredValue) && !is.data.frame(restoredValue)) {
    warning("Restored value for ", inputId, " has incorrect format.")
    restoredValue <- NULL
  }
  
  if (!is.null(restoredValue)) {
    restoredValue <- toJSON(restoredValue, strict_atomic = FALSE)
  }
  
  inputTag <- tags$input(
    id = inputId,
    name = inputId,
    type = "file",
    style = "display: none;",
    `data-restore` = restoredValue
  )
  
  if (multiple)
    inputTag$attribs$multiple <- "multiple"
  if (length(accept) > 0)
    inputTag$attribs$accept <- paste(accept, collapse=',')
  
  
  div(class = "form-group shiny-input-container",
      style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
      label %AND% tags$label(label),
      
      div(class = "input-group",
          tags$label(class = "input-group-btn",
                     span(class = "btn btn-default btn-file",
                          buttonLabel,
                          inputTag
                     )
          ),
          tags$input(type = "text", class = "form-control",
                     placeholder = placeholder, readonly = "readonly"
          )
      ),
      
      tags$div(
        id=paste(inputId, "_progress", sep=""),
        class="progress progress-striped active shiny-file-input-progress",
        tags$div(class="progress-bar")
      )
  )
}

↓↓↓ 一部変更

fileInput_Changed.R

fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
                      width = NULL, buttonLabel = "Browse...", placeholder = "No file selected") {
  
  restoredValue <- restoreInput(id = inputId, default = NULL)
  
  # Catch potential edge case - ensure that it's either NULL or a data frame.
  if (!is.null(restoredValue) && !is.data.frame(restoredValue)) {
    warning("Restored value for ", inputId, " has incorrect format.")
    restoredValue <- NULL
  }
  
  if (!is.null(restoredValue)) {
    restoredValue <- toJSON(restoredValue, strict_atomic = FALSE)
  }
  
  inputTag <- tags$input(
    id = inputId,
    name = inputId,
    type = "file",
    style = "display: none;",
    `data-restore` = restoredValue
  )
  
  if (multiple)
    inputTag$attribs$multiple <- "multiple"
  if (length(accept) > 0)
    inputTag$attribs$accept <- paste(accept, collapse=',')
  
  
  div(class = "form-group shiny-input-container",
      style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
      
      div(class = "input-group",
          tags$label(class = "input-group-btn",
                     inputTag
          ),
          tags$span(class = "form-placeholder",  placeholder) ,
          tags$input(type = "text", class = "form-control",
                     readonly = "readonly"
          )
      )
  )
}

カラーコード抽出

RImagePaletteの、image_palette()を使います。以下、一部抜粋

server.R

 yout_image <- readJPEG(input_file_path)
 palette <- image_palette(your_image, n = n_row, choice = choice)

your_image：アップロードされた画像ファイル
n ：抽出する色の数
choice：色抽出に用いる要約統計量

カラーコード可視化

ggplot2のbar chartを使ってPANTONEを作ります。以下、一部抜粋

server.R


df <- data.frame(X = seq( 1 : n_row ),
                       Y = rep( 10, n_row) )
      
pantone <- ggplot(df,
                  aes(x = X, 
                      y = Y, 
                      fill = factor(X))
                      ) + 
            geom_bar(stat = "identity", width = 0.8) +
            coord_flip() +
            scale_fill_manual(values = palette) +
            theme_void() + 
            theme(legend.position="none")

bar以外を全て排除して、シンプルに作図しています。

イメージ

#　結果

イメージ(画質)

pic.twitter.com/N8Br1jxuk1
— sasaki_K_sasaki (@sasaki_K_sasaki) 2017年12月23日

なんとなくはできたけど、そこまで素敵にはできませんでした！！
ファイルのアップロードにこだわりすぎて、色の抽出精度などに手が回っていません‥

コードはgithubにあります。
demoは以下のコードで実行できると思います。よろしければ試してみてください！

console.R

library(shiny)

runGitHub(repo = "ColorPaletteMaker", username = "sasakiK" )

Np_Ur_さんにバトンをもどします！
明日明後日よろしくお願いいたします！

参考

メディアンカット法による画像の減色
 Package ‘RImagePalette’
Rで解析：画像ファイルからカラーパレットを作成！「RImagePalette」パッケージ