commit 9a713ac8b7736a66a9306443bcf0e28636e181c7 parent 7d73250a7772050b472f70d3072cc5efff53c93f Author: Jared Tobin <jared@jtobin.io> Date: Wed, 27 May 2020 20:29:14 +0400 Cleaning some stuff up. Diffstat:
20 files changed, 234 insertions(+), 187 deletions(-)
diff --git a/.gitignore b/.gitignore @@ -2,3 +2,4 @@ cabal.sandbox.config dist *swp +.stack-work diff --git a/StackRS.hs b/StackRS.hs @@ -1,87 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -module StackRS where - -import Prelude hiding (head, tail) -import Data.Functor.Foldable as RS -import Text.Show.Deriving - -data StackF a r = - NilF - | ConsF a r - deriving (Eq, Functor, Foldable, Traversable, Show) - -$(deriveShow1 ''StackF) - -type Stack a = Fix (StackF a) - -empty :: Stack a -empty = Fix NilF - -push :: a -> Stack a -> Stack a -push h t = Fix (ConsF h t) - -pop :: Stack a -> Maybe (a, Stack a) -pop s = case project s of - NilF -> Nothing - ConsF h t -> Just (h, t) - -fromList :: [a] -> Stack a -fromList = ana coalg where - coalg = \case - [] -> NilF - (h : t) -> ConsF h t - -toList :: Stack a -> [a] -toList = ana coalg where - coalg s = case project s of - NilF -> Nil - ConsF h t -> Cons h t - -isEmpty :: Stack a -> Bool -isEmpty s = case project s of - NilF -> True - _ -> False - -cat :: Stack a -> Stack a -> Stack a -cat l r = apo coalg (project l) where - coalg = \case - ConsF h t -> case project t of - NilF -> ConsF h (Left r) - rest -> ConsF h (Right rest) - - NilF -> fmap Left (project r) - -update :: Int -> a -> Stack a -> Stack a -update idx x s = apo coalg (idx, s) where - coalg (j, stack) = case project stack of - NilF -> NilF - ConsF h t -> - if j <= 0 - then ConsF x (Left t) - else ConsF h (Right (pred j, t)) - --- exercise 2.1 -suffixes :: Stack a -> Stack (Stack a) -suffixes = ana coalg where - coalg stack = case project stack of - NilF -> NilF - ConsF _ t -> ConsF t t - --- test - -test0 :: Stack Int -test0 = fromList [1..3] - -test1 :: Stack Int -test1 = fromList [4..7] - -test2 :: Stack Int -test2 = update 3 100 (cat test0 test1) diff --git a/TreeRS.hs b/TreeRS.hs @@ -1,95 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -import Data.Functor.Foldable -import Text.Show.Deriving - -data TreeF a r = - LeafF - | NodeF r a r - deriving (Functor, Show) - -$(deriveShow1 ''TreeF) - -type Tree a = Fix (TreeF a) - -leaf :: Tree a -leaf = Fix LeafF - -node :: a -> Tree a -> Tree a -> Tree a -node x l r = Fix (NodeF l x r) - -insert :: Ord a => a -> Tree a -> Tree a -insert x = apo coalg where - coalg input = case unfix input of - LeafF -> NodeF (Left leaf) x (Left leaf) - NodeF l e r -> case compare x e of - EQ -> NodeF (Left l) e (Left r) - LT -> NodeF (Right l) e (Left r) - GT -> NodeF (Left l) e (Right r) - -member :: Ord a => a -> Tree a -> Bool -member x = cata $ \case - LeafF -> False - NodeF l e r -> case compare x e of - EQ -> True - LT -> l - GT -> r - -fromList :: Ord a => [a] -> Tree a -fromList = foldr insert leaf - -test0 :: Num a => Tree a -test0 = node 1 leaf leaf - --- 1 --- | \ --- L L - -test1 :: Num a => Tree a -test1 = node 2 (node 1 leaf leaf) (node 3 leaf leaf) - --- 2 --- | \ --- 1 3 --- | \ | \ --- L L L L - -test2 :: (Ord a, Num a) => Tree a -test2 = insert 0 test1 - --- 2 --- | \ --- 1 3 --- | \ | \ --- 0 L L L --- | \ --- L L - -test3 :: (Ord a, Num a) => Tree a -test3 = insert 5 test1 - --- 2 --- | \ --- 1 3 --- | \ | \ --- L L L 5 --- | \ --- L L - -test4 :: (Ord a, Num a) => Tree a -test4 = insert 4 test3 - --- 2 --- | \ --- 1 3 --- | \ | \ --- L L L 5 --- | \ --- 4 L --- | \ --- L L - diff --git a/lib/Okasaki/Stack.hs b/lib/Okasaki/Stack.hs @@ -0,0 +1,100 @@ +{-# OPTIONS_GHC -Wall -fno-warn-unused-top-binds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Okasaki.Stack ( + StackF(..) + , Stack + , empty + , push + , pop + + , fromList + , toList + , isEmpty + , cat + , update + , suffixes + ) where + +import Prelude hiding (head, tail) +import Data.Functor.Foldable as RS +import Text.Show.Deriving + +data StackF a r = + NilF + | ConsF !a r + deriving (Eq, Functor, Foldable, Traversable, Show) + +$(deriveShow1 ''StackF) + +type Stack a = Fix (StackF a) + +empty :: Stack a +empty = Fix NilF + +push :: a -> Stack a -> Stack a +push h t = Fix (ConsF h t) + +pop :: Stack a -> Maybe (a, Stack a) +pop s = case project s of + NilF -> Nothing + ConsF h t -> Just (h, t) + +fromList :: [a] -> Stack a +fromList = ana coalg where + coalg = \case + [] -> NilF + (h : t) -> ConsF h t + +toList :: Stack a -> [a] +toList = ana coalg where + coalg s = case project s of + NilF -> Nil + ConsF h t -> Cons h t + +isEmpty :: Stack a -> Bool +isEmpty s = case project s of + NilF -> True + _ -> False + +cat :: Stack a -> Stack a -> Stack a +cat l r = apo coalg (project l) where + coalg = \case + ConsF h t -> case project t of + NilF -> ConsF h (Left r) + rest -> ConsF h (Right rest) + + NilF -> fmap Left (project r) + +update :: Int -> a -> Stack a -> Stack a +update idx x s = apo coalg (idx, s) where + coalg (j, stack) = case project stack of + NilF -> NilF + ConsF h t -> + if j <= 0 + then ConsF x (Left t) + else ConsF h (Right (pred j, t)) + +-- exercise 2.1 +suffixes :: Stack a -> Stack (Stack a) +suffixes = ana coalg where + coalg stack = case project stack of + NilF -> NilF + ConsF _ t -> ConsF t t + +-- test + +test0 :: Stack Int +test0 = fromList [1..3] + +test1 :: Stack Int +test1 = fromList [4..7] + +test2 :: Stack Int +test2 = update 3 100 (cat test0 test1) diff --git a/lib/Okasaki/Tree.hs b/lib/Okasaki/Tree.hs @@ -0,0 +1,107 @@ +{-# OPTIONS_GHC -Wall -fno-warn-unused-top-binds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Okasaki.Tree ( + TreeF(..) + , Tree + , leaf + , node + + , insert + , member + , fromList + ) where + +import Data.Functor.Foldable +import Text.Show.Deriving + +data TreeF a r = + LeafF + | NodeF r a r + deriving (Functor, Show) + +$(deriveShow1 ''TreeF) + +type Tree a = Fix (TreeF a) + +leaf :: Tree a +leaf = Fix LeafF + +node :: a -> Tree a -> Tree a -> Tree a +node x l r = Fix (NodeF l x r) + +insert :: Ord a => a -> Tree a -> Tree a +insert x = apo coalg where + coalg input = case unfix input of + LeafF -> NodeF (Left leaf) x (Left leaf) + NodeF l e r -> case compare x e of + EQ -> NodeF (Left l) e (Left r) + LT -> NodeF (Right l) e (Left r) + GT -> NodeF (Left l) e (Right r) + +member :: Ord a => a -> Tree a -> Bool +member x = cata $ \case + LeafF -> False + NodeF l e r -> case compare x e of + EQ -> True + LT -> l + GT -> r + +fromList :: Ord a => [a] -> Tree a +fromList = foldr insert leaf + +test0 :: Num a => Tree a +test0 = node 1 leaf leaf + +-- 1 +-- | \ +-- L L + +test1 :: Num a => Tree a +test1 = node 2 (node 1 leaf leaf) (node 3 leaf leaf) + +-- 2 +-- | \ +-- 1 3 +-- | \ | \ +-- L L L L + +test2 :: (Ord a, Num a) => Tree a +test2 = insert 0 test1 + +-- 2 +-- | \ +-- 1 3 +-- | \ | \ +-- 0 L L L +-- | \ +-- L L + +test3 :: (Ord a, Num a) => Tree a +test3 = insert 5 test1 + +-- 2 +-- | \ +-- 1 3 +-- | \ | \ +-- L L L 5 +-- | \ +-- L L + +test4 :: (Ord a, Num a) => Tree a +test4 = insert 4 test3 + +-- 2 +-- | \ +-- 1 3 +-- | \ | \ +-- L L L 5 +-- | \ +-- 4 L +-- | \ +-- L L + diff --git a/okasaki.cabal b/okasaki.cabal @@ -1,5 +1,5 @@ name: okasaki -version: 0.1.0.0 +version: 0.1.0 synopsis: Okasaki's Purely Functional Data Structures homepage: http://github.com/jtobin/okasaki license: MIT @@ -7,12 +7,16 @@ license-file: LICENSE author: Jared Tobin maintainer: jared@jtobin.ca build-type: Simple -cabal-version: >=1.10 +cabal-version: >= 1.10 library - exposed-modules: Stack, Tree default-language: Haskell2010 + hs-source-dirs: lib + exposed-modules: + Okasaki.Stack + , Okasaki.Tree build-depends: - base >= 4.7 && < 4.8 - , QuickCheck >= 2.7.6 + base + , deriving-compat + , recursion-schemes diff --git a/stack.yaml b/stack.yaml @@ -0,0 +1,5 @@ +resolver: lts-15.14 +packages: ['.'] +extra-deps: +flags: {} +extra-package-dbs: [] diff --git a/stack.yaml.lock b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 496111 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/14.yaml + sha256: c442d702d66b8c129b3473a32c609050aabf1dc2f8e8502402c143271a8fb141 + original: lts-15.14 diff --git a/BinomialHeap.hs b/working/BinomialHeap.hs diff --git a/Dequeue.hs b/working/Dequeue.hs diff --git a/FiniteMap.hs b/working/FiniteMap.hs diff --git a/LeftistHeap.hs b/working/LeftistHeap.hs diff --git a/Queue.hs b/working/Queue.hs diff --git a/RedBlackTree.hs b/working/RedBlackTree.hs diff --git a/Setup.hs b/working/Setup.hs diff --git a/SplayHeap.hs b/working/SplayHeap.hs diff --git a/Stack.hs b/working/Stack.hs diff --git a/Tree.hs b/working/Tree.hs diff --git a/UnrankedBinomialHeap.hs b/working/UnrankedBinomialHeap.hs diff --git a/WeightBiasedLeftistHeap.hs b/working/WeightBiasedLeftistHeap.hs