extra/rosetta-code/hofstadter-q/hofstadter-q.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: kernel math prettyprint sequences ;
   4 IN: rosetta-code.hofstadter-q
   5
   6 ! https://rosettacode.org/wiki/Hofstadter_Q_sequence
   7
   8 ! The Hofstadter Q sequence is defined as:
   9 !    Q(1) = Q(2) = 1
  10 !    Q(n) = Q(n - Q(n-1)) + Q(n - Q(n-2))     , n > 2
  11
  12 ! It is defined like the Fibonacci sequence, but whereas the
  13 ! next term in the Fibonacci sequence is the sum of the previous
  14 ! two terms, in the Q sequence the previous two terms tell you how
  15 ! far to go back in the Q sequence to find the two numbers to sum
  16 ! to make the next term of the sequence.
  17
  18 ! Task
  19
  20 ! 1. Confirm and display that the first ten terms of the sequence
  21 !    are: 1, 1, 2, 3, 3, 4, 5, 5, 6, and 6
  22
  23 ! 2. Confirm and display that the 1000'th term is: 502
  24
  25 ! Optional extra credit
  26
  27 ! * Count and display how many times a member of the sequence is
  28 !   less than its preceding term for terms up to and including the
  29 !   100,000'th term.
  30
  31 ! * Ensure that the extra credit solution 'safely' handles being
  32 !   initially asked for an n'th term where n is large.
  33
  34 ! (This point is to ensure that caching and/or recursion limits,
  35 ! if it is a concern, is correctly handled).
  36
  37  : next ( seq -- newseq )
  38     dup 2 tail* over length [ swap - ] curry map
  39     [ dupd swap nth ] map 0 [ + ] reduce suffix ;
  40
  41 : qs-main ( -- )
  42     { 1 1 } 1000 [ next ] times  dup 10 head .  999 swap nth . ;