R : 原子量表のスクレイピング - へっぽこ博士のなんちゃって研究室

0.事始め

原子量一覧が欲しかったので、日本化学会にて公開されているものからスクレイピングでデータフレームを構築しようとしたら、結構苦労したので、Rのソースコードを晒しておきます。Rにおける文字列処理方法の勉強にはなったと思います。apply関数？知らない子ですね。

1.ゴリ押し大作戦

pdftoolsパッケージを使って6～7ページを読み込むと、以下のようなデータが得られます。

"     1 水           素 H      1.008               44 ル  テ  ニ  ウ  ム Ru  101.1"                                   
"     2 ヘ   リ   ウ   ム He     4.003               45 ロ   ジ   ウ   ム Rh  102.9"                                  
"                                      3 リ   チ   ウ   ム Li     6.94                46 パ  ラ  ジ  ウ  ム Pd  106.4"
"     4 ベ  リ  リ  ウ  ム Be     9.012               47       銀       Ag  107.9"                                    
"     5 ホ     ウ     素 B     10.81                48 カ  ド  ミ  ウ  ム Cd  112.4"                                  
"     6 炭           素 C     12.01                49 イ  ン  ジ  ウ  ム In  114.8"

日本語の元素名が均等割り付けされているため、不要なスペースが紛れ込んでおり、そのままでは区切り文字で各要素を分割することができません。
こういった体裁だけのための書式は、データサイエンティストにとって、本当に面倒です。
とりあえず、以下の作戦でスクレイピングすることにしました。
・1 数字またはアルファベットの前後のスペースを、
　　別の区切り文字に置き換える。
・2 余分なスペース、重複した区切り文字を除去。
・3 データフレームに入れて整形。

2.プログラム本体

で、最終的にこうなりました。

require(pdftools)
require(tidyverse) #stringr, tidyr, dplyr

# check multiple-byte character : return bool
is_multiple <- function(char) {
  pattern <- "\\p{Block=Katakana}|\\p{Script=Han}"
  invisible(return(str_detect(char,pattern=pattern)))
}

# check digit, alphabet and period : return bool
is_alnum <- function(char) {
  if (is_multiple(char)) invisible(return(FALSE))

  pattern <- "[[:alnum:]]|\\."
  invisible(return(str_detect(char,pattern=pattern)))
}

# check blank : return bool
is_blank <- function(char) {
  if (is_multiple(char)) invisible(return(FALSE))

  pattern <- "[[:blank:]]"
  invisible(return(str_detect(char, pattern=pattern)))
}

# extract character at a specified position : return character
chr_sub <-function(string, locate) {
  invisible(return(str_sub(string, locate, locate)))
}

# replace character at a specified position : return string
chr_replace <- function(string, locate, char) {
  forward <- str_sub(string, 1, (locate-1))
  backward <- str_sub(string, (locate+1), -1)
  invisible(return(str_c(forward,char,backward)))
}

# rebuild string : return data.frame
rebuild_str <- function(string) {
  new_str <- str_trim(string)
  N <- str_length(new_str)
  if (is.na(N)|(N < 2)) invisible(return(new_str))
  
  for (i in 2:(N-1)) {
    char <- chr_sub(new_str, i)
    if (is_blank(char)) {
      fchar <- chr_sub(new_str, (i-1))
      bchar <- chr_sub(new_str, (i+1))
      if (is_alnum(fchar)|is_alnum(bchar)) {
        new_str <- chr_replace(new_str, i, ",")
      }
    }
  }
  new_str <- str_replace_all(new_str, " ","" )
  sp_str <- str_split(new_str, "[,]+") %>% as.data.frame()
  invisible(return(t(sp_str)))
}

# extended bind_rows : return data.frame
bind_rows_ex <- function(df1, df2) {
  colnames(df2) <- colnames(df1)
  bind_df <- bind_rows(df1, df2)
  invisible(return(bind_df))
}

# rebuild page : return data.frame
rebuild_page <- function(source, page, start=1L, end=-1L) {
  if ((end==-1L)|(end > length(source[[page]]))) end <- length(source[[page]])

  txt <- source[[page]][start:end]
  txt.df <- data.frame(matrix(nrow=(end-start), ncol=8))
  for (i in 1:length(txt)) {
    txt.df[i,] <- rebuild_str(txt[i])
  }
  txt.df <- bind_rows_ex(txt.df[,1:4], txt.df[,5:8])
  invisible(return(txt.df))
}

# main process
fname <- "atom_2022.pdf"
suppressMessages(pdf_file <- pdf_text(fname))

pdftxt <- str_replace_all(pdf_file, c("＊\n"="", "†\n"="", "（"="", "）"=""))
pdftxt <- str_split(pdftxt, "\n", simplify = F)
p1 <- rebuild_page(pdftxt, 6, 12, 54) 
p2 <- rebuild_page(pdftxt, 7, 3, 18)

atom_table <- bind_rows(p1, p2)
colnames(atom_table) <- c("Number","Element","Symbol","Weight")
View(atom_table)

3.ソースコードの解説

is_multiple(char)
is_alnum(char)
is_blank(char)
文字種類の判定用関数です。
最初に全角、いわゆる2バイト文字の判定処理を入れないと、1バイト目の文字コードからアルファベットとして判断されることがあるようです。
長音符号(ー)はUnicodeではKatakanaブロックにあります。解説サイトでは、片仮名の判定をスクリプト(Script, sc, または省略)で指定されているほうが多いようで、この場合は、長音符号が含まれないので注意が必要です。
今回の場合、漢字の範囲はScriptで十分足りますが、人名や地名を判定する必要がある場合は不十分です。詳しくはこちらのサイト様が参考になると思います。

chr_sub(string, locate)
stringからlocateで指定した位置の文字を返すだけのラッパー関数です。

chr_replace(string, locate, char)
string中のlocateで指定した位置の文字をcharに置き換える関数です。意外とありそうでない関数の１つで、 pythonでも同様の質問がされていました。 C言語だとポインタを渡して簡単にアクセスできるのに・・・

rebuild_str(string)
stringから空白を取り除き、要素に分解したデータフレームを返します。作戦1～2のメイン処理部分です。
日本語の元素名は不要という方は、下記のような実装でもいいかもしれません。

rebuild_str <- function(string) {
  new_str <- str_trim(string)
  N <- str_length(new_str)
  if (is.na(N)|(N<2)) invisible(return(new_str))

  for (i in 2:(N-1)) {
    char <- chr_sub(new_str, i)
    if (is_multiple(char)) {
      new_str <- str_remove(new_str, char)
    }
  }
  
  sp_str <- str_split(new_str, "[ ]+") %>% as.data.frame()
  invisible(return(t(sp_str)))
}

連続した区切り文字を1文字として扱うには、正規表現では"[ ]+"のように後ろに+を付けます。

bind_rows_ex(df1, df2)
2つのデータフレームを縦に結合するラッパー関数です。
dplyr::bind_rowsは、base::rbindと比較して、列数や列名が異なっていても結合できる便利な関数です。ただ、思っていたのと挙動が違ったので、用意しました。色々試行錯誤した結果、列名にNULLを入れて結合することに落ち着いたので、rbindで良かったような・・・

bind_rowsの挙動は、以下のような2つのデータフレームを結合すると、

A	B
1	2

C	D
3	4

こんな感じになります。

A	B	C	D
1	2	NA	NA
NA	NA	3	4

こうなって欲しかったんですけどね・・・

A'	B'
1	2
3	4

rebuid_page(source, page, start, end)
pdf_textで読み込んだデータ(source)の指定ページ(page)を処理する関数です。
startとendで読み込み開始行と終了行を指定します。 WindowsとLinuxとで改行コードの違いからか、若干ずれるので、お手持ちの環境に合わせて調整ください。
データ処理部分をfor文で回していますが、sapply関数でも代替できます。ただ、実行時間に差が出なかった(どちらも0.5秒程度)のと、後々の処理が面倒だったので、書き慣れている方で処理しました。必ずしもapply系関数の方が優れているわけではないという一例ですね。

メイン処理部分
pdftools::pdf_textを使うと、"PDF error: Invalid Font Weight"という大量のエラーを吐くことがあります。これは、内部で使用しているPopplerライブラリが原因のようなので、ヘルプにある通り、suppressMessagesで出力を抑制しています。

後は、必要に応じてwrite.csv等で出力しておくのも良いかもしれません。