Tree

@MPD_bousai
Tree
Expressions tree
GHCi vs. GHC
haskellの資料

`@MPD_bousai`

警視庁災害対策課ベストツイート集

同名の本が出てたのでパラパラしてみた。興味があったのは、

ヘリコプターにスマホを鏡がわりにして信号を送る方法。ピースサインにした腕をだして、その視野でヘリコプターをとらえる。そしてそれに併せて光を送る。

曇らないマスクのつけ方。マスクの上辺を内側に折ってからつける。マスクの内側に、4つ折りしたティッシュを挟む。

ペットボトルで簡易蛇口。底辺近くに小さな穴をあける。指で塞いで水を入れる。キャップの開け閉めで、水が出たり出なかったりコントロール可能。

Tree

More about Algebraic Data Types

早速コンパイル。そして、エラーに遭遇。

sakae@deb:/tmp/Trees.hsproj$ cabal build
 :
Building executable 'Trees' for Trees-1.0..

<no location info>: error:
    output was redirected with -o, but no output will be generated
because there is no Main module.

下記の様に微妙に修正。メインモジュールには、mainが必要なんだな。起動の度に鼓舞するメッセージを表示させる。

-module BinTrees where
+module Main where

   | Node a (BinaryTree a) (BinaryTree a)
+    deriving (Show)


+main :: IO ()
+main = putStrLn "enjoy Haskell"

この修正で、どうやら起動した。早速どんなものが登録されてるか確認。

λ>  :bro
type BinaryTree :: * -> *
data BinaryTree a = Leaf | Node a (BinaryTree a) (BinaryTree a)
main :: IO ()
renderTree :: Show a => BinaryTree a -> Picture

実習を進める為に、小さい木を登録。

t1 = Leaf
t2 = Node 5 t1 t1
t3 = Node 7 Leaf t2
t4 = Node 10 t3 Leaf

それで、PNGファイルを作成。

λ> writePng "aa.png" ( drawPicture 3 $ renderTree t1 )
λ> writePng "bb.png" ( drawPicture 3 $ renderTree t2 )
 *** Exception: bb.png: withBinaryFile: does not exist (No such file or directory)

んが、例外が発生。コンパイルが通れば動くって誇大広告じゃな。aa.pngはちゃんと作成されてLeafが表示されるも、bb.pngはサイズが零のものしか出来なかった。なんか、とんでもなエラーメッセージになってる。

どんなデータを作成してるか確認しようとrenderTree t1 したら、Pictureと返答された。もっと詳細な奴が欲しいんですけど。。。

data PictureObject
  = Path
  :
  | TextBox
    { centerPO    :: Point
    , colourPO    :: Colour
    , textPO      :: String
    , sizePO      :: Float
    } deriving (Show)

type Picture = [PictureObject]

こんな具合に、あちこちのdataに、 deriving (Show) を入れまくり、文字列化してあげた。原始的なprint debugですな。

まずは、Leafのみを表示。

λ> renderTree t1
[Polygon {pointsPO = [Point {xPoint = 475.0, yPoint = 475.0},Point {xPoint = 47\
5.0, yPoint = 525.0},Point {xPoint = 525.0, yPoint = 525.0},Point {xPoint = 525\
.0, yPoint = 475.0},Point {xPoint = 475.0, yPoint = 475.0},Point {xPoint = 525.\
0, yPoint = 525.0},Point {xPoint = 475.0, yPoint = 525.0},Point {xPoint = 525.0\
, yPoint = 475.0}], colourPO = Colour {redC = 0, greenC = 0, blueC = 0, opacity\
C = 255}, lineStylePO = Solid, fillStylePO = NoFill}]

次は一番簡単なノードがひとつだけのツリーを表示。増えたのは、データを表示する為のオブジェクト。textデータの5が25ポイントで表示するんだよって言っている。

λ> renderTree t2
  :
TextBox {centerPO = Point {xPoint = 490.0, yPoint = 465.0},
colourPO = Colour {redC = 0, greenC = 0, blueC = 0, opacityC = 255},
textPO = "5", sizePO = 25.0},

じっと、ShapeGraphics.hsに眼をこらすと、MAC専用のフォントを選び出している。

    drawObj (TextBox (Point px py) textColour text textSize) =
      texture textColour $
                      printTextAt font (PointSize textSize) (V2 px py)
                           text
{-# NOINLINE font #-}
font
  = let
   fontErr = unsafePerformIO $ loadFontFile "/Library/Fonts/Trebuchet MS.ttf"
    in case fontErr of
          Left err -> error "font not available"
          Right f  -> f

hoogleを手軽に使えるようにしておいたので、検索。

loadFontFile

loadFontFile :: FilePath -> IO (Either String Font)
FontyFruity Graphics.Text.TrueType
Load a font file, the file path must be pointing to the true type file (.ttf)

printTextAt
Draw a string at a given position. Text printing imply loading a font, there
is no default font (yet). Below an example of font rendering using a font
installed on Microsoft Windows.

main = do
fontErr <- loadFontFile "test_fonts/DejaVuSans.ttf"
case fontErr of
Left err -> putStrLn err
Right font ->
writePng "text_example.png" .
renderDrawing 300 70 (PixelRGBA8 255 255 255 255)
. withTexture (uniformTexture $ PixelRGBA8 0 0 0 255) $
printTextAt font (PointSize 12) (V2 20 40)
"A simple text test!"

Arch Linuxってかオイラーはあまりフォントに興味は無いので、ツルータイプフォントなんて、ほとんど入っていない。そんなんで、適当に選んでみた。

[sakae@arch ~]$ file /usr/share/imlib2/data/fonts/notepad.ttf
/usr/share/imlib2/data/fonts/notepad.ttf: TrueType Font data, 15 tables, 1st "OS/2", 21 names, Unicode

したら、ちゃんと木ができた。やれやれ。

λ>  go x = writePng "aa.png" ( drawPicture 3 $ renderTree x)
λ>  go t3

PNGファイルを更新したら、firefoxをリロードすれば良い。これで、少しは楽になるな。

insertTree :: Ord a => a -> BinaryTree a -> BinaryTree a
insertTree x Leaf  = Node x Leaf Leaf
insertTree newValue (Node nodeValue leftSubtree rightSubtree)
  | newValue < nodeValue = Node nodeValue (insertTree newValue leftSubtree) rightSubtree
  | otherwise            = Node nodeValue leftSubtree (insertTree newValue rightSubtree)

listToTree :: Ord a => [a] -> BinaryTree a
listToTree  []    = Leaf
listToTree (x:xs) = insertTree x (listToTree xs)

ツリーへの挿入、それを下地にして、リストデータを、ツリーへ挿入。

λ>  insertTree 9 t2
Node 5 Leaf (Node 9 Leaf Leaf)
λ>  listToTree [4,1,8]
Node 8 (Node 1 Leaf (Node 4 Leaf Leaf)) Leaf
λ> go $ listToTree [4,2,6,3,1,7,5]

λ>  insertTree 3 Leaf
Node 3 Leaf Leaf
λ>  insertTree 5
insertTree 5 :: (Ord a, Num a) => BinaryTree a -> BinaryTree a
λ>  q = insertTree 5
λ>  q Leaf
Node 5 Leaf Leaf
λ>  Node 3 Leaf
Node 3 Leaf :: Num a => BinaryTree a -> BinaryTree a
λ>  p = Node 3 Leaf
λ>  p Leaf
Node 3 Leaf Leaf

BinaryTreeは、その定義により、1引数、もしくは3引数として振る舞う。よって、上記のpのように、リーチがかかった状態にできる。カリーだな。

DebianはX Windowsを入れてるのでフォントは豊富。適当に/usr/share/fonts/truetype/freefont/FreeMono.ttf を指定してみた。枠からはみだすなあ。フォントの幅を考慮しないで決め打ちか。ArchLinuxで選んだフォントは、筆記体でちょいと見にくかったな。

Expressions tree

http://learn.hfm.io/expressions.html

こちらも早速エラーですよ。もう、エラーが日常生活の一部です。

Expressions.hs:103:15: error:
    • Could not deduce (Show a0)
        arising from a type ambiguity check for
        the type signature for ‘renderExpr’
      from the context: Show a
        bound by the type signature for:
                   renderExpr :: forall a. Show a => Expr -> Picture
        at Expressions.hs:103:15-39
      The type variable ‘a0’ is ambiguous
      These potential instances exist:
        instance Show PixelCMYK16 -- Defined in ‘Codec.Picture.Types’
        instance Show PixelCMYK8 -- Defined in ‘Codec.Picture.Types’
        instance Show PixelRGB16 -- Defined in ‘Codec.Picture.Types’
        ...plus 39 others
        ...plus 134 instances involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the ambiguity check for ‘renderExpr’
      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
      In the type signature: renderExpr :: Show a => Expr -> Picture
    |
103 | renderExpr :: Show a => Expr -> Picture
    |               ^^^^^^^^^^^^^^^^^^^^^^^^^
Error: cabal: Failed to build exe:Expressions from Expressions-1.0.

ごちゃごちゃと説明が出てきてるけど、これぞと思う語句に的を絞って、世界の同士の経験を聞いてみる。ちっとも孤独じゃないな。

TypeApplicationsとAllowAmbiguousTypes

AllowAmbiguousTypes拡張と型適用

正直に告白すると、この説明の1%も理解は出きてはいない。だけど、オイラーはルビコン川を渡ってしまった。そう、私製のChatGPTを発動させる。野生の勘とでも申しましょうか。。。

コンパイラーへの制御フラグを、Expressions.hsの冒頭に挿入。

{-# LANGUAGE AllowAmbiguousTypes #-}

haskellの得意技、型確認。

λ> :bro
type Token :: *
data Token = PlusTok | TimesTok | OpenTok | CloseTok | IntTok Int
type Expr :: *
data Expr = IntLit Int | Add Expr Expr | Mult Expr Expr
lexer :: String -> [Token]
parseIntOrParenExpr :: [Token] -> Maybe (Expr, [Token])
parseProdOrIntOrParenExpr :: [Token] -> Maybe (Expr, [Token])
parseProdOrIntOrParenExprL :: [Token] -> Maybe ([Expr], [Token])
parseSumOrProdOrIntOrParenExpr :: [Token] -> Maybe (Expr, [Token])
parse :: [Token] -> Expr
eval :: Expr -> Int
renderExpr :: Show a => Expr -> Picture
main :: IO ()

そして、型だけを頼りに、長い関数の連鎖を圧縮。まあ、bashで言うエイリアスだな。

λ>  go s = writePng "aa.png" (drawPicture 3 (renderExpr (parse (lexer s))))
λ>  go "1 + 3"

エバるが有るんで、エバっつてみる。

λ>  eval (parse (lexer "3 + 4"))
7
λ>  eval (parse (lexer "3 + 4 * 5"))
23
λ>  parse (lexer "3 + 4 * 5")
Add (IntLit 3) (Mult (IntLit 4) (IntLit 5))

関数合成

憧れの関数合成をポイントフリー式でやってみる。

λ>  pl = parse . lexer
λ>  pl "4 + 5"
Add (IntLit 4) (IntLit 5)
λ>  wd = writePng "aa.png" . drawPicture 3 . renderExpr . parse . lexer
λ>  wd "3 * 4 + 5 * 6"

ドットで結合するってのは、rubyあたりにも有ったな。メソッドチェーンとか言うんだったな。ruby方式は、左から右に評価が進んでいくけど、haskellの場合は、右から左に向って評価が進む。ちょっと混乱するな。それから、引数も消えている。数学的には、左辺と右辺に同名の変数名があれば、それを削除できるんだった。だから、そうしてる。カリーさん有難う。

λ>  :t pl
pl :: String -> Expr
λ>  :t wd
wd :: String -> IO ()
λ>  :t writePng
writePng :: PngSavable pixel => FilePath -> Image pixel -> IO ()

でも、ちゃんと、合成した最右の関数入力と、最左の関数の出力だけが出てくる。中間の関数の情報はゴソッと消えてしまって、ブラックボックスだ。

枠枠

renderExprの中身の枠枠部分。

renderExpr' (IntLit x)
  = borderedTextBox str
    where str = "IntLit " ++  show x

borderedTextBox :: String -> (Float, Float, Picture)
borderedTextBox str
  = (nodeWidth,
     nodeWidth/2,
     [TextBox (Point (chrSize/5) (0.8*nodeHeight)) grey str chrSize,
        Polygon [Point 0 0, Point 0 nodeHeight,
                 Point nodeWidth nodeHeight, Point nodeWidth 0,
                 Point 0 0]
                black Solid NoFill])
  where
    strLen    = fromIntegral $ length $ str
    nodeWidth = strLen * chrSize/1.6

注目はhaskellでの計算方法。fromIntegralを使って、中間形式とも言える数値形式にする(strLen)。それを使って、世間一般並の演算が、やっと出来る。

Maybe Either …

オイラーもちょいと同じ事をやってみる。買い物する時の税込価格計算。

data Buy = Sake Int | Meat Int
  deriving (Show )

pay :: Buy -> Double
pay (Sake p) = (fromIntegral p) * 1.1
pay (Meat p) = (fromIntegral p) * 1.08

買い物は、酒か肉しかしない。本当は、数量も同時入力すべきだけど、単なる例だから、本体価格のみ入力。

λ>  pay (Meat 5000)
5400.0
λ>  homare = Sake 2000
λ>  pay homare
2200.0

5000円の肉って神戸牛か。酒は、会津誉をチョイス。樽平なんてのも飲んだぞ。型から値段と言うか値を取り出すには、パターンマッチを使えばいいのね。

λ>  pay (Kuso 1000)
<interactive>:354:6-9: error:
    Data constructor not in scope: Kuso :: t0 -> Buy

コンストラクターに無いものを指定すると、激しく抵抗されるな。

λ>  map pay [Sake 1000, Meat 1000, Sake 2000]
[1100.0,1080.0,2200.0]

数量の変わりに、こんな風にすればいいのか。嗚呼、つくづく酒飲みだな。

改めてこのリストを眺めると、無味乾燥な数値に意味を与えたように見える。いや、酒の値段は幾らとも読める。どっちでもいいけどね。

システムに備え付けのMaybeとかと同じ立ち位置に並んだんだな。これ以上は、効率よく、Prelude.hsとかを閲覧すればいいな。

GHCi vs. GHC

上の関数合成のところで、格好よくポイントフリーな奴を作くったので、ソースに反映しといた。そして、cabal buildすると、

Expressions.hs:152:42-51: error:
    • Ambiguous type variable ‘a0’ arising from a use of ‘renderExpr’
      prevents the constraint ‘(Show a0)’ from being solved.
      Probable fix: use a type annotation to specify what ‘a0’ should be.
      These potential instances exist:
        instance Show PixelCMYK16 -- Defined in ‘Codec.Picture.Types’
        instance Show PixelCMYK8 -- Defined in ‘Codec.Picture.Types’
        instance Show PixelRGB16 -- Defined in ‘Codec.Picture.Types’
        ...plus 39 others
        ...plus 134 instances involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the first argument of ‘(.)’, namely ‘renderExpr’
      In the second argument of ‘(.)’, namely
        ‘renderExpr . parse . lexer’
      In the second argument of ‘(.)’, namely
        ‘drawPicture 3 . renderExpr . parse . lexer’
    |
152 | wd = writePng "aa.png" . drawPicture 3 . renderExpr . parse . lexer

こんなエラーを食ってしまった。一体どういう事？インタープリター環境の ghciとコンパイラーであるGHCでは、挙動が違うの？

irbで試してみて良ければソースに反映させるって方法でずっとやって来たけど、こういうスタイルは通用しないの？

Why do GHC and GHCI differ on type inference?

意外と知らないType defaulting

で、結局