No Such Blog or Diary
ICPC by Haskell
ながながとICPC2005 Regional, Tokyo の問題Fを Haskell で．O(n^2) の DP で, 基本的に foldl の２重ネストと．Cで書いた場合と比べて for 文の代わりに foldl になっているだけの違いしかない...
-- Problem F in ACM/ICPC 2005 ASIA Regional Tokyo
-- 2005/11/04 O(n^2) DP
import Control.Monad
import Debug.Trace
import List
main = getProblems >>= mapM_ (putStrLn.show.solve)
getProblems =
do
[n] <- getNums
if n==0 then return []
else do
xs <- getNums
b <- liftM (head.map read.words) getLine :: IO(Double)
[sr,sv,se,sf] <- liftM words getLine
liftM ((xs, b, read sr, read sv::Double, read se::Double, read sf::Double):) getProblems
where
getNums = liftM (map read.words) getLine :: IO([Int])
solve :: ([Int], Double, Int, Double, Double, Double) -> Double
solve (ys,b,r,v,e,f) = sl ys [(0.0,0)]
where
-- xs:rest of checkpoints, cs:best cost for already passed checkpoints
sl [] cs = fst $ head cs
sl (x:xs) cs = sl xs (best x cs:cs)
-- (best cost, current cost, current point)
best x cs = (\(bc,c,p) -> (min bc (c + cost (x-p) x),x)) $ foldl op (100000000, 0, x) cs
where
op (cbc, c, p) (bc, pos) = let
c' = c + cost (x-p) (x-pos)
in (min cbc (c'+b+bc), c', pos)
cost p q = ct p 0.0
where
ct p c = if p == q then c
else ct (p+1) (c+step p)
step p = if p < r then 1.0 / (v-f*fromIntegral(r-p))
else 1.0 / (v-e*fromIntegral(p-r))
- Comments: 0
- TrackBack (Close): -
ICPC by Haskell
なぜか D を飛ばしてICPC2005 Regional, Tokyo の問題Eを Haskell で．全生成して条件で filter して max とるという非常に美しい形に...
-- Problem E in ACM/ICPC 2005 ASIA Regional Tokyo
-- 2005/11/04 Brute Force (42 * 2^5)
import Control.Monad
import Debug.Trace
import List
main = getProblems >>= mapM_ (putStrLn.(\r -> if r < 0 then "-1" else show r).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)
solve :: (Double, [Double])->Double
solve (r, ws) = foldl max (-1.0).filter (<r).map(\(lw, rw)->lw+rw).concat.map genWidth.concat.map genTree.perm $ ws
data BTree a = Node a (BTree a) (BTree a)
| Leaf a
genTree ] = [Leaf
genTree xs = [ Node (weight t + weight u) t u | i <- [1..length xs-1], t<-genTree (take i xs), u<-genTree (drop i xs)]
weight (Leaf x) = x
weight (Node x _ _) = x
genWidth (Leaf x) = [(0.0,0.0)]
genWidth (Node _ l r) = let
ls = genWidth l
rs = genWidth r
lw = weight l
rw = weight r
la = lw/(lw + rw)
ra = 1-la
in [x | (ll,lr)<-ls, (rl,rr)<-rs, x<-gen ll lr rl rr la ra]
gen ll lr rl rr la ra = dupFlip (max (la + ll) (rl-ra), max (ra + rr) (lr-la))
dupFlip (x,y) = [(x,y), (y,x)]
perm [] = []
perm ] = [[]
perm (x:xs) = [ take i y ++ (x:drop i y) | y <- perm xs, i <- [1..length xs]]
- Comments: 0
- TrackBack (Close): -
ICPC by Haskell
引き続きICPC2005 Regional, Tokyo の問題Cを Haskell で．サイコロの全パタン生成が一番面倒かも．全盛生後の比較の高速化のために色名を数字に置き換える部分は少々手抜きかも．
-- Problem C in ACM/ICPC 2005 ASIA Regional Tokyo
-- 2005/11/04 Brute Force (24^3)
import Control.Monad
import Debug.Trace
import List
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
solve::[[String]]->Int
solve [d] = 0
solve ds = let
tab = zip (nub.sort.concat $ ds) [1..]
rep x = case (lookup x tab) of Just i -> i
ds' = map (map rep) ds
in foldl1 min.map cost.map (head ds':).prod.map genAll.tail $ ds'
cost = sum . map cost'. trans
cost' xs = length xs - longest (sort xs)
longest (h:ts) = foldl1 max.map snd $ scanl (\(x, c) y -> if y == x then (x, c+1) else (y, 1)) (h,1) ts
trans s] = map (\x -> [) xs
trans (xs:xss) = zipWith (:) xs $ trans xss
prod s] = map (\x->[) xs
prod (xs:xss) = concat.map (\x -> map (x:) (prod xss)) $ xs
-- generate all dice equivalent to the die by rotation
genAll = concat . map rots2 . rots1
-- rotations around an axis (the front surface is fixed)
rots2 [x1,x2,x3,x4,x5,x6] = [[x1,x2,x3,x4,x5,x6],
[x1,x3,x5,x2,x4,x6],
[x1,x5,x4,x3,x2,x6],
[x1,x4,x2,x5,x3,x6]]
-- rotations to move each surface to the front
rots1 [x1,x2,x3,x4,x5,x6] = [[x1,x2,x3,x4,x5,x6],
[x2,x6,x3,x4,x1,x5],
[x3,x2,x6,x1,x5,x4],
[x4,x2,x1,x6,x5,x3],
[x5,x1,x3,x4,x6,x2],
[x6,x5,x3,x4,x2,x1]]
- Comments: 0
- TrackBack (Close): -
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 以外に意味のあるのがあるか？
- Comments: 0
- TrackBack (Close): -
ICPC by Haskell
ICPC2005 Regional, Tokyo の問題Ｂを 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')
- Comments: 0
- TrackBack (Close): -
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 の型を明示しとかないとこける可能性があることだろう．
- Comments: 0
- TrackBack (Close): -