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

#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
#パッケージの読み込み
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()
    }
  )
})