Hofstadter sequences

hofstadter.sml

(*
 * Hofstadter sequences
 * https://en.wikipedia.org/wiki/Hofstadter_sequence
 *)

signature QUEUE =                            
  sig                                                
    type 'a queue = 'a list * 'a list                                 
    val empty: 'a queue                           
    val enqueue: 'a -> 'a queue -> 'a queue     
    val dequeue: 'a queue -> 'a * 'a queue
  end 

structure Queue :> QUEUE =
struct
  type 'a queue = 'a list * 'a list
  val empty = ([], [])
  fun enqueue x (front, back) = (front, x :: back)
  fun dequeue ([], []) = raise Empty
    | dequeue (front, back) =
        let
          val (front', back') =
            if null front
            then (rev back, [])
            else (front, back)
        in
          (hd front', (tl front', back'))
        end
end

(* Figure-Figure sequences
 *
 * F(1) = 1
 * S(1) = 2
 * F(n) = F(n-1) + S(n-1)
 *
 * n 1  2  3  4  5  6  7  8  9
 * F 1  3  7 12 18 26 35 45 56
 * S 2  4  5  6  8  9 10 11 13
 *
 *)
fun figure n =
  let
    fun figure' f s _     1 = (f, s)
      | figure' f s queue n =
          let
            val f' = f + s
            val queue' = Queue.enqueue f' queue
            val s' = s + 1
            val (m, queue'') = Queue.dequeue queue'
          in
            if s' = m
            then figure' f' (s' + 1) queue'' (n - 1)
            else figure' f' s' queue' (n - 1)
          end
  in
    figure' 1 2 Queue.empty n
  end

(* G sequence *)
fun g 0 = 0
  | g n = n - g (g (n - 1))

(* H sequence *)
fun h 0 = 0
  | h n = n - h (h (h (n - 1)))

(* Female and Male sequences *)
fun f 0 = 1
  | f n = n - m (f (n - 1))
and m 0 = 0
  | m n = n - f (m (n - 1))

(* Q sequence *)
fun q 1 = 1
  | q 2 = 1
  | q n = q (n - q (n - 1)) + q (n - q (n - 2))

(* U sequence *)


(* Hofstadter - Conway $10K sequence*)
fun a 1 = 1
  | a 2 = 1
  | a n = a (a (n - 1)) + a (n - a (n - 1))