カテゴリー: Haskell

同じことをHaskellで。Ordクラスのインスタンスにしたら sortByDic はただの sort ですんだ。

import List

data Point = Pt Float Float deriving (Show, Eq, Ord)

distance :: Point -> Float
distance (Pt x y) = sqrt (x * x + y * y)

sortByDic :: [Point] -> [Point]
sortByDic = sort

sortByDis :: [Point] -> [Point]
sortByDis = List.sortBy (\p1 p2 -> compare (distance p1) (distance p2))

実行結果，辞書順：

*Main> sortByDic [Pt 3.2 1.9, Pt 3.2 0.3, Pt 1.2 3.5]
[Pt 1.2 3.5,Pt 3.2 0.3,Pt 3.2 1.9]

距離の昇順：

*Main> sortByDis [Pt 3.2 1.9, Pt 3.2 0.3, Pt 1.2 3.5]
[Pt 3.2 0.3,Pt 1.2 3.5,Pt 3.2 1.9]

cf. どう書く？.org – アルファベットの繰り上がり

succ でいいじゃん，と思ったらダメだった。

Prelude> succ 'A'
'B'
Prelude> succ 'Z'
'['

Ruby の String#succ はうまくやってくれるのに。

なら，26進数だと考えて素直に繰り上がりを処理すればいいか……と思ったけどこれもダメ。’A’ は 0 じゃない。要するに 0 が無いんだな。結局繰り上がりのところで汚いコードになってしまった。

module Main ( main ) where

import Data.Char ( ord, chr )
import Data.List ( mapAccumR, intersperse )

succS :: [Char] -> Int -> [Char]
succS s n = map intToAlpha $ g $ mapAccumR f n $ map alphaToInt s
  where
    alphaToInt c = (ord c ) - 64
    intToAlpha i = chr (i + 64)
    f acc x = let (d,m) = (acc+x) `divMod` 26
    in if m == 0 then (d-1,26) else (d,m)
    g (0,b) = b
    g (a,b) = a:b

main :: IO ()
main = putStr $ concat $ intersperse "," $ take 100 $ iterate (flip succS 1) "A"

実行：

^o^ >runhaskell succS.hs
A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,AB,AC,AD,AE,AF,AG,AH,AI,A
J,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ,BA,BB,BC,BD,BE,BF,BG,BH,BI,BJ,
BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ,CA,CB,CC,CD,CE,CF,CG,CH,CI,CJ,CK
,CL,CM,CN,CO,CP,CQ,CR,CS,CT,CU,CV

cf. どう書く？.org – 倍数になる13進数

module Main (main) where

fromDecimal :: (Integral a) => a -> a -> a
fromDecimal n x = f 0 x 1
  where
    f r 0 _ = r
    f r y z = f (r + (y `mod` 10) * z) (y `div` 10) (z * n)

main :: IO ()
main = putStr $ show $ head $ filter (\x -> fromDecimal 13 x `mod` x == 0) [10..]

実行。

^o^ >runhaskell multiple13.hs
1557

cf. どう書く？.org – アレイのuniq

再帰で

uniq [] = []
uniq (x:xs) = x:uniq (filter (/=x) xs)

と書いてから，こんな関数ありそうだなぁと思ったらやっぱりあった。

Data.List nub

高階関数版：

uniq2 :: (Eq a) => [a] -> [a]
uniq2 = foldl (\a e -> if (elem e a) then a else a ++ [e]) []

型を明示しないとダメ。

Prelude> :l uniq2.hs
[1 of 1] Compiling Main             ( uniq2.hs, interpreted )

uniq2.hs:2:27:
    Ambiguous type variable `b' in the constraint:
      `Eq b' arising from use of `elem' at uniq2.hs:2:27-34
    Possible cause: the monomorphism restriction applied to the following:
      uniq2 :: [b] -> [b] (bound at uniq2.hs:2:0)
    Probable fix: give these definition(s) an explicit type signature
                  or use -fno-monomorphism-restriction
Failed, modules loaded: none.

どう書く？org – ピラミッドを作る

与えられた高さのピラミッドを作る

module Main where

import System

cjust :: Int -> String -> String
cjust w s | w <= length s = s
          | otherwise = margin ++ s ++ margin
  where
    margin = replicate ((w - (length s)) `div` 2) ' '

pyramid :: [String]
pyramid = map (flip replicate '*') [1,3..]

main :: IO ()
main = do h <- getArgs >>= return.read.head
          putStr $ unlines $ map (cjust (h*2-1)) $ take h pyramid

実行。

^o^ >runhaskell pyramid.hs 4
   *
  ***
 *****
*******
^o^ >runhaskell pyramid.hs 5
    *
   ***
  *****
 *******
*********
^o^ >runhaskell pyramid.hs 6
     *
    ***
   *****
  *******
 *********
***********
^o^ >runhaskell pyramid.hs 1
*
^o^ >runhaskell pyramid.hs 0

お，高さ0でもちゃんと動く。

条件を満たす行を取り除く
　via http://d.hatena.ne.jp/gan2/20070706/1183708048

‘#’で始まる行を取り除く問題。すげーひさしぶりに Haskell で書いてみる。

module Main where

import System

f :: String -> Bool
f (h:tl) | h == '#' = False
          | otherwise = True

main :: IO ()
main = do fileName <- getArgs
          contents <- readFile (head fileName)
          putStr $ unlines $ filter f $ lines contents

実行。

^o^ >type sample.txt
hello!
# remove this
 # don't remove this
bye!
^o^ >runhaskell filterline.hs sample.txt
hello!
 # don't remove this
bye!

ファイルを1行ずつ処理するやり方を忘れててあせった。

追記：id:jmkさんからもらったアドバイスを追記しておこう。ありがとうございます。

f ('#':_) = False
f _ = True

• 元のコードでは空行に対応できてない。
• パターンマッチにはリテラルを使える。

• cf. どうしてプログラマに・・・プログラムが書けないのか?
• via 404 Blog Not Found – ブクマゴルフってどうよ?

なんか昨日からあちこちで見かけるので書いてみた。久しぶりの Haslellで。
あと，増田で剰余は使うな，と言ってるから使わない。

fizz = cycle ["","","Fizz"]
buzz = cycle ["","","","","Buzz"]

f "" n = show n
f s _ = s

main = mapM_ putStrLn $ zipWith f (zipWith (++) fizz buzz) [1..100]

あなごるじゃないから短くするのはやらない。

テキストファイルから入力を受け付ける時にはよく使う。あとはカンマ区切りなんかも。

import Data.Char

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
  where
    (a, b) = break p xs

splitBySpace :: String -> [String]
splitBySpace = splitBy isSpace

*Main> splitBySpace "a b c"
["a","b","c"]
*Main> splitBySpace " a b c "
["","a","b","c"]

正規表現（Text.Regex）を使えばもっとシンプルに書ける。

import Text.Regex

splitBySpace' :: String -> [String]
splitBySpace' = splitRegex (mkRegex " +")

*Main> splitBySpace' "a b c"
["a","b","c"]
*Main> splitBySpace' " a b c "
["","a","b","c",""]

……けど，ちょっと動作が違うな。
ちなみに Ruby の String#split は上の splitBySpace と同じ動作。

D:\>irb --simple-prompt
>> "a b c".split(/ +/)
=> ["a", "b", "c"]
>> " a b c ".split(/ +/)
=> ["", "a", "b", "c"]

cf. 今日の一行 – リストによる正方行列処理

週をまたいでしまった。解答例もでてるけど。

問題３。これも内包表記で。

boxing :: [[a]] -> [[a]]
boxing m = [[m!!x!!y| x <- [0..l1], y <- [0..l1], x`div`l2 == i, y`div`l2 == j] | i <- [0..l3], j <- [0..l3]]
  where
    l1 = length m - 1
    l2 = (floor . sqrt . fromIntegral . length) m
    l3 = l2 -1

行列のサイズから n を求めるとこで型が合わずにはまった（sqrt は (Floating a) => a -> a，必要なのは Int）。結局 floor を使った。