Hatena::Grouphaskell

Haskellで遊ぶよ

|

2009-05-31

関数のリストを、1つの演算対象に作用させた結果のリストを作る関数

01:34

↑タイトルだとよくわからんけど、こういう関数は標準で無いのかなあ?

foo :: [(a -> b)] -> a -> [b]
foo fs x = map (\f -> f x) fs

ありそうだけど、無い気もする。だって、これだと引数が増える度に別の関数を作らないといけないから。

bar :: [(a -> b -> c)] -> a -> b -> [c]
bar fs x y = map (\f -> f x y) fs

Otter_OOtter_O2009/06/06 06:10はじめましてOtter_Oと申します。

標準関数はよく知らないですが、Control.Applicativeの考え方を使うと新しい関数を定義しなくてもパラメタの数の違う関数を取り扱うことができます。


module Main where

import Control.Applicative

fs = [(1 +), (1 -)]
fs2 = [(+), (-)]

zipApp :: [(a->b)] -> a -> [b]
zipApp fs v = getZipList $ (ZipList fs) <*> (pure v)

main = do
print $ fs `zipApp` 1 --パラメタひとつ
print $ fs2 `zipApp` 5 `zipApp` 3 --パラメタ2つ

ちょっと古いですが、http://d.hatena.ne.jp/Otter_O/20080228/1204187600でApplicativeのことを勉強したときのメモがあります。よかったら参考にしてみてください。

ではでは。

トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20090531

2009-05-27

Haskellで数独

10:12

Mathematica で数独を解くプログラムが10行で書けるらしい。

search[x_] := Or[ goal@x, deepen@x]
goal[x_] := And[Not@MemberQ[x, 0, 2], report@x]
report[x_] := (Print[x // TableForm]; True)
deepen[x_] := With[{pos = First@Position[x, 0]}, 
  Or @@ Map[search, (ReplacePart[x, pos -> #] & /@ candidates[x, pos])]]
candidates[board_, {i_, j_}] := Complement[Range[1, 9],
  board[[i]],
  board[[Range[1, 9], j]],
  Flatten[Take[board, 3 Ceiling[i/3] - {2, 0}, 3 Ceiling[j/3] - {2, 0}]]]
$RecursionLimit = Infinity;
数独で見るRuby(とMathematica)のパワーと表現力 by Inquisitor

かなり暗号。でも関数型言語っぽい。じゃあ Haskell でどうなるかやってみよう。


search

探索は、ゴールであるなら終了し、そうでない場合は次を探す。

search[x_] := Or[ goal@x, deepen@x]

search :: [[Integer]] -> Bool
search xss = goal xss || deepen xss

型宣言は無くてもいいけど、あったほうがわかりやすいのでとりあえず付けておいた。


goal

ゴールは全部の升がゼロでなくなったとき。その場合は最終の盤面を報告する。

goal[x_] := And[Not@MemberQ[x, 0, 2], report@x]

all2d :: (a -> Bool) -> [[a]] -> Bool
all2d f xss = all (all f) xss

goal :: [[Integer]] -> Bool
goal xss = all2d (/=0) xss && report xss

all を2次元に拡張した all2d を使う。


report

報告。

report[x_] := (Print[x // TableForm]; True)

import Debug.Trace

report :: Show a => [[a]] -> Bool -- always True
report xss = all (\xs -> (trace.show) xs True ) xss && (trace.show.signum.head.head) xss True

trace の使い方が難しい。

何が難しいかって、そのまま出力してしまうと次の出力との境目が分からなくなってしまうので、区切りを入れようと思うのだけど、

&& trace "---" True 

とやると、GHC でコンパイルした場合は最初の一回だけしか "---" が出力されない。

最初の評価時に「trace "---" True = True という値」がキャッシュされてしまって、次からは出力せずに True を返すだけになってしまうから。

「毎回別の関数ですよ」ということを伝えるために

&& (trace.show.signum.head.head) xss True

と書いた。残念ながら、区切りとしては "---" ではなく "1" などが出力されることになる。


deepen

次 (より深く) を探す関数。まだゼロである要素に、その場所に入りうる数字の候補 (candidates) を一つずつ入れて、search 関数を実行する。

deepen[x_] := With[{pos = First@Position[x, 0]}, 
  Or @@ Map[search, (ReplacePart[x, pos -> #] & /@ candidates[x, pos])]]

import List

replacePart :: (Int,Int) -> a -> [[a]] -> [[a]]
replacePart (i,j) x xss = concat [ take i xss , [xs'] , drop (i+1) xss ]
    where
        xs' = concat [ take j xs , [x] , drop (j+1) xs ]
        xs = xss !! i

deepen :: [[Integer]] -> Bool
deepen xss = checkall search [replacePart ij x xss | x <- candidates ij xss]
    where 
        ij = head $ head [[(i,j) | (x,j) <- zip xs [0..] , (==0) x ] | (xs,i) <- zip xss [0..] , (any (==0)) xs ]
        checkall f xs = all (\x -> f x || True) xs

ij というのは (i,j) という座標のタプルで、xss というテーブルから、値がゼロな要素の座標を探すのが次のリスト内包表記

[[(i,j) | (x,j) <- zip xs [0..] , (==0) x ] | (xs,i) <- zip xss [0..] , (any (==0)) xs ]

(x,i) <- zip xs [0..] というのは Python でいうところの enumerate、または Ruby でいうところの each_with_index のようなもので、Haskell の findIndices のソースから拝借した。

deepen 関数は goal 関数が Flase のときのみ実行される。つまり値がゼロな要素が一つ以上存在することがわかっているので、Maybe を考える必要はない。


checkall というのはリストの全要素に対して「Bool 型を返す関数」(この場合は search) を実行しつつ、自身も Bool 型を返す関数としてでっち上げたもの。

Mathematica のほうの解説では「「Or @@ Map」なので、すべての解を求めます」と書かれているが、Haskell で普通に or.map とやると、最初に現れる解しか求めない。( Or @@ Map とは結局何なんだろう?)

だから適当にでっち上げたというわけ。


candidates

テーブルの上の与えられた座標から、その要素を含む行と列と箱 (3x3 の) を抜き出し、1から9までの数字のうちでそれらの中に含まれないものを返す。

candidates[board_, {i_, j_}] := Complement[Range[1, 9],
  board[[i]],
  board[[Range[1, 9], j]],
  Flatten[Take[board, 3 Ceiling[i/3] - {2, 0}, 3 Ceiling[j/3] - {2, 0}]]]

containingRow :: (Int,Int) -> [[a]] -> [a]
containingRow (i,_) xss = xss !! i

containingCol :: (Int,Int) -> [[a]] -> [a]
containingCol (_,j) xss = [ (xss !! i) !! j | i <- [0..8] ]

containingBox :: (Int,Int) -> [[a]] -> [a]
containingBox (i,j) xss = [(xss !! ii) !! jj | ii <- [i0..(i0+2)], jj <- [j0..(j0+2)]]
    where
        i0 = 3 * (i `div` 3)
        j0 = 3 * (j `div` 3)

candidates :: (Int,Int) -> [[Integer]] -> [Integer]
candidates ij xss = [n | n <- [1..9] , all (notElem n) [row, box, col] ]
    where
        row = containingRow ij xss
        box = containingBox ij xss
        col = containingCol ij xss

まとめ

型宣言などを除くとだいたい25行以内に収まった。

import List
import Debug.Trace
all2d f xss = all (all f) xss
replacePart (i,j) x xss = concat [ take i xss , [xs'] , drop (i+1) xss ]
    where
        xs' = concat [ take j xs , [x] , drop (j+1) xs ]
        xs = xss !! i
containingRow (i,_) xss = xss !! i
containingCol (_,j) xss = [ (xss !! i) !! j | i <- [0..8] ]
containingBox (i,j) xss = [(xss !! ii) !! jj | ii <- [i0..(i0+2)], jj <- [j0..(j0+2)]]
    where
        i0 = 3 * (i `div` 3)
        j0 = 3 * (j `div` 3)

search xss = goal xss || deepen xss
goal xss = all2d (/=0) xss && report xss
report xss = all (\xs -> (trace.show) xs True ) xss && (trace.show.signum.head.head) xss True
deepen xss = checkall search [replacePart ij x xss | x <- candidates ij xss]
    where 
        ij = head $ head [[(i,j) | (x,j) <- zip xs [0..] , (==0) x ] | (xs,i) <- zip xss [0..] , (any (==0)) xs ]
        checkall f xs = all (\x -> f x || True) xs
candidates ij xss = [n | n <- [1..9] , all (notElem n) [row, box, col] ]
    where
        row = containingRow ij xss
        box = containingBox ij xss
        col = containingCol ij xss

Mathematica は2次元以上の配列が扱いやすそうと思った。あと Complement が便利そう。


実行

上のコードの下に以下を追加して実行。

table= [
    [1,0,0,0,0,7,0,9,0],
    [0,3,0,0,2,0,0,0,8],
    [0,0,9,6,0,0,5,0,0],
    [0,0,5,3,0,0,9,0,0],
    [0,1,0,0,8,0,0,0,2],
    [6,0,0,0,0,4,0,0,0],
    [3,0,0,0,0,0,0,1,0],
    [0,4,0,0,0,0,0,0,7],
    [0,0,7,0,0,0,3,0,0]]

main = print $ search table
% ghc -o sudoku sudoku.hs && ./sudoku
[1,6,2,8,5,7,4,9,3]
[5,3,4,1,2,9,6,7,8]
[7,8,9,6,4,3,5,2,1]
[4,7,5,3,1,2,9,8,6]
[9,1,3,5,8,6,7,4,2]
[6,2,8,7,9,4,1,3,5]
[3,5,6,4,7,8,2,1,9]
[2,4,1,9,3,5,8,6,7]
[8,9,7,2,6,1,3,5,4]
1
True

計算は一瞬。


一番左上の 1 を 0 に変えて実行すると、

% ghc -o sudoku sudoku.hs && ./sudoku
[1,6,2,8,5,7,4,9,3]
[5,3,4,1,2,9,6,7,8]
[7,8,9,6,4,3,5,2,1]
[4,7,5,3,1,2,9,8,6]
[9,1,3,5,8,6,7,4,2]
[6,2,8,7,9,4,1,3,5]
[3,5,6,4,7,8,2,1,9]
[2,4,1,9,3,5,8,6,7]
[8,9,7,2,6,1,3,5,4]
1
[2,5,1,8,4,7,6,9,3]
[4,3,6,9,2,5,1,7,8]
[7,8,9,6,1,3,5,2,4]
[8,2,5,3,7,1,9,4,6]
[9,1,4,5,8,6,7,3,2]
[6,7,3,2,9,4,8,5,1]
[3,6,2,7,5,8,4,1,9]
[5,4,8,1,3,9,2,6,7]
[1,9,7,4,6,2,3,8,5]
1
[2,5,1,8,4,7,6,9,3]
[4,3,6,9,2,5,1,7,8]
[7,8,9,6,1,3,5,2,4]
[8,2,5,3,7,1,9,4,6]
[9,1,4,5,8,6,7,3,2]
[6,7,3,2,9,4,8,5,1]
[3,9,2,7,6,8,4,1,5]
[5,4,8,1,3,9,2,6,7]
[1,6,7,4,5,2,3,8,9]
1
:
(以下略)

となる。

yabukiyabuki2009/05/27 11:00こんにちは

> Or @@ Map とは結局何なんだろう?

Or @@ Map[f, list]は、listの要素にfを作用させた結果の論理和です。
正式には、Apply[Or, Map[f, list]]と書きます。

Mathematicaは遅延評価ではないので、まずMap[f, list]が完成してからそのOrをとります。

おそらくHaskellでは、listの要素にfを作用させるたびにOrが評価され、
一度真になれば、listのその先は評価されなくなるのではないでしょうか(遅延評価)。

(移植していただけるなら、幅優先探索にも対応できる汎用版を紹介すべきだったかもしれません。)

edvakfedvakf2009/05/27 11:12なるほど。おっしゃる通り、Haskell では or.map で一度 False になるとそれ以降は評価しません。

幅優先探索というのもぜひブログに書いてください >_<

トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20090527

2009-05-23

16進数から10進数の変換

08:29

16進数を10進数に変換してください。

ただし、入出力は文字列とし、次の変換は最低必ずできなければいけないこととします。

1. 0x12437308CCB6 →20080902065334

2. 0x2C9C1227FC6520B →200904012311450123

あわせて、扱える最大の整数も明らかにしてください。

16進数から10進数の変換 DouKaku?
hex1 :: Char -> Integer
hex1 x = case x of
    '0' -> 0
    '1' -> 1
    '2' -> 2
    '3' -> 3
    '4' -> 4
    '5' -> 5
    '6' -> 6
    '7' -> 7
    '8' -> 8
    '9' -> 9
    'A' -> 10
    'B' -> 11
    'C' -> 12
    'D' -> 13
    'E' -> 14
    'F' -> 15

hex2dec :: [Char] -> [Char]
hex2dec xs = show $ foldl (\d h -> d*16 + hex1 h) 0 hexstr
    where hexstr = tail $ tail xs

hugs で 確認。

Main> hex2dec "0x12437308CCB6"
"20080902065334"
Main> hex2dec "0x2C9C1227FC6520B"
"200904012311450123"

おっけい。

確か Integer はメモリの許す限り大きな整数が扱えたはず。


気になるところ

  • 最初に無駄な 0*16 が行われていること。

rst76rst762009/05/23 22:25これでどうでしょう?
hex2dec xs = show $ foldl1 (\d h -> d*16 + h) $ map hex1 hexstr
ちょっとずるいですが、こういうのも書けます。
import Numeric
hex2dec = show . fst . head . readHex . drop 2

edvakfedvakf2009/05/24 01:19Haskell グループはコメントが多くてすばらしいですね!

map して fold すると for(i=0; i<n; i++) 相当のことが2度行われるという感覚があったのですが、関数型言語ではたぶん違いますね。そういえば。

drop 2 使えますね。失念していました。

readHex のほうも見てみました。

http://www.sampou.org/haskell/report-revised-j/numeric.html

readHex = readInt 16 isHexDigit digitToInt

readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt radix isDig digToInt s =
[(foldl1 (\n d -> n * radix + d) (map (fromIntegral . digToInt) ds), r) | (ds,r) <- nonnull isDig s ]


http://www.sampou.org/haskell/report-revised-j/char.html

digitToInt :: Char -> Int
digitToInt c
| isDigit c = fromEnum c - fromEnum '0'
| c >= 'a' && c <= 'f' = fromEnum c - fromEnum 'a' + 10
| c >= 'A' && c <= 'F' = fromEnum c - fromEnum 'A' + 10
| otherwise = error "Char.digitToInt: not a digit"


やり方は rst76 さんの map を使う方法と同じですね。fromEnum などを使う分オーバーヘッドが大きいかなという気もしますが。

トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20090523

2009-05-16

sqrt(2)を計算してみる

15:39

1 2 5 12 29 70 169 408 985 ...
  次の数を求めるには、今の数を2倍して、前の数を足す。
  例:5の次は... 5 × 2 + 2 = 12
  √2 ≒ 408 ÷ 985 + 1 = 1.4142131979
ベジェ曲線がわかった! - ザリガニが見ていた...。

というのを見たので、やってみた。

まず、

sqrt2gen = generate (1,2)
    where
        generate (x,y) = x : generate (y, y*2+x)

main = print $ take 25 sqrt2gen
[1,2,5,12,29,70,169,408,985,2378,5741,13860,33461,80782,195025,470832,1136689,2744210,6625109,15994428,38613965,93222358,225058681,543339720,1311738121]

出力が見にくいです。これを

1
2
5
12
:

というふうに出力させるにはどうしたらいいんだろう?

次にこの sqrt2gen を使って、

main = print $ zipWith (\y x -> fromIntegral(y) / fromIntegral(x) + 1.0) ys xs
    where
        xs = take 25 sqrt2gen
        ys = 0 : xs

結果。(しょうがないので ruby で整形)

% runhugs sqrt2gen.hs | ruby -ne 'eval($_).each{|x| puts x}' 
1.0
1.5
1.4
1.41666666666667
1.41379310344828
1.41428571428571
1.41420118343195
1.41421568627451
1.41421319796954
1.41421362489487
1.41421355164605
1.41421356421356
1.41421356205732
1.41421356242727
1.4142135623638
1.41421356237469
1.41421356237282
1.41421356237314
1.41421356237309
1.4142135623731
1.41421356237309
1.4142135623731
1.41421356237309
1.41421356237309
1.41421356237309

1.41421356237309 で飽和。


Wikipediaによると

1.41421 35623 73095 04880 ...

と続くらしい。

それはいいとして、Wikipedia にこんな漸化式が書いてあった。

a(0) = 1
a(n+1) = a(n)/2 + 1/a(n)

ほうほう。これもやってみる。

sqrt2recurrence 0 = 1
sqrt2recurrence n = m / 2.0 + 1.0 / m
    where
        m = sqrt2recurrence $ n - 1

main = print $ map sqrt2recurrence [1..5]
% runhugs sqrt2recurrence.hs | ruby -ne 'eval($_).each{|x| puts x}'
1.5
1.41666666666667
1.41421568627451
1.41421356237469
1.41421356237309

明らかにこっちのほうが収束が速い。


思ったこと

Haskell で 1.41421356237309 より正確な少数を扱うにはどうしたらいいんだろう?

takatohtakatoh2009/05/16 18:08>出力が見にくいです。

main = mapM_ print $ take 25 sqrt2gen

かな。

edvakfedvakf2009/05/17 01:41できました。mapM でもいいみたいですね。
まだモナドとかよくわかってないので理解できてませんが、また勉強します。

トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20090516

2009-05-07

急勾配の判定

14:39

有限の長さの数列で,各要素の値が,その要素の後ろにある残りの列に含まれるすべての要素の和よりも大きい列を「急勾配の列」ということにします(空列の和は0とします).

任意の長さ(ただし有限の長さの)数列を与えられたとき,それが「急勾配の列」であるかどうかを判定する述語関数を定義してください.

必須ではありませんが,効率についてコメントがあれば面白いかもしれませんね.

急勾配の判定 DouKaku?

最初に書いたのがこれ。

steep xs = fst $ foldr _steep (True, 0) xs
    where  
        -- _steep returns tuple of boolean (if the rest has been steep) and the sum of the rest
        _steep _ (False, _) = (False,0)
        _steep x (True,sum)
            | x > sum   = (True, sum + x)
            | otherwise = (False, 0)

foldr や foldl で配列の要素の型では無い型 (特に Bool などが多い) を返すときは、自分で書くときはよくタプルを受け継ぐようにするのだけど、どうも無駄な部分が多い気がする。

あと、問題では「正の」数列とは書いていないので、 数列の一番最後が負数かもしれず、その場合にこれでは False になってしまう。

次に考えたのがこれ。


steep xs = not $ isInfinite $ foldr1 _steep xs
    where
        _steep x sum
            | isInfinite(sum) = sum
            | x > sum         = sum + x
            | otherwise       = 1/0

ちょっとすっきりしたようにも思うが、一度 sum = Infinite となった後も isInfinite が毎回呼ばれているのでたぶん最初のほうが効率がいい。


しかしスマートじゃないなあ。

本当はリストの内包表記とかで1行とかで書けたりするんだろうか?

トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20090507
|