Shinyの習作、その２です。出力したワードクラウドをPNG形式での保存とデータをテーブルで表示する例です。
紹介コマンドをコピー後にRStudioを利用し「ui.R」と「server.R」を用意、メニューのRun Appの右側下矢印を選択後「Run External」でウェブブラウザで作動させるのがポイントです。そうしないと、PNG形式での保存がうまく動作しません。
RStudioの2022.12.0 Build 353。windows 10のR version 4.2.2で動作を確認しています。
コマンドの紹介
詳細はコマンド、各パッケージのヘルプを確認してください。
ui.Rの内容
#ui.R
#可変レイアウト
shinyUI(fluidPage(
#タイトルを指定
titlePanel("PubMedでWordCloud"),
#1行目:可変レイアウト
fluidRow(plotOutput("WordCloud", width = "100%")),
#2行目:可変レイアウト
fluidRow(
#1列目
column(2, textInput("QueryWord", "クエリ", "クエリを入力"),
textInput("GetPaper", "取得論文数", "100"),
actionButton("GoWordCloud", "ワードクラウドを作成")),
#2列目
column(3, sliderInput("CountWord", "単語出現数", min = 1, max = 20, value = 5, step = 1),
#画像保存用のボタン
downloadButton("image", "プロットをPNGで保存")),
#2列目
column(5, p("出現単語表"), dataTableOutput("table"))
)
)
)server.Rの内容
#server.R
#パッケージの読み込み
if (!require("easyPubMed")) {
install.packages("easyPubMed")}
if (!require("tm")) {
install.packages("tm")}
if (!require("wordcloud")) {
install.packages("wordcloud")}
if (!require("tcltk")) {
install.packages("tcltk")}
shinyServer(function(input, output) {
#ui.Rからの入力の処理を調整するreactiveコマンド
#QueryWordでPubMedを検索してタイトルを取得:GetWordCloudData処理
GetWordCloudData <- reactive({
#GoWordCloudボタンを押すまでisolateコマンド内を処理しない
input$GoWordCloud
isolate(
if("クエリを入力" == input$QueryWord){
}else{
#結果の取得
ALL_Result <- get_pubmed_ids(input$QueryWord)
GetResult <- fetch_pubmed_data(ALL_Result,
retmax = input$GetPaper, format = "xml")
#論文タイトルを取得
TitleData <- unlist(xpathApply(GetResult, "//ArticleTitle", xmlValue))
###テキストマイニングの設定、お好みに合わせてください#####
CorMaster <- Corpus(DataframeSource(data.frame(TitleData))) #コーパスの作成
CorMaster <- tm_map(CorMaster, stripWhitespace) #空白の削除
CorMaster <- tm_map(CorMaster, removeNumbers) #数字の削除
CorMaster <- tm_map(CorMaster, removePunctuation) #句読点の削除
CorMaster <- tm_map(CorMaster, removeWords, stopwords("english")) #and, or等の削除
TermVec <- DocumentTermMatrix(CorMaster) #タームマトリックスの集計
########
###単語解析結果をデータフレーム化#####
#単語の出現率を集計
AnalyticsAllWords <- as.data.frame(apply(TermVec, 2, sum))
AnalyticsAllWords <- cbind(rownames(AnalyticsAllWords), AnalyticsAllWords)
#除去したい単語を設定
AnalyticsAllWords <- subset(AnalyticsAllWords,
!(AnalyticsAllWords[, 1] %in% c("the", "this", "can", "thus", "these")))
########
})
})
#使い回しするためにワードプロット用のデータは関数で処理
#ワードプロットを作成:PlotWordCloud関数
PlotWordCloud <- function(){
#理解しやすいようにGetWordCloudData処理で得た結果をAnalyticsAllWordsに代入
AnalyticsAllWords <- GetWordCloudData()
#GetWordCloudData処理の結果が何かある場合にワードプロットを作成
if(is.null(AnalyticsAllWords) == FALSE){
#GetWordCloudData処理で得た結果から出現数がCountWord以上を抽出
AnalyticsWords <- subset(AnalyticsAllWords,
AnalyticsAllWords[, 2] >= input$CountWord)
#出現回数で降順
AnalyticsWords <- AnalyticsWords[order(AnalyticsWords[, 2], decreasing = TRUE),]
#データ名
colnames(AnalyticsWords) <- c("単語", "出現回数")
AnalyticsWords
}else{}
}
#plotOutputに出力するrenderPlotコマンド
#ワードプロットをui.RのWordCloudに出力:output$WordCloud処理
output$WordCloud <- renderPlot({
#GetWordCloudData処理結果に何かある場合にワードプロットを作成
if(is.null(PlotWordCloud()) == FALSE){
#ワードプロット
#関数なので()を記述
wordcloud(PlotWordCloud()[, 1], PlotWordCloud()[, 2], scale = c(8, .1),
random.order = FALSE, rot.per = .10, colors = brewer.pal(8, "Dark2"))
}else{}
})
#dataTableOutputに出力するrenderDataTableコマンド
#ワードプロットデータをui.RのdataTableOutputに出力:output$table処理
output$table <- renderDataTable(
expr = PlotWordCloud(),
options = list(pageLength = 5)
)
#webブラウザで実行した際に画像等を保存するdownloadHandlerコマンド
#ワードプロットをpngで保存:output$image処理
#webブラウザで実行時のみ動作
output$image <- downloadHandler(
#ファイル名を指定
filename = function(){"WordCloudPlot.png"},
#処理内容を記述
content = function(file) {
png(file)
wordcloud(PlotWordCloud()[, 1], PlotWordCloud()[, 2], scale = c(8, .1),
random.order = FALSE, rot.per = .10, colors = brewer.pal(8, "Dark2"))
dev.off()
}
)
})実行例
・Chrome バージョン 56.0.2924.87 (64-bit)での実行例です。Shinyで習作1でも検索した「Leptailurus serval」結果。
少しでも、あなたの解析が楽になりますように！！けものフレンズ「第１０話 ろっじ」の配信が楽しみです。
