Haskell

ガイド

Windowsでstack installが効かないとき

インストール: Mac

2022-03

```sh brew install llvm@12

# GHC 8.10.7を入れる場合 OPT=/opt/homebrew/opt/llvm@12/bin/opt LLC=/opt/homebrew/opt/llvm@12/bin/llc ghcup install ghc 8.10.7 --force

# GHC 9.0.2を入れる場合 OPT=/opt/homebrew/opt/llvm@12/bin/opt LLC=/opt/homebrew/opt/llvm@12/bin/llc ghcup install ghc 9.0.2 --force

ghcup set ghc 8.10.7 # または ghcup set ghc 9.0.2 ```

インストール: Windows

よくある特殊記号の対照表

記号と Haskell の ASCII 文字対応. フォントの関係で記号によっては TeX 表記にする

基本?

よくある表記 Haskell
$\leq$ <=
$\geq$ >=
$\lor$ $\lor$
$\land$ &&
$\cdot$ .
$\neq$ /=
$\in$ elem
$\notin$ notElem
$\sqsubseteq$ isPrefixOf
div div
mod mod
min min
max max
knows knows

Graham の本から記号集

Symbol Meaning Typed
maps to ->
class constraint =>
\geq at least >=
\leq at most <=
\neq inequality /=
conjunction &&
disjunction $\lor$
negation not
exponentiation ^
\circ composition .
λ abstraction \
++ append ++
drawn from <-
>>= sequencing >>=
+++ choice +++

Bird, Gibbons, Algorithm Design with Haskell

| ⊥ | bottom |

参考文献

CharをWord8に変換する

ここを参考にするといいでしょう. 詳しく検証できていないものの, ここも調べておきたいです.

package.yaml には次のように書いておきます.

dependencies:
- base >= 4.7 && < 5
- bytestring
- utf8-string

コードは次の通り.

fromIntegral.ord $ 'd'

Char to [Word8] なら次のように書けるようです.

import qualified Codec.Binary.UTF8.String as US
US.encode 'd'

改行とスペースの Word8 は次のように定義できます.

lf :: W.Word8
lf = fromIntegral.ord $ '\n'

space :: W.Word8
space = fromIntegral.ord $ ' '

intercalateとunlines

intercalate は適当な文字を区切り文字にしてリストを文字列にしてくれる. ただし改行で区切ったとしても最後の行に改行がつかない. unlines は最後の行にも改行をつけてくれる.

Data.ByteString.Lazy (as BL), Data.ByteString.Lazy.Char8 as C8 でやっているとき, BL.intercalate だが, C8.unlines であることに注意.

ghcup完全アンインストール

ghcup nuke

negate

recip

Vectorのリテラル: OverloadedLists

{-# LANGUAGE OverloadedLists#-}
import qualified Data.Vector as V
main = do
  let a = [1..10]
  print $ a = V.fromList [1..10]

型まわりの用語: 型コンストラクタ (type constructor)

型の記述に使われる識別子. 型は型コンストラクタの組み合わせで作る.

例: Integer や Bool のような単体で型となる型コンストラクタの他, 他の型コンストラクタを引数としてとるものもある. このとき型コンストラクタに引数として渡す型コンストラクタを型引数と呼ぶ.

型引数を取る型コンストラクター: IO, Maybe, ->, (,).

型コンストラクターの実例: IO Integer, Maybe Int, String -> Bool, (Double, Double).

型まわりの用語: カインド

型を組み合わせる際のルールを規定するために使うものをカインド (kind) と呼ぶ. カインドは基本的には * (star) と -> だけで表され, 型コンストラクタと型引数の組み合わせを規定する

式に対する型, 型に対するカインドという構造がある.

型まわりの用語: 型変数

型の表記にも変数が使える: 常の式の中で使う変数と区別するため, これを型変数 (type variables) と呼ぶ.

例: id, head など, 型が異なっても同じ実装を使いまわせる関数は型変数を使って定義されている.

Prelude> :t id
id :: a -> a
Prelude> :t head
head :: [a] -> a

型まわりの用語: 型制約

型変数には制約をかけられる. 型制約は型変数の型を限定することで, 特定の型クラスに所属する型だけに型を限定できます.

型制約と型は => で区切る. => の左側に型変数が満たすべき条件を書き, それを満たすように制約を課す.

例: show 関数の型を見る.

Prelude> :t show
show :: Show a => a -> String

型まわりの用語: データコンストラクタ

代数的データ型を定義するためにデータコンストラクタを使う. 左辺に data キーワードと型コンストラクタ名 (型名), 右辺にデータコンストラクタ名と各フィールドの型を指定する.

例: 自作の Employee 型. これは Integer 型の年齢, Bool 型による管理職フラグ, String 型の名前の 3 つのフィールドを持つとする. 型コンストラクタ名とデータコンストラクタを区別できるように NewEmployee という名前を使うことにすると, 新たな型 Employee は次のように書ける.

Prelude> data Employee = NewEmployee Integer Bool String

REPL 上で表示するために, 末尾に deriving (Show) を追加してもいい.

Prelude> data Employee = NewEmployee Integer Bool String deriving (Show)

定義したデータコンストラクタは関数として使える. REPL で型を表示させてみると, フィー ルドである Integer, Bool, String の 3 つの引数を受け取り, Employee 型を生成する関数であることがわかる.

Prelude> :t NewEmployee
NewEmployee :: Integer -> Bool -> String -> Employee
Prelude> employee = NewEmployee 39 False "Subhash Khot"
Prelude> employee
NewEmployee 39 False "Subhash Khot"

Employee 型の値の各フィールドにアクセスするためにパターンマッチを使う. データコンストラクタ NewEmployee はそのままパターンとして使える. age, isManager, name という 3 つのローカル変数を導入して, それぞれのフィールドの値へ束縛する.

Prelude> NewEmployee age isManager name = employee
Prelude> age
39
Prelude> isManager
False
Prelude> name
"Subhash Khot"

データコンストラクタはコンストラクタとも呼ばれる: Just などがそれにあたる.うでした 単にコンストラクタと書いたときはデータコンストラクタを指すことがよくある.

型まわり: 代数的データ型で複数のコンストラクタのいずれか1つを使う

代数的データ型の宣言時に複数のデータコンストラクタを指定し, 生成時にいずれかを使う.

複数のコンストラクタから新しい型を定義するには | で定義を複数並べます.

data 型コンストラクタ名 =
  データコンストラクタ名 1 フィールドの型 1-1 フィールドの型 1-2 ...
  | データコンストラクタ名 2 フィールドの型 2-1 フィールドの型 2-2 ...

型まわり: 代数的データ型の引数の正格化

コンストラクタはデフォルトではすべての引数について非正格である. コンストラクタの定義で型の前に正格性フラグ ! を付けると, その引数について正格になる.

コンストラクタを非正格にしておくと, サンクがスペースリークの原因になる. 特に理由がなければ正格性フラグを付けること.

data LazyAndStrict = LazyAndStrict
                     { lsLazy
                     :: Int
                     , lsStrict :: !Int
                     }

型まわりの用語: レコード記法

他の多くのプログラミング言語で構造体やクラスを扱う場合, フィールドには名前を付けられる. Haskell では, レコード記法で代数的データ型のフィールドに名前を付ける. レコード記法は { } 内にフィールド名 :: 型名という形式で並べる.

例を挙げる.

data 型コンストラクタ名 = データコンストラクタ名 { フィールド名 1 :: 型名 1, フィールド名 2 :: 型名 2 }
data Employee = NewEmployee { employeeAge :: Integer
                            , employeeIsManager :: Bool
                            , employeeName :: String
                            } deriving (Show)

型まわりの用語: フィールドへのアクセス

レコード記法によって定義されたデータ型では, パターンマッチの代わりにフィールド名を関数として使い, その値へアクセスする.

employeeAge の型を見てみると, Employee 型の値をとって Integer 型の値を返している.

Prelude> -- あらかじめ代数的データ型`Employee`を定義しておく
Prelude> :t employeeAge
employeeAge :: Employee -> Integer

型まわりの用語: フィールドの値の差し替え

代数的データ型の値の一部のフィールドのデータを差し換えたい場合にもフィールド名を使える. ただし, Haskell のデータはすべてイミュータブルなので, 生成した値の書き換えはできない. その代わりに指定したフィールドのみ別のデータを持つ値をコピーして生成する.

フィールドを差し替えるにはコンストラクタのときと同様に { ... = ... } の書式を使う. ただし, コンストラクタ NewEmployee の代わりに差し替える対象となる値を指定する. employeeAge フィールドについては, 元の値に 1 を加えて更新します.

型まわりの用語整理: 例題

型変数とレコード記法を使って作った次のような定義を考える. この定義に出てくるそれぞれの識別子は式と型のどちらか.

Prelude> data A = B
Prelude> data C d = E { f :: d, g :: A }
Prelude> data H = I A (C A)

答え

型 d は型変数なので識別子としては公開されない. 識別子 B と E, I はコンストラクタで, パターンマッチ内で使える. f と g はフィールド名で, C d 型の同名のフィールドの差し替え時のレコード記法などで使える.

型まわりの用語: 型の別名

型名が長過ぎて可読性を損ねていたり, 同じ形式であってもデータの持つ意味が違ったりする場合, 型に別の名前を付けられると便利です. 前者の目的では type キーワードを, 後者の目的では newtype キーワードを使います.

型まわりの用語: type

type キーワードを使うと型に別名を付けられます. これを型シノニム (type synonym) と呼びます.

型シノニムは実は今までもよく目にしています: Prelude で定義されている String 型です. String は [Char] の別名です.

型シノニムは, 煩雑な型に簡単な別名を付けてコードの見通しをよくしたり, 一般的過ぎる名前の型に具体的な別名を与えて人間へのドキュメントとして使います.

legalDrink :: Integer -> Bool という型の関数を考えてみましょう. この関数は飲酒の可否判定を意図しています. しかしこのままでは第一引数に何を渡せばいいのか自明とは言えません. このような場合に型に別名を付けて型にこの関数の仕様を説明させます. Integer 型に Age 型という別名が付いたことで年齢が求められていることがわかります.

型まわりの用語: newtype

type と似たキーワードとして newtype があります. こちらも type と同様に型に別名を与えます. ただし, newtype で定義された型は, 元の型とは別の型です. 文字通り新しい型を作ります. そのため, type と違って右辺にはコンストラクタ名が必須です.

newtype 型コンストラクタ名 = データコンストラクタ名 型

型まわりの用語: 型クラスやインスタンスの用語上の注意点

Haskell では型クラス (クラス) やインスタンスなど, 他言語で少し聞き覚えのある用語が使われています. これらの用語の用法は Haskell と他言語で違います.

混同を防ぐために, ここでは用語の相違点や関係を一旦まとめます.

オブジェクト指向では, クラスはデータ構造の定義で型に近いもの, インスタンスはクラスが定義する構造を実際に持つデータを指します.

しかしHaskell の型クラスとインスタンスはかなりニュアンスが違います. Java でたとえるなら, 型クラスはインタフェースに, インスタンスは具象クラスにそれぞれ該当します. まとめると表のような対応関係になります.

Java Haskell 備考
インタフェース 型クラス 型が持つべきメソッドを規定
具象クラス インスタンス 規定されたメソッドの実装
インスタンス 個々のデータ

型クラスで定義され, 任意の型によって具体的に実装される, 型クラスに紐付いた関数をメソッドと呼びます. これはオブジェクト指向における用語と近いでしょう.

例えば, Num 型クラスでは (+) や negate 関数が型クラスのメソッドとして定義されています. Haskell の型クラスが定義するメソッドは, Java はじめその他のオブジェクト指向言語のようにデータに紐付いた関数ではありません. メソッドの属する型を第一引数とする必要もなく, 第二引数でも返り値やコールバック関数の引数がメソッドの属する型となるような定義も許されます. String や Integer のような型引数のない型だけではなく, Maybe や IO のように型引数をとる型コンストラクタについてもメソッドを規定できます. メソッド定義は非常に柔軟性が高く, この仕組みが Haskell の型の表現力を高めています.

型まわりの用語: 型クラス・インスタンス

型クラス (type class) は Haskell でアドホック多相を実現するための機構です. まずは型クラスは型制約に使える, 複数の型を一定の規則の元にまとめるための型のカテゴリや分類だと考えてください.

アドホック多相とは型に応じて場当たり的に異なる実装を適用することです (3.2.2 参照). そうはいっても, すべての型に対して適用できる関数をつくるわけにはいかないので, ある程度は型を限定する必要が出てきます. そこで型変数に制約を課します. 型制約を可能にするのが型クラスによる型の分類です. 型クラスに所属する型をその型クラスのインスタンス (instance) と呼びます.

Haskell では言語の中核といえる重要な演算が型クラスとして表現されています.

型クラスを積極的に利用した設計によって, + や - など, 他のプログラミング言語では組み込みの演算子として用意されていることが多いものまで, Haskell では自由にオーバーロードできます. オブジェクト指向でいう継承関係を持たない Haskell では, 型クラスは拡張性のある設計を行うための強力な道具です.

型まわりの用語: 型クラスの例

型クラスの例を, 型制約を通して見てみましょう.

Prelude> :t (+)
(+) :: Num a => a -> a -> a

Num が型クラスです. Num による型制約があるため Int や Float などの Num 型クラスに所属する型 (インスタンス) は引数に指定できますが, Char など属さないものは指定できません.

型まわりの用語: パラメータ多相

例えば, sample x = x と定義された sample 関数は, 任意の型に対して適用できます.

Prelude> sample x = x
Prelude> :t sample
sample :: t -> t
Prelude> -- 2 引数の場合は t, t1
Prelude> sample2Params f x = f x
Prelude> :t sample2Params
sample2Params :: (t1 -> t) -> t1 -> t

ここでの t 型, t1 型はその関数を扱う際に任意の具体的な型に置き換えられることを示しています.

このように一つの式に汎用の型を表す型変数 t を割り当て, 複数の具体的な型で使えるようにした型システムはパラメータ多相 (parametric polymorphism) を持つといいます.

型まわりの用語: アドホック多相

アドホック多相はオブジェクト指向言語におけるオーバーロードに相当します.

Haskell では型クラス (type class) という仕組みを利用して, 型によって全く異なる実装の式を使えます. 記述だけ見ると同じ式に見えても, 型によって柔軟に処理を変えられます.

例えば 1 == 1 と "OCaml" == "OCaml" の式のそれぞれの (==) 関数では, 関数名は同じですが, まったく別の実装が使われます. 型クラスによる多相は, 必要に応じて型ごとに場当たり的に違う実装を追加できるため, アドホック多相 (ad-hoc polymorphism) と呼ばれます.

備忘録: 型クラスを指定した関数の記法

Haskell弱者なので. 元ネタは次の本の演習問題.

何となくHaskellで書き直してみている. 問題の18.3についてGistに上げて, それを実解析Pに質問してみた.

結局bについての型指定についてはいまだによくわかっていない. 次のコードで次のエラーが出る.

assoc :: (Eq a, Eq b) =>a ->[(a, b)] ->Maybe b
assoc _ [] = Nothing
assoc ekimei0 (x:xs) =
  if fst x == ekimei0 then Just (snd x)
  else assoc ekimei0 xs

main = do
  -- 実行するとエラーになる:今の腕では解消できない
  print $ assoc "後楽園" [] == Nothing
  print $ assoc "後楽園" [("新大塚", 1.2), ("後楽園", 1.8)] == Just (1.8)
  print $ assoc "池袋" [("新大塚", 1.2), ("後楽園", 1.8)] == Nothing

runghc ex18_3_1.hs で実行すると次のエラーがでる.

ex18_3_1.hs:11:11: error:
     Ambiguous type variable b0 arising from a use of ==
      prevents the constraint (Eq b0) from being solved.
      Probable fix: use a type annotation to specify what b0 should be.
      These potential instances exist:
        instance Eq Ordering -- Defined in GHC.Classes
        instance Eq Integer
          -- Defined in integer-gmp-1.0.0.1:GHC.Integer.Type
        instance Eq a =>Eq (Maybe a) -- Defined in GHC.Base
        ...plus 22 others
        ...plus 9 instances involving out-of-scope types
        (use -fprint-potential-instances to see them all)
     In the second argument of ($), namely
        assoc "\24460\27005\22290" [] == Nothing
      In a stmt of a 'do' block:
        print $ assoc "\24460\27005\22290" [] == Nothing
      In the expression:
        do { print $ assoc "\24460\27005\22290" [] == Nothing;
             print
             $ assoc
                 "\24460\27005\22290"
                 [("\26032\22823\22618", 1.2), ("\24460\27005\22290", 1.8)]
               == Just (1.8);
             print
             $ assoc
                 "\27744\34955"
                 [("\26032\22823\22618", 1.2), ("\24460\27005\22290", 1.8)]
               == Nothing }
</code></pre></div>

バージョンは次の通り.

$ ghci --version
The Glorious Glasgow Haskell Compilation System, version 8.0.1

他にも気になることがあったりはしている. 数学の初学者の苦労はわからないことも多くなっているが, 自分自身が適当な分野の初学者になると「こんなところでもつまずく」系事例が 簡単に収集できる.

追記

コメントを頂いた.

[]の型がわからないのでそこからbの型を推論できないからですね。 たとえば([]::(Fractional a) =>[(String, a)])というふうに型情報を書いておけばいけます。 明示しないときassocが返す値の型はMaybe bということまでしかわかりませんから、 bの型が特定できません。 入力が [] のときに返ってくるのは Nothing ですから b の型は関係なさそうな気もしますが、たとえば Maybe Int の Nothing と Maybe Char の Nothing は (型がことなるので) 比較したりできません。

assocの型の方でもう少しbの型を制限する、たとえば(Num b)という制限をいれても大丈夫です。

あとで試してみよう.

関数プログラミング 珠玉のアルゴリズムデザイン

Reference

はじめに 関数プログラミング 珠玉のアルゴリズムデザイン

数学や物理, 特に物理を学ぶのに関数プログラミング, 特に Haskell が非常にうまく使えるという話がある. それを見て Haskell の勉強が急務だと思い色々な形で Haskell への知見を深めている.

例えば別企画で次のような記事 (群) もある.

そして何となくアルゴリズムをきちんと勉強しないといけないのかな, とずっと思って放置したままになっている. とりあえずいい加減何かやってみようと思い, 何となく買ってみたのが Richard Bird の pearls of functional algorithm design だ.

英語版を手に入れたのだが翻訳があったらしいと後で気付いた.

ウルトラ難しく 1 章を読んだ時点で既に心が折れている. ただせっかく読んだ分は記録に残しておきたい. 他の数学、物理系プログラミングを進めていて, うんざりしてきたら現実逃避でこちらを進めるというのもあっていいだろうとは思っている.

この本, Graham の本と同じスタイル, つまり正確なコードを書かずに一部疑似コード (疑似記号?) を使っていて, 慣れていないとすぐに翻訳できないのが最高に鬱陶しい. 例えば第 1 章で言うと本の P.1 で出てくる $\notin$ は not . flip elem のように表現しないといけないよう (本当によくわかっていない) だし, 本の P.2 で出てくる $\lor$ は本来の Haskell コードでは || だ.

先に書いたように最近また精力的に数学や物理, プログラミングのコンテンツを作っているけれども, こういうのはよくないな, と痛感させられるコンテンツだ. そういう意味でも厳しいコンテンツを見てみることは役に立つと思って, 無理せずゆるくやっていこう.

追記

翻訳者の山下伸夫さんからコメントを頂いてしまった.

Functional Pearls of Algorithm Designのプログラム表記と、ASCII記号によるHaskellプログラム表記との対応については、 http://pfad.sampou.org/ に追記しましたので、御笑覧くださいませ。

引用しておこう.

演算子記号とASCII文字列との対応

  • 本書の記号: HaskellのASCII文字
  • ≤: <=
  • ≥: >=
  • ∨: ||
  • ∧: &&
  • ⋅: .
  • ≠: /=
  • ∈: elem
  • ∉: notElem
  • ⊑: isPrefixOf
  • div: div
  • mod: mod
  • min: min
  • max: max
  • knows: knows

演算子以外の構文記号の一部については,GHCの言語拡張UnicodeSyntaxを有効にするとソースコード中に記述可能です. 詳細については,GHCユーザーガイド 9.3.1 Unicode syntaxをご覧ください.

演算子に関しては,Unicodeの記号が使えますので,たとえば,1章については,以下のような定義モジュールをインポートすれば,そのままコードで表現できます.

{-# LANGUAGE UnicodeSyntax #-} module Operators where

import qualified Data.List

infixr 5 \

(\) ∷ Eq a ⇒ [a] → [a] → [a] (\) = (Data.List.\)

infix 4 ∈, ∉

(∈) ∷ Eq a ⇒ a → [a] → Bool (∈) = elem

(∉) ∷ Eq a ⇒ a → [a] → Bool (∉) = notElem

infixr 2 ∨

(∨) ∷ Bool → Bool → Bool (∨) = (||)

infixr 3 ∧

(∧) ∷ Bool → Bool → Bool (∧) = (&&)

infix 4 ≤, ≥

(≤) ∷ Ord a ⇒ a → a → Bool (≤) = (<=)

(≥) ∷ Ord a ⇒ a → a → Bool (≥) = (>=)

数学関係だとほとんどコメント来ないのに (素人くさい) プログラミングの話だと やたら本質的に私が助かるコメントが来るのでありがたさしかない.

1. The smallest free number (最小自然数) 関数プログラミング 珠玉のアルゴリズムデザイン

投稿用メモ

導入部

集合$X \subset \mathbb{N}$の最小値を求めようという問題を考えよう. もちろん適当に派生的な問題もあるし現実的な応用もある. 解は$X$がどのように表現されているかによる.

任意の数のリストを線型時間でソートするアルゴリズムを考えてみる. 次のminfreeのような挙動をする関数を作りたい.

-- Int  Nat にしたい: Nat 自体は例えば Data.Nat にはある. 適当にインポートしたりする必要あり?
minfree :: [Int] -> Int
--minfree xs = head $ [0..] Data.List.\\ xs
minfree xs = head $ [0..] Main.\\ xs

-- Data.List.\\ にある関数: 本の記述では notElem  TeX でいう $\notin$ の記号で書かれていた.
(\\) :: Eq a => [a] -> [a] -> [a]
us \\ vs = filter (not . flip elem vs) us

main = do
  let a = [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]
--  print $ Data.List.sort a
  print $ minfree a
#+END_SRC
#+RESULTS:
:
: 15

この関数minfreeは$O(n^2)$のオーダーなので困る. これをどうにかしたい.

Haskellの配列による解法

[0 .. length xs] の全ての要素が xs に入っているわけではないことに注意する. xs に入っていない最小の数は filter (<= (length xs)) xs に入っていない最小の数だ.

結果から書くと次のようになる. この実装は xs の要素が全て違う必要はないものの自然数であることは要請する.

import Data.Array

minfree' = search . checklist

search :: Array Int Bool -> Int
search = length . takeWhile id . elems

checklist :: [Int] -> Array Int Bool
checklist xs = accumArray (||) False (0, n) $ zip (filter (<= n) xs) (repeat True)
    where n = length xs

main = do
  print $ minfree' [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]
:
: 15

こんなさっくり書かれて意味がわかるわけもない. 当然 searchchecklist をそれぞれじっくり追うしかない. まずは checklist を見てみる.

checklist

たぶん慣れていないと accumArray がめんどい. というかいまだにきちんと理解しきれていない. 次の節で別立てで見ることにして, まずは accumArray に食わせるリストを作るところからはじめよう. つまり zip (filter ( <= n) xs) (repeat True) だ.

repeat True は全要素がブーリアン True の無限リストを作る. zip ではめて有限リストを切り出している.

zip にかけるもう一方のリストは filter (<= n) xs で作る. これは特に言うことない.

+BEGIN_SRC haskell :results output

main = do let xs = [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6] let n = length xs let a = zip (filter (<= n) xs) (repeat True) -- print $ repeat True print $ filter (<= n) xs print a

+END_SRC

+RESULTS:

:
[8,9,0,12,11,1,10,13,7,4,14,5,17,3,19,2,6]
[(8,True),(9,True),(0,True),(12,True),(11,True),(1,True),(10,True),(13,True),(7,True),(4,True),(14,True),(5,True),(17,True),(3,True),(19,True),(2,True),(6,True)]

これでタプルのリストができる. このタプルのリストを accumArray にくわせる.

accumArray

多分これが一番めんどい. 泥臭くコード片を追いかけないとわからない. ふだん (手続き型で?) 書くときはループで書くところを関数でスパっと書いている感じ. 逐次 print デバッグみたいなのがやりづらいので何をやっているかまだ追いづらい. 多分慣れればもっとサクサク書けるのだろうなとは思う.

とにかく泥臭く追いかけよう. foldr などと同じくコレクションに関数を順次適用させて新たなコレクションを作る系の処理だ. 実コード例は次の通り.

+BEGIN_SRC haskell :results output

import Data.Array

main = do -- 配列の添字は [1..3] -- 配列の各要素は第 2 引数 0 で初期化される let a = [(1, 2), (3, 4), (1, 5)] print $ accumArray (+) 0 (1,3) a

+END_SRC

+RESULTS:

:
array (1,3) [(1,7),(2,0),(3,4)]

accumArray の第 1 引数は当てる関数, 第 2 引数は初期値, 第 3 引数は新たな配列の添字の範囲, 第 4 引数はなめていく配列だ. Python あたりの標準的な記法を使って配列、リストを表すことにしよう. accumArray の結果の配列を b とする.

b[1] からはじまるので b[1] がどうなるかを調べよう. 結果から行くと a[0]a[2] の第 1 要素の和, つまり b[1] = a[0][1] + a[2][1] になる. これを見ていく.

基本は a をなめていくのだ.

これが上の accumArray の結果.

checklist は 0 から $n$ 個までの $n+1$ スロットある. 最初は全て False だ.

改めて書くと次のように定義される.

+BEGIN_SRC haskell :results none

minfree' = search . checklist

search :: Array Int Bool -> Int search = length . takeWhile id . elems

checklist :: [Int] -> Array Int Bool checklist xs = accumArray (||) False (0, n) $ zip (filter (<= n) xs) (repeat True) where n = length xs

+END_SRC

Boolean の配列 (Data.Array) から整数を取る. この整数はもとのリストの最小値にあたる. この他に関数の合成 (.) も使っている.

elems から見ていこう. これは配列の要素をリストに格納して返す.

+BEGIN_SRC haskell :results output

import Data.Array

main = do let a = listArray (0,3) [1,2,3,4] print $ a print $ elems a

+END_SRC

+RESULTS:

:
array (0,3) [(0,1),(1,2),(2,3),(3,4)]
[1,2,3,4]

これも特に問題ないだろう. よくわからないのは id. なぜこれを挟む必要があるのだろうか? 外したらエラーになった. takeWhile に predicate を食わせないといけないからその役割なのだろうか. そう思えば必要な理由は理解できる. 今の私のレベルでは自分で書こうとすると多分解決できずそのまま死にそう.

takeWhile は predicate を食わせてそれが True を返すうちはリストを返し続けてくれる関数. False が来たら打ち切ってそこまでの長さを測れば目的の値が取れる.

分割統治法(divide & conquer)

xsの要素は全て異なることを前提にしている. 基本的なアイデアはリストを分けてそのリストのそれぞれに対処するべし.

最初のコードは次の通り. 徐々に改善する.

import Data.List
minfreeDivideAndConquer b xs =
  if null ([0..b-1] Data.List.\\ us)
  then head ([b..] Data.List.\\ vs)
  else head ([0..] Data.List.\\ us)
  where (us, vs) = partition (< b) xs

main = do
  let a = [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]
  print $ Data.List.sort a
  print $ minfreeDivideAndConquer 4 a
: [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,17,19,21,23,41]
: 15

いくつか関数の挙動を調べておこう. まずはnull.

main = do
  print $ null []
  print $ null [1]
:
: True
: False

次にpartition.

import Data.List
main = do
  print $ Data.List.partition (< 2) [1,2,3,4]
: ([1],[2,3,4])

最初の改良点はnull ([0..b-1] Data.List.\\ us)で, $O(n^2)$かかるこの処理を軽くしたい. リストに重複がなければnull ([0..b-1] \\ us) == (length us == b)であることを使う. ここでリストに重複がないことを使っている. これと次のminfromを使う.

minfrom :: Int -> [Int] -> Int
minfrom a xs = head ([a..] \\ xs)

そこで次のコードが出てくる.

import Data.List
b = 5
minfreeDivideAndConquer' xs = minfrom 0 xs
minfrom a xs | null xs            = a
             | length us == b - a = minfrom b vs
             | otherwise          = minfrom a us
  where (us, vs) = partition (< b) xs

main = do
  print $ minfreeDivideAndConquer' [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]

このコードをrunhaskellで動かそうと思ったら動かない. エラーになるわけではなく処理が回りっぱなしという感じ. 何なのだろう.

何はともあれ, 上のコードはb=5のハードコードが気に入らない. これを消した以外にもlength usを何度も計算しないように whereに押し込めたりと工夫したのが次のコード.

import Data.List
minfreeDivideAndConquer'' xs = minfrom 0 (length xs, xs)
minfrom a (n, xs) | n == 0     = a
                  | m == b - a = minfrom b (n - m, vs)
                  | otherwise  = minfrom a (m, us)
  where (us, vs) = partition (< b) xs
        b        = a + 1 + n `div` 2
        m        = length us

main = do
  print $ minfreeDivideAndConquer'' [8, 23, 9, 0, 12, 11, 1, 10, 13, 7, 41, 4, 14, 21, 5, 17, 3, 19, 2, 6]
:
: 15

今回はこれでおしまい.

2. A surpassing problem (上位者問題) 関数プログラミング 珠玉のアルゴリズムデザイン

投稿用メモ

元書籍とここまでの内容

書籍
原著
翻訳

翻訳の公式ページはここ.

ここまでの内容

冒頭部

Rem による解法では二分探索を使っていたそうだが, この本では分割統治法を使うとのこと 配列の要素の上位者は右にある要素より大きい要素のことをいう. 例えば $i<j$ かつ $x[i] < x[j]$ なら $x[j]$ は $x[i]$ の上位者であるという.

文字列と文字に対してアルファベットが小さい方が上位者という順序をつければ, 次のように上位者数がカウントできる.

G E N E R A T I N G
5 6 2 5 1 4 0 1 0 0

Specification

作る関数は msc (maximum surpassor count の略) と名付けられている. 次の実装は $O(n^2)$ なのでもっと軽くしたいという話.

+BEGIN_SRC haskell :results output

msc :: Ord a => [a] -> Int msc xs = maximum [scount z zs | z : zs <- tails xs] scount x xs = length (filter (x <) xs)

tails [ ] = [ ] tails (x : xs) = (x : xs) : tails xs

main = do print $ msc [1,2,3,4]

+END_SRC

+RESULTS:

:
3

標準ライブラリにも Data.List.tails があるがそれとは別に新たに定義する. 具体的には空リストを返さない. tails の挙動を調べておこう.

+BEGIN_SRC haskell :results output

tails [] = [] tails (x : xs) = (x : xs) : tails xs

main = do print $ tails [1,2,3,4]

+END_SRC

+RESULTS:

:
[[1,2,3,4],[2,3,4],[3,4],[4]]

標準ライブラリの Data.List.tails は次の通り.

+BEGIN_SRC haskell :results output

import Data.List main = do print $ Data.List.tails [1,2,3,4]

+END_SRC

+RESULTS:

:
[[1,2,3,4],[2,3,4],[3,4],[4],[]]

分割統治法

$O(n \log n)$ のオーダーにしたい.

全ての上位者数のテーブルを作る.

+BEGIN_SRC haskell :results output

scount x xs = length (filter (x <) xs)

tails [ ] = [ ] tails (x : xs) = (x : xs) : tails xs

table xs = [(z, scount z zs) | z : zs <- tails xs]

main = do print $ table [1,2,3,4,6,5]

+END_SRC

+RESULTS:

:
[(1,5),(2,4),(3,3),(4,2),(6,0),(5,0)]

このとき msc' = maximum . map snd . table とすれば第 2 の msc ができる.

+BEGIN_SRC haskell :results output

scount x xs = length (filter (x <) xs)

tails [ ] = [ ] tails (x : xs) = (x : xs) : tails xs

table xs = [(z, scount z zs) | z : zs <- tails xs]

msc' = maximum . map snd . table

main = do print $ table [1,2,3,4,6,5] print $ msc' [1,2,3,4,6,5]

+END_SRC

+RESULTS:

:
[(1,5),(2,4),(3,3),(4,2),(6,0),(5,0)]
5

ちなみに snd は名前の通り (タプルの) 2 番目を取ってくる関数. 1 番目を取りたければ fst.

+BEGIN_SRC haskell :results output

main = do let l = [(1,5),(2,4),(3,3),(4,2),(6,0),(5,0)] print $ map fst l print $ map snd l

+END_SRC

+RESULTS:

:
[1,2,3,4,6,5]
[5,4,3,2,0,0]

もっと効率よく

これではまだ不満: 分割統治法のために table (xs ++ ys) = join (table xs) (table ys) をみたす線型時間の join を作りたい.

本では間にごちゃごちゃ計算 (式または関数の変換) しているし, 途中にいろいろある. よくわからないのでまずは結論から.

+BEGIN_SRC haskell :results output

msc' :: Ord a => [a] -> Int msc' = maximum . map snd . table

table [x] = [(x, 0)] table xs = join (m-n) (table ys) (table zs) where m = length xs n = m div 2 (ys, zs) = splitAt n xs

join _ tys [] = tys join _ [] tzs = tzs join n tys@((y, c):tys') tzs@((z, d):tzs') | y < z = (y, c+n) : join n tys' tzs | otherwise = (z, d) : join (n-1) tys tzs'

main = do let l = [1,2,3,4,6,5] print $ table l print $ msc' l

+END_SRC

+RESULTS:

:
[(1,5),(2,4),(3,3),(4,2),(5,0),(6,0)]
5

join の定義で txstys に, tystzs に変えて table での引数との対応を見やすくした.

本での join の定義は join 単独で見た場合に全ケースを尽くしているのだろうか. 上のように書けば問題ないだろうとは思う.

@ はシノニム: 聞き慣れないのでめちゃくちゃわかりづらいが, 単に別名をつけているだけのようだ.

+BEGIN_SRC haskell :results output

testFunc lst@(x:xs) = [(x, 0)] ++ [(a, 1) | a <- xs] main = do print $ testFunc [1,2,3]

+END_SRC

+RESULTS:

:
[(1,0),(2,1),(3,1)]

これは引数の lstx:xs に分解して, この分解した値を関数本体で使っている.

: はリストへの要素追加.

+BEGIN_SRC haskell :results output

main = do let list = 1 : [2, 3] print list

+END_SRC

+RESULTS:

:
[1,2,3]

あとは join に食わせる n の値が問題か. 本ではもちろん最初から追いかけて最後に上のようにまとめているので, それを逆に追いかける必要がある. jointable は相互に関係があるから両方見ないと決まらないのか.

一般的に考えるより具体例を追いかけた方が早そう.

+BEGIN_SRC haskell :results output

main = do let xs = [1,3,2] let m = length xs let n = m div 2 let ys = fst $ splitAt n xs let zs = snd $ splitAt n xs

print m print n print (m - n) print ys print zs

+END_SRC

+RESULTS:

:
3
1
2
[1]
[3,2]

ここまで書いてみたはいいものの, 具体的に書き下していくのがあまりにも面倒で断念. 頭の中で簡単なシミュレーションをして何となく事情は察した.

このくらいならまだ結果を見てシミュレーションすれば何となく雰囲気は掴める. 単純に慣れていないだけなのだとは思っているが, 関数が相互に定義されていてしかも再帰的になっている状況, どうしても追いかけるのがつらい. デバッグもどうしたらいいのかよくわからない. 「(Haskell に) 慣れたら print デバッグなんてそもそもしなくなった」みたいなことも見かけるので, もっとどっぷり浸かってみろということなのだろう.

数学や物理のコンテンツを作っていても他人に言うことだし, しばらく地道にやっていくしかない.

あとやはり実行可能なコード片を実際に作り, ちょこちょこ小さくコードを積んでいくのがよさそう. 今回もそれをやりたかったのだが tablejoin のように 2 つの関数が絡んでくる場合にどうしたものか. もっとじっくり解きほぐすしかないか. 今回はソートされたリストのマージで挫折した. $\land$ を重ねたような記号で書いてあるところ.

ああいう記号だか関数だか Haskell に本当にあるの. 単に気分だけを表現しているのか何なのか, それすら全くわからない. 自分がコンテンツを作っているときにこうなっていないか, 反省する題材でもある.

追記

またコメントを頂いた. 本文にコメントを引用する.

(⩕)演算子はHaskellの標準ライブラリでは定義されていません。 この演算子の仕様が、「整列済みの2つのリストをマージして1つの整列済みのリストにする」です。 ここでは、この仕様どおりの(⩕)が与えられているとしたら、(2.2)の等式が満たされていることが判るということが重要です。つまりプログラムを実行しなくても、あるいはテストしなくても、その正しさが判るということが、肝になっています。

以下の様に定義すれば仕様を満していることは容易に判ると思います。

コードは別枠で引用.

+BEGIN_SRC haskell :results silent

infixr 4 ⩕ (⩕) ∷ Ord a ⇒ [a] → [a] → [a] [] ⩕ ys = ys xs ⩕ [] = xs xxs@(x:xs) ⩕ yys@(y:ys) | x > y = y : (xxs ⩕ ys) | otherwise = x : (xs ⩕ yys)

+END_SRC

話がずれるが「⩕」がフォント (?) 的に存在していたことに衝撃を受けた.

ちなみに infixrこの辺参照.

投稿用メモ

元書籍とここまでの内容

書籍
原著
翻訳

翻訳の公式ページはここ.

ここまでの内容

冒頭部

$f$ は各引数に対して単調増加な 2 変数関数で, それに対する適当な探索をするアルゴリズムを作ろうという話. $f$ の引数はタプルで与える前提のようだ.

チェック用に $f$ の代表例を定義しておこう.

+BEGIN_SRC haskell :results output

saddleBackSample (x, y) = x^2 + 2 * y^2 main = do print $ saddleBackSample (1, 2)

+END_SRC

一番シンプルなのは次の実装.

+BEGIN_SRC haskell :results output

saddleBackSample (x, y) = x^2 + 2 * y^2 invert f z = [(x,y) | x <- [0..z], y <- [0..z], f (x,y) == z]

main = do print $ invert saddleBackSample 18

+END_SRC

いつも通りこれはコストが高い: 全ペアを走査しないといけないから. コストをどう減らすかを順次考えていく.

案その 1

$f$ の各引数に対する単調性を使う. $f (x,y) \geq x + y$ だから「対角線」以下を走査すればいい. どちらでもいいので $y$ が動く範囲を変えたのが次のコード.

+BEGIN_SRC haskell :results output

saddleBackSample (x, y) = x^2 + 2 * y^2 invert1 f z = [(x,y) | x <- [0..z], y <- [0..z-x], f (x,y) == z]

main = do print $ invert1 saddleBackSample 18

+END_SRC

案その 2

単調性があるから最初のコードで動く範囲を制限できる. 図については本を見よう.

新たな関数 find をかませているのがポイント. これで探索域を制限する.

+BEGIN_SRC haskell :results output

saddleBackSample (x, y) = x^2 + 2 * y^2 find (u, v) f z = [(x, y) | x <- [u..z], y <- [v, v-1..0], f (x,y) == z] invert2 f z = find (0, z) f z

main = do print $ invert2 saddleBackSample 18

+END_SRC

案その 3

次に find の効率を上げる.

+BEGIN_SRC haskell :results output

saddleBackSample (x, y) = x^2 + 2 * y^2 invert3 f z = find (0, z) f z find (u, v) f z | u > z || v < 0 = [] | z' < z = find (u+1, v) f z | z' == z = (u, v) : find (u+1, v-1) f z | z' > z = find (u, v-1) f z where z' = f (u, v)

main = do print $ invert3 saddleBackSample 18

+END_SRC

== の場合は「正解」なのでちゃんと値を抜き出す必要がある. ふだん解析学で評価している悪い癖で, 等号は不等号に入れたり入れなかったり = の場合を分けなかったりと雑に扱いがちだが, 今の場合そういうのは禁忌. 反省した. find の定義で x <- [u..z], y <- [v, v-1..0] としているために z' < z' や反対の場合の(u, v)` に入れる値が決まる.

案その 4

探索範囲はもっと小さくできる. 先程紹介した図で $(0,z)$, $(z, 0)$ は overestimate なのでそれを削るのだ. 適当に $m$, $n$ を計算して $(z+1) \times (z+1)$ の正方形を $(m+1) \times (n+1)$ の長方形にまで小さくする.

まず完成系はこれ.

+BEGIN_SRC haskell :results output

saddleBackSample (x, y) = x^2 + 2 * y^2 invert4 f z = find (0, m) f z n where m = bsearch (\y -> f (0, y)) (-1, z+1) z n = bsearch (\x -> f (x, 0)) (-1, z+1) z

find (u,v) f z n | u > n || v < 0 = [] | z' < z = find (u+1, v) f z n | z' > z = find (u, v-1) f z n | otherwise = (u,v) : find (u+1, v-1) f z n where z' = f (u,v)

bsearch g (a,b) z | a+1 == b = a | g m <= z = bsearch g (m,b) z | otherwise = bsearch g (a,m) z where m = (a + b) div 2

main = do print $ invert4 saddleBackSample 18

+END_SRC

$m$ と $n$ は当然 $f$ に依存する. 気分的には次のように書けばいい: $f$ が生の形で出てくるので次のコードはそのままでは実行できないことに注意しよう.

+BEGIN_SRC haskell :results silent

m = maximum $ filter (\y -> f (0, y) <= z) [0..z] n = maximum $ filter (\z -> f (0, z) <= z) [0..z]

+END_SRC

これはこれでリストを全部なめて filter して最大値を取らないといけない. つまり効率が悪い. ここを 2 分探索でコストカットする.

4. A selection problem (選択問題) 関数プログラミング 珠玉のアルゴリズムデザイン

イントロ

$X$ と $Y$ が互いに素な有限順序集合で, $X \cup Y$ のうち $k$ 番目に小さい元を取得することを考える.

$X$ と $Y$ がソートされたリストなら $O (\abs{X} + \abs{Y})$ ステップで十分. 2 つのリストのマージは線型時間で, マージされたリストの $k$ 番目に来るまでさらに $O(k)$ ステップ必要.

実際にはマージされたリストの $k+1$ 番目までがわかればいいので, 実際は $O(k)$ ステップあれば十分.

$X$ と $Y$ が配列になっている場合はさらに $O(\abs{X} + \abs{Y})$ まで落ちる. これは配列が各要素に定数時間でアクセスできるから. 今回はこの配列がキーになるようだ.

形式化と第 1 ステップ

中置演算子

(演算子名) で関数を定義する. バッククオートでくくるとふつうの関数も中置演算子として使える.

add m n = m + n
(.+.) a b = add a b

8 `add` 6 -- 14
add 8 6 -- 14
8 .+. 6 -- 14
(.+.) 8 6 -- 14

パーサー attoparsec

サンプル ごく単純な置換

+BEGIN_SRC haskell

{-# LANGUAGE OverloadedStrings #-}

import Data.Attoparsec.Text import Control.Applicative

sectionTopParser = (string " " >> return "# ") <|> (string " " >> return "## ") <|> (string " " >> return "### ") <|> (string " " >> return "#### ") <|> (string " " >> return "##### ") <|> (string " " >> return "###### ") <|> (string "**** " >> return "####### ")

main :: IO () main = do print $ parseOnly sectionTopParser " test a $f * g$" print $ parseOnly sectionTopParser " test a $f * g$" print $ parseOnly sectionTopParser " test a $f * g$" print $ parseOnly sectionTopParser " test a $f * g$" print $ parseOnly sectionTopParser " test *a $f * g$" print $ parseOnly sectionTopParser "** test a $f * g$" print $ parseOnly sectionTopParser "* test a $f * g$" print $ parseOnly sectionTopParser "** test a** $f * g$"

+END_SRC

+RESULTS:

:124:11-19: error:
Variable not in scope: parseOnly :: t0 -> [Char] -> ()
:
:124:21-36: error:
Variable not in scope: sectionTopParser

サンプル ごく単純な置換

その 1 型の定義, IP のパース

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} import Data.Attoparsec.ByteString.Char8 import Data.Word

data IP = IP Word8 Word8 Word8 Word8 deriving Show

parseIP :: Parser IP parseIP = do d1 <- decimal char '.' d2 <- decimal char '.' d3 <- decimal char '.' d4 <- decimal return $ IP d1 d2 d3 d4

main :: IO () main = print $ parseOnly parseIP "131.45.68.123"

+END_SRC

+RESULTS:

:
Right (IP 131 45 68 123)

その 1

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} import Data.Time import Data.Attoparsec.ByteString.Char8

timeParser :: Parser LocalTime timeParser = do y <- count 4 digit char '-' mm <- count 2 digit char '-' d <- count 2 digit char ' ' h <- count 2 digit char ':' m <- count 2 digit char ':' s <- count 2 digit return $ LocalTime { localDay = fromGregorian (read y) (read mm) (read d) , localTimeOfDay = TimeOfDay (read h) (read m) (read s) }

main :: IO () main = print $ parseOnly timeParser "2013-06-30 14:33:29"

+END_SRC

+RESULTS:

:
Right 2013-06-30 14:33:29

その 2 シンタックスの定義, 日時のパース

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-}

import Data.Attoparsec.ByteString.Char8 import Control.Applicative

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

productParser :: Parser Product productParser = (string "mouse" >> return Mouse) <|> (string "keyboard" >> return Keyboard) <|> (string "monitor" >> return Monitor) <|> (string "speakers" >> return Speakers)

main :: IO () main = do print $ parseOnly productParser "mouse" print $ parseOnly productParser "mouze" print $ parseOnly productParser "monitor" print $ parseOnly productParser "keyboard"

+END_SRC

+RESULTS:

:
Right Mouse
Left "string"
Right Monitor
Right Keyboard

その 3 パーサーを組み合わせる

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} import Data.Word import Data.Time import Data.Attoparsec.ByteString.Char8 import Control.Applicative

{- TYPES -} -- | Type for IP's. data IP = IP Word8 Word8 Word8 Word8 deriving Show

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

data LogEntry = LogEntry { entryTime :: LocalTime , entryIP :: IP , entryProduct :: Product } deriving Show

-- | Parser of values of type 'IP'. parseIP :: Parser IP parseIP = do d1 <- decimal char '.' d2 <- decimal char '.' d3 <- decimal char '.' d4 <- decimal return $ IP d1 d2 d3 d4

-- | Parser of values of type 'LocalTime'. timeParser :: Parser LocalTime timeParser = do y <- count 4 digit char '-' mm <- count 2 digit char '-' d <- count 2 digit char ' ' h <- count 2 digit char ':' m <- count 2 digit char ':' s <- count 2 digit return $ LocalTime { localDay = fromGregorian (read y) (read mm) (read d) , localTimeOfDay = TimeOfDay (read h) (read m) (read s) }

-- | Parser of values of type 'Product'. productParser :: Parser Product productParser = (string "mouse" >> return Mouse) <|> (string "keyboard" >> return Keyboard) <|> (string "monitor" >> return Monitor) <|> (string "speakers" >> return Speakers)

-- show -- | Parser of log entries. logEntryParser :: Parser LogEntry logEntryParser = do -- First, we read the time. t <- timeParser -- Followed by a space. char ' ' -- And then the IP of the client. ip <- parseIP -- Followed by another space. char ' ' -- Finally, we read the type of product. p <- productParser -- And we return the result as a value of type 'LogEntry'. return $ LogEntry t ip p

{- TEST -} main :: IO () main = print $ parseOnly logEntryParser "2013-06-29 11:16:23 124.67.34.60 keyboard"

+END_SRC

+RESULTS:

:
Right (LogEntry {entryTime = 2013-06-29 11:16:23, entryIP = IP 124 67 34 60, entryProduct = Keyboard})

その 4

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} import Data.Word import Data.Time import Data.Attoparsec.ByteString.Char8 import Control.Applicative import qualified Data.ByteString as B

-- Settings -- | File where the log is stored. logFile :: FilePath logFile = "babel_haskell_selling.log"

-- Types data IP = IP Word8 Word8 Word8 Word8 deriving Show data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

-- | Type for log entries. -- Add, remove of modify fields to fit your own log file. data LogEntry = LogEntry { entryTime :: LocalTime , entryIP :: IP , entryProduct :: Product } deriving Show

type Log = [LogEntry]

-- Parsing -- | Parser of values of type 'IP'. parseIP :: Parser IP parseIP = do d1 <- decimal char '.' d2 <- decimal char '.' d3 <- decimal char '.' d4 <- decimal return $ IP d1 d2 d3 d4

-- | Parser of values of type 'LocalTime'. timeParser :: Parser LocalTime timeParser = do y <- count 4 digit char '-' mm <- count 2 digit char '-' d <- count 2 digit char ' ' h <- count 2 digit char ':' m <- count 2 digit char ':' s <- count 2 digit return $ LocalTime { localDay = fromGregorian (read y) (read mm) (read d) , localTimeOfDay = TimeOfDay (read h) (read m) (read s) }

-- | Parser of values of type 'Product'. productParser :: Parser Product productParser = (string "mouse" >> return Mouse) <|> (string "keyboard" >> return Keyboard) <|> (string "monitor" >> return Monitor) <|> (string "speakers" >> return Speakers)

-- | Parser of log entries. logEntryParser :: Parser LogEntry logEntryParser = do -- First, we read the time. t <- timeParser -- Followed by a space. char ' ' -- And then the IP of the client. ip <- parseIP -- Followed by another space. char ' ' -- Finally, we read the type of product. p <- productParser -- And we return the result as a value of type 'LogEntry'. return $ LogEntry t ip p

logParser :: Parser Log logParser = many $ logEntryParser <* endOfLine

-- Main main :: IO () main = do a <- B.readFile logFile print $ parseOnly logParser a

+END_SRC

+RESULTS:

:
Right [LogEntry {entryTime = 2013-06-29 11:16:23, entryIP = IP 124 67 34 60, entryProduct = Keyboard},LogEntry {entryTime = 2013-06-29 11:32:12, entryIP = IP 212 141 23 67, entryProduct = Mouse},LogEntry {entryTime = 2013-06-29 11:33:08, entryIP = IP 212 141 23 67, entryProduct = Monitor},LogEntry {entryTime = 2013-06-29 12:12:34, entryIP = IP 125 80 32 31, entryProduct = Speakers},LogEntry {entryTime = 2013-06-29 12:51:50, entryIP = IP 101 40 50 62, entryProduct = Keyboard},LogEntry {entryTime = 2013-06-29 13:10:45, entryIP = IP 103 29 60 13, entryProduct = Mouse}]

その 5 変更

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-}

import Data.Attoparsec.ByteString.Char8 import Control.Applicative

data Source = Internet | Friend | NoAnswer deriving Show

sourceParser :: Parser Source sourceParser = (string "internet" >> return Internet) <|> (string "friend" >> return Friend) <|> (string "noanswer" >> return NoAnswer)

main :: IO () main = print $ parseOnly sourceParser "internet"

+END_SRC

+RESULTS:

:
Right Internet

その 6

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} import Data.Word import Data.Time import Data.Attoparsec.ByteString.Char8 import Control.Applicative -- We import ByteString qualified because the function -- 'Data.ByteString.readFile' would clash with -- 'Prelude.readFile'. import qualified Data.ByteString as B


------ SETTINGS -------

-- | File where the log is stored. logFile :: FilePath logFile = "babel_haskell_selling.log"


-------- TYPES --------

-- | Type for IP's. data IP = IP Word8 Word8 Word8 Word8 deriving Show

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

data Source = Internet | Friend | NoAnswer deriving Show

-- show data LogEntry = LogEntry { entryTime :: LocalTime , entryIP :: IP , entryProduct :: Product -- Addition of the 'Source' field , source :: Source } deriving Show -- /show

type Log = [LogEntry]


------- PARSING -------

-- | Parser of values of type 'IP'. parseIP :: Parser IP parseIP = do d1 <- decimal char '.' d2 <- decimal char '.' d3 <- decimal char '.' d4 <- decimal return $ IP d1 d2 d3 d4

-- | Parser of values of type 'LocalTime'. timeParser :: Parser LocalTime timeParser = do y <- count 4 digit char '-' mm <- count 2 digit char '-' d <- count 2 digit char ' ' h <- count 2 digit char ':' m <- count 2 digit char ':' s <- count 2 digit return $ LocalTime { localDay = fromGregorian (read y) (read mm) (read d) , localTimeOfDay = TimeOfDay (read h) (read m) (read s) }

-- | Parser of values of type 'Product'. productParser :: Parser Product productParser = (string "mouse" >> return Mouse) <|> (string "keyboard" >> return Keyboard) <|> (string "monitor" >> return Monitor) <|> (string "speakers" >> return Speakers)

sourceParser :: Parser Source sourceParser = (string "internet" >> return Internet) <|> (string "friend" >> return Friend) <|> (string "noanswer" >> return NoAnswer)

-- show -- | Parser of log entries. logEntryParser :: Parser LogEntry logEntryParser = do t <- timeParser char ' ' ip <- parseIP char ' ' p <- productParser -- Addition of the 'Source' field char ' ' s <- sourceParser -- return $ LogEntry t ip p s -- /show

logParser :: Parser Log logParser = many $ logEntryParser <* endOfLine


-------- MAIN --------

main :: IO () main = B.readFile logFile >>= print . parseOnly logParser

+END_SRC

+RESULTS:

:
Right [LogEntry {entryTime = 2013-06-29 16:40:15, entryIP = IP 154 41 32 99, entryProduct = Monitor, source = Internet},LogEntry {entryTime = 2013-06-29 16:51:12, entryIP = IP 103 29 60 13, entryProduct = Keyboard, source = Internet},LogEntry {entryTime = 2013-06-29 17:13:21, entryIP = IP 121 95 68 21, entryProduct = Speakers, source = Friend},LogEntry {entryTime = 2013-06-29 18:20:10, entryIP = IP 190 80 70 60, entryProduct = Mouse, source = NoAnswer},LogEntry {entryTime = 2013-06-29 18:51:23, entryIP = IP 102 42 52 64, entryProduct = Speakers, source = Friend}]

その 7

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} import Data.Word import Data.Time import Data.Attoparsec.ByteString.Char8 import Control.Applicative -- We import ByteString qualified because the function -- 'Data.ByteString.readFile' would clash with -- 'Prelude.readFile'. import qualified Data.ByteString as B


------ SETTINGS -------

-- | File where the log is stored. logFile :: FilePath logFile = "babel_haskell_selling7.log"


-------- TYPES --------

-- | Type for IP's. data IP = IP Word8 Word8 Word8 Word8 deriving Show

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

data Source = Internet | Friend | NoAnswer deriving Show

data LogEntry = LogEntry { entryTime :: LocalTime , entryIP :: IP , entryProduct :: Product , source :: Source } deriving Show

type Log = [LogEntry]


------- PARSING -------

-- | Parser of values of type 'IP'. parseIP :: Parser IP parseIP = do d1 <- decimal char '.' d2 <- decimal char '.' d3 <- decimal char '.' d4 <- decimal return $ IP d1 d2 d3 d4

-- | Parser of values of type 'LocalTime'. timeParser :: Parser LocalTime timeParser = do y <- count 4 digit char '-' mm <- count 2 digit char '-' d <- count 2 digit char ' ' h <- count 2 digit char ':' m <- count 2 digit char ':' s <- count 2 digit return $ LocalTime { localDay = fromGregorian (read y) (read mm) (read d) , localTimeOfDay = TimeOfDay (read h) (read m) (read s) }

-- | Parser of values of type 'Product'. productParser :: Parser Product productParser = (string "mouse" >> return Mouse) <|> (string "keyboard" >> return Keyboard) <|> (string "monitor" >> return Monitor) <|> (string "speakers" >> return Speakers)

sourceParser :: Parser Source sourceParser = (string "internet" >> return Internet) <|> (string "friend" >> return Friend) <|> (string "noanswer" >> return NoAnswer)

-- show -- | Parser of log entries. logEntryParser :: Parser LogEntry logEntryParser = do t <- timeParser char ' ' ip <- parseIP char ' ' p <- productParser -- Look for the field 'Source' and return -- a default value ('NoAnswer') when missing. -- The arguments of 'option' are default value -- followed by the parser to try. s <- option NoAnswer $ char ' ' >> sourceParser -- return $ LogEntry t ip p s -- /show

logParser :: Parser Log logParser = many $ logEntryParser <* endOfLine


-------- MAIN --------

main :: IO () main = do a <- B.readFile logFile print $ parseOnly logParser a

+END_SRC

+RESULTS:

:
Right [LogEntry {entryTime = 2013-06-29 11:16:23, entryIP = IP 124 67 34 60, entryProduct = Keyboard, source = NoAnswer},LogEntry {entryTime = 2013-06-29 11:32:12, entryIP = IP 212 141 23 67, entryProduct = Mouse, source = NoAnswer},LogEntry {entryTime = 2013-06-29 11:33:08, entryIP = IP 212 141 23 67, entryProduct = Monitor, source = NoAnswer},LogEntry {entryTime = 2013-06-29 12:12:34, entryIP = IP 125 80 32 31, entryProduct = Speakers, source = NoAnswer},LogEntry {entryTime = 2013-06-29 12:51:50, entryIP = IP 101 40 50 62, entryProduct = Keyboard, source = NoAnswer},LogEntry {entryTime = 2013-06-29 13:10:45, entryIP = IP 103 29 60 13, entryProduct = Mouse, source = NoAnswer},LogEntry {entryTime = 2013-06-29 16:40:15, entryIP = IP 154 41 32 99, entryProduct = Monitor, source = Internet},LogEntry {entryTime = 2013-06-29 16:51:12, entryIP = IP 103 29 60 13, entryProduct = Keyboard, source = Internet},LogEntry {entryTime = 2013-06-29 17:13:21, entryIP = IP 121 95 68 21, entryProduct = Speakers, source = Friend},LogEntry {entryTime = 2013-06-29 18:20:10, entryIP = IP 190 80 70 60, entryProduct = Mouse, source = NoAnswer},LogEntry {entryTime = 2013-06-29 18:51:23, entryIP = IP 102 42 52 64, entryProduct = Speakers, source = Friend}]

その 8

+BEGIN_SRC haskell :results output

-- | Different kind of products are numbered from 1 to 4, in the given -- order. data Product = Mouse | Keyboard | Monitor | Speakers deriving (Enum,Show)

productFromID :: Int -> Product productFromID n = toEnum (n-1)

productToID :: Product -> Int productToID p = fromEnum p + 1

main :: IO () main = do print $ productFromID 1 print $ productFromID 3 print $ productToID Keyboard print $ productToID $ productFromID 4

+END_SRC

+RESULTS:

:
Mouse
Monitor
2
4

その 9

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} import Data.Attoparsec.ByteString.Char8 import Control.Applicative

data Product = Mouse | Keyboard | Monitor | Speakers deriving (Enum,Show)

productFromID :: Int -> Product productFromID n = toEnum (n-1)

-- show productParser2 :: Parser Product productParser2 = productFromID . read . (:[]) <$> digit

main :: IO () main = print $ parseOnly productParser2 "4"

+END_SRC

+RESULTS:

:
Right Speakers

その 10

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} import Data.Time import Data.Attoparsec.ByteString.Char8

timeParser2 :: Parser LocalTime timeParser2 = do d <- count 2 digit char '/' mm <- count 2 digit char '/' y <- count 4 digit char ' ' h <- count 2 digit char ':' m <- count 2 digit char ':' s <- count 2 digit return $ LocalTime { localDay = fromGregorian (read y) (read mm) (read d) , localTimeOfDay = TimeOfDay (read h) (read m) (read s) }

main :: IO () main = print $ parseOnly timeParser2 "29/06/2013 15:32:23"

+END_SRC

+RESULTS:

:
Right 2013-06-29 15:32:23

その 11

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-}

import Data.Word import Data.Time import Data.Attoparsec.ByteString.Char8 import Control.Applicative


-------- TYPES --------

-- | Type for IP's. data IP = IP Word8 Word8 Word8 Word8 deriving Show

data Product = Mouse | Keyboard | Monitor | Speakers deriving (Show,Enum)

productFromID :: Int -> Product productFromID n = toEnum (n-1)

data Source = Internet | Friend | NoAnswer deriving Show

data LogEntry = LogEntry { entryTime :: LocalTime , entryIP :: IP , entryProduct :: Product , source :: Source } deriving Show

type Log = [LogEntry]


------- PARSING -------

-- | Parser of values of type 'IP'. parseIP :: Parser IP parseIP = do d1 <- decimal char '.' d2 <- decimal char '.' d3 <- decimal char '.' d4 <- decimal return $ IP d1 d2 d3 d4

timeParser2 :: Parser LocalTime timeParser2 = do d <- count 2 digit char '/' mm <- count 2 digit char '/' y <- count 4 digit char ' ' h <- count 2 digit char ':' m <- count 2 digit char ':' s <- count 2 digit return $ LocalTime { localDay = fromGregorian (read y) (read mm) (read d) , localTimeOfDay = TimeOfDay (read h) (read m) (read s) }

productParser2 :: Parser Product productParser2 = productFromID . read . (:[]) <$> digit

sourceParser :: Parser Source sourceParser = (string "internet" >> return Internet) <|> (string "friend" >> return Friend) <|> (string "noanswer" >> return NoAnswer)

-- show logEntryParser2 :: Parser LogEntry logEntryParser2 = do ip <- parseIP char ' ' t <- timeParser2 char ' ' p <- productParser2 char ' ' s <- sourceParser return $ LogEntry t ip p s

main :: IO () main = print $ parseOnly logEntryParser2 "54.41.32.99 29/06/2013 15:32:23 4 internet"

+END_SRC

+RESULTS:

:
Right (LogEntry {entryTime = 2013-06-29 15:32:23, entryIP = IP 54 41 32 99, entryProduct = Speakers, source = Internet})

ごく単純な置換

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-}

import Data.Attoparsec.Text import Control.Applicative

data Product = Mouse | Keyboard | Monitor | Speakers deriving Show

productParser :: Parser Product productParser = (string "mouse" >> return Mouse) <|> (string "keyboard" >> return Keyboard) <|> (string "monitor" >> return Monitor) <|> (string "speakers" >> return Speakers)

main :: IO () main = do print $ parseOnly productParser "mouse" print $ parseOnly productParser "mouze" print $ parseOnly productParser "monitor" print $ parseOnly productParser "keyboard"

+END_SRC

+RESULTS:

:
Right Mouse
Left "string"
Right Monitor
Right Keyboard

サンプル

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} -- stack install attoparsec

import qualified Data.Text as T -- 重複を防ぐ import qualified Data.Text.IO as TIO -- 重複を防ぐ import Data.Attoparsec.Text hiding (take) import Control.Applicative

quotedText :: Parser T.Text quotedText = char '{' > takeTill (== '}') < char '}'

labeledName :: Parser T.Text labeledName = manyTill anyChar "\label" *> quotedText

texLabelParser = manyTill anyChar "\label" > char '{' > takeTill (== '}') <* char '}'

main :: IO () main = do print $ parse texLabelParser "name:\label{Yamada Ichiro}" feed ""

+END_SRC

+RESULTS:

:
Done "" "Yamada Ichiro"

サンプル

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} -- stack install attoparsec

import qualified Data.Text as T -- 重複を防ぐ import qualified Data.Text.IO as TIO -- 重複を防ぐ import Data.Attoparsec.Text hiding (take) import Control.Applicative

data SimpleDate = SimpleDate { year :: Int , month :: Int , day :: Int } deriving (Eq, Ord, Show, Read)

simpleDate :: Parser SimpleDate simpleDate = SimpleDate <$> (read <$> (count 4 digit)) < char '/' <> (read <$> (count 2 digit)) < char '/' <> (read <$> (count 2 digit))

labeledBirthday :: Parser SimpleDate labeledBirthday = "birthday:" *> simpleDate

main :: IO () main = do print $ parse labeledBirthday "birthday:2016/11/01" feed ""

+END_SRC

+RESULTS:

:
Done "" (SimpleDate {year = 2016, month = 11, day = 1})

サンプル

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} -- stack install attoparsec

import qualified Data.Text as T -- 重複を防ぐ import qualified Data.Text.IO as TIO -- 重複を防ぐ import Data.Attoparsec.Text hiding (take) import Control.Applicative

data Term = Add Expr deriving Show data Expr = ExTerm Double Term | ExEnd Double deriving Show

termParser :: Parser Term termParser = addParser where addParser :: Parser Term addParser = Add <$ char '+' <*> exprParser

exprParser :: Parser Expr exprParser = ExTerm <$> double <*> termParser <|> ExEnd <$> double

main :: IO () main = do print $ parse (exprParser <* endOfInput) "1+2+3" feed ""

+END_SRC

+RESULTS:

:
Done "" (ExTerm 1.0 (Add (ExTerm 2.0 (Add (ExEnd 3.0)))))

サンプル

+BEGIN_SRC haskell :results output

{-# LANGUAGE OverloadedStrings #-} -- stack install attoparsec

import qualified Data.Text as T import Data.Attoparsec.Text hiding (take) import Control.Applicative

data YMD = YMD Int Int Int deriving Show data HMS = HMS Int Int Int deriving Show

ymdParser :: Parser YMD ymdParser = YMD <$> (countRead 4 digit <?> "Year") < (char '/' <?> "Delim Y/M") <> (countRead 2 digit <?> "Month") < (char '/' <?> "Delim M/D") <> (countRead 2 digit <?> "Day")

hmsParser :: Parser HMS hmsParser = HMS <$> (countRead 2 digit <?> "Hour") < (char ':' <?> "Delim H:M") <> (countRead 2 digit <?> "Minute") < (char ':' <?> "Delim M:S") <> (countRead 2 digit <?> "Second")

dateTimeParser :: Parser (YMD, HMS) dateTimeParser = (,) <$> (ymdParser <?> "YMD") < (char ' ' <?> "space") <> (hmsParser <?> "HMS")

countRead :: Read a => Int -> Parser Char -> Parser a countRead i = fmap read . count i

main :: IO () main = do print $ parse (dateTimeParser < endOfInput) "2018/08/21hoge 12:00:00" feed "" print $ parse (dateTimeParser < endOfInput) "2018/08/21 12:00.00" feed "" print $ parse (dateTimeParser <* endOfInput) "2018/08/21 12:00:00" feed ""

+END_SRC

+RESULTS:

:
Fail "hoge 12:00:00" ["space","' '"] "Failed reading: satisfy"
Fail ".00" ["HMS","Delim M:S","':'"] "Failed reading: satisfy"
Done "" (YMD 2018 8 21,HMS 12 0 0)

プラグマ設定をオフにする

{-# OPTIONS_GHC -Wno-unused-top-binds #-}

文字列のリストを文字列に変換

リストを文字列へ戻すには 改行区切りなら unlines, 空白区切りなら unwords を使います. 適当な文字列で連結するには intercalate です.

import Data.List

css = ["hoge","piyo","fuga"]

main = do
  putStrLn $ unlines css
  putStrLn $ unwords css

  putStrLn $ intercalate "?" css

逆に文字列をリストへ分割したいなら, lines, words, "splitRegex" を使いましょう.

ライブラリのインストール

cabal install --lib [library-name]

cabal install --lib vector
cabal install --lib mtl

リストのリストをフラットにする

割り算はかけ算で