面白そうな問題
関数プログラミングの気分（『多段階選抜』問題を題材にして）
多段階選抜 2014.8.2 問題
第24回オフラインリアルタイムどう書くの問題
stack を導入したので、久しぶりにHaskellで解いてみる。
分析
全ての正の整数に先頭記号の操作を適用して、結果を次の記号の操作の入力にする。
これを末尾まで続けて、先頭１０個を取り出して文字列化、コンマを挿入すれば終了。
直前の結果にリスト末尾まで操作を適用し続けるのは foldl で表現できる。
最後のデータ加工処理は take, show, intercalate を並べるだけでよい。
「平方数、立方数を判断して前か後ろの要素を撤去する」のは、
元のリストの先頭１個を追加、削除したリストと zip すれば単純になる。
加工リストの要素が平方数、立方数なら、元リストの同位置の要素を drop する。
「２〜９の倍数番目を撤去する」「先頭１００個を撤去する」も同様に
インデクスと zip すれば、述語が違うだけで操作を統一できる。
インデクスが記号の倍数、１０１未満なら、元リストの同位置の要素を drop する。
実装
src/O24.hs
module O24 (o24) where
import Data.List (intercalate)
o24 :: String -> String
o24 = intercalate "," . map show . take 10 . foldl (flip symToProc) [1..]
symToProc :: Char -> [Int] -> [Int]
symToProc c ns
| c >= '2' && c <= '9' = dropWhen (indexOf ns) (`isMultipleOf` read [c]) ns
| c == 's' = dropWhen (successorOf ns) (`isPowerOf` 2) ns
| c == 'S' = dropWhen (predecessorOf ns) (`isPowerOf` 2) ns
| c == 'c' = dropWhen (successorOf ns) (`isPowerOf` 3) ns
| c == 'C' = dropWhen (predecessorOf ns) (`isPowerOf` 3) ns
| c == 'h' = dropWhen (indexOf ns) (`isLessThan` 101) ns
dropWhen :: [Int] -> (Int -> Bool) -> [Int] -> [Int]
dropWhen xs pred ns = map snd $ filter (not . pred . fst) $ zip xs ns
indexOf :: [Int] -> [Int]
indexOf _ = [1..]
successorOf :: [Int] -> [Int]
successorOf = drop 1
predecessorOf :: [Int] -> [Int]
predecessorOf = (2 :)
isLessThan :: Int -> Int -> Bool
isLessThan n m = n < m
isMultipleOf :: Int -> Int -> Bool
isMultipleOf n d = n `mod` d == 0
isPowerOf :: Int -> Int -> Bool
isPowerOf n p = round (fromIntegral n ** (1/fromIntegral p)) ^ p == n
test/Spec.hs
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
test/O24Spec.hs
module O24Spec (spec) where
import Test.Hspec
import O24
spec :: Spec
spec = do
describe "o24" $ do
it "0" $ o24 "ss6cc24S" `shouldBe` "1,9,21,30,33,37,42,44,49,56"
it "1" $ o24 "h" `shouldBe` "101,102,103,104,105,106,107,108,109,110"
it "2" $ o24 "hh" `shouldBe` "201,202,203,204,205,206,207,208,209,210"
it "3" $ o24 "hhh" `shouldBe` "301,302,303,304,305,306,307,308,309,310"
it "4" $ o24 "2" `shouldBe` "1,3,5,7,9,11,13,15,17,19"
it "5" $ o24 "22" `shouldBe` "1,5,9,13,17,21,25,29,33,37"
it "6" $ o24 "222" `shouldBe` "1,9,17,25,33,41,49,57,65,73"
it "7" $ o24 "3" `shouldBe` "1,2,4,5,7,8,10,11,13,14"
it "8" $ o24 "33" `shouldBe` "1,2,5,7,10,11,14,16,19,20"
it "9" $ o24 "333" `shouldBe` "1,2,7,10,14,16,20,23,28,29"
it "10" $ o24 "s" `shouldBe` "1,2,4,5,6,7,9,10,11,12"
it "11" $ o24 "ss" `shouldBe` "1,4,5,6,9,10,11,12,13,16"
it "12" $ o24 "sss" `shouldBe` "4,5,9,10,11,12,16,17,18,19"
it "13" $ o24 "S" `shouldBe` "1,3,4,6,7,8,9,11,12,13"
it "14" $ o24 "SS" `shouldBe` "1,4,7,8,9,12,13,14,15,16"
it "15" $ o24 "SSS" `shouldBe` "1,8,9,13,14,15,16,20,21,22"
it "16" $ o24 "c" `shouldBe` "1,2,3,4,5,6,8,9,10,11"
it "17" $ o24 "cc" `shouldBe` "1,2,3,4,5,8,9,10,11,12"
it "18" $ o24 "ccc" `shouldBe` "1,2,3,4,8,9,10,11,12,13"
it "19" $ o24 "C" `shouldBe` "1,3,4,5,6,7,8,10,11,12"
it "20" $ o24 "CC" `shouldBe` "1,4,5,6,7,8,11,12,13,14"
it "21" $ o24 "CCC" `shouldBe` "1,5,6,7,8,12,13,14,15,16"
it "22" $ o24 "23" `shouldBe` "1,3,7,9,13,15,19,21,25,27"
it "23" $ o24 "32" `shouldBe` "1,4,7,10,13,16,19,22,25,28"
it "24" $ o24 "2h" `shouldBe` "201,203,205,207,209,211,213,215,217,219"
it "25" $ o24 "h2" `shouldBe` "101,103,105,107,109,111,113,115,117,119"
it "26" $ o24 "sC" `shouldBe` "1,4,5,6,7,9,10,11,12,13"
it "27" $ o24 "Cs" `shouldBe` "1,4,5,6,7,8,10,11,12,13"
it "28" $ o24 "s468" `shouldBe` "1,2,4,6,7,11,12,16,17,20"
it "29" $ o24 "S468" `shouldBe` "1,3,4,7,8,12,13,16,18,21"
it "30" $ o24 "cc579" `shouldBe` "1,2,3,4,8,9,11,13,15,16"
it "31" $ o24 "CC579" `shouldBe` "1,4,5,6,8,11,13,15,17,18"
it "32" $ o24 "85" `shouldBe` "1,2,3,4,6,7,9,10,12,13"
it "33" $ o24 "sh" `shouldBe` "110,111,112,113,114,115,116,117,118,119"
it "34" $ o24 "94h" `shouldBe` "150,151,154,155,156,158,159,160,163,164"
it "35" $ o24 "h9c8" `shouldBe` "101,102,103,104,105,106,107,110,111,112"
it "36" $ o24 "Cc3s" `shouldBe` "1,3,5,6,10,11,13,16,17,19"
it "37" $ o24 "cs4h6" `shouldBe` "149,150,152,153,154,157,158,160,161,162"
it "38" $ o24 "84523c" `shouldBe` "1,3,11,15,23,26,34,38,46,49"
it "39" $ o24 "54C78hS" `shouldBe` "228,231,232,233,236,241,242,243,246,247"
it "40" $ o24 "65h7ccs" `shouldBe` "151,152,153,154,157,158,160,163,164,165"
it "41" $ o24 "c95hSc2C" `shouldBe` "145,147,151,153,156,159,162,164,168,171"
it "42" $ o24 "c5h3Ss794" `shouldBe` "130,131,133,137,138,142,148,150,152,157"
it "43" $ o24 "7ShscC846" `shouldBe` "129,130,131,134,135,139,141,142,146,148"
it "44" $ o24 "cshSCCS7ch" `shouldBe` "253,254,256,259,260,261,263,264,265,266"
it "45" $ o24 "hhC7849Ss6C" `shouldBe` "201,202,203,205,206,211,212,216,220,225"
it "46" $ o24 "hhsc3C987Ccs" `shouldBe` "201,202,204,205,207,208,214,217,218,220"
it "47" $ o24 "SC7S8hc59ss2" `shouldBe` "162,169,174,178,182,185,188,194,199,203"
it "48" $ o24 "s7S6c35C9CShc" `shouldBe` "367,371,377,379,380,385,387,388,392,395"
it "49" $ o24 "4scC3hh982Cc5s" `shouldBe` "422,426,430,434,447,451,459,463,471,479"
it "50" $ o24 "23h465Ssc9CchC" `shouldBe` "1027,1033,1045,1047,1057,1069,1071,1075,1081,1093"