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:
- 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). - No maximum value for n should be assumed.
- Calculate and show that the first ten values of R are: 1, 3, 7, 12, 18, 26, 35, 45, 56, and 69
- 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
- Sloane's A005228 and A030124.
- Wolfram Mathworld
- Wikipedia: Hofstadter Figure-Figure sequences.
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>
- 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
<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
(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.
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]
- 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)]
- 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
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))
- perf test case
- 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
<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
<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
<lang tcl>package require Tcl 8.5 package require struct::set
- 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 }
}
}
- Accessor procedures
proc ffr {n} {
buildSeq $n lindex $::R $n
} proc ffs {n} {
buildSeq $n lindex $::S $n
}
- 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