このブログを検索

2013/09/28

iOS7でミュージックの同期ができない

iPhone4SをiOS7にしたら、64GBの容量めいっぱいに入っていた音楽データが同期されなくなった。
データはあるように見えるが、再生できない。
iTunesを再インストールしたり、いったん同期設定を解除するなどしていたら、
iTunesで買ったものだけ復活したが、それも何度もダウンロードマークが出て
「クラウド」からダウンロードさせられたりするなど、ヘンな動作をしていた。
iOS7の不具合かと思って調べてみたが、どうやらそうではなくiTunesとiPhoneでは昔からよくあることのようだった。

iPhoneをPCにつなぐと、認識はされて同期も始まるのだが、最後のところで終わらない。
そのままにして寝たら一晩たっても終わっていなかった。


ボイスメモを消すと治るという情報を聞いてやってみたがダメだった。
結局、iPhoneを「設定」のところから初期化したら同期できるようになった。
写真はiPadにstreamで送られているのを確認し、電話番号は手で紙にメモした。

2013/08/17

excel関数使用時に文字を太字にする

excelでvlookupなどを使って他のセルから文字列を持ってきて、それに何かを付け加えているときに、

文字列の一部を太字にしたり下線を引いたりしたいということがあったが、

結局できないようなのであきらめた。

2013/07/15

twitterのbotが止まる

twitterのbotが止まっていた。

二つ動かしているのだが、二つとも6/11で止まっている。

tweetするスクリプトを手動で動かすと以下のようなエラーが出てツイートしない。

410: Gone 

同じアカウントを使っているpythonで作ったスクリプトだとツイートする。

これは、Net::Twitterが新しいAPIに対応していないためだろうと、
Net::Twitter::Liteを最新にするが、変わらない。

 検索すると、 Net::Twitter::Lite::WithAPIv1_1 を使うということがわかった。 

useとnewのところを直してうまくいった。


2013/06/13

tweepyアップデート

twitterでブロックしているユーザの一覧およびその解除をするpythonのスクリプトが動かなくなっていた。

C:\Users\t>python blocking.py
Traceback (most recent call last):
File "blocking.py", line 18, in <module>
results = api.blocks()
File "build\bdist.win32\egg\tweepy\binder.py", line 185, in _call
File "build\bdist.win32\egg\tweepy\binder.py", line 168, in execute
tweepy.error.TweepError: [{u'message': u'The Twitter REST API v1 will soon stop functioning. Please
migrate to API v1.1. https://dev.twitter.com/docs/api/1.1/overview.', u'code': 68}]


古いAPIのサポートが終わった、みたいなことを見かけたので動かなくなるんじゃないかと予想はしていた。
tweepyを使っているのだが、調べるとtweepyが新しいAPIに対応していたので更新しようとした。

C:\Users\t>easy_install tweepy
Searching for tweepy
Best match: tweepy 1.11
Processing tweepy-1.11-py2.7.egg
tweepy 1.11 is already the active version in easy-install.pth

Using c:\python27\lib\site-packages\tweepy-1.11-py2.7.egg
Processing dependencies for tweepy
Finished processing dependencies for tweepy


が、すでにインストールされています、となる。2.0が出ているのに・・・

easy_installで更新をするには -U をつけるということを知る。

C:\Users\t>easy_install -U tweepy
Searching for tweepy
Reading http://pypi.python.org/simple/tweepy/
Reading http://github.com/tweepy/tweepy
Reading http://github.com/joshthecoder/tweepy
Best match: tweepy 2.0
Downloading http://pypi.python.org/packages/2.7/t/tweepy/tweepy-2.0-py2.7.egg#md5=193993b0df7c4e28fb
a5bb457e401d91
Processing tweepy-2.0-py2.7.egg
Moving tweepy-2.0-py2.7.egg to c:\python27\lib\site-packages
Removing tweepy 1.11 from easy-install.pth file
Adding tweepy 2.0 to easy-install.pth file

Installed c:\python27\lib\site-packages\tweepy-2.0-py2.7.egg
Processing dependencies for tweepy
Finished processing dependencies for tweepy


無事、動くようになった。

その他、不完全ながらphpやperlで作った、webで使えるスクリプトもあるのだがそれらも全部動かなくなっている。

多分同じようにライブラリを更新すればいいのだと思うがメンドクサイからまた今度。

2013/05/29

LATITUDE D430にWindows XPをインストールする

1年程前に秋葉原で買った中古。8000円くらいだった。
出張中に主にメールのやりとりと会社へVPNアクセスするのに使った。
その後その必要がなくなり、CentOSを入れたりFreeBSDを入れたりしていた。
やっぱりWindowsは何かと便利で必要になることも多いのでまたWindowsに戻すことにした。
CDドライブは外付けのものが付属している。ケーブルはUSBに似ているがプラグが二個重なったような特殊なものだ。

XPのCDをいれてブートする。BSDの入っていたパーティションを削除し、NTSFでクイックフォーマットする。
XPのインストールは特に問題なく進む。
ネットワークアダプタは認識されず、1394インタフェースのみが認識される。間違ってそちらにアドレス等を設定してしまう。

自宅にはデスクトップPCがあって、NICが2枚ついていてブリッジ接続して、ノートPCはそこに有線LANでつなぎIPアドレスは固定で設定していた。無線LANアダプタはあるがLinuxで無線LAN設定がうまくいかなかったためだ。
XPなら無線が使える。だが、当然XPはドライバを持っていない。

デスクトップPCでLATITUDE D430のドライバをダウンロードし、USBメモリにコピーしてD430にうつしてインストールする。ネットワークのドライバさえ入れてしまえば後はインターネットで、と思ったがインストールしたてのXPでIE6ではWindows UpdateやMSのダウンロードサイトすらまともに見えない。

XPのSP3もデスクトップPCでダウンロードしてUSBメモリでコピーしてまずSP3をインストールする。
それからネットワーク、オーディオ、ビデオなどのドライバを入れていく。
ここまでは有線LANでデスクトップPCにブリッジ接続している。


最後に無線LANのドライバを入れる。アダプタは指の爪くらいの小さなもので、「Buffalo」の文字しか書いていない。ほかに小さく英数字でいろいろ書いてあるがどれも型番ではなく、どのドライバを落とせばいいのかわからない。
説明書を探して、ようやく型番がわかる。

EMOBILEの無線LANルータにつなげる。
有線LANのケーブルを抜く。

Chrome、Evernote、秀丸などをインストールする。
メインブラウザはChromeを使うが、IEが必要になる場合もあるだろうから8にしておく。

終わり。

Linuxなどではドライバインストールが不要だったことがなぜだろうと思ったがそれは単に新しくてドライバを持っているだけだ、と気づいた。
でもありとあらゆるPCのディスプレイやネットワークのドライバなどを持つのも大変じゃないかなあと思う。
汎用的なものを使ったりしているのだろうか?

2013/05/28

cobolは一行にかける文字数に制限がある

ということを忘れていた。

1行の桁数は80桁であり、さらにそのなかでコードを書ける領域は限られていて、
8桁目から72桁めの65桁である。最初の6桁は行番号を書く場所である。
ずいぶん少ないな。
7桁めに "-" を書くことで前行に続けて書くことができるのだが、あまり使った記憶がない。
というわけで謎のエラーは後ろがはみ出していたことが原因であった。

2013/05/26

opencobol

ちょっとcobolをやってみようと思う。
かつて仕事で使っていた。
opencobolをインストールしてみる。

wget http://sourceforge.net/projects/open-cobol/files/open-cobol/1.1/open-cobol-1.1.tar.gz/download

解凍して、configure, make, make install...
と思ったらmakeができない。
よく見るとconfigureの最後にエラーが出ている。

configure: error: gmp.h is required

gmpとは、The GNU Multiple Precision Arithmetic Library のことのようだ。http://gmplib.org/ からダウンロードしてくる。

wget ftp://ftp.gmplib.org/pub/gmp-5.1.2/gmp-5.1.2.tar.lz

拡張子がlz.... LHAで圧縮されているのか?なんで?
linuxでlzhのファイルを扱うのは初めてだ。
tarに --lzip というオプションがあることがわかったので指定するが失敗する。lhaをインストールしないといけないのか。

# tar xf gmp-5.1.2.tar.lz --lzip
tar (child): lzip: exec 不能: そのようなファイルやディレクトリはありません
tar (child): Error is not recoverable: exiting now
tar: Child returned status 2
tar: Error is not recoverable: exiting now

lzipを持ってくる。

http://sourceforge.jp/projects/freshmeat_lzip/releases/

windowsで落としてftpでさくらのVPSのcentosに送った。
解凍してconfigure, make, make install
tarの--lzipオプションが使えるようになった。
無事解凍。

gmpをconfigure, make, make install

opencobol再度configure... できた。make, make install

サンプルソースをコンパイルしてみる。

cobc -x hello.cob

実行してみると、

./hello: error while loading shared libraries: libcob.so.1: cannot open shared object file: No such file or directory

/usr/local/libにちゃんと libcob.so.1はある。
調べると、ldconfigをすればよいことがわかる。

参考 http://d.hatena.ne.jp/GARAPON/20100406/1270567339

動いた!

# ./hello
Hello World
0
Hello World
0
Hello World
2

ちなみにソースは http://codezine.jp/article/detail/2291?p=4
にあったもの。

123456*890123456789012345678901234567890123456789012345678901234567890
IDENTIFICATION DIVISION.
PROGRAM-ID.    SAMPLE1.
AUTHOR. Eiichi Fuse.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 CMD PIC 9.
PROCEDURE DIVISION.
PG-TOP.
DISPLAY "Hello World".
ACCEPT CMD.
IF CMD = 0 THEN GO TO PG-TOP.
STOP RUN.

ファイルを読んで集計する。

123456*890123456789012345678901234567890123456789012345678901234567890123456789
IDENTIFICATION   DIVISION.
PROGRAM-ID.      MYPROG01.
ENVIRONMENT      DIVISION.
INPUT-OUTPUT     SECTION.
FILE-CONTROL.
SELECT  MEIBO   ASSIGN  TO "meibo.txt"
ORGANIZATION    LINE    SEQUENTIAL
FILE STATUS IS MEIBO-STS.
DATA             DIVISION.
FILE             SECTION.
FD       MEIBO.
01       MEIBO-RECORD.
05      BANGOU          PIC X(8).
05      NAMAE           PIC X(20).
05      TELEPHONE       PIC X(15).
05      JUSHO           PIC X(20).
05      SALARY          PIC 9(8).
WORKING-STORAGE  SECTION.
01 MEIBO-STS     PIC XX.
01 GOUKEI        PIC 9(10)       VALUE ZERO.
01 JUDGE         PIC X.
88      ZOKKO           VALUE "1".
88      SHURYO          VALUE "2".
PROCEDURE        DIVISION.
MAIN             SECTION.
HAJIME.
OPEN    INPUT           MEIBO.
SET     ZOKKO           TO      TRUE.
YOMIKOMI.
PERFORM UNTIL           SHURYO
READ    MEIBO
AT END
SET     SHURYO  TO      TRUE;
NOT AT END
DISPLAY BANGOU NAMAE SALARY
ADD SALARY      TO      GOUKEI
END-READ
END-PERFORM.
DISPLAY         GOUKEI.
OWARI.
CLOSE                   MEIBO.
STOP                    RUN.


DISPLAY文で見出しをつけようと "number:" などというのを挟むと正しく表示されなかったりコンパイルエラーになったりする・・・

なぜだろう・・・

ファイルの項目を日本語にしてみたがうまくいかない・・・日本語対応が不十分という情報もみかけた・・・

2013/05/08

FreeBSDでマウスが動かない

インストール中は動いていたのだが、startxをやるとマウスカーソルが動かない。
マウスの設定ができていないのかと、sysinstallでもう一度やってみるが変わらず。

http://www.freebsd.org/doc/ja/books/handbook/x-config.html

に、/etc/rc.confに以下の記述をしましょうとあったのでやって、再起動したら動くようになった。

hald_enable="YES"
dbus_enable="YES"

味も素っ気もないウィンドウ画面である。だが、これがUNIXっぽくていい。

起動するとき、"Starting sshd." が表示されて10秒程度止まるのが気になる。

2013/05/07

FreeBSD

久しぶりに使ってみる。

Linuxとの違いはなんだろう?ほとんどわからない。
インストールするためにisoイメージをダウンロードしCDやDVDに焼くが、失敗する。
1回目、9.1をCDに焼く。失敗。もういちど同じイメージを別ディスクに焼く。失敗。
9.1のDVD用のイメージがあるのでそちらを焼く。失敗。
8.3のDVDイメージを焼く。ようやくインストールできた。

インストール中にSSHを有効にするかと聞いてきたので設定するが、
ログインできない。
ポート番号22とか、PermitRootLogin=noとかを有効にして、
ようやく入れるようになった。

だが、今度はsuできない。
wheelグループに入れればよいことがわかった。

pw hoge -n user -G wheel


2013/05/02

psで表示した特定のプロセスをkillする

以下のようにプロセスを起動した。

bash loop.bash&

表示

ps au
# ps au
USER       PID %CPU %MEM    VSZ   RSS TTY      STAT START   TIME COMMAND
root      1899  0.0  0.0   4060   456 tty1     Ss+  Apr21   0:00 /sbin/mingetty /dev/tty1
root      1900  0.0  0.0   4076   504 ttyS0    Ss+  Apr21   0:00 /sbin/agetty /dev/ttyS0 115200 vt100-nav
root     18518  0.0  0.1 108468  1872 pts/1    S+   13:09   0:00 -bash
root     19122  0.0  0.1 106092  1220 pts/0    S    14:27   0:00 bash loop.bash
root     19277  0.0  0.1 110232  1136 pts/0    R+   14:30   0:00 ps au


grepで特定する

# ps au|grep loop.bash
root     19122  0.0  0.1 106092  1220 pts/0    S    14:27   0:00 bash loop.bash
root     19343  0.0  0.0 107456   912 pts/0    S+   14:31   0:00 grep loop.bash


grep自体が表示されてしまうのでそれを除く

# ps au|grep loop.bash|grep -v grep
root     19122  0.0  0.1 106092  1224 pts/0    S    14:27   0:00 bash loop.bash


これでプロセスが特定できた。
kill するには以下のようにプロセス番号を指定すればよい。

kill 19122

まず、プロセス番号のみを表示する。

# ps au|grep loop.bash |grep -v grep|awk '{print $2}'
19483

xargsで渡して killする。

# ps au|grep loop.bash |grep -v grep|awk '{print $2}'|xargs kill
[1]+  終了しました      bash loop.bash


強制終了するなら

# ps au|grep loop.bash |grep -v grep|awk '{print $2}'|xargs kill -9
[1]+  強制終了            bash loop.bash


2013/05/01

備忘録

unset_linguas () {
export LC_ALL=C
export LC_MESSAGES=C
export LANGUAGE=C
export LANG=C
}

make_tmp_dir () {
local TMP_ROOT="${1:-${TMP_ROOT:-${HOME}}}"
local tmpdir=$(basename "$0")$$

tmpdir="${TMP_ROOT}/${tmpdir}"

mkdir "${tmpdir}" > /dev/null 2>&1
if [ $? -eq 0 ]; then
echo "${tmpdir}"
chmod 700 "${tmpdir}"
else
echo "Can't create cirectory: ${tmpdir}" 1>&2
return 1
fi
}


clean_tmp_dir () {
local TMP_ROOT="${1:-${TMP_ROOT:-${HOME}}}"
local tmpdir=$(basename "$0")$$

tmpdir="${TMP_ROOT}/${tmpdir}"

if [ ! -d "${tmpdir}" ]; then
echo "No such directory: ${tmpdir}" 1>&2
return 1
fi

if [ -L "${tmpdir}" ]; then
echo "Can't delete unexpected symlink: ${tmpdir}" 1>&2
return 1
fi

rm -rf "${tmpdir}" > /dev/null 2>&1

}


#!/bin/bash

MAIL_FROM="hoge@example.com"
MAIL_TO="foo@example.com"
MAIL_SUBJECT="テストメール"
MAIL_ID="<$(date +%Y%m%d%H%M%S).$(id -ru).$$@$(hostname)>"
SENDMAIL=/usr/lib/sendmail

FILE_UTIL=util_common.bash
. "${FILE_UTIL}" 2> /dev/null \
|| . "${0%/*}/${FILE_UTIL}" 2> /dev/null
if [ $? -ne 0 ]; then
echo "Can't load ${FILE_UTIL}!" 1>&2
exit 1
fi

unset_linguas

tmpdir=$(make_tmp_dir 2>/dev/null)
if [ $? -ne 0 ]; then
echo "Can't create temporary directory!" 1>&2
exit 2
fi

SIGNALS="HUP INT QUIT PIPE TERM"
trap "{ clean_tmp_dir; exit; }" ${SIGNALS}

subject=$(echo -n "${MAIL_SUBJECT}" |
iconv -f UTF-8 -t ISO-2022-JP |
perl -MMIME::Base64 -ne 'print encode_base64($_)')

mail_data="${tmpdir}/mail_data"
cat <<EOF > "${mail_data}"
Mime-Version: 1.0
Content-Type: Text/Plain; charset=iso-2022-jp
Content-Transfer-Encording: 7bit
From: ${MAIL_FROM}
To: ${MAIL_TO}
Subject: =?ISO-2022-JP?B?${subject}?=
Message-Id: ${MAIL_ID}
Date: $(date +"%a, %e %b %Y %H:%M:%S %z")

テストメールです。
-----------------------------------------------------
UPTIME
-----------------------------------------------------
$(uptime)

-----------------------------------------------------
W
-----------------------------------------------------
$(w)

-----------------------------------------------------
FREE
-----------------------------------------------------
$(free)

EOF

iconv -f UTF-8 -t ISO-2022-JP "${mail_data}" |
"${SENDMAIL}" -oi "${MAIL_TO}" > /dev/null 2>&1

clean_tmp_dir
trap ${SIGNALS}


#!/bin/bash

select member in john paul george ringo
do
echo "You chose $member."
break
done


while :; do netstat -tp; sleep 5; done





2013/04/29

sedでファイルを更新する

sedで置換などを行う時、対象のファイルを直接更新したいときは -i のオプションをつける。
つけないと、標準出力に表示されるのみで元のファイルは変更されない。
では、元のファイルにリダイレクトすればいいのではないか?
ハイフンi をつけた時と同じ結果になるように思える。
・・・
これも考えても仕方がないのでやってみた。
結果は、「元のファイルにリダイレクトすると中身が全部消える」
であった。
これも衝撃の事実だ。
なんでそうなるのだろう・・・?

# cat x.txt
i love cats.
#
# sed s/cat/dog/ x.txt
i love dogs.
#
#
# sed s/cat/dog/ x.txt > x.txt
#
# cat x.txt
#
#
# vi x.txt
#
# cat x.txt
i love cats.
#
# sed -i s/cat/dog/ x.txt
# cat x.txt
i love dogs.
#

2013/04/28

ハードリンクを削除したらリンク先のファイルは削除されるか?

「消えるにきまってんじゃん。そうじゃなかったらシンボリックリンクとハードリンクの区別がなくなるだろ?」
と思っていた。

しかし、よく考えると、「じゃあ、ハードリンクを作成した後で、リンクだけを削除するにはどうすればよいのか?」
という問いに答えが見つからない。

・・・・

考えても仕方がないので、実際にやってみた。
結果は、「ハードリンクを削除しても、リンク先のファイルは削除されない」となった。
これは衝撃の事実である。
「ハードリンクを削除したらリンク先も削除される」と思っている人は多いはずだ。

# ls txt
a.txt  a2.txt  a3.txt  b.txt  c.txt  ex.txt  logall.txt  p.txt  x.txt  x1.txt  x2.txt
#
# ls
a.tar  bu.pl  logall  logall.gz  main.cgi  txt  unko
#
# ln ./txt/a.txt anohardlink1
# ln ./txt/a.txt anohardlink2
#
# ls
a.tar  anohardlink1  anohardlink2  bu.pl  logall  logall.gz  main.cgi  txt  unko
# ls ./txt/
a.txt  a2.txt  a3.txt  b.txt  c.txt  ex.txt  logall.txt  p.txt  x.txt  x1.txt  x2.txt
#
# rm anohardlink1
rm: remove 通常ファイル `anohardlink1'? y
# ls
a.tar  anohardlink2  bu.pl  logall  logall.gz  main.cgi  txt  unko
# ls ./txt/
a.txt  a2.txt  a3.txt  b.txt  c.txt  ex.txt  logall.txt  p.txt  x.txt  x1.txt  x2.txt
#
#
# rm anohardlink2
rm: remove 通常ファイル `anohardlink2'? y
# ls
a.tar  bu.pl  logall  logall.gz  main.cgi  txt  unko
# ls ./txt/
a.txt  a2.txt  a3.txt  b.txt  c.txt  ex.txt  logall.txt  p.txt  x.txt  x1.txt  x2.txt
#

debianでrunlevelを変更する

LPICの勉強をしていたらapt-getとかdpkgとか聞いたことのないコマンドが出てきたので、debianをインストールした。

そして、telinitでrunlevelを変更できるという事を知ったので試してみたのだが、変更できない。

telinit 3 でテキストログインになるところが、GUIログインのままなのだ。

検索してみると、debianではrunlevel 2~5は同じ扱いになることを知った。

teiinit 2とするとテキストログインになった。しかしシングルモードなので外からsshとかができない。

2013/04/20

2枚交換する(改)

(残した札がペアになる組合せ数)= s1
または
(交換した2枚がペアになる組合せ数)= s2

s1とs2は同時には成立しない。

s1= 3 * COMBIN(3,1) * 46
s2= COMBIN(4,2)*10

2枚交換する組合せ数 b は
b = combin(47,2)

確率は ( s1 + s2 ) / b ≒ 0.438482886


(2020/7/19 追記)
読み返してみるとよくわからないが間違っていそうなので再計算結果を記す。

1. 交換した2枚がペアになる
2. 交換した2枚のうちどちらかあるいは両方が手札とペアになる

1、2については両方同時に成立しうる。
少なくともこれについては、最初に書いたのが間違いである。

交換した2枚がペアになりさらにそれが残した札のどれかとペアになる、
つまりスリーカードができる場合である。

まず、47枚のなかから2枚選ぶ組み合わせは、
Permut(47,2)=2162

「1. 交換した2枚がペアになる」場合の数であるが、
残ったカードは残り3枚のものが5種類(Aグループとする)、4枚のものが8種類(Bグループとする)ある。

Aグループは、Permut(15,2)=210
Bグループは、Permut(32,2)=992
合計 1202

「2.手札とペアになる」
手札とペアになれるカードは、残り3枚の3種類(Cグループとする)で9枚なので
Permut(9,2)=72

「3.スリーカードになる」
スリーカードになれるのはCグループ。

Cグループのうちのある種類のカードについて
C1,C2,C3とすると、これが2枚同じ種類になるのは
(C1,C2), (C1,C3),(C2,C3) とその並びが逆の6パターン
これが3種類あるから、18パターン

よって、2枚交換で少なくともワンペアができるパターンは、

1202 + 72 - 18 = 1202 + 54 = 1256

確率は

1256 / 2162 ≒ 0.580944


1枚交換より2枚交換のほうが断然ワンペアができやすい。

これは3枚、4枚、5枚も再考しないと....










1枚だけ交換する

例によって簡単なところから考えていく。

一番計算しやすいのは、4枚残して1枚交換する場合。

52枚から5枚配ったので残りは47枚。

そこから1枚選ぶのだから選び方の数は47通り。

残した4枚の札は役なし、つまり、すべて違う札であるから、
ワンペアができる札は、3x4=12枚あるので、
ワンペアができる確率は 12/47≒0.2553191

ポーカーで何枚の札を交換するべきか

ポーカーで最初に配られた5枚の札で役が何もなかったとき、何枚交換するのが得だろうか?

たまにポーカーのゲームで遊ぶとき、私は最も大きい札を1枚残して4枚取り替えるようにしている。

そのたびに、いつも思い出すことがある。

会社で昼休みにポーカーをしていて最初の5枚で役がなくて、いつものように1枚残して4枚交換すると、

横で見ていた先輩が、「2枚残した方がいいんじゃないの?」と言ったことである。

私は確たる根拠があって1枚残しているわけではなかったのだが、

何となく4枚交換するのが少なくともワンペアを作るには一番得策ではないかと、直感的に思っていた。

ちゃんと計算してみよう。

本来であればワンペアより大きい役が出る確率とか、同じ役だったら札が大きい方が強いとか、自分以外のプレイヤーの存在などを考えるべきだが、

まずは、「ワンペアのみができやすいのは1から5枚の何枚を交換したときか」として考えてみる。

ジョーカーは含めないとする。

私は4枚交換が一番できやすいと思う。残す札を増やせば、ワンペアとなる候補が増えるが、その候補を選ぶチャンスも減らすことになる。

もしかしたら2枚残しの方が得かもしれないとも思うが、3枚残し、4枚残しが得であることはないと思う。

これはあくまでも私の直感である。

これからそれを確かめる。

2013/04/14

色対応

できた。
配牌はスペースで区切って指定する。 昨日直したときの修正ミスがあったのでそれもなおす。
use strict;
use warnings;

if($#ARGV < 0){
    print "please specify haipai.\n";
    exit;
}

#my @haipai = sort split / /, shift;
my @haipai = sort @ARGV;

if($#haipai != 12){
    print "please specify 13 pies.\n";
    exit;
}
my @menz;

my %tenpai;

my $menz_count = 0;
my $head_count = 0;
my $tenpai_count = 0;
my $not_menz = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

@menz=();
$not_menz = 0;
$head_count = 0;

&select_menz([@haipai],[@menz],"");

#七対子
&chitoi([@haipai]);

# 結果表示
foreach my $name (sort keys %tenpai){
    $tenpai_count++;
    print "$tenpai_count : $name\n";
}


#アタマを選んだ後、メンツを選ぶ
sub select_head{
    my @haipai = @{ $_[0] };

    my ($i, $j);

    $head_count++;

    for($i=0;$i <= $#haipai - 1;$i++){
        for($j=$i+1;$j <= $#haipai;$j++){
            if(&is_menz($haipai[$i],$haipai[$j])==3){
                my $atama = "<".$haipai[$i].$haipai[$j].">";
#               print $atama."\n";

                my @menz;
#選んだ牌を消す
                my @new_haipai = @haipai;
                $new_haipai[$i]="0";
                $new_haipai[$j]="0";

                @new_haipai = grep { $_ ne "0" } @new_haipai;
#残ったパイからメンツを選ぶ
                &select_menz([@new_haipai], [@menz], $atama);
            }
        }
    }
}


sub select_menz{
    my @haipai = @{ $_[0] };
    my @menz = @{ $_[1] };
    my $atama = $_[2];

    my ($i,$j, $k);

# 牌の残りが2枚以下
    if($#haipai < 2){
# アタマあり
        if($head_count > 0) {
#メンツが3個以上
            if($#menz > 1){
#残りの牌がターツかトイツ
                if(&is_menz(@haipai)>0){
                    my @sorted = sort @menz;
                    my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
                    &tenpai_check($tenpai);
                }
            }
            return;
# アタマなし
        }else{
#メンツが4個以上
            if($#menz > 2){
                my @sorted = sort @menz;
                my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
                &tenpai_check($tenpai);
            }
            return;
        }
    }


    for($i=0;$i<= $#haipai - 2;$i++){
        for($j=$i+1;$j<= $#haipai - 1;$j++){
            for($k=$j+1;$k<= $#haipai;$k++){

                my @new_menz = @menz;

                if(&is_menz($haipai[$i], $haipai[$j], $haipai[$k]) > 0) {
                    push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
                }else{
#メンツにならなかったらカウント
                    $not_menz++;
                }
#アタマありの場合非メンツが2つ、なしの場合1つあれば探索中止

                if(($head_count == 0 && $not_menz > 0) ||
                ($head_count > 0  && $not_menz > 1)) {
                    $not_menz = 0;
                    last;
                }else{
#選んだパイを削除
                    my @new_haipai = @haipai;
                    $new_haipai[$i]="0";
                    $new_haipai[$j]="0";
                    $new_haipai[$k]="0";

                    @new_haipai = grep { $_ ne "0" } @new_haipai;

#再帰呼び出しで残り牌からメンツを選ぶ
                    &select_menz([@new_haipai], [@new_menz], $atama);

                }
            }
        }
    }
}

sub chitoi{
    my @haipai = @{ $_[0] };

    my $i = 0;
    my @menz;

    $menz_count = 0;

    while($i<$#haipai){
        if(&is_menz($haipai[$i], $haipai[$i+1]) == 3){
            push @menz,"(".$haipai[$i].$haipai[$i+1].")";
            $menz_count++;
            if($i==$#haipai-2){
                push @menz,"[".$haipai[$#haipai]."]";
            }
            $i+=2;
        }else{
            push @menz,"[".$haipai[$i]."]";
            $i++;
        }
    }

    if($menz_count>5){
        my $tenpai = join("",@menz);
        &tenpai_check($tenpai);
    }
}


#重複した聴牌形をハッシュでチェック
sub tenpai_check{
    my ($tenpai) = @_;
#   print "tenpai check :$tenpai\n";
    $tenpai{$tenpai}++;
}

#余り牌がターツあるいはトイツであるかをチェック
sub amari_check{
    my @haipai = @{ $_[0] };

    if($haipai[0] == $haipai[1]){
        return 1;
    }
    if($haipai[0]+1 == $haipai[1]){
        return 1;
    }
    if($haipai[0]+2 == $haipai[1]){
        return 1;
    }
}

sub is_menz{
    my @pais = @_;

#   print "pais:@pais\n";

    if($#pais == 1){
        if($pais[0] eq $pais[1]){
            return 3;
        } elsif(substr($pais[0],0,1) eq substr($pais[1],0,1) && (substr($pais[0],0,1) ne "x")){
            if(substr($pais[0],1,1)+1 == substr($pais[1],1,1)){
                return 4;
            }elsif(substr($pais[0],1,1)+2 == substr($pais[1],1,1)){
                return 5;
            }else{
                return 0;
            }
        }else{
            return 0;
        }
    }

    if($pais[0] eq $pais[1] && $pais[0] eq $pais[2]){
        return 2;
    }elsif(substr($pais[0],0,1) eq substr($pais[1],0,1) && substr($pais[0],0,1) eq substr($pais[2],0,1) && (substr($pais[0],0,1) ne "x")){
        if(substr($pais[0],1,1)+1 == substr($pais[1],1,1) && substr($pais[0],1,1)+2 == substr($pais[2],1,1)){
            return 1;
        }else{
            return 0;
        }
    }else{
        return 0;
    }
}
実行結果
# perl menx.pl m1 m2 m3 p1 p2 p3 s3 s4 s5 s6 s7 x1 x1
haipai: m1 m2 m3 p1 p2 p3 s3 s4 s5 s6 s7 x1 x1
1 : (m1m2m3)(p1p2p3)(s3s4s5)[s6s7]
2 : (m1m2m3)(p1p2p3)(s5s6s7)[s3s4]

2013/04/13

色対応の検討



麻雀聴牌判定プログラムは、一色限定版である。


だが、一色でできてしまえば、あとは牌が同一あるいは連続であるかを判定するときに色も見ればよい。


簡単そうだが、色をどうやってもたせるべきだろうか?


そもそも私は最初は色つきでやろうとしていたのだが、


調べていくうちに一色限定で判定するというコンテストのようなものを見つけ、


それをまずやってみた。


私が最初にやろうとしたのは、


マンズ: m1, m2 ... m9


ピンズ: p1, p2 ... p9


ソーズ: s1, s2 ... s9


字牌:x1, x2 ... x7


として、比較する時は牌データの1文字目で色を、2文字目で数字を見る、


というものであった。


substr関数を使うとか、正規表現を使うとかすればよいだろう。


クラスを使うのはどうだろうか?


$pai->color で色を、$pai->number で数字にアクセスできれば、


判定がわかりやすく簡単に書けそうだ。


でもこのくらいであれば、上記のフォーマットにして「同じか」「連続しているか」


などをサブルーチンにするだけでよいかもしれない。





2013/04/12

七対子対応



最初は、通常のテンパイ判定を改造して、3つ選ぶのを2枚にして、メンツの数は5つにして・・・とやったのだが、なぜかうまくいかなかった。


配牌はソートしているから隣と同じでなければ即非メンツに判定できることに気づいて、別途作った。


あとはループのさせ方がちょっと変だったのでなおしたら、1秒くらいで判定するようになった。



use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = sort split //, shift;

if($#haipai != 12){
print "please specify 13 pies.\n";
exit;
}
my @menz;

my %tenpai;

my $menz_count = 0;
my $head_count = 0;
my $tenpai_count = 0;
my $not_menz = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

@menz=();
$not_menz = 0;
$head_count = 0;

&select_menz([@haipai],[@menz],"");

#七対子
&chitoi([@haipai]);

# 結果表示
foreach my $name (sort keys %tenpai){
$tenpai_count++;
print "$tenpai_count : $name\n";
}


#アタマを選んだ後、メンツを選ぶ
sub select_head{
my @haipai = @{ $_[0] };

my ($i, $j);

$head_count++;

for($i=0;$i <= $#haipai - 1;$i++){
for($j=$i+1;$j <= $#haipai;$j++){
if($haipai[$i] == $haipai[$j]){
# print "$head_count: <".$haipai[$i].$haipai[$j].">\n";
my $atama = "<".$haipai[$i].$haipai[$j].">";
my @menz;
#選んだ牌を消す
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;
#残ったパイからメンツを選ぶ
&select_menz([@new_haipai], [@menz], $atama);
}
}
}
}


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };
my $atama = $_[2];

my ($i,$j, $k);

# 牌の残りが2枚以下
if($#haipai < 2){
# アタマあり
if($head_count > 0) {
#メンツが3個以上
if($#menz > 1){
#残りの牌がターツかトイツ
if(&amari_check([@haipai])>0){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
&tenpai_check($tenpai);
}
}
return;
# アタマなし
}else{
#メンツが4個以上
if($#menz > 2){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
&tenpai_check($tenpai);
}
return;
}
}


for($i=0;$i<= $#haipai - 2;$i++){
for($j=$i+1;$j<= $#haipai - 1;$j++){
for($k=$j+1;$k<= $#haipai;$k++){

my @new_menz = @menz;

if($haipai[$i]+1 == $haipai[$k]){
$not_menz++;
}elsif(($haipai[$i] == $haipai[$j] && $haipai[$j] == $haipai[$k]) ||
($haipai[$i]+1 == $haipai[$j] && $haipai[$j]+1 == $haipai[$k])){
push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
}else{
#メンツにならなかったらカウント
$not_menz++;
}
#アタマありの場合非メンツが2つ、なしの場合1つあれば探索中止

if(($head_count == 0 && $not_menz > 0) ||
($head_count > 0 && $not_menz > 1)) {
$not_menz = 0;
last;
}else{
#選んだパイを削除
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#再帰呼び出しで残り牌からメンツを選ぶ
&select_menz([@new_haipai], [@new_menz], $atama);

}
}
}
}
}

sub chitoi{
my @haipai = @{ $_[0] };

my $i = 0;
my @menz;

$menz_count = 0;

while($i<$#haipai){
if($haipai[$i] == $haipai[$i+1]){
push @menz,"(".$haipai[$i].$haipai[$i+1].")";
$menz_count++;
if($i==$#haipai-2){
push @menz,"[".$haipai[$#haipai]."]";
}
$i+=2;
}else{
push @menz,"[".$haipai[$i]."]";
$i++;
}
}

if($menz_count>5){
my $tenpai = join("",@menz);
&tenpai_check($tenpai);
}
}


#重複した聴牌形をハッシュでチェック
sub tenpai_check{
my ($tenpai) = @_;
# print "tenpai check :$tenpai\n";
$tenpai{$tenpai}++;
}

#余り牌がターツあるいはトイツであるかをチェック
sub amari_check{
my @haipai = @{ $_[0] };

if($haipai[0] == $haipai[1]){
return 1;
}
if($haipai[0]+1 == $haipai[1]){
return 1;
}
if($haipai[0]+2 == $haipai[1]){
return 1;
}
}





2013/04/11

テンパイ判定

3秒くらいで結果が出るようになった。

メンツの探索中に非メンツが、アタマありの場合2個、アタマなしの場合1個みつかったら探索を中止する。

本当はこの判断が入っているので最後にメンツの数をチェックする必要はないと思ったのだが、
メンツの数が足りないのに最後まで行く場合がかなりある。

また、中止する場合にlastでループを抜けてよいと思ったのだがそれをやると答えが足りなくなる。


use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = sort split //, shift;

if($#haipai != 12){
print "please specify 13 pies.\n";
exit;
}
my @menz;

my %tenpai;

my $menz_count = 0;
my $head_count = 0;
my $tenpai_count = 0;
my $not_menz = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

$head_count = 0;

&select_menz([@haipai],[@menz],"");

# 結果表示
foreach my $name (sort keys %tenpai){
$tenpai_count++;
print "$tenpai_count : $name\n";
}


#アタマを選んだ後、メンツを選ぶ
sub select_head{
my @haipai = @{ $_[0] };

my ($i, $j) = (0, 1);

$head_count++;

while($i <= $#haipai - 1){
if($haipai[$i] == $haipai[$j]){
# print "$head_count: <".$haipai[$i].$haipai[$j].">\n";
my $atama = "<".$haipai[$i].$haipai[$j].">";

my @menz;

#選んだ牌を消す
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#残ったパイからメンツを選ぶ
&select_menz([@new_haipai], [@menz], $atama);
}

$j++;
if($j>$#haipai){
$i++;
$j=$i+1;
}

}
}


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };
my $atama = $_[2];

my ($i,$j, $k) = (0, 1, 2);

# 牌の残りが2枚以下
if($#haipai < 2){
# アタマあり
if($head_count > 0) {
#メンツが3個以上
if($#menz > 1){
#残りの牌がターツかトイツ
if(&amari_check([@haipai])>0){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
# print "$tenpai\n";
&tenpai_check($tenpai);
}
}
return;
# アタマなし
}else{
#メンツが4個以上
if($#menz > 2){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
# print "$tenpai\n";
&tenpai_check($tenpai);
}
return;
}
}

while($i <= $#haipai - 2){

my @new_menz = @menz;

if($haipai[$i]+1 == $haipai[$k]){
$not_menz++;
}elsif(($haipai[$i] == $haipai[$j] && $haipai[$j] == $haipai[$k]) ||
($haipai[$i]+1 == $haipai[$j] && $haipai[$j]+1 == $haipai[$k])){
push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
}else{
#メンツにならなかったらカウント
$not_menz++;
}
#アタマありの場合非メンツが2つ、なしの場合1つあれば探索中止

if(($head_count == 0 && $not_menz > 0) ||
($head_count > 0 && $not_menz > 1)) {
$not_menz = 0;
}else{
#選んだパイを削除
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#再帰呼び出しで残り牌からメンツを選ぶ
&select_menz([@new_haipai], [@new_menz], $atama);

}

$k++;
if($k>$#haipai){
$j++;
if($j>$#haipai -1){
$i++;
$j=$i+1;
$k=$j+1;
}else{
$k=$j+1;
}
}

}
}

#重複した聴牌形をハッシュでチェック
sub tenpai_check{
my ($tenpai) = @_;
# print "tenpai check :$tenpai\n";
$tenpai{$tenpai}++;
}

#余り牌がターツあるいはトイツであるかをチェック
sub amari_check{
my @haipai = @{ $_[0] };

if($haipai[0] == $haipai[1]){
return 1;
}
if($haipai[0]+1 == $haipai[1]){
return 1;
}
if($haipai[0]+2 == $haipai[1]){
return 1;
}
}

再帰を使って1からnまでの和を求める

さっきのをマネしてunlessを使ってみる。
wa(10000);

sub wa{
my ($num, $sum) = @_; unless($num) { print "$sum\n"; }else{ $sum += $num; $num--; &wa($num, $sum); } }

3枚ずつ区切る

8枚までは多分正しい。9枚以上はダメだ。

ただしこれは(123)(456) と (456)(123)を両方数えている。

combin(8, 3) * combin(5, 3) = 8*7*5*4 = 560通り。


use strict;
use warnings;

my $haipai = shift;

if(!$haipai){print "specify haipai.\n"; exit;};

print "haipai : $haipai\n";

my $max_menz = int(length($haipai) / 3);

print "max_menz : $max_menz\n";

my @haipai = split("", $haipai);
my $level=0;
my $count = 0;

my @found;

my @result;

&select_menz(\@haipai);

$count = 0;
for(@result){
$count++;
print "$count:$_\n";
}

sub select_menz{
my ($array_ref) = @_;

my ($i, $j, $k) = (0, 1, 2);

# print "array:@$array_ref\n";

while($i<$#$array_ref-1){
$count++;
# print "level: $level num of found: $#found - $i $j $k - $count : ".$array_ref->[$i].$array_ref->[$j].$array_ref->[$k]."\n";
# print "found:@found\n";
if($max_menz == 3){
if($#$array_ref > 4 && $#found == 2) {
pop @found;
pop @found;
pop @found;
}
}
if($level == 0 && $#found == $max_menz - 1 ) {
pop @found;
pop @found;
}elsif($level == 1 && $#found == $max_menz - 1 ){
pop @found;
}

push @found, "(".$array_ref->[$i].$array_ref->[$j].$array_ref->[$k].")";

if($#found > $max_menz - 2 ){
push @result, join("", sort @found);
}

my @new_array = @$array_ref;
$new_array[$i]=0;
$new_array[$j]=0;
$new_array[$k]=0;
@new_array = grep{ $_ > 0 } @new_array;

if($#new_array > 1){
$level++;
&select_menz(\@new_array);
}

$k++;
if($k>$#$array_ref){
$j++;
$k=$j+1;
if($j>$#$array_ref-1){
$i++;
$j=$i+1;
$k=$j+1;
}
}
}
$level = 0;
# print "--- end of loop --- $#$array_ref \n";
}





perlでpermutation

「Perl クックブック」より。

#!/usr/bin/perl

permute([qw(one two three four)],[]);

sub permute {
my @items = @{ $_[0] };
my @perms = @{ $_[1] };

unless (@items) {
print "@perms\n";
}else{
my(@newitems, @newperms, $i);
foreach $i (0 .. $#items) {
@newitems = @items;
@newperms = @perms;
unshift(@newperms, splice(@newitems, $i, 1));
permute([@newitems], [@newperms]);
}
}
}


実行結果

# perl permute.pl
four three two one
three four two one
four two three one
two four three one
three two four one
two three four one
four three one two
three four one two
four one three two
one four three two
three one four two
one three four two
four two one three
two four one three
four one two three
one four two three
two one four three
one two four three
three two one four
two three one four
three one two four
one three two four
two one three four
one two three four


なるほど・・・が、ソースの意味がほとんどわからない・・・。


2013/04/10

6個の中から3個えらぶ



6個のものから3個選ぶ場合の数は、combin(6,3) = 20 である。


たとえば 123456という文字列から3つを取るパターンは、以下の20通りである。


123, 124, 125, 126, 134, 135, 136, 145, 146, 156, 234, 235, 236, 245, 246, 256, 345, 346, 356, 456


ところで、これを「6個の物を二つのグループに分けるパターン」とすると、


123:456, 124:356, ... 146:235, 156:234, 234:156 ... となって、


234:156 以降はすでに選んだパターンと同じである。


6個の場合は数えられるが、これが10個、20個になったときはどうなるか?


6個の場合と同様、combin(6,3) / 2 でいいのだろうか?・・・よくない。


グループ分けした結果のグループの順番を考慮しない場合は、グループ数の階乗で割る。


6個のものを3個ずつわける場合は、 combin(6, 3) / 2! = 20 / 2 = 10


グループ数が3個であれば、abc, acb, bac, bca cab, cba の6個か。


では、7個のものを3個x2+1に分けるパターンはいくつだろうか?


順序が同じ組は3個ずつの2つなのでわるのは二組に分ける場合と同様2の階乗になる。


combin(7, 3) * combin(4, 3) * 1 /2!


9個のものを3個ずつにわけて組の順序を区別しない場合。3の階乗で割る。


combin(9,3) * combin(6,3) * 1 / 3!





・・・こんなこと習ったっけ?全然記憶にない。





ほぼ完成

とりあえず、聴牌形を出すまでできた。ただしチートイツは除く。
チュウレンポウトウの9面待ちで11パターンが出るので合ってるんじゃないかな。
でも、すごく遅い。30秒くらいかかる。
聴牌形を選ぶ時点で重複があることがわかっている。
なので、最後にハッシュに登録してチェックしている。


use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = split //, shift;

my @menz;

my %tenpai;

my $menz_count = 0;
my $head_count = 0;
my $tenpai_count = 0;
my $not_menz = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

$head_count = 0;

&select_menz([@haipai],[@menz],"");

# 結果表示
foreach my $name (sort keys %tenpai){
$tenpai_count++;
print "$tenpai_count : $name\n";
}


#アタマを選んだ後、メンツを選ぶ
sub select_head{
my @haipai = @{ $_[0] };

my ($i, $j) = (0, 1);

while($i <= $#haipai - 1){
if($haipai[$i] == $haipai[$j]){
$head_count++;
# print "$head_count: <".$haipai[$i].$haipai[$j].">\n";
my $atama = "<".$haipai[$i].$haipai[$j].">";

my @menz;

#選んだ牌を消す
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#残ったパイからメンツを選ぶ
&select_menz([@new_haipai], [@menz], $atama);
}

$j++;
if($j>$#haipai){
$i++;
$j=$i+1;
}

}
}


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };
my $atama = $_[2];

my ($i,$j, $k) = (0, 1, 2);

# 牌の残りが2枚以下
if($#haipai < 2){
# アタマあり
if($head_count > 0) {
#メンツが3個以上
if($#menz > 1){
#残りの牌がターツかトイツ
if(&amari_check([@haipai])>0){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
&tenpai_check($tenpai);
}
}
return;
# アタマなし
}else{
#メンツが4個以上
if($#menz > 2){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
&tenpai_check($tenpai);
}
return;
}
}

while($i <= $#haipai - 2){

my @new_menz = @menz;
#コーツ
if(($haipai[$i] == $haipai[$j] && $haipai[$i] == $haipai[$k])
#シュンツ
|| ($haipai[$i]+1 == $haipai[$j] && $haipai[$j]+1 == $haipai[$k])) {
push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
}else{
#メンツにならなかったらカウント
$not_menz++;
}
#非メンツが2個以上になったら探索中止
if($not_menz > 1){
$not_menz = 0;
}else{
#選んだパイを削除
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#再帰呼び出しで残り牌からメンツを選ぶ
&select_menz([@new_haipai], [@new_menz], $atama);
}

$k++;
if($k>$#haipai){
$j++;
if($j>$#haipai -1){
$i++;
$j=$i+1;
$k=$j+1;
}else{
$k=$j+1;
}
}

}
}

#重複した聴牌形をハッシュでチェック
sub tenpai_check{
my ($tenpai) = @_;
# print "tenpai check :$tenpai\n";
$tenpai{$tenpai}++;
}

#余り牌がターツあるいはトイツであるかをチェック
sub amari_check{
my @haipai = @{ $_[0] };

if($haipai[0] == $haipai[1]){
return 1;
}
if($haipai[0]+1 == $haipai[1]){
return 1;
}
if($haipai[0]+2 == $haipai[1]){
return 1;
}
}


実行結果


# perl menz.pl 1112345678999
haipai: 1 1 1 2 3 4 5 6 7 8 9 9 9
1 : (111)(234)(567)(999)[8]
2 : (111)(234)(678)(999)[5]
3 : (111)(345)(678)(999)[2]
4 : <11>(123)(456)(789)[99]
5 : <11>(123)(456)(999)[78]
6 : <11>(123)(678)(999)[45]
7 : <11>(345)(678)(999)[12]
8 : <99>(111)(234)(567)[89]
9 : <99>(111)(234)(789)[56]
10 : <99>(111)(456)(789)[23]
11 : <99>(123)(456)(789)[11]





サブルーチンに複数の配列を渡す



リファレンスを使わない方法。さっきのpermutationがこれを使っている。

ミソは配列を[]で囲むことだ。


my @fruits = qw /apple banana orange strawberry/;
my @animals = qw /dog cat cow horse/;

&menz([@fruits],[@animals]);

sub menz{
my @array1 = @{ $_[0] };
my @array2 = @{ $_[1] };

print "array1:@array1\n";
print "array2:@array2\n";
}





アタマも選ぶ



アタマも選ぶようにした。これも、同じ牌であるかはまだ見ていない。

パターン数は

COMBIN(13,2) * COMBIN(11,3) * COMBIN(8,3) * COMBIN(5,3) = 7207200





use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = split //, shift;

my @menz;

my $menz_count = 0;
my $head_count = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

#&select_menz([@haipai],[@menz]);

sub select_head{
my @haipai = @{ $_[0] };
use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = split //, shift;

my @menz;

my $menz_count = 0;
my $head_count = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

#&select_menz([@haipai],[@menz]);

sub select_head{
my @haipai = @{ $_[0] };

my ($i, $j) = (0, 1);

while($i <= $#haipai - 1){
$head_count++;
# print "$head_count: <".$haipai[$i].$haipai[$j].">\n";
my $atama = "<".$haipai[$i].$haipai[$j].">";

my @menz;
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;
&select_menz([@new_haipai], [@menz], $atama);


$j++;
if($j>$#haipai){
$i++;
$j=$i+1;
}

}
}


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };
my $atama = $_[2];

my ($i,$j, $k) = (0, 1, 2);

if($#haipai < 2){
$menz_count++;
print "$menz_count: $atama @menz amari:@haipai\n";
return;
}

while($i <= $#haipai - 2){

my @new_menz = @menz;

push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;
&select_menz([@new_haipai], [@new_menz], $atama);

$k++;
if($k>$#haipai){
$j++;
if($j>$#haipai -1){
$i++;
$j=$i+1;
$k=$j+1;
}else{
$k=$j+1;
}
}

}
}





メンツ選択



今度こそできたと思う。

キモは取り出したメンツの配列を再帰呼び出しするサブルーチンに渡したことだ。

まだ、メンツになっているかどうかを問わず、3つずつに分けただけである。


use strict;1
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = split //, shift;

my @menz;

my $count = 0;

print "haipai: @haipai\n";

&select_menz([@haipai],[@menz]);


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };

my ($i,$j, $k) = (0, 1, 2);

if($#haipai < 2){
$count++;
print "$count: menz:@menz\n";
return;
}

while($i <= $#haipai - 2){

my @new_menz = @menz;

push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;
&select_menz([@new_haipai], [@new_menz]);

$k++;
if($k>$#haipai){
$j++;
if($j>$#haipai -1){
$i++;
$j=$i+1;
$k=$j+1;
}else{
$k=$j+1;
}
}

}
}


チュウレンの9面待ちに対してこれを実行すると、最後は以下のようになる。

同じならびが3つ続いているが、これは1が3枚あって、その3枚のうち2枚を選ぶパターンが3つあるためである。

4804800 = combin(13,3) * combin(10,3) * combin(7,3) * combin(4,3)

である。


4804793: menz:(999) (678) (245) (111)
4804794: menz:(999) (678) (245) (113)
4804795: menz:(999) (678) (245) (113)
4804796: menz:(999) (678) (245) (113)
4804797: menz:(999) (678) (345) (111)
4804798: menz:(999) (678) (345) (112)
4804799: menz:(999) (678) (345) (112)
4804800: menz:(999) (678) (345) (112)





2013/04/09

麻雀メンツ検索プログラム



直した。ただし、配牌から3個ずつの牌を選ぶパターンを洗い出すのみ。


刻子や順子になっているかは判定していない。


配牌は5枚から13枚まで試して、パターン数が正しいことだけ確かめた。


たとえば10枚の時は combin(10,3) * combin(7,3) * combin(4,3) = 16800。


だが、すでにこの時点ですごく遅い。とてもじゃないが麻雀ゲームには使えない。


デバッグ用のprint文がたくさん入っているがそれだけの問題ではないだろう・・・


と思ったら、パターン数が正しいだけで同じものが大量に出力されているので削除。





どうにもならないので、簡単なものから徐々に作っていく。


まずは、与えられた文字列から3文字ずつ選ぶパターンを網羅するもの。



use strict;
use warnings;

my $haipai = shift;

if(length($haipai)<0){print "specify haipai.\n"; exit;};

print "haipai : $haipai\n";

my $max_menz = int(length($haipai) / 3);

print "max_menz : $max_menz\n";

my @haipai = split("", $haipai);

my $count = 0;

&select_menz(\@haipai);

sub select_menz{
my ($array_ref) = @_;

my ($i, $j, $k) = (0, 1, 2);

while($i<$#$array_ref-1){
$count++;
print "$count : ".$array_ref->[$i].$array_ref->[$j].$array_ref->[$k]."\n";
$k++;
if($k>$#$array_ref){
$j++;
$k=$j+1;
if($j>$#$array_ref-1){
$i++;
$j=$i+1;
$k=$j+1;
}
}
}
}


これは間違いないと思う。


ここからが問題だ。


配列のリファレンスを与えて、その配列から3個の要素を選択するパターンを網羅することはできた。


それなら、各パターンについて、選択済みの要素を削除した配列を、再度このサブルーチンに渡せば、のこった要素の中から3個を選ぶパターンが網羅され、


それを要素が3個になるまで繰り返せばよい、と思う。


だが、問題がある。


まず、「配列から選択済みの要素を削除する」をどうするかだ。


たとえば「12345」という文字列から最初に選択する3文字のパターンは「123」である。


これを削除した配列は「45」である。


@array = (1,2,3,4,5)


だったとすると、


$array[0], $array[1], $array[2] を削除すればよい。


しかし・・・





2013/04/07

3メンツの抜き出し



13枚の配牌から3つのメンツを選ぶところまで、やっとできた。

イーペーコー形も判定できる。

アタマを選ぶとか、テンパイしているかの判定までは、まだ。

(2013/04/09 だいぶボロがある。今修正中)

my @array = qw /1 1 2 3 3 4 5 6 7 7 8 9 9/;

my @found;
my %found;
my $count = 0;

print "haipai:@array\n";

&moura(\@array);

foreach $key(sort keys(%found)){
    print "$key\n";
}



sub moura{
    my ($array_ref) = @_;
    my ($i,$j,$k);

    my @temp = ();
    for(@$array_ref){
        if($_>0){
            push @temp,$_;
        }
    }
    @$array_ref = @temp;

    if($count > 2){
        if($#found > 1) {
            $found{join("", sort @found)}++;
        }
        @found = ();
        $count = 0;
    }

    for ($i=0;$i<=$#$array_ref;$i++){
        for ($j=$i+1;$j<=$#$array_ref;$j++){
            for ($k=$j+1;$k<=$#$array_ref;$k++){
                if($array_ref->[$i] + 1 == $array_ref->[$j] && $array_ref->[$i] + 2 == $array_ref->[$k]){
                    push @found, $array_ref->[$i].$array_ref->[$j].$array_ref->[$k];
                }elsif($array_ref->[$i] == $array_ref->[$j] && $array_ref->[$i] == $array_ref->[$k]){
                    push @found, $array_ref->[$i].$array_ref->[$j].$array_ref->[$k];
                }
                $count++;
                @array2 = @$array_ref;
                $array2[$i] = 0;
                $array2[$j] = 0;
                $array2[$k] = 0;
                &moura(\@array2);
            }
         }
    }

}

再帰

ほとんどつかったことがない。


$num = 10;

print &factorial($num);

sub factorial {
my ($num) = @_;
if ($num < 2) {
return 1;
}else{
return ($num * &factorial($num-1));
}
}





2013/04/06

麻雀の聴牌判定プログラム



を書いてみようと思った。


牌はマンズがm1, m2, ... m9


ピンズが pn, ソーズがsn、字牌を x1, x2 ... x9(東南西北白發中)


とし、136枚のなかから13枚をランダムに選び、配列に格納してソートする。


まず、刻子、順子、対子をさがすプログラムを作った。


ソートした配牌を最初から順に探し、隣り合った牌が同じか連続しているものを選んでいく。


そこまでは難しくない。


まず困ったのは、112233 というようなイーペーコーの形のときだ。


これは並んだ順に探していくと3つのトイツになってしまう。


それから、77789 というような形は77 789でトイツと順子になるが、777 89という刻子とターツの場合がある。


このようなパターンをもれなくあげるにはどうすればよいのか。


チートイツや国士は特別なので後回しにする。





13枚の牌から3枚選ぶパターンは combin(13,3) 通りある。


combin(13,3)通りを列挙する。それらすべての組み合わせのなかからメンツになるものを探していく。メンツになったら、その3枚を配牌からとりのぞく。残り10枚のなかからcombin(10,3)通りを列挙する。その中からメンツになるものを探す。・・・これを残り一枚になるまで繰り返す。


そのパターン数は、combin(13,3) * combin(10,3) * combin(7,3) * combin(4*3) である。


これがタンキ待ちの場合。


アタマがある場合。アタマ候補を列挙する。combin(13,2)。


アタマを除いた11枚から3個ずつメンツ候補を列挙していく。


combin(13,2) * combin(11,3) * combin(8,3) * combin(5, 3)


残った2枚がトイツかターツ(カンチャンかペンチャンかリャンメン)であるかを調べる。





2013/04/05

素数判定

1億より小さい素数は5761455個あり、それをすべて表示するのにかかった時間は約3時間16分だった。

「エラトステネスのふるい」方式の改良版。

1千万までで1分かからなくなった。

これで1億までやってみる。

VPSでやろうとしたら Out of memoryになったので、10GBのメモリがあるWindows7でやる。

use strict;

use warnings;

my @array =();

my @new_array =();

my $max = shift || 1000;

open my $result, '>', 'result.txt' or die;

my $start_time = localtime();

my $count=0;

for(0..$max-1){

push @array, $count;

$count++;

}

$array[1] = 0;

for(my $i=2;$i

for(my $j=$i*2;$j<=$#array;$j=$j+$i){

$array[$j] = 0;

}

}

$count = 0;

for(@array){

if($_>0){

$count++;

print $result "$_\t";

}

}

print $result "\nTo $max count : $count \n";

my $end_time = localtime();

print $result "$start_time - $end_time\n";

close $result;

6分弱で終わった。5761455個。1億より小さい最大の素数は 99999989 である。

あるページのこの表をあんまり頻繁にみるので自分のところに書く。

範囲 素数の個数

10以下 4

100以下 25

1000以下 168

1万以下 1229

10万以下 9592

100万以下 78498

1000万以下 664579

1億以下 5761455

10億以下 50847534

100億以下 455052511

1000億以下 4118054813

1兆以下 37607912018

10兆以下 346065536839

10億までやろうとしたらパソコンがハンブアップした。ctrl+alt+deleteも効かないので電源を切った。

2013/04/04

bigint、素数判定

というものがあることを知った。cpanからインストールして

use bigint;

を書くと1023乗より大きい数を計算できた。

2のベキ乗を計算させると

1.28421286658896e+207

という表示ではなく、全桁表示する。

たとえば2の1247乗

2423285551989543969259886147306320615721694717012975552426444448158985017722789267546553034738712987127346362442309271495645764807314487385596126924659433020959638410571315406303196994043324038030803068668509323897700215957022383545283810557899591580902307500436706661372076856211818662627186819885605667216486349283517459646495626188985295134800963771933733229691796170211328





ちなみにこんなのもある。

なんでこれで判定できるのかさっぱりわからない。

perl -le 'print "PRIME" if (1 x shift) !~ /^(11+)\1+$/' 19


http://www.drdobbs.com/web-development/tpj-one-liners/184416234




「フェルマー小定理」方式C言語版

判定できる最大の素数は 16381である。

#include <stdio.h>
#include <math.h>

long double gojo(long double a, long double b);

int main(int argc, char *argv[]){
long double d;
long double  a, m, p, x;
int count, max;

count = 0;
a = 2;

if(argc > 1) {
    max = atoi(argv[1]);
}else{
    printf("please specify max number.\n");
    return 1;
}

printf("start\n");

for(p=3;p<max;p++){
    x = gojo(p, 2L);
    if(x == 1){
        d = powl(a, p-1);
        m = fmodl(d, p);
        if(m == 1){
            printf ("%.1Lf is PRIME\n", p);
            count++;
        }
    }
}

printf("end\n");
printf("count:%d\n", count);
}

long double gojo(long double a, long double b){
    long double c;

    while(b>0) {
        c = fmodl(a, b);
        a = b;
        b = c;
    }
    return a;
}





素数判定

youtubeのおすすめ動画に、NHKスペシャルの「リーマン予想」が出てきたので見てみた。

「リーマン予想」で検索してみると、専門家から言わせるとこの番組にはいろいろボロがあるようであるが、リーマン予想というのは、素数の出現に関する規則性のようなものだということはわかった。素数の並びそのものではなく、ゼータ関数と呼ばれる数式のある値に関する規則性だそうである。

この規則性については、正しい値が多数存在することは証明されても、その例外がみつかっていないのでほぼ正しいだろうとは考えられているものの、正しいという証明がいまだにされておらず、100万ドルの懸賞金までかかっているそうである。

私からすると、素数というものになぜ数学者が魅了されるのかわからない。そんなものに規則性なんかあるわけがないというのが私の直感的な考えであるが、どうやら規則性があるようなのである。

というわけで、とりあえず素数判定プログラムを書いてみようと思った。

use strict;
use warnings;

my $end = shift || 10000;
my $count = 0;

my $starttime = localtime();

for (2..$end) {
    if(isprime($_) == 0){
        $count++;
        print $_;
        print "\t";
    }
}

print "\ncount: $count\n";

my $endtime = localtime();

print $starttime." - ".$endtime;

sub isprime {
    my ($num) = @_;

    for (my $i=2;$i<$num;$i++){
        if(($num % $i) == 0){
            return 1;
        }
    }
    return 0;
}

これだと100000以下の素数を列挙するのに1分半くらいかかる。

2から順に割っているのだが、判定対象の数-1まで割るのはムダである。たとえば1600が800で割れるというのは、20で割ったときにわかる。では、いくつまで割ればいいのか?

これは昔数学の授業で習った記憶がある。最初、「1/2かな」と思って、やってみると素数の個数からして正しく判定できたようだ。

時間は20秒くらい短くなった。だが、なぜ1/2かと言われると説明できない。

高校の数学Bの教科書を開いてみた。

「自然数Nが合成数ならば、必ず√N以下の約数をもつ」

ということであった。だから、100なら10まで、10000なら100まで試し割をすればよいことになる。

for (my $i=2;$i<=(sqrt $num);$i++){

このように修正すると、3秒くらいになった。

「エラトステネスのふるい」方式。

(2013/04/04修正)

use strict;
use warnings;

my @array =();
my @new_array =();

my $max = shift || 1000;


my $start_time = localtime();

my $count=0;

for(0..$max-1){
    push @array, $count;
    $count++;
}

$array[1] = 0;

for(my $i=2;$i0){
        $count++;
        print;
        print "\t";
    }
}

print "\n $count \n";


my $end_time = localtime();

print "$start_time - $end_time\n";

「倍数をふるいにかける」ところを、mod (%)でやっているのはちょっとずるいかな。 (後記:ずるいというかムダ。$jを$iずつ増分した値を無条件に消していけばよい)

あと、「ふるいにかける」は、配列の要素を削除してやりたかったのだが、 spliceを使ったり別の配列にpushしたりしてみたがうまくできず、 値をゼロにして表示するときはゼロを飛ばすという方法にした。 100000まででやると、20秒かかる。試し割り方式より遅い。 (後記:修正後は約1秒になった)

さらに、素数判定では「フェルマーの小定理」を使うのが一番速いそうだ。 その定理とは「pを素数とし、aをpの倍数でない整数とするときにaのp-1乗をpで割った余りは1となる(wikipediaより)」 である。

実際に確認してみようか。

p=5とする。aは・・・3にしようか。

3^(5-1) / 5 の余りが 1になるということだね。

3^4 = 81

5でわると16...1だね。

p=23, a=17でやってみよう。

17^22 = 1174562876521148458974062689

1174562876521148458974062689 mod 23 は、電卓で計算したら1になった。

aとpの二つの数字が必要で、どちらかが判定対象だとして、もう1個の数字は互いに素になればなんでもいいのか?

p=100, a=3

3^99 を100でわった余りは67、だから素数でない。 これをプログラムする場合、判定対象をpとし、それと互いに素となるaを選ばねばならない。 a=2 としておいて、それが対象と互いに素でなければその時点で素数ではない。

プログラミングすると・・・

$b = 2;
$max = shift;

print "2\t";
$count = 1;

for($p=3;$p<$max;$p++){
    if (&gojo($p, $b) ==1){
        if($b**($p-1) % $p == 1){
            print "$p\t";
            $count++;
        }
    }
    $b = 2;
}
print "\ncount: $count\n";

sub gojo{
    my ($a,$b) =@_;

    while ($b>0) {
        $c = ($a % $b);
        $a = $b;
        $b = $c;
    }
    return $a;
}

100までは正しく判定できているようだ。 1000までにすると3個、余計に素数と判定したものが混じる。

誤判定した数字は、341, 561, 645。 電卓で計算すると、2^(p-1) mod p は皆1になる。 561は「カーマイケル数」だが、あとの二つは違う。 645は5で割れる。341は11で割れる。561も11で割れる。

これらはa=2とした場合に誤判定される数値のようだ。 1021までしか判定できないのだが、2のべき乗を計算すると1023乗までしかできない。

2013/03/26

twitterのblock

twitterの公式のWEBページでは、自分がblockしているユーザの一覧、自分のことをブロックしているユーザの一覧などが参照できない。

私はtwitterを使うためにわざわざアプリをインストールするのは面倒なので、パソコンではブラウザで、iPhoneでは公式アプリでtwitterを使っている。

あまりないのだが、SPAMみたいなアカウントとか、個人的にムカっときたときにブロックをすることがある。

自分が相手をブロックしているかどうかは、「ブロックされました」という通知が出たり「あなたをブロックしているユーザ一覧」などのような機能はないが、確認する方法がある(前に聞いたのだがどうやるかは忘れた)。

「ブロックする」というのは、あきらかなSPAMアカウントはいいとして、それ以外のアカウントに対してだと、なんだか自意識過剰な感じがするのでほとぼりがさめたら解除するようにしている。

そのために、APIを呼び出す簡単なスクリプトを作って実行している。

それを使いながら、「どうして公式サイトや公式アプリではブロックに関する機能があまりないのか」と考えたのだが、もし簡単に一括ブロックとか、ブロックしている・されているユーザ一覧などがわかってしまうと、ブロックが濫用されて気に入らない人のフォローが外れてしまい、「誰とでも気軽につながれる」というtwitterのよさが損なわれ、その他のSNSのように閉鎖的になるのを避けるためではないか。

最近は私はブロックするとすぐにそれを解除する。そうすると、あたかもシステムの不具合でいつの間にかフォローがはずれてしまったかのような状態になる。そういう話はよく聞くし、私も何度か経験した。

だがそれはもしかしたら、私がしているように、相手が私をブロックしてすぐ解除したのかもしれない。


2013/03/21

10個のマスのうち3個を塗りつぶすパターンをすべて示す

perlでなくもなんでもいいのだが、

「10個のマスのうち3個を塗りつぶすパターンをすべて示す」

というプログラムを書きたい。

マスというのは配列でも文字列でもなんでもよい。

oooxxxxxxx

ooxoxxxxxx

ooxxoxxxxx

....

という事である。

別に必要にせまられているわけではないが、こういうのはプログラムでやるのが得意で、頭の体操にもなるし、と書きかけたのだがうまい案が思いつかない。

再帰をつかうといいのかな?

とりあえず、なんとかできた。

$num = 10;

$x=0;
$y=1;
$z=2;

$count=0;

while($x<($num-2)){
$count++;
for($i=0;$i<$num;$i++){
$array[$i]=0;
}

$array[$x]=1;
$array[$y]=1;
$array[$z]=1;

printf("%8d: ", $count);
print @array;
print "\n";

$z++;
if($z>($num-1)){
$y++;
$z=$y+1;
if($y>($num-2)){
$x++;
$y=$x+1;
$z=$y+1;
}
}
}


もっとエレガントな書き方はあるだろう。

この書き方だと、マス数の変化には対応できるが塗りつぶすマス数の変化には対応できない。

2013/03/20

一括置換がうまくいかない

以下のような内容のテキストファイルがある。

aaa
<br>bbb
ccc


これを、以下のように書き換えたい。

aaa<br>bbb
ccc


つまり、

「行頭の<br>」、もしくは、「改行の後の<br>」を単なる<br>に置換したい


のである。

テキストファイルは多数あり、どのファイルに置換対象があるかはわからない。

まず、grepで対象ファイルを探そうと思った。

# grep -E '\n<br>' *.txt
#


これだと検索されない。

次のようにすると検索できる。

# grep -E '^<br>' *.txt
a.txt:<br>bbb
b.txt:<br>bbb


それでは置換してみよう。

# perl -pi -e 's/^<br>/<br>/g' *.txt
#


できない。

以下のような置換はうまくいくから、正規表現の問題だろうか。

# perl -pi -e 's/bbb/orange/g' *.txt
#


「sedでやれば?」と言うかもしれない。

実は以前これをsedでやろうとしてできず、1個ずつエディタを開いて直したことがあるのだ。

perlでやればいいのかと気づいて、やってみたら、やっぱりダメだったのだ。

sedのときは以下のいずれでもダメだった。

# sed -e "s/^<br>/<br>/g" *.txt

# sed -e "s/\n<br>/<br>/g" *.txt


viでは、以下のようにして置換できる。







Perlのワンライナー

ワンライナーはほとんど使わないが、「私、perlならそこそこ書けます」とか言っておいて「ああそう、じゃあこれちょっとワンライナーで書いて」と言われてできないというのはマズいからごく基本的なことはできるようにしておきたい。

perl -e 'for(1..20){print ($_**2); print "\n"};'


と思ったが、-e をつけてシングルクォーテーションで囲んで一行で書くだけか・・・。




2013/03/12

twitter oauth

とりあえずできた。

アプリを認証したらクッキーを焼いて2回目からは認証不要とする。

クッキーがあるので認証を経ずにブロック解除のスクリプトに飛ばせる。

ブロック解除のスクリプトでもクッキーを使う。

たぶんセキュリティ上あまりよくない方法な気がするので

ソースとかは載せない。




2013/03/10

oauth

oauthは難しい。全然わからん。

perl, php で動くサンプルをマネしてやってきたが、いずれもうまく動かなくなってしまった。

oauthを使うということはつまり、アプリを公開するということである。

自分だけ使うとか、ボットにtweetさせるとかいうだけなら必要ない。

私の場合、ブロックしているアカウントの一覧表示とその解除をしたい。

これだけである。

twitterはblockという機能をあまり使って欲しくないのか、公式ページでは自分が誰をブロックしているのかが簡単にはわからない。私はtwitterで誰かと会話することは皆無といってよいので、ケンカしたり中傷されたりという理由でブロックするのではない。インチキ商売のユーザーとか、フォローしたボットがフォローしてきたが飽きた時とかに使う。

followされるのが嫌なときにもブロックする。ただし、ずっとブロックしたままだとなんだか意識しているようでイヤなので、すぐにブロックを解除する。こうすると、あたかもtwitterの不具合でfollowが外れてしまったかのように見える。

そんなことをしたい。

pythonのtweepyというモジュールでやってみた。

WEBからあるサンプルを見つけて動くことを確認した。

oauthには2組のアカウント(idとパスワードの組み合わせ)を使用する。

consumer key と access token である。

consumer keyはアプリ側で用意しておく。

アプリ利用者は access tokenを取得する必要がある。

このときに自分のtwitterアカウントのIDとパスワードを入力し、access tokenを得て、twitter apiを使用する。




今回参考にしたサンプルでは、2つのスクリプトが動く。

最初のスクリプトではcosumer tokenとsecretを使用して認証のためのURLを取得し、そこにリダイレクトさせる。

http://api.twitter.com/oauth/authenticate?oauth_token=xxxxxx...


アプリを利用するユーザーは自分のtwitterアカウントでログインする。

すると、アプリ開発者が設定したcallback urlにリダイレクトされる。

この時に、callback urlにはoauth_tokenと oauth_verifierというものが付加されている。

アプリケーションは、oauth_tokenと、request secretから request tokenを得、

oauth verifierからaccess tokenを得る。

ここまで来れば、ユーザーにAPIを利用させることができる。

とりあえずaccess tokenを得てapiを動かすことはできるのだが、そのあとでいろいろ困っている。

ブロックしているユーザーの一覧は表示できた。

次にやりたいのはこれらのユーザーのブロック解除である。

ブロック解除するにはそれをおこなう別のスクリプトを動作させる必要がある。

つまり、認証状態を維持して、ブロック解除するスクリプトに渡さねばならないのだ。

どうやるのだろう?クッキーに保存するのか?

このへんはセッション管理で、oauthとはまた別の話か。

自分だけで使うときはaccess tokenをハードコーディングして渡している。

それを動的にやるだけか。

以下がハードコーディングの場合。

import tweepy
consumer_key = '***'
consumer_secret = ' *** '
access_key = ' *** '
access_secret = ' *** '
auth = tweepy.OAuthHandler(consumer_key, consumer_secret)
auth.set_access_token(access_key, access_secret)
api = tweepy.API(auth)
print = api.me().name


tweepy.OAuthHandlerを呼んだ後で、

get_authorization_urlを呼んで認証させると、

oauth_tokenとoauth_verifierが取得できて、

それらを使ってaccess_tokenとaccess_token_secretを得ると。




とりあえず、簡単なセッション管理をした。

access tokenとaccess token secretを取得したらそれをクッキーに保存する。

クッキーにtokenが保存されていたら認証ページへのリダイレクトをせずに、

callback urlへ飛ばす。

access tokenなんかをクッキーに保存すべきじゃないのかな?




hashを値の降順にソートして2次元配列にして返す


sub descend_hash {
my ($hash_ref) = @_;
my @tmp;
my @sorted;

foreach my $name (sort { $$hash_ref{$b} <=> $$hash_ref{$a} } keys %$hash_ref){
push @tmp, $name;
push @tmp, $$hash_ref{$name};
push @sorted, [@tmp];
@tmp = ();
}
return @sorted;
}


ハッシュのリファレンスを渡す。

デリファレンスをしてソートする。

ハッシュのキーと値を配列に格納する。

格納した配列を[]で囲み、無名配列として戻り値となる配列に格納するのがポイントである。

ここで配列のリファレンスである \@tmp を格納すると、

次の @tmp = (); で格納した配列がクリアされてしまう。

この辺は「プログラミングPerl」に書いてある。

というか、最初リファレンスで格納しようとしてうまくいかなかったので参照した。




使い方

my @array = util::descend_hash(\%myhash);
print '<table>';
foreach(@array){
print '<tr>';
foreach(@$_){
print '<td>';
print ;
print '</td>';
}
print '</tr>';
}
print '</table>';


@arrayに格納されているのは配列のリファレンスなので、

@$_ というふうにデリファレンスしてprintする。

各要素に直接アクセスするには $$_[0]というふうにする。




ログ解析

ボットを除いたアクセスを解析してみた。

サーチエンジンはGoogleが6割、yahooが3割、ezが8パーセント、bingが2パーセント。

実はこの4つしか数えていないのだが、私のサイトにはざっと見た感じこれ以外の検索エンジンからのアクセスはない。

ブラウザはIE9がトップで18%。次がAndroidのMobile Safari、つまりiPhoneでないスマホか。16%。firefoxが14%、Safariが13%。IE8が12%、Chromeが10%。MSIE10.0からのアクセスがあった。

Chromeが意外に少ない・・・。私はChromeを使っている。

IEはアドレスバー兼検索窓がたくさんタブを開くと小さくなってしまうのがイヤだ。

あとUIの雰囲気がイヤだ。だいぶ少なくなったがIEじゃないと使えないサイトがけっこうあるのでそのときだけ仕方なく使う。

OSはWin7が34%でトップ。次はXPとAndroidが同点でそれぞれ16%。iPhoneは9%。au携帯が8%、Mac OSが4.5%。Linux,BSDは全部あわせて1%くらい。

twitterなんかだとほとんどの人がマックを使ってるかのようにみんなマックマックと言っているのだが実際のシェアはそうでもないようだ。

ドメインはocnが12%でトップ。その次が spmode.ne.jpで、これはドコモである。ドコモの携帯かスマホでWifi経由じゃないやつか?11%あった。次がezwebで9%、次がpanda-worldつまりソフトバンクのiPhoneで6%。


2013/03/09

GDでグラフを描く

GDをインストールする。

あまり使いたくはなかったのだが・・・

棒グラフくらいなら小さな画像ファイルを並べてやっていたが、

円グラフを描きたくなったので。

perl -MCPAN -e shell

で install GD とやるとエラーがでる。

ネットを検索して、事前に

yum install gd-devel

が必要だと知る。




グラフを描いてみたが、思ったほど有用ではない。

パーセンテージが数字で出れば十分。

ログ解析で、ブラウザ、OS、ドメイン名などを数えてみた。

そして、「ハッシュを件数の降順に表示する」が頻発した。

これはライブラリ化したい。

こないだ立ち読みした「pythonクックブック」には、

ディクショナリの値でソート、を、クラスで実装する方法が紹介されていた。

perlでもできるよね?

とりあえずは、ハッシュのリファレンスを渡して、値の降順で並び替えたハッシュが返ってくればいい。


リファレンスの用途

リファレンスの使い方はだいたいわかったが、疑問がわいた。

「サブルーチンに文字列をそのまま渡さずにリファレンスで渡すべきか」
ということである。

直感的に、リファレンスで渡した方がよい事はあっても悪いことはない、と思う。

直接渡すと、サブルーチンでその文字列のコピーを持つから、文字列をコピーする時間がかかり、文字列用のメモリ領域も余計に取る、のではないだろうか?

実際に試してみても速度の変化は確認できなかったが、「続初めてのPerl」に以下のような記述があるので、私の考えは間違っていないと思う。
Perlは、@_を作るために、配列のすべての中身をコピーしなければなりません。要素が少なければ問題はありませんが、配列が大きくなったときには、サブルーチンに渡すためだけにデータをコピーするのは少し無駄です。

sprintfで%のエスケープ

ログ解析で以下のようにして 「15.2%」とかいう風に表示しようとした。

sprintf("%.1f%", $hoge / $sum * 100);


すると、意図通りに表示はされるのだが以下のメッセージがログに書かれた。

Invalid conversion in sprintf: end of string...


%をエスケープしないとダメか、と \%と書いたがダメで、

%%とするのだった。

sprintf("%.1f%%", $hoge / $sum * 100);

2013/03/08

rubyをやってみる

rubyもやってみよう。

2.0.0 が最新版とのことなので wgetでダウンロード。

インストール方法は、と調べると yum でできるのか・・・

が、yumだと 1.8.7で、前の前のバージョンということで、

やっぱり 2.0.0を入れる。

configure

make

make install

けっこう時間がかかる。そういえばphpもpythonもyumでやったような記憶がある。たくさんのcompileがおこなわれている・・・。言語をソースからインストールするとこんなものなのか。

ruby と言えば rails

railsも入れる。

gem というのを使ってインストールする。

gem install rails

バージョンをメモしておこう。

# ruby -v

ruby 2.0.0p0 (2013-02-24 revision 39474) [x86_64-linux]

# gem -v

2.0.0

# rails -v

Rails 3.2.12

インストール中に特に問題はなし。

railsインストール中に2回質問がきたが y で答える。

rdoc's executable "rdoc" conflicts with /usr/local/bin/rdoc
Overwrite the executable? [yN]  y
rdoc's executable "ri" conflicts with /usr/local/bin/ri
Overwrite the executable? [yN]  y
Depending on your version of ruby, you may need to install ruby rdoc/ri data:


ためしに環境変数を表示してみる。

そして REMOTE_ADDRで gethostbyaddrをやってみると、

返ってくるhostnameがおかしい・・・。

まあいいや。

じゃあmecab-rubyを入れよう。

0.994

https://code.google.com/p/mecab/downloads/list

ダウンロードサイトが検索にひっかからないので貼っておく。

rubyのボットスクリプトもpythonと同様、crontabに設定すると動かない。

今度は何もエラーが出ない。

似たようなことで悩んでる人がたくさんいるけど、

どれもなぜそうなってなぜ解決するのかがいまいち腑に落ちない。

#!/usr/local/bin/ruby
require 'rubygems'
require 'twitter'

YOUR_CONSUMER_KEY = "xxxxxxxx"
YOUR_CONSUMER_SECRET = "xxxxxxxxxx"
YOUR_OAUTH_TOKEN = "xxxxxxxxxxxxxx"
YOUR_OAUTH_TOKEN_SECRET = "xxxxxxxxxxxxxx"

Twitter.configure do |config|
config.consumer_key = YOUR_CONSUMER_KEY
config.consumer_secret = YOUR_CONSUMER_SECRET
config.oauth_token = YOUR_OAUTH_TOKEN
config.oauth_token_secret = YOUR_OAUTH_TOKEN_SECRET
end

client = Twitter::Client.new

client.update("こんにちわー")


perlだけはいけるんだよな・・・

なんでかな・・・




2013/03/07

cronだと動かなくなるpythonスクリプト

昨日直したのだがやっぱり動かない。

/var/log/messagesに以下のようなログが。

Mar  7 10:13:01 xxxxxxxx abrt: detected unhandled Python exception in '/hoge/hoge/hoge.py'
Mar  7 10:13:01 xxxxxxxx abrt: can't communicate with ABRT daemon, is it running? [Errno 2] No such file or directory

crontabで指定しているスクリプトは /hoge/hoge/hoge.shで、
/hoge/hoge/hoge.py というのは、sh内で呼んでいるpythonのスクリプトだ。
ルートディレクトリで /hoge/hoge/hoge.sh とやると動く。
hoge.pyを、print文一行だけにすると動く。
ということはpythonスクリプトの内容のせいか。
"No such file or directory" とあるが、何に対してなのか?
スクリプトの内容を変えると動くということは、
スクリプト内で開いているファイルだろう。
でも、ルートディレクトリで /hoge/hoge/hoge.sh とやって問題なく動くからな・・・・
どうしようもない・・・

これも頭の隅においとく。

検索後抽出アルゴリズムの改善

perlで書いたcgiをpythonに移植していて、元のコードのアラが見えたので直した。

これはperlだから、pythonだからどうこう以前の問題である。

ログのrefererから検索語を抽出するところである。

主にしていることは以下の通りである。



  • 検索エンジンの識別

  • 検索キーワードの抽出

  • 検索キーワードのURLデコード

  • URLデコードした文字列の文字コード識別(utf8以外)




ちょっと困ったのは文字コードの識別である。

ほとんどはutf8なのだが、EZの検索だとsjisになる。

これはEZの場合無条件にsijisとしてデコードするのでよい。

問題は、googleでもsjisの場合があることである。

referer内に「Shift_jis」などのキーワードがくっついている場合はそれを見てsjisと判断できるが、そのようなキーワードがないのにsjisの場合がまれにだが、ある。

pythonの場合、「utf8でデコードしてエラーを例外で捕捉しエラーならsjisでデコードし失敗したら不明」という風にした。

perlの場合、Encode::decodeでsjisの文字列をutf8でデコードしてもエラーにならない。

それじゃあ、と、Encode::Guessを使ってみる。

必ずではないがutf8の文字列をguessさせるとエラーになる場合がある。shiftjisの判別は成功するようである。

そこで、エラーは例外で捕捉し、guessに失敗した場合は何もせず、成功してshiftjisだったらshiftjisでデコード、という風にした。

最近のログだと、検索エンジンはgoogle, yahoo, ez, bingのみだ。ezが結構多い。

goo.ne.jpとか baiduとかはもう来なくなった。

数えてみたら、google 60%、yahoo 30%、ez 8%、bing 2% だった。

これをグラフで出すcgiもあとで作ろう。




pythonはいい

pythonはいい。

何がどういいのかを説明するのは難しいが、いろんな新しいアイディアがうかんでそれが即実現できる。

オブジェクトがどうとか型がどうだとかより、それが一番大事なことだ。




2013/03/06

importのエラー

twitterボットのスクリプトをpythonで書いて動くことを確認してcronで動かす。
翌日、動いてないことが発覚した。
python botscript.py だと動くのだが、
実行権限をつけて ./botscript.py とやると、import tweepyがエラーになる。

ImportError: No module named tweepy

sys.path.append('/usr/local/lib/python2.7/site-packages/')

か、と思って追加したがダメ。
見てみると MeCab.py はあるが、tweepy.py がない。 
tweepy-2.0-py2.7.egg というのがある。
tweepy.pyを探すがどこにもない。

あきらめてshスクリプトを作って逃げる。
eggの中のファイルをどっかにコピーすればいけるなんて情報があったが、
そんなことするのはまっぴらゴメンだよ!
python-twitterでやっても同じようになった。
頭の隅において置こう。いつかわかるさ。


今日はほぼ一日中pythonを書いていた。
やっぱり正規表現の使い方がperlと同じようにできないので、ロジックから作り直した。
おおげさかもしれないが、頭の中身がperl脳だったのがpython脳になって混乱している。
文法的に疑問があった時に対話式に確認できるのは便利だな。

user agentの変更

request = urllib2.Request('http://example.com/')
request.add_header('User-agent', 'Mozilla/5.0 (Windows NT 6.1; WOW64)')
response = urllib2.urlopen(request)
html = response.read()

2013/03/05

pythonで配列に要素を追加

ちょっと驚いたのは、配列に要素を追加したときだ。

perlでは pushという動作である。

pythonでは、以下のようにする。


array.append('hoge')


splitは以下のようにする。


array2 = moji.split('\n')


つまり、単なる文字列や配列がすでにオブジェクトであり、メソッドを持っているということである。




着々とperlからpythonへの移行がすすんだ。

正規表現を使うときにperlよりワンクッション入るような感じがする。

perlでサブルーチンにしてハッシュをリファレンスで渡しているところは、

pythonでは関数にディクショナリに **をつけて渡した。

が、参照渡しになるようなので、ディクショナリを戻り値にして渡したディクショナリにかぶせるようにした。

なんかスマートじゃないな。

ちなみに **dic というのをpythonでは何と呼ぶのだろうか?




pythonを覚える

perlしか書けないというのも困るので、pythonを本格的に覚えることにした。

気合をいれるために「初めてのPython」を買ってきた。

パラパラと読んでみたが、非常にマジメな印象である。

Perl本のようなギャグがない。

Perlとpythonについての比較のようなことがコラムとして書いてあったが、

perlは言語学者の作った自由な言語、pythonは数学者の作った統一のとれた言語、

というようなことが指摘されていた。

そしてperlの自由さは保守性が低くなるという欠陥であると。

私はperlが大好きなのだが、やっぱり特殊な言語なのかな。

大規模なシステムを複数の人間で作るようなものには向かないのだろうか。

あくまでもツールとして、とりあえず何かするみたいな使い方に適しているのかな。

さて、まずはpythonでmecabを使えるようにした。

mecab-pythonというバインディングをインストールしようとして、

python setup.py build でエラーになった。

mecab本体とバインディングのバージョンが違っているためだった。

mecabは数ヶ月前に入れたばかりなのだが、結構頻繁にアップデートされているのだな。

mecabのバージョンアップは置いておいて、とりあえずmecab-pythonを同じバージョンにしてやりすごした。

0.994である。

cgiにすると外部モジュールのimportが動かなくなった。

とりあえず

sys.path.append('/usr/local/lib/python2.7/site-packages/')

を書いてしのいだ。




まだ少ししか使っていないが、perlに比べてクソ真面目な印象がある。

というか、やっぱりperlが自由奔放すぎるのだろうか。

そこが好きなんだけど。




2013/03/02

日本語をsubstr

perlで、日本語文字列のアタマの部分を決まった文字数だけ取り出す必要があった。
substrコマンドを使ったら、最初の部分が文字化けした。
検索してみると、「use encoding utf8を書けばよい」という情報があったのだが、
最近、「use encodingは非推奨になった」という話を聞いたばかりだったので、それはやりたくなかった。
もう少し検索してみると、要は、substrをする前にデコードしてやればよい、ということであった。

perlでファイルを読むとき

ちょっとハマった。


while(<$fh>){
print;
}


はいいけど、


while(<$fh>){
print $out;
}


はだめ。


while(<$fh>){
print $out $_;
}


としないと。




2013/03/01

メモリ故障

Windows7が動いている私の自宅で使用しているパソコンが突然ハングアップしたり電源を入れると起動できず、電源オン・オフを繰り返したりすることが時々あった。

メモリは2GBが2枚刺さっていたのだが、そのうちの1枚を抜いたら落ち着いた。

今までも同じような状況になったことはあったが、フタを開けてホコリを吹いたら治ったりしていたので、たまたまかもしれないと抜いたメモリを戻したら起動しなくなった。

これはメモリの故障だろうということになった。


2GBでも使えないことはないのだが、たくさんウィンドウ(大体ブラウザだが)を開くとモタモタする。

CPUは Intel i3 550 @3.25GHz、Windows7は64bit版のHome Premiumである。

メモリは2GBではきついのか、ということで買いに行った。

以前はよくパーツを買って自作したりちょこちょこ換えたりしていたが、

最近はめっきりごぶさただ。

ハードディスクの空きがなくなる、ということもここ数年すっかり起こらなくなった。

メモリは DDR3の1333が刺さっていたので同じものにする。

さて、どれだけ増やすか。今、2GBなので、最低+2GBだ。

選択肢は

  • 2GB 1枚
  • 2GB 2枚
  • 4GB 1枚
  • 4GB 2枚

秋葉原のあるパーツショップで価格表を見る。
4GB2枚セットで5,6000円である。
たいした額ではないので、4GB2枚にした。
いつも一番安いのを買うのだが、また故障するとイヤなのでちょっと高めで6000円弱の、
Transcendの JM1333KLN-8GK というのにした。

動作は快適になった。
しかし、「多すぎるか」と思った。
合計10GBである。

5枚のタブを開いているchromeが起動している状態でタスクマネージャーを見ると、

物理メモリは、
合計 9911
空きメモリ 7071

とある。

普段使うものをかたっぱしから起動していって、やっと空きメモリが5866となった。

でも動画をいっぺんに3つ表示とかしているので実際にはありえない状態だ。
ネットで検索すると、「32ビットなら2GB、64ビット4GBくらいが必要でそれより多くても無意味」という意見が多い。

なんか、メモリをドカンと大量に使うアプリないかな・・・

uniq 重複行を削除するコマンド

結構な量の、同じ内容の行が複数あるテキストファイルがある。その複数行を一行にしたい。

perlで、hashを使えばできるな・・・と思っていたら、uniq というコマンドで速攻でできた。

ファイルをsortした後、uniq。

2013/02/28

mecabで名詞を数える

トレンドとなっている語を探したくて、mecabを使って名詞を数えるスクリプトを書いた。

単に名詞だけを数えると、「山田太郎」を「山田」と「太郎」を別々に数えてしまう。

mecabに「山田太郎」で辞書登録すれば一語にできるがそれもめんどくさい。

そこで、「姓と名が連続して登場したらひとつの名詞とみなす」という風にしたのだが、どうもスッキリ書けず、下記のようになってしまった。

一応これで用は足せているのだが、もっと簡単にかけないかなあ・・・



foreach (@array){
    for (my $n = $m->parseToNode ($_); $n ; $n = $n->{next}) {
        my $surf=decode('utf8',$n->{surface});
        my $feature=decode('utf8',$n->{feature});
        my @features = split(/,/, $feature);

        if($features[0]=~ /名詞/) {
            if($features[3] eq "名"){
                if($saveword){ $surf = $saveword.$surf };
                    &check_word_hash($surf,\%hash);
                    $saveword = undef;
                }elsif($features[3] eq "姓") {
                    if($saveword){
                        &check_word_hash($saveword,\%hash);
                    }
                    $saveword = $surf;
                }else{
                    &check_word_hash($surf,\%hash);
                }
         }elsif($saveword){
             &check_word_hash($saveword,\%hash);
             $saveword = undef;
         }else{
             if($saveword){
                 &check_word_hash($saveword,\%hash);
                 $saveword = undef;
             }
         }
     }
}



sedによる一括置換

cgiでrequireしているファイル名を mylib.pl から util.plに変えた。

sedで全部置換する。

sed -i s/mylib/util/ *.cgi


-i をつけるとファイルを直接書き換える。

2013/02/27

viのtips

カッコにカーソルを置いて % で対応カッコに移動

:!でコマンド実行

hashの値の降順でソート





foreach my $name (sort { $hash{$b} <=> $hash{$a} } keys %hash){
print "$name,$hash{$name}\n";
}

「数えてハッシュに登録し件数が多い順に表示」というのを最近おぼえてよく使うようになったのだが、


ハッシュの値でのソート方法をいつも検索して某所からコピーしていたのだがメンドクサイのでここに書いておく。





tweetを大量に削除

わけあって、自分の過去のtweetを大量にしかし全部ではなく削除する必要があった。

1個ずつWEBで削除していきながら、「これはAPIを使ってやるべきだな・・・」と思ったものの、やり方がわからず結局全部「手動で」消した。

調べたらごく簡単だったのでメモしておく。

tweetを削除するにはそのidを知る必要がある。まずはそれを知る方法。


#!/usr/bin/perl
use strict;
use warnings;
use YAML::Tiny;
use Net::Twitter::Lite;
use Encode;

my $config = ( YAML::Tiny->read('/hoge/config.yml') )->[0];
my $twit = Net::Twitter::Lite->new(
legacy_lists_api => 0,
consumer_key => $config->{'cs_key'}, consumer_secret => $config->{'cs_secret'} );

$twit->access_token( $config->{'ac_token'} );
$twit->access_token_secret( $config->{'ac_secret'} );


eval {
my $statuses = $twit->friends_timeline({ since_id => 1000, count => 10 });
for my $status ( @$statuses ) {
print encode('utf8',"$status->{created_at} <$status->{user}{screen_name}> $status->{text} $status->{id}\n");
}
};
warn "$@\n" if $@;


これは、Net::Twitter::Liteの、cpanのページの最初のサンプルほとんどそのままである。

tweet(status) は日本語なのでencodeしている。encodeしなくても表示できるが警告がうるさいのでencodeした。

use warning をはずせばいいのか・・・まあいいや。

since_id というのは名前からして、表示する最小のidであろう。ちなみにゼロにしたらエラーになった(省略できる)。

$status->{id}が、tweet(status)のidである。これはおそらく全tweetでユニークなidだ。

statusは新しいものからcountの数だけ取得される。

idがわかったら、以下のようにidを指定して destroy_statusを実行する。


eval {
my $statuses = $twit->destroy_status(3047606842882xxxxx);
};
warn "$@\n" if $@;


eval, warnとかの書き方はよくわからないがサンプルのままである。

あとは、tweetとidを表示し、消したいidを選んでdestroyすればよい。

「一括削除アプリ」みたいなものもあったのだが、遅い上に削除もできなかった。

注意すべきなのはあまり大量にいっぺんに表示・削除するとAPIの利用制限に引っかかるおそれがあることだ。

destroy_statusはAPIを1回呼び出すごとに1個ずつ消すから多分すぐアウトになるんじゃないか?

上記のやり方では1個だけ消せることを確認した。

大量に削除する際は要注意だ。




2013/02/25

RSSフィードを出力するcgi

ずっと前にやったRSSフィードを出力するcgiを見直す。

Jcodeを使っているが、古いのでやめる。

が、どうやって使うのかを忘れた。

ブラウザで実行するとxmlのソースが表示される。

これでいいんだっけ?

最近はRSSはあまり使わないけど、一応できるようにはしておきたい。

さて、やってみたら何の問題もなくrssが書けた。

多分、以前苦労したのは日本語のエンコードが良くわかっていなかったからだと思う。

rssフィードを出力するcgiを書いて、実行すると、ブラウザでxmlのソースが表示される。

そのurlをgoogleリーダーに登録する。フィードが表示される。

cgiを書き直して、フィードを更新してみる。googleリーダーを更新する。フィードが更新されない。

更新間隔が短すぎるからだろうと思って、いったんフィードの登録を削除し再登録すると新しいフィードが表示される。

さて、これをどうやって使うのだろうか?

たとえばブログの新しい記事を書いてそれを通知するときには、rssフィードを追加していくのか?

今日記事を書いて、フィードを出力する。翌日書いてまたフィードを出力する。この時に昨日のフィードを上書きしたら、

昨日のフィードを読まなかった人は読めなくなる。

だが、googleリーダーに登録してずっと読んでいなくても、後でまとめて読むことができる・・・

フィードを追加していくとすると、今度はずっとたまってしまう・・・




2013/02/23

logwatchを停める

logwatchは有益な情報が少ないので停めることにした。

どうやってインストールしたかもよく覚えていないが、

googleで検索し、/etc/cron.dailyにあるスクリプトを消す。

cron.dailyなるディレクトリの存在を初めて知る。

cron.hourlyなどもある。

それらの中のスクリプトを置いたおぼえはない。

毎日実行するようなものはここへ置くべきなのか。

たとえば /etc/cron.daily には logrotate というスクリプトがある。

毎日動くのはいいとして、何時に動くんだろう?午前零時?

話は変わるが、teratermでどこかに接続しているときに、途中でウィンドウのサイズを変えると切れる。

これはバグだね。

今再現できなかったのだがすぐつながってしまうからだ。

時々時間がかかることがあって、その時に起こる。

twitterのbot

以前twitterのボットを作った。今も動いている。まあ、作ったというほどでもない、簡単なものであるが。

botというと、名言をつぶやくものが多いが、私は非公開にして自分だけfollowし、

覚える必要があることをtweetさせている。

今はTOEICの準備をしているので、模擬試験ででてきた未知の単語やフレーズなどをtweetさせる。

twitterは病気みたいにいつも見ているので、起きた時とか、外出中のちょっとあいた時間などに読むと記憶がリフレッシュされてよいような気がする。

だがこれも、あまり頻度が高すぎると読まなくなってしまう。

これは普通のbotやtweetと同じだ。




2013/02/22

mecabの辞書登録

登録する単語を記述したcsvファイルをIPA辞書の配下に置く。
mecabをインストールするときに辞書をutf-8にしたはずだが、
ここに置くときはeucにしないとダメだった。

$ cp mydic.csv mecab-ipadic-2.7.0-20070801/
$ cd mecab-ipadic-2.7.0-20070801


初めて登録するときは、configureとmakeをする

$ ./configure --with-charset=utf8
$ make
$ sudo make install


2回目以降はmake cleanとmakeをする

$ make clean
$ make
$ sudo make install


(参考)

http://www.mwsoft.jp/programming/nlp/mecab_dictionary_customize.html

2013/02/15

crontabの書き方

twitterのbotをcronで動かしていて、つぶやく時間をひとつずつcrontabに書いていたのだが、便利な書き方を知った。

カンマで区切って複数時間を指定できる。

ハイフンでつないで範囲を指定できる。

8-20/3 は、8時から20時までの間で3時間置き、という意味である。

13  10  *  *  * root /hoge/hoge/hoge1
00,20,40  9-21  *  *  * root /hoge/hoge/hoge2
05  8-20/3  *  *  * root /hoge/hoge/hoge3


hogeの部分はperlで書いたスクリプトだが、スクリプト内で指定しているカレントディレクトリを認識しないようなので、絶対パス指定に書き換えた。




2013/02/09

セッション管理の必要性

さて、ログインの仕組みを作ってみたいと考えている。

パスワードを画面上で隠す方法はわかった。

次は、それを送信する時に暗号化すればいいのだろうと考えた。

最初はperlのcrypt関数を使おうとしたが、8文字までしかチェックできないので、Digest::MD5を使うことにした。

かんたんなテストプログラムで動作を確認してさあCGIで使おうと思ったところで、止まった。

postというのは、入力した値を処理するスクリプトを指定するだけであり、

入力された値を加工してから、つまり暗号化してから、渡すことができない。

ブラウザ上では見えないが、パケットキャプチャをすると当然平文パスワードが丸見えである。

このパスワードを認証するcgiに渡してからmd5ハッシュを作ってもしょうがない。

だがどう考えても、通信自体が暗号化されていなければパスワードを暗号化して渡すことはできない。

さらっと検索しても少なくともperlでcgiを書くだけではできないようだ。

だからみんなhttpsを使っているというわけなのか。

ただ私はほんのお遊びのサイトなので、簡易的なパスワードでかまわない。

どうせ見えるのなら、平文でやりとりするかな。

apacheのベーシック認証で、アクセス制限することはできる。

が、そもそもやりたいのはアクセス制限ではなく、カスタマイズされたページの表示である。

今はどのサイトでもログインしてそのユーザ用のページを表示する。amazon, twitter, google, yahoo... なんでもそうだ。

そのためにはセッション管理が必要である。

パスワード入力フィールドをマスクするhtmlタグ

パスワード入力欄、つまり入力した文字を表示せずに*でマスクするフィールドはhtmlで指定できることを知った。

<input type="password" name="password" ....>


CGIモジュールだと、

password_field("password")


CGIモジュール

あんまり使わないが、すっきり書けそうなので使ってみる。

charsetを指定しないと iso-xxxxとかになるので、utf-8を指定する。

日本語を使わないなら、 print header() でよい。


#!/usr/bin/perl
use strict;
use warnings;
use CGI qw(:standard);

print header(-charset=>'utf-8'),
start_html(-title=>"Login"),

h2("ログインしてください"),
hr(), start_form(-method=>'post',-action=>'./post.cgi'),
p("ID : ", textfield("id")),
p("password : ", textfield("password")),
submit(-name=>'login',-value=>'ログイン'),
end_form(), hr(), end_html();


ついでに、入力された値を表示するcgi。


#!/usr/bin/perl
use strict;
use warnings;
use CGI qw(:standard);

my $id = param('id');
my $password = param('password');

print header(-charset=>'utf-8'),
start_html(-title=>"Login"),
h2("ようこそ"),
hr(),
p($id),
p($password),
hr(), end_html();


CGIモジュールは使ったことがあったのだが、以下のようにnewして ->でメソッド(?)を呼び出していた。


$obj = new CGI;
print $obj->header;


今回はPerlクックブックなどのサンプルを見たのであるが、そこではnewしないで使っている。

そして、qw(:standard) を書かないとnewしないと使えないことがわかった。

どうしてそうなるのかは、わからない。




2013/02/06

一文字ずつパラパラと表示する

Perlクックブックより。
一文字ずつパラパラと表示する方法が紹介されていた。
まずは紹介されているものをそのまま書いて動くことを確認する。
split(//) で、一文字ずつに分解されることを知る。
ということは、分解した一文字ずつをprintし、sleepをはさんでいけばいいのではないかと思って、
while(<>){
   for(split(//)){
        print;
        sleep 1;
    }
}
とやってみたが、うまくいかない。
元のソースを見てみると、以下のような謎の1行があった。
$|=1;
そしてこれを書くと、想定どおりの動きをした。
$| とは何だろう?
調べてみたら、この値を0以外にすると出力のバッファリングをしないとのことであった。
通常はバッファリングするのでまとめて表示されるのだ。
1文字ずつパラパラと表示させるには、これを無効にする必要があったのだ。

2013/02/05

Perlクックブック

前から、それも数年前から欲しいと思っていた本をついに入手した。

本屋にいくたびにもしあったら買おうと思うのだがいつもない。

amazonを見てみたら中古しかない。ということはいわゆる絶版か。

そして中古価格は定価の1/10程度だった。

2001年の初版モノである。外観は多少薄汚れてはいるものの、

中身は一度でも読んだかどうかというくらいきれいだ。

こういうものはどうやって入手するのだろう?

買ったはいいが読まずに本棚においたままだったとか、店で売れずにいたものを買い取るとか。

この「クックブック」は最近(といってももう数年前)に2分冊になったようであるが、その前のものである。




2013/01/31

さくらのVPSでメールアカウントを追加する

さくらのVPSでメールアカウントを追加するには、二つの設定ファイルに追記してコマンドを実行してサービスを再起動する必要がある。

これを自動化したい。

一番ラクなのはwebから設定することであるが、cgiはそのままではシステムにかかわるファイルに追記したりサービスリスタートなどはできない。できては困る。権限がないのだ。

apacheでsudoを使うようにすればいいようだが、ひとつ困ったことがある。

cgiでファイルを open $fh,">>file.txt"; とやると、permission deniedになる。これは sudoでは解決しない。

ファイルをいじるスクリプトを作ってそれを呼ぶようにしないと駄目か。




ibus

# ps aux|grep ibus
hoge   2260  6.0  0.2 148464  2332 ?        Sl   07:00   0:04 /usr/bin/ibus-daemon -r --xim
hoge   2268  0.0  0.3 158108  3336 ?        S    07:00   0:00 /usr/libexec/ibus-gconf

hoge   2272  0.0  0.6 235456  6232 ?        S    07:00   0:00 /usr/libexec/ibus-x11 --kill-daemon
root      2374  0.0  0.0 107460   924 pts/1    S+   07:01   0:00 grep ibus

# ibus-setup
Traceback (most recent call last):

File "/usr/share/ibus/setup/main.py", line 28, in <module>
import gtk
ImportError: No module named gtk

これがいけないのか。gtkというモジュールがないのか。じゃあいれよう。ちょこちょことyum installをするがうまくいかない。めんどくさいので yum install python*

djangoがどうたらでエラーになる。

skipbrokenとかなんとかいうのをつけたらというのでつけてみるとインストールが始まったが最後にコケる。WEBで似たような状況の人を探し、pythonと名のつくものはなんでもかんでも片っ端から放り込む。

ダメ。

再起動する。

ダメ。

なんか、「あのリポジトリだとダメ」とかいう情報があるがどこからいれたとかどこからいれるとか、よくわからない。

以前使っていたノートPCを起動してみる。

起動しているプロセスが多い。

rpm -qa|grep ibus

としてみるとこれもずいぶん違う。

同じものを全部入れてみる。

再起動。

それにしてもいつも思うのだがさくらのVPSの再起動はずいぶん速いね?

iPhoneの再起動より速い。

ダメ。

psで足りないのは、以下の二つ。これが動かないとダメなのだろう。

やっぱりpythonだ。

python /usr/share/ibus/ui/gtk/main.py
python /usr/share/ibus-anthy/engine/main.py


はいってないモジュールを一個一個インストールしていくと、

エラーメッセージが変わった。

python /usr/share/ibus/ui/gtk/main.py
Traceback (most recent call last):
File "/usr/share/ibus/ui/gtk/main.py", line 33, in <module>
import ibus
ImportError: No module named ibus


main.pyというファイルを見ると、 import ibus と書いてある。

これがないのだ。

これを入れればいいのだ。

どうやって?

import os
import sys
import getopt
#import ibus
#import gtk
import gettext
#import panel
#import pynotify


main.pyには上記のようにimport文が書いてあるがコメントにした部分が全部 no module named *** となる。

なんだよこれ・・・

ibusがダメなのか、pythonがダメなのか・・・

2013/01/29

さくらのVPSメール関連設定メモ

doveadm pw

/etc/dovecot/passwd

/etc/postfix/vmailbox

postmap /etc/postfix/vmailbox

/etc/init.d/postfix restart

/etc/init.d/dovecot restart




さくらのVPSにVNC接続

さくらのvpsでgnomeを動かしてvncでつながるようになった。

そんなの重くて使いものにならないだろうと思っていたが、

軽快である。

youtubeを見てみようと思って、flashをインストールしたのだがうまくいかない。

インストールしたあと、libflashplayer.soというファイルを、以下のようにコピーしないといけなかった。

# cd /usr/lib/mozilla/plugins/
# ll
合計 0
# cd /
# find -name "libflashplayer.so"
./usr/lib64/mozilla/plugins/libflashplayer.so
./usr/lib64/flash-plugin/libflashplayer.so
# cp /usr/lib64/mozilla/plugins/libflashplayer.so /usr/lib/mozilla/plugins/


youtubeの絵はカクカクしているが、これはvpsから我が家間の通信が遅いからである。

Bフレッツとかだったらいけるんじゃないか?

あとは音か・・・。

その前に日本語入力だ。

Ctrl+SpaceでiBusという日本語入力が動くはずなのだが、数秒とまるが動かない。

あと、resolve.confの中身が消えてしまうことがある。

#Generated by NetworkManager と書いてあるので、こいつが上書きしているのではないかと思う。

GNOMEを入れるときに余計なものをたくさんいれてしまったのでその時入ってしまったのだろう。

NetworkManagerは起動しないようにする(GUIで)。

が、やっぱり消える。「ifconfigにネームサーバを書け」とか書いてあるので、しぶしぶ書いたらその内容がresolv.confに入った。よくわからんがこれでいこう。

日本語入力は、scimというのと、ibusというのがあって、scimはインストールできず、

ibusはインストールされているが起動せず、でどっちもダメだ。

まあguiでなきゃダメなことがあるわけではないから困らないのだが、

皆ができるということができないのは腑に落ちない・・・




2013/01/27

Net::Twitter::Liteの更新



Net::Twitter::Liteが新しくなっているようなので更新した。

cpan[1]> install Net::Twitter::Lite
CPAN: Storable loaded ok (v2.20)
Going to read '/root/.cpan/Metadata'
Database was generated on Fri, 25 Jan 2013 14:53:03 GMT
CPAN: LWP::UserAgent loaded ok (v6.04)
CPAN: Time::HiRes loaded ok (v1.9725)
Fetching with LWP:
ftp://ftp.riken.jp/lang/CPAN/authors/01mailrc.txt.gz
CPAN: YAML loaded ok (v0.70)
Going to read '/authors/01mailrc.txt.gz'
CPAN: Compress::Zlib loaded ok (v2.058)
............................................................................DONE
Fetching with LWP:
ftp://ftp.riken.jp/lang/CPAN/modules/02packages.details.txt.gz
Going to read '/modules/02packages.details.txt.gz'
Database was generated on Sun, 27 Jan 2013 15:17:03 GMT
..............
New CPAN.pm version (v1.9800) available.
[Currently running version is v1.9402]
You might want to try
install CPAN
reload cpan
to both upgrade CPAN.pm and run the new version without leaving
the current session.


..............................................................DONE
Fetching with LWP:
ftp://ftp.riken.jp/lang/CPAN/modules/03modlist.data.gz
Going to read '/modules/03modlist.data.gz'
............................................................................DONE
Going to write /root/.cpan/Metadata
Net::Twitter::Lite is up to date (0.11002).





2013/01/26

Java

ちょっとjavaを使ってみる。

server - clientのサンプルがあって、1台のパソコンで両方動かしてみたことがあるが、

それをさくらのVPSのサーバとWindows7間でやってみたい。

まずWin7にJDKを入れる。

JDKでいいんだっけ?

JavaはもうSunではなくORACLEのものになっている。

インストールして、Pathを追加して、helloworld的なものを動かしてみる。

さくらの方は、rpmファイルをPCに落としてftpであげようとしたら遅くて待てないので、wgetしようとしたら失敗する。どうも、WEBでLicense Agreementに同意してダウンロードしないとダメらしいので、PCからアップロードすることにする・・・あと80分とかいう表示・・・待てない。

さくらのvpsにX WindowsとGNOMEを入れて、VNCでつなぎ、firefoxをいれて、ORACLEのダウンロードページへ行って落とす。

けっこう時間はかかったが、今後もこういうことがあるかもしれないからね。

というわけでWin7とCentOS6の両方でjavaのHelloWorldを動かした。



perl単語帳

use Win32::Clipboard;
my $clip = Win32::Clipboard();
exit 1 unless $clip->IsText();
my $text = $clip->GetText();
$filename ='newwords.txt';
open $fh,'>>',$filename or die;
print $fh $text."\n";
close $fh;

新しい単語を見つけたらそれをクリップボードにコピーした後、

このスクリプトを動かすとファイルに追加してくれる。

それだけ。

コピーがメンドクサイ。本当は選択して右クリックで送りたいところだけど。




mediawikiのインストール

sphinxはやっぱりメンドクサイのでwikiを入れる。

こないだpukiwikiが動かなかったのでmediawikiを入れてみる。

ファイルを wgetでダウンロードして解凍し、/var/www/html/ の下にフォルダを移す。

そして http://www.example.com/mediawiki-1.xx.xx/index.php をブラウザで開く。

するとひまわりの写真の下に Please set up the wiki first. というリンクが表示される。

「これをクリックするとセットアップできるのか、こりゃ便利だ」

と思ったら、500のエラー。

ログを見ると、

[Sun Jan 27 04:48:27 2013] [error] [client xx.xx.xx.xx] PHP Fatal error:  Class 'DOMDocument' not found in /var/www/html/wiki/includes/LocalisationCache.php on line 542,(以下略)


これはphp-domがないと出るエラーだそうだ。

php-domをyumで入れればいいのだが依存関係がどうたらで結局phpを入れなおしてから以下をやった。

# yum install php-xml
# yum install php-dom
# service httpd restart


その後、インストールスクリプトが動いたがDBにアクセスできないとかいろいろあってごちゃごちゃやったが何が必要十分なのかがよくわからない。最終的にインストールできたときのphpとmysqlのモジュールは以下のようになっている。

# rpm -qa|grep php
php-mbstring-5.3.3-14.el6_3.x86_64
php-xml-5.3.3-14.el6_3.x86_64
php-common-5.3.3-14.el6_3.x86_64
php-pdo-5.3.3-14.el6_3.x86_64
php-gd-5.3.3-14.el6_3.x86_64
php-cli-5.3.3-14.el6_3.x86_64
php-mysql-5.3.3-14.el6_3.x86_64
php-devel-5.3.3-14.el6_3.x86_64
php-5.3.3-14.el6_3.x86_64
php-mcrypt-5.3.3-1.el6.x86_64
php-pear-1.9.4-4.el6.noarch

# rpm -qa|grep mysql
compat-mysql51-5.1.54-1.el6.remi.x86_64
mysql-5.5.28-3.el6.remi.x86_64
mysql-devel-5.5.28-3.el6.remi.x86_64
mysql-libs-5.5.28-3.el6.remi.x86_64
mysql-server-5.5.28-3.el6.remi.x86_64
php-mysql-5.3.3-14.el6_3.x86_64





Mojolicious

クライアントサーバのperl版を試した。

これを使えばさっき作った単語登録をネットワーク対応にできる。

そして、Mojoliciousというものを知った。

Mojolicious::Liteというモジュールもある。

インストール後、以下のようなファイルを作り、


use Mojolicious::Lite;

get '/' => 'index';

app->start;

__DATA__

@@ index.html.ep
Hello World!


以下のようにmorboというコマンドで実行するとhttpサーバが動く。


C:\Users\t\mojo>morbo mojo.pl
[Sun Jan 27 04:09:27 2013] [info] Listening at "http://*:3000".
Server available at http://127.0.0.1:3000.


この状態でブラウザで http://127.0.0.1:3000 にアクセスすれば、Hello World! という文字が表示される。

これはおもしろそう。

https://github.com/yuki-kimoto/mojolicious-guides-japanese/wiki/Mojolicious%3A%3ALite