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>
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>
D
<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> Output:
[1, 3, 7, 12, 18, 26, 35, 45, 56, 69] true
Go
<lang go>package main
import "fmt"
var ffr, ffs func(int) int
// task 1, 2 func init() {
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
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
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>
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>
Perl6
This purely recursive version is too slow, so it does not the last part of the task.
<lang perl6>
sub ffr(Int $n where { $n > 0 }) { $n == 1 ?? 1 !! ffr($n-1) + ffs($n-1) }
sub ffs(Int $n where { $n > 0 }) { $n == 1 ?? 2 !! (grep none( map &ffr, 1..$n ), 1..* )[$n-1] }
say map &ffr, 1..10
</lang>
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(): global cR, cS 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>
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).inject([]) {|seq, n| seq << ffr(n)} )
rs_values.merge( 1.upto(960).inject([]) {|seq, n| seq << 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
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