cabal install monadius したら結構ハマった
結局こんなことをやった
cabal install OpenGLRaw --reinstall
cabal install StateVar --reinstall
cabal install Tensor --reinstall
cabal install ObjectName --reinstall
cabal install OpenGL --reinstall
cabal install GLURaw --reinstall
cabal install array-0.3.0.1 --reinstall
cabal install containers --reinstall
cabal install GLUT --reinstall
cabal install directory-1.1.0.0 --reinstall
cabal install monadius --reinstall
- history からインストールに必要だと思われるコマンドを抜粋した。
- よく分からないのでとりあえず全部 --reinstall フラグをつけているけど要らないと思う。
ハマりポイント
cabal install array-0.3.0.1 --reinstall
cabal install directory-1.1.0.0 --reinstall
- "cabal install array"だけでバージョン指定をしなかったり、"cabal install directory"だけだと最新版を入れようとしてくれるが、入らない。
JOI2012春合宿
一日目:125
二日目:11
三日目:10
四日目:70
Haskellで文字列圧縮(エンコーダーのみ)
仕組み
- 各文字の出現頻度を数えて一番多いものに"1"、二番目に"01"、三番目に"001"を割り振る。
- ex "aaaaaaaaaaaa" -> "11111111111"
- その後6ビットずつに区切る
- ex "11111111111" -> ["111111","111111"]
- 2進数として読み、文字に変換する
- ex ["111111","111111"] -> "``"
動作例
Main> compress "aaaaaaaaaaaaabbbbbbbbbbbbbb"
Just "KKKK_`0"
Main> compress "qwerrfvghhvjnbknjkfaghjgfjda"
Just "!1!%!%%%B5B\"#!)A!$)#1;C\"!#1"
課題
文字の種類が多いものはうまく圧縮できない。
生成したビット列の長さが6で割りきれないときは勝手に0を補っている。
返り値が Maybe String 。
デコーダがない。(致命的)
ソースコード
import Data.Map as M import Data.List import Data.Char allChar = Prelude.map chr [0..127] genDict str = fromList $ Prelude.map func $ zip [1..] $ Prelude.map snd $ reverse $ sort $ zip (Prelude.map (countChar str) allChar) allChar where func (a,b) = (b,makeCodeLengthN a) makeCodeLengthN 1 = "1" makeCodeLengthN n = '0' : makeCodeLengthN (n-1) countChar [] _ = 0 countChar (x:xs) c = if x==c then 1 + countChar xs c else countChar xs c translate [] d = return [] translate (x:xs) d = do y <- M.lookup x d ys <- translate xs d return (y++ys) bitToChar str = func (reverse str) 0 where func [] a = chr (33+a) func (x:xs) a = if x=='1' then func xs (a*2+1) else func xs (a*2) split6 str = if length str < 6 then [str] else fst (splitAt 6 str) : split6 (snd (splitAt 6 str) ) compress str = do a <- translate str $ genDict str return ( Prelude.map bitToChar (split6 a) )
Haskellでheadコマンド
Haskellで作るものが思いつかないのでheadコマンドを実装してみた。
main = do cs <- getContents putStr $ unlines $ take 10 $ lines cs
std::setでデータ同士の間に順位付けができないと無視されてしまう件
#include <stdio.h> #include <set> using namespace std; struct Data{ int a,b; }; Data makeD(int aa,int bb){ Data d; d.a=aa,d.b=bb; return d; } bool operator < (const Data &d,const Data &e){ return d.a<e.a; } int main(){ set<Data> se; se.insert(makeD(0,1)); se.insert(makeD(0,2)); printf("se.size()==%d\n",se.size()); for(set<Data>::iterator it=se.begin();it!=se.end();it++) printf("a=%d b=%d\n",(*it).a,(*it).b); return 0; }
を実行すると
se.size()==1
a=0 b=1
となってしまう。
これはsetが(0,1)と(0,2)の違いを分からないからである。
se.size()==2
a=0 b=1
a=0 b=2
このようにするには
bool operator < (const Data &d,const Data &e){ if(d.a==e.a) //<= return d.b<e.b; //<= return d.a<e.a; }
こんな風に書き換えると良い。
HaskellでBrainfuckの処理系を実装する
課題
'.' ポインタが指す値を出力に書き出す。C言語の「putchar(*ptr);」に相当。
IOモナドを使いたくない(使えない)のでマシン状態の中にディスプレイを作って処理した。
',' 入力から1バイト読み込んで、ポインタが指す先に代入する。C言語の「*ptr=getchar();」に相当。
複雑になりそうだったので実装しなかった。
-- Brainfuck.hs import Data.Char main = do cs <- getContents putStrLn $ runBrainfuck cs runBrainfuck p = display $ runOneStep $ Machine p 0 [0,0..] 0 "" runOneStep (Machine a b c d e) = if (length a) == b then Machine a b c d e else runOneStep $ incrementProgramPointer func where func = case (a!!b) of '>' -> incrementPointer (Machine a b c d e) '<' -> decrementPointer (Machine a b c d e) '+' -> incrementMemory (Machine a b c d e) '-' -> decrementMemory (Machine a b c d e) '.' -> putCharToDisplay (Machine a b c d e) ']' -> jumpEnd (Machine a b c d e) '[' -> jumpStart (Machine a b c d e) otherwise -> (Machine a b c d e) incrementProgramPointer (Machine a b c d e) = Machine a (b+1) c d e data Machine = Machine { program::String,programPointer::Int,memory::[Int],memoryPointer::Int,display::String } deriving Show incrementPointer (Machine a b c d e) = Machine a b c (d+1) e decrementPointer (Machine a b c d e) = Machine a b c (d-1) e putCharToDisplay (Machine a b c d e) = Machine a b c d (e++[chr (c!!d)]) incrementMemory (Machine a b c d e) = Machine a b (changeMemory c 0 d (+ 1))d e decrementMemory (Machine a b c d e) = Machine a b (changeMemory c 0 d (subtract 1))d e jumpStart (Machine a b c d e) = if (c!!d)==0 then Machine a (func 0 b) c d e else Machine a b c d e where func depth pos = case (a!!pos) of '[' -> func (depth+1) (pos+1) ']' -> if depth==1 then pos else func (depth-1) (pos+1) otherwise -> func depth (pos+1) jumpEnd (Machine a b c d e) = if(c!!d)==0 then Machine a b c d e else Machine a (func 0 b) c d e where func depth pos = case (a!!pos) of '[' -> if depth==1 then pos else func (depth-1) (pos-1) ']' -> func (depth+1) (pos-1) otherwise -> func depth (pos-1) changeMemory [] i k f = [] changeMemory (x:mem) i k f = if i==k then f x:mem else x:changeMemory mem (i+1) k f
情報オリンピックの過去問の入出力をチェックするのに便利だったコマンド
nkf -Lu -overwrite TEST.txt
とやるとファイル中のCRLFが全てLFになって便利だった。