【Rでの画像処理シリーズ（その１）】R/EBImageとかを使った画像処理(読み込み、表示、リサイズetc)をやってみた件

今回は、EBImageとimagerを使った、 R環境での画像処理をいろいろと紹介する。

具体的に、画像ファイルの読み込み・表示、 ヒストグラム表示、グレー画像変換、リサイズ(縮小)とかのプログラムを作成・実行してみた。

はじめに、EBImageとimagerをセットアップする。

パッケージのインストール

#EBImageのインストール
install.packages("BiocManager")
BiocManager::install("EBImage", force = TRUE)

#imagerのインストール
install.packages("imager")

ひまわり画像をwikipediaからダウンロードして表示する

download.file関数を使って、Wikipediaからヒマワリの画像をダウンロードする。

そして、EBImageの関数群(readImage & display)を使って、読み込みと表示をやってみる。

#画像のダウンロード
download.file(url = "https://upload.wikimedia.org/wikipedia/commons/4/40/Sunflower_sky_backdrop.jpg", 
              destfile = "sunflower.jpg")

#EBImageのロードとオプション設定
library(EBImage); options(EBImage.display = "raster")

#画像の読み込み
Img <- EBImage::readImage(files="./sunflower.jpg", type = "jpg")

#画像の表示
EBImage::display(Img)

#画像の保存
quartz.save("Img01_sunflower.png", type="png", dpi=100); dev.off()

RGB画像をヒストグラムで表示する

次は、RGBのそれぞれの成分で頻度分布を計算して、ヒストグラムとして表示させる。

#クラス表示
str(Img)
#Formal class 'Image' [package "EBImage"] with 2 slots
#  ..@ .Data    : num [1:1404, 1:1555, 1:3] 0.00392 0.00392 0.00784 0.00784 0 ...
#  ..@ colormode: int 2
#  ..$ dim: int [1:3] 1404 1555 3

#画像の前処理
a <- hist(unlist(Img[,,1]), breaks=256); dev.off(); a <- a$red$density      #Red
b <- hist(unlist(Img[,,2]), breaks=256); dev.off(); b <- b$red$density      #Green
cc <- hist(unlist(Img[,,3]), breaks=256); dev.off(); cc <- cc$red$density   #Blue

#画像のヒストグラム表示
plot(a, 
     xlim = c(0,256), ylim=c(0, max(c(a, b, cc))*1.1),
     xlab="Intensity value (0-255)", ylab="Density", xaxs="i", yaxs="i",
     type="l", col="red")
lines(b, col="green")
lines(cc, col="blue")
quartz.save("Img02_rgb_histo.png", type="png", dpi=100); dev.off()

グレー画像をヒストグラムで表示する

ここでは、RGBのカラー画像をグレー画像に変換した後に、頻度分布を計算して、ヒストグラムとして表示させる。

まずは、カラー画像をグレー画像に変換する。

#詳細表示
Img
#Image 
#  colorMode    : Color 
#  storage.mode : double 
#  dim          : 1404 1555 3 
#  frames.total : 3 
#  frames.render: 1 
#
#imageData(object)[1:5,1:6,1]
#            [,1]        [,2]        [,3]        [,4]        [,5]        [,6]
#[1,] 0.003921569 0.003921569 0.003921569 0.003921569 0.003921569 0.003921569
#[2,] 0.003921569 0.003921569 0.003921569 0.003921569 0.003921569 0.003921569
#[3,] 0.007843137 0.007843137 0.007843137 0.007843137 0.003921569 0.003921569
#[4,] 0.007843137 0.003921569 0.003921569 0.003921569 0.003921569 0.003921569
#[5,] 0.000000000 0.003921569 0.003921569 0.003921569 0.003921569 0.003921569

#グレーに変換
ImgGr <- array(EBImage::channel(Img, "gray"), dim = dim(Img)[1:2])

#詳細表示
ImgGr
#Image 
#  colorMode    : Grayscale 
#  storage.mode : double 
#  dim          : 1404 1555 
#  frames.total : 1 
#  frames.render: 1 
#
#imageData(object)[1:5,1:6]
#          [,1]      [,2]      [,3]      [,4]      [,5]      [,6]
#[1,] 0.3124183 0.3124183 0.3124183 0.3124183 0.3124183 0.3124183
#[2,] 0.3124183 0.3124183 0.3124183 0.3124183 0.3124183 0.3124183
#[3,] 0.3163399 0.3163399 0.3163399 0.3163399 0.3124183 0.3124183
#[4,] 0.3163399 0.3124183 0.3124183 0.3124183 0.3124183 0.3124183
#[5,] 0.3084967 0.3124183 0.3124183 0.3124183 0.3124183 0.3124183

EBImage::display(ImgGr)
quartz.save("Img03_sunflower.png", type="png", dpi=100); dev.off()

次に、グレー画像のヒストグラムも合わせて表示してみる。

#画像の前処理
a <- hist(unlist(ImgGr), breaks=256); dev.off()
a <- a$density

#画像のヒストグラム表示
par(mfcol = c(1,2), mgp=c(2.5, 1, 0))
EBImage::display(ImgGr)
plot(a, 
     xlim = c(0,256), ylim=c(0, max(c(a))*1.1),
     xlab="Intensity value (0-255)", ylab="Density", xaxs="i", yaxs="i",
     type="l", col="grey50")
quartz.save("Img04_Grey.png", type="png", dpi=100); dev.off()

RGB画像を各成分に分離して、各画像を表示する

R成分を取り出す場合には、GとB成分にゼロを代入して、GB成分を消去する。 GとB成分でも同じような処理をやってみる。 そして、オリジナル画像、R成分、G成分、B成分の画像を連結させて表示させる。

#RGB色の分離
Red <- Img
Red[,,2] <- 0
Red[,,3] <- 0
#EBImage::display(Red)

Green <- Img
Green[,,1] <- 0
Green[,,3] <- 0
#EBImage::display(Green)

Blue <- Img
Blue[,,1] <- 0
Blue[,,2] <- 0
#EBImage::display(Blue)

#RGB色で表示
EBImage::display(EBImage::combine(Img, Red, Green, Blue),
                 nx=2, all=TRUE, spacing = 0.01, margin = 70)
quartz.save("Img05_rgb.png", type="png", dpi=100); dev.off()

フィルターを変えて、画像の縮小を行い、結果を比較してみた。

EBImage::resizeとimager::resizeを使って、 様々なフィルターでの画像の縮小を試してみた。 XY軸方向に、それぞれ20%縮小した（要するに、1/25縮小）。

#縮小 + no-filter
Img_n50 <- EBImage::resize(Img, 
                           w=round(dim(Img)[1]/5, 0), 
                           h=round(dim(Img)[2]/5, 0), 
                           filter="none")

#縮小 + bilinear filter
Img_b50 <- EBImage::resize(Img, 
                           w=round(dim(Img)[1]/5, 0), 
                           h=round(dim(Img)[2]/5, 0), 
                           filter="bilinear")

#EBImageからcimgへのオブジェクト変換
img <- imageData(Img)
img2 <- imager::as.cimg(img, dim=dim(img))
#警告メッセージ: 
# as.cimg.array(img, dim = dim(img)) で: 
#  Assuming third dimension corresponds to colour

#縮小 + no interpolation: additional space is filled according to boundary_conditions (0)
Img_nnia50 <- imager::resize(img2, 
                            size_x = round(dim(img2)[1]/5, 0),
                            size_y = round(dim(img2)[2]/5, 0),
                            interpolation_type = 0)
Img_nnia50 <- EBImage::Image(Img_nnia50[,,1,], colormode = "Color")
#EBImage::display(Img_nnia50)

#縮小 + nearest-neighbor interpolation (1)
Img_nni50 <- imager::resize(img2, 
                            size_x = round(dim(img2)[1]/5, 0),
                            size_y = round(dim(img2)[2]/5, 0),
                            interpolation_type = 1)
Img_nni50 <- EBImage::Image(Img_nni50[,,1,], colormode = "Color")

#縮小 + moving average interpolation (2)
Img_mai50 <- imager::resize(img2, 
                            size_x = round(dim(img2)[1]/5, 0),
                            size_y = round(dim(img2)[2]/5, 0),
                            interpolation_type = 2)
Img_mai50 <- EBImage::Image(Img_mai50[,,1,], colormode = "Color")

#縮小 + linear interpolation (3)
Img_li50 <- imager::resize(img2, 
                            size_x = round(dim(img2)[1]/5, 0),
                            size_y = round(dim(img2)[2]/5, 0),
                            interpolation_type = 3)
Img_li50 <- EBImage::Image(Img_li50[,,1,], colormode = "Color")

#縮小 + grid interpolation (4)
Img_gi50 <- imager::resize(img2, 
                            size_x = round(dim(img2)[1]/5, 0),
                            size_y = round(dim(img2)[2]/5, 0),
                            interpolation_type = 4)
Img_gi50 <- EBImage::Image(Img_gi50[,,1,], colormode = "Color")

#縮小 + cubic interpolation (5)
Img_ci50 <- imager::resize(img2, 
                            size_x = round(dim(img2)[1]/5, 0),
                            size_y = round(dim(img2)[2]/5, 0),
                            interpolation_type = 5)
Img_ci50 <- EBImage::Image(Img_ci50[,,1,], colormode = "Color")

#縮小 +  lanczos interpolation (6)
Img_lani50 <- imager::resize(img2, 
                            size_x = round(dim(img2)[1]/5, 0),
                            size_y = round(dim(img2)[2]/5, 0),
                            interpolation_type = 6)
Img_lani50 <- EBImage::Image(Img_lani50[,,1,], colormode = "Color")

#表示
EBImage::display(EBImage::combine(Img_n50, Img_b50, Img_nnia50, 
                                  Img_nni50, Img_mai50, Img_li50, 
                                  Img_gi50, Img_ci50, Img_lani50),
                 nx=3, all=TRUE, spacing = 0.01, margin = 70)
m <- c(0.8, 1, 0)
text(x = 100, y = 0,
     label = "Img_n50", adj = c(0,1), col = "white", cex = m[1], pos=m[2], srt=m[3])
text(x = 380, y = 0,
     label = "Img_b50", adj = c(0,1), col = "white", cex = m[1], pos=m[2], srt=m[3])
text(x = 680, y = 0,
     label = "Img_nnia50", adj = c(0,1), col = "white", cex = m[1], pos=m[2], srt=m[3])
text(x = 100, y = 310,
     label = "Img_nni50", adj = c(0,1), col = "white", cex = m[1], pos=m[2], srt=m[3])
text(x = 380, y = 310,
     label = "Img_mai50", adj = c(0,1), col = "white", cex = m[1], pos=m[2], srt=m[3])
text(x = 680, y = 310,
     label = "Img_li50", adj = c(0,1), col = "white", cex = m[1], pos=m[2], srt=m[3])
text(x = 100, y = 620,
     label = "Img_gi50", adj = c(0,1), col = "white", cex = m[1], pos=m[2], srt=m[3])
text(x = 380, y = 620,
     label = "Img_ci50", adj = c(0,1), col = "white", cex = m[1], pos=m[2], srt=m[3])
text(x = 680, y = 620,
     label = "Img_lani50", adj = c(0,1), col = "white", cex = m[1], pos=m[2], srt=m[3])
quartz.save("Img06_resize.png", type="png", dpi=150); dev.off()

n50、b50、nni50、gi50の縮小結果はあきらかに画像の平滑化がうまくいってなさそう。

nnia50の縮小結果は端っこしか切り取られていない。。

次に、画像(グレー変換後)のヒストグラムを図示してみる。

#レイアウト設定
par(mfrow = c(3,3), mgp=c(2.5, 1, 0), mai = c(0.5, 0.5, 0.2, 0.2))

#Img
hist(array(EBImage::channel(Img, "gray"), dim=dim(Img)[1:2])*256, 
     breaks=256, freq=F, main="Img", xlab="Intensity value (0-255)", 
     xaxs="i", yaxs="i", ylim=c(0, 0.06))

#Img_n50
hist(array(EBImage::channel(Img_n50, "gray"), dim=dim(Img_n50)[1:2])*256, 
     breaks=256, freq=F, main="Img_n50", xlab="Intensity value (0-255)", 
     xaxs="i", yaxs="i", ylim=c(0, 0.06))

#Img_b50
hist(array(EBImage::channel(Img_b50, "gray"), dim=dim(Img_b50)[1:2])*256, 
     breaks=256, freq=F, main="Img_b50", xlab="Intensity value (0-255)", 
     xaxs="i", yaxs="i", ylim=c(0, 0.06))

#Img_nni50
hist(array(EBImage::channel(Img_nni50, "gray"), dim=dim(Img_nni50)[1:2])*256, 
     breaks=256, freq=F, main="Img_nni50", xlab="Intensity value (0-255)", 
     xaxs="i", yaxs="i", ylim=c(0, 0.06))

#Img_mai50
hist(array(EBImage::channel(Img_mai50, "gray"), dim=dim(Img_mai50)[1:2])*256, 
     breaks=256, freq=F, main="Img_mai50", xlab="Intensity value (0-255)", 
     xaxs="i", yaxs="i", ylim=c(0, 0.06))

#Img_li50
hist(array(EBImage::channel(Img_li50, "gray"), dim=dim(Img_li50)[1:2])*256, 
     breaks=256, freq=F, main="Img_li50", xlab="Intensity value (0-255)", 
     xaxs="i", yaxs="i", ylim=c(0, 0.06))

#Img_gi50
hist(array(EBImage::channel(Img_gi50, "gray"), dim=dim(Img_gi50)[1:2])*256, 
     breaks=256, freq=F, main="Img_gi50", xlab="Intensity value (0-255)", 
     xaxs="i", yaxs="i", ylim=c(0, 0.06))

#Img_ci50
hist(array(EBImage::channel(Img_ci50, "gray"), dim=dim(Img_ci50)[1:2])*256, 
     breaks=256, freq=F, main="Img_ci50", xlab="Intensity value (0-255)", 
     xaxs="i", yaxs="i", ylim=c(0, 0.06))

#Img_lani50
hist(array(EBImage::channel(Img_lani50, "gray"), dim=dim(Img_lani50)[1:2])*256, 
     breaks=256, freq=F, main="Img_lani50", xlab="Intensity value (0-255)", 
     xaxs="i", yaxs="i", ylim=c(0, 0.06))

#保存
quartz.save("Img07_histo.png", type="png", dpi=150); dev.off()

ピークの高さとか、諧調150くらいのところに少し違いがありそう。

まとめ

R/EBImage/imagerでの基本的な画像をまとめてみた。

現状、Rでの画像処理のハウツゥはほんと少ない。。

R言語でも画像処理が結構できそうなので、 少しずつスクリプトを紹介できればと思う。

参考資料

bioconductor.org

rdrr.io

www.rdocumentation.org

dahtah.github.io

rdrr.io

http://cse.naro.affrc.go.jp/takezawa/r-tips/r/55.htmlcse.naro.affrc.go.jp

labs.eecs.tottori-u.ac.jp

テキスト解析ワークフローをまとめてみた件

テキスト解析で考慮すべき１３のポイント【随時更新予定】

No	大項目	小項目	DB / Tools	備考
1	タスク選定	テキストマイニング / 固有表現認識 (NER) / その他
2	言語	英語 / 日本語 / (機械)翻訳された文章 / その他	機械翻訳: Python/Googletrans, DeepL	英: アクセス可能なWebソースが多い 日: 全体の2%程度
3	対象条件	期間 / 地域
4	情報ソース	論文 / 特許 / SNS / Web / 書籍 / その他	Google / Google Scholar / PubMed / Twitter / Yahoo
5	データ取得方法	キーワード検索 / LOD・RDFダンプ / Webスクレイピング / PDFファイル / OCR / 書籍 / その他	PubMed: R/RISmed Webスクレイピング: R/Rselenium, R/rvest DB: Wikipedia, Wikidata
6	データ形式	テキスト / キーワード / 画像 / 図表		テキスト: 一次情報 キーワード: 要約情報、キュレーション有り(二次情報)
7	取得データサイズ	バイトサイズ / ファイル数 / ページ数
8	データの質	動的データ(データ取得の再現性) / 静的データ / クオリティ(誤字・脱字)
9	前処理	フィルタリング(除外要件) / リサンプリング (再抽出) / データクレンジング
10	NLP (自然言語処理)	エンティティリンキング / 形態素解析 / 文字列距離 / 文節係受け解析 / 複合語解析 / 意味解釈 / 機械学習	(形態素解析) 英語: TreeTagger, nltk, R/koRpus, R/nltk4r 日本語: MeCab/RMeCab, Suadachi/Suadachipy, JUMAN, ChaSen 中国語: NLPIR 多言語: MTMineR, TreeTagger
11	後処理 (post-NLP)
12	二次的データ解析	テキストマイニング / 機械学習	ワードクラウド: R/wordcloud2 共起解析: R/cooccur, R/RMeCab ネットワーク作図: R/igraph, R/visNetwork 特徴量解析: Python/word2vec, R/wordVectors DL: Keras/Tensorflow, PyTorch	テキストマイニング: テキストデータから有益な情報・知識を取り出す技術の総称
13	評価・解釈

Rプログラム

今回、上記のテーブルを作成するにあたり、 gistファイルを読み込んで、knitr::kableのpipをCSV出力してみた。

次に、file.csvをエクセルで開いて、はてなブログにコピペした。

以下、Rプログラムを示す。

#パッケージのインストール
install.packages(c("knitr", "magrittr", "readr"))

#パッケージのロード
library(knitr)
library(magrittr)
library(readr)

#データロード
Dat <- readr::read_csv("https://gist.githubusercontent.com/kumeS/d714a366f869be19afa321382f863c95/raw/71c375551403a912dbe189b5e2385c83b0eb91d3/textAnalysisWorkflow.csv")
Dat[is.na(Dat)] <- ""
CaptionText <- "テキスト解析で考慮すべき１３のポイント【随時更新予定】"

#pipテーブルの表示
Dat %>%
  head() %>%
  knitr::kable(format = "pipe", booktabs = T,
    caption = CaptionText, 
    align = c("c", "l", "l", "l", "l"))
Dat0 <- as.data.frame(Dat)

#フォントサイズを小さく
Size <- 40
for(n in 1:nrow(Dat)){
for(m in 2:ncol(Dat)){
if(Dat0[n, m] != ""){
 Dat0[n, m]  <- paste0('<span style="font-size: ', Size, '%">', Dat[n, m], '</span>')    
}}}

#pipテーブルの作成
Dat0 %>%
  knitr::kable(format = "pipe", booktabs = T,
    caption = CaptionText, 
    align = c("c", "l", "l", "l", "l")) %>%
  as.character() %>%
  as.data.frame() %>%
  readr::write_excel_csv(file="file.csv")

R/rtweetとか諸々を使って、つぶやきのテキスト解析 (形態素分析 + 感情分析) をやってみた件

twitterのつぶやきを集めて、形態素分析 + 感情分析をやってみた。

つぶやきの感情分析は、単語感情極性対応表を使って、positiveかnegativeかを評価してみた。やってみると、案外、面白かった。

まずは、Rの関連パッケージをインストールしてみる。

#インストール
install.packages(c("rtweet", "devtools", "dplyr", "magrittr"))
library(rtweet)
library(devtools)
library(dplyr)
library(magrittr)

#mecabのインストール
system("brew install mecab mecab-ipadic")
install.packages("RMeCab", repos = "http://rmecab.jp/R")
library(RMeCab)

はじめに、twitterアカウントの認証を行う*1。

rtweetの場合には、それが簡単で、 以下のように、とりあえず、何か実行すると、 Webブラウザが開いて、アカウント認証が求められる。

#試しに実行
search_tweets(q="コロナ", n = 100)
#Requesting token on behalf of user...
#Waiting for authentication in browser...
#Press Esc/Ctrl + C to abort
#Authentication complete.

こんな感じで、認証画面が表示される。

入力が完了すれば、Authentication completeとでる。

米国株をクエリに呟きを検索してみる。

今日の皆さんのつぶやきの感情は、ポジティブなのかネガティブなのか、、、

米国株をキーワードに、7/16未明のつぶやきを調べてみた。

#200個 検索
tweets <- search_tweets(q="米国株", n = 200)

#前処理
tweetsTxt <- tweets %>% 
  dplyr::select(text) %>% 
  unique()

#表示
head(tweetsTxt)
# A tibble: 6 x 1
#  text                                                                                     
#  <chr>                                                                                    
#1 "寝る前に米国株監視。まだ眠れない…"                                                      
#2 "米国株も調整入り？\nパウエル議長、テーパリング議論開始に言及\n～なんで金利は低下してい… 
#3 "✅米国株ライブ ヒートマップ\n指数\n ダウ -0.22% ラッセル -1.01%\n S&amp;P500 -0.68% ナ… 
#4 "✅米国株ライブ ヒートマップ\n指数\n ダウ +0.08% ラッセル -0.40%\n S&amp;P500 -0.19% ナ… 
#5 "✅米国株ライブ ヒートマップ\n指数\n ダウ +0.11% ラッセル -0.33%\n S&amp;P500 -0.29% ナ… 
#6 "これだけ変異株があるのに、東京五輪なんて開催するなよ。\n\nイータ株、アルファ株（英国)\n…

つぶやきの形態素解析

まず試しに、１つ目のつぶやき「寝る前に米国株監視。まだ眠れない…」をRMeCabで形態素解析をしてみる。

library(RMeCab)

#形態素解析
tweetsTxt1 <- unlist(tweetsTxt[1,], use.names = F)
result0 <- unlist(RMeCabC(tweetsTxt1))

##形態素解析の結果
result0
#  動詞   名詞   助詞   名詞   名詞   名詞   記号   副詞   動詞 助動詞   記号 
#"寝る"   "前"   "に" "米国"   "株" "監視"   "。" "まだ" "眠れ" "ない"   "…" 

#特定の品詞部分のみを取り出す
result1 <- unique(result0[names(result0) %in% c("動詞", "名詞", "形容詞", "副詞")])
result1
#[1] "寝る" "前"   "米国" "株"   "監視" "まだ" "眠れ"

単語感情極性対応表を使った感情分析

感情極性とは、その語が一般的に良い印象を持つか（positive）、悪い印象を持つか（negative）を二値属性(-1から+1の実数)で表したものである*2*3。

単語感情極性対応表は、 再配布禁止のようなので、今回、Rで直接URLを読み込んでみる。

#単語感情極性対応表の読み込み（コロン区切り）
pn_ja <- read.csv(file('http://www.lr.pi.titech.ac.jp/~takamura/pubs/pn_ja.dic',　encoding='Shift_JIS'), header = F, sep = ":")

#表示
head(pn_ja)
#        V1       V2     V3       V4
#1   優れる すぐれる   動詞 1.000000
#2     良い     よい 形容詞 0.999995
#3     喜ぶ よろこぶ   動詞 0.999979
#4   褒める   ほめる   動詞 0.999979
#5 めでたい めでたい 形容詞 0.999645
#6     賢い かしこい 形容詞 0.999486

#前処理
pn_ja01 <- pn_ja$V1
pn_ja04 <- pn_ja$V4

この対応表を使って、先ほどのつぶやきの感情分析をやってみる。

#見出し語との対応をとって、二値属性の和を計算
round(sum(pn_ja04[pn_ja01 %in% result1]), 2)
#[1] -2.75

値が-2.75ということで、どちらかというと、少しネガティブな呟きのようだ。

全つぶやきで、感情分析してみる。

今回、重複除去したつぶやきは全部で79個あり、それぞれで感情分析を実行してみた。

#結果を格納するデータフレーム
Results <- data.frame(Sentiment=NA, Text=unlist(tweetsTxt), row.names = 1:nrow(tweetsTxt))

#つぶやき数
length(unlist(tweetsTxt))
#[1] 79

#逐次実行
for(n in 1:length(unlist(tweetsTxt))){
#n <- 1
print(n)

#形態素解析
tweetsTxt1 <- unlist(tweetsTxt[n,], use.names = F)
result0 <- unlist(RMeCabC(tweetsTxt1))

##特定の品詞のみを取り出す
result1 <- unique(result0[names(result0) %in% c("動詞", "名詞", "形容詞", "副詞")])

#二値属性の和
a <- pn_ja04[pn_ja01 %in% result1]
result2 <- round(sum(a), 2)
print("OK")

#結果を格納する
Results[n,1] <- result2
}

この時、match(x, table, nomatch = 0L) でエラー: 'translateCharUTF8' must be called on a CHARSXP, but got 'NULL' とエラーがでても、再実行したらうまくいった。謎な挙動。

感情値で並び替えて、つぶやきとの対応を表示してみる。 また、結果をヒストグラムにしてみた。

#並び替え
ResultsOrder <- dplyr::as_tibble(Results[order(Results$Sentiment, decreasing = T),])

#ポジティブ上位の表示
head(ResultsOrder, n=3)
# A tibble: 3 x 2
#  Sentiment Text                                                                           
#      <dbl> <chr>                                                                          
#1     -0.77 "米国株、久々にめっちゃ下げてるやないかーい🤗\nって言おうと思ったけど、意外と… 
#2     -1.3  "【米国株セクターETF】\n⛓ $VAW 180.38 (+0.14%)\n🛒 $VCR 314.46 (-0.71%)\n☕ $V…
#3     -1.3  "【米国株セクターETF】\n⛓ $VAW 181.02 (+0.50%)\n🛒 $VCR 314.89 (-0.57%)\n☕ $V…

#ネガティブ上位の表示
tail(ResultsOrder, n=3)
# A tibble: 3 x 2
#  Sentiment Text                                                                           
#      <dbl> <chr>                                                                          
#1     -17.2 "米国株のクラウドストライクですが、ちょっと頭が重い感じがするので、一度利食い… 
#2     -19.4 "🍀改めて自己紹介\n\n・転勤族\n・住宅ローン返済中\n・家賃収入\n・米国株長期投… 
#3     -22.4 "10月からは全資金の半分以上は米国株の買い付けを始める\n3ヶ月かけてゆっくり仕込…

#ヒストグラム表示
hist(ResultsOrder$Sentiment, breaks=25, col = "skyblue", xlab = "Sentiment", xaxs="i", xlim = c(-25, 0))
#quartz.save(file = "./hist.png",  type = "png", dpi = 100)

まとめ

呟きを分析してみると、ヒストグラムで-5付近にピークがあった。 少しネガティブ気味かもしれないけども、これくらいならまだまだ楽観と思える。 まぁ時系列で解析結果を見てみないと、何ともよく分からないんだけど。

あと、パッと思いついて、ユニークな形態素だけで、 感情属性を集計してみたけど、これはこれで良さそうに思う。

参考資料

qiita.com

shohei-doi.github.io

notchained.hatenablog.com

qiita.com

www.lr.pi.titech.ac.jp

qiita.com

*1:twitterのアカウント要登録

*2:高村大也, 乾孝司, 奥村学: "スピンモデルによる単語の感情極性抽出", 情報処理学会論文誌ジャーナル, Vol.47 No.02 pp. 627--637, 2006.

*3:Hiroya Takamura, Takashi Inui, Manabu Okumura: "Extracting Semantic Orientations of Words using Spin Model", In Proceedings of the 43rd Annual Meeting of the Association for Computational Linguistics (ACL2005) , pages 133--140, 2005.