変な処理があれば修正してください。

ループ1†

問題文

times 0 action = return ()
times n action = action >> times (n-1) action

main = do
    5 `times` putStrLn "Hello World!"

別解

main = putStr $ "おっぱい！" >> "Hello World!\n"
↑

ループ2†

問題文

import System.Environment

times 0 action = return ()
times n action = action >> times (n-1) action

main = do
    x <- getArgs
    (read (x !! 0)) `times` putStrLn "Hello World!"

回数も表示

import System.Environment
import Control.Monad
 
main :: IO ()
main = fmap (read . head) getArgs >>= \n -> forM_ [1..n] $ putStrLn . ("Hello World! "++) . show
↑

FizzBuzz†

問題文

main = do
    mapM_ putStrLn (map fizzBuzz [1..100])

fizzBuzz :: Integer -> String
fizzBuzz n
    | n `mod` 15 == 0 = "FizzBuzz"
    | n `mod`  5 == 0 = "Buzz"
    | n `mod`  3 == 0 = "Fizz"
    | otherwise       = show n
↑

素数列挙†

問題文

primesTo m = 2 : sieve [3, 5..m] where
    sieve [] = []
    sieve (p:xs) = p : sieve (xs `minus` [p*p, p*p+2*p..m])

minus (x:xs) (y:ys) = case (compare x y) of
    LT -> x : minus xs (y:ys)
    EQ ->     minus xs ys
    GT ->     minus (x:xs) ys
minus xs _ = xs

main = do
    print $ primesTo (floor 1e6)
↑

うるう年判定†

問題文

isleap :: Integer -> Bool
isleap y
    | y `mod` 400 == 0 = True
    | y `mod` 100 == 0 = False
    | y `mod`   4 == 0 = True
    | otherwise        = False

main = do
    putStrLn "西暦を入力してください"
    x <- getLine
    putStrLn (x ++ "年はうるう年" ++ if isleap(read(x)) then "です" else "ではありません" )
↑

フィボナッチ数列†

問題文

import System.Environment

fibo = 0 : 1 : zipWith (+) fibo (tail fibo)

main = do
    x <- getArgs
    putStrLn (show (fibo !! read (x !! 0)))
↑

累乗1†

問題文

pow :: Integer -> Integer -> Integer
pow _ 0 = 1
pow 0 _ = 0
pow a b = a * pow a (b-1)

main = do
    putStrLn (show (pow 2 10))
↑

累乗2†

問題文

pow :: Integer -> Integer -> Integer
pow 0 _ = 0
pow _ 0 = 1
pow a b = pow' 1 a b
    where
    pow' x a 0 = x
    pow' x a b
        | even b = pow' x (a*a) (div b 2)
        | otherwise = pow' (x*a) a (b-1)

main = do
    putStrLn (show (pow 2 1000007))
↑

クイックソート†

問題文

quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) =
    let smallerSorted = quicksort[a | a<-xs, a <= x]
        biggerSorted  = quicksort[a | a<-xs, a >  x]
     in smallerSorted ++ [x] ++ biggerSorted

main :: IO()
main = print $ quicksort [5, 7, 9, 2, 1, 3, 8, 4, 6, 0]
↑

世界のナベアツ問題†

問題文

nabeatsu :: Integer -> String
nabeatsu x = if mod x 3 == 0 || elem '3' s then "Aho" else s where s = show x

main :: IO ()
main = putStrLn . unwords $ map nabeatsu [1..100]
↑

Caesar暗号解読†

問題文

import Data.List (isInfixOf)
 
next :: String -> Char -> Char
next (x:xs) = \c -> if x == c then head xs else next xs c
next _ = id
 
analyze :: String -> String
analyze = head . filter (isInfixOf keyword) . iterate (map $ next chars)
    where chars   = "-abcdefghijklmnopqrstuvwxyz .,-"
          keyword = "person"
 
main :: IO ()
main =  putStrLn $ analyze encoded
    where encoded = "qdq-gi.q-a ziatmxxitmdqibtqi-ustbi ri.qmoqrcxi.qbubu zir -ibtq\
                    \i-qp-qaai ripmymsqkir -ibtqi-qy dmxi ri.cnxuoi rruoumxakir -ib\
                    \tqiqzmobyqzbkii-q.qmxi -imyqzpyqzbi rixmeaki -puzmzoqai -i-qsc\
                    \xmbu zaimzpir -i btq-iymbbq-a;iz -iatmxximzgi.q-a zinqiuzimzgi\
                    \emgipuao-uyuzmbqpimsmuzabir -ia. za -uzsiacotiimi.qbubu zj"
↑

数当てゲーム†

問題文

import System.IO
import System.Random
import Control.Monad
 
game :: Int -> IO ()
game x = do
    us <- getLine
    case reads us of
        [(u, _)] -> when (x /= u) $ do
            putStrLn . ("too "++) . (++"!") $ if x < u then "big" else "small"
            game x
        _ -> putStrLn "invalid input!" >> game x
 
main :: IO ()
main = do hSetBuffering stdout NoBuffering
          putStrLn "input a number!"
          getStdGen >>= game . fst . randomR (1,100)
          putStrLn "right!"
↑

配列いじり†

問題文

tailZero :: (Num a) => [a] -> [a]
tailZero = zipWith (*) (1 : repeat 0)
 
main :: IO ()
main = print $ tailZero [3,5,2,4,2]
↑

シェルピンスキーのギャスケット†

問題文

import Control.Applicative
 
pascal :: [[Integer]]
pascal = [1] : map (zipWith (+) <$> ([0] ++) <*> (++ [0])) pascal
 
sierpinski :: Int -> String
sierpinski = unlines . map (map draw) . flip take pascal
    where draw x = if odd x then '*' else ' '
 
main :: IO ()
main = putStr $ sierpinski 32
↑

カレンダー出力†

問題文

import System.Environment
 
ff :: Int -> Int -> Int
ff y m
    | m < 3 = ff (y-1) (m+12)
    | otherwise = 365*y + (y`div`4) - (y`div`100) + (y`div`400) + ((306*(m+1))`div`10) - 428 + 1
 
calendar :: Int -> Int -> String
calendar y m
    | y < 1 || m < 1 || 12 < m = error "calendar"
    | otherwise = unlines . ("Su Mo Tu We Th Fr Sa":) . split7 $ map toStr calList
    where calList   = [1 - (ff y m) `mod` 7 .. ff y (m+1) - ff y m]
          toStr x   = if 0 < x  then sp x $ show x else "  "
          sp x      = if x < 10 then (' ':) else id
          split7 [] = []
          split7 xs = let (as, bs) = splitAt 7 xs in unwords as : split7 bs
 
main :: IO ()
main = fmap (map read) getArgs >>= \[y,m] -> putStr $ calendar y m
↑

ハノイの塔†

問題文

import System.Environment
 
hanoi :: Integer -> a -> a -> a -> [(a, a)]
hanoi 0 _ _ _ = []
hanoi n a b c = hanoi (n-1) a c b ++ [(a,b)] ++ hanoi (n-1) c b a
 
main :: IO ()
main = do
    [x] <- fmap (map read) getArgs
    let f = \(i,(a,b)) -> putStrLn $ show i ++ ": " ++ a ++ "->" ++ b
    mapM_ f . zip [1..] $ hanoi x "A" "B" "C"
↑

転置行列†

問題文

import Data.List (transpose)
↑

英単語しりとりプログラム†

問題文

import System.IO
import System.Random
import Control.Monad
import qualified Data.Set as S
import qualified Data.Map as M
 
type User    = Bool
type Initial = Char
type Dict    = S.Set String
type Used    = M.Map String (Int, User)
 
game :: User -> Initial -> Dict -> Used -> IO ()
game user c dic used = do
    word <- if user then userInput c dic else randomSelect c dic used
    case word of
        [] -> putStrLn $ winMsg usedSize
        _  -> case M.lookup word used of
            Just (n, u) -> putStrLn $ loseMsg n u usedSize
            Nothing     -> game (not user) (last word) dic $ M.insert word (usedSize + 1, user) used
    where usedSize = M.size used
          winMsg n = "S: まいりました！あなたの勝ちです。今回のしりとりでは "
                     ++ show n ++ " 個の単語を使用しました。"
          loseMsg n u m = "S: その言葉は " ++ show n ++ " 回目に "
                          ++ (if u then "あなた" else "わたし") ++ " が使用しています。わたしの勝ちです。\
                          \今回のしりとりでは " ++ show m ++ " 個の単語を使用しました。"
 
userInput :: Initial -> Dict -> IO String
userInput c dic = do
    putStr "U: "
    s <- getLine
    if not (null s) && head s /= c
        then putStrLn ("S: " ++ [c] ++ "から初めてください") >> userInput c dic
        else if S.member s dic
                 then return s
                 else putStrLn "S: 辞書に存在しない単語です。" >> userInput c dic
 
randomSelect :: Initial -> Dict -> Used -> IO String
randomSelect c dic used = do
    gen <- getStdGen
    newStdGen
    let sub  = S.filter (\x -> head x == c && M.notMember x used) dic
        idx  = fst $ randomR (0, S.size sub - 1) gen
        word = if S.null sub then [] else S.toList sub !! idx
    when (word /= []) . putStrLn $ "S: " ++ word
    return word
 
start :: IO ()
start = do
    gen <- getStdGen
    content <- readFile "word.dic"
    let user = fst $ random gen
        inic = fst $ randomR ('a','z') gen
        dic  = S.fromList $ lines content
    when user . putStrLn $ "S: " ++ [inic] ++ "から初めてください"
    game user inic dic M.empty
 
main :: IO ()
main = hSetBuffering stdout NoBuffering >> hSetEncoding stdout utf8 >> start
トップ   新規 一覧 検索 最終更新   ヘルプ   最終更新のRSS