Hofstadter Figure-Figure sequences: Difference between revisions

From Rosetta Code
Content added Content deleted
m (Note added regarding redundancy.)
Line 927: Line 927:


=={{header|Mathematica}} ==
=={{header|Mathematica}} ==



1. Create two functions named ffr and ffs that when given n return R(n) or S(n) respectively.
1. Create two functions named ffr and ffs that when given n return R(n) or S(n) respectively.
The instructions call for two functions.
Because S[n] is generated while computing R[n], one would normally avoid redundancy by combining R and S into a single function that
returns both sequences.


2. No maximum value for n should be assumed.
2. No maximum value for n should be assumed.

Revision as of 00:40, 20 November 2012

Task
Hofstadter Figure-Figure sequences
You are encouraged to solve this task according to the task description, using any language you may know.

These two sequences of positive integers are defined as:

The sequence is further defined as the sequence of positive integers not present in .

Sequence R starts: 1, 3, 7, 12, 18, ...
Sequence S starts: 2, 4, 5, 6, 8, ...

Task:

  1. Create two functions named ffr and ffs that when given n return R(n) or S(n) respectively.
    (Note that R(1) = 1 and S(1) = 2 to avoid off-by-one errors).
  2. No maximum value for n should be assumed.
  3. Calculate and show that the first ten values of R are: 1, 3, 7, 12, 18, 26, 35, 45, 56, and 69
  4. Calculate and show that the first 40 values of ffr plus the first 960 values of ffs include all the integers from 1 to 1000 exactly once.
References

Ada

Specifying a package providing the functions FFR and FFS: <lang Ada>package Hofstadter_Figure_Figure is

  function FFR(P: Positive) return Positive;
  function FFS(P: Positive) return Positive;

end Hofstadter_Figure_Figure;</lang>

The implementation of the package internally uses functions which generate an array of Figures or Spaces: <lang Ada>package body Hofstadter_Figure_Figure is

  type Positive_Array is array (Positive range <>) of Positive;
  function FFR(P: Positive) return Positive_Array is
     Figures: Positive_Array(1 .. P+1);
     Space: Positive := 2;
     Space_Index: Positive := 2;
  begin
     Figures(1) := 1;
     for I in 2 .. P loop
        Figures(I) := Figures(I-1) + Space;
        Space := Space+1;
        while Space = Figures(Space_Index) loop
           Space := Space + 1;
           Space_Index := Space_Index + 1;
        end loop;
     end loop;
     return Figures(1 .. P);
  end FFR;
  function FFR(P: Positive) return Positive is
     Figures: Positive_Array(1 .. P) := FFR(P);
  begin
     return Figures(P);
  end FFR;
  function FFS(P: Positive) return Positive_Array is
     Spaces:  Positive_Array(1 .. P);
     Figures: Positive_Array := FFR(P+1);
     J: Positive := 1;
     K: Positive := 1;
  begin
     for I in Spaces'Range loop
        while J = Figures(K) loop
           J := J + 1;
           K := K + 1;
        end loop;
        Spaces(I) := J;
        J := J + 1;
     end loop;
     return Spaces;
  end FFS;
  function FFS(P: Positive) return Positive is
     Spaces: Positive_Array := FFS(P);
  begin
     return Spaces(P);
  end FFS;

end Hofstadter_Figure_Figure;</lang>

Finally, a test program for the package, solving the task at hand: <lang Ada>with Ada.Text_IO, Hofstadter_Figure_Figure;

procedure Test_HSS is

  use Hofstadter_Figure_Figure;
  A: array(1 .. 1000) of Boolean := (others => False);
  J: Positive;

begin

  for I in 1 .. 10 loop
     Ada.Text_IO.Put(Integer'Image(FFR(I)));
  end loop;
  Ada.Text_IO.New_Line;
  for I in 1 .. 40 loop
     J := FFR(I);
     if A(J) then
        raise Program_Error with Positive'Image(J) & " used twice";
     end if;
     A(J) := True;
  end loop;
  for I in 1 .. 960 loop
     J := FFS(I);
     if A(J) then
        raise Program_Error with Positive'Image(J) & " used twice";
     end if;
     A(J) := True;
  end loop;
  for I in A'Range loop
     if not A(I) then raise Program_Error with Positive'Image(I) & " unused";
     end if;
  end loop;
  Ada.Text_IO.Put_Line("Test Passed: No overlap between FFR(I) and FFS(J)");

exception

  when Program_Error => Ada.Text_IO.Put_Line("Test Failed"); raise;

end Test_HSS;</lang>

The output of the test program: <lang> 1 3 7 12 18 26 35 45 56 69 Test Passed: No overlap between FFR(I) and FFS(J)</lang>

BBC BASIC

<lang bbcbasic> PRINT "First 10 values of R:"

     FOR i% = 1 TO 10 : PRINT ;FNffr(i%) " "; : NEXT : PRINT
     PRINT "First 10 values of S:"
     FOR i% = 1 TO 10 : PRINT ;FNffs(i%) " "; : NEXT : PRINT
     PRINT "Checking for first 1000 integers:"
     r% = 1 : s% = 1
     ffr% = FNffr(r%)
     ffs% = FNffs(s%)
     FOR wanted% = 1 TO 1000
       CASE TRUE OF
         WHEN wanted% = ffr% : r% += 1 : ffr% = FNffr(r%)
         WHEN wanted% = ffs% : s% += 1 : ffs% = FNffs(s%)
         OTHERWISE: EXIT FOR
       ENDCASE
     NEXT
     IF r% = 41 AND s% = 961 PRINT "Test passed" ELSE PRINT "Test failed"
     END
     
     DEF FNffr(N%)
     LOCAL I%, J%, R%, S%, V%
     DIM V% LOCAL 2*N%+1
     V%?1 = 1
     IF N% = 1 THEN = 1
     R% = 1
     S% = 2
     FOR I% = 2 TO N%
       FOR J% = S% TO 2*N%
         IF V%?J% = 0 EXIT FOR
       NEXT
       V%?J% = 1
       S% = J%
       R% += S%
       IF R% <= 2*N% V%?R% = 1
     NEXT I%
     = R%
     
     DEF FNffs(N%)
     LOCAL I%, J%, R%, S%, V%
     DIM V% LOCAL 2*N%+1
     V%?1 = 1
     IF N% = 1 THEN = 2
     R% = 1
     S% = 2
     FOR I% = 1 TO N%
       FOR J% = S% TO 2*N%
         IF V%?J% = 0 EXIT FOR
       NEXT
       V%?J% = 1
       S% = J%
       R% += S%
       IF R% <= 2*N% V%?R% = 1
     NEXT I%
     = S%</lang>
First 10 values of R:
1 3 7 12 18 26 35 45 56 69
First 10 values of S:
2 4 5 6 8 9 10 11 13 14
Checking for first 1000 integers:
Test passed

Common Lisp

<lang lisp>;;; equally doable with a list (flet ((seq (i) (make-array 1 :element-type 'integer :initial-element i :fill-pointer 1 :adjustable t)))

 (let ((rr (seq 1)) (ss (seq 2)))
   (labels ((extend-r ()

(let* ((l (1- (length rr))) (r (+ (aref rr l) (aref ss l))) (s (elt ss (1- (length ss))))) (vector-push-extend r rr) (loop while (<= s r) do (if (/= (incf s) r) (vector-push-extend s ss))))))

     (defun seq-r (n)

(loop while (> n (length rr)) do (extend-r)) (elt rr (1- n)))

     (defun seq-s (n)

(loop while (> n (length ss)) do (extend-r)) (elt ss (1- n))))))

(defun take (f n)

 (loop for x from 1 to n collect (funcall f x)))

(format t "First of R: ~a~%" (take #'seq-r 10))

(mapl (lambda (l) (if (and (cdr l) (/= (1+ (car l)) (cadr l))) (error "not in sequence")))

     (sort (append (take #'seq-r 40)

(take #'seq-s 960)) #'<)) (princ "Ok")</lang>output<lang>First of R: (1 3 7 12 18 26 35 45 56 69) Ok</lang>

C#

Creates an IEnumerable for R and S and uses those to complete the task <lang Csharp>using System; using System.Collections.Generic; using System.Linq;

namespace HofstadterFigureFigure { class HofstadterFigureFigure { readonly List<int> _r = new List<int>() {1}; readonly List<int> _s = new List<int>();

public IEnumerable<int> R() { int iR = 0; while (true) { if (iR >= _r.Count) { Advance(); } yield return _r[iR++]; } }

public IEnumerable<int> S() { int iS = 0; while (true) { if (iS >= _s.Count) { Advance(); } yield return _s[iS++]; } }

private void Advance() { int rCount = _r.Count; int oldR = _r[rCount - 1]; int sVal;

// Take care of first two cases specially since S won't be larger than R at that point switch (rCount) { case 1: sVal = 2; break; case 2: sVal = 4; break; default: sVal = _s[rCount - 1]; break; } _r.Add(_r[rCount - 1] + sVal); int newR = _r[rCount]; for (int iS = oldR + 1; iS < newR; iS++) { _s.Add(iS); } } }

class Program { static void Main() { var hff = new HofstadterFigureFigure(); var rs = hff.R(); var arr = rs.Take(40).ToList();

foreach(var v in arr.Take(10)) { Console.WriteLine("{0}", v); }

var hs = new HashSet<int>(arr); hs.UnionWith(hff.S().Take(960)); Console.WriteLine(hs.Count == 1000 ? "Verified" : "Oops! Something's wrong!"); } } } </lang> Output:

1
3
7
12
18
26
35
45
56
69
Verified

C

<lang c>#include <stdio.h>

  1. include <stdlib.h>

// simple extensible array stuff typedef unsigned long long xint;

typedef struct { size_t len, alloc; xint *buf; } xarray;

xarray rs, ss;

void setsize(xarray *a, size_t size) { size_t n = a->alloc; if (!n) n = 1;

while (n < size) n <<= 1; if (a->alloc < n) { a->buf = realloc(a->buf, sizeof(xint) * n); if (!a->buf) abort(); a->alloc = n; } }

void push(xarray *a, xint v) { while (a->alloc <= a->len) setsize(a, a->alloc * 2);

a->buf[a->len++] = v; }


// sequence stuff void RS_append(void);

xint R(int n) { while (n > rs.len) RS_append(); return rs.buf[n - 1]; }

xint S(int n) { while (n > ss.len) RS_append(); return ss.buf[n - 1]; }

void RS_append() { int n = rs.len; xint r = R(n) + S(n); xint s = S(ss.len);

push(&rs, r); while (++s < r) push(&ss, s); push(&ss, r + 1); // pesky 3 }

int main(void) { push(&rs, 1); push(&ss, 2);

int i; printf("R(1 .. 10):"); for (i = 1; i <= 10; i++) printf(" %llu", R(i));

char seen[1001] = { 0 }; for (i = 1; i <= 40; i++) seen[ R(i) ] = 1; for (i = 1; i <= 960; i++) seen[ S(i) ] = 1; for (i = 1; i <= 1000 && seen[i]; i++);

if (i <= 1000) { fprintf(stderr, "%d not seen\n", i); abort(); }

puts("\nfirst 1000 ok"); return 0; }</lang>

D

Translation of: Go

<lang d>import std.stdio, std.array, std.range, std.algorithm;

int delegate(in int) nothrow ffr, ffs;

static this() {

   auto r = [0, 1], s = [0, 2];
   ffr = (in int n) {
       while (r.length <= n) {
           int nrk = r.length - 1;
           int rNext = r[nrk] + s[nrk];
           r ~= rNext;
           foreach (sn; r[nrk] + 2 .. rNext)
               s ~= sn;
           s ~= rNext + 1;
       }
       return r[n];
   };
   ffs = (in int n) {
       while (s.length <= n)
           ffr(r.length);
       return s[n];
   };

}

void main() {

   writeln(iota(1, 11).map!ffr());
   auto t = iota(1, 41).map!ffr().chain(iota(1, 961).map!ffs());
   writeln(t.array().sort().equal(iota(1, 1001)));

}</lang> Output:

[1, 3, 7, 12, 18, 26, 35, 45, 56, 69]
true

Alternative version

Translation of: Python

(Same output) <lang d>import std.stdio, std.array, std.range, std.algorithm;

struct ffr {

   static int[] r = [int.min, 1];
   static int opCall(in int n) {
       assert(n > 0);
       if (n < r.length) {
           return r[n];
       } else {
           int ffr_n_1 = ffr(n - 1);
           int lastr = r[$ - 1];
           // extend s up to, and one past, last r
           ffs.s ~= array(iota(ffs.s[$ - 1] + 1, lastr));
           if (ffs.s[$ - 1] < lastr)
               ffs.s ~= lastr + 1;
           // access s[n-1] temporarily extending s if necessary
           size_t len_s = ffs.s.length;
           int ffs_n_1 = len_s > n ? ffs.s[n - 1] :
                                     (n - len_s) + ffs.s[$-1];
           int ans = ffr_n_1 + ffs_n_1;
           r ~= ans;
           return ans;
       }
   }

}

struct ffs {

   static int[] s = [int.min, 2];
   static int opCall(in int n) {
       assert(n > 0);
       if (n < s.length) {
           return s[n];
       } else {
           foreach (i; ffr.r.length .. n+2) {
               ffr(i);
               if (s.length > n)
                   return s[n];
           }
           assert(0, "Whoops!");
       }
   }

}

void main() {

   writeln(map!ffr(iota(1, 11)));
   auto t = chain(map!ffr(iota(1, 41)), map!ffs(iota(1, 961)));
   writeln(equal(sort(array(t)), iota(1, 1001)));

}</lang>

Factor

We keep lists S and R, and increment them when necessary. <lang factor>SYMBOL: S V{ 2 } S set SYMBOL: R V{ 1 } R set

next ( s r -- news newr )

2dup [ last ] bi@ + suffix dup [

 [ dup last 1 + dup ] dip member? [ 1 + ] when suffix

] dip ;

inc-SR ( n -- )

dup 0 <= [ drop ] [ [ S get R get ] dip [ next ] times R set S set ] if ;

ffs ( n -- S(n) )

dup S get length - inc-SR 1 - S get nth ;

ffr ( n -- R(n) )

dup R get length - inc-SR 1 - R get nth ;</lang>

<lang factor>( scratchpad ) 10 iota [ 1 + ffr ] map . { 1 3 7 12 18 26 35 45 56 69 } ( scratchpad ) 40 iota [ 1 + ffr ] map 960 iota [ 1 + ffs ] map append 1000 iota 1 v+n set= . t</lang>

Go

<lang go>package main

import "fmt"

var ffr, ffs func(int) int

// The point of the init function is to encapsulate r and s. If you are // not concerned about that or do not want that, r and s can be variables at // package level and ffr and ffs can be ordinary functions at package level. func init() {

   // task 1, 2
   r := []int{0, 1}
   s := []int{0, 2}
   ffr = func(n int) int {
       for len(r) <= n {
           nrk := len(r) - 1       // last n for which r(n) is known
           rNxt := r[nrk] + s[nrk] // next value of r:  r(nrk+1)
           r = append(r, rNxt)     // extend sequence r by one element
           for sn := r[nrk] + 2; sn < rNxt; sn++ {
               s = append(s, sn)   // extend sequence s up to rNext
           }
           s = append(s, rNxt+1)   // extend sequence s one past rNext
       }
       return r[n]
   }
   ffs = func(n int) int {
       for len(s) <= n {
           ffr(len(r))
       }
       return s[n]
   }

}

func main() {

   // task 3
   for n := 1; n <= 10; n++ {
       fmt.Printf("r(%d): %d\n", n, ffr(n))
   }
   // task 4
   var found [1001]int
   for n := 1; n <= 40; n++ {
       found[ffr(n)]++
   }
   for n := 1; n <= 960; n++ {
       found[ffs(n)]++
   }
   for i := 1; i <= 1000; i++ {
       if found[i] != 1 {
           fmt.Println("task 4: FAIL")
           return
       }
   }
   fmt.Println("task 4: PASS")

}</lang> Output:

r(1): 1
r(2): 3
r(3): 7
r(4): 12
r(5): 18
r(6): 26
r(7): 35
r(8): 45
r(9): 56
r(10): 69
task 4: PASS

The following defines two mutually recursive generators without caching results. Each generator will end up dragging a tree of closures behind it, but due to the odd nature of the two series' growth pattern, it's still a heck of a lot faster than the above method when producing either series in sequence. <lang go>package main import "fmt"

type xint int64 func R() (func() (xint)) { r, s := xint(0), func() (xint) (nil) return func() (xint) { switch { case r < 1: r = 1 case r < 3: r = 3 default: if s == nil { s = S() s() } r += s() } if r < 0 { panic("r overflow") } return r } }

func S() (func() (xint)) { s, r1, r := xint(0), xint(0), func() (xint) (nil) return func() (xint) { if s < 2 { s = 2 } else { if r == nil { r = R() r() r1 = r() } s++ if s > r1 { r1 = r() } if s == r1 { s++ } } if s < 0 { panic("s overflow") } return s } }

func main() { r, sum := R(), xint(0) for i := 0; i < 10000000; i++ { sum += r() } fmt.Println(sum) }</lang>

Haskell

<lang haskell>import Data.List (delete, sort)

-- Functions by Reinhard Zumkeller ffr n = rl !! (n - 1) where

  rl = 1 : fig 1 [2 ..]
  fig n (x : xs) = n' : fig n' (delete n' xs) where n' = n + x

ffs n = rl !! n where

  rl = 2 : figDiff 1 [2 ..]
  figDiff n (x : xs) = x : figDiff n' (delete n' xs) where n' = n + x

main = do

   print $ map ffr [1 .. 10]
   let i1000 = sort (map ffr [1 .. 40] ++ map ffs [1 .. 960])
   print (i1000 == [1 .. 1000])</lang>

Output:

[1,3,7,12,18,26,35,45,56,69]
True

Defining R and S literally: <lang haskell>import Data.List (sort)

r = scanl (+) 1 s s = 2:4:tail (compliment (tail r)) where compliment = concat.interval interval x = zipWith (\x y -> [x+1..y-1]) x (tail x)

main = do putStr "R: "; print (take 10 r) putStr "S: "; print (take 10 s) putStr "test 1000: "; print ([1..1000] == sort ((take 40 r) ++ (take 960 s)))</lang> output:

R: [1,3,7,12,18,26,35,45,56,69]
S: [2,4,5,6,8,9,10,11,13,14]
test 1000: True

Icon and Unicon

<lang Icon>link printf,ximage

procedure main()

  printf("Hofstader ff sequences R(n:= 1 to %d)\n",N := 10)
  every printf("R(%d)=%d\n",n := 1 to N,ffr(n))
  L := list(N := 1000,0)
  zero := dup := oob := 0
  every n := 1 to (RN := 40) do 
     if not L[ffr(n)] +:= 1 then    # count R occurrence
        oob +:= 1                   # count out of bounds
  every n := 1 to (N-RN) do 
     if not L[ffs(n)] +:= 1 then    # count S occurrence 
        oob +:= 1                   # count out of bounds  
  
  every zero +:= (!L = 0)           # count zeros / misses
  every dup  +:= (!L > 1)           # count > 1's / duplicates
     
  printf("Results of R(1 to %d) and S(1 to %d) coverage is ",RN,(N-RN))
  if oob+zero+dup=0 then 
     printf("complete.\n")
  else 
     printf("flawed\noob=%i,zero=%i,dup=%i\nL:\n%s\nR:\n%s\nS:\n%s\n",
            oob,zero,dup,ximage(L),ximage(ffr(ffr)),ximage(ffs(ffs)))

end

procedure ffr(n) static R,S initial {

  R := [1]
  S := ffs(ffs)               # get access to S in ffs
  }
  
  if n === ffr then return R  # secret handshake to avoid globals :)
  
  if integer(n) > 0 then 
     return R[n] | put(R,ffr(n-1) + ffs(n-1))[n]

end

procedure ffs(n) static R,S initial {

  S := [2] 
  R := ffr(ffr)               # get access to R in ffr
  }
  
  if n === ffs then return S  # secret handshake to avoid globals :)
  
  if integer(n) > 0 then {
     if S[n] then return S[n]
     else {
        t := S[*S]  
        until *S = n do 
           if (t +:= 1) = !R then next # could be optimized with more code
           else return put(S,t)[*S]    # extend S
        }
  }

end</lang>

printf.icn provides formatting ximage.icn allows formatting entire structures

Output:

Hofstader ff sequences R(n:= 1 to 10)
R(1)=1
R(2)=3
R(3)=7
R(4)=12
R(5)=18
R(6)=26
R(7)=35
R(8)=45
R(9)=56
R(10)=69
Results of R(1 to 40) and S(1 to 960) coverage is complete.

J

<lang j>R=: 1 1 3 S=: 0 2 4 FF=: 3 :0

 while. +./y>:R,&#S do.
   R=: R,({:R)+(<:#R){S
   S=: (i.<:+/_2{.R)-.R
 end.
 R;S

) ffr=: { 0 {:: FF@(>./@,) ffs=: { 1 {:: FF@(0,>./@,)</lang>

Required examples:

<lang j> ffr 1+i.10 1 3 7 12 18 26 35 45 56 69

  (1+i.1000) -: /:~ (ffr 1+i.40), ffs 1+i.960

1</lang>

Java

Code:

<lang java>import java.util.*;

class Hofstadter {

 private static List<Integer> getSequence(int rlistSize, int slistSize)
 {
   List<Integer> rlist = new ArrayList<Integer>();
   List<Integer> slist = new ArrayList<Integer>();
   Collections.addAll(rlist, 1, 3, 7);
   Collections.addAll(slist, 2, 4, 5, 6);
   List<Integer> list = (rlistSize > 0) ? rlist : slist;
   int targetSize = (rlistSize > 0) ? rlistSize : slistSize;
   while (list.size() > targetSize)
     list.remove(list.size() - 1);
   while (list.size() < targetSize)
   {
     int lastIndex = rlist.size() - 1;
     int lastr = rlist.get(lastIndex).intValue();
     int r = lastr + slist.get(lastIndex).intValue();
     rlist.add(Integer.valueOf(r));
     for (int s = lastr + 1; (s < r) && (list.size() < targetSize); s++)
       slist.add(Integer.valueOf(s));
   }
   return list;
 }
 
 public static int ffr(int n)
 {  return getSequence(n, 0).get(n - 1).intValue();  }
 
 public static int ffs(int n)
 {  return getSequence(0, n).get(n - 1).intValue();  }
 
 public static void main(String[] args)
 {
   System.out.print("R():");
   for (int n = 1; n <= 10; n++)
     System.out.print(" " + ffr(n));
   System.out.println();
   
   Set<Integer> first40R = new HashSet<Integer>();
   for (int n = 1; n <= 40; n++)
     first40R.add(Integer.valueOf(ffr(n)));
     
   Set<Integer> first960S = new HashSet<Integer>();
   for (int n = 1; n <= 960; n++)
     first960S.add(Integer.valueOf(ffs(n)));
   
   for (int i = 1; i <= 1000; i++)
   {
     Integer n = Integer.valueOf(i);
     if (first40R.contains(n) == first960S.contains(n))
       System.out.println("Integer " + i + " either in both or neither set");
   }
   System.out.println("Done");
 }

}</lang>

Output:

R(): 1 3 7 12 18 26 35 45 56 69
Done

JavaScript

Translated from Ruby. <lang JavaScript>var R = [null, 1]; var S = [null, 2];

var extend_sequences = function (n) { var current = Math.max(R[R.length-1],S[S.length-1]); var i; while (R.length <= n || S.length <= n) { i = Math.min(R.length, S.length) - 1; current += 1; if (current === R[i] + S[i]) { R.push(current); } else { S.push(current); } } }

var ffr = function(n) { extend_sequences(n); return R[n]; };

var ffs = function(n) { extend_sequences(n); return S[n]; };

for (var i = 1; i <=10; i += 1) {

  console.log('R('+ i +') = ' + ffr(i));

}

var int_array = [];

for (var i = 1; i <= 40; i += 1) { int_array.push(ffr(i)); } for (var i = 1; i <= 960; i += 1) { int_array.push(ffs(i)); }

int_array.sort(function(a,b){return a-b;});

for (var i = 1; i <= 1000; i += 1) { if (int_array[i-1] !== i) { throw "Something's wrong!" } else { console.log("1000 integer check ok."); } }</lang> Output:

R(1) = 1
R(2) = 3
R(3) = 7
R(4) = 12
R(5) = 18
R(6) = 26
R(7) = 35
R(8) = 45
R(9) = 56
R(10) = 69
1000 integer check ok.


Mathematica

1. Create two functions named ffr and ffs that when given n return R(n) or S(n) respectively.

   The instructions call for two functions.
   Because S[n] is generated while computing R[n], one would normally avoid redundancy by combining R and S into a single function that
   returns both sequences.

2. No maximum value for n should be assumed.

<lang Mathematica>

ffr[j_] := Module[{R = {1}, S = 2, k = 1},
   Do[While[Position[R, S] != {}, S++]; k = k + S; S++;
   R = Append[R, k], {n, 1, j - 1}]; R]
ffs[j_] := Differences[ffr[j + 1]]

</lang>

3. Calculate and show that the first ten values of R are: 1, 3, 7, 12, 18, 26, 35, 45, 56, and 69

<lang Mathematica>

ffr[10]
(* out *)
{1, 3, 7, 12, 18, 26, 35, 45, 56, 69}

</lang>

4. Calculate and show that the first 40 values of ffr plus the first 960 values of ffs include all the integers from 1 to 1000 exactly once.

<lang Mathematica>

t = Sort[Join[ffr[40], ffs[960]]];
t == Range[1000]
(* out *)
True

</lang>

MATLAB / Octave

1. Create two functions named ffr and ffs that when given n return R(n) or S(n) respectively. 2. No maximum value for n should be assumed.

<lang MATLAB> function [R,S] = ffr_ffs(N)

   t = [1,0]; 
   T = 1;
   n = 1; 
   %while T<=1000,
   while n<=N,
       R = find(t,n);
       S = find(~t,n);
       T = R(n)+S(n);
       % pre-allocate memory, this improves performance

if T > length(t), t = [t,zeros(size(t))]; end;

       t(T) = 1; 
       n = n + 1;
   end; 
   if nargout>0, 
     r = max(R); 
     s = max(S);
   else 
     printf('Sequence R:\n'); disp(R);
     printf('Sequence S:\n'); disp(S);
   end; 
 end; </lang>

3. Calculate and show that the first ten values of R are: 1, 3, 7, 12, 18, 26, 35, 45, 56, and 69

>>ffr_ffs(10)
Sequence R:
    1    3    7   12   18   26   35   45   56   69
Sequence S:
    2    4    5    6    8    9   10   11   13   14

4. This is self-evident from the function definition, but also because R and S are complementary in t and ~t. However, one can also Calculate and show that the first 40 values of ffr plus the first 960 values of ffs include all the integers from 1 to 1000 exactly once. Modify the function above in such a way that, instead of r and s, R and S are returned, and run

  [R1,S1] = ffr_ffs(40);	
  [R2,S2] = ffr_ffs(960);	
  all(sort([R1,S2])==1:1000) 
ans =  1

PicoLisp

<lang PicoLisp>(setq *RNext 2)

(de ffr (N)

  (cache '(NIL) (pack (char (hash N)) N)
     (if (= 1 N)
        1
        (+ (ffr (dec N)) (ffs (dec N))) ) ) )

(de ffs (N)

  (cache '(NIL) (pack (char (hash N)) N)
     (if (= 1 N)
        2
        (let S (inc (ffs (dec N)))
           (when (= S (ffr *RNext))
              (inc 'S)
              (inc '*RNext) )
           S ) ) ) )</lang>

Test: <lang PicoLisp>: (mapcar ffr (range 1 10)) -> (1 3 7 12 18 26 35 45 56 69)

(=
  (range 1 1000)
  (sort (conc (mapcar ffr (range 1 40)) (mapcar ffs (range 1 960)))) )

-> T</lang>

Perl 6

<lang perl6>my @ffr; my @ffs;

@ffr.plan: 0, 1, gather take @ffr[$_] + @ffs[$_] for 1..*; @ffs.plan: 0, 2, 4..6, gather take @ffr[$_] ^..^ @ffr[$_+1] for 3..*;

say @ffr[1..10];

say "Rawks!" if (1...1000) eqv sort @ffr[1..40], @ffs[1..960];</lang> Output:

1 3 7 12 18 26 35 45 56 69
Rawks!

PL/I

<lang PL/I>ffr: procedure (n) returns (fixed binary(31));

  declare n fixed binary (31);
  declare v(2*n+1) bit(1);
  declare (i, j) fixed binary (31);
  declare (r, s) fixed binary (31);
  v = '0'b;
  v(1) = '1'b;
  if n = 1 then return (1);
  r = 1;
  do i = 2 to n;
     do j = 2 to 2*n;
        if v(j) = '0'b then leave;
     end;
     v(j) = '1'b;
     s = j;
     r = r + s;
     if r <= 2*n then v(r) = '1'b;
  end;
  return (r);

end ffr;</lang> Output:

Please type a value for n: 
    1    3    7   12   18   26   35   45   56   69   83   98  114  131  150
  170  191  213  236  260  285  312  340  369  399  430  462  495  529  565
  602  640  679  719  760  802  845  889  935  982

<lang>ffs: procedure (n) returns (fixed binary (31));

  declare n fixed binary (31);
  declare v(2*n+1) bit(1);
  declare (i, j) fixed binary (31);
  declare (r, s) fixed binary (31);
  v = '0'b;
  v(1) = '1'b;
  if n = 1 then return (2);
  r = 1;
  do i = 1 to n;
     do j = 2 to 2*n;
        if v(j) = '0'b then leave;
     end;
     v(j) = '1'b;
     s = j;
     r = r + s;
     if r <= 2*n then v(r) = '1'b;
  end;
  return (s);

end ffs;</lang> Output of first 960 values:

Please type a value for n: 
    2    4    5    6    8    9   10   11   13   14   15   16   17   19   20
   21   22   23   24   25   27   28   29   30   31   32   33   34   36   37
  ...
  986  987  988  989  990  991  992  993  994  995  996  997  998  999 1000

Verification using the above procedures: <lang>

  put skip list ('Verification that the first 40 FFR numbers and the first');
  put skip list ('960 FFS numbers result in the integers 1 to 1000 only.');
  do i = 1 to 40;
     j = ffr(i);
     if t(j) then put skip list ('error, duplicate value at ' || i);
     else t(j) = '1'b;
  end;
  do i = 1 to 960;
     j = ffs(i);
     if t(j) then put skip list ('error, duplicate value at ' || i);
     else t(j) = '1'b;
  end;
  if all(t = '1'b) then put skip list ('passed test');

</lang> Output:

Verification that the first 40 FFR numbers and the first 
960 FFS numbers result in the integers 1 to 1000 only. 
passed test 

Prolog

Constraint Handling Rules

CHR is a programming language created by Professor Thom Frühwirth.
Works with SWI-Prolog and module chr written by Tom Schrijvers and Jan Wielemaker <lang Prolog>:- use_module(library(chr)).

- chr_constraint ffr/2, ffs/2, hofstadter/1,hofstadter/2.
- chr_option(debug, off).
- chr_option(optimize, full).

% to remove duplicates ffr(N, R1) \ ffr(N, R2) <=> R1 = R2 | true. ffs(N, R1) \ ffs(N, R2) <=> R1 = R2 | true.

% compute ffr ffr(N, R), ffr(N1, R1), ffs(N1,S1) ==>

        N > 1, N1 is N - 1 |

R is R1 + S1.

% compute ffs ffs(N, S), ffs(N1,S1) ==>

        N > 1, N1 is N - 1 |

V is S1 + 1, ( find_chr_constraint(ffr(_, V)) -> S is V+1; S = V).

% init hofstadter(N) ==> ffr(1,1), ffs(1,2). % loop hofstadter(N), ffr(N1, _R), ffs(N1, _S) ==> N1 < N, N2 is N1 +1 | ffr(N2,_), ffs(N2,_).

</lang> Output for first task :

 ?- hofstadter(10), bagof(ffr(X,Y), find_chr_constraint(ffr(X,Y)), L).
ffr(10,69)
ffr(9,56)
ffr(8,45)
ffr(7,35)
ffr(6,26)
ffr(5,18)
ffr(4,12)
ffr(3,7)
ffr(2,3)
ffr(1,1)
ffs(10,14)
ffs(9,13)
ffs(8,11)
ffs(7,10)
ffs(6,9)
ffs(5,8)
ffs(4,6)
ffs(3,5)
ffs(2,4)
ffs(1,2)
hofstadter(10)
L = [ffr(10,69),ffr(9,56),ffr(8,45),ffr(7,35),ffr(6,26),ffr(5,18),ffr(4,12),ffr(3,7),ffr(2,3),ffr(1,1)].

Code for the second task <lang Prolog>hofstadter :- hofstadter(960), % fetch the values of ffr bagof(Y, X^find_chr_constraint(ffs(X,Y)), L1), % fetch the values of ffs bagof(Y, X^(find_chr_constraint(ffr(X,Y)), X < 41), L2), % concatenate then append(L1, L2, L3), % sort removing duplicates sort(L3, L4), % check the correctness of the list ( (L4 = [1|_], last(L4, 1000), length(L4, 1000)) -> writeln(ok); writeln(ko)), % to remove all pending constraints fail. </lang> Output for second task

 ?- hofstadter.
ok
false.

Python

<lang python>def ffr(n):

   if n < 1 or type(n) != int: raise ValueError("n must be an int >= 1")
   try:
       return ffr.r[n]
   except IndexError:
       r, s = ffr.r, ffs.s
       ffr_n_1 = ffr(n-1)
       lastr = r[-1]
       # extend s up to, and one past, last r 
       s += list(range(s[-1] + 1, lastr))
       if s[-1] < lastr: s += [lastr + 1]
       # access s[n-1] temporarily extending s if necessary
       len_s = len(s)
       ffs_n_1 = s[n-1] if len_s > n else (n - len_s) + s[-1]
       ans = ffr_n_1 + ffs_n_1
       r.append(ans)
       return ans

ffr.r = [None, 1]

def ffs(n):

   if n < 1 or type(n) != int: raise ValueError("n must be an int >= 1")
   try:
       return ffs.s[n]
   except IndexError:
       r, s = ffr.r, ffs.s
       for i in range(len(r), n+2):
           ffr(i)
           if len(s) > n:
               return s[n]
       raise Exception("Whoops!")

ffs.s = [None, 2]

if __name__ == '__main__':

   first10 = [ffr(i) for i in range(1,11)]
   assert first10 == [1, 3, 7, 12, 18, 26, 35, 45, 56, 69], "ffr() value error(s)"
   print("ffr(n) for n = [1..10] is", first10)
   #
   bin = [None] + [0]*1000
   for i in range(40, 0, -1):
       bin[ffr(i)] += 1
   for i in range(960, 0, -1):
       bin[ffs(i)] += 1
   if all(b == 1 for b in bin[1:1000]):
       print("All Integers 1..1000 found OK")
   else:
       print("All Integers 1..1000 NOT found only once: ERROR")</lang>
Output
ffr(n) for n = [1..10] is [1, 3, 7, 12, 18, 26, 35, 45, 56, 69]
All Integers 1..1000 found OK

Alternative

<lang python>cR = [1] cS = [2]

def extend_RS(): x = cR[len(cR) - 1] + cS[len(cR) - 1] cR.append(x) cS += range(cS[-1] + 1, x) cS.append(x + 1)

def ff_R(n): assert(n > 0) while n > len(cR): extend_RS() return cR[n - 1]

def ff_S(n): assert(n > 0) while n > len(cS): extend_RS() return cS[n - 1]

  1. tests

print([ ff_R(i) for i in range(1, 11) ])

s = {} for i in range(1, 1001): s[i] = 0 for i in range(1, 41): del s[ff_R(i)] for i in range(1, 961): del s[ff_S(i)]

  1. the fact that we got here without a key error

print("Ok")</lang>output<lang>[1, 3, 7, 12, 18, 26, 35, 45, 56, 69] Ok</lang>


Using cyclic iterators

Translation of: Haskell

Defining R and S as mutually recursive generators. Follows directly from the definition of the R and S sequences. <lang python>from itertools import islice

def R(): n = 1 yield n for s in S(): n += s yield n;

def S(): yield 2 yield 4 u = 5 for r in R(): if r <= u: continue; for x in range(u, r): yield x u = r + 1

def lst(s, n): return list(islice(s(), n))

print "R:", lst(R, 10) print "S:", lst(S, 10) print sorted(lst(R, 40) + lst(S, 960)) == list(range(1,1001))

  1. perf test case
  2. print sum(lst(R, 10000000))</lang>
Output:
R: [1, 3, 7, 12, 18, 26, 35, 45, 56, 69]
S: [2, 4, 5, 6, 8, 9, 10, 11, 13, 14]
True

REXX

This REXX example makes use of sparse arrays.
Almost half of the code was for verification of the first thousand numbers in the Figure-Figure sequences. <lang rexx>/*REXX pgm to calculate & verify the Hofstadter Figure-Figure sequences.*/ parse arg x highV . /*obtain any C.L. specifications.*/ if x== then x=10; if highV== then highV=1000 /*use the defaults?*/ low=1 /*use unity as the starting point*/ if x<0 then low=abs(x) /*only show a single │X│ value.*/ r.=0; r.1=1; rr.=r.; rr.1=1 /*initialize the R and RR arrays.*/ s.=0; s.1=2; ss.=s.; ss.2=1 /* "  ? S " SS " .*/ errs=0

                 do i=low  to abs(x)  /*show first X values of  R & S  */
                 say right('R('i") =",20) right(ffr(i),7),  /*show nice*/
                     right('S('i") =",20) right(ffs(i),7)   /*  R & S  */
                 end   /*i*/

if x<1 then exit /*stick a fork in it, we're done.*/ /*═══════════════════════════════════════verify 1st 1k: unique & present*/ both.=0 /*initialize the BOTH array. */

                                      /*build list of 1st  40 R values.*/
 do m=1 for  40;     r=ffr(m)         /*calculate 1st   40  R   values.*/
 both.r=1                             /*build the  BOTH  array.        */
 end   /*m*/
    do n=1 for  960;    s=ffs(n)      /*calculate 1st  960  S   values.*/
    if both.s  then call sayErr 'duplicate number in R and S lists:' s
    both.s=1                          /*add to the  BOTH  array.       */
    end   /*n*/
                                      /*verify presence and uniqueness.*/
       do v=1  for highV              /*verify all  1 ≤ # ≤ 1k present.*/
       if \both.v  then call sayErr 'missing R │ S:'  v
       end   /*v*/

say @v='verification'; @i=" [inclusive]." /*shortcuts to shorten prog width*/ if errs==0 then say @v 'completed for all numbers from 1 ──►' highV @i

           else say @v 'failed with' errs "errors."

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────FFR subroutine──────────────────────*/ ffr: procedure expose r. s. rr. ss.; parse arg n if r.n\==0 then return r.n /*Defined? Then return the value.*/ _=ffr(n-1)+ffs(n-1) /*calculate the FFR value. */ r.n=_; rr._=1 /*assign the value to R and RR.*/ return _ /*return the value to the invoker*/ /*──────────────────────────────────FFS subroutine──────────────────────*/ ffs: procedure expose r. s. rr. ss.; parse arg n

          do k=1  for n  while s.n==0 /*search for not null  R │ S num.*/
          if s.k\==0 & ffr(k)\==0  then iterate
          km=k-1;    _=s.km+1         /*the next  SS  number, possibly.*/
          _=_+rr._                    /*maybe adjust for the  FRR  num.*/
          s.k=_;     ss._=1           /*define couple of  FFS  numbers.*/
          end    /*k*/

return s.n /*return the value to the invoker*/ /*──────────────────────────────────SAYERR subroutine───────────────────*/ sayErr: errs=errs+1; say; say '***error***!'; say; say arg(1); say; return</lang> output when using the defaults

              R(1) =       1               S(1) =       2
              R(2) =       3               S(2) =       4
              R(3) =       7               S(3) =       5
              R(4) =      12               S(4) =       6
              R(5) =      18               S(5) =       8
              R(6) =      26               S(6) =       9
              R(7) =      35               S(7) =      10
              R(8) =      45               S(8) =      11
              R(9) =      56               S(9) =      13
             R(10) =      69              S(10) =      14

verification completed for all numbers from  1 ──► 1000   [inclusive].

Ruby

Translation of: Tcl

<lang ruby>$r = [nil, 1] $s = [nil, 2]

def buildSeq(n)

 current = [ $r[-1], $s[-1] ].max
 while $r.length <= n || $s.length <= n
   idx = [ $r.length, $s.length ].min - 1
   current += 1
   if current == $r[idx] + $s[idx]
     $r << current
   else
     $s << current
   end
 end

end

def ffr(n)

 buildSeq(n)
 $r[n]

end

def ffs(n)

 buildSeq(n)
 $s[n]

end

require 'set' require 'test/unit'

class TestHofstadterFigureFigure < Test::Unit::TestCase

 def test_first_ten_R_values
   r10 = 1.upto(10).map {|n| ffr(n)}
   assert_equal(r10, [1, 3, 7, 12, 18, 26, 35, 45, 56, 69])
 end
 def test_40_R_and_960_S_are_1_to_1000
   rs_values = Set.new
   rs_values.merge( 1.upto(40).collect  {|n| ffr(n)} )
   rs_values.merge( 1.upto(960).collect {|n| ffs(n)} )
   assert_equal(rs_values, Set.new( 1..1000 ))
 end

end</lang>

outputs

Loaded suite hofstadter.figurefigure
Started
..
Finished in 0.511000 seconds.

2 tests, 2 assertions, 0 failures, 0 errors, 0 skips

Scala

Translation of: Go

<lang Scala>object HofstadterFigFigSeq extends App {

 import scala.collection.mutable.ListBuffer
 val r = ListBuffer(0, 1)
 val s = ListBuffer(0, 2)
 def ffr(n: Int): Int = {
   val ffri: Int => Unit = i => {
     val nrk = r.size - 1
     val rNext = r(nrk)+s(nrk)
     r += rNext
     (r(nrk)+2 to rNext-1).foreach{s += _}
     s += rNext+1
   }
   (r.size to n).foreach(ffri(_))
   r(n)
 }
 def ffs(n:Int): Int = {
   while (s.size <= n) ffr(r.size)
   s(n)
 }
 (1 to 10).map(i=>(i,ffr(i))).foreach(t=>println("r("+t._1+"): "+t._2))
 println((1 to 1000).toList.filterNot(((1 to 40).map(ffr(_))++(1 to 960).map(ffs(_))).contains)==List())

}</lang> Output:

r(1): 1
r(2): 3
r(3): 7
r(4): 12
r(5): 18
r(6): 26
r(7): 35
r(8): 45
r(9): 56
r(10): 69
true

Tcl

Library: Tcllib (Package: struct::set)

<lang tcl>package require Tcl 8.5 package require struct::set

  1. Core sequence generator engine; stores in $R and $S globals

set R {R:-> 1} set S {S:-> 2} proc buildSeq {n} {

   global R S
   set ctr [expr {max([lindex $R end],[lindex $S end])}]
   while {[llength $R] <= $n || [llength $S] <= $n} {

set idx [expr {min([llength $R],[llength $S]) - 1}] if {[incr ctr] == [lindex $R $idx]+[lindex $S $idx]} { lappend R $ctr } else { lappend S $ctr }

   }

}

  1. Accessor procedures

proc ffr {n} {

   buildSeq $n
   lindex $::R $n

} proc ffs {n} {

   buildSeq $n
   lindex $::S $n

}

  1. Show some things about the sequence

for {set i 1} {$i <= 10} {incr i} {

   puts "R($i) = [ffr $i]"

} puts "Considering {1..1000} vs {R(i)|i\u2208\[1,40\]}\u222a{S(i)|i\u2208\[1,960\]}" for {set i 1} {$i <= 1000} {incr i} {lappend numsInSeq $i} for {set i 1} {$i <= 40} {incr i} {

   lappend numsRS [ffr $i]

} for {set i 1} {$i <= 960} {incr i} {

   lappend numsRS [ffs $i]

} puts "set sizes: [struct::set size $numsInSeq] vs [struct::set size $numsRS]" puts "set equality: [expr {[struct::set equal $numsInSeq $numsRS]?{yes}:{no}}]"</lang> Output:

R(1) = 1
R(2) = 3
R(3) = 7
R(4) = 12
R(5) = 18
R(6) = 26
R(7) = 35
R(8) = 45
R(9) = 56
R(10) = 69
Considering {1..1000} vs {R(i)|i∈[1,40]}∪{S(i)|i∈[1,960]}
set sizes: 1000 vs 1000
set equality: yes