Paiza Online Hackason 6 を解いてみようというものでした (最後はコードゴルフ)
第1問 六村リオ
簡単な問題なのですが、浮動小数点の精度のせいで素直に書くとテストケースを通らないことがある、ということのようです(私はそんなことなかった)。気を使うなら有理数で計算して最後に浮動小数点数に変換すればいいと思います。
import Data.Ratio
parse = map read' . map words . tail . lines
where
read' [t,n] = ((read :: String->Int) t, (read:: String->Int) n % 1)
read' _ = (0, 0 % 1)
process (w, c) (1, n) = (w+n, c)
process (w, c) (2, n) = (w, c+n)
process (w, c) (3, n) = (i*w, i*c) where i = (w+c-n)/(w+c)
conc (w, c) = floor $ (100*c) / (w+c)
main = getContents >>= print . conc . foldl process (0 % 1, 0 % 1) . parse
第2問 霧島京子
簡単な再帰の問題。再帰でマスをどんどん進んでいく。各ステップで範囲外にはみ出るケースで"No"を返し、循環してしまうケースについては、既に止まったことのあるマスを記憶しておいてそこに行き当たったら"No"を返すようにするだけ。nマスならn回目までの再帰で必ず同じマスを2度踏むか、範囲をはみ出るか、ゴールするかになる(鳩の巣原理)。動的計画法だのダイクストラだの、こんな問題にそんなもん要りゃしません。
import Data.Array.IArray (Array, (!), bounds, listArray)
import Data.Set (Set, insert, empty, member)
run :: Array Int Int -> Set Int -> Int -> String
run arr memo pos
| pos < min || pos > max = "No"
| member pos memo = "No"
| pos == max = "Yes"
| otherwise = run arr (insert pos memo) (pos + arr!pos)
where (min,max) = bounds arr
main = mapM_ putStrLn . solve . parse =<< getContents
where
parse = construct . map words . lines
construct (n:ts:_:ds) = (read $ head n, map read ts, map (read . head) ds)
solve (n, es, ds) = map (run (listArray (0,n-1) es) empty) ds
敢えて探索アルゴリズムでやるならば、ゴールから幅優先探索風味に逆算します。ゴールの被到達可能地点を順次探索してメモに加えていくだけです。
import Data.Set (Set, member, notMember, insert, empty, singleton)
search :: [(Int,Int)] -> Set Int -> [Int] -> Set Int
search board memo ps -- board: 盤面 memo: 到達可能地点のメモ ps: 最後に探索した到達可能地点
| ps == nps = memo -- 到達可能地点がこれ以上増えないなら探索終了
| otherwise = search board nmemo nps -- 新たなメモと現ステップの探索結果で再帰
where
step board pos = map fst $ filter (\(i,e)->i+e==pos) board -- 地点posへ到達可能な地点の列挙
nps = concatMap (step board) ps -- 前ステップからの探索の結果
nmemo = foldr insert memo nps -- それを到達可能地点のメモに追加
main = mapM_ putStrLn . solve . parse =<< getContents
where
parse = construct . map words . lines
construct (n:ts:_:ds) = (read $ head n ,map read ts, map (read . head) ds)
solve (n, es, ds) = map (isAccessible n $ zip [0..] es) ds
isAccessible n board dice
| dice `member` search board (singleton $ n-1) [n-1] = "Yes"
| otherwise = "No"
第3問 緑川つばめ
……Piazaはなにがしたいの??
main = print . (\n -> n + div n 10 + mod n 10) . read =<< getContents
POH6+ 松江Ruby会議ミッション
これも再帰で書くだけ。辞書順にソートされた単語リストから適切な回文を作る関数build
を考えれば、素直な再帰で書ける。真ん中で綺麗に折半して鏡像に出来る場合と、中央にそれ自体が回文であるような単語が1語挟まる場合とがあるので(この場合には対になる語が残りのリスト中になくかつそれ自体が回文であるような語のうち最も辞書順で最小のもの――これを蓄積引数acc
で管理する――が中央に配置される)、そこを場合分けする。
import Data.List
solve ws = build "" ws
build acc [] = acc
build acc (x:xs)
| reverse x `elem` xs = x ++ next acc ++ reverse x
| x == reverse x && null acc = next x
| otherwise = next acc
where next w = build w $ delete (reverse x) xs
main = putStrLn . solve . sort . tail . lines =<< getContents
再帰の際にリストの後ろに(++)
でappendするのは一般に愚策なのだが、それを避けて
import Data.List
solve = build "" ""
build r c [] = reverse r ++ c ++ r
build r c (w:ws)
| reverse w `elem` ws = build (reverse w++r) c next
| w == reverse w && null c = build r w ws
| otherwise = build r c ws
where next = delete (reverse w) ws
main = putStrLn . solve . sort . tail . lines =<< getContents
と末尾再帰にすると速度は向上するが最初のものに比べてコードゴルフがかなり不利になる。そこで敢えて最初のものの方を採用してゴルフすると:
import Data.List;main=interact$c"".sort.tail.lines;c a[]=a;c a (x:y)|r`elem`y=x++n a++r|x++a==r=n x|1>0= n a where n s=c s$delete r y;r=reverse x
これで145バイトになった(採点結果)。
もし改善案か、より短い別解があれば教えて下さい(テストケースが殆ど機能していないらしく明らかに誤ったコードでも通ってしまうのがアレな感じ)。
でもコードゴルフあんまり楽しくない(小並感)。