WEEKEND ECONOMIST

Shiny: Output UI のループ

同じようなUIがたくさんあって、処理にも法則性がある場合に、UIのループを作成したくなることがある。
たとえば、グラフが10個あって、それぞれに対応するパラメータを選択するUIがあるとする。
グラフのIDが "fig1", "fig2", ..., パラメータUIのIDが "para1", "para2", ... と定義されているなら、同じコードを10回記述せずにループを利用した簡略なコードを書きたくなる。

Shinyでこれをするのは少し難しい。理由は、Shinyは常に変数の更新を監視し、結果を反映し続けているので、注意してコードを書かないと、ループ変数の更新を思わぬ形で反映して、バグが生じてしまうからだ。

例として、3つのテキスト入力フォーム（"text1", "text2", "text3"）とテキスト出力（"out1", "out2", "out3"）をもつアプリを考える。 text1 の内容は out1に、 text2はout2に、・・・というように表示させたい（コード）。

UI部分はシンプルだ。

library(shiny)

ui <- list(
    textInput('text1', 'Text 1', value=''),
    textInput('text2', 'Text 2', value=''),
    textInput('text3', 'Text 3', value=''),
    hr(),
    textOutput('out1'),
    textOutput('out2'),
    textOutput('out3')
)

単純な方法は３つの対応関係をすべて書きくだすこと。これで良いのだけど、汎用性がない。

server1 <- function(input, output) {
    output$out1 <- renderText({ input$text1 })
    output$out2 <- renderText({ input$text2 })
    output$out3 <- renderText({ input$text3 })    
}
runApp(list(ui=ui, server=server1))

単純なループはうまくいかない。下の例だと、renderText内の命令を実行するする際に、最新の i の値が使われてしまう。そのため、すべての出力がtext3（最後の値なので）を参照するようになる。また、 "i <- 1" をアンコメントすると、すべてtext1を参照するようになる。

server2 <- function(input, output) {
    for (i in 1:3) {
        output[[paste('out', i, sep='')]] <- renderText({
            input[[paste('text', i, sep='')]]
        })
    }
    #i <- 1
}
runApp(list(ui=ui, server=server2))

つまり、 i のスコープが広すぎて、意図しないところまで値を探しにいってしまうのがバグの原因になっている。これを回避する１つの方法は、 lapply を利用して、 i のスコープを限定することだ。以下の例はうまくいく。

server3 <- function(input, output) {
    lapply(1:3, 
        function(i) { 
            output[[paste('out', i, sep='')]] <- renderText({ 
                input[[paste('text', i, sep='')]] 
            }) 
        }
    )
}
runApp(list(ui=ui, server=server3))

もしくは、local関数を利用して、その中で新しい変数をコピーすることで、外部での更新の影響を遮断する方法もある。

server4 <- function(input, output) {
    for (i in 1:3) { local({
        j <- i
        output[[paste('out', j, sep='')]] <- renderText({
            input[[paste('text', j, sep='')]]
        })
    }) }
}
runApp(list(ui=ui, server=server4))

全コードはこちら。参考：Stack Overflow

Shinyアプリ・Outputの値へのアクセス・変数のスコープ

Shinyアプリで、ログディスプレイのようなもののあるページをつくろうと考えた。
画面上の操作に応じてテキストが徐々に追加されているような仕組みだが、思いの外難しかった。

模式的には、下の画像のようなものを想定している。入力フォームに記入してOKボタンを押すと、その文が画面に追加されていくという構造だ（コード）。

これが少し難しくなる理由は大きく２つある。
（１）outputに属する部品の値を取得することができない
（２）処理が関数や表現の内部で起こっているため、通常は変数は共有されない

まずはuiを作成する。入力フォーム、OKボタンと表示エリアだけの簡単な作りになっている。

library(shiny)
ui <- list(
   textInput('line', 'Type a line here.'),
   actionButton('insert', 'OK'),
   p(strong('Your sentenses will be displayed below')),
   verbatimTextOutput('display')        
)

次のようなserverを考える。OKボタンに反応するobserverを用意して、ボタンが押され時に、ディスプレイの文字列に入力された文字列を結合しようとしている。
ところが、起動してみると次のようなエラーが発生する：Reading objects from shinyoutput object not allowed. どうやら、直接outputの値にアクセスすることができない仕組みになっているらしい。

server1 <- function(input, output, session) {
    observeEvent(input$insert,
        { 
          output$display <- renderText({ 
              paste(output$display, input$line, sep='\n') 
          })
          updateTextInput(session, 'line', value='') 
        }
    )
}
runApp(list(ui=ui, server=server1))

そこで、今度は裏側に変数を用意して、そこにディスプレイと同じ文字列を格納しておくことを考える。次のようなserverになる。
今度はエラーは出ないが、ディスプレイに文字列が追加されていかず、その都度最新の値に置き換えられてしまう。原因は、observeEvent内で文字列Dの値を更新する際に、実はもとのDとは異なる文字列が生成されてしまっていて、その新しい変数のスコープが当該expression内に限られていることだ。そのため、新しく定義したDは毎回破棄され、もともとのDは手付かずのままになる。

server2 <- function(input, output, session) {
    D <- character(0)
    output$display <- renderText({ D })
    observeEvent(input$insert,
        { 
          D <- c(D, input$line)
          updateTextInput(session, 'line', value='') 
          output$display <- renderText({ paste(D, collapse='\n') })
        }
    )
}
runApp(list(ui=ui, server=server2))

スコープが問題、ということなので今度は文字列変数の代わりにR6クラスオブジェクトを作成し、そこにディスプレイの値を格納することを考える。R6クラスオブジェクトへの更新が参照扱いになることを利用するわけだ（参照：R6パッケージの解説）。
以下がその例で、これがうまくいく。Docクラスは、文字列変数をもつだけの単純なクラスでこれをServer処理のなかで定義する。observeEventからDへアクセスする際には、もとのオブジェクトを参照しているので、値の更新が保持される仕組みだ。

library(R6)
Doc <- R6Class('document',
    public=list(
    text = character(0),
    initialize = function(init=character(0)) 
        { self$text <- init }
    )
)

server3 <- function(input, output, session) {
    D <- Doc$new()  

    output$display <- renderText({ paste(D$text, collapse='\n') })
    observeEvent(input$insert,
        { 
          D$text <- c(D$text, input$line)
          updateTextInput(session, 'line', value='') 
          output$display <- renderText({ paste(D$text, collapse='\n') })
        }
    )
}
runApp(list(ui=ui, server=server3))

上のコードで、renderText の処理が observeEvent 内にあるのは重要で、外側に配置してしまうと、ディスプレイの値が変化していかない。裏側でDオブジェクトの値は更新されるのだが、そのことをshinyの機能が認知しないため、いつまでたっても処理が開始されないのだ。下記がその例。

server4 <- function(input, output, session) {
    D <- Doc$new()  
    
    observeEvent(input$insert,
        { 
          D$text <- c(D$text, input$line)
          updateTextInput(session, 'line', value='') 
          print(D$text)
        }
    )

    output$display <- renderText({ paste(D$text, collapse='\n') })
}
runApp(list(ui=ui, server=server4))

renderText を外に配置する方法として、処理内でOKボタンへ言及する方法がある。すると、ボタンが押されるたびにそれに感応して処理が行われることになり、ディスプレイも更新される。下はその例でうまく動くようだが、タイミングの定義が曖昧なようにも思える。ふたつの処理がOKボタンに反応するようになっていて、どちらが先にくるかが明示されていない。observeEvent が優先される仕様なのか、単に運が良いだけなのかは分からない。

server5 <- function(input, output, session) {
    D <- Doc$new()  
    
    observeEvent(input$insert,
        { 
          D$text <- c(D$text, input$line)
          updateTextInput(session, 'line', value='') 
        }
    )

    output$display <- renderText({ 
        input$insert
        paste(D$text, collapse='\n') 
    })
}
runApp(list(ui=ui, server=server5))

つまり、R6クラスオブジェクトで値を管理することの弱点は、その値がShinyの監視下にないことだ。実は、Shinyに監視されるオブジェクトととして、reactivevalues クラスが定義されている。おそらく以下の書き方が一番「shinyらしい」。

server6 <- function(input, output, session) {
    V <- reactiveValues(text = character(0))

    observeEvent(input$insert,
        { 
          V$text <- c(V$text, input$line)
          updateTextInput(session, 'line', value='') 
        }
    )

    output$display <- renderText({
        paste(V$text, collapse='\n') 
    })
}
runApp(list(ui=ui, server=server6))

コードの全体はこちら。

R on Ubuntu: 'devtools' のインストール

Rのdevtoolsパッケージをインストールしようとしたところ、次のようなエラーがでた。

ERROR: dependencies ‘httr’, ‘RCurl’, ‘rversions’, ‘git2r’ are not available for package ‘devtools’

OSはlubuntu14.04. RのバージョンはR version 3.1.0 (2014-04-10).

ひとつめの原因は、libcurl というライブラリ（？）がインストールされていなかったことらしい（参照）。
そこで、コンソールから次のパッケージをインストールする。

sudo apt-get install libcurl4-gnutls-dev

しかるのち再度devtoolsインストールを試みるも、依存関係にあるgit2rパッケージのインストールで問題が残っているようだ。

checking for library containing SSL_library_init... no
configure: error: in `/tmp/RtmpymzMhG/R.INSTALL29921535f41e/git2r':
configure: error: OpenSSL library required
See `config.log' for more details
ERROR: configuration failed for package ‘git2r’
* removing ‘/home/kota/R/x86_64-pc-linux-gnu-library/3.1/git2r’
Warning in install.packages :
  installation of package ‘git2r’ had non-zero exit status
ERROR: dependency ‘git2r’ is not available for package ‘devtools’

こちらについては、libcrypto++とlibssl-devというライブラリが必要になるらしい（参照）。

sudo apt-get install libcrypto++ libssl-dev

ここまで設定すると、ようやくインストールに成功した。

install.packages('devtools')

R6 Class とオブジェクトの破棄

プログラム言語によっては、変数やオブジェクトが不要になったときには、kill や dispose などのメソッドを使って明示に破棄する必要があり（または推奨されていて）、これを怠るとメモリリークの原因となりパフォーマンスに影響する（らしい）。

Rでは、このあたりの管理はシステム任せでよくて、オブジェクトの破棄について気にする必要はない。ところが、最近 R6 という直感的にオブジェクト指向なコーディングを可能にするライブラリについて教えてもらい、自分自身も使い始めた。クラスインスタンスを生成したり参照したりしていたら、ふと「参照されなくなったオブジェクトはどう処理されているんだろう」と不安になった。まさか忘れられたインスタンス達が散乱しているのでは、という懸念だ。

答えは公式の導入ページに書いてあった。不要になった（参照されていない）クラスインスタンスは、通常通り自動的にごみ収集機能（Garbage Collection）によって破棄される。関数 gc() を呼べば強制的にごみ収集を発生させることができるが、gc() のヘルプによると不要らしい。

下のコードでは、ごみ収集の機能をテストしている。
A クラスは、数字ひとつを要素にもつクラスだ。公式の例を参考に、生成時に reg.finalizer() 関数を使ってインスタンスが破棄された時の動作を「登録」している。ここでは格納された数字を表示させることによってどのインスタンスが破棄されたのかが分かるようにしている。

3つのAクラスインスタンスからなるリストを生成して、rm() により破棄すると、３つ全てが不要になりごみ収集対象になる（この時、rm() の前に一度 gc()を施しておくことで、破棄の結果だけを切り離している。こうしないと、インスタンス生成時に発生したゴミがまだ残っていて、同時に破棄されることがある）。

同じように3つのAクラスインスタンスからなるリストを生成して、今度は3つのうち1つ目の要素だけ削除する（参照を外す）。すると、削除された要素だけがゴミとみなされる。さらに、要素のうちの1つを別の変数により参照してからもとのリストを削除すると、参照されているインスタンスはまだ使用中ということになるから、ゴミ収集対象にならない。

結論としては、ごみの選別はきっちりやってくれているらしいから、メモリの心配はあまりしなくてよさそうだ。

library(R6)

A <- R6Class('A',
    public = list(
        number=NA,
        initialize = function(number) {
            self$number <- number
            reg.finalizer(
                self,
                function(e) cat('Garbage collected! #', e$number, '\n'),
                onexit = TRUE
            )
        }
    )
)

a <- list(A$new(1), A$new(2), A$new(3))
gc()  # clean up the garbage created when initializing

# when the list is removed, all three instances are 'garbage'
rm(a)
gc()
#Garbage collected! # 3
#Garbage collected! # 2
#Garbage collected! # 1
#    used (Mb) gc trigger (Mb) max used  (Mb)
#Ncells 567894 30.4    1168576 62.5  1168576  62.5
#Vcells 821924  6.3    2994598 22.9 54470995 415.6


a <- list(A$new(1), A$new(2), A$new(3))
gc()
# remove the reference to the 1st element.
a <- a[-1]
gc()
#Garbage collected! # 1
#    used (Mb) gc trigger (Mb) max used  (Mb)
#Ncells 567896 30.4    1168576 62.5  1168576  62.5
#Vcells 821917  6.3    2994598 22.9 54470995 415.6

# let another variable refer to the first element
b <- a[[1]]
rm(a)
gc()
#Garbage collected! # 3 
#    used (Mb) gc trigger (Mb) max used  (Mb)
#Ncells 567879 30.4    1168576 62.5  1168576  62.5
#Vcells 821913  6.3    2994598 22.9 54470995 415.6

koding : オンライン開発環境でRを使う

koding はオンラインの開発環境で、ブラウザ上のエディタでコードを書いて、同じくブラウザ上の端末からコンパイルしたり走らせたりできる。

C++やPythonなどの主要な開発言語は初めからインストールされていて、すぐ使える。

Rはもともと入っていないのだが、手動で加えることができる。
というのも、実はこの端末が Ubuntu14.04 Trusty なのだ。
それを確認するには、端末で

lsb_release -d

とすればいい。

したがって、次のコマンドで、Ubuntuの公式レポジトリに入っているRをダウンロードすることができる。

sudo apt-get update
sudo apt-get install r-base-core

注意点１. install.packages を使うときは、repos=<cran mirror URL>を指定する。通常はreposを指定しない場合、ミラーサイトを選ぶポップアップが出るのだが、それが機能しないので、はじめから指定する。

> install.packages('nleqslv', repos='http://cran.md.tsukuba.ac.jp/')

注意点2. グラフを描画する方法を検討中・・・。少し難しい。回りくどいが、Kodingでは ~/Webディレクトリ以下がWeb上に公開されているので、その中に画像を保存してブラウザ上で見るという方法がある。

sharelatex：Latex文書をクラウド上で管理・編集・コンパイル

ほんの5年程前にはDropboxの便利さに驚愕したものだけど、いまやクラウドサービスは当然で、なるべくならすべてのファイルをウェブ上で管理したいとすら思う。もし、ファイルがあるPC上にのみ存在する場合、当然他の端末からは編集できない。メールやUSBドライブなどを介してファイルを移して、変更を加えて移動しなおして・・・というようなことは可能だけど手間だし、バージョン管理の問題も生じる。その点、DropboxはWebサーバーを介してファイル情報を同期してくれるから、どの端末にも常に同じファイルが存在することになる。端末Aで加えた変更は端末Bの同じ箇所に直ちに反映されるから、あたかも同じファイルを編集しているように感じる。

一方Google Driveでは、ローカルファイルへの動機を行わず、ファイルをWeb上にのみ保管する仕組みになっている。ファイルを使ったり編集するためにいちいちローカルに保存する必要はほとんどなくて、Web上のアプリで事足りることが多い。Microsoft Office 系の作業はGoogle Sheets/Docs/Slidesで代替可能だし、インターフェースやテンプレートの好みまで考えれば代替どころではないかもしれない。ただし共同作業の場合には互換性に対するケアが必要だ。音楽ファイルの再生にはdriveplayerを使えばよいから、MP3ファイルもすべてGoogle Driveに移した。

同じことがLatex編集にもできないか？　Texコードがクラウド上にあって、ウェブ上のエディタで編集でき、コンパイラがついている。できたらエディタの隣に文書のプレビューがついていて、もちろん最後にはPDFファイルをダウンロードできる。Sharelatexはそんなサービスだ。無料で使えてスペルチェックまでついている。自分の普段使うスタイルを試してみたところ、問題なく一発でコンパイルできた。

対抗馬のサービスとしては、overleaf, latexlab あたりが有名なようだが、総合的にはsharelatexが気に入っている。overleafは、無料版にはスペルチェックがついていないのが減点。あとインターフェイスが好みじゃなかった。LatexlabはGoogle Docと連動しているという点が魅力的だが、開発途中なのか動作が遅い。

Sharelatexのおかげで、どの端末上からでも同じTex文書を編集することができる。

avconv で音声抽出

参考：[avconv] mp3 にフォーマット変換

avconv -vn -i hoge.mp4 -f mp3 -b:a 64k hoge.mp3

avconv -vn -i hoge.mp4 -f mp3 -q:a 9 hoge.mp3

for file in *.[mM][pP]4; do avconv -y -vn -i "$file" -f mp3 -b:a 64k "${file%.*}.mp3"; done
for file in *.[mM][pP]4; do avconv -y -vn -i "$file" -f mp3 -q:a 9 "${file%.*}.mp3"; done

find -type f -name "*.mp4" -print0 | xargs -0 -n 1 -i avconv -y -vn -i {} -f mp3 -b:a 64k {}.mp3
find -type f -name "*.mp4" -print0 | xargs -0 -n 1 -i avconv -y -vn -i {} -f mp3 -q:a 9 {}.mp3

ggplot2（３）色付き等高線

ggplot2で色付き等高線グラフを描くには、geom_point() で大きめのマーカーを並べる方法と、geom_tile()で長方形を並べる方法の2通りがある。公式のマニュアルではgeom_tile()が紹介されているが、geom_point()の方が多少動作が軽いし、結果が安定する気がする。
東急目黒線沿いの賃料マップ（codeIQ Magazine参照）を再現した。

上がgeom_point(), 下がgeom_tile()で書いたものだが、見た目をそう変わらない。左のほうが全体に滲むような色合いなのに対し、右はタイルを敷き詰めているので白い線が見える。

library(ggplot2)
library(reshape2)
x <- read.csv('http://file.sweettips.take-uma.net/meguro1k.txt', 
              sep='\t', as.is=T)
z <- read.csv('http://file.sweettips.take-uma.net/meguro-station.txt', 
              sep='\t', as.is=T, header=F)

fit <- loess(rent ~ lon + lat, data=x, span=0.5)
gd <- 100
lon <- seq(min(x$lon), max(x$lon), length=gd)
lat <- seq(min(x$lat), max(x$lat), length=gd)
D <- expand.grid(lon=lon, lat=lat)
v <- melt(predict(fit, D), value.name='rent')
v$lon <- as.numeric(gsub('lon=', '', v$lon))
v$lat <- as.numeric(gsub('lat=', '', v$lat))

p <- ggplot(v, aes(lon, lat, z=rent)) 
p + geom_point(aes(col=rent), linetype='blank', size=5, shape=15) +
    stat_contour(bins=10, col='white', size=1.2) + 
    stat_contour(bins=10) +
    geom_line(data=z, aes(V4, V3, z=V3), size=2, col='lightgreen') + 
    geom_line(data=z, aes(V4, V3, z=V3), size=1.2, color='coral4') + 
    geom_text(data=z, aes(V4, V3, z=V3, label=V1), 
              size=5.12, col='white', fontface=2) + 
    geom_text(data=z, aes(V4, V3, z=V3, label=V1), 
              fontface=2, size=5) + 
    scale_colour_gradientn(colours=rich.colors(10))

p + geom_tile(aes(fill=rent)) + 
    stat_contour(bins=10, col='white', size=1.2) + 
    stat_contour(bins=10) + 
    geom_line(data=z, aes(V4, V3, z=V3), size=2, col='lightgreen') + 
    geom_line(data=z, aes(V4, V3, z=V3), size=1.2, color='coral4') + 
    geom_text(data=z, aes(V4, V3, z=V3, label=V1), 
              size=5.12, col='white', fontface=2) +
    geom_text(data=z, aes(V4, V3, z=V3, label=V1), 
              fontface=2, size=5) + 
    scale_fill_gradientn(colours=rich.colors(10))

線分と垂線との交点を計算する

わけあって、線分\(XY\)と点\(Z\)が与えられた時に、点\(Z\)から線分\(XY\)へ下ろした垂線との交点\(M\)の座標を計算しました。結論からいうと、 \(\alpha = \frac{(X-Y)\cdot(Z-Y) }{||X-Y||^2}\) として、 \(M = \alpha X + (1-\alpha) Y\) になるようです。 \(\alpha\) は、点\(Z\)が \(X, Y\) のどちらに相対的に近いかを表していて、\(Z\) が\(X\)に近いほど1に近づき、\(Y\)に近いほどゼロに近づくことが式から分かります。ほぼ１０年ぶりくらいにベクトル計算をしました。

\(M\)は線分\(XY\)上にあるから、\(M = \alpha X + (1-\alpha) Y\)と書ける。ベクトル\(MY\)と\(MZ\)が垂直であるので、その内積はゼロに等しい、つまり \begin{align*}
(M-Y) \cdot (M-Z) &= 0 \\
[ \alpha (X-Y) ] \cdot [ \alpha (X-Y) + (Y-Z)] &= 0 \end{align*}
ここで、 \( \cdot\) は内積を表す。これを解くと、 \begin{align*} \alpha^2 ||X-Y||^2 + \alpha (X-Y) \cdot (Y-Z) &= 0 \\ \alpha \left[ \alpha ||X-Y||^2 - (X-Y) \cdot (Z-Y) \right] &= 0 \end{align*}
ここで、 \(||\;\;||\) はユークリッドノルム。
\(\alpha=0\) は、\(MY\) がゼロベクトルになることで内積をゼロにするので、題意に合わない。よって \(\alpha = \frac{(X-Y)\cdot(Z-Y) }{||X-Y||^2}\).

Python: オブジェクトのタイプを判定する

type() 関数や、isinstance()関数を使えばよい。

l = []
d = {}
t = ()
type(l), type(d), type(t)
isinstance(l, list), isinstance(l, dict), isinstance(l, tuple)
isinstance(d, list), isinstance(d, dict), isinstance(d, tuple)
isinstance(t, list), isinstance(t, dict), isinstance(t, tuple)

Output:

<type 'list'> <type 'dict'> <type 'tuple'>
True False False
False True False
False False True

クラスのインスタンスの場合、type()は"instance"と判別されるが、isinstance()は上と同様に機能するようだ。

class Hoge:
    def __init__(self):
        pass
h = Hoge()
type(h)
isinstance(h, Hoge)

Output:

<type 'instance'>
True