Difference between revisions of "Blow your mind"

From HaskellWiki
Jump to: navigation, search
(Mathematical sequences, etc: comment tweak re complexity)
 
(94 intermediate revisions by 33 users not shown)
Line 1: Line 1:
= Useful, Cool, Magical Idioms =
+
Useful Idioms that will blow your mind (unless you already know them :)
  
this collection is supposed to be comprised of short, useful, cool, magical  examples, which incite curiosity in the reader and (hopefully) lead him to a deeper understanding of advanced haskell concepts. at a later time i might add explanations to the more obscure solutions. i've also started providing several alternatives to give more insight into the interrelations of solutions.
+
This collection is supposed to be comprised of short, useful, cool, magical  examples, which should incite the reader's curiosity and (hopefully) lead to a deeper understanding of advanced Haskell concepts. At a later time I might add explanations to the more obscure solutions. I've also started providing several alternatives to give more insight into the interrelations of solutions.
  
whoever has any more ideas, please feel free to just add them; if you see mistakes or simpler solutions please correct my chaotic collection. i'm very interested in more "obscure" solutions, which showcase the applicability of haskell's (unique) features (i.e. monad magic, folds and unfolds, fix points, ...)
+
More examples are always welcome, especially "obscure" monadic ones.
  
  
<code>
+
== List/String operations ==
  -- splitting in twos (alternating)
 
  -- "1234567" -> ("1357", "246")
 
  foldr (\a (x,y) -> (a:y,x)) ([],[])
 
 
 
 
 
  -- splitting in N
 
  -- 2 -> "1234567" -> ["12", "34", "56", "7"]
 
  List.unfoldr (\a -> if null a then Nothing else Just $ splitAt 2 a) "1234567"
 
  
  fst . until (null . snd) (\(a,b) -> let (x,y) = splitAt 2 b in (a++[x],y)) $ ([], "1234567")
 
  
               
+
<haskell>
 
   -- split at whitespace
 
   -- split at whitespace
 
   -- "hello world" -> ["hello","world"]
 
   -- "hello world" -> ["hello","world"]
 
   words
 
   words
  
   fst . until (null . snd)  
+
   unfoldr (\b -> fmap (const . (second $ drop 1) . break (==' ') $ b) . listToMaybe $ b)
              (\(a,b) -> let (x,y) = break (==' ') b
+
 
                        in (a++[x], drop 1 y))  
+
  takeWhile (not . null) . evalState (repeatM $ modify (drop 1)  
              $ ([], "hello world")
+
    >> State (break (== ' '))) . (' ' :)
 +
    where repeatM = sequence . repeat
 +
 
 +
  fix (\f l -> if null l then [] else let (s,e) = break (==' ') l in s:f (drop 1 e))
 +
 
  
 +
  -- splitting in two alternating subsequences
 +
  -- "1234567" -> ("1357", "246")
 +
  -- the lazy match with ~ is necessary for laziness, 
 +
  -- especially to enable processing of infinite lists
 +
  foldr (\a ~(x,y) -> (a:y,x)) ([],[])
  
   -- combinations
+
   (map snd *** map snd) . partition (even . fst) . zip [0..]
  -- "12" -> "45" -> ["14", "15", "24", "25"]
 
  sequence ["12", "45"]
 
  [[x,y] | x <- "12", y <- "45"]
 
  do { x <- "12"; y <- "45"; return [x,y] }
 
  "12" >>= \a -> "45" >>= \b -> return ([a,b])
 
  
 +
  transpose . unfoldr (\a -> toMaybe (not $ null a) (splitAt 2 a))
 +
  -- this one uses the solution to the next problem in a nice way :)
 +
 
 +
  toMaybe b x = if b then Just x else Nothing
 +
  -- or generalize it:
 +
  -- toMaybe = (toMonadPlus :: Bool -> a -> Maybe a)
 +
  toMonadPlus b x = guard b >> return x
 +
  -- or with MonadComprehensions: [x | b]
  
   -- factorial
+
   -- splitting into lists of length N
   -- 6 -> 720
+
   -- "1234567" -> ["12", "34", "56", "7"]
  product [1..6]
+
   unfoldr (\a -> toMaybe (not $ null a) (splitAt 2 a))
  foldl1 (*) [1..6]
 
   (!!6) $ unfoldr (\(n,f) -> Just (f, (n+1,f*n))) (1,1)
 
  fix (\f (n,g) -> if n <= 0 then g else f (n-1,g*n)) (6,1)
 
  
 +
  takeWhile (not . null) . unfoldr (Just . splitAt 2)
  
   -- interspersing with newlines
+
   ensure :: MonadPlus m => (a -> Bool) -> a -> m a
   -- ["hello","world"] -> "hello world"
+
   ensure p x = guard (p x) >> return x
   unlines
+
   unfoldr (ensure (not . null . fst) . splitAt 2)
  intersperse '\n'
+
               
  
 
 
   -- sorting by a custom function
 
   -- sorting by a custom function
 
   -- length -> ["abc", "ab", "a"] -> ["a", "ab", "abc"]
 
   -- length -> ["abc", "ab", "a"] -> ["a", "ab", "abc"]
   sortBy length
+
  comparing f = compare `on` f -- "comparing" is already defined in Data.Ord
   map snd . sortBy fst . map (length &&& id)  
+
   sortBy (comparing length)
 +
 
 +
   map snd . sortBy (comparing fst) . map (length &&& id)
 +
  -- the so called "Schwartzian Transform" for computationally more expensive
 +
  -- functions.
 +
 
 +
  -- comparing adjacent elements
 +
  rises xs = zipWith (<) xs (tail xs)
 
    
 
    
    
+
   -- lazy substring search
   -- zweierpotenzen
+
  -- "ell" -> "hello" -> True
   iterate (*2) 1
+
  substr a b = any (a `isPrefixOf`) $ tails b
   unfoldr (\z -> Just (z,2*z)) 1
+
 
 +
  -- multiple splitAt's:
 +
  -- splitAts [2,5,0,3] [1..15] == [[1,2],[3,4,5,6,7],[],[8,9,10],[11,12,13,14,15]]
 +
  splitAts = foldr (\n r -> splitAt n >>> second r >>> uncurry (:)) return
 +
 
 +
  -- frequency distribution
 +
  -- "abracadabra" -> fromList [('a',5),('b',2),('c',1),('d',1),('r',2)]
 +
  import Data.Map
 +
  histogram = fromListWith (+) . (`zip` repeat 1)
 +
 
 +
   -- using arrows and sort
 +
  histogramArr = map (head&&&length) . group . sort
 +
 
 +
  -- multidimensional zipWith
 +
  zip2DWith :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
 +
  zip2DWith = zipWith . zipWith
 +
  zip3DWith :: (a -> b -> c) -> [[[a]]] -> [[[b]]] -> [[[c]]]
 +
  zip3DWith = zipWith . zipWith . zipWith
 +
  -- etc.
 +
</haskell>
 +
 
 +
== Mathematical sequences, etc ==
 +
 
 +
 
 +
<haskell>
 +
  -- factorial 6 = 720
 +
  product [1..6]
 +
 
 +
  foldl' (*) 1 [1..6]
 +
 
 +
  (!!6) $ scanl (*) 1 [1..]
 +
 
 +
  fix (\f n -> if n <= 0 then 1 else n * f (n-1)) 6
 +
 
 +
 
 +
  -- powers of two sequence
 +
   iterate (2*) 1
 +
 
 +
  fix ((1:) . map (2*))
 +
 
 +
   unfoldr (\z -> Just (z, 2*z)) 1
 +
 
 +
 
 +
  -- fibonacci sequence
 +
  unfoldr (\(a,b) -> Just (a,(b,a+b))) (0,1)
 +
 
 +
  fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
 +
 
 +
  fib = 0 : scanl (+) 1 fib    -- also,  fix ((0:) . scanl (+) 1)
 +
 
 +
 
 +
  -- pascal triangle
 +
  pascal = iterate (\row -> zipWith (+) ([0] ++ row) (row ++ [0])) [1]
 +
 
 +
 
 +
  -- prime numbers 
 +
  primes = sieve [2..] where
 +
          sieve (p:xs) = p : sieve [ n | n <- xs, n `mod` p > 0 ]
 +
 
 +
  unfoldr  sieve [2..] where
 +
          sieve (p:xs) = Just(p,  [ n | n <- xs, n `mod` p > 0 ])
 +
 
 +
  otherPrimes = nubBy (((>1).).gcd) [2..]
 +
 
 +
 
 +
  -- or if you want to use the Sieve of Eratosthenes
 +
  diff xl@(x:xs) yl@(y:ys) | x < y    = x:diff xs yl
 +
                          | x > y    =  diff xl ys
 +
                          | otherwise =  diff xs ys
 +
 
 +
  eprimes = sieve [2..] where
 +
            sieve (p:xs) = p : sieve (diff xs [p, p+p..])
 +
        -- sieve (splitAt 1 -> (h@(p:_),t)) =
 +
        --                h ++ sieve (diff t [p, p+p..])
 +
 
 +
  fix $ map head . scanl diff [2..] . map (\p -> [p, p+p..])
 +
 
 +
 
 +
  -- postponed to squares for under n^1.5 complexity
 +
  -- instead of above n^2.0
 +
  peprimes = 2 : sieve [[p*p, p*p+p..] | p <- peprimes] [3..] where
 +
                sieve ((q:cs):r) (span (< q) -> (h,_:t)) =
 +
                          h ++ sieve r (diff t cs)
 +
 
 +
  -- tree-folded, ~n^1.2, w/ data-ordlist's Data.List.Ordered.unionAll
 +
  2 : _Y ((3:) . diff [5,7..] . unionAll . map (\p -> [p*p, p*p+p..]))
 +
 
 +
  _Y g = g (_Y g)    -- non-sharing recursion prevents memory retention
 +
 
 +
 
 +
  -- Hamming numbers (`union`, `mergeAll` from data-ordlist)
 +
  h = 1 : foldr (\k -> union (map (k*) h)) [] [2,3,5]
 +
      -- or even just
 +
  h = 1 : unionAll [map (k*) h | k <- [2,3,5]]
 +
 
 +
  foldr (\n -> mergeAll . map (iterate (*n))) [1] [2,3,5]
 +
  foldr (\n -> mergeAll . iterate (map (*n))) [1] [2,3,5]  -- this too
 +
 
 +
  h = 1 : foldr (\n s -> fix (merge s . map (n*) . (1:))) [] [2,3,5]
 +
  --  h = 1 : fix (merge s3 . map (2*) . (1:)) where
 +
  --                    s3 = fix (merge s5 . map (3*) . (1:))) where
 +
  --                                    s5 = fix (map (5*) . (1:)))
 +
 
 +
  merge a@(x:xs) b@(y:ys) | x < y    = x : merge xs  b  -- merge assumes
 +
                      -- | x == y    = x : union xs ys  --  there's no dups
 +
                          | otherwise = y : merge a  ys
 +
  merge [] b = b  -- merge [] = \b -> b = id  -- (id .) = id
 +
  merge a [] = a
 +
 
 +
 
 +
  -- enumerating the rationals (see [1])
 +
  rats :: [Rational]
 +
  rats = iterate next 1 where
 +
      next x = recip (fromInteger n+1-y) where (n,y) = properFraction x
 +
 
 +
  -- another way
 +
  rats2 = fix ((1:) . (>>= \x -> [1+x, 1/(1+x)])) :: [Rational]
 +
</haskell>
  
 +
[1] [http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/index.html#rationals Gibbons, Lest, Bird - Enumerating the Rationals]
  
  -- simulating lisp's cond
+
== Monad magic ==
  case () of () | 1 > 2    -> True
 
                | 3 < 4    -> False
 
                | otherwise -> True
 
  
 +
The list monad can be used for some amazing Prolog-ish search problems.
  
   -- add indices to list for later use
+
<haskell>
   -- [3,3,3] -> [(0,3),(1,3),(2,3)]
+
   -- all combinations of a list of lists.
   zip [0..]
+
   -- these solutions are all pretty much equivalent in that they run
    
+
   -- in the List Monad. the "sequence" solution has the advantage of
+
   -- scaling to N sublists.
   -- fibonacci series
+
   -- "12" -> "45" -> ["14", "15", "24", "25"]
  unfoldr (\(f1,f2) -> Just (f1,(f2,f1+f2))) (0,1)
+
   sequence ["12", "45"]
   fibs = 0:1:zipWith (+) fibs (tail fibs)
 
  fib = 0:scanl (+) 1 fib
 
 
  
   -- unjust'ify list of Maybe's
+
   [[x,y] | x <- "12", y <- "45"]
  -- [Just 4, Nothing, Just 3] -> [4,3]
 
  catMaybes
 
  
 +
  do { x <- "12"; y <- "45"; return [x,y] }
  
   -- find substring
+
   "12" >>= \x -> "45" >>= \y -> return [x,y]
  -- "ell" -> "hello" -> True
 
  substr a b = any (a `elem`) $ map inits (tails b)
 
  
 +
  -- all combinations of letters
 +
  (inits . repeat) ['a'..'z'] >>= sequence
  
 
   -- apply a list of functions to an argument
 
   -- apply a list of functions to an argument
 
   -- even -> odd -> 4 -> [True,False]
 
   -- even -> odd -> 4 -> [True,False]
 
   map ($4) [even,odd]
 
   map ($4) [even,odd]
 +
 
   sequence [even,odd] 4
 
   sequence [even,odd] 4
    
+
 
    
+
   -- all subsequences of a sequence/ aka powerset.
 +
   filterM (const [True, False])
 +
 
 
   -- apply a function to two other function the same argument
 
   -- apply a function to two other function the same argument
   -- (lifting to the function monad (->))
+
   --   (lifting to the Function Monad (->))
 
   -- even 4 && odd 4 -> False
 
   -- even 4 && odd 4 -> False
 
   liftM2 (&&) even odd 4
 
   liftM2 (&&) even odd 4
  liftM2 (>>) putStrLn return "hello"    -- putStrLn "hello" >> return "hello"
 
  
 +
  liftM2 (>>) putStrLn return "hello"
 +
 +
  -- enumerate all rational numbers
 +
  fix ((1%1 :) . (>>= \x -> [x+1, 1/(x+1)]))
 +
  [1%1,2%1,1%2,3%1,1%3,3%2,2%3,4%1,1%4,4%3,3%4,5%2,2%5,5%3,3%5,5%1,1%5,5%4,4%5...
 
    
 
    
 +
  -- forward function concatenation
 +
  (*3) >>> (+1) $ 2
 +
 +
  foldl1 (flip (.)) [(*3),(+1)] 2
 +
 +
 +
  -- perform functions in/on a monad, lifting
 +
  fmap (+2) (Just 2)
 +
 +
  liftM2 (+) (Just 4) (Just 2)
 +
 +
 +
  -- [still to categorize]
 +
  ((+) =<< (+) =<< (+) =<< id) 3        -- (+) ((+) ((+) (id 3) 3) 3) 3 = 12
 +
                              -- might need to import Control.Monad.Instances
 +
 +
  -- Galloping horsemen
 +
  -- A large circular track has only one place where horsemen can pass;
 +
  -- many can pass at once there.  Is it possible for nine horsemen to
 +
  -- gallop around it continuously, all at different constant speeds?
 +
  -- the following prints out possible speeds for 2 or more horsemen.
 +
  spd s = ' ': show s ++ '/': show (s+1)
 +
  ext (c,l) = [(tails.filter(\b->a*(a+1)`mod`(b-a)==0)$r,a:l) | (a:r)<-c]
 +
  put = putStrLn . ('1':) . concatMap spd . reverse . snd . head
 +
  main = mapM_ put . iterate (>>= ext) $ [(map reverse $ inits [1..],[])]
 +
 +
  -- output:
 +
  1 1/2
 +
  1 2/3 1/2
 +
  1 3/4 2/3 1/2
 +
  1 5/6 4/5 3/4 2/3
 +
  1 12/13 11/12 10/11 9/10 8/9
 +
  1 27/28 26/27 25/26 24/25 23/24 20/21
 +
  1 63/64 60/61 59/60 57/58 56/57 55/56 54/55
 +
  1 755/756 741/742 740/741 735/736 734/735 728/729 727/728 720/721
 +
  1 126224/126225 122759/122760 122549/122550 122528/122529 122451/122452
 +
    122444/122445 122374/122375 122304/122305 122264/122265
 +
 +
 +
  double = join (+)                    -- double x = x + x
 +
 +
  (join . liftM2) (*) (+3) 5            -- (5+3)*(5+3) = 64
 +
                              -- might need to import Control.Monad.Instances
 +
 +
  mapAccumL (\acc n -> (acc+n,acc+n)) 0 [1..10] -- interesting for fac, fib, ...
 +
 +
  do f <- [not, not]; d <- [True, False]; return (f d) -- [False,True,False,True]
 +
 +
  do { Just x <- [Nothing, Just 5, Nothing, Just 6, Just 7, Nothing]; return x }
 +
</haskell>
 +
 +
== Other ==
 +
 +
 +
<haskell>
 +
  -- simulating lisp's cond
 +
  case () of () | 1 > 2    -> True
 +
                | 3 < 4    -> False
 +
                | otherwise -> True
 +
 +
  --or:
 +
  cond = foldr (uncurry if')    -- ' see [1] below
 +
 
   -- match a constructor
 
   -- match a constructor
   -- this is better than applying all the arguments, because this way the data type can be changed without touching the code (ideally).
+
   -- this is better than applying all the arguments, because this way the
 +
  -- data type can be changed without touching the code (ideally).
 
   case a of Just{} -> True
 
   case a of Just{} -> True
 
             _      -> False
 
             _      -> False
  
  
   -- prime numbers
+
   -- spreadsheet magic
   -- example of a memoising caf (??)
+
   -- might require import Control.Monad.Instances
   primes = sieve [2..] where
+
  let loeb x = fmap ($ loeb x) x in
          sieve (p:x) = p : sieve [ n | n <- x, n `mod` p > 0 ]
+
   loeb [ (!!5), const 3, liftM2 (+) (!!0) (!!1), (*2) . (!!2), length, const 17]
 +
 
  
 
   {-  
 
   {-  
   TODO, ideas:
+
   TODO, IDEAS:
     either
+
     more fun with monad, monadPlus (liftM, ap, guard, when)
    maybe
+
     fun with arrows (second, first, &&&, ***)
    group
+
     liftM, ap
     fun with monad, monadPlus
+
     lazy search (searching as traversal of lazy structures)
     liftM
+
    innovative data types (i.e. having fun with Maybe sequencing)
     list monad vs comprehensions
 
 
    
 
    
 
   LINKS:
 
   LINKS:
Line 126: Line 316:
 
     why functional fp matters (lazy search, ...)
 
     why functional fp matters (lazy search, ...)
 
   -}
 
   -}
</code>
+
</haskell>
 +
 
 +
[1]: see [[Case]] and [[If-then-else]].
 +
 
 +
=== Polynomials ===
 +
In abstract algebra you learn that polynomials can be used the same way integers are used given the right assumptions about their coefficients and roots.  Specifically, polynomials support addition, subtraction, multiplication and sometimes division.  It also turns out that one way to think of polynomials is that they are just lists of numbers (their coefficients). 
 +
 
 +
  instance Num a => Num [a] where              -- (1)
 +
 
 +
    (f:fs) + (g:gs) = f+g : fs+gs              -- (2)
 +
    fs + [] = fs                                -- (3a)
 +
    [] + gs = gs                                -- (3b)
 +
 
 +
    (f:fs) * (g:gs) = f*g : [f]*gs + fs*(g:gs)  -- (4)
 +
    _ * _ = []                                  -- (5)
 +
 
 +
    abs          = undefined  -- I can't think of a sensible definition
 +
    signum        = map signum
 +
    fromInteger n = [fromInteger n]
 +
    negate        = map (\x -> -x)
 +
 
 +
====Explanation====
 +
(1) puts lists into type class Num, the class to which operators + and * belong, provided the list elements are in class Num.
 +
 
 +
Lists are ordered by increasing powers. Thus <tt>f:fs</tt> means <tt>f+x*fs</tt> in algebraic notation.  (2) and (4) follow from these algebraic identities:
 +
 
 +
  (f+x*fs) + (g+x*gs) = f+g + x*(fs+gs)
 +
  (f+x*fs) * (g+x*gs) = f*g + x*(f*gs + fs*(g+x*gs))
 +
 
 +
(3) and (5) handle list ends.
 +
 
 +
The bracketed <tt>[f]</tt> in (4) avoids mixed arithmetic, which Haskell doesn't support.
 +
 
 +
====Comments====
 +
 
 +
The methods are qualitatively different from ordinary array-based methods; there is no vestige of subscripting or counting of terms.
 +
 
 +
The methods are suitable for on-line computation.  Only
 +
<i>n</i> terms of each input must be seen before the <i>n</i>-th term
 +
of output is produced.
 +
 
 +
Thus the methods work on infinite series as well as polynomials.
 +
 
 +
Integer power comes for free.  This example tests the cubing of (1+x):
 +
 
 +
  [1, 1]^3 == [1, 3, 3, 1]
 +
 
 +
 
 +
This gives us the infinite list of rows of Pascal's triangle:
 +
 
 +
    pascal = map ([1,1]^) [0..]
 +
 
 +
For example,
 +
 
 +
    take 5 pascal -- [[1], [1,1], [1,2,1], [1,3,3,1], [1,4,6,4,1]]
 +
 
 +
See also
 +
* [[Pointfree]]
 +
* [https://hub.darcs.net/thielema/numeric-prelude/browse/src/MathObj/Polynomial.hs NumericPrelude: Polynomials]
 +
* [[Add polynomials]]
 +
* Solve differential equations in terms of [http://www.haskell.org/pipermail/haskell-cafe/2004-May/006192.html power series].
 +
 
 +
[[Category:Idioms]]
 +
[[Category:Mathematics]]

Latest revision as of 17:53, 22 November 2019

Useful Idioms that will blow your mind (unless you already know them :)

This collection is supposed to be comprised of short, useful, cool, magical examples, which should incite the reader's curiosity and (hopefully) lead to a deeper understanding of advanced Haskell concepts. At a later time I might add explanations to the more obscure solutions. I've also started providing several alternatives to give more insight into the interrelations of solutions.

More examples are always welcome, especially "obscure" monadic ones.


List/String operations

  -- split at whitespace
  -- "hello world" -> ["hello","world"]
  words

  unfoldr (\b -> fmap (const . (second $ drop 1) . break (==' ') $ b) . listToMaybe $ b)

  takeWhile (not . null) . evalState (repeatM $ modify (drop 1) 
    >> State (break (== ' '))) . (' ' :)
    where repeatM = sequence . repeat

  fix (\f l -> if null l then [] else let (s,e) = break (==' ') l in s:f (drop 1 e))


  -- splitting in two alternating subsequences
  -- "1234567" -> ("1357", "246")
  -- the lazy match with ~ is necessary for laziness,  
  -- especially to enable processing of infinite lists
  foldr (\a ~(x,y) -> (a:y,x)) ([],[])

  (map snd *** map snd) . partition (even . fst) . zip [0..]

  transpose . unfoldr (\a -> toMaybe (not $ null a) (splitAt 2 a))
  -- this one uses the solution to the next problem in a nice way :)
  
  toMaybe b x = if b then Just x else Nothing
  -- or generalize it:
  -- toMaybe = (toMonadPlus :: Bool -> a -> Maybe a)
  toMonadPlus b x = guard b >> return x
  -- or with MonadComprehensions: [x | b]

  -- splitting into lists of length N
  -- "1234567" -> ["12", "34", "56", "7"]
  unfoldr (\a -> toMaybe (not $ null a) (splitAt 2 a))

  takeWhile (not . null) . unfoldr (Just . splitAt 2)

  ensure :: MonadPlus m => (a -> Bool) -> a -> m a
  ensure p x = guard (p x) >> return x
  unfoldr (ensure (not . null . fst) . splitAt 2)
                 

  -- sorting by a custom function
  -- length -> ["abc", "ab", "a"] -> ["a", "ab", "abc"]
  comparing f = compare `on` f -- "comparing" is already defined in Data.Ord
  sortBy (comparing length)

  map snd . sortBy (comparing fst) . map (length &&& id) 
  -- the so called "Schwartzian Transform" for computationally more expensive 
  -- functions.

  -- comparing adjacent elements
  rises xs = zipWith (<) xs (tail xs)
  
  -- lazy substring search
  -- "ell" -> "hello" -> True
  substr a b = any (a `isPrefixOf`) $ tails b

  -- multiple splitAt's:
  -- splitAts [2,5,0,3] [1..15] == [[1,2],[3,4,5,6,7],[],[8,9,10],[11,12,13,14,15]]
  splitAts = foldr (\n r -> splitAt n >>> second r >>> uncurry (:)) return

  -- frequency distribution
  -- "abracadabra" -> fromList [('a',5),('b',2),('c',1),('d',1),('r',2)]
  import Data.Map
  histogram = fromListWith (+) . (`zip` repeat 1)

  -- using arrows and sort
  histogramArr = map (head&&&length) . group . sort

  -- multidimensional zipWith
  zip2DWith :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
  zip2DWith = zipWith . zipWith
  zip3DWith :: (a -> b -> c) -> [[[a]]] -> [[[b]]] -> [[[c]]]
  zip3DWith = zipWith . zipWith . zipWith
  -- etc.

Mathematical sequences, etc

  -- factorial 6 = 720
  product [1..6]

  foldl' (*) 1 [1..6]

  (!!6) $ scanl (*) 1 [1..]

  fix (\f n -> if n <= 0 then 1 else n * f (n-1)) 6


  -- powers of two sequence
  iterate (2*) 1

  fix ((1:) . map (2*))

  unfoldr (\z -> Just (z, 2*z)) 1


  -- fibonacci sequence
  unfoldr (\(a,b) -> Just (a,(b,a+b))) (0,1)

  fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

  fib = 0 : scanl (+) 1 fib    -- also,  fix ((0:) . scanl (+) 1)


  -- pascal triangle
  pascal = iterate (\row -> zipWith (+) ([0] ++ row) (row ++ [0])) [1]


  -- prime numbers  
  primes = sieve [2..] where
           sieve (p:xs) = p : sieve [ n | n <- xs, n `mod` p > 0 ]

  unfoldr  sieve [2..] where 
           sieve (p:xs) = Just(p,   [ n | n <- xs, n `mod` p > 0 ])

  otherPrimes = nubBy (((>1).).gcd) [2..]


  -- or if you want to use the Sieve of Eratosthenes
  diff xl@(x:xs) yl@(y:ys) | x < y     = x:diff xs yl
                           | x > y     =   diff xl ys
                           | otherwise =   diff xs ys 

  eprimes = sieve [2..] where
            sieve (p:xs) = p : sieve (diff xs [p, p+p..]) 
         -- sieve (splitAt 1 -> (h@(p:_),t)) =
         --                h ++ sieve (diff t [p, p+p..]) 

  fix $ map head . scanl diff [2..] . map (\p -> [p, p+p..])


  -- postponed to squares for under n^1.5 complexity
  -- instead of above n^2.0
  peprimes = 2 : sieve [[p*p, p*p+p..] | p <- peprimes] [3..] where
                 sieve ((q:cs):r) (span (< q) -> (h,_:t)) = 
                           h ++ sieve r (diff t cs)

  -- tree-folded, ~n^1.2, w/ data-ordlist's Data.List.Ordered.unionAll
  2 : _Y ((3:) . diff [5,7..] . unionAll . map (\p -> [p*p, p*p+p..])) 

  _Y g = g (_Y g)    -- non-sharing recursion prevents memory retention 


  -- Hamming numbers (`union`, `mergeAll` from data-ordlist)
  h = 1 : foldr (\k -> union (map (k*) h)) [] [2,3,5]
      -- or even just
  h = 1 : unionAll [map (k*) h | k <- [2,3,5]]

  foldr (\n -> mergeAll . map (iterate (*n))) [1] [2,3,5]
  foldr (\n -> mergeAll . iterate (map (*n))) [1] [2,3,5]   -- this too

  h = 1 : foldr (\n s -> fix (merge s . map (n*) . (1:))) [] [2,3,5]
  --  h = 1 : fix (merge s3 . map (2*) . (1:)) where
  --                     s3 = fix (merge s5 . map (3*) . (1:))) where
  --                                     s5 = fix (map (5*) . (1:)))

  merge a@(x:xs) b@(y:ys) | x < y     = x : merge xs  b  -- merge assumes 
                       -- | x == y    = x : union xs ys  --  there's no dups
                          | otherwise = y : merge a  ys
  merge [] b = b  -- merge [] = \b -> b = id   -- (id .) = id
  merge a [] = a


  -- enumerating the rationals (see [1])
  rats :: [Rational]
  rats = iterate next 1 where
       next x = recip (fromInteger n+1-y) where (n,y) = properFraction x

  -- another way
  rats2 = fix ((1:) . (>>= \x -> [1+x, 1/(1+x)])) :: [Rational]

[1] Gibbons, Lest, Bird - Enumerating the Rationals

Monad magic

The list monad can be used for some amazing Prolog-ish search problems.

  -- all combinations of a list of lists.
  -- these solutions are all pretty much equivalent in that they run
  -- in the List Monad. the "sequence" solution has the advantage of
  -- scaling to N sublists.
  -- "12" -> "45" -> ["14", "15", "24", "25"]
  sequence ["12", "45"]

  [[x,y] | x <- "12", y <- "45"]

  do { x <- "12"; y <- "45"; return [x,y] }

  "12" >>= \x -> "45" >>= \y -> return [x,y]

  -- all combinations of letters
  (inits . repeat) ['a'..'z'] >>= sequence

  -- apply a list of functions to an argument
  -- even -> odd -> 4 -> [True,False]
  map ($4) [even,odd]

  sequence [even,odd] 4

  -- all subsequences of a sequence/ aka powerset.
  filterM (const [True, False])

  -- apply a function to two other function the same argument
  --   (lifting to the Function Monad (->))
  -- even 4 && odd 4 -> False
  liftM2 (&&) even odd 4

  liftM2 (>>) putStrLn return "hello"

  -- enumerate all rational numbers
  fix ((1%1 :) . (>>= \x -> [x+1, 1/(x+1)]))
  [1%1,2%1,1%2,3%1,1%3,3%2,2%3,4%1,1%4,4%3,3%4,5%2,2%5,5%3,3%5,5%1,1%5,5%4,4%5...
  
  -- forward function concatenation
  (*3) >>> (+1) $ 2

  foldl1 (flip (.)) [(*3),(+1)] 2


  -- perform functions in/on a monad, lifting
  fmap (+2) (Just 2)

  liftM2 (+) (Just 4) (Just 2)


  -- [still to categorize]
  ((+) =<< (+) =<< (+) =<< id) 3        -- (+) ((+) ((+) (id 3) 3) 3) 3 = 12
                               -- might need to import Control.Monad.Instances

  -- Galloping horsemen
  -- A large circular track has only one place where horsemen can pass;
  -- many can pass at once there.  Is it possible for nine horsemen to
  -- gallop around it continuously, all at different constant speeds?
  -- the following prints out possible speeds for 2 or more horsemen.
  spd s = ' ': show s ++ '/': show (s+1)
  ext (c,l) = [(tails.filter(\b->a*(a+1)`mod`(b-a)==0)$r,a:l) | (a:r)<-c]
  put = putStrLn . ('1':) . concatMap spd . reverse . snd . head
  main = mapM_ put . iterate (>>= ext) $ [(map reverse $ inits [1..],[])]

  -- output:
  1 1/2
  1 2/3 1/2
  1 3/4 2/3 1/2
  1 5/6 4/5 3/4 2/3
  1 12/13 11/12 10/11 9/10 8/9
  1 27/28 26/27 25/26 24/25 23/24 20/21
  1 63/64 60/61 59/60 57/58 56/57 55/56 54/55
  1 755/756 741/742 740/741 735/736 734/735 728/729 727/728 720/721
  1 126224/126225 122759/122760 122549/122550 122528/122529 122451/122452
    122444/122445 122374/122375 122304/122305 122264/122265


  double = join (+)                     -- double x = x + x

  (join . liftM2) (*) (+3) 5            -- (5+3)*(5+3) = 64
                               -- might need to import Control.Monad.Instances

  mapAccumL (\acc n -> (acc+n,acc+n)) 0 [1..10] -- interesting for fac, fib, ...

  do f <- [not, not]; d <- [True, False]; return (f d) -- [False,True,False,True]

  do { Just x <- [Nothing, Just 5, Nothing, Just 6, Just 7, Nothing]; return x }

Other

  -- simulating lisp's cond
  case () of () | 1 > 2     -> True
                | 3 < 4     -> False
                | otherwise -> True

  --or:
  cond = foldr (uncurry if')     -- ' see [1] below

  -- match a constructor
  -- this is better than applying all the arguments, because this way the
  -- data type can be changed without touching the code (ideally).
  case a of Just{} -> True
            _      -> False


  -- spreadsheet magic
  -- might require import Control.Monad.Instances
  let loeb x = fmap ($ loeb x) x in 
  loeb [ (!!5), const 3, liftM2 (+) (!!0) (!!1), (*2) . (!!2), length, const 17]


  {- 
  TODO, IDEAS:
    more fun with monad, monadPlus (liftM, ap, guard, when)
    fun with arrows (second, first, &&&, ***)
    liftM, ap
    lazy search (searching as traversal of lazy structures)
    innovative data types (i.e. having fun with Maybe sequencing)
  
  LINKS:
    bananas, envelopes, ...   (generic traversal)
    why functional fp matters (lazy search, ...)
  -}

[1]: see Case and If-then-else.

Polynomials

In abstract algebra you learn that polynomials can be used the same way integers are used given the right assumptions about their coefficients and roots. Specifically, polynomials support addition, subtraction, multiplication and sometimes division. It also turns out that one way to think of polynomials is that they are just lists of numbers (their coefficients).

 instance Num a => Num [a] where               -- (1)
   (f:fs) + (g:gs) = f+g : fs+gs               -- (2)
   fs + [] = fs                                -- (3a)
   [] + gs = gs                                -- (3b)
   (f:fs) * (g:gs) = f*g : [f]*gs + fs*(g:gs)  -- (4)
   _ * _ = []                                  -- (5)
   abs           = undefined   -- I can't think of a sensible definition
   signum        = map signum
   fromInteger n = [fromInteger n]
   negate        = map (\x -> -x)

Explanation

(1) puts lists into type class Num, the class to which operators + and * belong, provided the list elements are in class Num.

Lists are ordered by increasing powers. Thus f:fs means f+x*fs in algebraic notation. (2) and (4) follow from these algebraic identities:

 (f+x*fs) + (g+x*gs) = f+g + x*(fs+gs)
 (f+x*fs) * (g+x*gs) = f*g + x*(f*gs + fs*(g+x*gs))

(3) and (5) handle list ends.

The bracketed [f] in (4) avoids mixed arithmetic, which Haskell doesn't support.

Comments

The methods are qualitatively different from ordinary array-based methods; there is no vestige of subscripting or counting of terms.

The methods are suitable for on-line computation. Only n terms of each input must be seen before the n-th term of output is produced.

Thus the methods work on infinite series as well as polynomials.

Integer power comes for free. This example tests the cubing of (1+x):

  [1, 1]^3 == [1, 3, 3, 1]


This gives us the infinite list of rows of Pascal's triangle:

   pascal = map ([1,1]^) [0..]

For example,

   take 5 pascal -- [[1], [1,1], [1,2,1], [1,3,3,1], [1,4,6,4,1]]

See also