09

03

[Haskell] クロッシング問題を解きました

2013.09.03(20:35)

結城浩 @hyuki さんのツイートで知った
クロッシング問題
http://www.hyuki.com/codeiq/#c12
を解いてCodeIQへ投稿しました。アルゴリズムを改良してゆくステップが楽しめました。時間制限も絶妙でした。今日、 @hyuki さんから採点が届き、正解だったので、私の解答を公開します。

Haskellで、マージソートを使った、O(n log n)のアルゴリズムを書きました。
私の環境ではIntでは桁が足りず、Integerで数えました。

私のノートブックで
ghciで
(21.36 secs, 4447749184 bytes)
ghc -O2 -o crossing.exe crossing.hs
crossing.exe
24689222839
2.9671697s
という速度になりました。

24689222839,2
ENV: Haskell

-- | CodeIQの問題に挑戦しよう! 結城浩
-- | http://www.hyuki.com/codeiq/
-- | 問題12. Crossing(クロッシング)
-- | http://www.hyuki.com/codeiq/#c12

{-# OPTIONS -Wall -Werror #-}

import Data.Time
{--------------------------------------------------
import Test.HUnit
c2 :: Integer->Integer
c2 n = (n*(n-1)) `div` 2

-- | ユニットテスト
myTests :: Test
myTests = test [
  cross [2,1] ~?= 1,
  cross [3,2,1] ~?= (2+1),
  cross [2,1,3] ~?= 1,
  cross [3,1,2] ~?= 2,
  cross [4,3,2,1] ~?= (3+2+1),
  cross [2,1,3,5,4] ~?= 2,
  cross [3,1,4,5,9,2,6,8,7] ~?= 9,

  cross [1..100] ~?= 0,
  cross ([51..100]++[1..50]) ~?= (50*50),
  cross (reverse [1..100]) ~?= (c2 100),
  cross (101:[1..100]) ~?= 100,
  cross (reverse [1..1000]) ~?= (c2 1000),
  cross (10001:[1..10000]) ~?= 10000,
  -- cross (100001:[1..100000]) ~?= 100000,
  True ~?= True] 

--------------------------------------------}

-- | 1つのリストを中央値より大きい値と中央値以下の値に分け、
-- | あわせてクロスした回数を数えて返す
cross3 :: Int->Int->[Int]->([Int],[Int],Integer,Integer)
cross3 _ _ [] = ([],[],0,0)
cross3 from to (x:xs) = 
  if (mid < x) then (    smaller,(x:larger),(len+1),result)
               else ((x:smaller),larger,    len,    (result+len))
  where mid = (from + to) `div` 2
        (smaller,larger,len,result) = cross3 from to xs

-- | 再帰のたびに(from == to)をやらないでいいように関数を分ける。
cross2 :: Int->Int->[Int]->([Int],[Int],Integer)
cross2 from to xs = if (from == to) then ([],[],0)
                                    else (s,l,r) 
                                         where (s,l,_,r) = cross3 from to xs

-- | 1つのリストを前半分と後ろ半分に分け、クロスした回数に、左の再帰分と右の再帰分を足す。
cross1 :: Int->Int->[Int]->Integer
cross1 _ _ [] = 0
cross1 from to xs = (r1+r2+r3)
                     where (smaller,larger,r1) = cross2 from to xs
                           r2 = cross1 from ((from+to)`div`2) smaller
                           r3 = cross1 (((from+to)`div`2)+1) to larger

-- | 前準備。問題より値の範囲は1から(length xs)まで。
cross :: [Int]->Integer
cross [] = 0
cross xs = cross1 1 (length xs) $ reverse xs

-- | メイン
main :: IO ()
main = do
  -- _ <- runTestTT myTests
  x <- getCurrentTime
  -- | 時間計測ここから ---------------------------------
  let fileName = "crossing.txt"
  -- let fileName = "sample.txt"
  contents <- readFile fileName
  let nums = map (\s -> read s :: Int) $ lines contents
  print $ cross nums
  -- | 時間計測ここまで ---------------------------------
  y <- getCurrentTime
  print $ diffUTCTime y x
  return ()
 

07

24

[Haskell] 頻出関数

2013.07.24(21:51)

[Haskell] 頻出関数
このソースを読むとリスト処理などの勘が取り戻せる。
{-# OPTIONS -Wall -Werror #-}
-- | idiom.hs 頻出関数
module Idiom where
import Test.HUnit
import Test.QuickCheck
--import Data.List (isPrefixOf,isInfixOf,isSuffixOf,group)
import Data.List --(isPrefixOf,isInfixOf,isSuffixOf,group)
import Data.Char (isSpace,toUpper)
-----------------------------------------------------------
-- | 可逆圧縮
encode :: Eq a => [a]->[(Int,a)]
encode = map (\xs -> (length xs,head xs)) . group

decode :: Eq a => [(Int,a)]->[a]
decode = concatMap $ uncurry replicate
-----------------------------------------------------------
-- | ユニットテスト
idiomTest :: Test
idiomTest = test [
    -- | enumFromTo :: Enum a => a -> a -> [a]
    enumFromTo (2::Int) 4  ~=?  [2..4],
    -- | concatMap :: (a -> [b]) -> [a] -> [b]
    concatMap (enumFromTo 1) ([1,3,5]::[Int])  ~=? [1,1,2,3,1,2,3,4,5],
    concatMap (\x -> [(x,x+2,x/2)]) ([1,3,5]::[Float])  ~=? [(1.0,3.0,0.5),(3.0,5.0,1.5),(5.0,7.0,2.5)],
    -- | replicate :: Int->a->[a]  -- n回aを繰り返したリストを返す
    replicate 3 'a'  ~=? "aaa",
    -- | iterate::(a->a)->a->[a]   -- 初期値に関数を繰り返し適用したリストを返す
    (take 10 $ iterate (*2) 1) ~=? ([1,2,4,8,16,32,64,128,256,512]::[Int]),
    -- | fromInteger :: Num a => Integer -> a  -- IntegerとIntに
    ((fromInteger 10)::Int) ~=? (10::Int),
    foldr (+) 0 ([1,2,3]::[Int]) ~=? 6,
    -- | break :: (a -> Bool) -> [a] -> ([a], [a])
    -- | 初めてTrueになるまでと、なった後を分けてタプルで返す
    break (>3) ([1,2,3,4,1,2,3,4]::[Int]) ~=? ([1,2,3],[4,1,2,3,4]),
    takeWhile (< 3) ([1,2,3,4,1,2,3,4]::[Int]) ~=? [1,2],
    dropWhile (< 3) ([1,2,3,4,1,2,3,4]::[Int]) ~=? [3,4,1,2,3,4],
    span (< 3) ([1,2,3,4,1,2,3,4]::[Int]) ~=? ([1,2],[3,4,1,2,3,4]),
    -- | splitAt :: Int -> [a] -> ([a], [a])
    splitAt 3 "abcdef" ~=?  ("abc","def"),
    splitAt 2 "abcde" ~=?  ("ab","cde"),

    -- | filter :: (a -> Bool) -> [a] -> [a]
    filter (\x -> x `mod` 3 == 0) ([1..10]::[Int]) ~=? [3,6,9],
    -- | partition :: (a -> Bool) -> [a] -> ([a], [a])
    partition (\x -> x `mod` 3 == 0) ([1..10]::[Int]) ~=? ([3,6,9],[1,2,4,5,7,8,10]),
    -- | group :: Eq a => [a] -> [[a]]
    group "Mississippi" ~=? ["M","i","ss","i","ss","i","pp","i"],
      
    -- | (!!) :: [a] -> Int -> a -- リストのn番目
    "abc" !! 2 ~=? 'c',
    -- | elem :: Eq a => a -> [a] -> Bool -- 要素がリストに含まれるときTrue
    elem (3::Int) ([1,2,3]::[Int]) ~=? True,
    -- | concat :: [[a]] -> [a] -- リストのリストをリストに均す
    concat ["abc","def"] ~=? "abcdef",
    -- | zip :: [a] -> [b] -> [(a, b)]  -- 2つのリストを貼り合わせてタプルのリストに
    zip ([0..]::[Int]) "abc" ~=? [(0,'a'),(1,'b'),(2,'c')],
    -- | unzip :: [(a, b)] -> ([a], [b]) -- 
    unzip ([(0,'a'),(1,'b'),(2,'c')]::[(Int,Char)]) ~=? ([0,1,2],"abc"),
    -- | zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (+) ([1,2,3]::[Int]) ([4,5,6]::[Int]) ~=? [5,7,9],
    -- | fst :: (a, b) -> a
    fst (1::Int,2::Int)  ~=? 1,
    snd (1::Int,2::Int)  ~=? 2,
    -- | curry :: ((a, b) -> c) -> a -> b -> c
    curry fst (1::Int) (2::Int)  ~=? 1,
    -- | uncurry :: (a -> b -> c) -> (a, b) -> c
    uncurry (+) ((1,2)::(Int,Int))  ~=? 3,
    uncurry (++) ("abc","def")  ~=? "abcdef",
    -- | Data.List ---------------------------------------------------------------
    -- | リストの先頭にリストが現れるときTrue
    isPrefixOf "ab" "abc" ~=? True,
    -- | リストの途中にリストが現れるときTrue
    -- | isInfixOf :: Eq a => [a] -> [a] -> Bool
    isInfixOf "bc" "abcde" ~=? True,
    -- | リストの最後にリストが現れるときTrue
    isSuffixOf "de" "abcde" ~=? True,
    -- | Data.Char ---------------------------------------------------------------
    dropWhile isSpace "\t\r\n\f  abc" ~=? "abc",
    True ~=? True
  ]


convertTest :: Test
convertTest = test [
    -- | Stringを何かに変換する
    (read "5"::Int) ~=? 5,
    (read "5"::Float) ~=? 5.0,
    (read "[1,2,3]"::[Int]) ~=? [1,2,3],
    (read "(1,'a')"::(Int,Char)) ~=? (1,'a'),
    words " a b c "  ~=? ["a","b","c"],
    -- | [String]を何かに変換する
    unwords ["a","b","c"]  ~=? "a b c",
    map (map toUpper) ["abc","def"] ~=? ["ABC","DEF"],
    map (read::String->Int) ["123","456"]  ~=? [123,456],
    -- | Intを何かに変換する
    show (123::Int) ~=? "123",
    -- | fromInteger :: Num a => Integer -> a
    ((fromInteger 123)::Float) ~=? (123.0::Float),
    -- | fromIntegral :: (Integral a, Num b) => a -> b
    -- | [Int]を何かに変換する
    ((map fromInteger [1,2,3]::[Int])::[Int]) ~=? [1,2,3],
    ((map fromInteger [1,2,3]::[Float])::[Float]) ~=? [1.0,2.0,3.0],
    ((map show [(1::Int),2,3])::[String]) ~=? ["1","2","3"],
    True ~=? True
  ]

encodeDecodeTest :: Test
encodeDecodeTest = test [
    [] ~?= encode "",
    [(1,'a')] ~?= encode "a",
    [(1,'M'),(1,'i'),(2,'s'),(1,'i'),(2,'s'),(1,'i'),(2,'p'),(1,'i')] ~?= encode "Mississippi",
    "Mississippi" ~?= decode [(1,'M'),(1,'i'),(2,'s'),(1,'i'),(2,'s'),(1,'i'),(2,'p'),(1,'i')],
    True ~=? True
  ]

-- | encode decode test
prop_encodeDecode :: Eq a => [a] -> Bool
prop_encodeDecode xs = (decode $ encode xs) == xs

---------------------------------------------------
main :: IO ()
main = do
    _ <- runTestTT idiomTest
    _ <- runTestTT convertTest
    _ <- runTestTT encodeDecodeTest
    quickCheck (prop_encodeDecode :: [Int] -> Bool)
    quickCheck (prop_encodeDecode :: [Bool] -> Bool)
    quickCheck (prop_encodeDecode :: [Char] -> Bool)
    putStrLn "done"

07

18

[Haskell] Stateモナドの定義のうち、バインド(>>=)の定義がわかりにくい

2013.07.18(23:37)

Stateモナドの定義のうち、バインド(>>=)の定義がわかりにくい

-- newtypeは既存の型を別の型にくるむもの。
-- State型の中にいれたものはs -> (a,s)型の関数。
-- その関数をStateモナドに適用して評価した値を求めるのがrunState。

newtype State s a = State { runState :: s -> (a, s) }

-- State s型をMonad型クラスのインスタンスにする。
instance Monad (State s) where

-- returnはState型の中に最低限の関数として ¥s -> (x, s) をいれたもの。
-- return :: a -> State s a
return x = State $ ¥s -> (x, s)

-- (>>=) :: State s a -> (a -> State s b) -> State s b
State h >>= f = State $ ¥s -> let (a, newState) = h s
                    State g = f a
                  in g newState ★

get :: State a a
get = State (¥s -> (s, s))
put :: a -> State a ()
put s = State (¥_ -> ((), s))

-- の★の部分が何をやっているのかよくわからない。ちょっと変形してみる。
-- State hの中に入っている関数hに今の状態sを適用するとは、
-- runState (State h) s していることと同じである。
-- runStateすると、(値,新しい状態) として、(a,s')が返ってくる。 
-- 2段階目、fは、(a -> State s b)型の関数なので
-- f aを求めるとState s b型になり、それに状態s'を適用するのは
-- やはりrunStateしていることと同じで、runState (f a) s'と書ける。
-- runStateすると、(値,新しい状態) として、(a',s'')が返ってくる。
 
-- (>>=) :: State s a -> (a -> State s b) -> State s b
State h >>= f = State $ ¥s -> let
                   (a,s') = runState (State h) s
                   (a',s'') = runState (f a) s'
                  in (a',s'')
ここでState hをmと書くと
m >>= f = State $ ¥s -> let (a,s') = runState m s
                (a',s'') = runState (f a) s'
              in (a',s'')

つまり
m >>= f = State $ ¥s -> let (a,s') = runState m s
              in runState (f a) s'

こう書くとわかりやすい。これはバインド(>>=)の定義。

07

18

[Haskell] モナドとしての関数

2013.07.18(22:54)

モナドとしての関数

モナドは(m a)型であり、(a->m b)型の関数とバインドすれば、
(m b)型となって、最初と同じ文脈のモナドになる。
モナドには(m a)でできているものもあれば、
(m a)>>=(a->m b)でできているものもあれば、
(m a)>>=(a->m b)>>=(b->m c)でできているものなどいろいろある。
つまり内部に(a->m b)型の関数が0個のものもあれば、
1個や複数のものなどある。モナドはプログラマブルコンテナである。

((->) r)というのは不完全な型。もうひとつ型が与えられて
((->) r a) となると完全な型で、これはr型の引数を1つとって
a型の戻り値を返す関数の型になっている。

((->)r)はモナド。Readerモナド。((->)r)はあと型が1個あれば関数になれるモナド。

関数はCompositeパターンみたいなもの。外から見たら関数だし、
中に複数の関数をもっている場合もある。
中に複数の関数を持っているものには、
returnして関数(m a)を返すものや次とバインドする
(a -> m b)の中に関数(m b)を含んでいるものがある。

外から見たら関数なので、中を記述したものが最終的に返すのは(m a)
バインドしていった最後にreturnが返しているのは(m a)

中から見たときは、それぞれの関数には、共通のグローバルな環境変数wが
適用されるように地下配線されていて、そのwは外の世界でいうところの
引数になっている。

中から見たときは、外のことはwでしか伝わらない。引数は1つしかなくて、
wには引数の値がそのまま入っている。wの値を使うか使わないかは
それぞれ自分で決められる。

f1 :: Int -> Int
f1 = do a <= (*2) (あ)
        b <= (+10) (い)
        return (a+b) (う)

(あ)〜(う)のすべての行で、関数が書いてあると、
それには地下配線からwが引数として与えられる。なので、
aには(*2)w の値が束縛され、b には、(+10)w の値が束縛される。
return (a+b) にもwが引数として与えられるがreturnの定義に
よりそれは捨てられて(a+b)の値を計算したものが(m a)型の文脈に
いれられ内部関数の処理がすべて終了し、外の世界に(m a)型が返ってゆく。

それがそうできていることは、具体的な関数、たとえばf1 に対し、
((->)r)モナドの定義、
return x = ¥_ -> x
h >> f   = ¥w -> f (h w) w
を使って説明することができる。
説明をはしょるとf1は最終的に、
f1 = ¥w -> ((*2)w + (+10)w)
になる。

はしょった部分
-- return x = ¥_ -> x (1)
-- h >>= f = ¥w -> f (h w) w (2)
addStuff11 = do a <- (*2)
b <- (+10)
return (a + b)
addStuff12 = (*2) >>= (¥a -> (+10) >>= (¥b -> return(a+b))) -- do記法をバインドに
addStuff13 = ¥w -> (¥a -> (+10) >>= (¥b -> return(a+b)) ) ((*2)w) w --(2)より
addStuff14 = ¥w -> (¥a -> (¥w' -> (¥b -> return(a+b)) ((+10)w') w') ) ((*2)w) w --(2)よ
り
addStuff15 = ¥w -> (¥w' -> (¥b -> return(((*2)w)+b)) ((+10)w') w') w --aに((*2)w)を適用
addStuff16 = ¥w -> (¥w' -> return((*2)w + (+10)w') w') w --bに((+10)w)を適用
addStuff17 = ¥w -> (¥w' -> (¥_-> ((*2)w + (+10)w')) w') w --(1)より
addStuff18 = ¥w -> (¥w' -> ((*2)w + (+10)w') ) w --w'を適用
addStuff19 = ¥w -> ((*2)w + (+10)w) --wを適用
結局addStuffは、¥w -> ((*2)w + (+10)w) と同じ。
途中で、return(a+b)の、aに(*2)wを、bに(+10)wを適用しているところに注目。

おまけ。Intに1を加えてIntを返す関数addOneは以下のようにいろいろ書ける。
addOne :: Int -> Int
addOne1 = (+1)
addOne2 = ¥w -> (+1) w
結局、関数にとって引数はReaderモナドの地下配線
で与えられるRead Only定数。askで得ることができる。
addOne3 = do x <- ask
          return (+1) x
addOne4 = do x <- (+1)
          return x
addOne5 = (+1) >>= (¥x -> return x)
addOne6 = (id) >>= (¥x -> return (+1) x ) >>= (¥x -> return x)

関数は、do記法を使っても書けるし、バインドを使っても書ける。

07

18

[Haskell] すごいHaskell楽しく学ぼう 第14章もうちょっとだけモナド p361 読者への演習問題 解いてみた

2013.07.18(22:17)

p361 『結果が⼀致する事象の確率をまとめる処理を書くのはとても簡単です
(から、読者への演習問題とさせていただこうと思います)。』

これを
[Coin]のうち、どれかが表だったらTrueを返す関数([Coin]->Bool)と、
flip3Coins :: Prob [Coin]
flip3Coins = coin >>= (¥a -> coin >>= (¥b -> 
             loadedCoin >>= (¥c -> return [a, b, c])))
をとって、確率
31 % 40
を求める関数rationalAnswer
rationalAnswer :: ([Coin]->Bool) -> Prob [Coin] -> Rational
を作ってください。

という問題だと解釈して解いてみました。

確率モナドと、確率モナドを使ったコイントスを別のファイルにしました。
確率モナド (テキストそのまま)
{-# OPTIONS -Wall -Werror #-}
-- | 確率モナド  Prob.hs
-- | モジュール宣言。このプログラムは、Prob.hsというファイルに入っている
module Prob where
-- | "分数"データ型
import Data.Ratio

-- | Probをnewtypeで包んでおく
-- | getProbすると(値,確率)のリストを返す。
newtype Prob a = Prob { getProb :: [(a, Rational)] } deriving Show

-- | fmapの定義を与えてファンクターにする
-- | fmapするときは値のほうにfを適用して、確率のほうは何もしないことにする
instance Functor Prob where
  fmap f (Prob xs) = Prob $ map (\(x, p) -> (f x, p)) xs

-- | 「確率リストの確率リスト」を平らにする方法を用意
flatten :: Prob (Prob a) -> Prob a
flatten (Prob xs) = Prob $ concat $ map multAll xs
   where multAll (Prob innerxs, p) = map (\(x, r) -> (x, p*r)) innerxs

-- | ProbをMonadインスタンスにする
instance Monad Prob where
  return x = Prob [(x, 1%1)]
  -- m >> f は常に join (fmap f m)に同じ。
  m >>= f  = flatten (fmap f m)
  fail _   = Prob []

確率モナドを使ったコイントス
{-# OPTIONS -Wall -Werror #-}
-- | 確率モナドを使ったコイントス Coin_toss.hs
module Coin_toss where
import Test.HUnit
import Data.Ratio
--import Data.List (all)
import Prob

-- | コイン型は、2つの値コンストラクタをとる
data Coin = Heads | Tails deriving (Show, Eq)

-- | 普通のコインは、表の出る確率が1/2, 裏が出る確率が1/2
coin :: Prob Coin
coin       = Prob [(Heads, 1%2), (Tails, 1%2)]

-- | いかさまコインは、表の出る確率が1/10, 裏が出る確率が9/10
loadedCoin :: Prob Coin
loadedCoin = Prob [(Heads, 1%10), (Tails, 9%10)]

-- | コイン投げ
-- | 普通のコイン2回といかさまコイン1回振って、
-- | すべての表裏の組み合わせとその確率を求める
flip3Coins :: Prob [Coin]
flip3Coins = coin >>= (\a -> coin >>= (\b -> 
             loadedCoin >>= (\c -> return [a, b, c])))

-- | モナドから[([出方],確率)]を得る
getResult :: Prob [Coin] -> [([Coin],Rational)]
getResult a = getProb a

-- | 全部の出方のうち自分の見つけたい出方だったらTrue
-- | 今回はHeadsが1度でも出たらTrue
findCoins :: [Coin]->Bool
findCoins [] = False
findCoins (x:xs) = if x == Heads then True
                                 else findCoins xs

-- | コインの出方を判断する関数と
-- | [([出方],確率)]をとって
-- | その出方をした確率を返す関数
sumTrueCoinCases :: ([Coin]->Bool) -> [([Coin],Rational)] -> Rational
sumTrueCoinCases _ [] = 0
sumTrueCoinCases f (x:xs) = if (f cs) then r+(sumTrueCoinCases f xs) 
                                      else   (sumTrueCoinCases f xs)
                                      where  (cs,r) = x

-- | コインの出方を判断する関数と
-- | すべての出方の確率モナドをとって
-- | その出方をした確率を返す関数
rationalAnswer :: ([Coin]->Bool) -> Prob [Coin] -> Rational
rationalAnswer func pa = sumTrueCoinCases func $ getProb pa

main :: IO ()
main = print $ rationalAnswer findCoins flip3Coins

実行結果
> :reload
[1 of 2] Compiling Prob             ( Prob.hs, interpreted )
[2 of 2] Compiling Coin_toss        ( Coin_toss.hs, interpreted )
Ok, modules loaded: Coin_toss, Prob.
> :main
31 % 40
(0.00 secs, 2183500 bytes)
プロフィール

島敏博

Shima Toshihiro 島敏博
信州アルプスハイランド在住。HaskellとElixirが好き。組み込みソフトウェアアーキテクト、C++プログラマ、山歩き、美術館巡り、和食食べ歩き、日本赤十字社救急法指導員、インデックス投資、クラシック音楽、SESSAME会員、状態マシン設計、モデル駆動開発、ソフトウェアプロダクトライン、Rubyist、実践ビジネス英語

■ ツイッター
http://twitter.com/saltheads
■ Facebook
http://www.facebook.com/saltheads
■ Qiita
http://qiita.com/saltheads

印刷する場合は、ブラウザの印刷メニューではなく、このページの上から3cmくらいの青いところにある、「印刷」を押してみてください。少しうまく印刷できます。まだ完全ではないのですが、これで勘弁してください。


カテゴリ
最新記事
月別アーカイブ
最新コメント
検索フォーム
リンク
sessame
RSSリンクの表示