Rで解析:Shinyで習作2「プロットを保存」


投稿日: Rの解析に役に立つ記事

Shinyの習作、その2です。出力したワードクラウドをPNG形式での保存とデータをテーブルで表示する例です。

紹介コマンドをコピー後にRStudioを利用し「ui.R」と「server.R」を用意、メニューのRun Appの右側下矢印を選択後「Run External」でウェブブラウザで作動させるのがポイントです。そうしないと、PNG形式での保存がうまく動作しません。

RStudioのversion 1.0.136。windows 10のR version 3.3.3で動作を確認しています。


コマンドの紹介

詳細はコマンド、各パッケージのヘルプを確認してください。

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() } ) }) [/code]


実行例

・Chrome バージョン 56.0.2924.87 (64-bit)での実行例です。Shinyで習作1でも検索した「Leptailurus serval」結果。


少しでも、あなたの解析が楽になりますように!!けものフレンズ「第10話 ろっじ」の配信が楽しみです。

スポンサードリンク

関連コンテンツ


スポンサードリンク