2018年11月11日日曜日

Haskell Day 2018 に参加してきた

ここ数年子育てで忙しく、なかなか勉強会に出れなかったのですが、久しぶりに行ってきました、非常に楽しかったのと、さらにhaskell最高って感じになって帰ってきました。


haskellを導入した話


後半で出てくる、HRR(Haskell relational record)は以前ちょっとやってみようと思いつつ今まで放置していたので、これを期にしっかりやってみようと思い、そんな話の中で、esqueletoがinvalidなsqlを吐くとか知らない情報もいただけたので良かった。

Servantで実現する高速かつ安全なAPI開発


実際に業務Servantを導入しているということでお話をききました、自分はYesodをチョロッと触った程度でServantをガチに触ったことないので、おもしろそうだなと感じた。YesodとServantってPythonでいうDjangoとFlaskみたな関係なのか。ただ、やっぱりhaskellの抽象化と型検査がガチガチに効いてる感があって非常に良かった。

並列並行言語Haskell


これはちょっと高度な話題で、半分ぐらい置いていかれてたがおもしろかった。多少、Haskellによる並列・並行プログラミングは読んでいたのでチョイチョイは理解できましたが、STMとかMVarとか適当な理解力のまま、放置していることもあるので、また暇を見つけて読もうかと...ただ、haskellのやり方は普通の言語のそれとは違って、綺麗に書けてるので気に入ってるかな、例えば評価戦略と実際の処理を分けて書いたりとか、このセッションは自分の勉強不足が身に染みた内容でした。

Semigroupとは?Monoid?環?


Haskellをやっていくといつしか遭遇するやつ、自分はまともに数学なんかやったこと無いので、数学的な話とか数式が出てきて完全に置いていかれるんだけどモナドとかやる上で必要。ただセッション自体が私なんかでも分かるように説明されていたので、非常に勉強になった。haskellをしっかり身につけたいなら一読した方がいいスライドだと個人的に思う。

gloss: 動かして遊んで学ぶHaskell


graphicsを使って遊びながら簡単に学べそうで、自分の子供にもそのうちやらせてみようかななんて感じた。でも業務でも、データをグラフ化したり視覚化するのに使えそうなので、一度いじって見ようかと感じている。

最後に


ちょっと簡単過ぎるけど、今回いってさらにhaskellを使い倒してみたくなったhaskell素人中年ジジィーになった感じでヤバい、主催者の方々、登壇の方々、有難うございました。

諸事情で最後までセッションを聞けなかったのは残念でしたが、またチョイチョイ顔を出すのでよろしくお願いします。

2018年9月20日木曜日

両耳イヤホン買いました

イヤホンが壊れて、片耳しか聞こえなくなってしまったので、両耳で聞ける、両耳イヤホンを買いました。
なにしろ、前のイヤホンはジャックから両耳まで線があるもんで、右手にビール左手にスマホという状況で、非常にウザい感じになる。

電話でもかかってきたら、もう、どうしていいかわからず、身を任せて車内を彷徨うばかり...

そういう理由で、IEEE802.15.1で規格化されている、ブルーチューシュな両耳イヤホンを購入


 スマホがSony製なのでこれ、お値段も6000円程度、ビックカメラのポイントが3000円程度あったので、安く買えました。

これで、両耳で音楽が聞けます、ただ、電話もイヤホン部についているボタンを押せば、通話ができるのですが、両手が塞がっているので状況が変わらないことに、今気ずきました。

Stereo出力なので、両耳で聞けるイヤホンを買ってください、片耳イヤホンを2つかってもジャックを挿すところはひとつです。

 

2018年8月29日水曜日

祝、双子と一緒に、Solaris11.4でた、とりあえずLocal Repository作っとけ

Solaris11.4でたよ


双子出てきた! 

と思ったら、

Solaris11.4でた!

って感じになってめでたいので、記念にローカルリポジトリ作った


Solaris11.4のインストールは熟練のSolaris遣いの偉い人にお願いして、私はローカルリポジトで我慢します、いろいろzoneとかゴリゴリ作る人はあった方がいいかも。

まずダウンロード


https://www.oracle.com/technetwork/server-storage/solaris11/downloads/local-repository-2245081.html
ここいって全部ダウンロードしてくる、

自分はsolaris 11.3のzone作ってそこにリポジトリ作ったよ

root@repo114:/share# ls -l
total 20267487
-rw-r--r--   1 500      500         4317  8月 29日  04:16 README-zipped-repo.txt
-rwxr-xr-x   1 500      500        12262  8月 29日  04:16 install-repo.ksh
-rw-r--r--   1 500      500      1968246581  8月 29日  04:17 sol-11_4-repo_1of5.zip
-rw-r--r--   1 500      500      1814619737  8月 29日  04:18 sol-11_4-repo_2of5.zip
-rw-r--r--   1 500      500      1772147401  8月 29日  04:19 sol-11_4-repo_3of5.zip
-rw-r--r--   1 500      500      2132702935  8月 29日  04:20 sol-11_4-repo_4of5.zip
-rw-r--r--   1 500      500      1939943920  8月 29日  04:21 sol-11_4-repo_5of5.zip
-rw-r--r--   1 500      500          495  8月 29日  04:21 sol-11_4-repo_digest.txt

リポジトリのファイルシステムを作成する


リポジトリデータを格納するファイルシステムを作成する
zone # zfs create -o mountpoint=/var/pkglocal rpool/pkglocal
そしたら作成する、同時にisoも作っておく
root@repo114:/share# ./install-repo.ksh -d /var/pkglocal -I
Using sol-11_4-repo download.
Uncompressing sol-11_4-repo_1of5.zip...done.
Uncompressing sol-11_4-repo_2of5.zip...done.
Uncompressing sol-11_4-repo_3of5.zip...done.
Uncompressing sol-11_4-repo_4of5.zip...done.
Uncompressing sol-11_4-repo_5of5.zip...done.
Repository can be found in /var/pkglocal.
Building ISO image...done.
ISO image can be found at:
/share/sol-11_4-repo.iso
Instructions for using the ISO image can be found at:
/var/pkglocal/README-repo-iso.txt
root@repo114:/share#
終わると、/var/pkglocalが初期化されてるので、pkg serverを起動する

root@repo114:~# svccfg -s application/pkg/server setprop pkg/inst_root=/var/pkglocal
root@repo114:~# svccfg -s application/pkg/server setprop pkg/readonly=true
root@repo114:~# svccfg -s application/pkg/server setprop pkg/port=80
root@repo114:~# svcadm refresh application/pkg/server
root@repo114:~# svcadm enable application/pkg/server
root@repo114:~# svcs -xv
ブラウザで、「http://192.168.0.20/」が見れればOK



Solaris11.4のpublisherを設定する


root@sol114-dev:~# pkg publisher
パブリッシャー              タイプ ステータス P 場所
solaris                     起点   オンライン F http://pkg.oracle.com/solaris/release/
ローカルのリポジトリに変更する
root@sol114-dev:~# pkg set-publisher -M '*' -G '*' -g http://192.168.0.20/ solaris
root@sol114-dev:~# pkg publisher
パブリッシャー              タイプ ステータス P 場所
solaris                     起点   オンライン F http://192.168.0.20/
完了、試しにzoneを作ってみる
root@sol114-dev:~# zonecfg -z bare create
root@sol114-dev:~# zoneadm -z bare install
次の ZFS ファイルシステムが作成されました:
    rpool/VARSHARE/zones/bare
Progress being logged to /var/log/zones/zoneadm.20180828T212530Z.bare.install
       Image: Preparing at /system/zones/bare/root.

 Install Log: /system/volatile/install.1381/install_log
 AI Manifest: /tmp/manifest.xml.kI3ood
  SC Profile: /usr/share/auto_install/sc_profiles/enable_sci.xml
    Zonename: bare
Installation: Starting ...

        Creating IPS image
Startup linked: 1/1 done
        Installing packages from:
            solaris
                origin:  http://192.168.0.20/
Creating Plan (Package planning: 106/415): /
library/ncurses                       92/415   13732/65388  113.1/428.2  510k/s
...
...
root@sol114-dev:~# zonecfg -z bare create
root@sol114-dev:~# zoneadm -z bare install
次の ZFS ファイルシステムが作成されました:
    rpool/VARSHARE/zones/bare
    Progress being logged to /var/log/zones/zoneadm.20180828T212530Z.bare.install
   Image: Preparing at /system/zones/bare/root.

外見るよりは早いので試してみてください、なんかいろいろ新機能入ってるし、やっぱsolarisは実機がほしいな...だれかくれ..

2018年6月10日日曜日

haskellでoracle databaseへつなぐ

oracle databaseへhaskellから簡単につなぐライブラリを探してたところ、odpic-rawなるものを発見。

これ、ODPI-Cのライブラリに依存しているのでそれもいれる。

そして、どっかのドキュメントへ書かれていたサンプルでつないでみる


{-# LANGUAGE OverloadedStrings #-}

import Database.Dpi

user = "testdb"
passwd = "xxxxxxxxxx"
host  = "192.168.253.13:1521/orcl"

main :: IO ()
main = do
    withContext $ \cxt ->
        withPool cxt user passwd host "utf-8" "utf-8" 2 $ \pool ->
            withPoolConnection pool $ \conn ->
                withStatement conn False "SELECT SYSDATE FROM DUAL" $ \st -> do
                    r <- executeStatement st ModeExecDefault
                    f <- fetch st
                    mapM (getQueryValue st) [1..r] >>= print
やってみる

Prelude> :load "/home/cuomo/Code/haskell/odpic/Odpic.hs"                                                                                                                                                                                                                        
[1 of 1] Compiling Main             ( /home/cuomo/Code/haskell/odpic/Odpic.hs, interpreted )
Ok, one module loaded.
*Main> main
[DataLocalTime 2018-06-10 17:52:42]

つながった...

パッケージの方は、gentoo-haskellの方へpull request送っておきました。

2018年6月7日木曜日

django 1.11.xでContextとRenderContextでエラー出た

最近djangoのバージョンを1.10系から1.11系に上げたところ、テンプレートの吐き出しで、

TypeError: context must be a dict rather than Context.

のエラーが出るようになった、ドキュメントで確認したところ、template.render()に、ContextやRenderContextが渡せなくなったよう。 なので、こういうコードは1.11系からダメなので、
def index(request):
    dic = {
        'title': 'index',
    }
    c = Context(dic)
    template = loader.get_template('index.html')
    return HttpResponse(template.render(c))
こういう風に普通にdictを渡す必要があるみたい。
def index(request):
    dic = {
        'title': 'index',
    }
    template = loader.get_template('index.html')
    return HttpResponse(template.render(dic))

久しぶりにdjango触ったので、ハマタよ..
ちなみにこちらに詳細がありまする...1.10から bump up する人は気をつけてね

https://docs.djangoproject.com/en/1.11/releases/1.11/#django-template-backends-django-template-render-prohibits-non-dict-context

2018年6月2日土曜日

gentooで、OpenCV + tesseract とGPU

画像から文字を取り出す


普通にOCR試したかっただけなのですが、結果から申しますと、期待していたほど精度もさほど良くなく、日本語の抽出はまったくうまくいきませんでした。(やり方がまずかったのか...)

設定と色々インストール


このマシンにはGeForce GTX 1050が刺さっているの、openclとopenglの動作する実装をeselectで切り替えておく
ugui7 ~ # eselect opencl list
Available OpenCL implementations:
  [1]   mesa
  [2]   nvidia *
ugui7 ~ # eselect opengl list
Available OpenGL implementations:
  [1]   nvidia *
  [2]   xorg-x11
ugui7 ~ # 

ちなみにopenclの実装をmesaに切り替えると、/usr/lib64/libtesseract.so.3の呼び出しでSEGVで腐る、多分、OpenclDeviceが帰ってこないようです。
#0  0x00007fffefd624b6 in strlen () from /lib64/libc.so.6
#1  0x00007fffee5ab5bf in OpenclDevice::getDeviceSelection() () from /usr/lib64/libtesseract.so.3
#2  0x00007fffee5ad1f8 in OpenclDevice::InitOpenclRunEnv_DeviceSelection(int) () from /usr/lib64/libtesseract.so.3
#3  0x00007fffee5ad25b in OpenclDevice::InitEnv() () from /usr/lib64/libtesseract.so.3
#4  0x00007fffee3b2e6a in tesseract::TessBaseAPI::Init(char const*, char const*, tesseract::OcrEngineMode, char**, int, GenericVector<STRING> const*, GenericVector<STRING> const*, bool) () from /usr/lib64/libtesseract.so.3
#5  0x00007ffff38ae61e in cv::text::OCRTesseract::create(char const*, char const*, char const*, int, int) () from /usr/lib64/libopencv_text.so.3.4
#6  0x000055555555785d in main () at ocrtesseract.cpp:16

話戻して、パッケージはこんな感じ
ugui7 ~ # emerge -pv app-text/tesseract media-libs/opencv

 * IMPORTANT: config file '/etc/portage/package.keywords' needs updating.
 * See the CONFIGURATION FILES and CONFIGURATION FILES UPDATE TOOLS
 * sections of the emerge man page to learn how to update config files.

These are the packages that would be merged, in order:

Calculating dependencies... done!
[ebuild   R    ] app-text/tesseract-3.05.01::gentoo  USE="doc jpeg opencl png tiff -examples -math -osd -scrollview -static-libs -training -webp" L10N="ja -ar -bg -ca -chr -cs -da -de -el -es -fi -fr -he -hi -hu -id -it -ko -lt -lv -nl -no -pl -pt -ro -ru -sk -sl -sr -sv -th -tl -tr -uk -vi -zh-CN -zh-TW" 0 KiB
[ebuild   R   ~] media-libs/opencv-3.4.1-r2:0/3.4.1::gentoo  USE="contrib contrib_dnn eigen ffmpeg gtk ieee1394 jpeg jpeg2k opencl opengl openmp png python tesseract threads tiff -contrib_cvv -contrib_hdf -contrib_sfm -contrib_xfeatures2d -cuda -debug -dnn_samples -examples -gdal -gflags -glog -gphoto2 -gstreamer (-ipp) -java -lapack -libav -openexr -pch -qt5 -testprograms -v4l -vaapi -vtk -webp -xine" ABI_X86="32 (64) (-x32)" CPU_FLAGS_X86="sse sse2 -avx -avx2 -fma3 -popcnt -sse3 -sse4_1 -sse4_2 -ssse3" PYTHON_TARGETS="python2_7 python3_6 -python3_4 -python3_5" 0 KiB

Total: 2 packages (2 reinstalls), Size of downloads: 0 KiB

 * IMPORTANT: 36 news items need reading for repository 'gentoo'.
 * Use eselect news read to view new items.

ugui7 ~ # 

取り出してみる


画像はこちら



OCRTesseract::create関数のengをjpnにすれば、日本語の解析ができるようですが、抽出はうまく出来ませんでした、なので英語版で動作確認です。
#include <opencv2/opencv.hpp>
#include <opencv2/text.hpp>

using namespace std;

int main(void)
{
    auto image = cv::imread("test.jpg");
    cv::Mat gray;
    cv::cvtColor(image, gray, cv::COLOR_RGB2GRAY);
    
    string result;
    vector<cv::Rect> boxes;
    vector<string> words;
    vector<float> confidences;
    printf("Initialize OCRTesseract...\n");
    auto ocr = cv::text::OCRTesseract::create("/usr/share/tessdata", "eng", NULL, cv::text::OEM_DEFAULT, cv::text::PSM_AUTO);
    ocr->run(gray, result, &boxes, &words, &confidences);

    cout << " String              | Posistion  | Size       | confidences" << endl;
    cout << "---------------------+------------+------------+------------" << endl;
    for (int i = 0; i < boxes.size(); i++) {
        printf("%-20s | (%3d, %3d) | (%3d, %3d) | %f\n",
               words[i].c_str(),
               boxes[i].x, boxes[i].y,
               boxes[i].width, boxes[i].height,
               confidences[i]);
    }
    cout << endl << "Result:\n-------" << endl;
    cout << result.c_str();

    return 0;
}

そして、ビルド、実行結果
cuomo@ugui7 ~/opencv $ gcc -g -O0 `pkg-config opencv --cflags --libs` -lstdc++ ocrtesseract.cpp
cuomo@ugui7 ~/opencv $ ./a.out 
Initialize OCRTesseract...
[DS] Profile read from file (tesseract_opencl_profile_devices.dat).
[DS] Device[1] 1:GeForce GTX 1050 score is 0.087704
[DS] Device[2] 0:(null) score is 0.372587
[DS] Selected Device[1]: "GeForce GTX 1050" (OpenCL)
 String              | Posistion  | Size       | confidences
---------------------+------------+------------+------------
The                  | ( 39,  54) | ( 37,  17) | 87.536118
first                | ( 91,  54) | ( 63,  17) | 71.520576
step                 | (169,  56) | ( 50,  19) | 85.904022
is                   | (234,  54) | ( 23,  17) | 73.084877
always               | (273,  54) | ( 75,  21) | 78.761841
the                  | (364,  54) | ( 37,  17) | 88.950020
hardest              | (417,  54) | ( 97,  17) | 46.006390
There                | ( 39,  80) | ( 63,  17) | 85.972023
is                   | (117,  80) | ( 23,  17) | 73.084877
no                   | (157,  85) | ( 23,  12) | 85.654243
royal                | (196,  80) | ( 62,  21) | 79.272545
road                 | (274,  80) | ( 48,  17) | 85.654243
to                   | (338,  82) | ( 24,  15) | 85.466003
learning             | (377,  80) | (111,  21) | 46.006390
It s                 | ( 39, 105) | ( 49,  18) | 26.470589
never                | (105, 111) | ( 61,  12) | 85.544647
too                  | (182, 108) | ( 37,  15) | 85.466003
late                 | (234, 106) | ( 50,  17) | 78.761841
to                   | (299, 108) | ( 24,  15) | 85.466003
learn                | (338, 106) | ( 72,  17) | 46.006390
Kuso                 | ( 39, 134) | ( 50,  15) | 85.498596
ka2                  | (104, 132) | ( 36,  17) | 72.482178
Dnaeha               | (156, 132) | (111,  17) | 46.006390

Result:
-------
The first step is always the hardest 
There is no royal road to learning 
It s never too late to learn 

Kuso ka2 Dnaeha

普通にかかれている英文はうまく取れましたが、「?」とか入っているとなんか腐るようです。

ほんとにGPU使ってんのか?


x11-drivers/nvidia-drivers-396.24パッケージにnvidia-smiというコマンドが入っているのでこれで確認してみた。
cuomo@ugui7 ~ $ nvidia-smi -l 1 -i 0
Sat Jun  2 10:00:37 2018
+-----------------------------------------------------------------------------+
| NVIDIA-SMI 396.24                 Driver Version: 396.24                    |
|-------------------------------+----------------------+----------------------+
| GPU  Name        Persistence-M| Bus-Id        Disp.A | Volatile Uncorr. ECC |
| Fan  Temp  Perf  Pwr:Usage/Cap|         Memory-Usage | GPU-Util  Compute M. |
|===============================+======================+======================|
|   0  GeForce GTX 1050    Off  | 00000000:01:00.0  On |                  N/A |
| 35%   35C    P0    N/A /  75W |    244MiB /  1999MiB |      0%      Default |
+-------------------------------+----------------------+----------------------+

+-----------------------------------------------------------------------------+
| Processes:                                                       GPU Memory |
|  GPU       PID   Type   Process name                             Usage      |
|=============================================================================|
|    0       445      G   /usr/bin/X                                   189MiB |
|    0     23555      C   ./a.out                                       43MiB |
+-----------------------------------------------------------------------------+
...

Type CなのでCompute Processでa.out動いてるっぽい、が、OCRてきなところは期待していたより、さほど良くないみたい。

2018年5月6日日曜日

gitのdescribe

gitのtag


コードやドキュメント書いていてgitに世話になっているのは私だけでは無いと思いますが、一人で使っているとcommit、pushの繰り返しになって、あまりtagコマンドは使わない。で暇だったのでtagをちょっと調べてみた。

tag一覧


tagの一覧の表示はこれ
cuomo@ugui7 ~/code $ git tag -l
0.3.0
1.0.0
1.1.0
1.2.0
...
...

3.5.0
3.6.0
cuomo@ugui7 ~/code $

最新のtagはどれ?


一覧の中の最新のタグはどれだってなる場合、describeをつかう
cuomo@ugui7 ~/code $ git describe --tag --abbrev=0
3.6.0
ちなみに--tagをつけないと--annotateで設定したタグしか出力しないので注意が必要、--abbrev=0をつけないと
cuomo@ugui7 ~/code $ git describe --tag
3.6.0-7-ga2e69a4
こういう出かた、意味は最新のtagから7コミットすすんでいて、そのhashがa2e694ということ、--abbrev=xでhashの出力桁数を調整出来る。サブオプションもちゃんと調べて使おう...

2018年4月22日日曜日

gentooでlet's encryptしてみた

そろそろSSL化しないとまずいと思っていたので無料SSLを試してみた、けっこう訳分からん404に遭遇して適当にやったのであまり当てにしないで

certbotのインストール


nginxにSSLを入れるのでこちらをインストール
# emerge app-crypt/certbot-nginx

証明書の発行


let's encryptがサイトの存在を確認しにファイルを探しに来るので、そのファイルにアクセスできるようにしておく、なんかファイル置いてブラウザで見れるか確認しておいた方がいい。
# mkdir -p /var/www/localhost/htdocs/.well-known/acme-challenge
でcertbotを実行
# certbot certonly --webroot -w /var/www/localhost/htdocs -d www.karky7.com
Saving debug log to /var/log/letsencrypt/letsencrypt.log
Plugins selected: Authenticator webroot, Installer None
Obtaining a new certificate
Performing the following challenges:
http-01 challenge for www.karky7.com
Using the webroot path /var/www/localhost/htdocs for all unmatched domains.
Waiting for verification...
Cleaning up challenges
Unable to clean up challenge directory /var/www/localhost/htdocs/.well-known/acme-challenge

IMPORTANT NOTES:
 - Congratulations! Your certificate and chain have been saved at:
   /etc/letsencrypt/live/www.karky7.com/fullchain.pem
   Your key file has been saved at:
   /etc/letsencrypt/live/www.karky7.com/privkey.pem
   Your cert will expire on 2018-07-21. To obtain a new or tweaked
   version of this certificate in the future, simply run certbot
   again. To non-interactively renew *all* of your certificates, run
   "certbot renew"
 - If you like Certbot, please consider supporting our work by:

   Donating to ISRG / Let's Encrypt:   https://letsencrypt.org/donate
   Donating to EFF:                    https://eff.org/donate-le

nginxへ設定


nginx.confにSSLの設定をいれる

    server {
        listen IP.xxx.xxx.xxx:443;
        server_name www.karky7.com;
        access_log /var/log/nginx/kuso.access_log_443 main;
        error_log /var/log/nginx/kuso.error_log_443 info;
        
        ssl on;
        ssl_certificate /etc/letsencrypt/live/www.karky7.com/fullchain.pem;
        ssl_certificate_key /etc/letsencrypt/live/www.karky7.com/privkey.pem;

        root /var/kuso/www;
        autoindex on;
        error_page 404 /error/404.html;
    }
で完了、結構簡単にできました、ちなみに「certbot run」はうまくいきませんでした。

あとはrenewで自動更新すればいいらしい、今度設定する

2018年4月7日土曜日

東京スタイル鶏らーめん ど・みそ鶏

最近食ったラーメン、白湯ベース、文句なしにうまい、


スープが扁桃腺に染み入ります...



醤油


おいちい...



味噌


一緒にいったラーメンマンが食べたので、私はまだ食べてません...次食ってみます



今のところ、個人的に醤油派の自分ですが塩がいいかな、今度は味噌やってみます。



2018年1月8日月曜日

passwdコマンドでAuthentication token lock busy

passwdコマンドでハマる


簡単な事って意外とハマるとツボって抜け出せなくなる。
kernelビルドしなおして再起動した後rootのパスワード設定しようとしようとしたら
# passwd root
Changing password for user root
New UNIX password:
Retype new UNIX password:

passwd: Authentication token lock busy
#
エラーが出る、昔見たような見ないような記憶が定かではないエラーで、しばらく悩んだ。
たまたま見てみると、/bootがmountされていない、/etc/fstabを見てみると腐ってる。
面倒だったのでstage3で/を強制的に上書きしたのがfstabが腐った原因。

なので、remountしてfstabを修正
# mount -o remount,rw / 

リブート後、ちゃんと帰ってきました
アルチューのみんな、ちゃんとupdateしようね。

2018年1月7日日曜日

gentooのprofiles上がってたの知らなかった

New 17.0 profiles in the Gentoo repository.


正月終わって、いきなり、CPU脆弱性祭り、なんか「ほんとは知ってたんじゃないのぉ」的な感じもしなくはないが、まぁメーカーを信じるとして、その乗りでgentooのアップデート調べてたら...



gentoo profiles が2017-11-30に上がってたの気がつかなかった、しょうがないのでアップデート。
gccはgcc-6.4.0以上にしたよとか、gccのPIEをディフォルトしたから、ビルドしなおしてねってとか、最近、MeltdownやらSpectreなんかで、アップデートしろっていうから面倒だけど諦めてやりましょう...

Sparc勢は余裕なんだろう ワロス

2018年1月3日水曜日

正月に Monad Transformer

あけまして、おめでとうございます


ミソカから元旦にかけて、あるチューhighまーのまま、stack overflowをおこし、体ダルダルで飲みつづけてます、本年もよろしくお願いします。



まず、今年の抱負


理由は聞かないでください
  • 一番搾りは350ml缶2本まで
  • 焼酎は薄めます
  • 「セイッ」は月に一度にする
今年も頑張るぞ!

もなどとらんすふぉーまーってなんだよ


それは、よく分かってません、とりあえずモナドを合成することらしいですが、やってみました、あってるかどうかは分かりませんが、動くのでいいでしょう。

まず、普通のStateもなど


よくみるサンプル、Identityは恒等モナドっていって、関数で言うidみたいなもんだと思ってて、それのモナド用らしい。
type Stack = [Int]

push :: Int -> StateT Stack Identity ()
push x = state $ \xs -> ((), x:xs)

pop :: StateT Stack Identity Int
pop = state $ \(x:xs) -> (x, xs)

ghciで
*Main> f = do {push 5; pop; pop;}
*Main> runIdentity (runStateT f [1,2,3])
(1,[2,3])
*Main>

runStateTでStateTモナドを走らせたら、Identity aが帰ってくるので、更にrunIdentityで剥がしているだけ。

エラーの時どうする?


こうやってpopしまくると、エラーになる
*Main> f = do {push 5; pop; pop; pop; pop; pop;}
*Main> runIdentity (runStateT f [1,2,3])
*** Exception: /home/cuomo/Code/haskell/MonadTransformer/MonadStack.hs:18:15-32: Non-exhaustive patterns in lambda

*Main> 

これは、\(x:xs)のパターンマッチが腐って、エラーになる、これはエラーとして処理したい、そんな時はpopをお利口チャンににして

push2 :: Int -> ExceptT String (StateT Stack Identity) ()
push2 x = state $ \xs -> ((), x:xs)

pop2 :: ExceptT String (StateT Stack Identity) Int
pop2 = do
    s <- get
    case s of
        x:xs -> put xs >> return x
        otherwise -> throwError "Stack is empty"
元々の機能にエラー処理を追加したことが、前のpopと違うところ、これはこうやって使う

*Main> f = do {push2 5; pop2; pop2; pop2; pop2; pop2;}
*Main> runIdentity (runStateT (runExceptT f) [1,2,3,4,5,6,7])
(Right 4,[5,6,7])
*Main> runIdentity (runStateT (runExceptT f) [1,2,3])
(Left "Stack is empty",[])
*Main> 

スタックから取るのが無いのに、popすると結果にLeft値がはいって失敗が分かるようになる、タプルの中にLeft値と腐った空の配列入れてきてもらっても、無意味っぽいので、別の書き方で...

push3 :: Int -> StateT Stack (ExceptT String Identity) ()
push3 x = state $ \xs -> ((), x:xs)

pop3 :: StateT Stack (ExceptT String Identity) Int
pop3 = do
    s <- get
    case s of
        x:xs -> put xs >> return x
        otherwise -> throwError "Stack is empty"

StateTとExceptTの位置を変えて逆にすると、結果がRight値、またはLeft値で出てくるようになる。
*Main> f = do {pop3; pop3; pop3; pop3; pop3; pop3;}
*Main> runIdentity (runExceptT (runStateT f [1,2,3,4,5,6,7]))
Right (6,[7])
*Main> f = do {pop3; pop3; pop3; pop3; pop3; pop3; pop3; pop3}
*Main> runIdentity (runExceptT (runStateT f [1,2,3,4,5,6,7]))
Left "Stack is empty"
*Main> 

成功すれば、Right値に結果がくるまれて、失敗した場合、Left値にエラーの文字列が入ってくるようになる、こっちの方がウケが良さそうな気がする。

操作をログでとる


さらにWriterTで何を突っ込んで、何を取り出したのをログする機能を追加してみる

type Log = [String]

push4 :: Int -> StateT Stack (WriterT Log (ExceptT String Identity)) ()
push4 x = do
    tell ["push " ++ show x]
    state $ \xs -> ((), x:xs)

pop4 :: StateT Stack (WriterT Log (ExceptT String Identity)) Int
pop4 = do
    s <- get
    case s of
        x:xs -> do
            tell ["pop " ++ show x]
            put xs >> return x
        otherwise -> do
            throwError $ "Stack is empty"

同じように...

*Main> runIdentity (runExceptT (runWriterT (runStateT f [1,2,3,4,5,6,7])))
Right ((4,[5,6,7]),["push 5","pop 5","pop 1","push 10","pop 10","pop 2","pop 3","pop 4"])
*Main> runIdentity (runExceptT (runWriterT (runStateT f [1,2,3])))
Left "Stack is empty"
*Main> 
外側のタプルの右側に操作したログが追加されるようになる。

最後にIOは


じゃぁ、この中でIOの処理入れたいんだど、どうすればいい? って疑問がわくよね、ここで、Identity a が効いてくる、IOとIdentityってkindすると

Prelude> :m +Control.Monad.Identity
Prelude Control.Monad.Identity> :k Identity
Identity :: * -> *
Prelude Control.Monad.Identity> :k IO
IO :: * -> *
Prelude Control.Monad.Identity> 

にてるよね、そう、IdentityのところへIOを入れられるようになって、liftIOでリフトしてIOな関数を利用する。

push5 :: Int -> StateT Stack (WriterT Log (ExceptT String IO)) ()
push5 x = do
    liftIO $ putStrLn "pushしまーすぅ"
    tell ["push " ++ show x]
    state $ \xs -> ((), x:xs)

pop5 :: StateT Stack (WriterT Log (ExceptT String IO)) Int
pop5 = do
    s <- get
    liftIO $ putStrLn "popすんぞ"
    case s of
        x:xs -> do
            tell ["pop " ++ show x]
            put xs >> return x
        otherwise -> do
            throwError $ show "Stack is empty"

これで、main()から呼んでみると
main :: IO ()
main = do
    v <- runExceptT (runWriterT (runStateT stackIjily [1,2,3,4,5,6,7]))
    putStrLn $ show v

stackIjily :: StateT Stack (WriterT Log (ExceptT String IO)) Int
stackIjily = do
    push5 5
    pop5
    pop5
    push5 10
    pop5
    pop5
    pop5
    pop5
    pop5
    x <- pop5
    return x

こうやると、関数の中でIOを発行することができる。

~/Code/haskell/MonadTransformer $ runghc MonadStack.hs
pushしまーすぅ
popすんぞ
popすんぞ
pushしまーすぅ
popすんぞ
popすんぞ
popすんぞ
popすんぞ
popすんぞ
popすんぞ
Right ((6,[7]),["push 5","pop 5","pop 1","push 10","pop 10","pop 2","pop 3","pop 4","pop 5","pop 6"])

こうやって、モナドを積んでいけば、既存の処理を壊すこと無く機能を追加できる、ただ、積み上げる順序によって剥がし方がかわるのと、ちょっと複雑になると分かりにくくなってしまうような気がする。まぁ慣れればそんなに気にする事でもなさそうな。

その他の、同じようなやつ


で、同じような理由で、RWSモナドとか、MonadWriterとかMonadStateとかMonadReaderとかあるみたいだけど、使ったこと無いです、こんどやってみます。

今年は、haskellの理解力をさらに深めたいと思います。