nprolog, xml
ちょいとATMで振り込みしようとした。初画面に、振り込み詐欺注意の大きな図が出て来た。 次をめくると、カードか振り込み通帳を利用してください。現在、現金での振り込みは扱っておりませんですって。前は現金OKだったのに。。カードを持って出直しですよ。
年寄りのタンス貯金を使えないようにしてるんだな。振り込み詐欺の水際防止作戦の一環だろうね。まあ、これが公式見解。本当は銀行屋も現金を扱いたくない。だから真綿で首を絞める誘導作戦。新規口座開設で通帳を作ると金を取るご時世ですから。
それから数日前のTVでやってたんだけど、都会ではATMが続々と撤去されてるらしい。その一等地は争奪戦がすさまじいとか。跡地は、プリン屋さんとか、サンドイッチ屋さんが入居してるとか。ATMが無くなるって事は、スマホで決済しろって事か。
nprolog
とある方を経由して、 nprolog なんてのを知った。nprologのnは、ノスタルジアの意味を込めてあるそうだ。オイラーにもぴったりだな。この分野だとswi-prologとかgprologと言う巨大な奴が居るけど、それじゃ大変だからね。早速DLして、OpenBSD 6.8(i386)に入れてみる。
vbox$ make
gcc -Wall -O3 -c main.c
main.c:8:10: fatal error: stdio_ext.h: No such file or directory
#include <stdio_ext.h>
^~~~~~~~~~~~~
compilation terminated.
*** Error 1 in /tmp/nprolog (<sys.mk>:87 'main.o')
そんなヘッダー無いとな。無い袖は振れないので、コメントアウトして 続けてみると、
gcc -Wall -O3 -c main.c
In file included from main.c:9:
main.c: In function 'debugger':
npl.h:196:29: warning: implicit declaration of function '__fpurge'; did you mean
'fpurge'? [-Wimplicit-function-declaration]
#define FLUSH __fpurge(stdin);
^~~~~~~~
main.c:566:5: note: in expansion of macro 'FLUSH'
FLUSH
^~~~~
gcc -Wall -O3 -c parser.c
gcc -Wall -O3 -c function.c
gcc -Wall -O3 -c builtin.c
builtin.c:1:10: fatal error: stdio_ext.h: No such file or directory
#include <stdio_ext.h>
^~~~~~~~~~~~~
compilation terminated.
*** Error 1 in /tmp/nprolog (<sys.mk>:87 'builtin.o')
他にも無理強いしてる所はerror.cだったんで、コメントアウト。
gcc main.o parser.o function.o builtin.o extension.o link.o data.o gbc.o cell.o error.o bignum.o compute.o edit.o -o npl -lm -ldl ld: error: unable to find library -ldl collect2: error: ld returned 1 exit status *** Error 1 in /tmp/nprolog (makefile:27 'npl')
今度は -ldlで失敗。ｇｇしてみると、リナのソースをOpenBSDに移植する人が多数悩んでいた。結論を書くと、ダイナミックロードなんて多用される技法だから、OpenBSDではlibcに吸収しちゃったよ。未だに別になってるのはリナだけだよとの事。よってmakefileから-ldlを削除。
gcc main.o parser.o function.o builtin.o extension.o link.o data.o gbc.o
cell.o error.o bignum.o compute.o edit.o -o npl -lm
ld: error: undefined symbol: __fpurge
>>> referenced by main.c
>>> main.o:(debugger.part.5)
:
上で見逃していたエラーが復活してきた。 __fpurge なんてのはOpenBSDには無いとな。ならばリナではどうなってる？ 尼寺へ行けじゃなくて、manを引け。
SYNOPSIS
/* unsupported */
#include <stdio.h>
int fpurge(FILE *stream);
/* supported */
#include <stdio.h>
#include <stdio_ext.h>
void __fpurge(FILE *stream);
CONFORMING TO
These functions are nonstandard and not portable. The function
fpurge() was introduced in 4.4BSD and is not available under Linux.
The function __fpurge() was introduced in Solaris, and is present in
glibc 2.1.95 and later.
正統派なやつはfpurgeなのね。するってえとリナは、もどきなんだな。そんな事でnpl.hを修正。make cleanしてから再コンパイルしたら実行ファイルが無事に作成された。
vbox$ ./npl ksh: ./npl: Cannot allocate memory vbox$ ulimit -a : data(kbytes) 524288 : vbox$ ulimit -d 1524288 vbox$ ./npl N-Prolog Ver 1.2 ?- X is 2^100. X = 1267650600228229401496703205376 . yes ?- halt. - good bye -
メモリー不足で起動せず。OpenBSDの32Bit版では、ヒープエリアが控え目に設定されてるんで増やしてあげた。そしたら、動き始めた。
makefileではgccが使われいるけど、OpenBSDのデフォのコンパイラーはccだ。llvm由来のccに切り替えて再コンパイル。
bignum.c:1017:13: warning: absolute value function 'abs' given an argument of
type 'long long' but has parameter of type 'int' which may cause
truncation of value [-Wabsolute-value]
j = abs(j);
^
bignum.c:1017:13: note: use function 'llabs' instead
こんな有り難い忠告を受けたよ。冷酒と親の小言は後で効く、かな？
後は探検の為に、etags *.[ch] だな。まて、お前prologの事良く知らないだろう。何か適当な資料は無いか？ 探したら『７つの言語 ７つの世界』とか『On Lisp』に資料が見つかった。 久しぶりに紐解いてみるかな。
ちょいとソースをブラウズしてたら
#elif __OpenBSD__
printf("\a");
#endif
こんなのに出くわしたけど、OpenBSDでの協力者が居るのかな？ それとも作者さん自身が密かなOpenBSD信奉者なのかな。
xml
通奏低音のようにRをそしてe-Statに憑りついている。それじゃお化けだろう。
R上のxml editor?
> library(XML)
> doc = xmlInternalTreeParse("po.xml")
> getNodeSet(doc, '/GET_STATS_DATA/STATISTICAL_DATA/CLASS_INF')
[[1]]
<CLASS_INF>
<CLASS_OBJ id="cat01" name="認知・検挙件数・検挙人員">
<CLASS code="100" name="認知件数" level="1" unit="件"/>
<CLASS code="110" name="検挙件数" level="1" unit="件"/>
<CLASS code="120" name="検挙率" level="1" unit="%"/>
<CLASS code="130" name="検挙人員" level="1" unit="人"/>
<CLASS code="150" name="検挙人員_うち少年" level="2" unit="人" parentCode="130"/>
</CLASS_OBJ>
<CLASS_OBJ id="cat02" name="罪種">
<CLASS code="100" name="刑法犯総数" level="1"/>
<CLASS code="110" name="凶悪犯" level="2" parentCode="100"/>
:
<CLASS code="2007000000" name="2007年" level="1"/>
<CLASS code="2006000000" name="2006年" level="1"/>
</CLASS_OBJ>
</CLASS_INF>
attr(,"class")
[1] "XMLNodeSet"
汎用的 down loader for xml
e-StatをRから使うってのでｇｇしてると、皆さんjsonがお好きなようです。jsonは軽くていいんだけど、どうもR内で使うには便利だけどR外では、不便。
この際XML主体で行きたい。なんたってemacsで簡単に閲覧できるからね。いざとなったら直接データを切り貼り（それってデータのねつ造じゃん）出来るからね。
と言う事で、shellからダウンロード出来るように汎用化しとく。
#! /bin/sh # Usage: fromes statsDataId ;;ex. fromes 0003191320 MY=40byte-your-appID curl -o $1.xml "https://api.e-stat.go.jp/rest/2.1/app/getStatsData?appId=$MY&lang=J&statsDataId=$1&metaGetFlg=Y&cntGetFlg=N§ionHeaderFlg=1"
ダウンロードしたい表のidを指定するだけ。結果は、表id.xmlってファイルになる。これで、APIボタンをクリックして、statsDataIdを抜いて、上記スクリプトに喰わせるだけだ。バンバンDLしよう。
表のidを指定しないと、哀れな事に、.xml って言う普段は見えないエラーだよファイルが作成されちゃう。本来なら何とかしないといけないんだけど、個人使用って事で、引数チェックをさぼってます。使う人は注意めされ。
鉄板な処理
奥村先生のe-statページに、素晴らしい鉄板処理例が載ってた。
library(XML)
foo = function(x) {
n = getNodeSet(doc, paste0("//CLASS_OBJ[@id='", x, "']/CLASS"))
tbl = sapply(n, xmlGetAttr, "name")
names(tbl) = sapply(n, xmlGetAttr, "code")
tbl[sapply(items, xmlGetAttr, x)]
}
doc = xmlParse("0003033021.xml")
items = getNodeSet(doc, "//VALUE")
cat01 = foo("cat01")
cat02 = foo("cat02")
cat03 = foo("cat03")
area = foo("area")
time = foo("time")
value = as.numeric(sapply(items, xmlValue))
df = data.frame(cat01, cat02, cat03, area, time, value)
指定した列データを取り出して来て、フレームを組み立てる。味噌はfoo関数だな。
> df1 = subset(df, cat01=="男" & cat03=="日本人" & area=="全国") > df2 = subset(df, cat01=="女" & cat03=="日本人" & area=="全国") > df1$cat02 [1] "総数（年齢）" "0歳" "1歳" : [100] "98歳" "99歳" "100歳以上" > plot(0:100, df2$value[2:102], type="o", xlab="Age", ylab="Population") > points(0:100, df1$value[2:102], pch=16, type="o")
得られたフレームを元に男のフレームと女のフレームをsubsetで作り出す。年齢は総数から始まって、最後の方に余分なやつが付いている。 そこで、値の範囲を 2:102 として、０歳から１００歳以上のデータを折れ線グラフで書く。
> head(df)
cat01 cat02 cat03 area time value
1 総数（男女別） 総数（年齢） 総数（国籍） 全国 2010年 128056000
2 総数（男女別） 総数（年齢） 総数（国籍） 全国市部 2010年 116184500
3 総数（男女別） 総数（年齢） 総数（国籍） 全国郡部 2010年 11871500
4 総数（男女別） 総数（年齢） 日本人 全国 2010年 125691800
5 総数（男女別） 総数（年齢） 日本人 全国市部 2010年 113902100
6 総数（男女別） 総数（年齢） 日本人 全国郡部 2010年 11789700
> head(df1)
cat01 cat02 cat03 area time value
664 男 総数（年齢） 日本人 全国 2010年 61339900
670 男 0歳 日本人 全国 2010年 544800
676 男 1歳 日本人 全国 2010年 542200
682 男 2歳 日本人 全国 2010年 551800
688 男 3歳 日本人 全国 2010年 546800
694 男 4歳 日本人 全国 2010年 541200
> tail(df2, n=10)
cat01 cat02 cat03 area time value
1924 女 99歳 日本人 全国 2010年 2.210000e+04
1930 女 100歳以上 日本人 全国 2010年 3.980000e+04
1936 女 不詳 日本人 全国 2010年 2.135000e+05
1942 女 （再掲）15歳未満 日本人 全国 2010年 8.096200e+06
:
これが鉄板な処理プログラムなるな。グラフ描きもこれで自由自在だ。
この例の素晴らしいのは、使うライブラリーが一つだけって事。しかもそのライブラリーの根幹は、emacsでも使っているlibxmlってやつ。信頼おけるし、扱いが楽だ。 ともすればRでも、ごまんととライブラリーを使ってるのを見る事がある。そんなに沢山のライブラリィーの使い方を覚えるのは、年寄りに苦痛です。
そういう理由もありpythonで自由奔放にimportしてるのを見ると、ゾッとしますね。地獄が待っている気がするぞ。
RからのXMLをちゃんとやるなら、 An XML package for the S language を見ておけかな？ 表題にはSって書いてあるけど、R == S と思うぞ。昔unix上の統計ソフトと言ったら有料のSしかなかった（その後、S pulsとかの派生が出たけど、相変わらず有料）。貧乏大学は、おいそれと導入出来なかった。そこで発奮して、無料かつソース公開版を作った。それがRだ。
最初は論文とか学会ではRを無視（と言うかいじめられていた。Rを使った論文はそれだけで受理されなかったらしい）されていた。まあ、何処の世界も一緒だわな。白人優越主義。黄色とか黒は下等とみなしていた、、、今もそうかな。
Rはどんどん発展。そしてやっと市民権を得た。先人の偉大な努力で天国に入る事が出来たんですよ。心して使えよ。＞オイラー。
step 実行
上で出て来た鉄板な処理で中核は関数 foo(x) だ。その入出力が分かっているので、そんなものって、打っちゃってもいいんだけど、それじゃ奥村先生に失礼だ。よって、この関数をステップ実行して、やってる事を理解したい。そんなのトレースでいいじゃん。待て、emacs上からRしてるんで、簡単に切り貼り実行出来るから、今回はその方向でやってみる。
供試データは、犯罪統計のうちの下記の部分。
<CLASS_OBJ id="time" name="時間軸(年次)">
<CLASS code="2016000000" name="2016年" level="1"/>
<CLASS code="2015000000" name="2015年" level="1"/>
:
<CLASS code="2006000000" name="2006年" level="1"/>
</CLASS_OBJ>
これを肴にするんで、x = 'time' としておく。
> paste0("//CLASS_OBJ[@id='", x, "']/CLASS")
[1] "//CLASS_OBJ[@id='time']/CLASS"
こんな検索用の文字列が生成される。
> n = getNodeSet(doc, paste0("//CLASS_OBJ[@id='", x, "']/CLASS"))
> n
[[1]]
<CLASS code="2016000000" name="2016年" level="1"/>
[[2]]
<CLASS code="2015000000" name="2015年" level="1"/>
:
[[11]]
<CLASS code="2006000000" name="2006年" level="1"/>
attr(,"class")
[1] "XMLNodeSet"
クラスオブジェクトのid=timeを検出して、その内容を得るんだな。
> tbl = sapply(n, xmlGetAttr, "name") > tbl [1] "2016年" "2015年" "2014年" "2013年" "2012年" "2011年" "2010年" "2009年" [9] "2008年" "2007年" "2006年"
次は、そこからnameのキーが付いたものを拾いだしてる。
> names(tbl) = sapply(n, xmlGetAttr, "code") > names(tbl) [1] "2016000000" "2015000000" "2014000000" "2013000000" "2012000000" [6] "2011000000" "2010000000" "2009000000" "2008000000" "2007000000" [11] "2006000000"
それのコードも拾い出してる。
!> tbl[sapply(items, xmlGetAttr, x)] 2016000000 2015000000 2014000000 2013000000 2012000000 2011000000 2010000000 "2016年" "2015年" "2014年" "2013年" "2012年" "2011年" "2010年" : 2012000000 2011000000 2010000000 2009000000 2008000000 2007000000 2006000000 "2012年" "2011年" "2010年" "2009年" "2008年" "2007年" "2006年"
これが、関数fooからの返値になる。対象は、グローバル変数items中の、timeだ。
> rv = tbl[sapply(items, xmlGetAttr, x)] > length(rv) [1] 2310 > length(items) [1] 2310 !> head(items, n=3) [[1]] <VALUE cat01="100" cat02="100" time="2016000000" unit="件">996120</VALUE> [[2]] <VALUE cat01="100" cat02="100" time="2015000000" unit="件">1098969</VALUE> [[3]] <VALUE cat01="100" cat02="100" time="2014000000" unit="件">1212163</VALUE>
返値を変数にバインドして、元データを比べてみた。
!> str(rv) Named chr [1:2310] "2016年" "2015年" "2014年" "2013年" "2012年" "2011年" ... - attr(*, "names")= chr [1:2310] "2016000000" "2015000000" "2014000000" "2013 000000" ...
fooな関数は、表名を指定すると、その値を得る関数なんだな。
ちょいと発展
先生の講義を追った後は、発展問題です。お第は実用的なものって事で、 罪種をカテゴリー分けしてるレベルを得てみる。
<CLASS_OBJ id="cat02" name="罪種">
<CLASS code="100" name="刑法犯総数" level="1"/>
<CLASS code="110" name="凶悪犯" level="2" parentCode="100"/>
<CLASS code="120" name="凶悪犯_殺人" level="3" parentCode="110"/>
<CLASS code="130" name="凶悪犯_強盗" level="3" parentCode="110"/>
:
<CLASS code="270" name="知能犯" level="2" parentCode="100"/>
<CLASS code="280" name="知能犯_詐欺" level="3" parentCode="270"/>
<CLASS code="290" name="知能犯_横領" level="3" parentCode="270"/>
fooに変わる関数を作るか？ そんな無駄はしない(少なくともlisperならばね）。高階関数もどきでいいじゃん。Rもそれを積極的に勧めている。
foo = function(x, what="name") {
n = getNodeSet(doc, paste0("//CLASS_OBJ[@id='", x, "']/CLASS"))
tbl = sapply(n, xmlGetAttr, what)
names(tbl) = sapply(n, xmlGetAttr, "code")
tbl[sapply(items, xmlGetAttr, x)]
}
デフォルト引数を用意しただけ。whatを指定しなかった場合、nameから拾ってくる。whatを指定したら、それに従う。これだけの修正である。
使い方の要点は
doc = xmlParse("0003191320.xml")
items = getNodeSet(doc, "//VALUE")
lvl = foo("cat02", what="level")
cat01 = foo("cat01")
cat02 = foo("cat02")
time = foo("time")
value = as.numeric(sapply(items, xmlValue))
df = data.frame(lvl, cat01, cat02, time, value)
df1 = subset(df, lvl=="2" & time=="2011年")
cat02からlevelを引いてくる。それらを元にフレームdfを作る。それを元に、例としてレベル２の犯種の大分類を2011年で絞り込んでみる。 その結果は、
> head(df)
lvl cat01 cat02 time value
1 1 認知件数 刑法犯総数 2016年 996120
2 1 認知件数 刑法犯総数 2015年 1098969
3 1 認知件数 刑法犯総数 2014年 1212163
4 1 認知件数 刑法犯総数 2013年 1314140
5 1 認知件数 刑法犯総数 2012年 1403167
6 1 認知件数 刑法犯総数 2011年 1502951
> head(df1, n=10)
lvl cat01 cat02 time value
17 2 認知件数 凶悪犯 2011年 7062
72 2 認知件数 粗暴犯 2011年 61897
149 2 認知件数 窃盗犯 2011年 1152492
193 2 認知件数 知能犯 2011年 40894
325 2 認知件数 風俗犯 2011年 10966
380 2 認知件数 その他の刑法犯 2011年 229640
479 2 検挙件数 凶悪犯 2011年 5287
534 2 検挙件数 粗暴犯 2011年 45095
611 2 検挙件数 窃盗犯 2011年 305922
655 2 検挙件数 知能犯 2011年 26433
元になる表であるdfを確認。そこから絞りこんだ結果を表示。
余談になるけど、DBのkeyとかに一見数値っぽいものが表れる。
<TABLE_INF id="0003191320">
<STAT_NAME code="00130001">犯罪統計</STAT_NAME>
<GOV_ORG code="00130">警察庁</GOV_ORG>
例えばこんなの。普通に考えたら、codeなんて数値でいいじゃんと思ってしまう。そうすれば冒頭の無駄と思われる０が省けて嬉しいぞ。
でも、数字と決め打ちしちゃうと、文字通り数値しか表現出来なくなる。DB屋さんは、それを嫌うんだろうね。固定長の文字列なら、アルファベット文字も入れられる。飛躍的に表現力が高まる。そんな理由で、採用してるんだろうね。
まあ、オイラーは頭の０が気になる。頭はポリスのPで始めるとかしてくれませんか。そうすれば、オイラーも諦めがつくってもんです（あっ、BASE64表現とか言い出さないでね）。
nxml-mode.el
emacsでは、サフィックスにxmlって付いているファイルを開くと、xml-modeが有効になる。 ふとっちょ括弧と言うかHTMLのタグの親分みたいなやつでデータを囲んだ文書だ。
ならば、括弧を結んで開いてって出来ると思うんだ。余計な所は編集とか閲覧には目障りなんで、そういう機能が有ってもよさそう。
んか、そんな機能はなさそうだ。nxml-mode.elを開いてざっと見したんだけどね。
(defvar nxml-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\M-\C-u" 'nxml-backward-up-element)
(define-key map "\M-\C-d" 'nxml-down-element)
(define-key map "\M-\C-n" 'nxml-forward-element)
(define-key map "\M-\C-p" 'nxml-backward-element)
閲覧に使えそうなキーバインドは、これぐらいしか無かった。中には、これにhtml-modeをかぶせて使ってる猛者もいるようですけど。