Experimenting efficiency of Haskell

014.c

@@ -0,0 +1,39 @@
+#include <stdio.h>
+
+int main(int argc, char **argv)
+{
+  int longest = 0;
+  int terms = 0;
+  int i;
+  unsigned long j;
+  int this_terms;
+
+  for (i = 1; i <= 1000000; i++)
+  {
+    j = i;
+    this_terms = 1;
+
+    while (j != 1)
+    {
+      this_terms++;
+
+      if (this_terms > terms)
+      {
+        terms = this_terms;
+        longest = i;
+      }
+
+      if (j % 2 == 0)
+      {
+        j = j / 2;
+      }
+      else
+      {
+        j = 3 * j + 1;
+      }
+    }
+  }
+
+  printf("longest: %d (%d)\n", longest, terms);
+  return 0;
+}

014.hs

@@ -0,0 +1,39 @@
+import Data.List
+type YInt = Int
+
+collatz :: YInt -> YInt
+collatz n = if n<0 then 1 else if even n then n `quot` 2 else 3*n+1
+
+-- The l `seq` is necessary to not be lazy (non-strict)
+-- And not to fill the stack
+lencollatz' :: YInt -> YInt -> YInt
+lencollatz' l 1 = l
+lencollatz' l n = l `seq` lencollatz' (l+1) (collatz n)
+
+lencollatz = lencollatz' 0
+
+-- The j `seq` is necessary to not be lazy (non-strict)
+-- And not to fill the stack
+maximalIndex :: (YInt,YInt) -> YInt -> [YInt] -> (YInt,YInt)
+maximalIndex (m,i) j []     = (m,i)
+maximalIndex (m,i) j (x:xs) = j `seq` maximalIndex res (j+1) xs
+                              where res = if x>m then (x,j) else (m,i)
+
+showCollatz :: YInt -> String
+showCollatz 1 = "1"
+showCollatz n = show n ++ " → " ++ showCollatz ( collatz n )
+
+pure (Just x) = x
+
+main = do 
+            putStrLn $ "max len: " ++ show m
+            putStrLn $ "max value: " ++ show i
+            -- print mrec
+            -- print irec
+            -- putStrLn $ showCollatz $ toInteger i
+       where 
+            array = map lencollatz [1..1000000] 
+            m = maximum array 
+            i = 1 + pure (elemIndex m array)
+            (mrec,irec) = maximalIndex (0,0) 1 array
+

014c.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE BangPatterns #-}
+module Main (main) where
+
+import Data.Bits
+
+main :: IO ()
+main = putStrLn $ "longest: " ++ show longest ++ " (" ++ show terms ++ ")"
+       where IP longest terms = euler14
+
+data IntPair = IP {-# UNPACK #-} !Int {-# UNPACK #-} !Int
+
+euler14 :: IntPair
+euler14 = go 1 0 0
+    where
+      go :: Int -> Int -> Int -> IntPair
+      go i !longest !terms | i <= 1000000 = while i 1 longest terms
+                           | otherwise    = IP longest terms
+        where
+            while :: Int -> Int -> Int -> Int -> IntPair
+            while 1 !_ !longest !terms = go (i+1) longest terms
+            while j thisTerms longest terms =
+                let thisTerms' = thisTerms + 1
+                    IP terms' longest' = if thisTerms > terms
+                                            then IP thisTerms i
+                                            else IP terms longest
+                    j' = if j<0 then 1 else 
+                                            if j .&. 1 == 0
+                                               then j `quot` 2
+                                               else 3 * j + 1
+                in while j' thisTerms' longest' terms'