本文へスキップ
からだにいいもの

Rのトピックスを中心に『まだ、まだ、知らない、役に立つ情報?』を発信します。

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

Shinyの習作、その2です。出力したワードクラウドを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」結果。

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

スポンサーリンク
Prices and shipping availability may change. Please refer to the product page at time of purchase.
Content displayed on this site is provided by Amazon and may be updated or removed.
Amazon Associate, karada-good earns income through qualifying sales.