Hofstadter Figure-Figure sequences: Difference between revisions

From Rosetta Code
Content added Content deleted
(J)
(Added Haskell version)
Line 56: Line 56:
(princ "Ok")</lang>output<lang>First of R: (1 3 7 12 18 26 35 45 56 69)
(princ "Ok")</lang>output<lang>First of R: (1 3 7 12 18 26 35 45 56 69)
Ok</lang>
Ok</lang>

=={{header|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:
<pre>[1,3,7,12,18,26,35,45,56,69]
True</pre>


=={{header|J}}==
=={{header|J}}==

Revision as of 10:18, 24 October 2011

Hofstadter Figure-Figure sequences is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

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

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>

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

J

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

 assert. y>:0
 while.y>:#R do.
   R=: R,({:R)+(<:#R){S
   S=: (1+i.+:#R)-.R
 end.
 (y{R),y{S

) ffr=: {.@FF@<: ffs=: {:@FF@<:</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>

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

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