Hofstadter Q sequence: Difference between revisions
m →{{header|REXX}}: removed the "style" from the PRE html tag. |
→{{header|jq}}: omit parenthetical remark |
||
Line 973:
requirement regarding "recursion limits", and secondly to
demonstrate one way to handle a cache in a functional language.
For simplicity, we also define Q(0) = 1, so that the defining
|
Revision as of 06:30, 28 July 2014
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
The Hofstadter Q sequence is defined as:
It is defined like the Fibonacci sequence, but whereas the next term in the Fibonacci sequence is the sum of the previous two terms, in the Q sequence the previous two terms tell you how far to go back in the Q sequence to find the two numbers to sum to make the next term of the sequence.
- Task
- Confirm and display that the first ten terms of the sequence are: 1, 1, 2, 3, 3, 4, 5, 5, 6, and 6
- Confirm and display that the 1000th term is: 502
- Optional extra credit
- Count and display how many times a member of the sequence is less than its preceding term for terms up to and including the 100,000'th term.
- Ensure that the extra credit solution 'safely' handles being initially asked for an n'th term where n is large.
(This point is to ensure that caching and/or recursion limits, if it is a concern, is correctly handled).
Ada
<lang Ada>with Ada.Text_IO;
procedure Hofstadter_Q_Sequence is
type Callback is access procedure(N: Positive);
procedure Q(First, Last: Positive; Q_Proc: Callback) is -- calls Q_Proc(Q(First)); Q_Proc(Q(First+1)); ... Q_Proc(Q(Last)); -- precondition: Last > 2
Q_Store: array(1 .. Last) of Natural := (1 => 1, 2 => 1, others => 0); -- "global" array to store the Q(I) -- if Q_Store(I)=0, we compute Q(I) and update Q_Store(I) -- else we already know Q(I) = Q_Store(I)
function Q(N: Positive) return Positive is begin if Q_Store(N) = 0 then Q_Store(N) := Q(N - Q(N-1)) + Q(N-Q(N-2)); end if; return Q_Store(N); end Q;
begin for I in First .. Last loop Q_Proc(Q(I)); end loop; end Q;
procedure Print(P: Positive) is begin Ada.Text_IO.Put(Positive'Image(P)); end Print;
Decrease_Counter: Natural := 0; Previous_Value: Positive := 1;
procedure Decrease_Count(P: Positive) is begin if P < Previous_Value then Decrease_Counter := Decrease_Counter + 1; end if; Previous_Value := P; end Decrease_Count;
begin
Q(1, 10, Print'Access); -- the first ten terms of the sequence are: 1, 1, 2, 3, 3, 4, 5, 5, 6, and 6 Ada.Text_IO.New_Line;
Q(1000, 1000, Print'Access); -- the 1000'th term is: 502 Ada.Text_IO.New_Line;
Q(2, 100_000, Decrease_Count'Access); Ada.Text_IO.Put_Line(Integer'Image(Decrease_Counter)); -- how many times a member of the sequence is less than its preceding term -- for terms up to and including the 100,000'th term
end Hofstadter_Q_Sequence;</lang>
Output:
1 1 2 3 3 4 5 5 6 6 502 49798
ALGOL 68
Note: This specimen retains the original C coding style.
File: Hofstadter_Q_sequence.a68<lang algol68>#!/usr/local/bin/a68g --script #
INT n = 100000; main: (
INT flip; [n]INT q;
q[1] := q[2] := 1;
FOR i FROM 3 TO n DO q[i] := q[i - q[i - 1]] + q[i - q[i - 2]] OD;
FOR i TO 10 DO printf(($g(0)$, q[i], $b(l,x)$, i = 10)) OD;
printf(($g(0)l$, q[1000]));
flip := 0; FOR i TO n-1 DO flip +:= ABS (q[i] > q[i + 1]) OD;
printf(($"flips: "g(0)l$, flip))
)</lang>Output:
1 1 2 3 3 4 5 5 6 6 502 flips: 49798
AutoHotkey
<lang AutoHotkey>SetBatchLines, -1 Q := HofsQSeq(100000)
Loop, 10 Out .= Q[A_Index] ", "
MsgBox, % "First ten:`t" Out "`n" . "1000th:`t`t" Q[1000] "`n" . "Flips:`t`t" Q.flips
HofsQSeq(n) { Q := {1: 1, 2: 1, "flips": 0} Loop, % n - 2 { i := A_Index + 2 , Q[i] := Q[i - Q[i - 1]] + Q[i - Q[A_Index]] if (Q[i] < Q[i - 1]) Q.flips++ } return Q }</lang> Output:
First ten: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6, 1000th: 502 Flips: 49798
AWK
<lang awk>#!/usr/bin/awk -f BEGIN {
N = 100000 print "Q-sequence(1..10) : " Qsequence(10) Qsequence(N,Q) print "1000th number of Q sequence : " Q[1000] for (n=2; n<=N; n++) {
if (Q[n]<Q[n-1]) NN++
} print "number of Q(n)<Q(n+1) for n<=100000 : " NN
}
function Qsequence(N,Q) {
Q[1] = 1 Q[2] = 1 seq = "1 1" for (n=3; n<=N; n++) { Q[n] = Q[n-Q[n-1]]+Q[n-Q[n-2]] seq = seq" "Q[n] } return seq
} </lang>
Q-sequence(1..10) : 1 1 2 3 3 4 5 5 6 6 1000th number of Q sequence : 502 number of Q(n)<Q(n+1) for n<=100000 : 49798
BBC BASIC
<lang bbcbasic> PRINT "First 10 terms of Q = " ;
FOR i% = 1 TO 10 : PRINT ;FNq(i%, c%) " "; : NEXT : PRINT PRINT "1000th term = " ; FNq(1000, c%) PRINT "100000th term = " ; FNq(100000, c%) PRINT "Term is less than preceding term " ; c% " times" END DEF FNq(n%, RETURN c%) LOCAL i%,q%() IF n% < 3 THEN = 1 ELSE IF n% = 3 THEN = 2 DIM q%(n%) q%(1) = 1 : q%(2) = 1 : q%(3) = 2 c% = 0 FOR i% = 3 TO n% q%(i%) = q%(i% - q%(i%-1)) + q%(i% - q%(i%-2)) IF q%(i%) < q%(i%-1) THEN c% += 1 NEXT = q%(n%)</lang>
Output:
First 10 terms of Q = 1 1 2 3 3 4 5 5 6 6 1000th term = 502 100000th term = 48157 Term is less than preceding term 49798 times
C
<lang c>#include <stdio.h>
- include <stdlib.h>
- define N 100000
int main() { int i, flip, *q = (int*)malloc(sizeof(int) * N) - 1;
q[1] = q[2] = 1;
for (i = 3; i <= N; i++) q[i] = q[i - q[i - 1]] + q[i - q[i - 2]];
for (i = 1; i <= 10; i++) printf("%d%c", q[i], i == 10 ? '\n' : ' ');
printf("%d\n", q[1000]);
for (flip = 0, i = 1; i < N; i++) flip += q[i] > q[i + 1];
printf("flips: %d\n", flip); return 0; }</lang>Output:
1 1 2 3 3 4 5 5 6 6 502 flips: 49798
C++
solution modeled after Perl solution
<lang Cpp>#include <iostream>
int main( ) {
int hofstadters[100000] ; hofstadters[ 0 ] = 1 ; hofstadters[ 1 ] = 1 ; for ( int i = 3 ; i < 100000 ; i++ ) hofstadters[ i - 1 ] = hofstadters[ i - 1 - hofstadters[ i - 1 - 1 ]] +
hofstadters[ i - 1 - hofstadters[ i - 2 - 1 ]] ;
std::cout << "The first 10 numbers are:\n" ; for ( int i = 0 ; i < 10 ; i++ ) std::cout << hofstadters[ i ] << std::endl ; std::cout << "The 1000'th term is " << hofstadters[ 999 ] << " !" << std::endl ; int less_than_preceding = 0 ; for ( int i = 0 ; i < 99999 ; i++ ) { if ( hofstadters[ i + 1 ] < hofstadters[ i ] )
less_than_preceding++ ;
} std::cout << less_than_preceding << " times a number was preceded by a greater number!\n" ; return 0 ;
}</lang> Output:
The first 10 numbers are: 1 1 2 3 3 4 5 5 6 6 The 1000'th term is 502 ! 49798 times a number was preceded by a greater number!
C#
<lang C sharp>using System; using System.Collections.Generic;
namespace HofstadterQSequence {
class Program { // Initialize the dictionary with the first two indices filled. private static readonly Dictionary<int, int> QList = new Dictionary<int, int> { {1, 1}, {2, 1} };
private static void Main() { int lessThanLast = 0; /* Initialize our variable that holds the number of times * a member of the sequence was less than its preceding term. */
for (int n = 1; n <= 100000; n++) { int q = Q(n); // Get Q(n).
if (n > 1 && QList[n - 1] > q) // If Q(n) is less than Q(n - 1), lessThanLast++; // then add to the counter.
if (n > 10 && n != 1000) continue; /* If n is greater than 10 and not 1000, * the rest of the code in the loop does not apply, * and it will be skipped. */
if (!Confirm(n, q)) // Confirm Q(n) is correct. throw new Exception(string.Format("Invalid result: Q({0}) != {1}", n, q));
Console.WriteLine("Q({0}) = {1}", n, q); // Write Q(n) to the console. }
Console.WriteLine("Number of times a member of the sequence was less than its preceding term: {0}.", lessThanLast); }
private static bool Confirm(int n, int value) { if (n <= 10) return new[] {1, 1, 2, 3, 3, 4, 5, 5, 6, 6}[n - 1] == value; if (n == 1000) return 502 == value; throw new ArgumentException("Invalid index.", "n"); }
private static int Q(int n) { int q;
if (!QList.TryGetValue(n, out q)) // Try to get Q(n) from the dictionary. { q = Q(n - Q(n - 1)) + Q(n - Q(n - 2)); // If it's not available, then calculate it. QList.Add(n, q); // Add it to the dictionary. }
return q; } }
}</lang>
Output
Q(1) = 1 Q(2) = 1 Q(3) = 2 Q(4) = 3 Q(5) = 3 Q(6) = 4 Q(7) = 5 Q(8) = 5 Q(9) = 6 Q(10) = 6 Q(1000) = 502 Number of times a member of the sequence was less than its preceding term: 49798.
Clojure
The qs function, given the initial subsequence of Q of length n, produces the initial subsequence of length n+1. The subsequences are vectors for efficient indexing. qfirst iterates qs so the nth iteration is Q{1..n]. <lang clojure>(defn qs [q]
(let [n (count q)] (condp = n 0 [1] 1 [1 1] (conj q (+ (q (- n (q (- n 1)))) (q (- n (q (- n 2)))))))))
(defn qfirst [n] (-> (iterate qs []) (nth n)))
(println "first 10:" (qfirst 10)) (println "1000th:" (last (qfirst 1000))) (println "extra credit:" (->> (qfirst 100000) (partition 2 1) (filter #(apply > %)) count))</lang> Output: <lang>first 10: [1 1 2 3 3 4 5 5 6 6] 1000th: 502 extra credit: 49798</lang>
Common Lisp
<lang lisp>(defparameter *mm* (make-hash-table :test #'equal))
- generic memoization macro
(defmacro defun-memoize (f (&rest args) &body body)
(defmacro hash () `(gethash (cons ',f (list ,@args)) *mm*)) (let ((h (gensym))) `(defun ,f (,@args) (let ((,h (hash)))
(if ,h ,h (setf (hash) (progn ,@body)))))))
- def q
(defun-memoize q (n)
(if (<= n 2) 1 (+ (q (- n (q (- n 1)))) (q (- n (q (- n 2)))))))
- test
(format t "First of Q: ~a~%Q(1000): ~a~%Bumps up to 100000: ~a~%" (loop for i from 1 to 10 collect (q i)) (q 1000) (loop with c = 0 with last-q = (q 1) for i from 2 to 100000 do (let ((next-q (q i))) (if (< next-q last-q) (incf c)) (setf last-q next-q)) finally (return c)))</lang>output<lang>First of Q: (1 1 2 3 3 4 5 5 6 6) Q(1000): 502 Bumps up to 100000: 49798</lang>
Although the above definition of q
is more general, for this specific problem the following is faster:<lang lisp>(let ((cc (make-array 3 :element-type 'integer
:initial-element 1
:adjustable t
:fill-pointer 3)))
(defun q (n)
(when (>= n (length cc)) (loop for i from (length cc) below n do (q i)) (vector-push-extend (+ (aref cc (- n (aref cc (- n 1)))) (aref cc (- n (aref cc (- n 2))))) cc)) (aref cc n)))</lang>
D
<lang d>import std.stdio, std.algorithm, std.functional, std.range;
int Q(in int n) nothrow in {
assert(n > 0);
} body {
alias mQ = memoize!Q; if (n == 1 || n == 2) return 1; else return mQ(n - mQ(n - 1)) + mQ(n - mQ(n - 2));
}
void main() {
writeln("Q(n) for n = [1..10] is: ", iota(1, 11).map!Q); writeln("Q(1000) = ", Q(1000)); writefln("Q(i) is less than Q(i-1) for i [2..100_000] %d times.", iota(2, 100_001).count!(i => Q(i) < Q(i - 1)));
}</lang> Output:
Q(n) for n = [1..10] is: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] Q(1000) = 502 Q(i) is less than Q(i-1) for i [2..100_000] 49798 times.
Faster Version
Same output. <lang d>import std.stdio, std.algorithm, std.range, std.array;
struct Q {
__gshared static Appender!(uint[]) s;
nothrow static this() { s ~= [0, 1, 1]; }
static uint opCall(in int n) nothrow in { assert(n > 0); } body { foreach (immutable i; s.data.length .. n + 1) s ~= s.data[i - s.data[i - 1]] + s.data[i - s.data[i - 2]]; return s.data[n]; }
}
void main() {
writeln("Q(n) for n = [1..10] is: ", iota(1, 11).map!Q); writeln("Q(1000) = ", Q(1000)); writefln("Q(i) is less than Q(i-1) for i [2..100_000] %d times.", iota(2, 100_001).count!(i => Q(i) < Q(i - 1)));
}</lang>
Dart
Naive version using only recursion (Q(1000) fails due to browser script runtime restrictions) <lang dart>int Q(int n) => n>2 ? Q(n-Q(n-1))+Q(n-Q(n-2)) : 1;
main() {
for(int i=1;i<=10;i++) { print("Q($i)=${Q(i)}"); } print("Q(1000)=${Q(1000)}");
}</lang>
Version featuring caching. <lang dart>class Q {
Map<int,int> _table;
Q() { _table=new Map<int,int>(); _table[1]=1; _table[2]=1; }
int q(int n) { // if the cache is not filled until n-1, fill it starting with the lowest entries first // this avoids doing a recursion from n to 2 (e.g. if you call q(1000000) first) // this doesn't happen in the tasks calls since the cache is filled ascending if(_table[n-1]==null) { for(int i=_table.length;i<n;i++) {
q(i); }
} if(_table[n]==null) { _table[n]=q(n-q(n-1))+q(n-q(n-2)); }
return _table[n]; }
}
main() {
Q q=new Q();
for(int i=1;i<=10;i++) { print("Q($i)=${q.q(i)}"); } print("Q(1000)=${q.q(1000)}");
int count=0; for(int i=2;i<=100000;i++) { if(q.q(i)<q.q(i-1)) { count++; } } print("value is smaller than previous $count times");
}</lang> Output:
Q(1)=1 Q(2)=1 Q(3)=2 Q(4)=3 Q(5)=3 Q(6)=4 Q(7)=5 Q(8)=5 Q(9)=6 Q(10)=6 Q(1000)=502 value is smaller than previous 49798 times
If the maximum number is known, filling an array is probably the fastest solution. <lang dart>main() {
List<int> q=new List<int>(100001); q[1]=q[2]=1; int count=0; for(int i=3;i<q.length;i++) { q[i]=q[i-q[i-1]]+q[i-q[i-2]]; if(q[i]<q[i-1]) { count++; } } for(int i=1;i<=10;i++) { print("Q($i)=${q[i]}"); } print("Q(1000)=${q[1000]}"); print("value is smaller than previous $count times");
}</lang>
Erlang
<lang erlang>%% @author Jan Willem Luiten <jwl@secondmove.com> %% Hofstadter Q Sequence for Rosetta Code
-module(hofstadter). -export([main/0]). -define(MAX, 100000).
flip(V2, V1) when V1 > V2 -> 1; flip(_V2, _V1) -> 0.
list_terms(N, N, Acc) -> io:format("~w~n", [array:get(N, Acc)]); list_terms(Max, N, Acc) -> io:format("~w, ", [array:get(N, Acc)]), list_terms(Max, N+1, Acc).
hofstadter(N, N, Acc, Flips) -> io:format("The first ten terms are: "), list_terms(9, 0, Acc), io:format("The 1000'th term is ~w~n", [array:get(999, Acc)]), io:format("Number of flips: ~w~n", [Flips]); hofstadter(Max, N, Acc, Flips) -> Qn1 = array:get(N-1, Acc), Qn = array:get(N - Qn1, Acc) + array:get(N - array:get(N-2, Acc), Acc), hofstadter(Max, N+1, array:set(N, Qn, Acc), Flips + flip(Qn, Qn1)).
main() -> Tmp = array:set(0, 1, array:new(?MAX)), Acc = array:set(1, 1, Tmp), hofstadter(?MAX, 2, Acc, 0). </lang>Output:
The first ten terms are: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 The 1000'th term is 502 Number of flips: 49798
F#
<lang fsharp>let memoize f =
let cache = System.Collections.Generic.Dictionary<_,_>() fun x -> match cache.TryGetValue(x) with | (true, v) -> v | (_, _) -> let v = f x cache.[x] <- v v
let rec q = memoize (fun i ->
if i < 3I then 1I else q (i - q (i - 1I)) + q (i - q(i - 2I)))
printf "q(1 .. 10) ="; List.iter (q >> (printf " %A")) [1I .. 10I] printfn "" printfn "q(1000) = %A" (q 1000I) printfn "descents(100000) = %A" (Seq.sum (Seq.init 100000 (fun i -> if q(bigint(i)) > q(bigint(i+1)) then 1 else 0)))</lang> Output
q(1 .. 10) = 1 1 2 3 3 4 5 5 6 6 q(1000) = 502 descents(100000) = 49798
Factor
We define a method next that takes a sequence of the first n Q values and appends the next one to it. Then we perform it 1000 times on { 1 1 }
and show the first 10 and 999th (because the list is zero-indexed) elements.
<lang factor>( scratchpad ) : next ( seq -- newseq )
dup 2 tail* over length [ swap - ] curry map
[ dupd swap nth ] map 0 [ + ] reduce suffix ;
( scratchpad ) { 1 1 } 1000 [ next ] times dup 10 head . 999 swap nth . { 1 1 2 3 3 4 5 5 6 6 } 502</lang>
Go
Sure there are ways that run faster or handle larger numbers; for the task though, maps and recursion work just fine. <lang go>package main
import "fmt"
var m map[int]int
func initMap() {
m = make(map[int]int) m[1] = 1 m[2] = 1
}
func q(n int) (r int) {
if r = m[n]; r == 0 { r = q(n-q(n-1)) + q(n-q(n-2)) m[n] = r } return
}
func main() {
initMap() // task for n := 1; n <= 10; n++ { showQ(n) } // task showQ(1000) // extra credit count, p := 0, 1 for n := 2; n <= 1e5; n++ { qn := q(n) if qn < p { count++ } p = qn } fmt.Println("count:", count) // extra credit initMap() showQ(1e6)
}
func showQ(n int) {
fmt.Printf("Q(%d) = %d\n", n, q(n))
}</lang> Output:
Q(1) = 1 Q(2) = 1 Q(3) = 2 Q(4) = 3 Q(5) = 3 Q(6) = 4 Q(7) = 5 Q(8) = 5 Q(9) = 6 Q(10) = 6 Q(1000) = 502 count: 49798 Q(1000000) = 512066
Haskell
The basic task:
<lang Haskell>qSequence = tail qq where
qq = 0 : 1 : 1 : map g [3..] g n = qq !! (n - qq !! (n-1)) + qq !! (n - qq !! (n-2))
-- Output:
- Main> (take 10 qSequence, qSequence !! (1000-1))
([1,1,2,3,3,4,5,5,6,6],502) (0.00 secs, 525044 bytes)</lang>
Extra credit task:
<lang Haskell>import Data.Array
qSequence n = arr
where arr = listArray (1,n) $ 1:1: map g [3..n] g i = arr!(i - arr!(i-1)) + arr!(i - arr!(i-2))
gradualth m k arr -- gradually precalculate m-th item
| m <= v = pre `seq` arr!m -- in steps of k where -- to prevent STACK OVERFLOW pre = foldl1 (\a b-> a `seq` arr!b) [u,u+k..m] (u,v) = bounds arr
qSeqTest m n = let arr = qSequence $ max m n in
( take 10 . elems $ arr -- 10 first items , gradualth m 10000 $ arr -- m-th item , length . filter (> 0) -- reversals in n items . _S (zipWith (-)) tail . take n . elems $ arr )
_S f g x = f x (g x)</lang>
Output:
<lang Haskell>Prelude Main> qSeqTest 1000 100000 -- reversals in 100,000 ([1,1,2,3,3,4,5,5,6,6],502,49798) (0.09 secs, 18879708 bytes)
Prelude Main> qSeqTest 1000000 100000 -- 1,000,000-th item ([1,1,2,3,3,4,5,5,6,6],512066,49798) (2.80 secs, 87559640 bytes)</lang>
Using a list (more or less) seemlessly backed up by a double resizing array: <lang haskell>import Data.Array
q = qq (listArray (1,2) [1,1]) 1 where qq ar n = (arr!n) : qq arr (n+1) where l = snd (bounds ar) step n =arr!(n - (fromIntegral (arr!(n - 1)))) + arr!(n - (fromIntegral (arr!(n - 2)))) arr :: Array Int Integer arr | n <= l = ar | otherwise = listArray (1, l*2)$ ([ar!i | i <- [1..l]] ++ [step i | i <- [l+1..l*2]])
main = do putStr("first 10: "); print (take 10 q) putStr("1000-th: "); print (q !! 999) putStr("flips: ")
print $ length $ filter id $ take 100000 (zipWith (>) q (tail q))</lang>
- Output:
first 10: [1,1,2,3,3,4,5,5,6,6] 1000-th: 502 flips: 49798
List backed up by a list of arrays, with nominal constant lookup time. Somehow faster than the previous method. <lang haskell>import Data.Array import Data.Int (Int64)
q = qq [listArray (1,2) [1,1]] 1 where qq a n = seek aa n : qq aa (1 + n) where aa | n <= l = a | otherwise = listArray (l+1,l*2) (take l $ drop 2 lst):a where l = snd (bounds $ head a) lst = seek a (l-1):seek a l:(ext lst (l+1)) ext (q1:q2:qs) i = (g (i-q2) + g (i-q1)):ext (q2:qs) (1+i) g = seek aa seek (ar:ars) n | n >= fst (bounds ar) = ar ! n | otherwise = seek ars n
-- Only a perf test. Task can be done exactly the same as above main = print $ sum qqq where qqq :: [Int64] qqq = map fromIntegral $ take 3000000 q</lang>
Icon and Unicon
<lang Icon>link printf
procedure main()
V := [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] every i := 1 to *V do
if Q(i) ~= V[i] then stop("Assertion failure for position ",i)
printf("Q(1 to %d) - verified.\n",*V)
q := Q(n := 1000) v := 502 printf("Q[%d]=%d - %s.\n",n,v,if q = v then "verified" else "failed")
invcount := 0 every i := 2 to (n := 100000) do
if Q(i) < Q(i-1) then { printf("Q(%d)=%d < Q(%d)=%d\n",i,Q(i),i-1,Q(i-1)) invcount +:= 1 }
printf("There were %d inversions in Q up to %d\n",invcount,n) end
procedure Q(n) #: Hofstader Q sequence static S initial S := [1,1]
if q := S[n] then return q else {
q := Q(n - Q(n - 1)) + Q(n - Q(n - 2)) if *S = n - 1 then { put(S,q) return q } else runerr(500,n) }
end</lang>
printf.icn provides formatting
Output:
Q(1 to 10) - verified. Q[1000]=502 - verified. Q(16)=9 < Q(15)=10 Q(25)=14 < Q(24)=16 Q(32)=17 < Q(31)=20 Q(36)=19 < Q(35)=21 ... Q(99996)=48252 < Q(99995)=50276 Q(99999)=48456 < Q(99998)=50901 Q(100000)=48157 < Q(99999)=48456 There were 49798 inversions in Q up to 100000
J
Solution (bottom-up):<lang j> Qs=:0 1 1
Q=: verb define n=. >./,y while. n>:#Qs do. Qs=: Qs,+/(-_2{.Qs){Qs end. y{Qs
)</lang>
Solution (top-down):<lang j> Q=: 1:`(+&$:/@:- $:@-& 1 2)@.(>&2)"0 M.</lang>
Example:<lang j> Q 1+i.10 1 1 2 3 3 4 5 5 6 6
Q 1000
502
+/2>/\ Q 1+i.100000
49798</lang>
Note: The bottom-up solution uses iteration and doesn't risk failure due to recursion limits or cache overflows. The top-down solution uses recursion, and likely hews closer to the spirit of the task. While this latter uses memoization/caching, at some point it will still hit a recursion limit (depends on the environment; in mine, it barfs at N=4402).
It happens to be that the bottom-up version is written in the "explicit" style of code and the top-down version is written in the "tacit" (aka "point-free") style. This is incidental and it's possible to write bottom-up tacitly and/or top-down explicitly.
The top-down version may be interesting as an example of algebraic factorization of code: taking advantage of some unique function composition operations in J, it manages to only mention $: (aka recursion aka "Q") twice.
Java
This example also counts the number of times each n is used as an argument up to 100000 and reports the one that was used the most. <lang java5>import java.util.HashMap; import java.util.Map;
public class HofQ { private static Map<Integer, Integer> q = new HashMap<Integer, Integer>(){{ put(1, 1); put(2, 1); }};
private static int[] nUses = new int[100001];//not part of the task
public static int Q(int n){ nUses[n]++;//not part of the task if(q.containsKey(n)){ return q.get(n); } int ans = Q(n - Q(n - 1)) + Q(n - Q(n - 2)); q.put(n, ans); return ans; }
public static void main(String[] args){ for(int i = 1; i <= 10; i++){ System.out.println("Q(" + i + ") = " + Q(i)); } int last = 6;//value for Q(10) int count = 0; for(int i = 11; i <= 100000; i++){ int curr = Q(i); if(curr < last) count++; last = curr; if(i == 1000) System.out.println("Q(1000) = " + curr); } System.out.println("Q(i) is less than Q(i-1) for i <= 100000 " + count + " times");
//Optional stuff below here int maxUses = 0, maxN = 0; for(int i = 1; i<nUses.length;i++){ if(nUses[i] > maxUses){ maxUses = nUses[i]; maxN = i; } } System.out.println("Q(" + maxN + ") was called the most with " + maxUses + " calls"); } }</lang> Output:
Q(1) = 1 Q(2) = 1 Q(3) = 2 Q(4) = 3 Q(5) = 3 Q(6) = 4 Q(7) = 5 Q(8) = 5 Q(9) = 6 Q(10) = 6 Q(1000) = 502 Q(i) is less than Q(i-1) for i <= 100000 49798 times Q(44710) was called the most with 19 calls
JavaScript
Based on memoization example from 'JavaScript: The Good Parts'. <lang JavaScript>var hofstadterQ = function() {
var memo = [1,1,1]; var Q = function (n) { var result = memo[n]; if (typeof result !== 'number') { result = Q(n - Q(n-1)) + Q(n - Q(n-2)); memo[n] = result; } return result; }; return Q;
}();
for (var i = 1; i <=10; i += 1) {
console.log('Q('+ i +') = ' + hofstadterQ(i));
}
console.log('Q(1000) = ' + hofstadterQ(1000)); </lang> Output:
Q(1) = 1 Q(2) = 1 Q(3) = 2 Q(4) = 3 Q(5) = 3 Q(6) = 4 Q(7) = 5 Q(8) = 5 Q(9) = 6 Q(10) = 6 Q(1000) = 502
jq
The implementation here is recursive, firstly to satisfy the task requirement regarding "recursion limits", and secondly to demonstrate one way to handle a cache in a functional language.
For simplicity, we also define Q(0) = 1, so that the defining formula also holds for n == 2, and so that we can cache Q(n) at the n-th position of an array with index origin 0. <lang jq># Q/1 is a helper function for computing Q(n) and also for the
- function that solves the "extra credit" task.
- Q(n) as defined here returns an updated cache array such that .[n]
- is the Hofstadter value Q(n), assuming that the input is null or a
- valid cache.
def Q(n):
n as $n | (if . == null then [1,1,1] else . end) as $q | if $q[$n] != null then $q else $q | Q($n-1) as $q1 | $q1 | Q($n-2) as $q2 | $q2 | Q($n - $q2[$n - 1]) as $q3 # Q(n - Q(n-1)) | $q3 | Q($n - $q3[$n - 2]) as $q4 # Q(n - Q(n-2)) | ($q4[$n - $q4[$n-1]] + $q4[$n - $q4[$n -2]]) as $ans | $q4 | setpath( [$n]; $ans) end ;
- For n>=2, Q(n) = Q(n - Q(n-1)) + Q(n - Q(n-2))
def Q: . as $n | null | Q($n) | .[$n];
- count the number of times Q(i) > Q(i+1) for 0 < i < n
def flips(n):
reduce range(1;n) as $i ( [0,null]; # [ count; cache ] .[0] as $count | .[1] | Q($i) as $r | $r | Q($i + 1) as $s | (if $s[$i] > $s[$i + 1] then 1 else 0 end) as $one | [ $count + $one, $s ] ) | .[0] ;
- The three tasks at hand:
((range(0;11), 1000) | "Q(\(.)) = \( . | Q)"),
(100 | "flips(\(.)) = \(flips(.))")</lang>
Transcript
<lang bash> $ uname -a Darwin Mac-mini 13.3.0 Darwin Kernel Version 13.3.0: Tue Jun 3 21:27:35 PDT 2014; root:xnu-2422.110.17~1/RELEASE_X86_64 x86_64 $ time jq -r -n -f hofstadter.jq Q(0) = 1 Q(1) = 1 Q(2) = 1 Q(3) = 2 Q(4) = 3 Q(5) = 3 Q(6) = 4 Q(7) = 5 Q(8) = 5 Q(9) = 6 Q(10) = 6 Q(1000) = 502 flips(100000) = 49798
real 0m58.566s user 0m45.799s sys 0m9.187s</lang>
Julia
The following implementation accepts an argument that is a single integer, an array of integers, or a range: <lang julia>function Q(n)
N = maximum(n) q = Array(Int, N) q[1], q[2] = 1, 1 for i = 3:N q[i] = q[i - q[i-1]] + q[i - q[i-2]] end return q[n]
end</lang>
Output: <lang julia>julia> Q(1:10) 10-element Array{Int64,1}:
1 1 2 3 3 4 5 5 6 6
julia> Q(1000) 502</lang> And we can also count the number of times a value is less than its predecessor by, for example: <lang julia>julia> sum(diff(Q(1:10^5)) .< 0) 49798</lang> Since the implementation is non-recursive, there is no issue with recursion limits.
Maple
We use automatic memoisation ("option remember") in the following. The use of "option system" assures that memoised values can be garbage collected. <lang Maple>Q := proc( n )
option remember, system; if n = 1 or n = 2 then 1 else thisproc( n - thisproc( n - 1 ) ) + thisproc( n - thisproc( n - 2 ) ) end if
end proc:</lang> From this we get: <lang Maple>> seq( Q( i ), i = 1 .. 10 );
1, 1, 2, 3, 3, 4, 5, 5, 6, 6
> Q( 1000 );
502</lang>
To determine the number of "flips", we proceed as follows. <lang Maple>> flips := 0: > for i from 2 to 100000 do > if L[ i ] < L[ i - 1 ] then > flips := 1 + flips > end if > end do: > flips;
49798</lang>
Alternatively, we can build the sequence in an array. <lang Maple>Qflips := proc( n )
local a := Array( 1 .. n ); a[ 1 ] := 1; a[ 2 ] := 1; for local i from 3 to n do a[ i ] := a[ i - a[ i - 1 ] ] + a[ i - a[ i - 2 ] ] end do; local flips := 0; for i from 2 to n do if a[ i ] < a[ i - 1 ] then flips := 1 + flips end if end do; flips
end proc:</lang> This gives the same result. <lang Maple>> Qflips( 10^5 );
49798</lang>
Mathematica
<lang Mathematica>Hofstadter[1] = Hofstadter[2] = 1; Hofstadter[n_Integer?Positive] := Hofstadter[n] = Block[{$RecursionLimit = Infinity},
Hofstadter[n - Hofstadter[n - 1]] + Hofstadter[n - Hofstadter[n - 2]]
]</lang> Output: <lang Mathematica>Hofstadter /@ Range[10] {1,1,2,3,3,4,5,5,6,6} Hofstadter[1000] 502 Count[Differences[Hofstadter /@ Range[100000]], _?Negative] 49798</lang>
MATLAB / Octave
This solution pre-allocates memory and is an iterative solution, so caching or recursion limits do not apply. <lang MATLAB>function Q = Qsequence(N)
%% zeros are used to pre-allocate memory, this is not strictly necessary but can significantly improve performance for large N Q = [1,1,zeros(1,N-2)]; for n=3:N Q(n) = Q(n-Q(n-1))+Q(n-Q(n-2)); end;
end; </lang> Confirm and display that the first ten terms of the sequence are: 1, 1, 2, 3, 3, 4, 5, 5, 6, and 6
>> Qsequence(10) ans = 1 1 2 3 3 4 5 5 6 6
Confirm and display that the 1000'th term is: 502
>> Q=Qsequence(1000); Q(end) ans = 502
Count and display how many times a member of the sequence is less than its preceding term for terms up to and including the 100,000'th term.
>> sum(diff(Qsequence(100000))<0) ans = 49798
PARI/GP
Straightforward, unoptimized version; about 1 ms. <lang parigp>Q=vector(1000);Q[1]=Q[2]=1;for(n=3,#Q,Q[n]=Q[n-Q[n-1]]+Q[n-Q[n-2]]); Q1=vecextract(Q,"1..10"); print("First 10 terms: "Q1,if(Q1==[1, 1, 2, 3, 3, 4, 5, 5, 6, 6]," (as expected)"," (in error)")); print("1000-th term: "Q[1000],if(Q[1000]==502," (as expected)"," (in error)"));</lang>
Output:
First 10 terms: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] (as expected) 1000-th term: 502 (as expected)
Pascal
<lang pascal>Program HofstadterQSequence (output);
const
limit = 100000;
var
q: array [1..limit] of longint; i, flips: longint;
begin
q[1] := 1; q[2] := 1; for i := 3 to limit do q[i] := q[i - q[i - 1]] + q[i - q[i - 2]]; for i := 1 to 10 do write(q[i], ' '); writeln; writeln(q[1000]); flips := 0; for i := 1 to limit - 1 do if q[i] > q[i+1] then inc(flips); writeln('Flips: ', flips);
end.</lang> Output:
:> ./HofstadterQSequence 1 1 2 3 3 4 5 5 6 6 502 Flips: 49798
Perl
<lang Perl>#!/usr/bin/perl use warnings; use strict;
my @hofstadters = ( 1 , 1 ); while ( @hofstadters < 100000 ) {
my $nextn = @hofstadters + 1;
- array index counting starts at 0 , so we have to subtract 1 from the numbers!
push @hofstadters , $hofstadters [ $nextn - 1 - $hofstadters[ $nextn - 1 - 1 ] ] + $hofstadters[ $nextn - 1 - $hofstadters[ $nextn - 2 - 1 ]];
} for my $i ( 0..9 ) {
print "$hofstadters[ $i ]\n";
} print "The 1000'th term is $hofstadters[ 999 ]!\n"; my $less_than_preceding = 0; for my $i ( 0..99998 ) {
$less_than_preceding++ if $hofstadters[ $i + 1 ] < $hofstadters[ $i ];
} print "Up to and including the 100000'th term, $less_than_preceding terms are less " .
"than their preceding terms!\n";
</lang> Output:
1 1 2 3 3 4 5 5 6 6 The 1000'th term is 502! Up to and including the 100000'th term, 49798 terms are less than their preceding terms!
Here's a second solution. This solution uses tie to make the Q sequence look like a regular array, and only fills the cache on demand. Some pre-allocation is done which provides a minor speed increase for the extra credit. I could have chosen to do recursion instead of iteration, as perl has no limit on how deeply one may recurse, but did not see the benefit of doing so.
<lang Perl>#!perl use strict; use warnings; package Hofstadter; sub TIEARRAY {
bless [undef, 1, 1], shift;
} sub FETCH {
my ($self, $n) = @_; die if $n < 1; if( $n > $#$self ) { my $start = $#$self + 1; $#$self = $n; # pre-allocate for efficiency for my $nn ( $start .. $n ) { my ($a, $b) = (1, 2); $_ = $self->[ $nn - $_ ] for $a, $b; $_ = $self->[ $nn - $_ ] for $a, $b; $self->[$nn] = $a + $b; } } $self->[$n];
}
package main;
tie my (@q), "Hofstadter";
print "@q[1..10]\n"; print $q[1000], "\n";
my $count = 0; for my $n ( 2 .. 100_000 ) {
$count++ if $q[$n] < $q[$n - 1];
} print "Extra credit: $count\n"; </lang> Output:
1 1 2 3 3 4 5 5 6 6 502 Extra credit: 49798
Perl 6
OO solution
Similar concept as the perl5 solution, except that the cache is only filled on demand.
<lang perl6>class Hofstadter {
has @!c = 1,1; method at_pos ($me: Int $i) { @!c.push($me[@!c.elems-$me[@!c.elems-1]] +
$me[@!c.elems-$me[@!c.elems-2]]) until @!c[$i]:exists;
return @!c[$i]; }
}</lang> Testing: <lang perl6>my Hofstadter $Q .= new();
say "first ten: $Q[^10]"; say "1000th: $Q[999]";
my $count = 0; $count++ if $Q[$_ +1 ] < $Q[$_] for ^99_999; say "In the first 100_000 terms, $count terms are less than their preceding terms";</lang>
- Output:
first ten: 1 1 2 3 3 4 5 5 6 6 1000th: 502 In the first 100_000 terms, 49798 terms are less than their preceding terms
Idiomatic solution
By defining a lazily generated constant array, we automatically get caching. <lang perl6>constant @Q = 1, 1, -> $a, $b {
(state $n = 1)++; @Q[$n - $a] + @Q[$n - $b]
} ... *;</lang> Testing: <lang perl6>say "first ten: ", @Q[^10]; say "1000th: ", @Q[999]; say "In the first 100_000 terms, ",
[+](@Q[1..100000] Z< @Q[0..99999]), " terms are less than their preceding terms";</lang>
(Same output.)
PicoLisp
<lang PicoLisp>(de q (N)
(cache '(NIL) N (if (>= 2 N) 1 (+ (q (- N (q (dec N)))) (q (- N (q (- N 2)))) ) ) ) )</lang>
Test: <lang PicoLisp>: (mapcar q (range 1 10)) -> (1 1 2 3 3 4 5 5 6 6)
- (q 1000)
-> 502
- (let L (mapcar q (range 1 100000))
(cnt < (cdr L) L) )
-> 49798</lang>
PL/I
<lang PL/I> /* Hofstrader Q sequence for any "n". */
H: procedure options (main); /* 28 January 2012 */
declare n fixed binary(31);
put ('How many values do you want? :'); get (n);
begin;
declare Q(n) fixed binary (31); declare i fixed binary (31);
Q(1), Q(2) = 1; do i = 1 upthru n; if i >= 3 then Q(i) = ( Q(i - Q(i-1)) + Q(i - Q(i-2)) ); if i <= 20 then put skip list ('n=' || trim(i), Q(i)); end; put skip list ('n=' || trim(i), Q(i));
end; end H; </lang> Output:
How many values do you want? : n=1 1 n=2 1 n=3 2 n=4 3 n=5 3 n=6 4 n=7 5 n=8 5 n=9 6 n=10 6 n=11 6 n=12 8 n=13 8 n=14 8 n=15 10 n=16 9 n=17 10 n=18 11 n=19 11 n=20 12 n=1000 502
Final output for n=100,000
n=100000 48157
Bonus to produce the count of unordered values: <lang>
declare tally fixed binary (31) initial (0);
do i = 1 to n-1; if Q(i) > Q(i+1) then tally = tally + 1; end; put skip data (tally);
</lang> Output:
n=100000 48157 TALLY= 49798;
Python
<lang python>def q(n):
if n < 1 or type(n) != int: raise ValueError("n must be an int >= 1") try: return q.seq[n] except IndexError: ans = q(n - q(n - 1)) + q(n - q(n - 2)) q.seq.append(ans) return ans
q.seq = [None, 1, 1]
if __name__ == '__main__':
first10 = [q(i) for i in range(1,11)] assert first10 == [1, 1, 2, 3, 3, 4, 5, 5, 6, 6], "Q() value error(s)" print("Q(n) for n = [1..10] is:", ', '.join(str(i) for i in first10)) assert q(1000) == 502, "Q(1000) value error" print("Q(1000) =", q(1000))</lang>
- Extra credit
If you try and initially compute larger values of n then you tend to hit the Python recursion limit.
The function q1 gets around this by calling function q to extend the Q series in increments below the recursion limit.
The following code is to be concatenated to the code above: <lang python>from sys import getrecursionlimit
def q1(n):
if n < 1 or type(n) != int: raise ValueError("n must be an int >= 1") try: return q.seq[n] except IndexError: len_q, rlimit = len(q.seq), getrecursionlimit() if (n - len_q) > (rlimit // 5): for i in range(len_q, n, rlimit // 5): q(i) ans = q(n - q(n - 1)) + q(n - q(n - 2)) q.seq.append(ans) return ans
if __name__ == '__main__':
tmp = q1(100000) print("Q(i+1) < Q(i) for i [1..100000] is true %i times." % sum(k1 < k0 for k0, k1 in zip(q.seq[1:], q.seq[2:])))</lang>
- Combined output
Q(n) for n = [1..10] is: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 Q(1000) = 502 Q(i+1) < Q(i) for i [1..10000] is true 49798 times.
Alternative
<lang python>def q(n):
l = len(q.seq) while l <= n: q.seq.append(q.seq[l - q.seq[l - 1]] + q.seq[l - q.seq[l - 2]])
l += 1
return q.seq[n]
q.seq = [None, 1, 1]
print("Q(n) for n = [1..10] is:", [q(i) for i in range(1, 11)]) print("Q(1000) =", q(1000)) q(100000) print("Q(i+1) < Q(i) for i [1..100000] is true %i times." %
sum([q.seq[i] > q.seq[i + 1] for i in range(1, 100000)]))</lang>
Racket
<lang racket>
- lang racket
(define t (make-hash)) (hash-set! t 0 0) (hash-set! t 1 1) (hash-set! t 2 1)
(define (Q n)
(hash-ref! t n (λ() (+ (Q (- n (Q (- n 1)))) (Q (- n (Q (- n 2))))))))
(for/list ([i (in-range 1 11)]) (Q i)) (Q 1000)
- extra credit
(for/sum ([i 100000]) (if (< (Q (add1 i)) (Q i)) 1 0)) </lang>
- Output:
'(1 1 2 3 3 4 5 5 6 6) 502 49798
REXX
non-recursive
The REXX language doesn't allow expressions for stemmed array indices, so a temporary variable must be used. <lang rexx>/*REXX program to generate Hofstadter Q sequence for any N. */ q.=1 /*negative #s won't have values displayed.*/ call HofstadterQ 10 call HofstadterQ -1000; say; say '1000th value='result; say call HofstadterQ -100000 downs=0; do j=2 to 100000; jm=j-1
downs=downs + (q.j<q.jm) end /*j*/
say downs 'terms are less than the previous term.' exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────HofstadterQ subroutine──────────────*/ HofstadterQ: procedure expose q.; arg x 1 ox /*get the # to gen through*/
/*(above) OX is the same as X.*/
x=abs(x) /*use the absolute value for X. */ L=length(x) /*use for right justified output.*/
do j=1 for x if j>2 then if q.j==1 then do; jm1=j-1; jm2=j-2 _1=j-q.jm1; _2=j-q.jm2 q.j=q._1+q._2 end if ox>0 then say right(j,L) right(q.j,L) /*if X>0, tell*/ end /*j*/
return q.x /*return the Xth term to caller.*/</lang> output
1 1 2 1 3 2 4 3 5 3 6 4 7 5 8 5 9 6 10 6 1000th value=502 49798 terms are less than the previous term.
non-recursive, simpler
This REXX example is identical to the first version except that it uses a function to retrieve array elements with index expressions. <lang rexx>/*REXX program to generate Hofstadter Q sequence for any N. */ q.=1 /*negative #s won't have values displayed.*/ call HofstadterQ 10 call HofstadterQ -1000; say; say '1000th value='result; say call HofstadterQ -100000 downs=0; do j=2 to 100000; jm=j-1
downs=downs + (q.j<q.jm) end /*j*/
say downs 'terms are less than the previous term.' exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────HofstadterQ subroutine──────────────*/ HofstadterQ: procedure expose q.; arg x 1 ox /*get the # to gen through*/
/*(above) OX is the same as X.*/
x=abs(x) /*use the absolute value for X. */ L=length(x) /*use for right justified output.*/
do j=1 for x if j>2 then if q.j==1 then q.j=q(j-q(j-1)) + q(j-q(j-2)) if ox>0 then say right(j,L) right(q.j,L) /*if X>0, tell*/ end /*j*/
return q.x /*return the Xth term to caller.*/
/*──────────────────────────────────Q subroutine────────────────────────*/
q: parse arg ?; return q.? /*return value of Q.? to invoker.*/</lang>
output is identical to the first version.
recursive
<lang rexx>/*REXX program to generate Hofstadter Q sequence for any N. */ q.=0; q.1=1; q.2=1 /*negative #s won't have values displayed.*/ call HofstadterQ 10 call HofstadterQ -1000; say; say '1000th value='result; say call HofstadterQ -100000 downs=0; do j=2 to 100000; jm=j-1
downs=downs + (q.j<q.jm) end
say downs 'terms are less than the previous term.' exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────HofstadterQ subroutine──────────────*/ HofstadterQ: procedure expose q.; arg x 1 ox /*get the # to gen through*/
/*(above) OX is the same as X.*/
x=abs(x) /*use the absolute value for X. */ L=length(x) /*use for right justified output.*/
do j=1 for x if q.j==0 then q.j=QR(j) /*Not defined? Then define it.*/ if ox>0 then say right(j,L) right(q.j,L) /*if X>0, tell*/ end /*j*/
return q.x /*return the Xth term to caller.*/
/*──────────────────────────────────QR subroutine───────────────────────*/
QR: procedure expose q.; parse arg n /*function is recursive. */
if q.n==0 then q.n=QR(n-QR(n-1)) + QR(n-QR(n-2)) /*¬defined? Define it*/
return q.n /*return with the value. */</lang>
output is identical to the first version.
The recursive version took over five times longer than the non-recursive version.
Ruby
<lang ruby>@cache = [] def Q(n)
if @cache[n].nil? case n when 1, 2 then @cache[n] = 1 else @cache[n] = Q(n - Q(n-1)) + Q(n - Q(n-2)) end end @cache[n]
end
puts "first 10 numbers in the sequence: #{(1..10).map {|n| Q(n)}}" puts "1000'th term: #{Q(1000)}"
prev = Q(1) count = 0 2.upto(100_000) do |n|
q = Q(n) count += 1 if q < prev prev = q
end puts "number of times in the first 100,000 terms where Q(i)<Q(i-1): #{count}"</lang> output
first 10 numbers in the sequence: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] 1000'th term: 502 number of times in the first 100,000 terms where Q(i)<Q(i-1): 49798
Run BASIC
<lang Runbasic>input "How many values do you want? :";n dim Q(n) Q(1) = 1 Q(2) = 1 for i = 1 to n
if i >= 3 then Q(i) = ( Q(i - Q(i-1)) + Q(i - Q(i-2)) ) if i <= 20 then print "n=";using("####",i);" ";using("###",Q(i))
next i if i > 20 then print "n=";using("####",i);using("####",Q(i)) end
</lang>
How many values do you want? :?1000 n= 1 1 n= 2 1 n= 3 2 n= 4 3 n= 5 3 n= 6 4 n= 7 5 n= 8 5 n= 9 6 n= 10 6 n= 11 6 n= 12 8 n= 13 8 n= 14 8 n= 15 10 n= 16 9 n= 17 10 n= 18 11 n= 19 11 n= 20 12 n=1000 502
Scala
Naive but elegant version using only recursion doesn't work because runtime is excessive increasing ... <lang scala>object HofstadterQseq extends App {
val Q: Int => Int = n => { if (n <= 2) 1 else Q(n-Q(n-1))+Q(n-Q(n-2)) } (1 to 10).map(i=>(i,Q(i))).foreach(t=>println("Q("+t._1+") = "+t._2)) println("Q("+1000+") = "+Q(1000))
}</lang>
Unfortunately the function Q isn't tail recursiv, therefore the compiler can't optimize it. Thus we are forced to use a caching featured version.
<lang scala>object HofstadterQseq extends App {
val HofQ = scala.collection.mutable.Map((1->1),(2->1))
val Q: Int => Int = n => { if (n < 1) 0 else { val res = HofQ.keys.filter(_==n).toList match { case Nil => {val v = Q(n-Q(n-1))+Q(n-Q(n-2)); HofQ += (n->v); v} case xs => HofQ(n) } res } } (1 to 10).map(i=>(i,Q(i))).foreach(t=>println("Q("+t._1+") = "+t._2)) println("Q("+1000+") = "+Q(1000)) println((3 to 100000).filter(i=>Q(i)<Q(i-1)).size)
}</lang>
Q(1) = 1 Q(2) = 1 Q(3) = 2 Q(4) = 3 Q(5) = 3 Q(6) = 4 Q(7) = 5 Q(8) = 5 Q(9) = 6 Q(10) = 6 Q(1000) = 502 49798
Scheme
I wish there were a portable way to define-syntax
, or to resize arrays, or to do formated output--anything to make the code less silly looking while still run under more than one interpreter.
<lang lisp>(define qc '#(0 1 1))
(define filled 3)
(define len 3)
- chicken scheme
- vector-resize!
- gambit
- vector-append
(define (extend-qc)
(let* ((new-len (* 2 len))
(new-qc (make-vector new-len)))
(let copy ((n 0)) (if (< n len)
(begin (vector-set! new-qc n (vector-ref qc n)) (copy (+ 1 n)))))
(set! len new-len) (set! qc new-qc)))
(define (q n)
(let loop () (if (>= filled len) (extend-qc)) (if (>= n filled) (begin
(vector-set! qc filled (+ (q (- filled (q (- filled 1)))) (q (- filled (q (- filled 2)))))) (set! filled (+ 1 filled)) (loop))
(vector-ref qc n))))
(display "Q(1 .. 10): ") (let loop ((i 1))
;; (print) behave differently regarding newline across compilers (display (q i)) (display " ") (if (< i 10) (loop (+ 1 i)) (newline)))
(display "Q(1000): ") (display (q 1000)) (newline)
(display "bumps up to 100000: ") (display
(let loop ((s 0) (i 1)) (if (>= i 100000) s (loop (+ s (if (> (q i) (q (+ 1 i))) 1 0)) (+ 1 i)))))
(newline)</lang>output<lang>Q(1 .. 10): 1 1 2 3 3 4 5 5 6 6 Q(1000): 502 bumps up to 100000: 49798</lang>
Seed7
<lang seed7>$ include "seed7_05.s7i";
const type: intHash is hash [integer] integer;
var intHash: qHash is intHash.value;
const func integer: q (in integer: n) is func
result var integer: q is 1; begin if n in qHash then q := qHash[n]; else if n > 2 then q := q(n - q(pred(n))) + q(n - q(n - 2)); end if; qHash @:= [n] q; end if; end func;
const proc: main is func
local var integer: n is 0; var integer: less_than_preceding is 0; begin writeln("q(n) for n = 1 .. 10:"); for n range 1 to 10 do write(q(n) <& " "); end for; writeln; writeln("q(1000)=" <& q(1000)); for n range 2 to 100000 do if q(n) < q(pred(n)) then incr(less_than_preceding); end if; end for; writeln("q(n) < q(n-1) for n = 2 .. 100000: " <& less_than_preceding); end func;</lang>
Output:
q(n) for n = 1 .. 10: 1 1 2 3 3 4 5 5 6 6 q(1000)=502 q(n) < q(n-1) for n = 2 .. 100000: 49798
Tcl
<lang tcl>package require Tcl 8.5
- Index 0 is not used, but putting it in makes the code a bit shorter
set tcl::mathfunc::Qcache {Q:-> 1 1} proc tcl::mathfunc::Q {n} {
variable Qcache if {$n >= [llength $Qcache]} {
lappend Qcache [expr {Q($n - Q($n-1)) + Q($n - Q($n-2))}]
} return [lindex $Qcache $n]
}
- Demonstration code
for {set i 1} {$i <= 10} {incr i} {
puts "Q($i) == [expr {Q($i)}]"
}
- This runs very close to recursion limit...
puts "Q(1000) == [expr Q(1000)]"
- This code is OK, because the calculations are done step by step
set q [expr Q(1)] for {set i 2} {$i <= 100000} {incr i} {
incr count [expr {$q > [set q [expr {Q($i)}]]}]
} puts "Q(i)<Q(i-1) for i \[2..100000\] is true $count times"</lang> Output:
Q(1) == 1 Q(2) == 1 Q(3) == 2 Q(4) == 3 Q(5) == 3 Q(6) == 4 Q(7) == 5 Q(8) == 5 Q(9) == 6 Q(10) == 6 Q(1000) == 502 Q(i)<Q(i-1) for i [2..100000] is true 49798 times
XPL0
<lang XPL0>code ChOut=8, CrLf=9, IntOut=11; int N, C, Q(100_001); [Q(1):= 1; Q(2):= 1; C:= 0; for N:= 3 to 100_000 do
[Q(N):= Q(N-Q(N-1)) + Q(N-Q(N-2)); if Q(N) < Q(N-1) then C:= C+1; ];
for N:= 1 to 10 do
[IntOut(0, Q(N)); ChOut(0, ^ )];
CrLf(0); IntOut(0, Q(1000)); CrLf(0); IntOut(0, C); CrLf(0); ]</lang>
- Output:
1 1 2 3 3 4 5 5 6 6 502 49798
zkl
<lang zkl>const n = 0d100_000; q:=(n+1).pump(List.createLong(n+1).write); // (0,1,2,...,n) base 1 q[1] = q[2] = 1;
foreach i in ([3..n]) { q[i] = q[i - q[i - 1]] + q[i - q[i - 2]] }
q[1,10].concat(" ").println(); println(q[1000]);
flip := 0; foreach i in (n){ flip += (q[i] > q[i + 1]) } println("flips: ",flip);</lang>
- Output:
1 1 2 3 3 4 5 5 6 6 502 flips: 49798
- Programming Tasks
- Solutions by Programming Task
- Ada
- ALGOL 68
- AutoHotkey
- AWK
- BBC BASIC
- C
- C++
- C sharp
- Clojure
- Common Lisp
- D
- Dart
- Erlang
- F Sharp
- Factor
- Go
- Haskell
- Icon
- Unicon
- Icon Programming Library
- J
- Java
- Memoization
- JavaScript
- Jq
- Julia
- Maple
- Mathematica
- MATLAB
- Octave
- PARI/GP
- Pascal
- Perl
- Perl 6
- PicoLisp
- PL/I
- Python
- Racket
- REXX
- Ruby
- Run BASIC
- Scala
- Scheme
- Seed7
- Tcl
- XPL0
- Zkl