fork download
copy 
  1. data Tree a = Leaf
  2.               | Node Integer (Tree a) a (Tree a) 
  3.               deriving (Show)-- where Integer is the height (bottom = 0)
  4.  
  5. height:: Tree a -> Integer
  6. height Leaf = 0
  7. height (Node n _ _ _) = n
  8.  
  9.  
  10. insertFree :: Integer -> a -> Tree a -> Maybe (Tree a)
  11.  
  12. insertFree index x Leaf                    = Just (Node index  Leaf x Leaf)
  13. insertFree _ x (Node level Leaf val right) = Just (Node level (Node (level-1) Leaf x Leaf) val right)
  14. insertFree _ x (Node level left val Leaf)  = Just (Node level left val (Node (level-1) Leaf x Leaf))
  15. -- insertFree _ _ _ = Nothing
  16.  
  17. -- make balanced, binary tree (height diff is <= 1)
  18. -- Note - I would've liked to have kept `foldTree` point-free,
  19. --        but I'm not sure how to do that since I need `xs` for `treeHeight`
  20. foldTree :: [a] -> Tree a
  21. foldTree xs = (foldingFn . zip [0..]) xs
  22.    where foldingFn = foldr (\(i, elem) acc -> if (odd i) then insertFreeOrLeft  treeHeight elem acc  
  23.                                               else            insertFreeOrRight treeHeight elem acc) Leaf
  24.          treeHeight = getBinTreeHt xs 
  25.  
  26. -- get Binary Tree Height (used to start making the Tree)
  27. getBinTreeHt :: [a] -> Integer
  28. getBinTreeHt = floor . (logBase 2) . fromIntegral . length      
  29.  
  30. -- insert where there's a Leaf, otherwise choose Left
  31. insertFreeOrLeft :: Integer -> a -> Tree a -> Tree a
  32. insertFreeOrLeft index x Leaf                    = Node index  Leaf x Leaf
  33. insertFreeOrLeft _ x (Node level Leaf val right) = Node level (Node (level-1) Leaf x Leaf) val right
  34. insertFreeOrLeft _ x (Node level left val Leaf)  = Node level left val (Node (level-1) Leaf x Leaf)
  35. insertFreeOrLeft _ x (Node level left val right) = Node level (insertFreeOrLeft (level-1) x left) val right
  36.  
  37. -- insert where there's a Leaf, otherwise choose Right
  38. insertFreeOrRight :: Integer -> a -> Tree a -> Tree a
  39. insertFreeOrRight index x Leaf                    = Node index  Leaf x Leaf
  40. insertFreeOrRight _ x (Node level left val Leaf)  = Node level left val (Node (level-1) Leaf x Leaf)
  41. insertFreeOrRight _ x (Node level Leaf val right) = Node level (Node (level-1) Leaf x Leaf) val right
  42. insertFreeOrRight _ x (Node level left val right) = Node level left val (insertFreeOrRight (level-1) x right)
  43.  
  44.  
  45. indent :: [String] -> [String]
  46. indent = map ("  "++)
  47.  
  48. layoutTree :: Show a => Tree a -> [String]
  49. layoutTree Leaf = []  -- wow, that was easy
  50. layoutTree (Node _ left here right) 
  51.          = indent (layoutTree right) ++ [show here] ++ indent (layoutTree left)
  52.  
  53. prettyTree :: Show a => Tree a -> String
  54. prettyTree = unlines.layoutTree
  55.  
  56.  
  57. main :: IO()
  58. main = putStrLn $ prettyTree $ foldTree [0..127]
  59.  
  60.  
Success #stdin #stdout 0s 6236KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
                                                                  0
                                                                4
                                                              8
                                                                2
                                                            12
                                                              6
                                                          16
                                                            10
                                                        20
                                                          14
                                                      24
                                                        18
                                                    28
                                                      22
                                                  32
                                                    26
                                                36
                                                  30
                                              40
                                                34
                                            44
                                              38
                                          48
                                            42
                                        52
                                          46
                                      56
                                        50
                                    60
                                      54
                                  64
                                    58
                                68
                                  62
                              72
                                66
                            76
                              70
                          80
                            74
                        84
                          78
                      88
                        82
                    92
                      86
                  96
                    90
                100
                  94
              104
                98
            108
              102
          112
            106
        116
          110
      120
        114
    124
      118
  126
    122
127
    121
  125
      117
    123
        113
      119
          109
        115
            105
          111
              101
            107
                97
              103
                  93
                99
                    89
                  95
                      85
                    91
                        81
                      87
                          77
                        83
                            73
                          79
                              69
                            75
                                65
                              71
                                  61
                                67
                                    57
                                  63
                                      53
                                    59
                                        49
                                      55
                                          45
                                        51
                                            41
                                          47
                                              37
                                            43
                                                33
                                              39
                                                  29
                                                35
                                                    25
                                                  31
                                                      21
                                                    27
                                                        17
                                                      23
                                                          13
                                                        19
                                                            9
                                                          15
                                                              5
                                                            11
                                                                1
                                                              7
                                                                3
https://ideone.com/IYKfNR
language:
Haskell (ghc 8.4.4)
created:
11 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!