Project Euler Problem #14


Longest hailstone sequence with starting number under one-million.

let hailstone n = Seq.unfold (function 0L -> None | 1L -> Some(1L, 0L)

                                     | n when n % 2L = 0L -> Some(n, n / 2L)

                                     | n -> Some(n, 3L * n + 1L)) n

let chainLen n = hailstone n |> Seq.length

let naturals = Seq.unfold (fun i -> Some(i, i + 1L)) 1L

let lengths = Seq.map chainLen naturals

let results = Seq.zip naturals lengths

results |> Seq.takeWhile (fst >> ((>=) 1000000L)) |> Seq.maxBy snd |> fst

Comments (2)

  1. nundee says:

    Here's a faster alternative:

    let hailstone2 n =

       let rec loop n l = match n with

                          | 0L ->  l

                          | 1L ->  l+1L

                          | x when x % 2L = 0L -> loop (x/2L) (l+1L)

                          | x -> loop (3L*x+1L) (l+1L)

       in loop (int64 n) 0L

    let longestChain n = Seq.initInfinite id |> Seq.takeWhile ((>=) n) |> Seq.maxBy hailstone2

    longestChain 1000000