Added extra files to Haskell directory

haskell-way/CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for haskell-way
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

haskell-way/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2019,  
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of   nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

haskell-way/README.md

@@ -0,0 +1,4 @@
+## How to run tests
+
+`cabal install QuickCheck memoize`
+`cabal test`

haskell-way/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

haskell-way/haskell-way.cabal

@@ -0,0 +1,33 @@
+cabal-version:       >=1.10
+-- Initial package description 'haskell-way.cabal' generated by 'cabal
+-- init'.  For further documentation, see
+-- http://haskell.org/cabal/users-guide/
+
+name:                haskell-way
+version:             0.1.0.0
+-- synopsis:
+-- description:
+-- bug-reports:
+license:             BSD3
+license-file:        LICENSE
+author:
+maintainer:
+-- copyright:
+-- category:
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+
+library
+  exposed-modules:     TransformBST, DiceProblem
+  -- other-modules:
+  other-extensions:    MultiWayIf
+  build-depends:       base >=4.12 && <4.13,
+                       QuickCheck,
+                       memoize
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+
+test-suite test
+  type:         exitcode-stdio-1.0
+  main-is:      test/Main.hs
+  build-depends: base, QuickCheck, memoize

haskell-way/src/DiceProblem.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE MultiWayIf #-}
+
+module DiceProblem where
+
+import Data.Function.Memoize (memoFix)
+
+{-
+  Given a number 'n', n>=0, find out the number of ways the number 'n' can be reached
+by rolling a 6-faced dice
+-}
+
+{-
+  This problem could be solved in Haskell using a linked list, similar to the eaxmple in Scala. It would be more idiomatic to 
+-}
+
+{- TODO: Original function, implemented with linked lists as in scala-}
+noOfWays :: Int -> Integer
+noOfWays = undefined
+
+noOfWays' :: Int -> Integer
+noOfWays' = memoFix $ \memo n ->
+  if | n <= 0    -> 0
+     | n <= 6    -> 1 + sum [ memo (n -i) | i <- [1..n] ]
+     | otherwise -> sum [ memo (n - i) | i <- [1..6] ]

haskell-way/src/TransformBST.hs

@@ -0,0 +1,48 @@
+module TransformBST where
+
+import Data.Traversable
+
+{-
+      5                        27
+   / \                      /  \
+  2    7        =>         32   8
+ /    / \                 /    / \
+1    6   8               34   21  0
+      \                        \
+       6                        15
+-}
+
+data Tree a = Branch (Tree a) a (Tree a) | Bud
+  deriving (Show)
+
+instance Functor Tree where
+  fmap f = go where
+    go (Branch l v r) = Branch (go l) (f v) (go r)
+    go Bud = Bud
+
+instance Foldable Tree where
+  foldMap f = go where
+    go (Branch l v r) = go l <> f v <> go r
+    go Bud = mempty
+
+instance Traversable Tree where
+  traverse f = go where
+    go (Branch l v r) = Branch <$> go l <*> f v <*> go r
+    go Bud = pure Bud
+
+transformBST :: Num a => Tree a -> Tree a
+transformBST = snd . mapAccumR (\a b -> (a+b, a)) 0
+
+leaf :: a -> Tree a
+leaf a = Branch Bud a Bud
+
+root :: Tree Int
+root = Branch interim1 5 interim2
+  where
+    interim1 = Branch (leaf 1) 2 Bud
+    interim3 = Branch Bud 6 (leaf 6)
+    interim2 = Branch interim3 7 (leaf 8)
+
+main :: IO ()
+main = putStrLn $ "Transformed root value = " <> show transformedRoot
+  where transformedRoot = transformBST root

haskell-way/test/Main.hs

@@ -0,0 +1,6 @@
+module Test.Main where
+
+import qualified Test.TransformBST
+
+main = do
+  quickCheck TransformBST.tests

haskell-way/test/TransformBST.hs

@@ -0,0 +1,43 @@
+module Test.TransformBST (tests) where
+
+import TransformBST
+
+tests :: Property
+tests = do
+  property $ transformBSTcommutes (toList :: Tree a -> [a])
+
+
+{-
+  The `Arbitrary` typeclasses provides the ability to generate random testing
+  data. This instance is dependant on `a` also having an arbitrary instance.
+-}
+instance Arbitrary a => Arbitrary (Tree a) where
+  arbitrary = resize maxDepth genTree where
+    maxDepth = 5
+    branchChance = 0.7
+    genTree = fix $ \subtree -> do
+      n <- getSize
+      r <- choose (0.0, 1.0)
+      if n <= 0 || r > branceChanch
+        then pure Bud
+        else Tree <$> scale pred subtree <*> scale pred subtree
+
+
+{-
+  What properties would we expect `transformBST` to have?
+
+  t a -------> u a
+  |             |
+  |             |
+  V             V
+  t a -------> u a
+
+
+-}
+transformBSTcommutes :: (Arbitrary (t a), Arbitrary (u a), Traversable t,Traversable u, Num a) 
+                     => (t a -> u a) -> Property
+transformBSTcommutes f = do
+  ta <- arbitrary
+  pure $ transformBST (f ta) == f (transformBST ta) 
+
+