hpastetwo

for gnuvince

author
roconnor
age
434 days
language
haskell
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
module Main where

{- TODO imports -}

data BTree = Leaf | Node BTree BTree

leaf = tell 1 >> return Leaf
node a b = tell 1 >> return (Node a b)

make 0 = leaf
make depth = node <$> make (depth - 1) <*> make (depth - 1)

main = do
  depth <- depthArgs <$> getArgs
  let counter = getSum . execWrite . make $ depth
  print counter
 where
  depthArgs [] = 10
  depthArgs [x] = x

{- This is totally untested -}

.

author
.
age
434 days
language
haskell
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
module Main where

{- TODO imports -}

data BTree = Leaf | Node BTree BTree

leaf = tell 1 >> return Leaf
node a b = tell 1 >> return (Node a b)

make 0 = leaf
make depth = node <$> make (depth - 1) <*> make (depth - 1)

main = do
  depth <- depthArgs <$> getArgs
  let counter = getSum . execWriter . make $ depth
  print counter
 where
  depthArgs [] = 10
  depthArgs [x] = x

{- This is totally untested -}

compile error

author
gnuvince
age
433 days
language
haskell
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
{-# LANGUAGE NoMonomorphismRestriction #-}

module Main where

import Data.Monoid
import Control.Applicative
import Control.Monad.Writer
import System

data BTree = Leaf | Node BTree BTree

inc = tell (Sum 1)

leaf = inc >> return Leaf
node a b = inc >> return (Node a b)

make 0 = leaf
make depth = node <$> make (depth - 1) <*> make (depth - 1)


main = do
  depth <- depthArgs <$> getArgs
  let counter = getSum . execWriter . make $ depth
  print counter
    where
      depthArgs :: [String] -> Int
      depthArgs [] = 10
      depthArgs [x] = read x




% ghc -Wall -O2 --make foo.hs
[1 of 1] Compiling Main             ( foo.hs, foo.o )

foo.hs:18:13:
    Couldn't match expected type `BTree'
           against inferred type `m BTree'
      Expected type: m1 BTree
      Inferred type: m1 (m BTree)
    In the expression: node <$> make (depth - 1) <*> make (depth - 1)
    In the definition of `make':
        make depth = node <$> make (depth - 1) <*> make (depth - 1)

.

author
.
age
433 days
language
haskell
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
import Control.Monad.State.Strict

data Node = Node [Node] deriving Show

mknode :: Int -> State Int Node
mknode 1 = do
  modify (1+)
  return $ Node []

mknode (k+1) = do
  modify (1+)
  p1 <- mknode k
  p2 <- mknode k
  return $ Node [p1, p2]

main = print $ runState (mknode 10) 0

.

author
.
age
433 days
language
haskell
1
2
3
4
make depth = do 
 t1 <- make (depth - 1)
 t2 <- make (depth - 1)
 node t1 t2

.

author
.
age
433 days
language
haskell
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
import Control.Applicative
import Data.Tree
import Data.Foldable (toList)
import System.Environment

type Node = Tree ()

make_tree depth
    | depth > 1 = Node () [ make_tree (depth-1)
                          , make_tree (depth-1) ]
    | otherwise = Node () []
    
counter = length . toList . make_tree

main   = do depth <- depthArg <$> getArgs
            print $ counter depth
    where depthArg [] = 10
          depthArg  lst = read . head $ lst

.

author
.
age
433 days
language
haskell
1
2
3
4
change:
data Node = Node [Node] deriving Show
to:
data Node = Node ![Node] deriving Show

strict writer

author
roconnor
age
433 days
language
haskell
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
{-# LANGUAGE NoMonomorphismRestriction #-}

module Main where

import Data.Monoid
import Control.Applicative
import Control.Monad.Writer.Strict
import System

data BTree = Leaf | Node BTree BTree

inc = tell (Sum 1)

leaf = inc >> return Leaf
node a b = inc >> return (Node a b)

make 0 = leaf
make depth = do
 t1 <- make (depth - 1)
 t2 <- make (depth - 1)
 node t1 t2

main = do
  depth <- depthArgs <$> getArgs
  let counter = getSum . execWriter . make $ depth
  print counter
    where
      depthArgs :: [String] -> Int
      depthArgs [] = 10
      depthArgs [x] = read x

{-
$ ghc --make -O2 -no-recomp Foo.hs
[1 of 1] Compiling Main             ( Foo.hs, Foo.o )
Linking Foo ...
$ time ./Foo 23
16777215

real    0m0.005s
user    0m0.004s
sys     0m0.000s
-}

Now with Lists

author
roconnor
age
433 days
language
haskell
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
{-# LANGUAGE NoMonomorphismRestriction #-}

module Main where

import Data.Monoid
import Control.Applicative
import Control.Monad.Writer.Strict
import Control.Monad              
import System                     

data Tree = Node [Tree]

inc = tell (Sum 1)

node x = inc >> return (Node x)

make 0 = node []
make depth = replicateM 2 (make (depth -1)) >>= node

main = do
  depth <- depthArgs <$> getArgs
  let counter = getSum . execWriter . make $ depth
  print counter
    where
      depthArgs :: [String] -> Int
      depthArgs [] = 10
      depthArgs [x] = read x