前回の補足: server.R in “app_hoge2”

total_msg <- append(total_msg, input$msg)
total_msg2 <- "hogehoge0"
total_msg2  <- append(total_msg2,  "hogehoge1")
total_msg2 <- append(total_msg2, "hogehoge2")
total_msg2
[1] "hogehoge0" "hogehoge1" "hogehoge2"

Scope:shared variable

total_msg <<- append(total_msg, input$msg)

Rスクリプトファイル”utils3.R”の読み込み

source("utils3.R")

“univ”ディレクト内テキストの頻度行列

univMtx<- getFreqDir("univ")
univNames <- colnames(univMtx)
univMtx[1:3,]

6列目(osaka4)の情報を抽出

要素の名前がすでに分かっている場合

cUniv <- univMtx$osaka4
head(cUniv)

要素のインデックスがすでに分かっている場合

cUniv <- univMtx[6]
head(cUniv)

要素の名前からインデックスを探す場合(which関数の適用)

indexNum <- which(colnames(univMtx)== "osaka4")
indexNum
[1] 6
cUniv <- univMtx[indexNum]
head(cUniv)

0以上の情報を抽出

cUniv <-cUniv[cUniv>0]
#cf. cUniv[cUniv!=0]

頻度順に並べ替え & 上位15語を抽出

orderLst <- order(cUniv, decreasing = TRUE)
cUnivFreq <- cUniv[orderLst][1:15]
names(cUnivFreq) <- rownames(univMtx)[orderLst][1:15]
head(cUnivFreq)
       the        and         of         to university      human 
        43         35         31         23         22         20 

barplot

barplot(cUnivFreq, las=2, col="blue")

wordcloud

library('wordcloud')
wordcloud(names(cUnivFreq),cUnivFreq)

wordcloud2

library('wordcloud2')
wordcloud2(data.frame(names(cUnivFreq), cUnivFreq))

列名で条件抽出: which関数の適用

  • univMtx$osaka3
colnames(univMtx)[5]
[1] "osaka3"
tmpUniv <-univMtx[which(colnames(univMtx)==colnames(univMtx)[5])]
dim(tmpUniv)
[1] 1506    1
head(tmpUniv)
#tmpUniv[1:3,]

補足subset()

subset()

tmpUniv2 <- subset(tmpUniv, tmpUniv>0)
head(tmpUniv2)

Shiny (Part2)

app_lec09

  • server.R
  • ui.R
  • global.R
xxxOutput() in ui.R <-> output$FuncionName in server.R

* textOutput("textData") <-> output$textData #renderText
* plotOutput("freqBar")   <->  output$freqBar #renderPlot
* dataTableOutput("freqData"))    <-> output$freqData #renderDataTable

Shinyアプリケーション”app_lec09”の実行

runApp("app_lec09")

server.R

  • output$textData
univNames <- colnames(univMtx)
univNames[3]
[1] "osaka1"
(fname <- paste(univNames[3], "txt", sep = "."))
[1] "osaka1.txt"
fname <- paste(dirName, fname, sep = "/")
textLst<-readLines(fname)
textLst[1]
[1] "The meaning of Osaka University's motto \"Live Locally, Grow Globally\" goes beyond the historical significance of the university's roots that reach back to Kaitokudo1 and Tekijuku2. Kaitokudo and Tekijuku were not only places of learning open to the public, they were also schools possessing cutting-edge knowledge in their day, places of unimpeded study for citizens. The inspirational spirit of Kaitokudo and Tekijuku exemplifies the future course for Osaka University, an institution imparting \"knowledge\" both locally and globally."

練習:

“app_lec09”を拡張させて、棒グラフの色をインタラクティブに選択できるようにする。

  • ui.Rに色選択のプルダウンを追加
  • server.Rで、選択した色を反映するように編集
LS0tCnRpdGxlOiAiTGVjMDk6IFNoaW55IChQYXJ0MikiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCgojIyDliY3lm57jga7oo5zotrM6IHNlcnZlci5SIGluICJhcHBfaG9nZTIiCmBgYAp0b3RhbF9tc2cgPC0gYXBwZW5kKHRvdGFsX21zZywgaW5wdXQkbXNnKQpgYGAKCmBgYHtyfQp0b3RhbF9tc2cyIDwtICJob2dlaG9nZTAiCnRvdGFsX21zZzIgIDwtIGFwcGVuZCh0b3RhbF9tc2cyLCAgImhvZ2Vob2dlMSIpCnRvdGFsX21zZzIgPC0gYXBwZW5kKHRvdGFsX21zZzIsICJob2dlaG9nZTIiKQp0b3RhbF9tc2cyCmBgYAoKIyMjIFNjb3Bl77yaPGEgaHJlZj0iaHR0cHM6Ly9zaGlueS5yc3R1ZGlvLmNvbS9hcnRpY2xlcy9zY29waW5nLmh0bWwiIHRhcmdldD0iX2JsYW5rIj5zaGFyZWQgdmFyaWFibGU8L2E+CmBgYHtyLCBldmFsPUZBTFNFfQp0b3RhbF9tc2cgPDwtIGFwcGVuZCh0b3RhbF9tc2csIGlucHV0JG1zZykKYGBgCgojIyBS44K544Kv44Oq44OX44OI44OV44Kh44Kk44OrInV0aWxzMy5SIuOBruiqreOBv+i+vOOBvwpgYGB7cn0Kc291cmNlKCJ1dGlsczMuUiIpCmBgYAoKIyMjICJ1bml2IuODh+OCo+ODrOOCr+ODiOWGheODhuOCreOCueODiOOBrumgu+W6puihjOWIlwpgYGB7cn0KdW5pdk10eDwtIGdldEZyZXFEaXIoInVuaXYiKQp1bml2TmFtZXMgPC0gY29sbmFtZXModW5pdk10eCkKdW5pdk10eFsxOjMsXQpgYGAKCgoKIyMjIDbliJfnm67vvIhvc2FrYTTvvInjga7mg4XloLHjgpLmir3lh7oKIyMjIyDopoHntKDjga7lkI3liY3jgYzjgZnjgafjgavliIbjgYvjgaPjgabjgYTjgovloLTlkIgKYGBge3J9CmNVbml2IDwtIHVuaXZNdHgkb3Nha2E0CmhlYWQoY1VuaXYpCmBgYAoKIyMjIyDopoHntKDjga7jgqTjg7Pjg4fjg4Pjgq/jgrnjgYzjgZnjgafjgavliIbjgYvjgaPjgabjgYTjgovloLTlkIgKYGBge3J9CmNVbml2IDwtIHVuaXZNdHhbNl0KaGVhZChjVW5pdikKYGBgCgojIyMjIOimgee0oOOBruWQjeWJjeOBi+OCieOCpOODs+ODh+ODg+OCr+OCueOCkuaOouOBmeWgtOWQiCh3aGljaOmWouaVsOOBrumBqeeUqCkKYGBge3J9CmluZGV4TnVtIDwtIHdoaWNoKGNvbG5hbWVzKHVuaXZNdHgpPT0gIm9zYWthNCIpCmluZGV4TnVtCmNVbml2IDwtIHVuaXZNdHhbaW5kZXhOdW1dCmhlYWQoY1VuaXYpCmBgYAoKIyMjIDDku6XkuIrjga7mg4XloLHjgpLmir3lh7oKYGBge3J9CmNVbml2IDwtY1VuaXZbY1VuaXY+MF0KI2NmLiBjVW5pdltjVW5pdiE9MF0KYGBgCgojIyMg6aC75bqm6aCG44Gr5Lim44G55pu/44GIICYg5LiK5L2N77yR77yV6Kqe44KS5oq95Ye6CmBgYHtyfQpvcmRlckxzdCA8LSBvcmRlcihjVW5pdiwgZGVjcmVhc2luZyA9IFRSVUUpCmNVbml2RnJlcSA8LSBjVW5pdltvcmRlckxzdF1bMToxNV0KbmFtZXMoY1VuaXZGcmVxKSA8LSByb3duYW1lcyh1bml2TXR4KVtvcmRlckxzdF1bMToxNV0KaGVhZChjVW5pdkZyZXEpCmBgYAoKIyMgYmFycGxvdApgYGB7cn0KYmFycGxvdChjVW5pdkZyZXEsIGxhcz0yLCBjb2w9ImJsdWUiKQpgYGAKCiMjIHdvcmRjbG91ZApgYGB7cn0KbGlicmFyeSgnd29yZGNsb3VkJykKd29yZGNsb3VkKG5hbWVzKGNVbml2RnJlcSksY1VuaXZGcmVxKQpgYGAKCiMjIHdvcmRjbG91ZDIKYGBge3J9CmxpYnJhcnkoJ3dvcmRjbG91ZDInKQp3b3JkY2xvdWQyKGRhdGEuZnJhbWUobmFtZXMoY1VuaXZGcmVxKSwgY1VuaXZGcmVxKSkKYGBgCgojIyMg5YiX5ZCN44Gn5p2h5Lu25oq95Ye6OiB3aGljaOmWouaVsOOBrumBqeeUqAoqIHVuaXZNdHgkb3Nha2EzCmBgYHtyfQpjb2xuYW1lcyh1bml2TXR4KVs1XQp0bXBVbml2IDwtdW5pdk10eFt3aGljaChjb2xuYW1lcyh1bml2TXR4KT09Y29sbmFtZXModW5pdk10eClbNV0pXQpkaW0odG1wVW5pdikKaGVhZCh0bXBVbml2KQojdG1wVW5pdlsxOjMsXQpgYGAKCiMjIyDoo5zotrNzdWJzZXQoKQo8YSBocmVmPSJodHRwczovL2Jpb2luZm8tZG9qby5uZXQvMjAxNy8wOC8xMC9yLXN1YnNldC8iPnN1YnNldCgpPC9hPgpgYGB7cn0KdG1wVW5pdjIgPC0gc3Vic2V0KHRtcFVuaXYsIHRtcFVuaXY+MCkKaGVhZCh0bXBVbml2MikKYGBgCgojIyBTaGlueSAoUGFydDIpCiMjIyBhcHBfbGVjMDkKKiBzZXJ2ZXIuUgoqIHVpLlIKKiBnbG9iYWwuUgoKYGBgCnh4eE91dHB1dCgpIGluIHVpLlIgPC0+IG91dHB1dCRGdW5jaW9uTmFtZSBpbiBzZXJ2ZXIuUgoKKiB0ZXh0T3V0cHV0KCJ0ZXh0RGF0YSIpIDwtPiBvdXRwdXQkdGV4dERhdGEgI3JlbmRlclRleHQKKiBwbG90T3V0cHV0KCJmcmVxQmFyIikgICA8LT4gIG91dHB1dCRmcmVxQmFyICNyZW5kZXJQbG90CiogZGF0YVRhYmxlT3V0cHV0KCJmcmVxRGF0YSIpKSAgICA8LT4gb3V0cHV0JGZyZXFEYXRhICNyZW5kZXJEYXRhVGFibGUKYGBgCiMjIyA8YSBocmVmPSJodHRwczovL3NoaW55LnJzdHVkaW8uY29tL3R1dG9yaWFsL3dyaXR0ZW4tdHV0b3JpYWwvbGVzc29uNC8iIHRhcmdldD0iX2JsYW5rIj5PdXRwdXQgZnVuY3Rpb248L2E+CgojIyMgU2hpbnnjgqLjg5fjg6rjgrHjg7zjgrfjg6fjg7MiYXBwX2xlYzA5IuOBruWun+ihjApgYGB7ciwgZXZhbD1GQUxTRX0KcnVuQXBwKCJhcHBfbGVjMDkiKQpgYGAKCiMjIyBzZXJ2ZXIuUgoqIG91dHB1dCR0ZXh0RGF0YQpgYGB7cn0KdW5pdk5hbWVzIDwtIGNvbG5hbWVzKHVuaXZNdHgpCnVuaXZOYW1lc1szXQooZm5hbWUgPC0gcGFzdGUodW5pdk5hbWVzWzNdLCAidHh0Iiwgc2VwID0gIi4iKSkKZm5hbWUgPC0gcGFzdGUoZGlyTmFtZSwgZm5hbWUsIHNlcCA9ICIvIikKdGV4dExzdDwtcmVhZExpbmVzKGZuYW1lKQp0ZXh0THN0WzFdCmBgYAoKIyMjIOe3tOe/kjogCiMjIyMgImFwcF9sZWMwOSLjgpLmi6HlvLXjgZXjgZvjgabjgIHmo5LjgrDjg6njg5Xjga7oibLjgpLjgqTjg7Pjgr/jg6njgq/jg4bjgqPjg5bjgavpgbjmip7jgafjgY3jgovjgojjgYbjgavjgZnjgovjgIIKKiB1aS5S44Gr6Imy6YG45oqe44Gu44OX44Or44OA44Km44Oz44KS6L+95YqgCiogc2VydmVyLlLjgafjgIHpgbjmip7jgZfjgZ/oibLjgpLlj43mmKDjgZnjgovjgojjgYbjgavnt6jpm4YKCiMjIyMgPGEgaHJlZj0iaHR0cHM6Ly9jb3B1bGFiby5zaGlueWFwcHMuaW8vYXBwX2xlYzA5X2V4dC8iIHRhcmdldD0iX2JsYW5rIj7lrp/ooYzkvos8L2E+CgoK