Data commit

Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-1.hs

@@ -0,0 +1,8 @@
+qSequence = tail qq where
+  qq = 0 : 1 : 1 : map g [3..]
+  g n = qq !! (n - qq !! (n-1)) + qq !! (n - qq !! (n-2))
+
+-- Output:
+*Main> (take 10 qSequence, qSequence !! (1000-1))
+([1,1,2,3,3,4,5,5,6,6],502)
+(0.00 secs, 525044 bytes)

Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-2.hs

@@ -0,0 +1,21 @@
+import Data.Array
+
+qSequence n = arr
+  where
+     arr = listArray (1,n) $ 1:1: map g [3..n]
+     g i = arr!(i - arr!(i-1)) +
+           arr!(i - arr!(i-2))
+
+gradualth m k arr                         -- gradually precalculate m-th item
+        | m <= v = pre `seq` arr!m        --   in steps of k
+  where                                   --     to prevent STACK OVERFLOW
+    pre = foldl1 (\a b-> a `seq` arr!b) [u,u+k..m]
+    (u,v) = bounds arr
+
+qSeqTest m n = let arr = qSequence $ max m n in
+  ( take 10 . elems  $ arr                       -- 10 first items
+  , gradualth m 10000 $ arr                      -- m-th item
+  , length . filter (> 0)                       -- reversals in n items
+     . _S (zipWith (-)) tail . take n . elems $ arr )
+
+_S f g x = f x (g x)

Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-3.hs

@@ -0,0 +1,7 @@
+Prelude Main> qSeqTest 1000 100000    -- reversals in 100,000
+([1,1,2,3,3,4,5,5,6,6],502,49798)
+(0.09 secs, 18879708 bytes)
+
+Prelude Main> qSeqTest 1000000 100000   -- 1,000,000-th item
+([1,1,2,3,3,4,5,5,6,6],512066,49798)
+(2.80 secs, 87559640 bytes)

Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs

@@ -0,0 +1,16 @@
+q = qq (listArray (1,2) [1,1]) 1 where
+    qq ar n    = (arr!n) : qq arr (n+1) where
+        l = snd (bounds ar)
+        step n =arr!(n - (fromIntegral (arr!(n - 1)))) +
+            arr!(n - (fromIntegral (arr!(n - 2))))
+        arr :: Array Int Integer
+        arr | n <= l = ar
+            | otherwise = listArray (1, l*2)$
+                ([ar!i | i <- [1..l]] ++
+                 [step i | i <- [l+1..l*2]])
+
+main = do
+    putStr("first 10: "); print (take 10 q)
+    putStr("1000-th:  "); print (q !! 999)
+    putStr("flips: ")
+    print $ length $ filter id $ take 100000 (zipWith (>) q (tail q))

Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs

@@ -0,0 +1,21 @@
+import Data.Array
+import Data.Int (Int64)
+
+q = qq [listArray (1,2) [1,1]] 1 where
+    qq a n = seek aa n : qq aa (1 + n) where
+        aa  | n <= l = a
+            | otherwise = listArray (l+1,l*2) (take l $ drop 2 lst):a
+            where
+            l = snd (bounds $ head a)
+            lst = seek a (l-1):seek a l:(ext lst (l+1))
+            ext (q1:q2:qs) i = (g (i-q2) + g (i-q1)):ext (q2:qs) (1+i)
+            g = seek aa
+        seek (ar:ars) n
+            | n >= fst (bounds ar) = ar ! n
+            | otherwise = seek ars n
+
+-- Only a perf test. Task can be done exactly the same as above
+main = print $ sum qqq
+    where
+        qqq :: [Int64]
+        qqq = map fromIntegral $ take 3000000 q