2010年03月18日 木曜日
■ [文法][fromC/C++]基本文法(fmap、data)
{-# LANGUAGE UnicodeSyntax #-} -- fmapって2引数タプルやEitherにも使えるんだ...知らなかった。 -- というか、2引数タプルやEitherはFunctorクラスのインスタンスなんだ... test1 = fmap (+ 5) (1, 2) -- 第2要素にだけ適用される... -- $> test1 -- (1,7) test2 = fmap (+ 5) (Left 2) test3 = fmap (+ 5) (Right 1) -- Rightにだけ適用される... -- $> test2 -- Left 2 -- $> test3 -- Right 6 -- 代数的データ型と型クラスに関しては、よくわからない。C++のイメージとはちょっと違う。 -- C++っぽいネーミングにしてみた... -- 代数的データ型はコンストラクタのみ定義できるC++の構造体みたいな感じ、 -- Cの構造体(or 列挙型)に近いかも... -- 他のメンバ関数(メソッド)は定義できない... data IChar a ⇒ CString a = CString [a] deriving (Show, Eq, Ord) -- 型クラスはC++のinterfaceのようだけど、微妙に違う... -- 型変数はギリシャ文字の順番(α, β ⋯ == a, b ⋯)の順で使うのが慣習らしいとどっかで読んだ気がする... class IChar a where toChar ∷ a → Char class IString a where strcat ∷ a → a → a -- Haskellだと、この時点ではCStringとIStringは全く関係がないようだ。C++でも関係ないと言えば -- 関係ないけど、普通はCStringがIStringを継承してると思う。つまり、型とメンバ関数が -- 基本的にセットになっている → オブジェクト指向... -- セットになっていると便利だけど、使わないのに仮想関数を定義する必要があったり、 -- 後から足すのが面倒くさい(デザインパターンのAdapterパターン？で誤魔化すらしい。 -- 自分はCOM関連以外は基本的に多重継承しないのでよくわからないけど...) -- Haskellではインスタンス宣言して、やっと関連が付く。つまり、必要な機能だけ後付けできる... instance IChar Char where toChar c = c instance IChar a ⇒ IString (CString a) where (CString s1) `strcat` (CString s2) = CString (s1 ++ s2) -- 型シグネチャ宣言や型注釈で⇒の左側に来るのは文脈(context = 型クラス 型変数)、右側は型変数とか型構築子 -- データ構築子は宣言には現れない... -- add ∷ Num a ⇒ a → a → a -- strcat ∷ CString → CString → CString -- 用語.. 構築子と構成子は同じらしく、共にconstructorの訳らしい。紛らわしいなぁ。 -- 型構築子はtype constructor、データ構築子はdata constructor... -- 役には立たないけど、意味はわかりやすいかな... data Object = Object deriving Show data Executable = Executable deriving Show data Language = Language { label ∷ String , compiler ∷ String → [Object] , linker ∷ [Object] → Executable } class Tool a where compile ∷ (a, String) → (a, [Object]) link ∷ (a, [Object]) → Executable build ∷ (a, String) → Executable instance Tool Language where compile (a, s) = (a, compiler a $ s) link (a, xs) = linker a $ xs build = link . compile instance Show Language where show a = label a -- 使ってみよう... main = do let cpp = Language "C++" (const []) (const Executable) print cpp print $ build (cpp, "int main(){return 0;}") -- $> main -- C++ -- Executable -- (0.00 secs, 525292 bytes)
型について勉強していくと、戻ってこれない気がする...
あと、よく考えたら、Languageにlinkerは要らないな...
まとめると、Haskellでは代数的データ型と型クラスは明確に区別されているようだ(名前空間は同じっぽいけど...)。C++はオブジェクト指向だけあって、Haskellでいう代数的データ型を逆に型クラスの様に扱うこともできる(予め、統合されてるから。ポインタや参照を扱う場合などは特に顕著、ちょっと言い過ぎだけど)。
だから？
Haskellの型をC++のコンテキストで理解しようとすると、いつかドツボにハマる...んじゃないかなと思った。逆にGHCの言語拡張を駆使すれば、代数的データ型と型クラスの関係をC++のオブジェクトの様に扱える気はする。
ただ、言語拡張を使い過ぎると、型推論が弱くなると思うのでもう少し慣れてから...
地道にやっていこう...
■ [アルゴリズム]ペル方程式
"http://www004.upp.so-net.ne.jp/s_honma/"
の備忘録→ペル方程式のアルゴリズムを参考にペル方程式を解いてみた。
利用したのは、上述のHPに記載されていた2つの定理。こんなの知らなきゃ無理...
アルゴリズムは確定しているので、どうやって定義(実装)するかだけだけど...
{-# LANGUAGE UnicodeSyntax #-} module PellEquation ( Root (..) , solvePellEquation, solvePellEquation' ) where import Control.Arrow ((&&&), (***)) import Data.Ratio (numerator) -- 簡単に平方根の計算ができた方がいいかと思ったので... -- 複雑な計算はMathematicaとかに任せよう... data (Integral a, RealFrac b) ⇒ Root a b = Root a (b, b) deriving (Eq, Show) -- よく考えたら、hasSameRootが間違ってる... -- rが1の時はに計算が変わってしまう。言語拡張(PatternGuard)を使って、rとr'の最大値を -- Maybeで返すようにしないといけなかった... -- → 修正...(maxで十分ぽい) instance (Integral a, RealFrac b) ⇒ Fractional (Root a b) where (/) x@(Root r (a, b)) (Root r' (a', b')) | hasSameRoot r r' = Root (max r r') ((a'' / d), (b'' / d)) | otherwise = error $ "(/): Not the same root." where Root _ (a'', b'') = x * Root r' (a', (negate b')) d = a' ^ 2 - b' ^ 2 * fromIntegral r' fromRational x = Root 1 (fromRational x, 0) instance (Integral a, RealFrac b) ⇒ Num (Root a b) where (+) (Root r (a, b)) (Root r' (a', b')) | hasSameRoot r r' = Root (max r r') (a + a', b + b') | otherwise = error $ "(+): Not the same root." (*) (Root r (a, b)) (Root r' (a', b')) | hasSameRoot r r' = Root (max r r') (a * a' + b * b' * fromIntegral (max r r'), a * b' + b * a') | otherwise = error $ "(*): Not the same root." negate (Root r (a, b)) = Root r (negate a, negate b) abs x@(Root r _) | signum x == mRoot r = negate x | otherwise = x signum (Root r (a, b)) | a == 0 && b == 0 = zRoot r | signum a >= 0 && signum b >= 0 = pRoot r | signum a <= 0 && signum b <= 0 = mRoot r | otherwise = if signum a * a ^ 2 + signum b * b ^ 2 * fromIntegral r >= 0 then pRoot r else mRoot r fromInteger x = Root 1 (fromIntegral x, 0) mRoot r = Root r (negate 1, negate 1) zRoot r = Root r ( 0, 0) pRoot r = Root r ( 1, 1) hasSameRoot r r' = r == 1 || r' == 1 || r == r' -- ペル方程式(x ^ 2 - d * y ^ 2 = 1)を満たす最小解を返す。 -- ペル方程式の解の冪乗は全て解になる。 -- 引数dに2の冪乗(平方数)は指定できない... solvePellEquation ∷ Integer → Root Integer Rational solvePellEquation d = let a@(Root _ r) = solvePellEquation' d (x, y) = (numerator *** numerator) r in -- 解が-1の方なら2乗して+1の方を返す。 if x ^ 2 - d * y ^ 2 == -1 then a ^ 2 else a -- abs (x ^ 2 - d * y ^ 2) = 1の最小解を返す。 -- -1の解は存在しない場合がある。 -- -1の解をaとする時、次の解を得るには、a ^ 2を掛ける(aを掛けると+1の解になってしまう)... solvePellEquation' ∷ Integer → Root Integer Rational solvePellEquation' d | d <= 0 = showError $ "is zero or has negative value." | (floor . sqrt . fromInteger $ d) ^ 2 == d = showError $ "is a square number." | otherwise = p 0 [a0] where showError = error . ("solvePellEquation': " ++) . ("d(" ++) . (shows d ") " ++) d' = toRational d a0@(g0, h0, k0) = (0, 1, toRational . floor . sqrt . fromIntegral $ d) p n xs@((g, h, k):_) | g == g' = ((^ 2) . f $ q 0 (reverse xs) []) / Root d (h, 0) | h == h' = (uncurry (*) . (f &&& f . tail) $ q 0 (reverse (a' : xs)) []) / Root d (h, 0) | otherwise = p (succ n) (a' : xs) where a'@(g', h', k') = (-g + k * h, (d' - g' ^ 2) / h, toRational . floor $ (k0 + g') / h') f = Root d . (snd &&& fst) . head q _ (_:[]) ys = ys q n xs ys | n == 0 = q (succ n) xs ((0, h') : ys) -- 最初の引数はドロップしない... | n == 1 = q (succ n) xs' ((1, g ) : ys) | otherwise = q (succ n) xs' ((y, x ) : ys) where ((g', h', k'):xs') = xs ((g , h , k ):_ ) = xs' ((y' , x' ):ys') = ys ((y'', x''):_ ) = ys' (x, y) = (g * y + h * y', y'' + k' * y')
■ [アルゴリズム]ペル方程式(検証)
x ^ 2 - d * y ^ 2 = 1で検証してみよう...
計算するのが急に大変になるのは、dが61の時...
$> let a = solvePellEquation 61 (0.00 secs, 0 bytes) $> a Root 61 (1766319049 % 1,226153980 % 1) (0.00 secs, 0 bytes)
(x, y) = (1766319049, 226153980)
が最初の解...
計算にGHCiでコンマ1秒すらかからない、すごいアルゴリズム...
次の解は...
$> a ^ 2 Root 61 (6239765965720528801 % 1,798920165762330040 % 1) (0.02 secs, 525812 bytes)
(x, y) = (6239765965720528801, 798920165762330040)
100番目の解は...
$> a ^ 100 Root 61 (32276381116960305639325958838172316625136535911085041010916684110022737 36613386000462515801229557129435845772937766560044152546946182368577429998989370 14246606176506177272589212432935321962492310788331475688631514060183808673262909 77725478771518744835759878289507459709835744476153210303248854445123406945592964 76882536282804161068744604490647158207294947854459166375522562425827171826141056 43082877390576010091254781525397872937596483242370481767263272645710970811903509 42439869260895006993155667528727431958743877444658760733837432875611328670524419 49942922238001163850592681369485875196514411809269161377832509713256025630926167 59505846427760489562841384241212690585545482921334500429440088624067079665388960 18505692754217416027734602641548266521017423514205817803944309292725633965454689 91232757675075964907353138221472365672629397838248416276619869675685420344509941 38633630052877346092527824184747853423860284091468255829792883524501976946372200 0001 % 1,41325671337406374897335066676274109108046721085478956603292758897027123 47401868083588052035457728393224718172560031987091693079440925251405192830369027 62497046003091796413876312939413350443999997637595104412338212225559058356269843 26750033971033407447076490152397537960135174470942741561005546304728925361121050 72943763831263012828688852057327640981638689909565283715021472607923798206903004 64897448311388254756594684312682804975858007874163629892282520109926210930754187 65845217196922887971726266663351207174842163607362458747455631352178919867547390 31885253191929760091056926735209201371002664318425592530485152665279492816104015 48927750120613139534506987555225237507182165676183784976412278209117346888801579 32344454000932284311525660244374531219899770139960070335369010999775034942725226 56529434305932005249877716727362031086648363874671191495699779887388351483703106 37798756897110675139973119805323090799349896276876852909285510476471928573081302 000 % 1) (0.03 secs, 1603260 bytes)
何番目でも、もうただの掛け算...
■ [文法]基本文法(mappend)
{-# LANGUAGE UnicodeSyntax #-} import Data.List import Data.Monoid (mappend) import Data.Maybe (fromMaybe) -- Just - Justの場合に文字列を繋げたければ、Monoidが使える... test = [Just "foo", Nothing, Just "bar"] -- $> sequence test -- Nothing -- (0.00 secs, 0 bytes) -- $> msum test -- Just "foo" -- (0.00 secs, 0 bytes) -- $> mconcat test -- Just "foobar" -- (0.00 secs, 528316 bytes) -- 2引数タプルもMaybeもリストも関数もMonoidのインスタンスで、 -- かつMonoid則は簡単、2つ(単位元の定義、結合法則)しかない... -- Monadみたいに変に全称量化されてないから(訂正: 類の間違いだった...)、 -- Integerとかもインスタンスにできる... -- 結合法則から、foldl1 mappend [モノイド] == foldr1 mappend [モノイド] -- だから、fold系関数と親和性が高い。 -- で、Monoidを使ったfizzbuzzの解... fizzBuzzList n = map f [1 ⋯ n] where f i = fromMaybe (show i) $ foldr (mappend . g) Nothing [3, 5] where g x = case (x, mod i x) of (3, 0) → Just "fizz" (5, 0) → Just "buzz" otherwise → Nothing -- この場合、foldl'でも同じ。何故なら、Nothing == memptyで単位元だから... fizzBuzzList' n = map f [1 ⋯ n] where f i = fromMaybe (show i) $ foldl' (\ar x → ar `mappend` (g x)) mempty [3, 5] where g x = case (x, mod i x) of (3, 0) → Just "fizz" (5, 0) → Just "buzz" otherwise → mempty
コメント