2011-10-12

冪乗計算のバイナリ法と冪剰余

GCJJ決勝のB問題を解いてたら解けなくて気づいたらここに辿り着いてたのでメモ。

冪剰余計算

import Data.List

bits :: Integer -> [Integer]
bits e = reverse $ bits' e
    where
    bits' 0 = []
    bits' x = (x `mod` 2) : bits' (x `div` 2)

binaryMod :: Integer -> Integer -> Integer -> Integer
binaryMod x e m = foldl' ope 1 $ bits e
    where
    ope n 0 = n^2 `mod` m
    ope n 1 = n^2 `mod` m * x `mod` m

なお、binaryMod内の`mod` mを除けば冪乗を計算するバイナリ法として動作。
使ってみると、(13783^5789) ^ (4498^10798) `mod` 5578 は1245だと返した。

2011-09-30

PeggyでHTMLパーサー(手抜き)を書いてみた

Haskell プログラミング

PEGとか知らないけどPeggy - The Parser Generator for Haskellを見ながら書いてみた。
思うところは色々あるけどもう今日は終わりたいから書いておく。

{-# LANGUAGE TemplateHaskell, QuasiQuotes, FlexibleContexts #-}

import Text.Peggy

main = print . parseHtml =<< getContents

parseHtml :: String -> Either ParseError HTML
parseHtml = parseString document "HTML"

data HTML = TextNode String
          | ElemNode { name :: String, attributes :: [(String,String)], children :: [HTML] }
          | Doctype String
          | Document [HTML]
          deriving (Show)

[peggy|
document :: HTML
    = nodes { Document $1 }

nodes :: [HTML]
    = (node, [\r\n \t]*)

node :: HTML
    = '<!DOCTYPE ' [^<>]+ '>' { Doctype $1 }
    / soloTag
    / coupleTag
    / [^<>]+ { TextNode $1 }

soloTag :: HTML
    = '<' soloTagList [ \t]* (attribute, [ \t]*) [ \t]* '/'? '>' { ElemNode $1 $3 [] }

soloTagList :: String
    = 'meta' { "meta" }
    / 'link' { "link" }
    / 'img' { "img" }
    / 'input' { "input" }
    / 'hr' { "hr" }
    / 'br' { "br" }

coupleTag :: HTML
    = '<' tagName [ \t]* (attribute, [ \t]*) [ \t]* '>' [\r\n \t]* nodes [\r\n \t]* '</' tagName '>' { ElemNode $1 $3 $6 }

tagName :: String
    = [^<>\r\n \t/!]+

attribute :: (String, String)
    = attributeName '=' attributeValue

attributeName :: String
    = [^ \r\n\t&<>=]+

attributeValue :: String
    = '\"' [^\"\r\n]* '\"'
|]

上記パーザーに下のHTMLを食わせる。

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html lang="ja">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=utf8">
        <title>hoge</title>
    </head>
    <body>
        <div id="header" class="mark">
            <div id="logo"><img src="logo.png"/></div>
        </div>
        <div id="body">
            <div id="content">
                <p>foobar</p>
            </div>
        </div>
        <div id="footer">
            <div id="copyright">Copyright &copy; hogehoge</div>
        </div>
    </body>
</html>

そうするとこんな結果。

Right (
  Document [
    Doctype "html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"",
    ElemNode {name = "html", attributes = [("lang","ja")], children = [
      ElemNode {name = "head", attributes = [], children = [
        ElemNode {name = "meta", attributes = [("http-equiv","Content-Type"),("content","text/html; charset=utf8")], children = []},
        ElemNode {name = "title", attributes = [], children = [
          TextNode "hoge"
        ]}
      ]},
      ElemNode {name = "body", attributes = [], children = [
        ElemNode {name = "div", attributes = [("id","header"),("class","mark")], children = [
          ElemNode {name = "div", attributes = [("id","logo")], children = [
            ElemNode {name = "img", attributes = [("src","logo.png")], children = []}
          ]}
        ]},
        ElemNode {name = "div", attributes = [("id","body")], children = [
          ElemNode {name = "div", attributes = [("id","content")], children = [
            ElemNode {name = "p", attributes = [], children = [
              TextNode "foobar"
            ]}
          ]}
        ]},
        ElemNode {name = "div", attributes = [("id","footer")], children = [
          ElemNode {name = "div", attributes = [("id","copyright")], children = [
            TextNode "Copyright &copy; hogehoge"
          ]}
        ]}
      ]}
    ]}
  ]
)

あ、ドキュメントタイプがXHTMLだった。
もっと綺麗に書きたいなー。

2011-09-22

wxHaskellでMediaCtrlを使用する

プログラミング Haskell

※gdgdやりながら何とか動いた時の手順をまとめた自分用のメモなので、正規のやり方では無い可能性があります。
なお、ubuntu11.04での話です。

wxWidgets

./configure --enable-mediactrl --enable-unicode
make
make install

でインストール。ここまで問題なし。

wxHaskell

wxHaskellのMediaCtrlはデフォルトで無効になっているので、インストールする際に有効にする必要があります。
wxモジュールはwxWidgetsをラップしているwxcoreを用いて高レベルインターフェースを提供しているので、今回いじる箇所はwxcoreです。
以下手順

wxcoreのtar玉をダウンロードし、展開します。
Setup.hsをテキストエディタで開きます。
50行目(readProcess "wc-config"のある行)の["--libs","--cppflags"]を["--libs","std,media","--cppflags"]に変更します。
63行目の["-DwxcREFUSE_MEDIACTRL"]を["-DwxUSE_MEDIACTRL"]へ変更します。
Setup.hsを保存し、cabal installします。
cabal install wxします。
お疲れ様でした。

2011-09-18

マルバツゲーム

プログラミング Haskell

RWHでモナド変換子とか色々覚えたので、それらを使ってマルバツゲーム作ってみた。

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Applicative
import Control.Monad.Error
import Control.Monad.Instances
import Control.Monad.State
import Data.Array
import Data.Char
import System.IO

-- ゲームの進行用モナド。
newtype Game t e a = Game { getGame :: ErrorT e (State t) a }
    deriving (Monad, MonadError e, MonadState t)

runGame :: Game Board GameError a -> Board -> (Either GameError a, Board)
runGame = runState . runErrorT . getGame

-- 盤面。
data CellState = Maru | Batsu | Blank deriving (Eq,Show)

showCellState :: CellState -> String
showCellState Maru = "O"
showCellState Batsu = "X"

type Board = Array Int CellState

initBoard :: Board
initBoard = listArray (1,9) . repeat $ Blank

updateBoard :: Int -> CellState -> Board -> Either GameError Board
updateBoard n cst brd
    | n < 1 || 9 < n || brd ! n /= Blank = Left . strMsg $ "そこには置けません。"
    | otherwise = Right $ brd // [(n,cst)]

renderBoard :: Board -> String
renderBoard brd = line [1..3] ++ "-----" ++ line [4..6] ++ "-----" ++ line [7..9]
    where
    line (a:b:c:_) = "\n" ++ cell a ++ "|" ++ cell b ++ "|" ++ cell c ++ "\n"
    cell n = let a = brd!n in if a == Blank then show n else showCellState a

-- 勝敗判定。
data Judge = Win | Continue deriving (Eq,Show)

judge :: Board -> Judge
judge brd = if any line pat then Win else Continue
    where
        pat = [ [1,2,3], [4,5,6], [7,8,9], [1,4,7], [2,5,8], [3,6,9], [1,5,9], [3,5,7] ]
        line (x:xs) = case brd ! x of
            Blank -> False
            x' -> all (==x') . map (brd!) $ xs

-- ゲーム進行上のエラー
newtype GameError = GameError String deriving Show

instance Error GameError where
    strMsg = GameError

errMsg :: GameError -> String
errMsg (GameError msg) = "ERROR: " ++ msg

-- Main
main :: IO ()
main = game initBoard Maru

game :: Board -> CellState -> IO ()
game b p = do
    putStrLn $ showCellState p ++ "のターン"
    putStrLn $ renderBoard b
    putStr "置きたい場所の番号を選んでください >"
    hFlush stdout
    n <- (\s -> if all isDigit s then read s else 0) <$> getLine
    let (res,b') = runGame (process p n) b
    either err (next b' p) res
    where
        err e = putStrLn (errMsg e) >> game b p
        next b p Continue = game b $ if p == Maru then Batsu else Maru
        next b p Win = do
            putStrLn $ renderBoard b
            putStrLn $ showCellState p ++ "の勝利です。"

process :: CellState -> Int -> Game Board GameError Judge
process cst n = do
    get >>= either throwError put . updateBoard n cst
    get >>= return . judge

2011-06-27

gitでcloneとかする時のポート指定

Git

例えば、

git clone ssh://foo@hogehoge:ポート番号/bar

ってする。

2011-04-07

qtHaskellでのui/qtスクリプト/qrcファイルの扱い方

Haskell

uiはuiLoaderを使う。
qtスクリプトは普通に読み込む。
qrcファイルは一旦「rcc -binary my_application.qrc -o my_application.rcc」とかやってrccファイルを作り、実行時にregisterResourceを使って読み込む。

2011-04-07

ghc7でqtHaskell-1.1.4をインストール

Haskell

qtHaskell-1.1.4はbuildスクリプトがghc7に対応していないので、Adminpanelを見て手作業で進めていきましょう。
またrunhaskell Setup.hs buildを実行すると、途中でQtc/Core/Attributes.hsで以下のようなエラーを出します。

Qtc/Core/Attributes.hs:583:13:
    Could not deduce (Qstt a (QDialogSc b))
      arising from a use of `slotReject''
    from the context (Qstt a (QDialogSc b1))
      bound by the instance declaration
      at Qtc/Core/Attributes.hs:581:10-52
    Possible fix:
      add (Qstt a (QDialogSc b)) to the context of
        the instance declaration
      or add an instance declaration for (Qstt a (QDialogSc b))
    In the expression: slotReject'
    In an equation for `reject'': reject' = slotReject'
    In the instance declaration for `QsaSlotReject a'

そしたら下記のパッチを当てます。

--- Qtc/Core/Attributes.hs      2011-04-07 00:32:52.280000311 +0900
+++ Qtc/Core/Attributes_modify.hs       2011-04-07 00:33:28.033333645 +0900
@@ -580,7 +580,7 @@
 
 instance (Qstt a (QDialogSc b)) => QsaSlotReject (a) where
   slotReject' = (Qslot "reject()", \_ -> ())
-  reject' = slotReject'
+  reject' = (Qslot "reject()", \_ -> ())
 
 class QsaSignalRejected_nt_f w x f where
   signalRejected', rejected' :: x -> SltConf w f

でも該当箇所を直接書き換えた方が早いです、きっと。
当てたらrunhaskell Setup.hs buildして、残りの作業を続けます。

ネタ元：windows - An error occured while compiling qtHaskell - Stack Overflow