2005年09月
LZSS
いろいろなところで使われている LZSS の実装は多種多様である．なので，ありそうなパターンに対応できるようにソースを書いてみた．速度は度外視．あとで最適化すればいいし．圧縮部分の検索ルーチンをもう少し大きなハッシュにしたほうが速いだろうか？ ま，どうでもいいか．つーことで，そーすをおいておく．
- Comments: 0
- TrackBack (Close): -
Java の quine program
Java で自分自身を出力する quine program を書いてみた．
結果はこんなん：
class Self {
static String s="class Self {%n%tstatic String s=%c%s%c;%n%tpublic static void main(String [] args) {%n%t%tString ss=s.replaceAll(new String(new byte []{37, 110}), new String(new byte []{10}));%n%t%tss=ss.replaceAll(new String(new byte []{37, 116}), new String(new byte []{9}));%n%t%tss=ss.replaceAll(new String(new byte []{37, 99}), new String(new byte []{34}));%n%t%tss=ss.replaceAll(new String(new byte []{37, 115}), s);%n%t%tSystem.out.print(ss);%n%t}%n}%n";
public static void main(String [] args) {
String ss=s.replaceAll(new String(new byte []{37, 110}), new String(new byte []{10}));
ss=ss.replaceAll(new String(new byte []{37, 116}), new String(new byte []{9}));
ss=ss.replaceAll(new String(new byte []{37, 99}), new String(new byte []{34}));
ss=ss.replaceAll(new String(new byte []{37, 115}), s);
System.out.print(ss);
}
}
ほとんど printf をエミュレートするような形で... 美しくないなぁ．%n, %c, %t, %s を改行，ダブルクオート，タブ，自身の文字列で置換すると．ついでなので（ある程度）任意のプログラムを読み込んで quine program にしてしまうプログラムも作ったので置いておこう．
- Comments: 0
- TrackBack (Close): -
The Underhanded C Contest のコード
コンテストの規定は画像処理プログラムを書いて， fingerprint を実行するたびに異なるように入れろと．さたに，その fingerprint に意味はなくてもいいけどあるほうがよいと．んで，受賞した単に減色するだけのプログラムを見たけど... まったく普通のプログラムにしか見えん．種明かしとしてはスタックフレームにローカル変数の値が残ることを利用して連続しているらしい．うーん，こんな方法思いつかんなぁ．もっと柔軟にならねば．
- Comments: 0
- TrackBack (Close): -
Singletonパターンのあほなおち
Singleton パターンではインスタンスを一つ作ってそれを使いまわす．そのために，そのインスタンスを取得する関数でインスタンスを作ってあるかを調べ，あったらそれをかえす，なければ新しく作るという動作をさせるのが一番楽．で，コンストラクタはプライベートにしておくと．
しかしながらとあるプログラマは次のようなコードを書いて，うまく動かないと騒いでいた．
AClass* AClass::getInstance(){
static bool isFirst = false;
if(!isFirst){
instance = new AClass();
}
return instance;
}
isFirst が false のままだし... あなたインスタンス取得するたびに新しいの作るんですか？ Singleton とか言ってたのにインスタンスはひとつじゃないんですね．そもそも isFirst などというフラグを持たずに if(!instance) と書いていれば間違いがなかったものを．
とりあえず今後の参考のためにこの事実を記しておこう．ちなみに彼はコンストラクタすらもプライベートでなかったという... （まあ，このソース以外では正しいコードを書いていたそうだが．）
- Comments: 0
- TrackBack (Close): -
Haskell で LZSS
Haskell で副作用のない LZSS を実装してみようと考えてやってみた．
検索には二分木を用いるとして，有限サイズの窓では二分木の古いノードを消さなければならない．ということで，キューでも使って追加したノードを覚えとけばいいのだけど，Haskell でO(1)操作のキューを作るのはただ事でないので... とりあえずヒープを使って O(log n) のキューを作りましょうと．（まあ，Chris Okasaki: Simple and efficient purely functional queues and deques. JFP 5(4):583-592, October 1995. のキューが使えるんだけどよく理解してないし）
import Char
import List
import Monad
import System.Random
import System.IO
import System
import IO
import CPUTime
-- 検索およびHeap用 BinaryTree
data BTree a = Node a (BTree a) (BTree a) | Nil
-- 表示
instance Show a => Show (BTree a) where
showsPrec n x = xshowsB x
xshowsB (Node a l r) = ("Node ("++) . (shows a) . (") ("++). (shows l) . (") ("++). (shows r) . (")"++)
xshowsB (Nil) = ("Nil"++)
-- 表示2
printBTree b = mapM_ putStr (map (++"\n") (bstr b))
bstr (Node a l r) = let
ba = shows a ""
sp = map (\x -> ' ') [1..(length ba)]
sps = ba:map (\x -> sp) [1..]
bstrr = bstr r
bstrl = (if isNil l then [""] else bstr l)
leftes = (if isNil r then leftedges2 else leftedges)
bl = map (\(p,e,s)->p++e++s) (zip3 sps leftes bstrl)
br = map (\(e,s) -> sp++e++s) (zip rightedges bstrr)
in if (isNil l) && (isNil r) then [ba] else bl++br
where
leftedges = "-+-":leftedges'
leftedges' = " | ":leftedges'
leftedges2 = "-+-":leftedges2'
leftedges2' = " ":leftedges2'
rightedges = " +-":rightedges'
rightedges' = " ":rightedges'
bstr Nil = []
-- ノードのテストと置換
isNil Nil = True
isNil (Node a l r) = False
getVal (Node a l r) = a
getLeft (Node a l r) = l
getRight (Node a l r) = r
insRight (Node a l r) r' = Node a l r'
insLeft (Node a l r) l' = Node a l' r
insRoot (Node a l r) a' = Node a' l r
newNode x = Node x Nil Nil
-- ヒープはサイズと二分木のペア
type HeapTree a = (Int, BTree a)
-- heap の印刷用
printHeap (n, t) = printBTree t
-- ヒープに値を入れる(key, val)
insertHeap::Ord a => HeapTree a -> a -> HeapTree a
insertHeap heap item = let news = fst heap + 1 in (news, ins news (snd heap))
where
ins n t = if n==1 then Node item Nil Nil
else (if mod n 2 == 0 then (let
tl = getLeft t
tl' = ins (div n 2) tl
in swapHeapNodeLeft t tl'
)
else (let
tr = getRight t
tr' = ins (div n 2) tr
in swapHeapNodeRight t tr'
)
)
-- 左右の子と適宜入れ替える
swapHeapNodeLeft (p@((Node ki1 l1 r1))) (c@((Node ki2 l2 r2)))
= if ki1 <= ki2 then Node ki1 c r1
else Node ki2 (Node ki1 l2 r2) r1
swapHeapNodeLeft (Node ki1 l1 r1) Nil = Node ki1 Nil r1
swapHeapNodeRight (p@((Node ki1 l1 r1))) (c@((Node ki2 l2 r2)))
= if ki1 <= ki2 then Node ki1 l1 c
else Node ki2 l1 (Node ki1 l2 r2)
swapHeapNodeRight (Node ki1 l1 r1) Nil = Node ki1 l1 Nil
-- ヒープの最小値を覗く
peepMinimumHeap heap = getVal (snd heap)
-- 空？
isEmpty (_, Nil) = True
isEmpty (_, Node _ _ _) = False
-- 最小値と更新されたヒープを返す
minimumHeap::Ord a => HeapTree a -> (a, HeapTree a)
minimumHeap heap = let
size = fst heap
t = snd heap
in if size == 1 then (getVal t, (0, Nil))
else let (h, l, r) = moveLastToHead t size
in (getVal t, (size-1, reHeap h l r))
where
reHeap ki Nil Nil = Node ki Nil Nil
reHeap ki Nil (r@(Node kir lr rr)) = if ki <= kir then Node ki Nil r
else recR kir Nil ki lr rr
reHeap ki (l@(Node kil ll rl)) Nil = if ki <= kil then Node ki l Nil
else recL kil Nil ki ll rl
reHeap ki (l@(Node kil ll rl)) (r@(Node kir lr rr))
= if ki <= kir && ki <= kil then Node ki l r
else (if kir <= kil then recR kir l ki lr rr
else recL kil r ki ll rl
)
recR kir l ki lr rr = Node kir l (reHeap ki lr rr)
recL kil r ki ll rl = Node kil (reHeap ki ll rl) r
moveLastToHead t s = let
(h, t') = mov t s
in (h, getLeft t', getRight t')
mov t n = if n==1 then (getVal t, Nil)
else (if mod n 2 == 0 then (let
tl = getLeft t
(h, tl') = mov tl (div n 2)
in (h, swapHeapNodeLeft t tl')
)
else (let
tr = getRight t
(h, tr') = mov tr (div n 2)
in (h, swapHeapNodeRight t tr')
)
)
-- ヒープソート
heapsort xs = heapsortrec (foldl (\t x -> insertHeap t x) (0, Nil) xs)
where
heapsortrec heap = case heap of
(0, _) -> []
(_,_) -> (let (ki, h') = minimumHeap heap
in ki:heapsortrec h')
-- ヒープのテスト
-- 挿入過程
heaptest2 xs = foldl (\mt x -> mt>>= (\t -> let t' = insertHeap t x in printBTree (snd t')>> putStr "\n" >> return t')) (return (0, Nil)) xs
-- 取り出し過程
heaptest3 heap = case heap of
(0, _) -> print ""
(_,_) -> (let (ki, h') = minimumHeap heap
in print ki >> printBTree (snd h') >> heaptest3 h')
-- 挿入して取り出す
heaptest4 xs = heaptest2 xs >>= (\h -> heaptest3 h)
んで，検索木とキューの用意ができたので本体をば．展開はかなりきれいにかけるが圧縮部分が汚い... ループ使わずに全部再帰だし．ちなみに符号は Direct c で圧縮なしのキャラクタ c, Compress a l で自分より a 前から l + threlength キャラクタで圧縮と．
-- LZSS 符号
data LZCode = Direct Char
| Compress Int Int
instance Show LZCode where
showsPrec n x = xshowsLZ x
xshowsLZ (Direct x) = ("D "++) . (shows x)
xshowsLZ (Compress a l) = ("C "++) . (shows (a, l))
instance Eq LZCode where
(Direct x) == (Direct y) = x==y
(Compress a l) == (Compress b m) = a==b && l == m
-- 最大一致長
maxlength = 18
-- これ未満の一致は圧縮しない
threlength = 3
- - 窓のサイズ
んで，さらにこれを８符号ごとにまとめてバイトストリームに変換するのとそれをファイルに読み書きする部分を足し合わせると．最後にコマンドラインからファイル名とかを取るようにして完成．
-- コードを８ずつまとめてフラグビットを作るのと
-- アドレスとかをエンコードする
-- Compress a l で， 0<=a<4096, 0<=l<16 で使用のこと
encode xs = enc xs 128 0 [] []
where
enc [] mask flags cs codes = List.reverse (cs ++ (Char.chr(flags):codes))
enc (x:xs) mask flags cs codes = case mask of
0 -> (enc (x:xs) 128 0 [] (cs ++ (Char.chr(flags):codes)))
_ -> (case x of
Direct c -> enc xs (div mask 2) flags (c:cs) codes
Compress a l -> enc xs (div mask 2) (flags+mask) (Char.chr((div a 256)+l*16):Char.chr(mod a 256):cs) codes
)
decode xs = dec xs 0 0 []
where
dec [] mask flags codes = List.reverse codes
dec (x:xs) mask flags codes = case mask of
0 -> (dec xs 128 (Char.ord x) codes)
_ -> (if (flags - mask < 0) then dec xs (div mask 2) flags (Direct x:codes)
else
case xs of
(x':xs') -> dec xs' (div mask 2) (flags-mask) (Compress ((Char.ord x) + (mod (Char.ord x') 16)*256) (div (Char.ord x') 16):codes)
)
-- pico second から秒数表示
showSec psec = let msec = (div psec 1000000000)
in (show (div msec 1000) ++"."++ shown 3 '0' (mod msec 1000)++" sec\n")
-- n 文字で c をパディングにして a を文字列化
shown n c a = let str = show a in sh (n - length str) str
where
sh k str = if k<= 0 then str else sh (k-1) (c:str)
-- バイナリでオープンしないとならんので...
readBinaryFile path = openBinaryFile path ReadMode >>= hGetContents
writeBinaryFile path str = bracket (openBinaryFile path WriteMode)
hClose
(`hPutStr` str)
-- ファイルを圧縮, 展開
compfile path = do
putStr (("output: "++path++".cmp\n"))
st <- getCPUTime
str <- readBinaryFile path
c <- return (compress2 str)
ec <- return (encode c)
writeBinaryFile (path++".cmp") ec
ed <- getCPUTime
putStr (showSec (ed-st))
return c
decompfile path = do
putStr (("output: "++path++".dec\n"))
st <- getCPUTime
ec <- readBinaryFile path
c <- return (decode ec)
str <- return (decompress c)
writeBinaryFile (path++".dec") str
ed <- getCPUTime
putStr (showSec (ed-st))
return str
usage = ["usage: [compress] > lzss file",
" [decompress] > lzss -d compressedfile"]
printUsage = mapM_ (\x->putStr (x++"\n")) usage
main = do
args <- getArgs
if args ==[] then printUsage
else if head args == "-d" then (decompfile (head (tail args)) >> putStr "done.")
else (compfile (head args) >> putStr "\n")
720k のファイルで圧縮 88sec, 展開 ... 終わらん．130k で圧縮 15sec, 展開 7sec．ふむ，実用には絶対に耐えられん．意外に速かったけど．でも展開に変に時間がかかってるなぁ，どこが問題なのやら．ま，いいや．
- Comments: 0
- TrackBack (Close): -
図形のプログラム
- 2005-09-20 (Tue)
- プログラミング
凸多角形と軸が与えられ，その多角形を軸周りに回転したときの回転体の体積を求める．こんなプログラムを書いたのだが... 交差判定とかめんどくさすぎ．数式書いたらそれを計算してくれるプログラムをはく変換器がほしいと真剣に思う．そーいや，みんな戦略ソフトウェアの課題どうしたんだろ？
- Comments: 0
- TrackBack (Close): -
順列を内包表記で in Haskell
書くとこうなる
perm [] = [] perm [a] = [[a]] perm (x:xs) = [ take i y ++ (x:drop i y) | y <- perm xs, i <- [1..length xs]]
ちなみに，y と i の生成順を逆にすると遅くなる．内側が先に確定して外側に行くので．
- Comments: 0
- TrackBack (Close): -
th08.dat の再構築
- 2005-09-10 (Sat)
- プログラミング
展開できたついでに酒の勢いで再構築（圧縮）できるようにしてみた．んで，中にデモ用のリプレイファイルがあるからそれを自分のリプレイに置き換えてみたところ... デモはステージが固定なのかわけのわからない動きをして被弾しまくる結果に．ま，こんなもんだわな．
技術的には LZ の圧縮部分(最長一致の検索部分)を高速化したいところではある．いまのところ再構築に３５秒程度かかっているのでまったり感が微妙に... やっぱ binary tree ではなくハッシュを使う方式にしたほうが速いのだろうか？ もしくはアセンブラを考慮して最適化したコードを書かねばならんのか？ どうでもいいけどアドレス値が 0 になったのを符号列の終端の印にするってのは一般的なのだろうか？ これの分だけちょこっと圧縮率損するんだよなぁ...
- Comments: 0
- TrackBack (Close): -
浮動小数点数のオーバーフローと速度低下
二つの和を求めるプログラムがある．
#include<iostream>
using namespace std;
int main(int argc, char *argv[]){
double d = 1e300;
double sum = 0;
for(int i = 0; i < 10000000; i++){ sum+=d; }
cout << sum << endl;
}
#include<iostream>
using namespace std;
int main(int argc, char *argv[]){
double d = 1e308;
double sum = 0;
for(int i = 0; i < 10000000; i++){ sum+=d; }
cout << sum << endl;
}
上は 1e300 を 100000000 回足した和を求める．下は 1e308 を 100000000 回足した和を求める．これらのプログラムを実行した場合，普通は速度の違いなどないように思えるが... 実際に動かすと上が 0.148s で下が 0m3.692s と劇的に違う．これは double が 1.7e308 程度までしか値を保持できず，これ以上ではオーバーフローして Inf になってしまうことによる．で，Inf に値を足し続けるので遅くなると．何で Inf で遅くなるのかしらんけど．
- Comments: 0
- TrackBack (Close): -
区間が重なるか？
- 2005-09-05 (Mon)
- プログラミング
数直線上に一定周期で一定幅を持つ区間が並んでいると．そんなのを二つ持ってきたときに何処かに重なる部分がありますかという問題を解きたい．当初あほな私は for 文を繰り返し幅の lcm 文にいたるまでぶん回していたのだが... よく考えたら gcd の分だけできるだけ近づけて考えれば一発でいいじゃんと．いやぁ，あほだった．
- Comments: 0
- TrackBack (Close): -
ICPCの問題を久々に
- 2005-09-04 (Sun)
- プログラミング
ある期間内に存在する指定した曜日と日にちをもつ日の数を数えたり，グラフ上を巡回するアリ全部に対して情報伝達可能かどうかをしらべたり．そんな問題を解いたわけだが... コーディングが遅くなっているような... 最近この手のプログラムかいとらんかったからなぁ．いや，むしろ日付問題が苦手なだけだだろうか？ まあ，そんなことはどうでもよいのでさっさといやらしい入力を作るか．
- Comments: 0
- TrackBack (Close): -
永夜抄のデータ解析
- 2005-09-03 (Sat)
- プログラミング
友人がリプレイファイルの解析をやっていたのでデータファイルの解析をやってみた．結論としてはブロックに切ってスクランブルしてマスクでXORして，LZで圧縮かけて（アドレス13bit, 長さ4bit, 絶対アドレス（開始オフセット１）），全部をがしゃんとくっつけて最後にファイル名とアドレスと展開後のサイズの情報をまとめてLZかけてスクランブルしてくっつけてあると．んで，先頭には識別文字4つとファイル情報のエントリ数，アドレス，展開後のサイズがスクランブルされて格納されていると．
いやぁ，結構手間がかかってるもんだなぁと関心しつつ，ここまでやらなきゃだめなのかと思ったり．あと，ＬＺのパラメータが何でこの数字になっているのかよくわからない．バイト境界になるようにアドレスと長さのビットを割り振って，さらにフラグを８つまとめて置いておくほうが展開が速いと思うのだが... そこまで速度はいらないのかな．むしろビットストリームのほうがぱっと見で元データがわからないからいいのかも．
どうでもいいけど，何でこの永夜抄のアーカイブに妖々夢のPhantasm出現時に表示される画像データが入っているのだろう？
- Comments: 0
- TrackBack (Close): -
C言語のmain関数を変数として定義
なんとなく思いついたのでやってみた．C 言語で書いたプログラムの（ブートストラップ後の）エントリポイントは main 関数なわけだけど，アセンブラレベルでは結局のところ call main して main というラベルにとんでいるだけ．ということは，main は別にC言語の関数ではなく変数でもよい（main というラベルが作られる）．これを実証するコードは以下のとおり．
こいつは HelloWorld を表示するが，main は関数でなく変数である．
#include <stdio.h>
int f()
{
printf("HelloWorld!\n");
return 0;
}
int main[] = {0xB8909090, (int)f, 0x9090E0FF};
/*
int main = 0xB8909090;
int main2 = (int)f;
int main3 = 0x9090E0FF;
*/
/*
struct main {
int m1; int m2; int m3;
} main = {0xB8909090, (int)f, 0x9090E0FF};
*/
main の定義をコメントアウトしている形（構造体，複数個の連続した変数）にしても動く．原理としては main というラベルに飛ばされてくるので，そこに関数本体である f へのジャンプを行うマシン語を埋め込んで f へジャンプさせる．ジャンプのコードはi386で
90 NOP 90 NOP 90 NOP B8 XXXXXXXX MOVE EAX, f FF E0 JMP EAX 90 NOP 90 NOP
とかけるので，これらのマシン後が実行されるように main 変数に値を入れている．
ついでに C++ 版も．
#include <cstdio>
struct main {
int ins[5];
static int f() {
puts("HelloWorld!");
return 0;
}
} main = {0xB8909090, (int)(main::f), 0xE0FF};
- Comments: 0
- TrackBack (Close): -