R MarkdownでBootstrapの画像スライド(carousel)を実装 #R

タイトルのまんまです。

carouselとは

要するにWebページ内にスライドショーを埋め込んだものです。画像が横にスライドしていくのとか，見たことあると思います。アレです。具体的にはBootstrapのサイトにある以下を参照してください:

R Markdownへの実装

基本コンセプト

まず，これを実装するためにはBootstrapが組み込まれている必要があるのですが，R Markdownのhtml_document形式なら標準で組み込まれています。なので追加で加える必要はありません。なので，あとは必要なhtmlコードを生成するだけです。

どのようなhtmlコードが必要化については，先述したBootstrapのサイトを参照してください。シンプルに見えて結構ややこしいです。なのでMarkdown記法でどうにかするのはまず無理です。なのでhtmltoolsパッケージを利用し，必要なタグを生成するような関数を作ることとしました。

実装した関数

以下のとおりです:

library(htmltools)

carousel <- function(id, img, caption_title = NULL, caption_text, interval = "5000", pause = "hover", wrap = TRUE, keyboard = TRUE){
  # args check
  if(missing(caption_title)){
    caption_title <- character(length(img))
  }
  if(missing(caption_text)){
    caption_text <-  character(length(img))
  }
  if(wrap){
    wrap <- "true"
  }else{
    wrap <- "false"
  }
  if(keyboard){
    keyboard <- "true"
  }else{
    keyboard <- "false"
  }


  # make Indicators
  li_active <- tags$li('data-target'=paste0('#', id), 'data-slide-to'=as.character(0), class="active")
  li_others <- mapply(tags$li,
                      'data-target'=paste0('#', id), 'data-slide-to'=as.character(1:(length(img)-1)),
                      SIMPLIFY = FALSE, USE.NAMES = FALSE)
  indi <- tags$ol(li_active, li_others, class="carousel-indicators")

  # make carousel-inner
  item_active <- tags$div(class="item active",
    tags$img(src=img[1], alt=""),
    tags$div(class="carousel-caption",
             tags$h3(caption_title[1]),
             tags$p(caption_text[1])
             )
  )
  item_img <- mapply(tags$img, 
                      src=img[2:length(img)], alt="",
                      SIMPLIFY = FALSE, USE.NAMES = FALSE)
  item_caption_title <- mapply(tags$h3,
                                 caption_title[2:length(caption_title)], 
                                 SIMPLIFY = FALSE, USE.NAMES = FALSE)
  item_caption_text <- mapply(tags$p,
                              caption_text[2:length(caption_text)],
                              SIMPLIFY = FALSE, USE.NAMES = FALSE)
  item_caption <- mapply(tags$div,
                         class="carousel-caption",
                         item_caption_title, item_caption_text,
                         SIMPLIFY = FALSE, USE.NAMES = FALSE)
  item_others <- mapply(tags$div,
                        class="item", item_img, item_caption,
                        SIMPLIFY = FALSE, USE.NAMES = FALSE)
  item <- tags$div(item_active, item_others, class="carousel-inner", role="listbox")

  # make control
  left_ctrl <- tags$a(class = "left carousel-control", href=paste0('#', id), role="button", 'data-slide'="prev",
                      span(class="glyphicon glyphicon-chevron-left", 'aria-hidden'="true"),
                      span(class="sr-only", "Previous")
                      )
  right_ctrl <- tags$a(class = "right carousel-control", href=paste0('#', id), role="button", 'data-slide'="next",
                      span(class="glyphicon glyphicon-chevron-right", 'aria-hidden'="true"),
                      span(class="sr-only", "Next")
                      )

  # make carousel
  ca <- tags$div(indi, item, left_ctrl, right_ctrl, id=id, class="carousel slide", 'data-ride'="carousel", 
           'data-interval'=interval, 'data-pause'= pause, 'data-wrap' = wrap, 'data-keyboard' = keyboard)
  tagList(ca)
}

これでOKです。画像を準備し，Rチャンク内でこの関数を組み込めば出力してくれるようになります。なお面倒なので，この関数はkazutan/zousanパッケージに組み込みました。GitHubに置いていますので，試してみたいという方はインストールして使ってみてください:

# install
githubinstall::githubinstall("zousan")
# devtoolsを使う場合は以下を
# devtools::install_github("kazutan/zousan")

実装テスト

これを確認するには実際にR Markdownで作成したhtmlドキュメントである必要があるので，別途以下のページに準備しました:

ぜひ内容を確認してみてください。簡単にスライドショーを作成できました。

書式設定について

生成物はhtmlタグなので，基本cssで設定していくことになります。生成されるhtmlタグは以下のような感じです:

carousel(id = "carousel4", img = df$imgs, caption_title = df$titles, caption_text = df$texts) %>% 
  as.character() %>% cat()

あとこれを参考にcssを当てていけば大丈夫だと思います。

雑感

なんでこんなのを作ろうと思ったんでしょうね。自分でもよくわかりません。まあ楽しかったからいいです。細かい解説が必要な場合はコメントあるいはTwitterで直接お問い合わせください。

Enjoy!