├── .github └── workflows │ └── test.yaml ├── .gitignore ├── LICENSE ├── README.md ├── Setup.hs ├── _config.yml ├── docs ├── Algorithms │ ├── List │ │ ├── BasicOperations │ │ │ ├── Filter.md │ │ │ ├── GroupBy.md │ │ │ ├── Inits.md │ │ │ ├── Iterate.md │ │ │ ├── Length.md │ │ │ ├── Map.md │ │ │ ├── Permutations.md │ │ │ ├── Reverse.md │ │ │ ├── Scanr.md │ │ │ ├── Span.md │ │ │ ├── Subsequences.md │ │ │ ├── Take.md │ │ │ ├── TakeWhile.md │ │ │ └── Zip.md │ │ ├── EditDistance.md │ │ ├── LongestCommonSubsequence.md │ │ ├── MatrixChainMultiplication.md │ │ ├── RunLengthConversion.md │ │ └── Sorting │ │ │ ├── InsertionSort.md │ │ │ └── SelectionSort.md │ ├── Nat │ │ ├── BasicOperations │ │ │ ├── Add.md │ │ │ ├── Factorial.md │ │ │ ├── LessThan.md │ │ │ └── Product.md │ │ ├── Catalan.md │ │ └── Fibonacci.md │ └── Tree │ │ ├── BasicOperations │ │ └── Depth.md │ │ ├── BreadthFirstSearch.md │ │ └── DepthFirstSearch.md ├── DataStructures │ ├── Levels.md │ ├── List.md │ ├── Nat.md │ └── Tree.md ├── README.md └── RecursionSchemes │ └── Extra.md ├── package.yaml ├── recursion-algorithms.cabal ├── stack.yaml ├── stack.yaml.lock └── test ├── Directory.hs ├── Docs2Hs.hs ├── Doctest.hs └── RemoveHs.hs /.github/workflows/test.yaml: -------------------------------------------------------------------------------- 1 | name: Test 2 | on: push 3 | jobs: 4 | doctest: 5 | name: Run all doctest 6 | runs-on: ubuntu-latest 7 | steps: 8 | - uses: actions/checkout@v2 9 | - uses: haskell/actions/setup@v1 10 | with: 11 | enable-stack: true 12 | stack-no-global: true 13 | stack-setup-ghc: true 14 | - uses: actions/cache@v2 15 | with: 16 | path: | 17 | ~/.stack 18 | .stack-work 19 | key: recursion-algorithms-${{ hashFiles('package.yaml') }}-${{ hashFiles('stack.yaml') }} 20 | - run: stack test 21 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | docs/**/*.hs 2 | 3 | .stack-work/ 4 | *~ 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Tatsuya Hirose (c) 2020 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Algorithms written in Recursion Schemes 2 | 3 | See . 4 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-dinky -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Filter.md: -------------------------------------------------------------------------------- 1 | # filter 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Filter where 5 | 6 | import GHC.Natural 7 | 8 | import qualified Control.Foldl as L 9 | import Data.Functor.Foldable 10 | 11 | import DataStructures.List 12 | import RecursionSchemes.Extra 13 | ``` 14 | 15 | This implementation can be found in Meijer (1991)[^1]. 16 | 17 | ```hs 18 | -- | >>> filterCata odd [1, 2, 3] 19 | -- [1,3] 20 | filterCata :: (a -> Bool) -> [a] -> [a] 21 | filterCata p = cata \case 22 | Nil -> [] 23 | (Cons a b) -> if p a then a : b else b 24 | ``` 25 | 26 | You can also implement a monadic filter, which is used to implement subsequences[^2]. 27 | 28 | ```hs 29 | -- | >>> filterCataM (pure . odd) [1, 2, 3] 30 | -- [1,3] 31 | filterCataM :: Monad m => (a -> m Bool) -> [a] -> m [a] 32 | filterCataM p = cataM \case 33 | Nil -> pure [] 34 | Cons x xs -> do 35 | flg <- p x 36 | pure if flg then x:xs else xs 37 | ``` 38 | 39 | `filter` can also be implemented using Monoidal Catamorphism[^3]. 40 | 41 | ```hs 42 | -- | >>> filterCat odd [1, 2, 3] 43 | -- [1,3] 44 | filterCat :: (a -> Bool) -> [a] -> [a] 45 | filterCat p = cat listFold (L.prefilter p L.list) . refix 46 | ``` 47 | 48 | ## References 49 | [1] Meijer, Erik, Maarten Fokkinga, and Ross Paterson. "Functional programming with bananas, lenses, envelopes and barbed wire." Conference on Functional Programming Languages and Computer Architecture. Springer, Berlin, Heidelberg, 1991. 50 | [2] [Monadic versions · Issue #5 · vmchale/recursion_schemes](https://github.com/vmchale/recursion_schemes/issues/5) 51 | [3] [Monoidal Catamorphisms \| Bartosz Milewski's Programming Cafe](https://bartoszmilewski.com/2020/06/15/monoidal-catamorphisms/) 52 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/GroupBy.md: -------------------------------------------------------------------------------- 1 | # groupBy 2 | 3 | 4 | ```hs 5 | module Algorithms.List.BasicOperations.GroupBy where 6 | 7 | import Control.Arrow (first) 8 | import Data.Functor.Foldable 9 | ``` 10 | 11 | ``groupBy`` is defined in standard Data.List module of base package. Its spec is following 12 | 13 | ```hs 14 | {- @ 15 | groupBy :: (a -> a -> Bool) -> [a] -> [[a]] 16 | groupBy _ [] = [] 17 | groupBy eq (x:xs) = (x:ys) : groupBy eq zs 18 | where (ys,zs) = span (eq x) xs 19 | @ 20 | -} 21 | ``` 22 | 23 | We can implement ``groupBy`` as an instance of paramorphism. 24 | 25 | ```hs 26 | {- | >>> groupByAna (==) "Mississippi" 27 | ["M","i","ss","i","ss","i","pp","i"] 28 | -} 29 | groupByAna :: (a -> a -> Bool) -> [a] -> [[a]] 30 | groupByAna eq = ana psi 31 | where 32 | psi = \ case 33 | [] -> Nil 34 | x:xs -> uncurry Cons (first (x :) (span (eq x) xs)) 35 | ``` 36 | And we can also implement ``groupBy`` as an instance of catamorphism. [*](https://github.com/lotz84/recursion-algorithms/pull/2#issuecomment-626012637) 37 | 38 | ```hs 39 | {- | >>> groupByCata (==) "Mississippi" 40 | ["M","i","ss","i","ss","i","pp","i"] 41 | -} 42 | groupByCata :: (a -> a -> Bool) -> [a] -> [[a]] 43 | groupByCata g = cata alg 44 | where 45 | alg = \ case 46 | Nil -> [] 47 | Cons x [] -> [[x]] 48 | Cons x (ys@(y:_):yss) 49 | | g x y -> (x:ys):yss 50 | | otherwise -> [x]:ys:yss 51 | ``` 52 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Inits.md: -------------------------------------------------------------------------------- 1 | # inits / tails 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Inits where 5 | 6 | import Algorithms.List.BasicOperations.TakeWhile 7 | ``` 8 | 9 | `inits` is a function that returns all substrings of the list in succession from the beginning[^1]. 10 | 11 | ```hs 12 | -- | >>> inits "abc" 13 | -- ["","a","ab","abc"] 14 | inits :: [a] -> [[a]] 15 | inits = takeWhileCataM (const [False, True]) 16 | ``` 17 | 18 | `tails` is a function that enumerates all contiguous partial lists from the end of a given list[^1]. 19 | 20 | ```hs 21 | -- | >>> tails "abc" 22 | -- ["abc","bc","c",""] 23 | tails :: [a] -> [[a]] 24 | tails = dropWhileParaM (const [False, True]) 25 | ``` 26 | 27 | ## References 28 | [1] [Monadic versions · Issue #5 · vmchale/recursion_schemes](https://github.com/vmchale/recursion_schemes/issues/5) -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Iterate.md: -------------------------------------------------------------------------------- 1 | # iterate 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Iterate where 5 | 6 | import Data.Functor.Foldable 7 | ``` 8 | 9 | This implementation can be found in Meijer (1991)[^1]. 10 | 11 | ```hs 12 | -- | >>> take 3 $ iterateAna (+1) 1 13 | -- [1,2,3] 14 | iterateAna :: (a -> a) -> a -> [a] 15 | iterateAna f = ana \a -> Cons a (f a) 16 | ``` 17 | 18 | ## References 19 | [1] Meijer, Erik, Maarten Fokkinga, and Ross Paterson. "Functional programming with bananas, lenses, envelopes and barbed wire." Conference on Functional Programming Languages and Computer Architecture. Springer, Berlin, Heidelberg, 1991. 20 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Length.md: -------------------------------------------------------------------------------- 1 | # length 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Length where 5 | 6 | import Data.Monoid 7 | import GHC.Natural 8 | 9 | import qualified Control.Foldl as L 10 | import Data.Functor.Foldable 11 | 12 | import DataStructures.List 13 | import RecursionSchemes.Extra 14 | ``` 15 | 16 | Since the length function is a list to natural number function, it can be represented as either a cata or ana. This is the most basic implementation by cata and was introduced in Meijer(1991)[^1]. 17 | 18 | ```hs 19 | -- | >>> lengthCata [1, 2, 3] 20 | -- 3 21 | lengthCata :: [a] -> Natural 22 | lengthCata = cata \case 23 | Nil -> 0 24 | Cons _ n -> 1 + n 25 | ``` 26 | 27 | Conversely, if we look at the natural number of return values, we get an implementation by ana. 28 | 29 | ```hs 30 | -- | >>> lengthAna [1, 2, 3] 31 | -- 3 32 | lengthAna :: [a] -> Natural 33 | lengthAna = ana \case 34 | [] -> Nothing 35 | (_:xs) -> Just xs 36 | ``` 37 | 38 | Given that both input and output are recursive types, it is possible that the algorithm could be written down using bialgebra and distributional laws[^2]. In this case this is correct. ListF is for lists and Maybe is for Natural's Base Functor. 39 | 40 | ```hs 41 | dist :: ListF a (Maybe b) -> Maybe (ListF a b) 42 | dist Nil = Nothing 43 | dist (Cons a Nothing) = Just Nil 44 | dist (Cons a (Just b)) = Just (Cons a b) 45 | 46 | 47 | -- | >>> lengthCataAna [1, 2, 3] 48 | -- 3 49 | lengthCataAna :: [a] -> Natural 50 | lengthCataAna = cata $ ana (dist . fmap project) 51 | 52 | 53 | -- | >>> lengthAnaCata [1, 2, 3] 54 | -- 3 55 | lengthAnaCata :: [a] -> Natural 56 | lengthAnaCata = ana $ cata (fmap embed . dist) 57 | ``` 58 | 59 | `length` can also be implemented using Monoidal Catamorphism[^3]. 60 | 61 | ```hs 62 | -- | >>> lengthCat [1, 2, 3] 63 | -- 3 64 | lengthCat :: [a] -> Natural 65 | lengthCat = cat listFold L.genericLength . refix 66 | ``` 67 | 68 | ## References 69 | [1] Meijer, Erik, Maarten Fokkinga, and Ross Paterson. "Functional programming with bananas, lenses, envelopes and barbed wire." Conference on Functional Programming Languages and Computer Architecture. Springer, Berlin, Heidelberg, 1991. 70 | [2] Hinze, Ralf, et al. "Sorting with bialgebras and distributive laws." Proceedings of the 8th ACM SIGPLAN workshop on Generic programming. 2012. 71 | [3] [Monoidal Catamorphisms \| Bartosz Milewski's Programming Cafe](https://bartoszmilewski.com/2020/06/15/monoidal-catamorphisms/) 72 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Map.md: -------------------------------------------------------------------------------- 1 | # map 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Map where 5 | 6 | import qualified Control.Foldl as L 7 | 8 | import Data.Functor.Foldable 9 | 10 | import DataStructures.List 11 | import RecursionSchemes.Extra 12 | ``` 13 | 14 | The map can be easily implemented in both cata and ana to maintain the structure of the list. The implementation by ana is also described in Meijer (1991)[^1]. 15 | 16 | ```hs 17 | -- | >>> mapCata show [1,2,3] 18 | -- ["1","2","3"] 19 | mapCata :: (a -> b) -> [a] -> [b] 20 | mapCata f = cata \case 21 | Nil -> [] 22 | (Cons a b) -> f a : b 23 | 24 | 25 | -- | >>> mapAna show [1,2,3] 26 | -- ["1","2","3"] 27 | mapAna :: (a -> b) -> [a] -> [b] 28 | mapAna f = ana \case 29 | [] -> Nil 30 | (x:xs) -> Cons (f x) xs 31 | ``` 32 | 33 | Since map is the endomorphism of the list, let's see if we can implement it with bialgebra and distributional laws. This generally works well, but the list is reversed at the end, so you'll need to fix it in reverse. 34 | 35 | ```hs 36 | dist :: (a -> b) -> ListF a (ListF b c) -> ListF b (ListF a c) 37 | dist _ Nil = Nil 38 | dist f (Cons a Nil) = Cons (f a) Nil 39 | dist f (Cons a (Cons b c)) = Cons b (Cons a c) 40 | 41 | 42 | -- | >>> mapCataAna show [1,2,3] 43 | -- ["1","2","3"] 44 | mapCataAna :: (a -> b) -> [a] -> [b] 45 | mapCataAna f = reverse . (cata $ ana (dist f . fmap project)) 46 | 47 | 48 | -- | >>> mapAnaCata show [1,2,3] 49 | -- ["1","2","3"] 50 | mapAnaCata :: (a -> b) -> [a] -> [b] 51 | mapAnaCata f = reverse . (ana $ cata (fmap embed . dist f)) 52 | ``` 53 | 54 | `map` can also be implemented using Monoidal Catamorphism[^2]. 55 | 56 | ```hs 57 | -- | >>> mapCat show [1, 2, 3] 58 | -- ["1","2","3"] 59 | mapCat :: (a -> b) -> [a] -> [b] 60 | mapCat f = cat listFold (L.premap f L.list) . refix 61 | ``` 62 | 63 | ## References 64 | [1] Meijer, Erik, Maarten Fokkinga, and Ross Paterson. "Functional programming with bananas, lenses, envelopes and barbed wire." Conference on Functional Programming Languages and Computer Architecture. Springer, Berlin, Heidelberg, 1991. 65 | [2] [Monoidal Catamorphisms \| Bartosz Milewski's Programming Cafe](https://bartoszmilewski.com/2020/06/15/monoidal-catamorphisms/) 66 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Permutations.md: -------------------------------------------------------------------------------- 1 | # permutations 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Permutations where 5 | 6 | import Algorithms.List.Sorting.InsertionSort 7 | ``` 8 | 9 | `permutations` is a function that enumerates all combinations of permutations of the elements of a given list[^1]. 10 | 11 | ```hs 12 | -- | >>> permutations [1, 2, 3] 13 | -- [[3,2,1],[3,1,2],[1,3,2],[2,3,1],[2,1,3],[1,2,3]] 14 | permutations :: [a] -> [[a]] 15 | permutations = sortByCataM (\_ _ -> [False, True]) 16 | ``` 17 | 18 | ## References 19 | [1] [Monadic versions · Issue #5 · vmchale/recursion_schemes](https://github.com/vmchale/recursion_schemes/issues/5) -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Reverse.md: -------------------------------------------------------------------------------- 1 | # reverse 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Reverse where 5 | 6 | import qualified Control.Foldl as L 7 | 8 | import Data.Functor.Foldable 9 | 10 | import DataStructures.List 11 | import RecursionSchemes.Extra 12 | ``` 13 | 14 | This implementation by cata can be found in Meijer (1991)[^1]. 15 | 16 | ```hs 17 | -- | >>> reverseCata [1, 2, 3] 18 | -- [3,2,1] 19 | reverseCata :: [a] -> [a] 20 | reverseCata = cata \case 21 | Nil -> [] 22 | (Cons a b) -> b ++ [a] 23 | ``` 24 | 25 | At first glance, implementation by ana looks difficult, but it's possible to do it via the difference list. This is an implementation in hylo, since it is expanded in ana to a list of difference lists and then folded in cata. 26 | 27 | ```hs 28 | -- | >>> reverseHylo [1, 2, 3] 29 | -- [3,2,1] 30 | reverseHylo :: [a] -> [a] 31 | reverseHylo = hylo f g 32 | where 33 | f Nil = [] 34 | f (Cons a b) = a b 35 | g [] = Nil 36 | g (x:xs) = Cons (++ [x]) xs 37 | ``` 38 | 39 | Given that reverse is a list to list function, it is natural to try to see if it can be implemented with bialgebra and the distribution law[^2]. And it was a success. 40 | 41 | ```hs 42 | dist :: ListF a (ListF a b) -> ListF a (ListF a b) 43 | dist Nil = Nil 44 | dist (Cons a Nil) = Cons a Nil 45 | dist (Cons a (Cons b c)) = Cons b (Cons a c) 46 | 47 | 48 | -- | >>> reverseCataAna [1, 2, 3] 49 | -- [3,2,1] 50 | reverseCataAna :: [a] -> [a] 51 | reverseCataAna = cata $ ana (dist . fmap project) 52 | 53 | 54 | -- | >>> reverseAnaCata [1, 2, 3] 55 | -- [3,2,1] 56 | reverseAnaCata :: [a] -> [a] 57 | reverseAnaCata = ana $ cata (fmap embed . dist) 58 | ``` 59 | 60 | `reverse` can also be implemented using Monoidal Catamorphism[^3]. 61 | 62 | ```hs 63 | -- | >>> reverseCat [1, 2, 3] 64 | -- [3,2,1] 65 | reverseCat :: [a] -> [a] 66 | reverseCat = cat listFold L.revList . refix 67 | ``` 68 | 69 | ## References 70 | [1] Meijer, Erik, Maarten Fokkinga, and Ross Paterson. "Functional programming with bananas, lenses, envelopes and barbed wire." Conference on Functional Programming Languages and Computer Architecture. Springer, Berlin, Heidelberg, 1991. 71 | [2] Hinze, Ralf, et al. "Sorting with bialgebras and distributive laws." Proceedings of the 8th ACM SIGPLAN workshop on Generic programming. 2012. 72 | [3] [Monoidal Catamorphisms \| Bartosz Milewski's Programming Cafe](https://bartoszmilewski.com/2020/06/15/monoidal-catamorphisms/) 73 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Scanr.md: -------------------------------------------------------------------------------- 1 | # scanr / scanl 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Scanr where 5 | 6 | import Data.List.NonEmpty (NonEmpty(..), (<|)) 7 | 8 | import Data.Functor.Base (NonEmptyF(NonEmptyF)) 9 | import Data.Functor.Foldable 10 | ``` 11 | 12 | ## scanr 13 | 14 | `scanr` is a function that returns a list of foldr calculations, including the process. 15 | 16 | ```hs 17 | -- | >>> scanrCata (+) 0 [1, 2, 3] 18 | -- [6,5,3,0] 19 | scanrCata :: (a -> b -> b) -> b -> [a] -> [b] 20 | scanrCata f b = cata $ \case 21 | Nil -> [b] 22 | Cons a bs -> (f a $ head bs) : bs 23 | ``` 24 | 25 | However, this implementation by cata is not very natural as it requires the use of head. Considering that the result of the scanr calculation always contains at least an initial value, it is natural to interpret the result as NonEmpty. This allows you to get a new implementation. 26 | 27 | ```hs 28 | -- | >>> scanrCata' (+) 0 [1, 2, 3] 29 | -- 6 :| [5,3,0] 30 | scanrCata' :: (a -> b -> b) -> b -> [a] -> NonEmpty b 31 | scanrCata' f b = cata $ \case 32 | Nil -> b :| [] 33 | Cons a bs@(b :| _) -> f a b <| bs 34 | ``` 35 | 36 | ## scanl 37 | 38 | Since both list and NonEmpty are types that can be represented as fixed points, it is conceivable to decompose them into a combination of cata and ana. This means that any implementation where the order of the computations can be reversed will be a scanl. 39 | 40 | 41 | ```hs 42 | dist :: (a -> b -> b) -> b 43 | -> ListF a (NonEmptyF b r) -> NonEmptyF b (ListF a r) 44 | dist _ b Nil = NonEmptyF b Nothing 45 | dist f _ (Cons a (NonEmptyF b Nothing)) = NonEmptyF (f a b) (Just Nil) 46 | dist f _ (Cons a (NonEmptyF b (Just r))) = NonEmptyF (f a b) (Just $ Cons a r) 47 | 48 | -- | >>> scanlCataAna (+) 0 [1, 2, 3] 49 | -- 6 :| [3,1,0] 50 | scanlCataAna :: (a -> b -> b) -> b -> [a] -> NonEmpty b 51 | scanlCataAna f b = cata $ ana (dist f b . fmap project) 52 | 53 | -- | >>> scanlAnaCata (+) 0 [1, 2, 3] 54 | -- 6 :| [3,1,0] 55 | scanlAnaCata :: (a -> b -> b) -> b -> [a] -> NonEmpty b 56 | scanlAnaCata f b = ana $ cata (fmap embed . dist f b) 57 | ``` 58 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Span.md: -------------------------------------------------------------------------------- 1 | # span 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Span where 5 | 6 | import Control.Arrow (first) 7 | import Data.Functor.Foldable 8 | ``` 9 | 10 | ``span`` is a Prelude function and its spec is a following: 11 | 12 | ```hs 13 | -- @ 14 | -- span :: (a -> Bool) -> [a] -> ([a], [a]) 15 | -- span p xs = (takeWhile p xs, dropWhile p xs) 16 | -- @ 17 | ``` 18 | 19 | We can implement ``span`` as an instance of paramorphism. 20 | 21 | ```hs 22 | -- | >>> spanPara even [2, 4, 7, 8] 23 | -- ([2,4],[7,8]) 24 | spanPara :: (a -> Bool) -> [a] -> ([a], [a]) 25 | spanPara p = para phi 26 | where 27 | phi = \ case 28 | Nil -> ([], []) 29 | Cons a (as, b) -> if p a then first (a :) b else ([], a : as) 30 | ``` 31 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Subsequences.md: -------------------------------------------------------------------------------- 1 | # subsequences 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Subsequences where 5 | 6 | import Algorithms.List.BasicOperations.Filter 7 | ``` 8 | 9 | `subsequences` is a function that returns a partial list of all parts of a given list[^1]. 10 | 11 | ```hs 12 | -- | >>> subsequences "abc" 13 | -- ["","a","b","ab","c","ac","bc","abc"] 14 | subsequences :: [a] -> [[a]] 15 | subsequences = filterCataM (const [False, True]) 16 | ``` 17 | 18 | ## References 19 | [1] [Monadic versions · Issue #5 · vmchale/recursion_schemes](https://github.com/vmchale/recursion_schemes/issues/5) -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Take.md: -------------------------------------------------------------------------------- 1 | # take / drop 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Take where 5 | 6 | import GHC.Natural 7 | 8 | import qualified Control.Foldl as L 9 | import Data.Functor.Foldable 10 | 11 | import DataStructures.List 12 | import RecursionSchemes.Extra 13 | ``` 14 | 15 | ## take 16 | 17 | This implementation can be found in Uustalu (2000)[^1]. 18 | 19 | ```hs 20 | -- | >>> takeMMulti 3 [1..] 21 | -- [1,2,3] 22 | takeMMulti :: Natural -> [a] -> [a] 23 | takeMMulti = mmulti phi 24 | where 25 | phi _ Nothing Nil = [] 26 | phi _ Nothing (Cons _ _) = [] 27 | phi _ (Just _) Nil = [] 28 | phi f (Just a) (Cons b c) = b : f a c 29 | ``` 30 | 31 | It can be implemented using catamorphism through the adjoint fold about the adjunction of -×A -\| -^A [^2]. 32 | 33 | ```hs 34 | -- | >>> takeCata 3 [1..10] 35 | -- [1,2,3] 36 | takeCata :: Natural -> [a] -> [a] 37 | takeCata = cata f 38 | where 39 | f Nothing _ = [] 40 | f _ [] = [] 41 | f (Just g) (x:xs) = x : g xs 42 | ``` 43 | 44 | ## drop 45 | 46 | `drop` can also be implemented using catamorphism through the adjoint fold[^2]. 47 | 48 | ```hs 49 | -- | >>> dropCata 3 [1..5] 50 | -- [4,5] 51 | dropCata :: Natural -> [a] -> [a] 52 | dropCata = cata f 53 | where 54 | f Nothing xs = xs 55 | f _ [] = [] 56 | f (Just g) (x:xs) = g xs 57 | ``` 58 | 59 | `drop` can be implemented using Monoidal Catamorphism[^3]. 60 | 61 | ```hs 62 | -- | >>> dropCat 3 [1..5] 63 | -- [4,5] 64 | dropCat :: Natural -> [a] -> [a] 65 | dropCat n = cat listFold (L.drop n L.list) . refix 66 | ``` 67 | 68 | ## References 69 | [1] Uustalu, Tarmo, and Varmo Vene. "Coding recursion a la Mendler." Department of Computer Science, Utrecht University. 2000. 70 | [2] Hinze, Ralf. "Adjoint folds and unfolds." International Conference on Mathematics of Program Construction. Springer, Berlin, Heidelberg, 2010. 71 | [3] [Monoidal Catamorphisms \| Bartosz Milewski's Programming Cafe](https://bartoszmilewski.com/2020/06/15/monoidal-catamorphisms/) 72 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/TakeWhile.md: -------------------------------------------------------------------------------- 1 | # takeWhile / dropWhile 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.TakeWhile where 5 | 6 | import qualified Control.Foldl as L 7 | import Data.Functor.Foldable 8 | 9 | import DataStructures.List 10 | import RecursionSchemes.Extra 11 | ``` 12 | 13 | ## takeWhile 14 | 15 | This implementation can be found in Meijer (1991)[^1]. 16 | 17 | ```hs 18 | -- | >>> takeWhileCata odd [3, 1, 4, 1, 5] 19 | -- [3,1] 20 | takeWhileCata :: (a -> Bool) -> [a] -> [a] 21 | takeWhileCata p = cata \case 22 | Nil -> [] 23 | Cons a b -> if p a then a : b else [] 24 | ``` 25 | 26 | Monadic takeWhile also uses catamorphism, but the difference is that the object to be folded is wrapped in the monad[^2]. 27 | 28 | ```hs 29 | -- | >>> takeWhileCataM (\i -> print i >> pure (odd i)) [3, 1, 4, 1, 5] 30 | -- 3 31 | -- 1 32 | -- 4 33 | -- [3,1] 34 | takeWhileCataM :: Monad m => (a -> m Bool) -> [a] -> m [a] 35 | takeWhileCataM p = cata \case 36 | Nil -> pure [] 37 | Cons x xs -> do 38 | flg <- p x 39 | if flg then (x:) <$> xs else pure [] 40 | ``` 41 | 42 | ## dropWhile 43 | 44 | You can implement `dropWhile` by using paramorphism and returning the list of the points where the element no longer satisfies the condition. 45 | 46 | ```hs 47 | -- | >>> dropWhilePara odd [3, 1, 4, 1, 5] 48 | -- [4,1,5] 49 | dropWhilePara :: (a -> Bool) -> [a] -> [a] 50 | dropWhilePara p = para \case 51 | Nil -> [] 52 | Cons x (xs, ys) -> if p x then ys else x:xs 53 | ``` 54 | 55 | Monadic dropWhile also uses paramorphism, but the difference is that the object to be folded is wrapped in the monad[^2]. 56 | 57 | ```hs 58 | -- | >>> dropWhileParaM (\i -> print i >> pure (odd i)) [3, 1, 4, 1, 5] 59 | -- 3 60 | -- 1 61 | -- 4 62 | -- [4,1,5] 63 | dropWhileParaM :: Monad m => (a -> m Bool) -> [a] -> m [a] 64 | dropWhileParaM p = para \case 65 | Nil -> pure [] 66 | Cons x (xs, ys) -> do 67 | flg <- p x 68 | if flg then ys else pure (x:xs) 69 | ``` 70 | 71 | `dropWhile` can also be implemented using Monoidal Catamorphism[^3]. 72 | 73 | ```hs 74 | -- | >>> dropWhileCat odd [3, 1, 4, 1, 5] 75 | -- [4,1,5] 76 | dropWhileCat :: (a -> Bool) -> [a] -> [a] 77 | dropWhileCat p = cat listFold (L.predropWhile p L.list) . refix 78 | ``` 79 | 80 | ## References 81 | [1] Meijer, Erik, Maarten Fokkinga, and Ross Paterson. "Functional programming with bananas, lenses, envelopes and barbed wire." Conference on Functional Programming Languages and Computer Architecture. Springer, Berlin, Heidelberg, 1991. 82 | [2] [Monadic versions · Issue #5 · vmchale/recursion_schemes](https://github.com/vmchale/recursion_schemes/issues/5) 83 | [3] [Monoidal Catamorphisms \| Bartosz Milewski's Programming Cafe](https://bartoszmilewski.com/2020/06/15/monoidal-catamorphisms/) 84 | -------------------------------------------------------------------------------- /docs/Algorithms/List/BasicOperations/Zip.md: -------------------------------------------------------------------------------- 1 | # zip 2 | 3 | ```hs 4 | module Algorithms.List.BasicOperations.Zip where 5 | 6 | import Data.Functor.Foldable 7 | 8 | import RecursionSchemes.Extra 9 | ``` 10 | 11 | This implementation can be found in Meijer (1991)[^1]. 12 | 13 | ```hs 14 | -- | >>> zipAna [1, 2, 3] "abc" 15 | -- [(1,'a'),(2,'b'),(3,'c')] 16 | zipAna :: [a] -> [b] -> [(a, b)] 17 | zipAna = curry $ ana \case 18 | ([], _) -> Nil 19 | (_, []) -> Nil 20 | (a:as, b:bs) -> Cons (a, b) (as, bs) 21 | ``` 22 | 23 | It can be implemented using catamorphism through the adjoint fold about the adjunction of -×A -| -^A [^2]. 24 | 25 | ```hs 26 | -- | >>> zipCata [1, 2, 3] "abc" 27 | -- [(1,'a'),(2,'b'),(3,'c')] 28 | zipCata :: [a] -> [b] -> [(a, b)] 29 | zipCata = cata f 30 | where 31 | f Nil _ = [] 32 | f _ [] = [] 33 | f (Cons a g) (b:xs) = (a, b) : g xs 34 | ``` 35 | 36 | Also zip can be implimented by using Multimorphism. 37 | 38 | ```hs 39 | -- | >>> zipMMulti [1, 2, 3] "abc" 40 | -- [(1,'a'),(2,'b'),(3,'c')] 41 | zipMMulti :: [a] -> [b] -> [(a, b)] 42 | zipMMulti = mmulti phi 43 | where 44 | phi _ Nil Nil = [] 45 | phi _ Nil (Cons _ _) = [] 46 | phi _ (Cons _ _) Nil = [] 47 | phi f (Cons a as) (Cons b bs) = (a, b) : f as bs 48 | ``` 49 | 50 | ## References 51 | [1] Meijer, Erik, Maarten Fokkinga, and Ross Paterson. "Functional programming with bananas, lenses, envelopes and barbed wire." Conference on Functional Programming Languages and Computer Architecture. Springer, Berlin, Heidelberg, 1991. 52 | [2] Hinze, Ralf. "Adjoint folds and unfolds." International Conference on Mathematics of Program Construction. Springer, Berlin, Heidelberg, 2010. 53 | -------------------------------------------------------------------------------- /docs/Algorithms/List/EditDistance.md: -------------------------------------------------------------------------------- 1 | # Edit Distance 2 | 3 | ```hs 4 | module Algorithms.List.EditDistance where 5 | 6 | import GHC.Natural 7 | 8 | import Control.Comonad 9 | import Control.Comonad.Cofree 10 | import Data.Functor.Foldable 11 | 12 | import RecursionSchemes.Extra 13 | ``` 14 | 15 | Edit distance is an algorithm that calculates the distance between two strings, based on the idea that there is a cost every time you insert, delete, or replace a string when converting from one to the other. Check out [Edit distance - Wikipedia](https://en.wikipedia.org/wiki/Edit_distance) for more information.The implementation here is based on Kabanov (2006)[^1]. 16 | 17 | The editing distance algorithm looks like it could be implemented straightforwardly in Hylomorphism, but this is inefficient because it doesn't use the results once computed, resulting in duplicate computations. 18 | 19 | ```hs 20 | -- | Base Functor for the intermediate structure of editDistHylo 21 | data G c x = Inl [c] | Inr (c, c) (x, x, x) 22 | instance Functor (G c) where 23 | fmap f (Inl cs) = Inl cs 24 | fmap f (Inr cc (a, b, c)) = Inr cc (f a, f b, f c) 25 | 26 | -- | >>> editDistHylo ("kitten", "sitting") 27 | -- 3 28 | editDistHylo :: Eq a => ([a], [a]) -> Natural 29 | editDistHylo = hylo g f 30 | where 31 | f ([], bs) = Inl bs 32 | f (as, []) = Inl as 33 | f (a:as, b:bs) = Inr (a, b) ((as, b:bs), (a:as, bs), (as, bs)) 34 | g (Inl as) = fromIntegral $ length as 35 | g (Inr (a, b) (x1, x2, x3)) = 36 | minimum [x1 + 1, x2 + 1, x3 + if a == b then 0 else 1] 37 | ``` 38 | 39 | It is possible to implement using Dynamorphism to use dynamic programming to use the results once they are computed. Edit distance algorithms usually consider tabular data as an intermediate structure, but matrix is not a recursive data type, so they do not fit well with recursion schemes. So, as an intermediate structure, we consider a list of a matrix decomposed into row by row. 40 | 41 | ```hs 42 | -- | Base Functor for the intermediate structure of editDistDyna 43 | data F c x = F [c] [c] (Maybe x) 44 | 45 | instance Functor (F c) where 46 | fmap f (F as bs x) = F as bs (fmap f x) 47 | 48 | -- | >>> editDistDyna ("kitten", "sitting") 49 | -- 3 50 | editDistDyna :: Eq a => ([a], [a]) -> Natural 51 | editDistDyna (cs, cs') = 52 | let n = length cs 53 | in dyna (g n) f (cs, cs') 54 | where 55 | f ([] , []) = F [] [] Nothing 56 | f ([], b:bs) = F [] (b:bs) (Just (cs, bs)) 57 | f (a:as, bs) = F (a:as) bs (Just (as, bs)) 58 | g _ (F _ _ Nothing) = 0 59 | g _ (F [] bs (Just _)) = fromIntegral $ length bs 60 | g _ (F as [] (Just _)) = fromIntegral $ length as 61 | g n (F (a:as) (b:bs) (Just x)) = 62 | minimum [ extract x + 1 63 | , extract (iterate pi x !! n) + 1 64 | , extract (iterate pi x !! (n + 1)) + if a == b then 0 else 1 65 | ] 66 | pi (_ :< F _ _ (Just y)) = y 67 | ``` 68 | 69 | ## References 70 | [1] Kabanov, Jevgeni, and Varmo Vene. "Recursion schemes for dynamic programming." International Conference on Mathematics of Program Construction. Springer, Berlin, Heidelberg, 2006. 71 | -------------------------------------------------------------------------------- /docs/Algorithms/List/LongestCommonSubsequence.md: -------------------------------------------------------------------------------- 1 | # Longest Common Subsequence 2 | 3 | ```hs 4 | module Algorithms.List.LongestCommonSubsequence where 5 | 6 | import GHC.Natural 7 | 8 | import Control.Comonad 9 | import Control.Comonad.Cofree 10 | import Data.Functor.Foldable 11 | 12 | import RecursionSchemes.Extra 13 | ``` 14 | 15 | Longest Common Subsequence is an algorithm that extracts the longest common sequence from a given two lists. Check out [Longest common subsequence problem - Wikipedia](https://en.wikipedia.org/wiki/Longest_common_subsequence_problem) for more information on the algorithm. The algorithm looks like it could be written down in a straightforward manner using Hylomorphism. However, this implementation is inefficient because it results in a number of duplicate calculations. 16 | 17 | ```hs 18 | -- | Base Functor for the intermediate structure of lcsHylo 19 | data G c x = G (Maybe (c, c, x, x, x)) 20 | 21 | instance Functor (G c) where 22 | fmap f (G Nothing) = G Nothing 23 | fmap f (G (Just (c1, c2, x1, x2, x3))) = G (Just (c1, c2, f x1, f x2, f x3)) 24 | 25 | -- | >>> lcsHylo ("kitten", "sitting") 26 | -- "ittn" 27 | lcsHylo :: Eq a => ([a], [a]) -> [a] 28 | lcsHylo = hylo g f 29 | where 30 | f ([], _) = G Nothing 31 | f (_, []) = G Nothing 32 | f (a:as, b:bs) = G $ Just (a, b, (as, b:bs), (a:as, bs), (as, bs)) 33 | g (G Nothing) = [] 34 | g (G (Just (a, b, x1, x2, x3))) = 35 | if a == b then a:x3 else (if length x1 > length x2 then x1 else x2) 36 | ``` 37 | 38 | Dynamorphism can be used to rewrite this implementation into an algorithm that does not do any extra computation[^1]. 39 | 40 | ```hs 41 | -- | Base Functor for the intermediate structure of lcsDyna 42 | data F c x = F [c] [c] (Maybe x) 43 | 44 | instance Functor (F c) where 45 | fmap f (F as bs x) = F as bs (fmap f x) 46 | 47 | -- | >>> lcsDyna ("kitten", "sitting") 48 | -- "ittn" 49 | lcsDyna :: Eq a => ([a], [a]) -> [a] 50 | lcsDyna (cs, cs') = 51 | let n = length cs 52 | in dyna (g n) f (cs, cs') 53 | where 54 | f ([], []) = F [] [] Nothing 55 | f ([], b:bs) = F [] (b:bs) (Just (cs, bs)) 56 | f (a:as, bs) = F (a:as) bs (Just (as, bs)) 57 | g _ (F _ _ Nothing) = [] 58 | g _ (F [] _ _) = [] 59 | g _ (F _ [] _) = [] 60 | g n (F (a:as) (b:bs) (Just x)) = 61 | let x1 = extract x 62 | x2 = extract $ iterate pi x !! n 63 | x3 = extract $ iterate pi x !! (n + 1) 64 | in if a == b then a:x3 else (if length x1 > length x2 then x1 else x2) 65 | pi (_ :< F _ _ (Just y)) = y 66 | ``` 67 | 68 | ## References 69 | [1] Kabanov, Jevgeni, and Varmo Vene. "Recursion schemes for dynamic programming." International Conference on Mathematics of Program Construction. Springer, Berlin, Heidelberg, 2006. 70 | -------------------------------------------------------------------------------- /docs/Algorithms/List/MatrixChainMultiplication.md: -------------------------------------------------------------------------------- 1 | # Matrix Chain Multiplication 2 | 3 | ```hs 4 | module Algorithms.List.MatrixChainMultiplication where 5 | 6 | import Control.Comonad.Cofree 7 | 8 | import RecursionSchemes.Extra 9 | ``` 10 | 11 | Matrix Chain Multiplication is an algorithm for finding the order of computation that minimizes the amount of computation for computing the matrix product of given matrices. Check out [Matrix chain multiplication - Wikipedia](https://en.wikipedia.org/wiki/Matrix_chain_multiplication) for more information on the algorithm. 12 | 13 | ```hs 14 | -- | Base Functor for the intermediate structure 15 | data F x = F Int Int (Maybe x) deriving Functor 16 | 17 | -- | >>> mcm [100, 500, 1000, 5000, 10000] 18 | -- 5550000000 19 | mcm :: [Int] -> Int 20 | mcm xs = dyna g f (0, n-1) 21 | where 22 | n = length xs - 1 23 | f (i, j) 24 | | i == 0 && j == 0 = F i j Nothing 25 | | i == 0 = F i j (Just (n-j, n-1)) 26 | | otherwise = F i j (Just (i-1, j-1)) 27 | g (F _ _ Nothing) = 0 28 | g (F i j (Just cs)) 29 | | i == j = 0 30 | | otherwise = minimum $ flip map [i..j-1] $ \k -> 31 | let posR = pos i j - pos i k - 1 32 | posL = pos i j - pos (k+1) j - 1 33 | cost = xs!!i * xs !!(k+1) * xs!!(j+1) 34 | in lookup cs posR + lookup cs posL + cost 35 | pos i j = n * (j-i) - (div ((j-i)*(j-i-1)) 2) + i 36 | lookup (a :< _) 0 = a 37 | lookup (_ :< F _ _ (Just cs)) n = lookup cs (n-1) 38 | ``` 39 | -------------------------------------------------------------------------------- /docs/Algorithms/List/RunLengthConversion.md: -------------------------------------------------------------------------------- 1 | # Run Length Conversion 2 | 3 | ```hs 4 | module Algorithms.List.RunLengthConversion where 5 | 6 | import Control.Arrow 7 | import Data.List 8 | import Data.Functor.Foldable 9 | ``` 10 | 11 | The function ``runLength``'s spec is following: 12 | 13 | ```hs 14 | {- 15 | @ 16 | runLength :: Eq a => [a] -> [(a, Int)] 17 | runLength = map (head &&& length) . group 18 | @ 19 | -} 20 | ``` 21 | 22 | We can eliminate the intermediate list between ``map f`` and ``group`` by fusing them into an anamorphism. 23 | 24 | ```hs 25 | {- 26 | @ 27 | map f . ana psi 28 | where 29 | psi = \ case 30 | [] -> Nil 31 | xs -> Cons y ys 32 | = 33 | ana psi' 34 | where 35 | psi = \ case 36 | [] -> Nil 37 | xs -> Cons (f y) ys 38 | @ 39 | -} 40 | ``` 41 | 42 | We can fuse ``map (head &&& length) . group`` into an ana. 43 | 44 | ```hs 45 | {- 46 | @ 47 | map (head &&& length) . group 48 | = 49 | map (head &&& length) . groupBy (==) 50 | = 51 | map (head &&& length) . ana psi 52 | where 53 | psi = \ case 54 | [] -> Nil 55 | x:xs -> uncurry Cons (first (x:)) (span (x ==) xs)) 56 | = 57 | ana psi' 58 | where 59 | psi' = \ case 60 | [] -> Nil 61 | x:xs -> uncurry Cons (first ((head &&& length) . (x:))) (span (x ==) xs) 62 | @ 63 | -} 64 | ``` 65 | 66 | So far, we define ``runLength`` as an instance of anamorphism. 67 | 68 | ```hs 69 | {- 70 | @ 71 | runLength = ana psi 72 | where 73 | psi = \ case 74 | [] -> Nil 75 | x:xs -> uncurry Cons (first ((head &&& length) . (x:)) (span (x ==) xs)) 76 | @ 77 | -} 78 | ``` 79 | 80 | If we have ``spanCount :: (a -> Bool) -> [a] -> (Int, [a])`` instead of ``span``, we can get a slightly more efficient definition: 81 | 82 | ```hs 83 | {- | 84 | >>> xs = "mississippi" 85 | >>> runLength xs == (map (head &&& length) . group) xs 86 | True 87 | -} 88 | 89 | runLength :: Eq a => [a] -> [(a, Int)] 90 | runLength = ana psi 91 | where 92 | psi = \ case 93 | [] -> Nil 94 | x:xs -> uncurry Cons (first ((,) x . succ) (spanCount (x ==) xs)) 95 | ``` 96 | 97 | The ``spanCount`` returns the length of the span instead of returning the span itself. Its spec is: 98 | 99 | ```hs 100 | {- 101 | @ 102 | spanCount p = first length . span p 103 | @ 104 | -} 105 | ``` 106 | 107 | We can define the ``spanCount`` as an instance of paramorphism. 108 | 109 | ```hs 110 | {- | 111 | >>> xs = [2,4,1,6,3,5] 112 | >>> (spanCount even) xs == (first length . span even) xs 113 | True 114 | -} 115 | 116 | spanCount :: (a -> Bool) -> [a] -> (Int, [a]) 117 | spanCount p = para phi 118 | where 119 | phi = \ case 120 | Nil -> (0, []) 121 | Cons a (as, b) -> if p a then first succ b else (0, a:as) 122 | ``` 123 | -------------------------------------------------------------------------------- /docs/Algorithms/List/Sorting/InsertionSort.md: -------------------------------------------------------------------------------- 1 | # Insertion Sort 2 | 3 | ```hs 4 | module Algorithms.List.Sorting.InsertionSort where 5 | 6 | import Control.Arrow ((&&&)) 7 | 8 | import Data.Functor.Foldable 9 | 10 | import RecursionSchemes.Extra 11 | ``` 12 | 13 | Insertion sort is an algorithm that inserts the elements of the list one by one into the sorted list. This can be written down in a straightforward manner using Catamorphism[^1]. 14 | 15 | ```hs 16 | -- | >>> insertionSortCata [1, 3, 2] 17 | -- [1,2,3] 18 | insertionSortCata :: Ord a => [a] -> [a] 19 | insertionSortCata = cata \case 20 | Nil -> [] 21 | Cons x xs -> insert x xs 22 | where 23 | insert x xs = let (ys, zs) = span (<= x) xs 24 | in ys ++ [x] ++ zs 25 | ``` 26 | 27 | It can also be implemented using bialgebra and distribution laws, since both arguments and return values are lists. Surprisingly, given the duality of this implementation, we get a selection sort[^2]. 28 | 29 | ```hs 30 | swap :: Ord a => ListF a (ListF a r) -> ListF a (ListF a r) 31 | swap Nil = Nil 32 | swap (Cons a Nil) = Cons a Nil 33 | swap (Cons a (Cons b r)) 34 | | a <= b = Cons a (Cons b r) 35 | | otherwise = Cons b (Cons a r) 36 | 37 | -- | >>> insertionSortCataAna [1, 3, 2] 38 | -- [1,2,3] 39 | insertionSortCataAna :: Ord a => [a] -> [a] 40 | insertionSortCataAna = cata $ ana (swap . fmap project) 41 | ``` 42 | 43 | This implementation is a bit inefficient, so you can get a true insert sort by using Apomorphism. (In fact, the dual of this inefficient insertion sort will be the bubble sort.) 44 | 45 | ```hs 46 | swop :: Ord a => ListF a (x, ListF a x) -> ListF a (Either x (ListF a x)) 47 | swop Nil = Nil 48 | swop (Cons a (x, Nil)) = Cons a (Left x) 49 | swop (Cons a (x, (Cons b x'))) 50 | | a <= b = Cons a (Left x) 51 | | otherwise = Cons b (Right $ Cons a x') 52 | 53 | -- | >>> insertionSortCataApo [1, 3, 2] 54 | -- [1,2,3] 55 | insertionSortCataApo :: Ord a => [a] -> [a] 56 | insertionSortCataApo = cata $ apo (swop . fmap (id &&& project)) 57 | ``` 58 | 59 | You can also think of a monadic insertion sort. This will be used to implement permutations[^3]. 60 | 61 | ```hs 62 | insertByParaM :: Monad m => (a -> a -> m Bool) -> a -> [a] -> m [a] 63 | insertByParaM cmp x = para \case 64 | Nil -> pure [x] 65 | Cons y (xs, ys) -> do 66 | flg <- cmp x y 67 | if flg then pure (x:y:xs) else (y:) <$> ys 68 | 69 | -- | >>> sortByCataM (\x y -> print (x, y) >> pure (x < y)) [3, 1, 4, 1, 5] 70 | -- (1,5) 71 | -- (4,1) 72 | -- (4,5) 73 | -- (1,1) 74 | -- (1,4) 75 | -- (3,1) 76 | -- (3,1) 77 | -- (3,4) 78 | -- [1,1,3,4,5] 79 | sortByCataM :: Monad m => (a -> a -> m Bool) -> [a] -> m [a] 80 | sortByCataM cmp = cataM \case 81 | Nil -> return [] 82 | Cons x xs -> insertByParaM cmp x xs 83 | ``` 84 | 85 | ## References 86 | [1] Augusteijn, Lex. "Sorting morphisms." International School on Advanced Functional Programming. Springer, Berlin, Heidelberg, 1998. 87 | [2] Hinze, Ralf, et al. "Sorting with bialgebras and distributive laws." Proceedings of the 8th ACM SIGPLAN workshop on Generic programming. 2012. 88 | [3] [Monadic versions · Issue #5 · vmchale/recursion_schemes](https://github.com/vmchale/recursion_schemes/issues/5) -------------------------------------------------------------------------------- /docs/Algorithms/List/Sorting/SelectionSort.md: -------------------------------------------------------------------------------- 1 | # Selection Sort 2 | 3 | ```hs 4 | module Algorithms.List.Sorting.SelectionSort where 5 | 6 | import Control.Arrow ((|||)) 7 | 8 | import Data.Functor.Foldable 9 | ``` 10 | 11 | Selection sort is an algorithm that sorts a list by repeating the operation to get the minimum value from the list. This can be implemented using Anamorphism[^1]. 12 | 13 | ```hs 14 | -- | >>> selectionSortAna [1, 3, 2] 15 | -- [1,2,3] 16 | selectionSortAna :: (Eq a, Ord a) => [a] -> [a] 17 | selectionSortAna = ana \case 18 | [] -> Nil 19 | xs -> let x = minimum xs 20 | xs' = filter (/= x) xs 21 | in Cons x xs' 22 | ``` 23 | 24 | This can be implemented as a dual of insertion sort using Anamorphism and Paramorphism[^2]. 25 | 26 | ```hs 27 | swop :: Ord a => ListF a (x, ListF a x) -> ListF a (Either x (ListF a x)) 28 | swop Nil = Nil 29 | swop (Cons a (x, Nil)) = Cons a (Left x) 30 | swop (Cons a (x, (Cons b x'))) 31 | | a <= b = Cons a (Left x) 32 | | otherwise = Cons b (Right $ Cons a x') 33 | 34 | -- | >>> selectionSortAnaPara [1, 3, 2] 35 | -- [1,2,3] 36 | selectionSortAnaPara :: Ord a => [a] -> [a] 37 | selectionSortAnaPara = ana $ para (fmap (id ||| embed) . swop) 38 | ``` 39 | 40 | ## References 41 | [1] Augusteijn, Lex. "Sorting morphisms." International School on Advanced Functional Programming. Springer, Berlin, Heidelberg, 1998. 42 | [2] Hinze, Ralf, et al. "Sorting with bialgebras and distributive laws." Proceedings of the 8th ACM SIGPLAN workshop on Generic programming. 2012. 43 | -------------------------------------------------------------------------------- /docs/Algorithms/Nat/BasicOperations/Add.md: -------------------------------------------------------------------------------- 1 | # add 2 | 3 | ```hs 4 | module Algorithms.Nat.BasicOperations.Add where 5 | 6 | import GHC.Natural 7 | 8 | import Data.Functor.Foldable 9 | ``` 10 | 11 | Addition can be represented as catamorphism. 12 | 13 | ```hs 14 | -- | >>> addCata 1 2 15 | -- 3 16 | addCata :: Natural -> Natural -> Natural 17 | addCata n = cata \case 18 | Nothing -> n 19 | Just m -> 1 + m 20 | ``` 21 | 22 | Mendler-style implementation[^1] 23 | 24 | ```hs 25 | -- | >>> addMCata 1 2 26 | -- 3 27 | addMCata :: Natural -> Natural -> Natural 28 | addMCata n = mcata f . refix 29 | where 30 | f _ Nothing = n 31 | f g (Just m) = 1 + g m 32 | ``` 33 | 34 | ## References 35 | [1] Uustalu, Tarmo, and Varmo Vene. "Mendler-style inductive types, categorically." Nord. J. Comput. 6.3 (1999): 343. 36 | 37 | -------------------------------------------------------------------------------- /docs/Algorithms/Nat/BasicOperations/Factorial.md: -------------------------------------------------------------------------------- 1 | # factorial 2 | 3 | ```hs 4 | module Algorithms.Nat.BasicOperations.Factorial where 5 | 6 | import GHC.Natural 7 | 8 | import Data.Functor.Foldable 9 | ``` 10 | 11 | The implementation of factorialization by hylo is described in Meijer (1991)[^1]. And it is also known as the implementation by "Cartesianally-inclined Haskell programmer"[^3]. 12 | 13 | ```hs 14 | -- | >>> factorialHylo 5 15 | -- 120 16 | factorialHylo :: Natural -> Natural 17 | factorialHylo = hylo g f 18 | where 19 | f 0 = Nil 20 | f n = Cons n (n-1) 21 | g Nil = 1 22 | g (Cons a b) = a * b 23 | ``` 24 | 25 | The implementation of factorialization by para is presented in Meertens(1990). And it's also known as the implementation by "Post-doc Haskell programmer"[^3]. 26 | 27 | ```hs 28 | -- | >>> factorialPara 5 29 | -- 120 30 | factorialPara :: Natural -> Natural 31 | factorialPara = para \case 32 | Nothing -> 1 33 | Just (n, a) -> (1 + n) * a 34 | ``` 35 | 36 | ## References 37 | [1] Meijer, Erik, Maarten Fokkinga, and Ross Paterson. "Functional programming with bananas, lenses, envelopes and barbed wire." Conference on Functional Programming Languages and Computer Architecture. Springer, Berlin, Heidelberg, 1991. 38 | [2] Meertens, Lambert. "Paramorphisms." Formal aspects of computing 4.5 (1992): 413-424. 39 | [3] Fritz Ruehr, Willamette University. "The Evolution of a Haskell Programmer" 40 | -------------------------------------------------------------------------------- /docs/Algorithms/Nat/BasicOperations/LessThan.md: -------------------------------------------------------------------------------- 1 | # lessThan 2 | 3 | ```hs 4 | module Algorithms.Nat.BasicOperations.LessThan where 5 | 6 | import GHC.Natural 7 | 8 | import RecursionSchemes.Extra 9 | ``` 10 | 11 | The `lessThan` can be implemented by comparing two natural numbers recursively by multimorphism[^1]; the same is true for `greaterThan` and `equal`. 12 | 13 | ```hs 14 | -- | >>> 1 `lessThan` 2 15 | -- True 16 | lessThan :: Natural -> Natural -> Bool 17 | lessThan = mmulti phi 18 | where 19 | phi _ Nothing Nothing = False 20 | phi _ Nothing (Just _) = True 21 | phi _ (Just _) Nothing = False 22 | phi lt (Just a) (Just b) = lt a b 23 | ``` 24 | 25 | ## References 26 | [1] Uustalu, Tarmo, and Varmo Vene. "Coding recursion a la Mendler." Department of Computer Science, Utrecht University. 2000. 27 | 28 | -------------------------------------------------------------------------------- /docs/Algorithms/Nat/BasicOperations/Product.md: -------------------------------------------------------------------------------- 1 | # product 2 | 3 | ```hs 4 | module Algorithms.Nat.BasicOperations.Product where 5 | 6 | import GHC.Natural 7 | 8 | import Data.Functor.Foldable 9 | ``` 10 | 11 | Multiplication can be represented as catamorphism. 12 | 13 | ```hs 14 | -- | >>> prodCata 2 3 15 | -- 6 16 | prodCata :: Natural -> Natural -> Natural 17 | prodCata n = cata \case 18 | Nothing -> 0 19 | Just m -> n + m 20 | ``` 21 | 22 | -------------------------------------------------------------------------------- /docs/Algorithms/Nat/Catalan.md: -------------------------------------------------------------------------------- 1 | # Catalan Numbers 2 | 3 | ```hs 4 | module Algorithms.Nat.Catalan where 5 | 6 | import GHC.Natural 7 | 8 | import Data.Foldable 9 | 10 | import Control.Comonad.Cofree 11 | import Data.Functor.Foldable 12 | ``` 13 | 14 | In order to calculate the Catalan number, we need to refer to all the results of the previous calculations. This type calculation is called as course-of-values recursion. We can implement the Catalan number by using Histomorphism[^1]. 15 | 16 | ```hs 17 | -- | >>> catalanHisto 5 18 | -- 42 19 | catalanHisto :: Natural -> Natural 20 | catalanHisto = histo \case 21 | Nothing -> 1 22 | Just table -> 23 | let xs = toList table 24 | in sum $ zipWith (*) xs (reverse xs) 25 | ``` 26 | 27 | `toList` is too specific and only for this situation. There is also an implementation of Catalan numbers using Dynamorphism in [1] so that the more general case can be assumed. 28 | 29 | ## References 30 | [1] Hinze, Ralf, and Nicolas Wu. "Histo-and Dynamorphisms Revisited." 31 | -------------------------------------------------------------------------------- /docs/Algorithms/Nat/Fibonacci.md: -------------------------------------------------------------------------------- 1 | # Fibonacci Numbers 2 | 3 | ```hs 4 | module Algorithms.Nat.Fibonacci where 5 | 6 | import GHC.Natural 7 | 8 | import Control.Comonad.Cofree 9 | import Data.Functor.Foldable 10 | ``` 11 | 12 | In order to calculate the Fibonacci number, we need to know the previous two Fibonacci numbers. The Fibonacci number can be calculated using Histomorphism, which can refer to any previous result[^1]. 13 | 14 | ```hs 15 | -- | >>> fibHisto 5 16 | -- 8 17 | fibHisto :: Natural -> Natural 18 | fibHisto = histo \case 19 | Nothing -> 1 20 | Just (_ :< Nothing) -> 1 21 | Just (n :< Just (m :< _)) -> n + m 22 | ``` 23 | 24 | Using Mendler-style histo, it can be implemented without being aware of the intermediate structure[^2]. 25 | 26 | ```hs 27 | -- | >>> fiboMHisto 5 28 | -- 8 29 | fiboMHisto :: Natural -> Natural 30 | fiboMHisto = mhisto phi . refix 31 | where 32 | phi f unIn Nothing = 1 33 | phi f unIn (Just n) = case unIn n of 34 | Nothing -> 1 35 | (Just n') -> f n + f n' 36 | ``` 37 | 38 | ## References 39 | [1] Uustalu, Tarmo, and Varmo Vene. "Primitive (co) recursion and course-of-value (co) iteration, categorically." Informatica 10.1 (1999): 5-26. 40 | [2] Uustalu, Tarmo, and Varmo Vene. "Coding recursion a la Mendler." Department of Computer Science, Utrecht University. 2000. 41 | -------------------------------------------------------------------------------- /docs/Algorithms/Tree/BasicOperations/Depth.md: -------------------------------------------------------------------------------- 1 | # depth 2 | 3 | ```hs 4 | module Algorithms.Tree.BasicOperations.Depth where 5 | 6 | import GHC.Natural 7 | 8 | import Data.Functor.Foldable 9 | 10 | import DataStructures.Tree 11 | ``` 12 | 13 | `depth` is a function for calculating the hight of the tree. 14 | 15 | ```hs 16 | -- | >>> depthCata (node 1 (leaf 2) (node 3 (node 4 (leaf 5) (leaf 6)) (leaf 7))) 17 | -- 4 18 | depthCata :: Tree a -> Natural 19 | depthCata = cata \case 20 | Leaf _ -> 1 21 | Node _ l r -> 1 + l `max` r 22 | ``` 23 | -------------------------------------------------------------------------------- /docs/Algorithms/Tree/BreadthFirstSearch.md: -------------------------------------------------------------------------------- 1 | # Breadth First Search 2 | 3 | ```hs 4 | module Algorithms.Tree.BreadthFirstSearch where 5 | 6 | import Control.Applicative 7 | 8 | import Data.Functor.Foldable 9 | 10 | import DataStructures.Levels 11 | import DataStructures.Tree 12 | ``` 13 | 14 | Breadth First Search is an algorithm to find the elements in the tree that satisfy certain conditions. It is characterized by exploring nodes in same depth. The algorithm can be divided into two processes. The first step is to enumerate elements in the order in which they are to be explored. The next step is to find the elements from enumerated items using the usual find function. The benefit of the lazy evaluation allows these to be combined efficiently. We use `Levels` to enumerate items in which the depth of items is presereved as a level. This implementation references [Kidne and Wu 2021][^1]. 15 | 16 | We will only implement the first step, converting the tree to a `Levels`. 17 | 18 | ```hs 19 | -- | >>> bfsCata (node 1 (leaf 2) (node 3 (node 4 (leaf 6) (leaf 7)) (leaf 5))) 20 | -- Levels [[1],[2,3],[4,5],[6,7]] 21 | bfsCata :: Tree a -> Levels a 22 | bfsCata = cata \case 23 | Leaf a -> pure a 24 | Node a l r -> pure a <|> wrap (l <|> r) 25 | ``` 26 | 27 | [1] Donnacha Oisín Kidney and Nicolas Wu. 2021. Algebras for weighted search. Proc. ACM Program. Lang. 5, ICFP, Article 72 (August 2021), 30 pages. DOI:https://doi.org/10.1145/3473577 -------------------------------------------------------------------------------- /docs/Algorithms/Tree/DepthFirstSearch.md: -------------------------------------------------------------------------------- 1 | # Depth First Search 2 | 3 | ```hs 4 | module Algorithms.Tree.DepthFirstSearch where 5 | 6 | import Data.Functor.Foldable 7 | 8 | import DataStructures.Tree 9 | ``` 10 | 11 | Deep First Search is an algorithm to find the elements in the tree that satisfy certain conditions. It is characterized by exploring deeper nodes first. The algorithm can be divided into two processes. The first step is to create a list of elements in the order in which they are to be explored. The next step is to find the elements from the list using the usual find function. The benefit of the lazy evaluation allows these to be combined efficiently. 12 | 13 | We will only implement the first step, converting the tree to a list. 14 | 15 | ```hs 16 | -- | >>> dfsCata (node 1 (leaf 2) (node 3 (node 4 (leaf 5) (leaf 6)) (leaf 7))) 17 | -- [1,2,3,4,5,6,7] 18 | dfsCata :: Tree a -> [a] 19 | dfsCata = cata \case 20 | Leaf a -> [a] 21 | Node a l r -> a : (l ++ r) 22 | ``` 23 | -------------------------------------------------------------------------------- /docs/DataStructures/Levels.md: -------------------------------------------------------------------------------- 1 | # Levels 2 | 3 | ```hs 4 | module DataStructures.Levels where 5 | 6 | import Control.Applicative 7 | ``` 8 | 9 | `Levels` is not recursive data type, but it is important to implement [breadth-first search](/recursion-algorithms/Algorithms/Tree/BreadthFirstSearch.html). Implementations in here reference to [Kidne and Wu 2021][^1]. Note that `Levels` doesn't follow the Applicative and Monad law, since below implementation using list for inner groups. 10 | 11 | ```hs 12 | newtype Levels a = Levels [[a]] 13 | deriving (Show, Eq) 14 | 15 | choices :: Alternative f => (a -> f b) -> [a] -> f b 16 | choices f [] = empty 17 | choices f (x:xs) = f x <|> choices f xs 18 | 19 | wrap :: Levels a -> Levels a 20 | wrap (Levels xs) = Levels ([] : xs) 21 | 22 | zipL :: [[a]] -> [[a]] -> [[a]] 23 | zipL [] yss = yss 24 | zipL xss [] = xss 25 | zipL (xs:xss) (ys:yss) = (xs ++ ys) : zipL xss yss 26 | 27 | instance Functor Levels where 28 | fmap f (Levels xss) = Levels (map (map f) xss) 29 | 30 | instance Foldable Levels where 31 | foldMap f (Levels xss) = mconcat $ map (mconcat . map f) xss 32 | 33 | instance Applicative Levels where 34 | pure x = Levels [[x]] 35 | (Levels []) <*> _ = Levels [] 36 | (Levels (fs:fss)) <*> (Levels xss) = Levels (map (fs <*>) xss) <|> wrap (Levels fss <*> Levels xss) 37 | 38 | instance Alternative Levels where 39 | empty = Levels [] 40 | (Levels xss) <|> (Levels yss) = Levels (zipL xss yss) 41 | 42 | instance Monad Levels where 43 | (Levels []) >>= k = empty 44 | (Levels (xs:xss)) >>= k = choices k xs <|> wrap (Levels xss >>= k) 45 | ``` 46 | 47 | ## References 48 | [1] Donnacha Oisín Kidney and Nicolas Wu. 2021. Algebras for weighted search. Proc. ACM Program. Lang. 5, ICFP, Article 72 (August 2021), 30 pages. DOI: 49 | -------------------------------------------------------------------------------- /docs/DataStructures/List.md: -------------------------------------------------------------------------------- 1 | # List 2 | 3 | ```hs 4 | module DataStructures.List where 5 | 6 | import Data.Functor.Foldable 7 | 8 | import RecursionSchemes.Extra 9 | ``` 10 | 11 | The list is the most basic data type to consider in recursion schemes. 12 | 13 | ```hs 14 | -- data ListF a r = Nil | Cons a r 15 | -- 16 | -- type List a = Fix (ListF a) 17 | 18 | listFold :: FoldAlgebra ListF 19 | listFold Nil = id 20 | listFold (Cons a b) = b . a 21 | ``` 22 | -------------------------------------------------------------------------------- /docs/DataStructures/Nat.md: -------------------------------------------------------------------------------- 1 | # Nat 2 | 3 | ```hs 4 | module DataStructures.Nat where 5 | 6 | import Data.Functor.Foldable 7 | ``` 8 | 9 | The natural number can be seen as the fixed point of a certain functor. This functor is isomorphic to the data type Maybe, and is implemented as such in the recursion schemes library. 10 | 11 | ```hs 12 | data NatF r = Zero | Succ r 13 | 14 | type Nat = Fix NatF 15 | ``` 16 | -------------------------------------------------------------------------------- /docs/DataStructures/Tree.md: -------------------------------------------------------------------------------- 1 | # Tree 2 | 3 | ```hs 4 | module DataStructures.Tree where 5 | 6 | import Data.Functor.Foldable 7 | ``` 8 | 9 | There are a lot of trees in the world, but here we are dealing with a binary tree. Tree structures are also one of the data types that can be represented as the fixed point. 10 | 11 | 12 | ```hs 13 | data TreeF a r = Leaf a | Node a r r 14 | deriving Functor 15 | 16 | type Tree a = Fix (TreeF a) 17 | 18 | leaf :: a -> Tree a 19 | leaf = Fix . Leaf 20 | 21 | node :: a -> Tree a -> Tree a -> Tree a 22 | node a l r = Fix $ Node a l r 23 | ``` 24 | -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | ``` 2 | ██████╗ ███████╗ ██████╗██╗ ██╗██████╗ ███████╗██╗ ██████╗ ███╗ ██╗ 3 | ██╔══██╗██╔════╝██╔════╝██║ ██║██╔══██╗██╔════╝██║██╔═══██╗████╗ ██║ 4 | ██████╔╝█████╗ ██║ ██║ ██║██████╔╝███████╗██║██║ ██║██╔██╗ ██║ 5 | ██╔══██╗██╔══╝ ██║ ██║ ██║██╔══██╗╚════██║██║██║ ██║██║╚██╗██║ 6 | ██║ ██║███████╗╚██████╗╚██████╔╝██║ ██║███████║██║╚██████╔╝██║ ╚████║ 7 | ╚═╝ ╚═╝╚══════╝ ╚═════╝ ╚═════╝ ╚═╝ ╚═╝╚══════╝╚═╝ ╚═════╝ ╚═╝ ╚═══╝ 8 | 9 | █████╗ ██╗ ██████╗ ██████╗ ██████╗ ██╗████████╗██╗ ██╗███╗ ███╗███████╗ 10 | ██╔══██╗██║ ██╔════╝ ██╔═══██╗██╔══██╗██║╚══██╔══╝██║ ██║████╗ ████║██╔════╝ 11 | ███████║██║ ██║ ███╗██║ ██║██████╔╝██║ ██║ ███████║██╔████╔██║███████╗ 12 | ██╔══██║██║ ██║ ██║██║ ██║██╔══██╗██║ ██║ ██╔══██║██║╚██╔╝██║╚════██║ 13 | ██║ ██║███████╗╚██████╔╝╚██████╔╝██║ ██║██║ ██║ ██║ ██║██║ ╚═╝ ██║███████║ 14 | ╚═╝ ╚═╝╚══════╝ ╚═════╝ ╚═════╝ ╚═╝ ╚═╝╚═╝ ╚═╝ ╚═╝ ╚═╝╚═╝ ╚═╝╚══════╝ 15 | ``` 16 | 17 | [![GitHub](https://img.shields.io/github/license/lotz84/recursion-algorithms)](LICENSE) 18 | [![GitHub Actions](https://github.com/lotz84/recursion-algorithms/actions/workflows/test.yaml/badge.svg)](https://github.com/lotz84/recursion-algorithms/actions/workflows/test.yaml) 19 | [![GitHub contributors](https://img.shields.io/github/contributors/lotz84/recursion-algorithms)](https://github.com/lotz84/recursion-algorithms/graphs/contributors) 20 | 21 | This respository is a collection of various algorithms written using recursion schemes. Recursion schemes brings a brilliant perspective guided by Category Theory to recursive data structures and algorithms. I was particularly impressed by ["A Duality of Sorts" written by R. Hinze et al.](https://www.semanticscholar.org/paper/A-Duality-of-Sorts-Hinze-Magalh%C3%A3es/62a1d9ecaea95fbceb42c644ca38dd577b85fe4d) that pointed out that there is a nice duality between the well-known sorting algorithms. 22 | 23 | The purpose of this repository is to provide **a broad and comprehensive collection of algorithms written by recursion schemes** to discover hidden relationships between algorithms. This is a work in progress and I can only work on it in my free time, so contributions will be greatly appreciated. For more information on how to contribute, please refer to "How to get involved" below. 24 | 25 | This repository uses [recursion-schemes](https://hackage.haskell.org/package/recursion-schemes) to implement the algorithm. If any recursion schemes are missing, they are implemented in the [Extra Recursion Schemes](RecursionSchemes/Extra.md). 26 | 27 | ## Table of Contents 28 | ### Data Structures 29 | - [Nat](DataStructures/Nat.md) 30 | - [List](DataStructures/List.md) 31 | - [Tree](DataStructures/Tree.md) 32 | - [Levels](DataStructures/Levels.md) 33 | 34 | ### Algorithms 35 | - Natural Number 36 | - Basic Operations 37 | - [add](Algorithms/Nat/BasicOperations/Add.md) 38 | - [product](Algorithms/Nat/BasicOperations/Product.md) 39 | - [factorial](Algorithms/Nat/BasicOperations/Factorial.md) 40 | - [lessThan](Algorithms/Nat/BasicOperations/LessThan.md) 41 | - [Fibonacci Numbers](Algorithms/Nat/Fibonacci.md) 42 | - [Catalan Numbers](Algorithms/Nat/Catalan.md) 43 | - List 44 | - Basic Operations 45 | - [length](Algorithms/List/BasicOperations/Length.md) 46 | - [filter](Algorithms/List/BasicOperations/Filter.md) 47 | - [map](Algorithms/List/BasicOperations/Map.md) 48 | - [zip](Algorithms/List/BasicOperations/Zip.md) 49 | - [iterate](Algorithms/List/BasicOperations/Iterate.md) 50 | - [reverse](Algorithms/List/BasicOperations/Reverse.md) 51 | - [span](Algorithms/List/BasicOperations/Span.md) 52 | - [groupBy](Algorithms/List/BasicOperations/GroupBy.md) 53 | - [subsequences](Algorithms/List/BasicOperations/Subsequences.md) 54 | - [permutations](Algorithms/List/BasicOperations/Permutations.md) 55 | - [scanr / scanl](Algorithms/List/BasicOperations/Scanr.md) 56 | - [take / drop](Algorithms/List/BasicOperations/Take.md) 57 | - [takeWhile / dropWhile](Algorithms/List/BasicOperations/TakeWhile.md) 58 | - [inits / tails](Algorithms/List/BasicOperations/Inits.md) 59 | - [Edit Distance](Algorithms/List/EditDistance.md) 60 | - [Longest Common Subsequence](Algorithms/List/LongestCommonSubsequence.md) 61 | - [Run Length Conversion](Algorithms/List/RunLengthConversion.md) 62 | - [Matrix Chain Multiplication](Algorithms/List/MatrixChainMultiplication.md) 63 | - Sorting 64 | - [Insertion Sort](Algorithms/List/Sorting/InsertionSort.md) 65 | - [Selection Sort](Algorithms/List/Sorting/SelectionSort.md) 66 | - Tree 67 | - Basic Operations 68 | - [depth](Algorithms/Tree/BasicOperations/Depth.md) 69 | - [Depth First Search](Algorithms/Tree/DepthFirstSearch.md) 70 | - [Breadth First Search](Algorithms/Tree/BreadthFirstSearch.md) 71 | - [Extra Recursion Schemes](RecursionSchemes/Extra.md) 72 | 73 | ## How it works 74 | All algorithms have been tested by [doctest](https://hackage.haskell.org/package/doctest). To make the code test compatible with the markdown used in GitHub Pages, there's a conversion process from markdown to Haskell in the stack test. 75 | 76 | ## How to get involved 77 | Please, feel free to send a PR with 78 | 79 | - implementing an algorithm that doesn't yet exist (don't forget to explain and doctest), 80 | - adding a recursive data structure that can be represented as an fixed point, 81 | - adding a description of some recursion schemes, 82 | - and fixes of typos/bugs/etc. 83 | 84 | And if any of the references are wrong or not appropriate, please let me know. If you have any feedback, please make an issue or contact [@lotz84\_](https://twitter.com/lotz84_). 85 | 86 | ## Related Projects 87 | - [tayllan/awesome-algorithms: A curated list of awesome places to learn and/or practice algorithms.](https://github.com/tayllan/awesome-algorithms) 88 | -------------------------------------------------------------------------------- /docs/RecursionSchemes/Extra.md: -------------------------------------------------------------------------------- 1 | # Extra Recursion Schemes 2 | 3 | ```hs 4 | {-# LANGUAGE ExistentialQuantification #-} 5 | {-# LANGUAGE FlexibleContexts #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | module RecursionSchemes.Extra where 8 | 9 | import Control.Monad ((>=>)) 10 | import Data.Bifunctor 11 | 12 | import Control.Comonad 13 | import Control.Comonad.Cofree 14 | import Control.Foldl 15 | import Data.Functor.Foldable 16 | ``` 17 | 18 | Here is a collection of implementations of recursion schemes that are not implemented in recursion-schemes. 19 | 20 | ## Dynamorphism 21 | Dynamorphism is the recursion schemes proposed by Kabanov and Vene to realize dynamic programming[^1]. Simply put, it is represented as a refold of Anamorphism and Histomorphism.However, here we implement Dynamorphism as an extension of Hylomorphism in order not to lose generality. 22 | 23 | ```hs 24 | dyna :: Functor f => (f (Cofree f x) -> x) -> (y -> f y) -> (y -> x) 25 | dyna phi psi = extract . hylo ap psi 26 | where ap f = phi f :< f 27 | ``` 28 | 29 | ## Multimorphism 30 | 31 | Multimorphism is a recursion schemes that deals with the two recursive type at the same time[^2]. 32 | 33 | ```hs 34 | mmulti :: (Recursive f, Recursive g) => (forall a b. (a -> b -> c) -> Base f a -> Base g b -> c) -> f -> g -> c 35 | mmulti psi f g = psi (mmulti psi) (project f) (project g) 36 | ``` 37 | 38 | `mmulti` can also be implemented using Day convolution as type `(Day (Base f) (Base g) c -> c) -> f -> g -> c`[^3]. 39 | 40 | Since `Co f` is the right adjoint of `Day f`, we can rewrite mmulti using transpose[^4]. 41 | 42 | `mmulti' :: (Recursive f, Recursive g) => (forall r. Base g c -> Base f (c -> r) -> r) -> f -> g -> c` 43 | 44 | ## Monoidal Catamorphism 45 | 46 | This idea was introduced by Bartosz Milewski as an extension of Foldl to RecursionSchemes[^5]. Here we use endomorphsm instead of monoids to match the implementation in the Foldl library. 47 | 48 | ```hs 49 | type FoldAlgebra f = forall x. f (x -> x) (x -> x) -> (x -> x) 50 | 51 | cat :: (Bifunctor f, Functor (f a)) => FoldAlgebra f -> Fold a b -> Fix (f a) -> b 52 | cat falg (Fold step begin done) = done . ($ begin) . cata (falg . bimap (flip step) id) 53 | ``` 54 | 55 | ## Monadic Recursion Schemes 56 | Monadic catamorphism[^6] can be implemented as a special case of ordinary catamorphism[^7]. 57 | 58 | ```hs 59 | cataM :: (Traversable (Base t), Monad m, Recursive t) 60 | => (Base t c -> m c) -> t -> m c 61 | cataM = cata . (sequence >=>) 62 | ``` 63 | 64 | You can also implement monadic paramorphism in a similar way. 65 | 66 | ```hs 67 | paraM :: (Recursive t, Monad m, Traversable (Base t)) 68 | => (Base t (t, c) -> m c) -> t -> m c 69 | paraM = para . (sequence . fmap sequence >=>) 70 | ``` 71 | 72 | ## References 73 | [1] Kabanov, Jevgeni, and Varmo Vene. "Recursion schemes for dynamic programming." International Conference on Mathematics of Program Construction. Springer, Berlin, Heidelberg, 2006. 74 | [2] Uustalu, Tarmo, and Varmo Vene. "Coding recursion a la Mendler." Department of Computer Science, Utrecht University. 2000. 75 | [3] [sellout/yaya - Yaya.Fold#cata2](https://github.com/sellout/yaya/blob/d75598e08b4ea85946857f7c0643811b858a9b2b/core/src/Yaya/Fold.hs#L178-L181) 76 | [4] [kan-extensions - Control.Monad.Co](https://hackage.haskell.org/package/kan-extensions-5.2.1/docs/Control-Monad-Co.html) 77 | [5] [Monoidal Catamorphisms \| Bartosz Milewski's Programming Cafe](https://bartoszmilewski.com/2020/06/15/monoidal-catamorphisms/) 78 | [6] Fokkinga, Maarten Maria. Monadic maps and folds for arbitrary datatypes. University of Twente, Department of Computer Science, 1994. 79 | [7] [Suggestion: Add monadic variants of various ...morphism functions. · Issue #3 · ekmett/recursion-schemes](https://github.com/ekmett/recursion-schemes/issues/3) 80 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: recursion-algorithms 2 | github: "lotz84/recursion-algorithms" 3 | license: BSD3 4 | copyright: "2020 Tatsuya Hirose" 5 | 6 | dependencies: 7 | - base >= 4.7 && < 5 8 | 9 | library: 10 | dependencies: 11 | - comonad 12 | - foldl 13 | - free 14 | - recursion-schemes 15 | 16 | tests: 17 | recursion-algorithms-test: 18 | main: Doctest.hs 19 | source-dirs: test 20 | ghc-options: 21 | - -threaded 22 | - -rtsopts 23 | - -with-rtsopts=-N 24 | dependencies: 25 | - cmark-gfm 26 | - directory 27 | - doctest 28 | - filepath 29 | - text 30 | -------------------------------------------------------------------------------- /recursion-algorithms.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.33.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | -- 7 | -- hash: fcf51f82bb48de70f2d6982a2ea7d9b0fc081ed38568e566fb1d3ef2642ccacc 8 | 9 | name: recursion-algorithms 10 | version: 0.0.0 11 | homepage: https://github.com/lotz84/recursion-algorithms#readme 12 | bug-reports: https://github.com/lotz84/recursion-algorithms/issues 13 | copyright: 2020 Tatsuya Hirose 14 | license: BSD3 15 | license-file: LICENSE 16 | build-type: Simple 17 | 18 | source-repository head 19 | type: git 20 | location: https://github.com/lotz84/recursion-algorithms 21 | 22 | library 23 | other-modules: 24 | Paths_recursion_algorithms 25 | build-depends: 26 | base >=4.7 && <5 27 | , comonad 28 | , foldl 29 | , free 30 | , recursion-schemes 31 | default-language: Haskell2010 32 | 33 | test-suite recursion-algorithms-test 34 | type: exitcode-stdio-1.0 35 | main-is: Doctest.hs 36 | other-modules: 37 | Directory 38 | Docs2Hs 39 | RemoveHs 40 | Paths_recursion_algorithms 41 | hs-source-dirs: 42 | test 43 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 44 | build-depends: 45 | base >=4.7 && <5 46 | , cmark-gfm 47 | , directory 48 | , doctest 49 | , filepath 50 | , text 51 | default-language: Haskell2010 52 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-15.7 2 | packages: 3 | - . 4 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 491389 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/7.yaml 11 | sha256: 92ab6303fe20ec928461c82ce0980b4d17c06f4e66205a2967e476474f686c17 12 | original: lts-15.7 13 | -------------------------------------------------------------------------------- /test/Directory.hs: -------------------------------------------------------------------------------- 1 | module Directory where 2 | 3 | import Control.Monad (forM) 4 | 5 | import System.Directory 6 | import System.FilePath 7 | 8 | -- | Manipulate subdirectories recursively to enumerate only files 9 | listDirectoryRecursively :: FilePath -> IO [FilePath] 10 | listDirectoryRecursively prepath = do 11 | ps <- listDirectory prepath 12 | fmap concat . forM ps $ \path -> do 13 | let fullpath = prepath path 14 | isDir <- doesDirectoryExist fullpath 15 | if isDir 16 | then listDirectoryRecursively fullpath 17 | else pure [fullpath] 18 | -------------------------------------------------------------------------------- /test/Docs2Hs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Docs2Hs where 4 | 5 | import Control.Monad (forM_, when) 6 | import Data.Maybe (catMaybes) 7 | 8 | import CMarkGFM 9 | import Data.Text (Text) 10 | import qualified Data.Text as T 11 | import qualified Data.Text.IO as T 12 | import System.FilePath (splitExtension) 13 | 14 | import Directory (listDirectoryRecursively) 15 | 16 | -- | Function to manipulate a Node recursively while transforming the NodeType 17 | mapNode :: (NodeType -> a) -> Node -> [a] 18 | mapNode f (Node _ nt []) = [f nt] 19 | mapNode f (Node _ nt ns) = f nt : concatMap (mapNode f) ns 20 | 21 | 22 | -- | Merge and return only the contents of the hs/haskell code block of Markdown text 23 | -- If there is no corresponding code block, it returns Nothing 24 | md2hs :: Text -> Maybe Text 25 | md2hs = aggregate . catMaybes . mapNode getHsText . commonmarkToNode [] [] 26 | where 27 | getHsText (CODE_BLOCK "hs" code) = Just code 28 | getHsText (CODE_BLOCK "haskell" code) = Just code 29 | getHsText _ = Nothing 30 | aggregate [] = Nothing 31 | aggregate ts = Just (T.unlines ts) 32 | 33 | 34 | -- | Converts all markdown files under the specified folder to a haskell file. 35 | -- This process searches the folder recursively. 36 | docs2Hs :: FilePath -> IO () 37 | docs2Hs dir = do 38 | ps <- listDirectoryRecursively dir 39 | forM_ ps $ \path -> 40 | let (filename, ext) = splitExtension path 41 | in when (ext == ".md") $ do 42 | code <- md2hs <$> T.readFile path 43 | case code of 44 | Nothing -> pure () 45 | Just code -> T.writeFile (filename ++ ".hs") code 46 | -------------------------------------------------------------------------------- /test/Doctest.hs: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | import Test.DocTest 5 | 6 | import Docs2Hs (docs2Hs) 7 | import RemoveHs (removeHs) 8 | 9 | main :: IO () 10 | main = do 11 | removeHs "docs" 12 | docs2Hs "docs" 13 | doctest [ "-XBlockArguments" 14 | , "-XDeriveFunctor" 15 | , "-XLambdaCase" 16 | , "docs" 17 | ] 18 | -------------------------------------------------------------------------------- /test/RemoveHs.hs: -------------------------------------------------------------------------------- 1 | module RemoveHs where 2 | 3 | import Control.Monad (forM_, when) 4 | 5 | import System.Directory (removeFile) 6 | import System.FilePath (splitExtension) 7 | 8 | import Directory (listDirectoryRecursively) 9 | 10 | removeHs :: FilePath -> IO () 11 | removeHs dir = do 12 | ps <- listDirectoryRecursively dir 13 | forM_ ps $ \path -> 14 | let (filename, ext) = splitExtension path 15 | in when (ext == ".hs") $ removeFile path --------------------------------------------------------------------------------