Data update

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

@@ -1,21 +1,13 @@
-import Data.Array
+douglasHofstadter :: Int -> [Int]
+douglasHofstadter m = reverse (dSeqEffect [1,1] 2 m)
+                      where
+                           dSeqEffect xs n m | n > m = xs
+                                             | otherwise = dSeqEffect (((xs !! (xs !! (n - 1))) + (xs !! (n - (xs !! (n - 1)))) ) : xs) (n + 1) m
 
-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))
+-- main
+getIntArg :: IO Int
+getIntArg = fmap (read . head) getArgs
 
-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)
+main = do
+        args <- getIntArg
+        print (douglasHofstadter args)

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

@@ -1,7 +1,21 @@
-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)
+import Data.Array
 
-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)
+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-4.hs

@@ -1,16 +1,7 @@
-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]])
+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)
 
-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))
+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-5.hs

@@ -1,21 +1,16 @@
-import Data.Array
-import Data.Int (Int64)
+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]])
 
-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
+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-6.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