No Such Blog or Diary

«Prev || 1 | 2 | 3 |...| 45 | 46 | 47 |...| 57 | 58 | 59 || Next»

forall A

Haskell で forall A. A -> A 系の型を作ってみる.まずもっとも単純に.

let x = x

t を型変数として x :: t で,undef 以外の何者でもない気がする.

んで,次.

let f x = x

これで f :: t->t . id 関数なような.

続いて

let y f = f (y f)

これで y :: (t->t)->t . fixpoint 関数とうか Y コンビネータなような.

ついでに,

let g y z = if True then y else z

とすると g :: t->t->t になる.意味のある関数ではないが... さて,これ以降はどうなるのだろうか?

ついでなので,forall a,b,... . a -> b -> ... も作ろうとすると

let f x y = f x y

とかで引数の数を増やせばいくらでもいける.意味はないけど.意味のあるものってどれくらいあるんだろう? undef, id, fixpoint 以外に意味のあるのがあるか?

ICPC by Haskell

ICPC2005 Regional, Tokyo の問題Bを Haskell で.queue を使ったシミュレーションだけど面倒だから一ターンごとにリスト生成...

 -- Problem B in ACM/ICPC 2005 ASIA Regional Tokyo
 -- 2005/11/04     Brute Force
import Control.Monad
import Debug.Trace
main = getProblems >>= mapM_ (putStrLn.show.solve)
  
getProblems = 
    do
    [m, c, n] <- getNums
    if (n==0 && m==0 && c==0) then return []
       else do
            xs <- replicateM n getEntry
            liftM ((m,c,n,xs):) getProblems
    where 
    getEntry = getNums >> getNums
    getNums = liftM (map read.words) getLine
  
 -- it's better to make each entry of ds the pair of it and its length 
solve (m,c,n,xs) = sl xs 0 (take m $ repeat [])
    where
    sl [] t _ = t
    sl ys t ds = let
                 (hs, ys') = unzip $ map (\x->(head x, tail x)) ys
                 (t', ds') = sl' ds hs
                 in sl (filter (not.(==[])) ys') (t'+t) ds'
    sl' ds = foldl searchOne (0,ds)
    searchOne (t, ds) x = let 
                          p = length $ takeWhile (not.or.map (==x)) ds 
                          ds' =if p<m then take p ds++[filter (not.(==x)) (ds!!p)]++drop (p+1) ds
                               else ds  
                          in insertOne (t+p+1) ds' x
    insertOne t ds x =
        if length (head ds) < c then (t+1, (x:head ds):tail ds)
        else let
             p = length $ takeWhile ((==c).length) ds 
             ds' = if p<m then take p ds++[x:(ds!!p)]++drop (p+1) ds
                   else ds
             p' = length $ takeWhile ((==c).length) ds'
             hds = head ds
             tds = tail ds
             q = p'-1
             tds' =if p'<m then take q tds++[last hds:(tds!!q)]++drop (q+1) tds
                   else tds
             in (t+p+p'+p+5, (x:init hds):tds')

ICPCをHaskellでやろうとしたときのテンプレート

ICPCをHaskellでやろうとすると入出力はこんな感じだろうか? とりあえずメインルーチンはデータセットのリストを getProblems で生成し,mapM_ で各データセットに対して solve で解いた結果を putStrLn.show で出力と.

main = getProblems >>= mapM_ (putStrLn.show.solve)

getProblems に関して.各入力セットの先頭の数字が終了フラグになるタイプは,終了なら [] をリターン,そうでなければデータをタプルにして cons をリフトする.

main = getProblems >>= mapM_ (putStrLn.show.solve)
getProblems = 
    do
    [n] <- getNums
    if n==0 then return []
       else do
            xs <- replicateM n getEntry
            liftM (xs:) getProblems
    where 
    getEntry = liftM words getLine
    getNums = liftM (map read.words) getLine
 

入力の最初にデータセットの数がある場合は replicateM でリストにすると.

main = getProblems >>= mapM_ (putStrLn.show.solve)
getProblems = 
    do
    n <- liftM (head.map read.words) getLine
    replicateM n getProblem
getProblem =
    do
    r <- getNum
    s <- liftM (head.map read.words) getLine
    ws <- replicateM s getNum
    return (r, ws)
    where 
    getNum = liftM (head.map read.words) getLine :: IO(Double)

あとは EOF で終了という不親切な場合もあるが... 面倒なのでやめとこう.各データセット内の値の取得は,replicateM と liftM (map read.words) getLine と叫べば大体は入力できそう.面倒なのは read の型を明示しとかないとこける可能性があることだろう.

ICPCアジア予選本番

一人でやるとしたら簡単なほうから5問は確実に行くだろうけど... 残りの問題はコーディングが面倒な感じかと思われる.間違っても Haskell では書きたくない.ProblemA でさえHaskell だと面倒だ(インデックス使えんので).

import Control.Monad
main = getProblems >>= mapM_ (putStrLn.show.cnt)
getProblems = do
              n <- liftM read getLine
              if n==0 then return [] else liftM (n:) getProblems
 
primes = let p (x:xs) = x:p (filter (\y -> not (mod y x ==0)) xs) in p [2..]
cnt n = cn primes primes 0 0
 where
 cn ps qs sum c = 
     if sum >= n then cn (tail ps) qs (sum-head ps) (c+if sum==n then 1 else 0)
     else (if n < head qs then c
           else cn ps (tail qs) (sum+head qs) c)

素数の生成はエレガントに書けるけど入出力がうざい.ところで Y コンビネータのラムダ式ってどうだっけ? olymorphic lambda calculus もよくわからん... free theorem の根拠が...

ラムダ式をS,K,Iへコンパイル

自由変数のないラムダ式を S, K, I のコンビネータで記述するためのプログラムを書いてみた.演習の課題で S,K,I 以外のコンビネータを S,K,I で書けという問題があるそうだけどそんなのはプログラムでやるものだし(Bなんか手でやる気がしない).んで,毎度のごとく Haskell でコンパクトに.

data LExp = Lambda (Int, LExp)
          | Apply  (LExp, LExp)
          | Var    Int
          | S
          | K
          | I
ctc (Lambda (x, exp)) = let exp' = ctc exp in (ctc' exp' x)
  where
  ctc' (Apply (exp1, exp2)) x = Apply (Apply (S, ctc' exp1 x), ctc' exp2 x)
  ctc' (Var y) x = if y == x then I else Apply (K, Var y)
  ctc' l x = Apply (K, l)
ctc (Apply (exp1, exp2)) = Apply (ctc exp1, ctc exp2)
ctc x = x

ラムダ式 LExp はλ抽象,適用,変数と,コンビネータ S, K, I で.コンパイル自体はλ抽象を内側からコンビネータに変換していくだけ.変換はアプリケーションに関しては S にして,変数に関しては束縛されるなら I, そうでないなら K.

折角なのでコンビネータからラムダ式への変換(alpha変換, beta簡約)も書いて知ってるコンビネータも全部書いてみた CompileToCombinators.hs .

関数ポインタの判別?

C++ のテンプレートでテンプレート引数に関数ポインタが指定されたときだけ挙動を変えたい.でもやり方が良くわからない... ポインタかどうかの判定法は知ってるが,関数ポインタか否かはどうすれば?

«Prev || 1 | 2 | 3 |...| 45 | 46 | 47 |...| 57 | 58 | 59 || Next»
Search
Feeds

Page Top