Hofstadter Figure-Figure sequences: Difference between revisions

Content added Content deleted

Inline

Revision as of 17:01, 2 November 2011

These two sequences of positive integers are defined as:

{\begin{aligned}R(1)&=1\ ;\ S(1)=2\\R(n)&=R(n-1)+S(n-1),\quad n>1.\end{aligned}}

The sequence

S(n)

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

R(n)

.

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.

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

Translation of: Python

<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

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>

Library: Icon Programming Library

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.

This example does not show the output mentioned in the task description on this page (or a page linked to from here). Please ensure that it meets all task requirements and remove this message.
Note that phrases in task descriptions such as "print and display" and "print and show" for example, indicate that (reasonable length) output be a part of a language's solution.

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

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).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

Library: Tcllib (Package: struct::set)

<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

@@ Line 260: / Line 260: @@
 =={{header|Perl6}}==
+{{output?|Perl6}}
 This purely recursive version is too slow, so it does not the last part of the task.
 <lang perl6>