-- Examples of stream processing
-- by Scot Drysdale 8/07, with some additions by Chris Bailey-Kellogg
-- Additional examples added 11/08 and 2/09.

type Stream = [Integer]

ones = 1 : ones

integersFrom :: Integer -> Stream
integersFrom n = n : integersFrom (n + 1)

naturals = integersFrom 0

naturals2 = 0 : zipWith (+) ones naturals2

naturals3 = 0 : map (+1) naturals3

evens = filter (\x -> x `mod` 2 == 0) naturals

odds = filter (\x -> x `mod` 2 /= 0) naturals

naturals4 = scanl (+) 0 ones

triangular = scanl (+) 0 (tail naturals)

--------

-- Fibonaci numbers

fib = 1 : 1 : zipWith (+) fib (tail fib)

fib20 = take 20 fib

-- Recursive definition of Fibonacci numbers is not efficient:

fibRec  :: Integer -> Integer
fibRec n = if n < 2
           then 1
           else fibRec (n-1) + fibRec (n-2)
           
---------

-- Sieve to get primes

primes = sieve [2..] 

sieve :: Stream -> Stream
sieve (p:lst) = p:sieve (filter (\b -> b `rem` p /= 0) lst)

primes20 = take 20 primes

---------

-- Merges two sorted streams to get a single stream.  An item appearing in both input streams 
-- input streams appears once in the output stream.

merge :: Ord a => [a] -> [a] -> [a]
merge xs@(x:xt) ys@(y:yt) | x < y     = x:(merge xt ys)
                          | y < x     = y:(merge xs yt)
                          | otherwise = x:(merge xt yt)


-- Computes all numbers of form 2^i * 3^j * 5^k
hamming = 1 : (merge (map (*2) hamming)
                     (merge (map (*3) hamming)
                            (map (*5) hamming)))


-- Computes all numbers whose factors are integers in a given finite list, 
-- in increasing order.  A generalized version of hamming.
prodOfFactors :: [Integer] -> Stream
prodOfFactors ps =               
  1:(foldl1 merge (map (\p -> map (p*) (prodOfFactors ps)) ps))

hamming2 = take 20 (prodOfFactors [2, 3, 5])

-----

-- Version of prodOfFactors that handles an infinite stream of factors!
-- Assumes that the factors list is in increasing order.
prodOfFactorsInf   :: Stream -> Stream
prodOfFactorsInf ps = 
  1 : mergeStreams (map (\p -> map (p*) (prodOfFactorsInf ps)) ps)

-- Before seeing how to merge and infinite number of streams, let's
-- look at a simpler related problem:

-- Listing everything in a stream of streams.

-- Let's create a stream of streams where it is easy to tell what
-- row and column an item came from:

-- Creates a stream [1, n, n^2, n^3, ...]
powStream  :: Integer -> Stream
powStream n = 1 : map (*n) (powStream n)

-- Create a stream of powers of primes: 
-- [[2,4,8,16, ...],
--  [3,9,27,81,...],
--  [5,25,125,625,...],
--  ... 
-- ]
streamOfStreams :: [Stream]
streamOfStreams = map (\x -> tail (powStream x)) primes

-- Creates a single stream that includes all of the items
-- in the stream of streams by traversing diagonals. So
--   enumerateStreams streamOfStreams =>
--     [2,3,4,5,9,8,7,25,27,16, ...]
enumerateStreams :: [Stream] -> Stream
enumerateStreams (s:ss) = helper [s] ss where
  helper xss (ys:yss) = map head xss ++ 
                        helper (ys : (map tail xss)) yss

enumerateSofS = enumerateStreams streamOfStreams

---------
-- Merges an infinite number of streams into a single stream.
-- Assumes that each stream is in increasing order and that 
-- the first value of the kth stream is larger than at least
-- k-1 distinct values in the first k-1 streams.  
-- (This is necessary because the kth stream is not merged in
-- until k-1 values have been removed from previous streams.)
mergeStreams :: [Stream] -> Stream
mergeStreams (xs : xss) = mergeHelper xs xss 
  where mergeHelper (minVal : restMerged) (xs : xss) = 
          minVal : mergeHelper (merge restMerged xs) xss             
-----

-- Some really convoluted ways to get naturals and odds!

-- Naturals are 0 and numbers that are products of primes.
naturals5 = 0 : prodOfFactorsInf primes

-- Odds are products of all primes except 2.
odds2 = prodOfFactorsInf (tail primes)

-- Numbers that have no factors of 2, 3, or 5
antiHamming = prodOfFactorsInf ((tail . tail . tail) primes)

----------

-- Sums of Pairs

-- Given a stream of integers, computers a stream of all sums of pairs 
-- of integers in increasing order.
-- Assumes stream is in increasing order

listsOfSums :: Stream -> [Stream]
listsOfSums xs@(x:xt) = map (x +) xs : listsOfSums xt

-- Goldbach's Conjecture is that every even number > 4 is the sum of
-- two odd primes.
goldbach = mergeStreams (listsOfSums (tail primes))

squares = map (^2) (tail naturals)

sumsOfSquares = mergeStreams (listsOfSums squares)

---------

-- Prefixes

prefixes :: [a] -> [[a]]
prefixes str = prefixHelp [] str
  where prefixHelp pre (x:xs) = let next = (pre ++ [x])
                                in next : prefixHelp next xs
                      
triangular2 = map sum (prefixes naturals)

-- An unusual case where foldr can be used on a stream.
-- Remember that concat lst = foldr (++) [] lst

concatPre = concat (prefixes naturals)

-----------

-- Thue-Morse Sequence
-- An infinite non-repeating sequence.  It contains no subsequence of the
-- form xxx, where x is a non-empty subsequence.  The first 16 values are:
--   [0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0]
-- It arises in Morse theory.

-- The first 2^n items can be recursively defined as follows:
-- p(0) = [0]
-- p(n) = p(n-1) ++ q(n-1), where q(n-1) is the complement of p(n-1)


-- Takes a sequence of 0's and 1's and complements it
complement :: [Int] -> [Int]
complement s = map (1-) s

-- Given a sequence xs, treats it as a prefix and generates the rest
-- of the Thue-Morse sequence.
genRest :: [Int] -> [Int]
genRest xs = let cxs = complement xs in cxs ++ genRest (xs ++ cxs)

tm = 0 : genRest [0]

-- An alternate way of viewing the sequence is that it starts with 0
-- and then is interleaved with its complement!  (Note that the even
-- positions of the sequence are identical to the sequence, while the
-- odd positions are the complement of the sequence.)  Using this 
-- definition we can define the sequence as follows.  
-- (Credit for this solution goes to Doug McIlroy.)

-- Interleaves two streams (first from each, then second from each, etc.)
interleave :: [a] -> [a] -> [a]
interleave (x:xs) ys = x : interleave ys xs

tm2 = 0 : interleave (complement tm2) (tail tm2)


-- One final way written by Jay Misra.  us is the sequence, vs is the
-- complement of the sequence.

us = 0 : ut
vs = 1 : vt
ut = interleave vs ut
vt = interleave us vt


main = print (primes !! 10000)