I tried to solve the same problem and came out with a O(log n) solution. It is pretty quick, since I keep track of the steps on a map structure.

Even though it runs really fast, it hogs on memory just like Steve's version.

Following is the full source, for your consideration:


======================Euler14.hs======================
import qualified Data.Map as Map
import qualified Data.List as List

type Table=Map.Map Integer Integer

rank::Table->Integer->(Table,Integer)
rank s n= (s',r)
    where
        nxt=if even n then (n `div` 2) else (3*n+1)
        r=case (Map.lookup n s) of
            Just a -> a
            Nothing-> (1 + (snd $ rank s nxt))
        s'=Map.insert n r s

search::Integer->Integer
search n = case List.findIndex (\a -> a==ms) sw of
                Just a -> toInteger(a) +1
                Nothing -> -1
    where s=Map.singleton 1 1
          sw=searchWork s [1..n]
          ms=maximum sw

searchWork::Table->[Integer]->[Integer]
searchWork s []=[]
searchWork s (i:is)= r:(searchWork s' is)
    where
        (s',r)=rank s i

main = do 
    print $ search 1000000
======================Euler14.hs======================