1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

R ShinyAdvent Calendar 2017

Day 23

画像から素敵なカラーパレットをつくりたい

Last updated at Posted at 2017-12-23

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

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

スクリーンショット 2017-12-14 午後5.07.18.png

designseeds

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

画像からPANTONEをつくりたい

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

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

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

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

イメージ

image.png

詳細

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

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

イメージ(画質)

1.「By upload」

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

2.「By URL」

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

3.「D&D」(ドラッグ&ドロップ)

ドラッグ&ドロップで画像をアップロードする形式
スクリーンショット 2017-12-23 午前10.04.45(2).png

それぞれ見た目を整えるために、元の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以外を全て排除して、シンプルに作図しています。

イメージ
palette_sample.png

# 結果

イメージ(画質)

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

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

console.R
library(shiny)

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

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

参考

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

1
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?