三島Haskell無名関数の会#1に参加しました
参加者の皆様お疲れさまでした。楽しかったです。
とりあえず、各セクションの感想など。
Gentoo on Yesod
Gentoo LinuxでYesodをインストールする一部始終を解説していただきました。
Yesodは、前に一度インストールしてみたのですが、えらく大変だった記憶しかありませんでした。
Gentooがその福音に…なるのかはわかりませんでしたが^_^;、Gentooへの興味はちょっと高まりました。
とりあえず、いただいたvmwareのイメージを動かしてみねば。
DevQuizに参加しました(3)
スライドパズル
最後はスライドパズル。いわゆる15パズルを解く問題なのですが、4x4だけではなく3x3〜6x6、4x3などの長方形もあり、「壁」という動かないパネルもあるという、変形15パズルです。
これはチャレンジ問題ということで、とても難しかったです。
結果、5000問中1335問正解で時間切れになってしまいました。
この問題は反省しきりです。
module Main where import Prelude hiding (Left, Right) import Time import Directory sampletable :: Table sampletable = ((0, 0), [(1, (1, 0)), (2, (1, 1)), (3, (0, 1))]) samplegoal :: Table samplegoal = ((1, 1), [(1, (0, 0)), (2, (1, 0)), (3, (0, 1))]) -- solve001 = moves2str $ solve (5, 6) $ readTable 5 "12=E4D9HIF8=GN576LOABMTPKQSR0J" -- solve007 = moves2str $ solve (3, 3) q007 q007 :: Table q007 = readTable 3 "168452=30" {- q007 = ((2, 2), [ (1, (0, 0)), (2, (2, 1)), (3, (1, 2)), (4, (0, 1)), (5, (1, 1)), (6, (1, 0)), (8, (2, 0)) ]) -} main = do start <- getClockTime putStrLn $ show start udlf <- getLine limitstr <- getLine readPuzzles (read limitstr) 1 end <- getClockTime putStrLn $ show $ diffClockTimes end start readPuzzles limit count = do wid <- getNum hig <- getNum puz <- getLine if wid + hig <= 9 -- if wid <= 3 && hig <= 3 then do nam <- return ("ans" ++ show count) exist <- doesFileExist nam if exist then return () else do putStrLn nam (moves, ccount) <- return $ solve (wid, hig) $ readTable wid puz appendFile ("ans" ++ show count) $ moves2str $ moves putStrLn $ show ccount else do return () if count == limit then return () else readPuzzles limit (count + 1) getNum = do str <- getNumStr return $ read str getNumStr = do c <- getChar if c == ',' then return "" else do l <- getNumStr return (c:l) readTable width tstr = (take0, dropwall) where take0 = snd $ head $ filter isZeroPanel panels isZeroPanel (val, _) = val == 0 dropwall = filter isNomalPanel panels isNomalPanel (val, _) = val > 0 panels = map mkPanel $ zip tstr [0..] mkPanel (ch, ipos) = (char2id ch, (ipos `mod` width, ipos `div` width)) char2id ch = (length $ takeWhile ((/=) ch) "=0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ") - 1 moves2str :: [[Move]] -> String moves2str mss = unlines $ map (map move2char) mss move2char :: Move -> Char move2char Left = 'L' move2char Right = 'R' move2char Up = 'U' move2char Down = 'D' type Pos = (Int, Int) type Panel = (Int, Pos) type Table = (Pos, [Panel]) type Size = (Int, Int) data Move = Left | Right | Up | Down deriving (Show, Eq) data CanMove = None | Can Move deriving (Show, Eq) type Solution = ((Table, Integer), [Move]) type SolveState = ([Integer], [Solution], [Solution]) giveup = 200 toprank = 30 canmove :: Pos -> Pos -> CanMove canmove (x0, y0) (x1, y1) | x0 - 1 == x1 && y0 == y1 = Can Left | x0 + 1 == x1 && y0 == y1 = Can Right | x0 == x1 && y0 - 1 == y1 = Can Up | x0 == x1 && y0 + 1 == y1 = Can Down | otherwise = None filtpanel :: Table -> [(Move, Panel)] filtpanel (_, []) = [] filtpanel (pos, (p:ps)) | cm p == Can Left = (Left , p) : nr | cm p == Can Right = (Right, p) : nr | cm p == Can Up = (Up , p) : nr | cm p == Can Down = (Down , p) : nr | cm p == None = nr where cm (_, posn) = canmove pos posn nr = filtpanel (pos, ps) move :: Table -> Panel -> Table move (zpos, panels) (tch, tpos) = (tpos, exchange panels (tch, zpos)) exchange :: [Panel] -> Panel -> [Panel] exchange ps target = map changeone ps where changeone org | fst org == fst target = target | otherwise = org solve :: Size -> Table -> ([[Move]], Integer) solve size inittable = (map reverse $ fst resultsolve, snd resultsolve) where goalhash = makeGoalHash size inittable resultsolve = solve2 0 goalhash size ([], [((inittable, makeHash size inittable), [])], []) solve2 :: Integer -> Integer -> Size -> SolveState -> ([[Move]], Integer) solve2 count goalhash size (hashes, ss, ss0) | count > giveup = ([], count) | restsolve == 0 = ([], count) | getgoals == [] = solve2 (count + 1) goalhash size nextsolvestate | otherwise = (getgoals, count) where restsolve = length (ss ++ ss0) getgoals = snd $ unzip $ filter (\((_, h), _) -> h == goalhash) ss nextsolvestate = (nexthashes, newsolutions, waitedsolutions) nexthashes = hashes ++ (snd $ unzip $ fst $ unzip ss) newsolutions = makenext size nexthashes $ take toprank sortedsolutions waitedsolutions = drop toprank sortedsolutions sortedsolutions = sortbyrank size (ss ++ ss0) makeGoalHash :: Size -> Table -> Integer makeGoalHash size (_, ps) = sum $ map (goalhashval size) ps goalhashval :: Size -> (Int, Pos) -> Integer goalhashval size (val, _) = (toInteger mulsize ^ val * (toInteger val)) where mulsize = fst size * snd size makeHash :: Size -> Table -> Integer makeHash size (_, ps) = sum $ map (hashval size) ps hashval :: Size -> (Int, Pos) -> Integer hashval size (val, pos) = (toInteger mulsize ^ val * (toInteger $ getGoalValue size pos)) where mulsize = fst size * snd size sortbyrank :: Size -> [Solution] -> [Solution] sortbyrank size ss = snd $ unzip $ qsort $ map withrank ss where withrank s = (ranktable size $ fst $ fst s, s) qsort [] = [] qsort (x:xs) = qsort smaller ++ [x] ++ qsort larger where smaller = [a | a <- xs, fst a <= fst x] larger = [b | b <- xs, fst b > fst x] ranktable :: Size -> Table -> Int ranktable size (_, ts) = foldr (distance size) 0 ts distance :: Size -> Panel -> Int -> Int distance (w, h) (val, (x, y)) sum = sum + abs((val - 1) `mod` w - x) + abs((val - 1) `div` w - y) getGoalValue :: Size -> Pos -> Int getGoalValue (w, _) (x, y) = x + y * w + 1 makenext :: Size -> [Integer] -> [Solution] -> [Solution] makenext size hashes ss = concatMap (\((t, h), ms) -> makeonenext size hashes (t, ms)) ss makeonenext :: Size -> [Integer] -> (Table, [Move]) -> [Solution] makeonenext size hashes (table, moves) = filter (\((_, h), _) -> not $ loopsolution hashes h) $ map process $ filtpanel table where process (m, p) = ((nexttable, makeHash size nexttable), m : moves) where nexttable = move table p loopsolution :: [Integer] -> Integer -> Bool loopsolution hashes newhash = any ((==) newhash) $ hashes
Haskellで解きました。
- まずは幅優先の総当り（大きいパズルでは全然）
- ゴールへの近さを定義して、近いものから優先して解く
- ハッシュを計算して盤の比較
- 解けた問題の解答はファイルに保存して2度解かないようにする
- 時間がかかったらギブアップして次の問題へ行く
てな感じで上記のコードになりました。
反省点
- 解く速さにこだわってしまい、本格的に計算を始めるのが遅れた
- そのせいで時間切れ
- ギブアップなど、早く解くこと以外に力を入れ解ける問題をさっさと済ませればよかった
- あんま関数型っぽく解けなかった気がする
- データ型を木構造にするなどもうちょっと凝れば、効率もが上がったかもしれない
なんとなく自分の仕事のやり方の問題点も顕になってしまった気もする。
自分の仕事のやり方を見直す意味でもこういう機会はちょくちょく作りたい。
DevQuizに参加しました(2)
Web Game
次はWeb Gameを解きました。
神経衰弱ができるWebページクリアすればOK。でも、この神経衰弱、カードは色を塗ってあるだけ。人間の目にはほとんど区別できない似た色のカードがあったり、枚数が異常に多かったりでとても人間が解くのは不可能。というわけでプログラミングで解きましょう、というクイズ。
オススメのChrome Extensionで解きました。
function clickCard(card) { var myevent = document.createEvent('MouseEvents'); myevent.initEvent('click', false, true); card.dispatchEvent(myevent); } function getColorNo(colorstr) { var pattern = /[0-9]+/g; var bai = 1; var result = 0; while((res = pattern.exec(colorstr)) !== null){ result += res * bai; bai *= 256; } return result; } var elements = document.getElementsByTagName('div'); var cards = []; for(var i = 0; i < elements.length; i++) { var elm = elements[i]; clickCard(elm); cards.push({element:elm, color: getColorNo(elm.style.backgroundColor)}); } var unopens = []; for(var i = 0; i < cards.length / 2; i++) { var card1 = cards[i * 2]; var card2 = cards[i * 2 + 1]; if (card1.color !== card2.color){ unopens.push(card1); unopens.push(card2); } } var message = ''; unopens.sort(function(a, b){ return a.color - b.color; }); for(var i = 0; i < unopens.length; i++) { var elm = unopens[i].element; clickCard(elm); message += unopens[i].color + "\n" }
全部のカードをクリックして、色を把握し、色順で並べ替えてクリック順を割り出しました。
あっという間にカードがめくれるのを見るのは面白かったです。
最初のクリックで色が揃ったものを把握して、無駄なクリックをしないようにしました。
DevQuizに参加しました(1)
DevQuizに参加したので、解答を晒しておきます。
やったのは、
- 一人ゲーム
- Web Game
- スライドパズル
一人ゲーム
まずは一人ゲーム。ルールは以下のとおり。
数がいくつか与えられます。なるべく少ない手数で数を全て取り除いてください。
あなたは 1 手で、
- 全ての数を半分にする（端数は切り捨て）
- 5 の倍数 (0 を含む) を全て取り除く
のどちらかの操作をすることができます。
で、与えられた問題に対して答えの回数を返すというもの。
作ったプログラムは以下のとおり。
main = do qcountstr <- getLine disp_answer $ read qcountstr disp_answer count = do ncountstr <- getLine questionstr <- getLine print (solveone (getquestion (read ncountstr) questionstr)) if count > 1 then disp_answer (count - 1) else return () getquestion count str = take count $ map read $ words str solveone xs = operatecnt (0, [xs]) operatecnt (cnt, xss) | isIncludeNull xss = cnt | otherwise = operatecnt (cnt + 1, operate xss) operate [] = [] operate (xs:xss) | isInclude5 xs = div2all xs : rid5 xs : operate xss | otherwise = div2all xs : operate xss div2all = map (\x -> x `div` 2) rid5 [] = [] rid5 (x:xs) | isPow5 x = rid5 xs | otherwise = x : rid5 xs isIncludeNull [] = False isIncludeNull (xs:xss) | isNull xs = True | otherwise = isIncludeNull xss isNull x = x == [] isInclude5 [] = False isInclude5 (x:xs) | isPow5 x = True | otherwise = isInclude5 xs isPow5 x = x `mod` 5 == 0
Haskellで書きました。
2で割っていって、5の倍数を取り除ける場合に解答を枝分かれさせ、全て取り除けた時点で終了。
サックリ解けたので特に問題無し。
反省点はfoldやfilterなど使ってもっとすっきり書けばよかったこと。
つづく
リポジトリのツリーを別のリポジトリに移す方法
以下の段階を踏めばOK。
- ダンプ
- フィルター
- 移動先のフォルダを用意する
- ロード
- フォルダ移動
エクスプローラで自由自在に移動、というわけにはいかない。必要な部分を選んで、移動先とファイルがごちゃごちゃにならないように移して、最後にフォルダを整える、といった感じか。
詳細は以下に。
その2 フィルター
リポジトリの一部のフォルダのみを移動したければ、フィルターをかけます。
svndumpfilter include /trunk/app --drop-empty-revs --renumber-revs > app.dump(2011/04/21修正) svndumpfilter include /trunk/app --drop-empty-revs --renumber-revs > app.dump < repos.dump
--drop-empty-revs はフィルタをかけたために空になったリビジョンを取り除く。
--renumber-revs はフィルタをかけた後に残ったリビジョンに番号をふりなおす。
意味のないリビジョンを作らないためにも、このオプションはつけた方がよい。
その3 移動先のフォルダを用意する
移動先のリポジトリを用意し、ダンプを読み込んでもエラーが出ない様に必要なフォルダを作成する。
上記の例ではreposリポジトリの/trunk/app以下のフォルダを移動しようとしている。
そのために、svndumpfilterでフィルターをかけたのだが、その時点でダンプから/trunkフォルダを作成した情報が失われているため、移動先のリポジトリに/trunkが無ければ作成しておく。
その4 ロード
ダンプした結果を読み込みます。
svnadmin load newrepos < app.dump
ロードするフォルダを指定したいときは、--parent-dir を使用すればよい。
上記の例では、
svnadmin load newrepos --parent-dir newdir < app.dump
newreposリポジトリのnewdirの下にtrunk/appが作られる（newdir/trunkが無いなら作っておく必要あり）。
その5 フォルダ移動
ロードまでの段階では、移動したいフォルダを自由自在に動かすことはできないので、必要ならこの段階で動かす。
Windowsのサーバーで、Subversionのリポジトリを、Apacheを使って公開
最近、Windowsのサーバーで、Subversionのリポジトリを、Apacheを使って公開した。
やったことを、やった順に記録しておく。
その２ Subversion1.6.6をインストール
こちらから。
Setup-Subversion-1.6.6.msi
が簡単。
その３ SubversionのReadme.txtを読んで設定を行う
ReadmeはSubversionのスタートメニューから開くことができた。以下の部分を読んで設定。
For an Apache server here's the essentials: 1. Copy bin/mod_dav_svn.so and bin/mod_authz_svn.so to the Apache modules directory. 2. Add the Subversion/bin directory to the SYSTEM PATH and reboot so all the Subversion support dll's are visible to the Apache service. 3. Edit the Apache configuration file (httpd.conf) and make the following changes: 3a. Uncomment the following two lines: #LoadModule dav_fs_module modules/mod_dav_fs.so #LoadModule dav_module modules/mod_dav.so 3b. Add the following two lines to the end of the LoadModule section: LoadModule dav_svn_module modules/mod_dav_svn.so LoadModule authz_svn_module modules/mod_authz_svn.so 3c. Add the following to end of the file. Note: This Location directive is a minimal example with no authentication directives. For other options, especially authentication options, see the Subversion INSTALL file, the Subversion Book, or the TortoiseSVN Manual.DAV svn SVNPath your/repository/path
上記の2.に"reboot"とあるのを見落としていて、うまくいかず、結構悩んだ。
ここまでくればSubversionのリポジトリをWebを通して見ることができているはず。
その４ 複数リポジトリ公開できるように設定変更
ここまでのやり方では設定ファイルで指定した1つのリポジトリしか公開できず、リポジトリを増やすたびにLocationを増やす必要があり面倒。SVNParentPathを使えばリポジトリが複数置いてあるフォルダを指定できるので、このフォルダにリポジトリを作成すれば公開完了になる。
Readme.txtの3c.で設定した部分を以下のように変更。
DAV svn SVNParentPath c:/svn-repos
SVNParentPathの引数には複数のリポジトリが置いてあるフォルダを指定。
その５ BASIC認証
設定を以下のように変更
DAV svn SVNParentPath c:/svn-repos Require valid-user AuthType Basic AuthName "Subversion repository" AuthUserFile c:/svn-repos/htpasswd
AuthUserFileで指定されているファイルは、Apacheのbinフォルダにある、htpasswd.exeを使用して作成。
その６ アクセス制御
authzファイルでできるようなアクセス制御をしたいので、以下のように設定を変更。
DAV svn SVNParentPath c:/svn-repos Require valid-user AuthType Basic AuthName "Subversion repository" AuthUserFile c:/svn-repos/htpasswd AuthzSVNAccessFile c:/svn-repos/authz
AuthzSVNAccessFileで指定したファイルの記述方法はauthzファイルと同じでよさそう。
