----------------------------------------------------------------------------- -- | -- -- Module : Data.Rivers.Ecology -- Copyright : (c) Drew Day 2011 -- License : BSD-style -- Maintainer : drewday@gmail.com -- Stability : experimental -- Portability : probably portable -- -- -- This module is an attempt to construct many and varied examples of "River"s and -- "Streams". At the moment, the concept of what "River"s are (or are not) is -- not entirely clear in the mind of any particular person on Earth, myself foremost -- amoung the befuddled. -- -- Primarily because I lay claim to inventing the idea, this is a worrisome situation. -- Nevertheless, whatever these things are, regular old "Data.Stream" streams (and kin) -- are subsets (or sub-classes, or.. sub-something) of these things, and hence they must -- qualify to be mapped in this ecosystem (by definition). -- -- As of now, these example originate primarily from three excellent papers on Streams -- and their properties. More precisey, they originate from my haphazard and occasionally -- mindless transcription of what I saw from these documents. Therefore, the authors of -- the following papers deserve /much of the credit/, but bear /none of the responsibility/ -- of the contents of this module. -- -- [@CONTRACTIVE@] -- -- * Graham Hutton and Mauro Jaskelioff, \"Representing contractive functions on streams\", -- -- * Submitted to the /Journal of Functional Programming/ (October 2011). -- -- * Link: <http://www.cs.nott.ac.uk/~gmh/bib.html#contractive> -- -- * PDF: <http://www.cs.nott.ac.uk/~gmh/contractive.pdf> -- -- [@PEARL-UFP@] -- -- * Ralph Hinze, \"Functional pearl: streams and unique fixed points\". -- -- * /Proceedings of the 13th ACM SIGPLAN international conference on Functional Programming (ICFP '08)/ -- (22-24 September 2008). pp. 189-200. (c) ACM -- -- * Link: <http://www.cs.ox.ac.uk/ralf.hinze/publications/index.html#B9> -- -- * PDF: <http://www.cs.ox.ac.uk/ralf.hinze/publications/ICFP08.pdf> -- -- [@PROVING-UFP@] -- -- * Ralf Hinze and Daniel W. H. James, \"Proving The Unique Fixed-Point Principle Correct\" -- -- * /Proceeding of the 16th ACM SIGPLAN international conference on Functional programming (ICFP '11)/ -- (September 2011). pp. 359-371. (c) ACM -- -- * Link: <http://www.cs.ox.ac.uk/people/daniel.james/unique.html> -- -- * PDF: <http://www.cs.ox.ac.uk/people/daniel.james/unique/unique-conf.pdf> -- -- -- -- This module should clearly document the behavior of /all/ functions. In fact, the -- code in this module is generally not intended to be imported and used directly. Instead -- the purpose of this module is to: -- -- 1. show *many* examples of Streams, especially non-trivial ones (ie, more complicated than 'fibionacci') -- -- 2. provide visual (and eventually, pictoral) *proof* of equality (insofar that this is possible) -- -- 3. ... more things -- -- 4. ... should go here -- -- 5. ... becuase there's a point to all of this, right? -- -- -- Note: To accomidate the documentation, the text-width of this document is 129 characters. -- -- -- As a witness to the correctness of the examples, I include the result of running doctest: -- -- > $ doctest Data/Rivers/Ecology.hs -- > Cases: 74 Tried: 74 Errors: 0 Failures: 0 -- ----------------------------------------------------------------------------- module Data.Rivers.Ecology where import Data.Rivers.Idiom import Data.Rivers.Streams -- -- -- -- -- -- -- -- -------------------------------------------------------------------------------------------------------------------------------- -- * Silly Streams -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- ** /Constant/ Zeroes -------------------------------------------------------------------------------------------------------------------------------- sZero :: S Integer sZero = 0 <|| smerge sZero (stail sZero) -- ^ -- >>> stake 30 $ sZero -- [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0] gZero :: G Integer Integer gZero [] = 0 gZero xs = xs !! ( (length xs ) `div` 2) -- ^ -- >>> stake 30 $ fwdFix gZero -- [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0] rZero :: G Integer Integer rZero [] = 0 rZero xs = xs !! ( (length xs - 1) `div` 2) -- ^ -- >>> stake 30 $ revFix rZero -- [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0] cZero :: S Integer cZero = cfix (cZeroH, cZeroT) ([], -1) -- ^ -- >>> stake 30 $ cZero -- [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0] cZeroH :: (Num a) => ([a] , Int) -> a cZeroH ([] , _ ) = 0 cZeroH (xs , n ) = xs !! (n `div` 2) cZeroT :: (Num t) => ([a], t ) -> a -> ([a] , t ) cZeroT (xs , n ) x = (x:xs, n+1) -------------------------------------------------------------------------------------------------------------------------------- -- ** /Constant/ Ones -------------------------------------------------------------------------------------------------------------------------------- -- | -- Believe it or not, this is in OEIS: -- -- >>> take 30 $ fromOEIS "A000012" -- [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1] sOne :: S Integer sOne = 1 <|| sOne -- ^ -- >>> stake 30 $ sOne -- [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1] sOnes :: S Integer sOnes = 1 <|| smerge sOnes (stail sOnes) -- ^ -- >>> stake 30 $ sOnes -- [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1] gOne :: G Integer Integer gOne [] = 1 gOne xs = last xs gOne' :: G Integer Integer gOne' __ = 1 -- ^ -- >>> stake 30 $ fwdFix gOne -- [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1] rOne :: G Integer Integer rOne [] = 1 rOne (x:__) = x -- ^ -- >>> stake 30 $ revFix rOne -- [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1] cOne :: S Integer cOne = cfix (cOneH, cOneT) 1 -- ^ -- >>> stake 30 $ cOne -- [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1] cOneH :: t -> t cOneH x = x cOneT :: t -> t -> t cOneT x _ = x {-- FIXME altOnes :: S Integer altOnes = 0 <|| altOnes + 1 - carry -- ^ -- >>> stake 30 $ altOnes -- [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1] --} -------------------------------------------------------------------------------------------------------------------------------- -- ** The /Natural/ Numbers -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A000027" -- [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30] sNat :: S Integer sNat = 0 <|| sMap (+1) sNat -- ^ -- >>> stake 30 $ sNat -- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29] sNatIt :: S Integer sNatIt = siterate (+1) 0 -- ^ -- >>> stake 30 $ siterate (+1) 0 -- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29] natnat :: S Integer natnat = 0 <|| (2 * natnat |~| 2 * natnat + 1) + 1 -- ^ -- >>> stake 30 $ natnat -- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29] gNat :: G Integer Integer gNat [] = 0 gNat xs = last xs +1 gNat' :: [a] -> Int gNat' = length -- ^ -- >>> stake 30 $ fwdFix gNat -- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29] rNat :: G Integer Integer rNat [] = 0 rNat (x:_) = x +1 -- ^ -- >>> stake 30 $ revFix rNat -- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29] cNat :: S Integer cNat = cfix (cNatH, cNatT) 0 -- ^ -- >>> stake 30 $ cNat -- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29] cNatH :: t -> t cNatH x = x cNatT :: (Num a) => a -> t -> a cNatT x _ = x +1 -------------------------------------------------------------------------------------------------------------------------------- -- *** /Natural/ Numbers from Binary -------------------------------------------------------------------------------------------------------------------------------- bin :: S Integer bin = 0 <|| 2 * bin + 1 |~| 2 * bin + 2 -- ^ -- >>> stake 30 $ bin -- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29] -------------------------------------------------------------------------------------------------------------------------------- -- * Simple Streams -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- ** Power Streams -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- *** Powers of (-2) -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 15 $ fromOEIS "A122803" -- [1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384] revPowersOfN2 :: S Integer revPowersOfN2 = revFix a122803 -- ^ -- >>> stake 15 $ revPowersOfN2 -- [1,-2,4,-8,16,-32,64,-128,256,-512,1024,-2048,4096,-8192,16384] a122803 :: G Integer Integer a122803 [] = 1 a122803 (x:_) = -2 * x -------------------------------------------------------------------------------------------------------------------------------- -- *** Powers of (2) - Bool -------------------------------------------------------------------------------------------------------------------------------- -- Clearly, this won't be in OEIS, per se. -- -- pot :: S Bool pot = True <|| pot |~| srepeat False -- ^ -- >>> stake 15 $ pot -- [True,True,False,True,False,False,False,True,False,False,False,False,False,False,False] -------------------------------------------------------------------------------------------------------------------------------- -- *** Powers of (3) -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 15 $ fromOEIS "A000244" -- [1,3,9,27,81,243,729,2187,6561,19683,59049,177147,531441,1594323,4782969] revPowersOf3 :: S Integer revPowersOf3 = revFix pothree -- ^ -- >>> stake 15 $ revPowersOf3 -- [1,3,9,27,81,243,729,2187,6561,19683,59049,177147,531441,1594323,4782969] pothree :: G Integer Integer pothree [] = 1 pothree (x:_) = 3 * x -------------------------------------------------------------------------------------------------------------------------------- -- ** Squares -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A000290" -- [0,1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841] a000290 :: S Integer a000290 = bsum $ 2 * sNat + 1 -- ^ -- >>> stake 30 $ bsum $ 2 * sNat + 1 -- [0,1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841] -------------------------------------------------------------------------------------------------------------------------------- -- ** Factorial Numbers -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 10 $ fromOEIS "A000142" -- [1,1,2,6,24,120,720,5040,40320,362880] sFac :: S Integer sFac = 1 <|| (sNat + 1) * sFac -- ^ -- >>> stake 10 $ sFac -- [1,1,2,6,24,120,720,5040,40320,362880] -------------------------------------------------------------------------------------------------------------------------------- -- * The Family of Fibionacci (and Lucas!) -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- ** Forever Fibionacci -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 29 $ fromOEIS "A000045" -- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368,75025,121393,196418,317811] sFib :: S Integer sFib = 0 <|| 1 <|| sMap2 (+) sFib (stail sFib) -- ^ -- >>> stake 29 $ sFib -- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368,75025,121393,196418,317811] sFib2 :: S Integer sFib2 = 0 <|| (1 <|| sFib2) + sFib2 -- ^ -- >>> stake 29 $ sFib2 -- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368,75025,121393,196418,317811] revGfibs :: G Integer Integer revGfibs [] = 0 revGfibs [_] = 1 revGfibs (x:y:_) = y + x -- ^ -- >>> stake 29 $ revFix revGfibs -- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368,75025,121393,196418,317811] cFib :: S Integer cFib = cfix (cFibH, cFibT) (0,1) cFibH :: (a,b) -> a cFibH (x,_) = x cFibT :: (Num a) => (a, a) -> a -> (a, a) cFibT (x,y) ____ = (y, x+y) -- ^ -- >>> stake 29 $ cFib -- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368,75025,121393,196418,317811] gFibs :: G Integer Integer gFibs xs = case length xs of 0 -> 0 1 -> 1 n -> xs !! (n-2) + xs !! (n-1) -- ^ -- >>> stake 29 $ fwdFix gFibs -- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368,75025,121393,196418,317811] -------------------------------------------------------------------------------------------------------------------------------- -- ** Lonely Lucas -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 28 $ fromOEIS "A000032" -- [2,1,3,4,7,11,18,29,47,76,123,199,322,521,843,1364,2207,3571,5778,9349,15127,24476,39603,64079,103682,167761,271443,439204] sLucas :: S Integer sLucas = 2 <|| 1 <|| sMap2 (+) sLucas (stail sLucas) -- ^ -- >>> stake 28 $ sLucas -- [2,1,3,4,7,11,18,29,47,76,123,199,322,521,843,1364,2207,3571,5778,9349,15127,24476,39603,64079,103682,167761,271443,439204] rLucas :: G Integer Integer rLucas [] = 2 rLucas [_] = 1 rLucas (x:y:_) = x + y -- ^ -- >>> stake 28 $ revFix rLucas -- [2,1,3,4,7,11,18,29,47,76,123,199,322,521,843,1364,2207,3571,5778,9349,15127,24476,39603,64079,103682,167761,271443,439204] -------------------------------------------------------------------------------------------------------------------------------- -- *** under (4*n + 1) -------------------------------------------------------------------------------------------------------------------------------- -- | The Fibionacci (4n + 1) and Lucas (4n + 1) numbers -- -- drop0L is evidently a bisect twice function -- fib4np1 :: S Integer fib4np1 = drop0L sFib -- ^ -- >>> stake 10 $ drop0L sFib -- [1,5,34,233,1597,10946,75025,514229,3524578,24157817] -- -- >>> take 10 $ fromOEIS "A033889" -- [1,5,34,233,1597,10946,75025,514229,3524578,24157817] luc4np1 :: S Integer luc4np1 = drop0L sLucas -- ^ -- >>> stake 10 $ drop0L sLucas -- [1,11,76,521,3571,24476,167761,1149851,7881196,54018521] -- -- >>> take 10 $ fromOEIS "A056914" -- [1,11,76,521,3571,24476,167761,1149851,7881196,54018521] -------------------------------------------------------------------------------------------------------------------------------- -- *** under (2*n) -------------------------------------------------------------------------------------------------------------------------------- -- | The Fib (2*n) and Lucas (2*n) numbers -- -- dromIp1L is evidently a bisect function -- fib2n :: S Integer fib2n = dropIp1L sFib -- ^ -- >>> stake 20 $ dropIp1L sFib -- [0,1,3,8,21,55,144,377,987,2584,6765,17711,46368,121393,317811,832040,2178309,5702887,14930352,39088169] -- -- >>> take 20 $ fromOEIS "A001906" -- [0,1,3,8,21,55,144,377,987,2584,6765,17711,46368,121393,317811,832040,2178309,5702887,14930352,39088169] luc2n :: S Integer luc2n = dropIp1L sLucas -- ^ -- >>> stake 20 $ dropIp1L sLucas -- [2,3,7,18,47,123,322,843,2207,5778,15127,39603,103682,271443,710647,1860498,4870847,12752043,33385282,87403803] -- -- >>> take 20 $ fromOEIS "A005248" -- [2,3,7,18,47,123,322,843,2207,5778,15127,39603,103682,271443,710647,1860498,4870847,12752043,33385282,87403803] -------------------------------------------------------------------------------------------------------------------------------- -- *** under (sum) -------------------------------------------------------------------------------------------------------------------------------- fibpfib :: S Integer fibpfib = plus sFib sFib -- ^ -- >>> stake 21 $ [1] <<| plus sFib sFib -- [1,0,2,2,4,6,10,16,26,42,68,110,178,288,466,754,1220,1974,3194,5168,8362] -- -- >>> take 21 $ fromOEIS "A006355" -- [1,0,2,2,4,6,10,16,26,42,68,110,178,288,466,754,1220,1974,3194,5168,8362] -------------------------------------------------------------------------------------------------------------------------------- -- *** under (diff) -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 20 $ fromOEIS "A039834" -- [1,1,0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597] dxFib :: S Integer dxFib = diff sFib -- ^ -- >>> stake 20 $ [1] <<| diff sFib -- [1,1,0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597] -- | -- >>> take 20 $ fromOEIS "A061084" -- [1,2,1,3,4,7,11,18,29,47,76,123,199,322,521,843,1364,2207,3571,5778] dxLucas :: S Integer dxLucas = diff sLucas -- ^ -- >>> stake 20 $ diff sLucas -- [-1,2,1,3,4,7,11,18,29,47,76,123,199,322,521,843,1364,2207,3571,5778] -------------------------------------------------------------------------------------------------------------------------------- -- * Padovans and Perrins, and Pells -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- ** Padovan -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A000931" -- [1,0,0,1,0,1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265,351,465,616] padovanPP11010 :: S Integer padovanPP11010 = [1,0,0,1,0] <<| padovan -- ^ -- >>> stake 30 $ padovanPP11010 -- [1,0,0,1,0,1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265,351,465,616] -- | -- >>> take 30 $ fromOEIS "A134816" -- [1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265,351,465,616,816,1081,1432,1897,2513] padovan :: S Integer padovan = 1 <|| 1 <|| 1 <|| sMap2 (+) padovan (stail padovan) -- ^ -- >>> stake 30 $ padovan -- [1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265,351,465,616,816,1081,1432,1897,2513] -- rpadovan :: G Integer Integer rpadovan [] = 1 rpadovan [_] = 1 rpadovan (_:_:[]) = 1 rpadovan (_:y:z:_) = y + z -- ^ -- >>> stake 30 $ revFix rpadovan -- [1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265,351,465,616,816,1081,1432,1897,2513] -- | -- >>> take 31 $ fromOEIS "A133034" -- [1,0,1,1,1,0,0,1,0,1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265] d2xpadovan :: S Integer d2xpadovan = diff $ diff $ revFix rpadovan -- ^ -- >>> stake 30 $ diff $ diff $ revFix rpadovan -- [0,1,-1,1,0,0,1,0,1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265] -------------------------------------------------------------------------------------------------------------------------------- -- ** Perrin -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A001608" -- [3,0,2,3,2,5,5,7,10,12,17,22,29,39,51,68,90,119,158,209,277,367,486,644,853,1130,1497,1983,2627,3480] perrin :: S Integer perrin = 3 <|| 0 <|| 2 <|| sMap2 (+) perrin (stail perrin) -- ^ -- >>> stake 30 $ perrin -- [3,0,2,3,2,5,5,7,10,12,17,22,29,39,51,68,90,119,158,209,277,367,486,644,853,1130,1497,1983,2627,3480] rperrin :: G Integer Integer rperrin [] = 3 rperrin [_] = 0 rperrin (_:_:[]) = 2 rperrin (_:y:z:_) = y + z -- ^ -- >>> stake 30 $ revFix rperrin -- [3,0,2,3,2,5,5,7,10,12,17,22,29,39,51,68,90,119,158,209,277,367,486,644,853,1130,1497,1983,2627,3480] -------------------------------------------------------------------------------------------------------------------------------- -- ** Pell -------------------------------------------------------------------------------------------------------------------------------- -- | -- Generating Function: -- -- z -- -------------------- -- z^2 + 2z - 1 -- -- | -- >>> take 20 $ fromOEIS "A000129" -- [0,1,2,5,12,29,70,169,408,985,2378,5741,13860,33461,80782,195025,470832,1136689,2744210,6625109] cPell :: S Integer cPell = cfix (cPellH, cPellT) (0,1) cPellH :: (a,a) -> a cPellH (x,_) = x cPellT :: (Num a) => (a, a) -> a -> (a, a) cPellT (x,y) ____ = (y, x+2*y) -- ^ -- >>> stake 20 $ cPell -- [0,1,2,5,12,29,70,169,408,985,2378,5741,13860,33461,80782,195025,470832,1136689,2744210,6625109] -- rpell :: G Integer Integer rpell [] = 0 rpell [_] = 1 rpell (x:y:_) = 2*x + y -- ^ -- >>> stake 20 $ revFix rpell -- [0,1,2,5,12,29,70,169,408,985,2378,5741,13860,33461,80782,195025,470832,1136689,2744210,6625109] -------------------------------------------------------------------------------------------------------------------------------- -- * Who invited the J's? -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- ** Jacobsthal Sequence -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 20 $ fromOEIS "A001045" -- [0,1,1,3,5,11,21,43,85,171,341,683,1365,2731,5461,10923,21845,43691,87381,174763] jacob :: S Integer jacob= 0 <|| 1 <|| sMap2 (+) (sMap (*2) jacob) (stail jacob) -- ^ -- >>> stake 20 $ jacob -- [0,1,1,3,5,11,21,43,85,171,341,683,1365,2731,5461,10923,21845,43691,87381,174763] rjacob :: G Integer Integer rjacob [] = 0 rjacob [_] = 1 rjacob (x:y:_) = x + 2*y -- ^ -- >>> stake 20 $ revFix rjacob -- [0,1,1,3,5,11,21,43,85,171,341,683,1365,2731,5461,10923,21845,43691,87381,174763] -------------------------------------------------------------------------------------------------------------------------------- -- ** Jacobsthal-Lucas Sequence -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 20 $ fromOEIS "A014551" -- [2,1,5,7,17,31,65,127,257,511,1025,2047,4097,8191,16385,32767,65537,131071,262145,524287] jacobl :: S Integer jacobl = 2 <|| 1 <|| sMap2 (+) (sMap (*2) jacobl) (stail jacobl) -- ^ -- >>> stake 20 $ jacobl -- [2,1,5,7,17,31,65,127,257,511,1025,2047,4097,8191,16385,32767,65537,131071,262145,524287] rjacobl :: G Integer Integer rjacobl [] = 2 rjacobl [_] = 1 rjacobl (x:y:_) = x + 2*y -- ^ -- >>> stake 20 $ revFix rjacobl -- [2,1,5,7,17,31,65,127,257,511,1025,2047,4097,8191,16385,32767,65537,131071,262145,524287] -------------------------------------------------------------------------------------------------------------------------------- -- ** Josephus Numbers -------------------------------------------------------------------------------------------------------------------------------- -- GF: -- z - 2 -- -------------- -- 2z^2 + z - 1 -- CF: -- (1/2) * (2^n - 2*(-1)^n) -- | -- >>> take 30 $ drop 1 $ fromOEIS "A006257" -- [1,1,3,1,3,5,7,1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15,17,19,21,23,25,27,29] jos :: S Integer jos = 1 <|| 2 * jos - 1 |~| 2 * jos + 1 -- ^ -- >>> stake 30 $ jos -- [1,1,3,1,3,5,7,1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15,17,19,21,23,25,27,29] josAlt :: S Integer josAlt = 2 * (stail sNat - msb) + 1 -- ^ -- >>> stake 30 $ josAlt -- [1,1,3,1,3,5,7,1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15,17,19,21,23,25,27,29] -------------------------------------------------------------------------------------------------------------------------------- -- * Basically Binary (Base 2) -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- ** Most Significant Bit -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ drop 1 $ fromOEIS "A053644" -- [1,2,2,4,4,4,4,8,8,8,8,8,8,8,8,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16] msb :: S Integer msb = 1 <|| 2 * msb |~| 2 * msb -- ^ -- >>> stake 30 $ msb -- [1,2,2,4,4,4,4,8,8,8,8,8,8,8,8,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16] -------------------------------------------------------------------------------------------------------------------------------- -- ** Thue-Morse Sequence -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A010060" -- [0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,0,1,1,0,1,0] athue :: S Integer athue = 0 <|| interleave' (inv athue) (stail athue) -- ^ -- >>> stake 30 $ athue -- [0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,0,1,1,0,1,0] thue :: S Integer thue = 0 <|| thue' thue' :: S Integer thue' = 1 <|| interleave thue' (inv thue') -- ^ -- >>> stake 30 $ thue -- [0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,0,1,1,0,1,0] -------------------------------------------------------------------------------------------------------------------------------- -- ** Something with twos! -------------------------------------------------------------------------------------------------------------------------------- binlike1 :: S Integer binlike1 = 0 <|| 1 <|| smerge (sMap (* 2) binlike1) (stail binlike1) -- ^ -- >>> stake 30 $ binlike1 -- [0,1,0,1,2,0,0,1,2,2,4,0,0,0,0,1,2,2,4,2,4,4,8,0,0,0,0,0,0,0] -------------------------------------------------------------------------------------------------------------------------------- -- ** Something with twos! (2) -------------------------------------------------------------------------------------------------------------------------------- binlike2 :: S Integer binlike2 = 0 <|| 1 <|| smerge (stail binlike2) (sMap (* 2) binlike2) -- ^ -- >>> stake 30 $ binlike2 -- [0,1,1,0,1,2,0,2,1,0,2,2,0,4,2,0,1,4,0,2,2,0,2,4,0,4,4,0,2,8] -------------------------------------------------------------------------------------------------------------------------------- -- ** Who knows what this is? -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A000035" -- [0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1] lsb :: S Integer lsb = bsum 0 |~| 1 -- ^ -- >>> stake 30 $ bsum 0 |~| 1 -- [0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1] -------------------------------------------------------------------------------------------------------------------------------- -- ** Binary Sum Carry -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A011371" -- [0,0,1,1,3,3,4,4,7,7,8,8,10,10,11,11,15,15,16,16,18,18,19,19,22,22,23,23,25,25] sumcarry :: S Integer sumcarry = bsum carry -- ^ -- >>> stake 30 $ sumcarry -- [0,0,1,1,3,3,4,4,7,7,8,8,10,10,11,11,15,15,16,16,18,18,19,19,22,22,23,23,25,25] -------------------------------------------------------------------------------------------------------------------------------- -- * Fractals -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- ** Apollonian Fractal -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- *** D2: (-1,2,2,3) -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 20 $ fromOEIS "A060790" -- [1,2,2,3,15,38,110,323,927,2682,7754,22403,64751,187134,540822,1563011,4517183,13054898,37729362,109039875] apolloD2 :: (Floating a) => [a] -> a apolloD2 [] = 2 apolloD2 [_] = 2 apolloD2 (_:_:[]) = 3 apolloD2 (x:y:z:_) = (x + y + z) + 2*sqrt(x*y + y*z + z*x) -- ^ -- >>> stake 20 $ revFix apolloD2 -- [2.0,2.0,3.0,15.0,38.0,110.0,323.0,927.0,2682.0,7754.0,22403.0,64751.0,187134.0,540822.0,1563011.0,4517183.0,1.3054898e7,3.7729362e7,1.09039875e8,3.15131087e8] apolloD2alt :: (Floating a) => [a] -> a apolloD2alt [] = 2 apolloD2alt [_] = 2 apolloD2alt (_:_:[]) = 3 apolloD2alt (x:y:z:_) = (x + y + z) - 2*sqrt(x*y + y*z + z*x) -- ^ -- >>> stake 20 $ revFix apolloD2alt -- [2.0,2.0,3.0,-1.0,2.0,2.0,3.0,-1.0,2.0,2.0,3.0,-1.0,2.0,2.0,3.0,-1.0,2.0,2.0,3.0,-1.0] -- with (2,2) as the init -- -- http://www.wolframalpha.com/input/?i=%7B2%2C2%2C8%2C24%2C66%2C194%2C560%2C1616%2C4674%2C13506%2C39032%2C+112808%2C+326018%2C+942210%2C+2723040%2C+7869728%7D -- -- 1st, 2nd, and 3rd differences have the same shape (and are colinear) -- -- successive ratios converging to: -- 28.9005 -- -- generating function: -- 2*(z - 1) / (z^4 - 2z^3 -2z^2 -2z + 1) -- -- rep-pair items: -- 2424 -- with (3,3) as init -- -- http://www.wolframalpha.com/input/?i=%7B3%2C3%2C12%2C36%2C99%2C291%2C840%2C2424%2C7011%2C20259%2C5848%2C169212%7D -- -- successive ratios: -- 28.935 -- -- with (4,4) as init -- -- successive ratios: -- 2.8896 -- -- gen: -- same, but with 4 coeff -- -- odd ones of these have rep-pair items -- -- successive ratios: -- 2.8896 -- 4040 here apd2 :: (Floating a) => [a] -> a apd2 [] = -1 apd2 [_] = 2 apd2 (_:_:[]) = 2 apd2 (x:y:z:_) = (x + y + z) + sqrt(x*y + y*z + z*x) -------------------------------------------------------------------------------------------------------------------------------- -- *** D3: (-0,0,1,1) -------------------------------------------------------------------------------------------------------------------------------- fr :: Num t => (t, t, t, t, t, t, t, t) -> (t, t, t, t, t, t, t, t) fr (m', a, b, c, w', x, y, z) = let m = (4 * w' - m') w = 4 * (4 * w' - m') - w' in ( m, 2*m + a, 2*m + b, 2*m + c, w, 2*w + x, 2*w + y, 2*w + z ) apd3 :: Coalg (Integer, (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer)) Integer Integer apd3 = (now, next) where now (n,s) = proy s n next (n,s) _ = let n' = (n+1) `mod` 8 in (n', if n' == 0 then fr s else s) proy :: (a,a,a,a,a,a,a,a) -> Integer -> a proy (x,_,_,_,_,_,_,_) 0 = x proy (_,x,_,_,_,_,_,_) 1 = x proy (_,_,x,_,_,_,_,_) 2 = x proy (_,_,_,x,_,_,_,_) 3 = x proy (_,_,_,_,x,_,_,_) 4 = x proy (_,_,_,_,_,x,_,_) 5 = x proy (_,_,_,_,_,_,x,_) 6 = x proy (_,_,_,_,_,_,_,x) 7 = x proy (_,_,_,_,_,_,_,_) _ = error "this is unreachable" streamApD3 :: S Integer streamApD3 = cfix apd3 (0,(0,0,1,1,1,2,2,3)) -- ^ -- >>> stake 32 $ streamApD3 -- [0,0,1,1,1,2,2,3,4,8,9,9,15,32,32,33,56,120,121,121,209,450,450,451,780,1680,1681,1681,2911,6272,6272,6273] streamApD3' :: S (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer) streamApD3' = Cons (0,0,1,1,1,2,2,3) (sMap fr streamApD3') -- ^ -- >>> stake 4 $ streamApD3' -- [(0,0,1,1,1,2,2,3),(4,8,9,9,15,32,32,33),(56,120,121,121,209,450,450,451),(780,1680,1681,1681,2911,6272,6272,6273)] -- GF: -- 4 - z -- ------------- -- z^2 - 4z + 1 -------------------------------------------------------------------------------------------------------------------------------- -- ** Some /Fractal/ Numbers -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A025480" -- [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2,10,5,11,1,12,6,13,3,14,7] frac :: S Integer frac = sNat |~| frac -- ^ -- >>> stake 30 $ frac -- [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2,10,5,11,1,12,6,13,3,14,7] -------------------------------------------------------------------------------------------------------------------------------- -- ** Greatest Odd Divisor -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A000265" -- [1,1,3,1,5,3,7,1,9,5,11,3,13,7,15,1,17,9,19,5,21,11,23,3,25,13,27,7,29,15] god :: S Integer god = 2 * frac + 1 -- ^ -- >>> stake 30 $ god -- [1,1,3,1,5,3,7,1,9,5,11,3,13,7,15,1,17,9,19,5,21,11,23,3,25,13,27,7,29,15] -------------------------------------------------------------------------------------------------------------------------------- -- ** Dunno -------------------------------------------------------------------------------------------------------------------------------- blah :: S Integer blah = 2 ^ carry * god -- ^ -- @diverges!!@ -------------------------------------------------------------------------------------------------------------------------------- -- * The Zoo -------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------- -- ** Moser-de-Bruijn sequence -------------------------------------------------------------------------------------------------------------------------------- -- -- Moser-de Bruijn sequence: sum of distinct powers of 4 -- http://oeis.org/A000695 -- http://oeis.org/wiki/Negabinary -- http://oeis.org/A005351 -- http://oeis.org/A005352 -- http://oeis.org/A053985 -------------------------------------------------------------------------------------------------------------------------------- -- ** Fermi Dirac Numbers -------------------------------------------------------------------------------------------------------------------------------- -- fermi dirac numbers -- -- http://oeis.org/A186285 -- http://oeis.org/A050376 -------------------------------------------------------------------------------------------------------------------------------- -- ** 5-Smooth (Hamming) (Regular) Numbers -------------------------------------------------------------------------------------------------------------------------------- -- Hamming (or Regular) (or 5-smooth) Numbers -- -- These should be a stream, but this version produces different output than I expected. -- -- http://rosettacode.org/wiki/Hamming_numbers#Haskell -- -- "classic" -- | -- >>> take 30 $ fromOEIS "A051037" -- [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40,45,48,50,54,60,64,72,75,80] hamming :: S Integer hamming = 1 <|| smap (2*) hamming |!| smap (3*) hamming |!| smap (5*) hamming -- ^ -- >>> stake 30 $ hamming -- [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40,45,48,50,54,60,64,72,75,80] montest :: S Integer montest = 1 <|| smap (47*) montest |!| smap (59*) montest |!| smap (71*) montest -------------------------------------------------------------------------------------------------------------------------------- -- ** Dunno this one either? -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A092323" -- [0,1,1,3,3,3,3,7,7,7,7,7,7,7,7,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15] a092323 :: S Integer a092323 = diff sNat - msb -- ^ -- >>> stake 30 $ (diff sNat - msb) -- [0,-1,-1,-3,-3,-3,-3,-7,-7,-7,-7,-7,-7,-7,-7,-15,-15,-15,-15,-15,-15,-15,-15,-15,-15,-15,-15,-15,-15,-15] -------------------------------------------------------------------------------------------------------------------------------- -- ** Carry Bits -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A007814" -- [0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1] carry :: S Integer carry = 0 <|| carry + 1 |~| 0 -- ^ -- >>> stake 30 $ carry -- [0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1] altCarry :: S Integer altCarry = (bsum carry |~| bsum carry) |~| (sNat |~| sNat) -- wrong! -- ^ -- @FIXME@: Incorrect! -- tree :: Integral a => a -> S a tree n = n <|| turn n <<| tree (n+1) -- ^ -- >>> stake 30 $ tree 0 -- [0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1] -------------------------------------------------------------------------------------------------------------------------------- -- ** Non-Negative Integers. Repeated. Floor (n/2) -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 30 $ fromOEIS "A004526" -- [0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13,14,14] a004526 :: S Integer a004526 = bsum $ 0 `smerge` 1 -- ^ -- >>> stake 30 $ a004526 -- [0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13,14,14] -------------------------------------------------------------------------------------------------------------------------------- -- ** Square Pyramidal Numbers -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 16 $ 0 : fromOEIS "A000330" -- [0,0,1,5,14,30,55,91,140,204,285,385,506,650,819,1015] a000330 :: S Integer a000330 = bsum $ sNat^(2::Integer) -- ^ -- >>> stake 16 $ a000330 -- [0,0,1,5,14,30,55,91,140,204,285,385,506,650,819,1015] -------------------------------------------------------------------------------------------------------------------------------- -- ** The "Perturbation Method" -------------------------------------------------------------------------------------------------------------------------------- -- | perturbation method -- -- bsum s = bsum (stail s) - s + repeat (shead s) -- -- bsum s = 0 <| repeat (shead s) + bsum (stail s) -------------------------------------------------------------------------------------------------------------------------------- -- ** iterate k = 2^n-k -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 21 $ 1 : fromOEIS "A078008" -- [1,1,0,2,2,6,10,22,42,86,170,342,682,1366,2730,5462,10922,21846,43690,87382,174762] iterk2nk :: S Integer iterk2nk = cfix (iterk2nkH, iterk2nkT) (0,1) iterk2nkH :: (a, b) -> a iterk2nkH (x,_) = x iterk2nkT :: (Num a) => (a, a) -> a -> (a, a) iterk2nkT (x,y) ____ = (2*y, x+y) -- ^ -- >>> stake 21 $ [1,1] <<| iterk2nk -- [1,1,0,2,2,6,10,22,42,86,170,342,682,1366,2730,5462,10922,21846,43690,87382,174762] -------------------------------------------------------------------------------------------------------------------------------- -- ** What the heck is this? -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 15 $ fromOEIS "A090017" -- [0,1,4,18,80,356,1584,7048,31360,139536,620864,2762528,12291840,54692416,243353344] a090017 :: G Integer Integer a090017 [] = 0 a090017 [_] = 1 a090017 (x:y:_) = 2*(2*x + y) -- ^ -- >>> stake 15 $ revFix a090017 -- [0,1,4,18,80,356,1584,7048,31360,139536,620864,2762528,12291840,54692416,243353344] -------------------------------------------------------------------------------------------------------------------------------- -- ** Horadam (0,1,4,2) Numbers -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 15 $ fromOEIS "A085449" -- [0,1,2,8,24,80,256,832,2688,8704,28160,91136,294912,954368,3088384] horadam0142 :: G Integer Integer horadam0142 [] = 0 horadam0142 [_] = 1 horadam0142 (x:y:_) = 2*(x + 2*y) -- ^ -- >>> stake 15 $ revFix horadam0142 -- [0,1,2,8,24,80,256,832,2688,8704,28160,91136,294912,954368,3088384] -------------------------------------------------------------------------------------------------------------------------------- -- ** Some random thing I found. -------------------------------------------------------------------------------------------------------------------------------- -- | -- >>> take 15 $ fromOEIS "A002605" -- [0,1,2,6,16,44,120,328,896,2448,6688,18272,49920,136384,372608] a002605 :: G Integer Integer a002605 [] = 0 a002605 [_] = 1 a002605 (x:y:_) = 2*(x + y) -- ^ -- >>> stake 15 $ revFix a002605 -- [0,1,2,6,16,44,120,328,896,2448,6688,18272,49920,136384,372608]