Hofstadter Q sequence: Difference between revisions
→{{header|jq}}: omit parenthetical remark |
|||
(147 intermediate revisions by 61 users not shown) | |||
Line 1: | Line 1: | ||
{{task}}The [[wp:Hofstadter_sequence#Hofstadter_Q_sequence|Hofstadter Q sequence]] is defined as: |
{{task}}The [[wp:Hofstadter_sequence#Hofstadter_Q_sequence|Hofstadter Q sequence]] is defined as: |
||
<big> |
|||
:<math>\begin{align} |
|||
:: <math>\begin{align} |
|||
Q(1)&=Q(2)=1, \\ |
Q(1)&=Q(2)=1, \\ |
||
Q(n)&=Q\big(n-Q(n-1)\big)+Q\big(n-Q(n-2)\big), \quad n>2. |
Q(n)&=Q\big(n-Q(n-1)\big)+Q\big(n-Q(n-2)\big), \quad n>2. |
||
\end{align}</math> |
\end{align}</math> |
||
</big> |
|||
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. |
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: |
;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 first ten terms of the sequence are: 1, 1, 2, 3, 3, 4, 5, 5, 6, and 6 |
||
* Confirm and display that the 1000<sup>th</sup> term is: 502 |
* Confirm and display that the 1000<sup>th</sup> term is: 502 |
||
;Optional extra credit |
;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 |
* 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<sup>th</sup> term. |
||
* Ensure that the extra credit solution 'safely' handles being initially asked for an n'th term where n is large |
* Ensure that the extra credit solution ''safely'' handles being initially asked for an '''n'''<sup>th</sup> term where '''n''' is large. |
||
<br>(This point is to ensure that caching and/or recursion limits, if it is a concern, is correctly handled). |
|||
<br><br> |
|||
=={{header|11l}}== |
|||
{{trans|C}} |
|||
<syntaxhighlight lang="11l">V qseq = [0] * 100001 |
|||
qseq[1] = 1 |
|||
qseq[2] = 1 |
|||
L(i) 3 .< qseq.len |
|||
qseq[i] = qseq[i - qseq[i-1]] + qseq[i - qseq[i-2]] |
|||
print(‘The first 10 terms are: ’qseq[1..10].map(q -> String(q)).join(‘, ’)) |
|||
print(‘The 1000'th term is ’qseq[1000]) |
|||
V less_than_preceding = 0 |
|||
L(i) 2 .< qseq.len |
|||
I qseq[i] < qseq[i-1] |
|||
less_than_preceding++ |
|||
print(‘Times a member of the sequence is less than its preceding term: ’less_than_preceding)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
The first 10 terms are: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 |
|||
The 1000'th term is 502 |
|||
Times a member of the sequence is less than its preceding term: 49798 |
|||
</pre> |
|||
=={{header|360 Assembly}}== |
|||
{{trans|PL/I}} |
|||
<syntaxhighlight lang="360asm">* Hofstrader q sequence for any n - 18/10/2015 |
|||
HOFSTRAD CSECT |
|||
USING HOFSTRAD,R15 set base register |
|||
MVC Q,=F'1' q(1)=1 |
|||
MVC Q+4,=F'1' q(2)=1 |
|||
LA R4,1 i=1 |
|||
LOOPI C R4,N do i=1 to n |
|||
BH ELOOPI |
|||
C R4,=F'3' if i>=3 then |
|||
BL NOTREC |
|||
LR R1,R4 i |
|||
SLA R1,2 i*4 |
|||
L R2,Q-8(R1) q(i-1) |
|||
LR R1,R4 i |
|||
SR R1,R2 i-q(i-1) |
|||
SLA R1,2 *4 |
|||
L R2,Q-4(R1) r2=q(i-q(i-1)) |
|||
LR R1,R4 i |
|||
SLA R1,2 i*4 |
|||
L R3,Q-12(R1) q(i-2) |
|||
LR R1,R4 i |
|||
SR R1,R3 i-q(i-2) |
|||
SLA R1,2 *4 |
|||
L R3,Q-4(R1) r3=q(i-q(i-2)) |
|||
AR R2,R3 r2=r2+r3 |
|||
LR R1,R4 i |
|||
SLA R1,2 i*4 |
|||
ST R2,Q-4(R1) q(i)=q(i-q(i-1))+q(i-q(i-2)) |
|||
NOTREC C R4,=F'10' if i<=10 |
|||
BNH PRT |
|||
C R4,N or i=n then |
|||
BNE NOPRT |
|||
PRT XDECO R4,XD edit i |
|||
MVC PG+2(4),XD+8 output i |
|||
LR R1,R4 i |
|||
SLA R1,2 i*4 |
|||
L R2,Q-4(R1) q(i) |
|||
XDECO R2,XD edit q(i) |
|||
MVC PG+10(4),XD+8 output q(i) |
|||
XPRNT PG,80 print buffer |
|||
NOPRT LA R4,1(R4) i=i+1 |
|||
B LOOPI |
|||
ELOOPI XR R15,R15 set return code |
|||
BR R14 return to caller |
|||
PG DC CL80'n=...., q=....' buffer |
|||
XD DS CL12 temporary variable |
|||
LTORG insert literals for addressability |
|||
N DC F'1000' n=1000 |
|||
Q DS 1000F array q(1000) |
|||
YREGS |
|||
END HOFSTRAD</syntaxhighlight> |
|||
{{out}} |
|||
<pre style="height:16ex"> |
|||
n= 1, q= 1 |
|||
n= 2, q= 1 |
|||
n= 3, q= 2 |
|||
n= 4, q= 3 |
|||
n= 5, q= 3 |
|||
n= 6, q= 4 |
|||
n= 7, q= 5 |
|||
n= 8, q= 5 |
|||
n= 9, q= 6 |
|||
n= 10, q= 6 |
|||
n=1000, q= 502 |
|||
</pre> |
|||
=={{header|8080 Assembly}}== |
|||
<syntaxhighlight lang="8080asm">puts: equ 9 ; CP/M call to print a string |
|||
org 100h |
|||
;;; Generate the first 1000 members of the Q sequence |
|||
lxi b,3 ; Start at 3rd element (1 and 2 already defined) |
|||
genq: dcx b ; BC = N-1 |
|||
call q |
|||
mov e,m ; DE = Q(N-1) |
|||
inx h |
|||
mov d,m |
|||
inx b ; BC = (N-1)+1 = N |
|||
xchg ; HL = Q(N-1) |
|||
call neg ; HL = -Q(N-1) |
|||
dad b ; HL = N-Q(N-1) |
|||
push b ; Keep N |
|||
mov b,h ; BC = N-Q(N-1) |
|||
mov c,l |
|||
call q ; HL = *Q(N-Q(N-1)) |
|||
mov e,m ; DE = Q(N-Q(N-1)) |
|||
inx h |
|||
mov d,m |
|||
pop b ; Restore N |
|||
push d ; push Q(N-Q(N-1)) |
|||
dcx b ; BC = N-2 |
|||
dcx b |
|||
call q ; DE = Q(N-2) |
|||
mov e,m |
|||
inx h |
|||
mov d,m |
|||
inx b ; BC = (N-2)+2 = N |
|||
inx b |
|||
xchg ; HL = Q(N-2) |
|||
call neg ; HL = -Q(N-2) |
|||
dad b ; HL = N-Q(N-2) |
|||
push b ; Keep N |
|||
mov b,h ; BC = N-Q(N-2) |
|||
mov c,l |
|||
call q ; HL = *Q(N-Q(N-2)) |
|||
mov a,m ; HL = Q(N-Q(N-2)) |
|||
inx h |
|||
mov h,m |
|||
mov l,a |
|||
pop b ; Restore N |
|||
pop d ; pop Q(N-Q(N-1)) |
|||
dad d ; HL = Q(N-Q(N-1))+Q(N-Q(N-2)) |
|||
xchg ; DE = Q(N-Q(N-1))+Q(N-Q(N-2)) |
|||
call q ; HL = *Q(N) |
|||
mov m,e ; Store Q(N) |
|||
inx h |
|||
mov m,d |
|||
inx b ; N = N+1 |
|||
lxi h,-1001 |
|||
dad b ; Are we there yet? |
|||
jnc genq |
|||
;;; Print first 10 terms |
|||
lxi d,m10 |
|||
mvi c,puts |
|||
call 5 |
|||
lxi b,1 ; Start at term 1 |
|||
mvi d,10 ; 10 terms |
|||
p10: push b ; Save counters |
|||
push d |
|||
call prterm ; Print current term |
|||
pop d ; Restore counters |
|||
pop b |
|||
inx b ; Next term |
|||
dcr d ; Repeat 10 times |
|||
jnz p10 |
|||
;;; Print 1000th term |
|||
lxi d,m1000 |
|||
mvi c,puts |
|||
call 5 |
|||
lxi b,1000 ; 1000th term |
|||
;;; Print Q(BC) |
|||
prterm: call q ; Load term into HL |
|||
mov a,m |
|||
inx h |
|||
mov h,m |
|||
mov l,a |
|||
lxi b,num ; Push pointer to end of number buffer |
|||
push b |
|||
lxi b,-10 ; Divisor |
|||
dgt: lxi d,-1 ; Quotient |
|||
divlp: inx d |
|||
dad b |
|||
jc divlp |
|||
mvi a,'0'+10 |
|||
add l ; Make ASCII digit |
|||
pop h ; Get pointer |
|||
dcx h |
|||
mov m,a ; Store digit |
|||
push h |
|||
xchg ; HL = next quotient |
|||
mov a,h ; More digits? |
|||
ora l |
|||
jnz dgt |
|||
pop d ; Print string |
|||
mvi c,puts |
|||
jmp 5 |
|||
;;; Set HL = -HL |
|||
neg: dcx h |
|||
mov a,h |
|||
cma |
|||
mov h,a |
|||
mov a,l |
|||
cma |
|||
mov l,a |
|||
ret |
|||
;;; Set HL to memory location of Q(BC) |
|||
q: push d ; Keep DE |
|||
mov h,b ; HL = 2*(BC-1) |
|||
mov l,c |
|||
dcx h |
|||
dad h |
|||
lxi d,qq ; Add to start of sequence |
|||
dad d |
|||
pop d |
|||
ret |
|||
m10: db 'The first 10 terms are: $' |
|||
m1000: db 13,10,'The 1000th term is: $' |
|||
db '*****' ; Placeholder for number |
|||
num: db ' $' |
|||
qq: dw 1,1 ; Q sequence stored here, starting with 1, 1</syntaxhighlight> |
|||
{{out}} |
|||
<pre>The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502</pre> |
|||
=={{header|8086 Assembly}}== |
|||
<syntaxhighlight lang="asm">puts: equ 9 ; MS-DOS syscall to print a string |
|||
cpu 8086 |
|||
org 100h |
|||
section .text |
|||
;;; Generate first 1000 elements of Q sequence |
|||
mov dx,3 ; DX = N |
|||
mov di,Q+4 ; DI = place to store elements |
|||
mov cx,998 ; Generate 998 more terms |
|||
genq: mov si,dx ; SI = N |
|||
sub si,[di-2] ; SI -= Q[N-1] |
|||
mov bp,dx ; BP = N |
|||
sub bp,[di-4] ; BP -= Q[N-2] |
|||
dec si ; SI = 2*(SI-1) (0-indexed, 2 bytes/term) |
|||
shl si,1 |
|||
dec bp ; Same for BP |
|||
shl bp,1 |
|||
mov ax,[si+Q] ; Load Q[n-Q[n-1]] |
|||
add ax,[bp+Q] ; Add Q[n-Q[n-2]] |
|||
stosw ; Store as Q[n] |
|||
inc dx ; Increment N |
|||
loop genq |
|||
;;; Print first 10 elements |
|||
mov ah,puts |
|||
mov dx,m10 |
|||
int 21h |
|||
mov cx,10 |
|||
mov bx,1 |
|||
p10: call prterm |
|||
inc bx |
|||
loop p10 |
|||
;;; Print 1000th element |
|||
mov ah,puts |
|||
mov dx,m1000 |
|||
int 21h |
|||
mov bx,1000 |
|||
;;; Print the term in BX |
|||
prterm: push bx ; Save term |
|||
dec bx |
|||
shl bx,1 |
|||
mov ax,[bx+Q] ; Load term into AX |
|||
mov bp,10 ; Divisor |
|||
mov bx,num ; Number buffer pointer |
|||
.dgt: xor dx,dx |
|||
div bp ; Divide number by 10 |
|||
dec bx |
|||
add dl,'0' ; DX = remainder, add '0' |
|||
mov [bx],dl ; Stored digit |
|||
test ax,ax ; Done yet? |
|||
jnz .dgt ; If not, find next digit |
|||
mov dx,bx ; Print the number |
|||
mov ah,puts |
|||
int 21h |
|||
pop bx ; Restore term |
|||
ret |
|||
section .data |
|||
m10: db 'First 10 terms are: $' |
|||
m1000: db 13,10,'1000th term is: $' |
|||
db '*****' ; Number placeholder |
|||
num: db ' $' |
|||
Q: dw 1,1 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>First 10 terms are: 1 1 2 3 3 4 5 5 6 6 |
|||
1000th term is: 502</pre> |
|||
=={{header|Action!}}== |
|||
<syntaxhighlight lang="action!">PROC Main() |
|||
DEFINE MAX="1000" |
|||
INT ARRAY q(MAX+1) |
|||
INT i |
|||
q(1)=1 q(2)=1 |
|||
FOR i=3 TO MAX |
|||
DO |
|||
q(i)=q(i-q(i-1))+q(i-q(i-2)) |
|||
OD |
|||
FOR i=1 TO 10 |
|||
DO |
|||
PrintF("%I: %I%E",i,q(i)) |
|||
OD |
|||
PrintF("%I: %I%E",MAX,q(MAX)) |
|||
RETURN</syntaxhighlight> |
|||
{{out}} |
|||
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Hofstadter_Q_sequence.png Screenshot from Atari 8-bit computer] |
|||
<pre> |
|||
1: 1 |
|||
2: 1 |
|||
3: 2 |
|||
4: 3 |
|||
5: 3 |
|||
6: 4 |
|||
7: 5 |
|||
8: 5 |
|||
9: 6 |
|||
10: 6 |
|||
1000: 502 |
|||
</pre> |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
< |
<syntaxhighlight lang="ada">with Ada.Text_IO; |
||
procedure Hofstadter_Q_Sequence is |
procedure Hofstadter_Q_Sequence is |
||
Line 73: | Line 407: | ||
-- how many times a member of the sequence is less than its preceding term |
-- 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 |
-- for terms up to and including the 100,000'th term |
||
end Hofstadter_Q_Sequence;</ |
end Hofstadter_Q_Sequence;</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> 1 1 2 3 3 4 5 5 6 6 |
<pre> 1 1 2 3 3 4 5 5 6 6 |
||
502 |
502 |
||
Line 86: | Line 420: | ||
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''.}} |
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''.}} |
||
'''File: Hofstadter_Q_sequence.a68'''< |
'''File: Hofstadter_Q_sequence.a68'''<syntaxhighlight lang="algol68">#!/usr/local/bin/a68g --script # |
||
INT n = 100000; |
INT n = 100000; |
||
Line 109: | Line 443: | ||
printf(($"flips: "g(0)l$, flip)) |
printf(($"flips: "g(0)l$, flip)) |
||
)</syntaxhighlight> |
|||
)</lang>'''Output:''' |
|||
{{out}} |
|||
<pre> |
<pre> |
||
1 1 2 3 3 4 5 5 6 6 |
1 1 2 3 3 4 5 5 6 6 |
||
Line 115: | Line 450: | ||
flips: 49798 |
flips: 49798 |
||
</pre> |
</pre> |
||
=={{header|ALGOL-M}}== |
|||
<syntaxhighlight lang="algolm">begin |
|||
integer array Q[1:1000]; |
|||
integer n; |
|||
Q[1] := Q[2] := 1; |
|||
for n := 3 step 1 until 1000 do |
|||
Q[n] := Q[n-Q[n-1]] + Q[n-Q[n-2]]; |
|||
write("The first 10 terms are:"); |
|||
write(""); |
|||
for n := 1 step 1 until 10 do writeon(Q[n]); |
|||
write("The 1000th term is:", Q[1000]); |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
<pre>The first 10 terms are: |
|||
1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502</pre> |
|||
=={{header|ALGOL W}}== |
|||
<syntaxhighlight lang="algolw">begin % find elements of the Hofstader Q sequence Q(1) = Q(2) = 1 % |
|||
% Q(n) = Q( n - Q( n - 1 ) ) + Q( n - Q( n - 2 ) ) for n > 2 % |
|||
integer MAX_Q; |
|||
max_Q := 100000; |
|||
begin |
|||
integer array Q ( 1 :: MAX_Q ); |
|||
integer array xQ ( 1 :: 10 ); |
|||
integer ltCount; |
|||
logical valuesOk; |
|||
% expected values of the first 10 elements % |
|||
xQ( 1 ) := xQ( 2 ) := 1; |
|||
xQ( 3 ) := 2; xQ( 4 ) := xQ( 5 ) := 3; xQ( 6 ) := 4; |
|||
xQ( 7 ) := xQ( 8 ) := 5; xQ( 9 ) := xQ( 10 ) := 6; |
|||
% calculate the sequence and count how often Q( n ) < Q( n - 1 ) % |
|||
ltCount := 0; |
|||
Q( 1 ) := Q( 2 ) := 1; |
|||
for n := 3 until MAX_Q do begin |
|||
Q( n ) := Q( n - Q( n - 1 ) ) + Q( n - Q( n - 2 ) ); |
|||
if Q( n ) < Q( n - 1 ) then ltCount := ltCount + 1 |
|||
end for_n ; |
|||
valuesOk := true; |
|||
write( "The first 10 terms of the Hofstader Q sequence:" ); |
|||
for i := 1 until 10 do begin |
|||
writeon( i_w := 1, s_w := 0, " ", Q( i ) ); |
|||
if Q( i ) not = xQ( i ) then begin |
|||
writeon( i_w := 1, s_w := 0, "-EXPECTED-", xQ( i ) ); |
|||
valuesOk := false |
|||
end if_Q_i_ne_xQ_i |
|||
end for_i ; |
|||
write( i_w := 1, s_w := 0, "The 1000th term is: ", Q( 1000 ) ); |
|||
if Q( 1000 ) not = 502 then begin |
|||
writeon( "-EXPECTED-502" ); |
|||
valuesOk := false |
|||
end if_Q_100_ne_502 ; |
|||
if valuesOk then write( " (Computed values are as expected)" ) |
|||
else write( "Values NOT as expected" ); |
|||
write( i_w := 1, s_w := 0, "Q(n) < Q(n-1) ", ltCount," times for n up to ", MAX_Q ) |
|||
end |
|||
end.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
The first 10 terms of the Hofstader Q sequence: 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502 |
|||
(Computed values are as expected) |
|||
Q(n) < Q(n-1) 49798 times for n up to 100000 |
|||
</pre> |
|||
=={{header|APL}}== |
|||
<syntaxhighlight lang="apl">∇ Q_sequence;seq;size |
|||
size←100000 |
|||
seq←{⍵,+/⍵[(1+⍴⍵)-¯2↑⍵]}⍣(size-2)⊢1 1 |
|||
⎕←'The first 10 terms are:', seq[⍳10] |
|||
⎕←'The 1000th term is:', seq[1000] |
|||
⎕←(+/ 2>/seq),'terms were preceded by a larger term.' |
|||
∇</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502 |
|||
49798 terms were preceded by a larger term. |
|||
</pre> |
|||
=={{header|ARM Assembly}}== |
|||
<syntaxhighlight lang="text">.text |
|||
.global _start |
|||
_start: ldr r6,=qs @ R6 = base register for Q array |
|||
@@@ Write first 2 elements |
|||
mov r0,#1 @ Q(1) and Q(2) are 1 |
|||
strh r0,[r6,#4] |
|||
strh r0,[r6,#8] |
|||
@@@ Generate 100 thousand elements |
|||
mov r1,#0x86A0 |
|||
movt r1,#1 @ 0x186A0 = 100.000 |
|||
mov r0,#3 @ Starting at element 3 |
|||
1: sub r2,r0,#1 @ r2 = n-1 |
|||
ldr r2,[r6,r2,lsl#2] @ r2 = Q[r2] |
|||
sub r2,r0,r2 @ r2 = n-Q[r2] |
|||
ldr r2,[r6,r2,lsl#2] @ r2 = Q[r2] |
|||
sub r3,r0,#2 @ r3 = n-2 |
|||
ldr r3,[r6,r3,lsl#2] @ r3 = Q[r3] |
|||
sub r3,r0,r3 @ r3 = n-Q[r3] |
|||
ldr r3,[r6,r3,lsl#2] @ r3 = Q[r3] |
|||
add r2,r2,r3 @ r2 += r3 |
|||
str r2,[r6,r0,lsl#2] @ Q[n] = r2 |
|||
add r0,r0,#1 @ n++ |
|||
cmp r0,r1 |
|||
bls 1b @ If r0<=r1, generate next |
|||
@@@ Print first 10 elements |
|||
ldr r1,=f10m |
|||
bl pstr |
|||
mov r8,#1 @ Start at element 1 |
|||
1: ldr r0,[r6,r8,lsl#2] @ Grab current element |
|||
bl pnum @ Print it |
|||
ldr r1,=space @ Print a space |
|||
bl pstr |
|||
add r8,r8,#1 |
|||
cmp r8,#10 @ Keep going until 10 elements printed |
|||
bls 1b |
|||
ldr r1,=nl @ Print newline |
|||
bl pstr |
|||
@@@ Print 1000th element |
|||
ldr r1,=f1000m |
|||
bl pstr |
|||
mov r8,#1000 @ Grab 1000th element |
|||
ldr r0,[r6,r8,lsl#2] |
|||
bl pnum |
|||
ldr r1,=nl @ Print newline |
|||
bl pstr |
|||
@@@ Find how many times a member is less than its preceding term |
|||
mov r0,#0 @ counter |
|||
mov r1,#0x86A0 @ max element |
|||
movt r1,#1 |
|||
mov r2,#1 @ value of previous element |
|||
mov r3,#2 @ number of current element |
|||
2: ldr r4,[r6,r3,lsl#2] @ get value of current element |
|||
cmp r2,r4 @ if previous more than current |
|||
addhi r0,r0,#1 @ then increment counter |
|||
mov r2,r4 @ current el is now prevous el |
|||
add r3,r3,#1 @ increment element index |
|||
cmp r3,r1 @ are we there yet? |
|||
bls 2b @ if not, keep going |
|||
bl pnum @ otherwise, print the number |
|||
ldr r1,=ltermm @ and the corresponding message |
|||
bl pstr |
|||
mov r0,#0 @ and then exit |
|||
mov r7,#1 |
|||
swi #0 |
|||
@@@ Print a length-prefixed string (in r1) |
|||
pstr: push {r7,lr} @ Save syscall and link registers |
|||
mov r0,#1 @ 1 = stdout |
|||
ldrb r2,[r1],#1 @ Get length and advance r1 |
|||
mov r7,#4 @ Write |
|||
swi #0 |
|||
pop {r7,pc} |
|||
@@@ Print unsigned number in r0 using Linux |
|||
pnum: push {r7,lr} @ Save syscall and link registers |
|||
ldr r7,=qs @ May as well use R7 as buffer pointer |
|||
1: mov r1,#10 @ Div-mod by 10 |
|||
bl divmod |
|||
add r1,r1,#'0 @ This makes an ASCII digit |
|||
strb r1,[r7,#-1]! @ Store it in the buffer |
|||
tst r0,r0 @ Are there more digits? |
|||
bne 1b @ If so, calculate them |
|||
mov r0,#1 @ 1 = stdout |
|||
mov r1,r7 @ Start of number in R1 |
|||
ldr r2,=qs @ Calculate length |
|||
sub r2,r2,r1 |
|||
mov r7,#4 @ 4 = write |
|||
swi #0 |
|||
pop {r7,pc} |
|||
@@@ Division routine: r0=r0/r1, r1=r0%r1 |
|||
divmod: mov r2,#0 @ R2 = counter |
|||
1: cmp r1,r0 @ Double R1 until R1>R0 |
|||
lslls r1,r1,#1 |
|||
addls r2,r2,#1 |
|||
bls 1b |
|||
mov r3,#0 |
|||
2: lsl r3,r3,#1 |
|||
subs r0,r0,r1 @ Trial subtraction |
|||
addhs r3,r3,#1 @ If it worked, mark |
|||
addlo r0,r0,r1 @ If it didn't, undo |
|||
lsr r1,r1,#1 @ Halve R1 |
|||
subs r2,r2,#1 @ Decrement counter |
|||
bhs 2b @ Keep going until zero |
|||
mov r1,r0 @ R1 = modulus |
|||
mov r0,r3 @ R0 = quotient |
|||
bx lr |
|||
.data |
|||
space: .ascii "\x1 " |
|||
nl: .ascii "\x1\n" |
|||
f10m: .ascii "\x18The first 10 terms are: " |
|||
f1000m: .ascii "\x14The 1000th term is: " |
|||
ltermm: .ascii "' terms were preceded by a larger term.\n" |
|||
.bss |
|||
.align 4 |
|||
.space 8 @ Buffer for number output |
|||
qs: .space 4 * 100001 @ One word per term</syntaxhighlight> |
|||
{{out}} |
|||
<pre>The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502 |
|||
49798 terms were preceded by a larger term.</pre> |
|||
=={{header|Arturo}}== |
|||
<syntaxhighlight lang="rebol">q: new [1 1] |
|||
n: 2 |
|||
while [n<1001][ |
|||
'q ++ (get q n-q\[n-1]) + get q n-q\[n-2] |
|||
n: n+1 |
|||
] |
|||
print ["First ten items:" first.n: 10 q] |
|||
print ["1000th item:" q\[999]]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>First ten items: [1 1 2 3 3 4 5 5 6 6] |
|||
1000th item: 502</pre> |
|||
=={{header|AutoHotkey}}== |
=={{header|AutoHotkey}}== |
||
< |
<syntaxhighlight lang="autohotkey">SetBatchLines, -1 |
||
Q := HofsQSeq(100000) |
Q := HofsQSeq(100000) |
||
Line 136: | Line 697: | ||
} |
} |
||
return Q |
return Q |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
|||
'''Output:''' |
|||
<pre>First ten: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6, |
<pre>First ten: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6, |
||
1000th: 502 |
1000th: 502 |
||
Line 143: | Line 704: | ||
=={{header|AWK}}== |
=={{header|AWK}}== |
||
< |
<syntaxhighlight lang="awk">#!/usr/bin/awk -f |
||
BEGIN { |
BEGIN { |
||
N = 100000 |
N = 100000 |
||
Line 164: | Line 725: | ||
} |
} |
||
return seq |
return seq |
||
} </ |
} </syntaxhighlight> |
||
<pre>Q-sequence(1..10) : 1 1 2 3 3 4 5 5 6 6 |
<pre>Q-sequence(1..10) : 1 1 2 3 3 4 5 5 6 6 |
||
Line 170: | Line 731: | ||
number of Q(n)<Q(n+1) for n<=100000 : 49798</pre> |
number of Q(n)<Q(n+1) for n<=100000 : 49798</pre> |
||
=={{header| |
=={{header|BASIC}}== |
||
==={{header|BASIC256}}=== |
|||
<lang bbcbasic> PRINT "First 10 terms of Q = " ; |
|||
{{trans|FreeBASIC}} |
|||
<syntaxhighlight lang="basic256"> |
|||
limite = 100000 |
|||
dim Q[limite+1] |
|||
cont = 0 |
|||
Q[1] = 1 |
|||
Q[2] = 1 |
|||
for i = 3 to limite |
|||
Q[i] = Q[i-Q[i-1]] + Q[i-Q[i-2]] |
|||
if Q[i] < Q[i-1] then cont += 1 |
|||
next i |
|||
print "Primeros 10 términos: "; |
|||
for i = 1 to 10 |
|||
print Q[i] + " "; |
|||
next i |
|||
print "Término número 1000: "; Q[1000] |
|||
print "Términos menores que los anteriores: "; cont |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Igual que la entrada de FreeBASIC. |
|||
</pre> |
|||
==={{header|BBC BASIC}}=== |
|||
<syntaxhighlight lang="bbcbasic"> PRINT "First 10 terms of Q = " ; |
|||
FOR i% = 1 TO 10 : PRINT ;FNq(i%, c%) " "; : NEXT : PRINT |
FOR i% = 1 TO 10 : PRINT ;FNq(i%, c%) " "; : NEXT : PRINT |
||
PRINT "1000th term = " ; FNq(1000, c%) |
PRINT "1000th term = " ; FNq(1000, c%) |
||
Line 188: | Line 776: | ||
IF q%(i%) < q%(i%-1) THEN c% += 1 |
IF q%(i%) < q%(i%-1) THEN c% += 1 |
||
NEXT |
NEXT |
||
= q%(n%)</ |
= q%(n%)</syntaxhighlight> |
||
{{out}} |
|||
'''Output:''' |
|||
<pre> |
<pre> |
||
First 10 terms of Q = 1 1 2 3 3 4 5 5 6 6 |
First 10 terms of Q = 1 1 2 3 3 4 5 5 6 6 |
||
Line 196: | Line 784: | ||
Term is less than preceding term 49798 times |
Term is less than preceding term 49798 times |
||
</pre> |
</pre> |
||
==={{header|QBasic}}=== |
|||
{{works with|QBasic|1.1}} |
|||
{{works with|QuickBasic|4.5}} |
|||
<syntaxhighlight lang="qbasic">CONST limite = 10000 |
|||
DIM Q(limite) |
|||
Q(1) = 1 |
|||
Q(2) = 1 |
|||
cont = 0 |
|||
FOR i = 3 TO limite |
|||
Q(i) = Q(i - Q(i - 1)) + Q(i - Q(i - 2)) |
|||
IF Q(i) < Q(i-1) THEN cont = cont + 1 |
|||
NEXT i |
|||
PRINT "First 10 terms: "; |
|||
FOR i = 1 TO 10 |
|||
PRINT Q(i); " "; |
|||
NEXT i |
|||
PRINT |
|||
PRINT "Term 1000: "; Q(1000) |
|||
PRINT "Terms less than preceding in first 100k: "; cont</syntaxhighlight> |
|||
==={{header|True BASIC}}=== |
|||
<syntaxhighlight lang="qbasic">LET limite = 100000 |
|||
DIM q(0) |
|||
MAT REDIM q(limite) |
|||
LET q(1) = 1 |
|||
LET q(2) = 1 |
|||
LET count = 0 |
|||
FOR i = 3 TO limite |
|||
LET q(i) = q(i-q(i-1))+q(i-q(i-2)) |
|||
IF q(i) < q(i-1) THEN |
|||
LET count = count + 1 |
|||
END IF |
|||
NEXT i |
|||
PRINT "First 10 terms: "; |
|||
FOR i = 1 TO 10 |
|||
PRINT q(i); |
|||
NEXT i |
|||
PRINT |
|||
PRINT "Term 1000: "; q(1000) |
|||
PRINT "Terms less than preceding in first 100k: "; count |
|||
END</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Same as FreeBASIC entry.</pre> |
|||
==={{header|XBasic}}=== |
|||
{{works with|Windows XBasic}} |
|||
<syntaxhighlight lang="qbasic">PROGRAM "Hofstadter Q sequence" |
|||
VERSION "0.0000" |
|||
DECLARE FUNCTION Entry () |
|||
FUNCTION Entry () |
|||
limite = 1e5 |
|||
DIM q[limite] |
|||
q[1] = 1 |
|||
q[2] = 1 |
|||
count = 0 |
|||
FOR i = 3 TO limite |
|||
q[i] = q[i-q[i-1]] + q[i-q[i-2]] |
|||
IF q[i] < q[i-1] THEN |
|||
INC count |
|||
END IF |
|||
NEXT i |
|||
PRINT "First 10 terms: "; |
|||
FOR i = 1 TO 10 |
|||
PRINT q[i]; |
|||
NEXT i |
|||
PRINT "\nTerm 1000: "; q[1000] |
|||
PRINT "Terms less than preceding in first 100k: "; count |
|||
END FUNCTION |
|||
END PROGRAM |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Same as FreeBASIC entry.</pre> |
|||
==={{header|Yabasic}}=== |
|||
<syntaxhighlight lang="basic">limite = 1e5 |
|||
dim q(limite) |
|||
q(1) = 1 |
|||
q(2) = 1 |
|||
count = 0 |
|||
for i = 3 to limite |
|||
q(i) = q(i-q(i-1)) + q(i-q(i-2)) |
|||
if q(i) < q(i-1) count = count + 1 |
|||
next i |
|||
print "First 10 terms: "; |
|||
for i = 1 to 10 |
|||
print q(i), " "; |
|||
next i |
|||
print "\nTerm 1000: ", q(1000) |
|||
print "Terms less than preceding in first 100k: ", count |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Same as FreeBASIC entry.</pre> |
|||
=={{header|Bracmat}}== |
|||
<syntaxhighlight lang="bracmat">( 0:?memocells |
|||
& tbl$(memo,!memocells+1) { allocate array } |
|||
& ( Q |
|||
= |
|||
. !arg:(1|2)&1 |
|||
| !arg:>2 |
|||
& ( !arg:>!memocells:?memocells { Array is too small. } |
|||
& tbl$(memo,!memocells+1) { Let array grow to needed size. } |
|||
| { Array is not too small. } |
|||
) |
|||
& ( !(!arg$memo):>0 { Set index to !arg. Return value at index if > 0 } |
|||
| Q$(!arg+-1*Q$(!arg+-1))+Q$(!arg+-1*Q$(!arg+-2)) |
|||
: ?(!arg$?memo) { Set index to !arg. Store value just found. } |
|||
) |
|||
) |
|||
& 0:?i |
|||
& whl |
|||
' (1+!i:~>10:?i&put$(str$(Q$!i " "))) |
|||
& put$\n |
|||
& whl'(1+!i:~>1000:?i&Q$!i) |
|||
& out$(Q$1000) |
|||
& 0:?previous:?lessThan:?i |
|||
& whl |
|||
' ( 1+!i:~>100000:?i |
|||
& Q$!i |
|||
: ( <!previous&1+!lessThan:?lessThan |
|||
| ? |
|||
) |
|||
: ?previous |
|||
) |
|||
& out$!lessThan |
|||
);</syntaxhighlight> |
|||
Output: |
|||
<pre>1 1 2 3 3 4 5 5 6 6 |
|||
502 |
|||
49798</pre> |
|||
=={{header|BCPL}}== |
|||
<syntaxhighlight lang="bcpl">get "libhdr" |
|||
let start() be |
|||
$( let Q = vec 1000 |
|||
Q!1 := 1 |
|||
Q!2 := 1 |
|||
for n = 3 to 1000 do |
|||
Q!n := Q!(n-Q!(n-1)) + Q!(n-Q!(n-2)) |
|||
writes("The first 10 terms are:") |
|||
for n = 1 to 10 do writef(" %N", Q!n) |
|||
writef("*NThe 1000th term is: %N*N", Q!1000) |
|||
$)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502</pre> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
< |
<syntaxhighlight lang="c">#include <stdio.h> |
||
#include <stdlib.h> |
#include <stdlib.h> |
||
Line 221: | Line 976: | ||
printf("flips: %d\n", flip); |
printf("flips: %d\n", flip); |
||
return 0; |
return 0; |
||
}</syntaxhighlight> |
|||
}</lang>'''Output:''' |
|||
{{out}} |
|||
<pre>1 1 2 3 3 4 5 5 6 6 |
<pre>1 1 2 3 3 4 5 5 6 6 |
||
502 |
502 |
||
flips: 49798 |
flips: 49798 |
||
</pre> |
|||
=={{header|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: |
|||
<pre>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! |
|||
</pre> |
</pre> |
||
=={{header|C sharp}}== |
=={{header|C sharp}}== |
||
< |
<syntaxhighlight lang="c sharp">using System; |
||
using System.Collections.Generic; |
using System.Collections.Generic; |
||
Line 332: | Line 1,048: | ||
} |
} |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
|||
'''Output''' |
|||
<pre>Q(1) = 1 |
<pre>Q(1) = 1 |
||
Q(2) = 1 |
Q(2) = 1 |
||
Line 347: | Line 1,063: | ||
Q(1000) = 502 |
Q(1000) = 502 |
||
Number of times a member of the sequence was less than its preceding term: 49798.</pre> |
Number of times a member of the sequence was less than its preceding term: 49798.</pre> |
||
=={{header|C++}}== |
|||
solution modeled after Perl solution |
|||
<syntaxhighlight lang="cpp">#include <iostream> |
|||
int main() { |
|||
const int size = 100000; |
|||
int hofstadters[size] = { 1, 1 }; |
|||
for (int i = 3 ; i < size; 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: "; |
|||
for (int i = 0; i < 10; i++) |
|||
std::cout << hofstadters[ i ] << ' '; |
|||
std::cout << std::endl << "The 1000'th term is " << hofstadters[ 999 ] << " !" << std::endl; |
|||
int less_than_preceding = 0; |
|||
for (int i = 0; i < size - 1; i++) |
|||
if (hofstadters[ i + 1 ] < hofstadters[ i ]) |
|||
less_than_preceding++; |
|||
std::cout << "In array of size: " << size << ", "; |
|||
std::cout << less_than_preceding << " times a number was preceded by a greater number!" << std::endl; |
|||
return 0; |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>The first 10 numbers are: 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000'th term is 502 ! |
|||
In array of size: 100000, 49798 times a number was preceded by a greater number!</pre> |
|||
=={{header|Clojure}}== |
=={{header|Clojure}}== |
||
Line 352: | Line 1,096: | ||
The subsequences are vectors for efficient indexing. |
The subsequences are vectors for efficient indexing. |
||
''qfirst'' iterates ''qs'' so the nth iteration is Q{1..n]. |
''qfirst'' iterates ''qs'' so the nth iteration is Q{1..n]. |
||
< |
<syntaxhighlight lang="clojure">(defn qs [q] |
||
(let [n (count q)] |
(let [n (count q)] |
||
(condp = n |
(condp = n |
||
Line 364: | Line 1,108: | ||
(println "first 10:" (qfirst 10)) |
(println "first 10:" (qfirst 10)) |
||
(println "1000th:" (last (qfirst 1000))) |
(println "1000th:" (last (qfirst 1000))) |
||
(println "extra credit:" (->> (qfirst 100000) (partition 2 1) (filter #(apply > %)) count))</ |
(println "extra credit:" (->> (qfirst 100000) (partition 2 1) (filter #(apply > %)) count))</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<lang>first 10: [1 1 2 3 3 4 5 5 6 6] |
<syntaxhighlight lang="text">first 10: [1 1 2 3 3 4 5 5 6 6] |
||
1000th: 502 |
1000th: 502 |
||
extra credit: 49798</ |
extra credit: 49798</syntaxhighlight> |
||
=={{header|CLU}}== |
|||
<syntaxhighlight lang="clu">q_seq = proc (n: int) returns (sequence[int]) |
|||
q: array[int] := array[int]$[1,1] |
|||
for i: int in int$from_to(3,n) do |
|||
array[int]$addh(q, q[i-q[i-1]] + q[i-q[i-2]]) |
|||
end |
|||
return(sequence[int]$a2s(q)) |
|||
end q_seq |
|||
start_up = proc () |
|||
po: stream := stream$primary_output() |
|||
q: sequence[int] := q_seq(100000) |
|||
stream$puts(po, "First 10 terms:") |
|||
for i: int in int$from_to(1,10) do |
|||
stream$puts(po, " " || int$unparse(q[i])) |
|||
end |
|||
stream$puts(po, "\n1000th term: " || int$unparse(q[1000])) |
|||
flips: int := 0 |
|||
for i: int in int$from_to(2, sequence[int]$size(q)) do |
|||
if q[i-1]>q[i] then flips := flips + 1 end |
|||
end |
|||
stream$putl(po, "\nflips: " || int$unparse(flips)) |
|||
end start_up</syntaxhighlight> |
|||
{{out}} |
|||
<pre>First 10 terms: 1 1 2 3 3 4 5 5 6 6 |
|||
1000th term: 502 |
|||
flips: 49798</pre> |
|||
=={{header|CoffeeScript}}== |
|||
{{trans|JavaScript}} |
|||
<syntaxhighlight lang="coffeescript">hofstadterQ = do -> |
|||
memo = [ 1 ,1, 1] |
|||
Q = (n) -> |
|||
result = memo[n] |
|||
if typeof result != 'number' |
|||
result = memo[n] = Q(n - Q(n - 1)) + Q(n - Q(n - 2)) |
|||
result |
|||
# some results: |
|||
console.log 'Q(' + i + ') = ' + hofstadterQ(i) for i in [1..10] |
|||
console.log 'Q(1000) = ' + hofstadterQ(1000)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|COBOL}}== |
|||
<syntaxhighlight lang="cobol"> IDENTIFICATION DIVISION. |
|||
PROGRAM-ID. Q-SEQ. |
|||
DATA DIVISION. |
|||
WORKING-STORAGE SECTION. |
|||
01 SEQ. |
|||
02 Q PIC 9(3) OCCURS 1000 TIMES. |
|||
02 Q-TMP1 PIC 9(3). |
|||
02 Q-TMP2 PIC 9(3). |
|||
02 N PIC 9(4). |
|||
01 DISPLAYING. |
|||
02 ITEM PIC Z(3). |
|||
02 IX PIC Z(4). |
|||
PROCEDURE DIVISION. |
|||
MAIN-PROGRAM. |
|||
PERFORM GENERATE-SEQUENCE. |
|||
PERFORM SHOW-ITEM |
|||
VARYING N FROM 1 BY 1 |
|||
UNTIL N IS GREATER THAN 10. |
|||
SET N TO 1000. |
|||
PERFORM SHOW-ITEM. |
|||
STOP RUN. |
|||
GENERATE-SEQUENCE. |
|||
SET Q(1) TO 1. |
|||
SET Q(2) TO 1. |
|||
PERFORM GENERATE-ITEM |
|||
VARYING N FROM 3 BY 1 |
|||
UNTIL N IS GREATER THAN 1000. |
|||
GENERATE-ITEM. |
|||
COMPUTE Q-TMP1 = N - Q(N - 1). |
|||
COMPUTE Q-TMP2 = N - Q(N - 2). |
|||
COMPUTE Q(N) = Q(Q-TMP1) + Q(Q-TMP2). |
|||
SHOW-ITEM. |
|||
MOVE N TO IX. |
|||
MOVE Q(N) TO ITEM. |
|||
DISPLAY 'Q(' IX ') = ' ITEM.</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
< |
<syntaxhighlight lang="lisp">(defparameter *mm* (make-hash-table :test #'equal)) |
||
;;; generic memoization macro |
;;; generic memoization macro |
||
Line 397: | Line 1,253: | ||
(if (< next-q last-q) (incf c)) |
(if (< next-q last-q) (incf c)) |
||
(setf last-q next-q)) |
(setf last-q next-q)) |
||
finally (return c)))</ |
finally (return c)))</syntaxhighlight> |
||
{{out}} |
|||
<pre>First of Q: (1 1 2 3 3 4 5 5 6 6) |
|||
Q(1000): 502 |
Q(1000): 502 |
||
Bumps up to 100000: 49798</ |
Bumps up to 100000: 49798</pre> |
||
Although the above definition of <code>q</code> is more general, for this specific problem the following is faster:< |
Although the above definition of <code>q</code> is more general, for this specific problem the following is faster:<syntaxhighlight lang="lisp">(let ((cc (make-array 3 :element-type 'integer |
||
:initial-element 1 |
:initial-element 1 |
||
:adjustable t |
:adjustable t |
||
Line 412: | Line 1,270: | ||
(aref cc (- n (aref cc (- n 2))))) |
(aref cc (- n (aref cc (- n 2))))) |
||
cc)) |
cc)) |
||
(aref cc n)))</ |
(aref cc n)))</syntaxhighlight> |
||
=={{header|Cowgol}}== |
|||
<syntaxhighlight lang="cowgol">include "cowgol.coh"; |
|||
# Generate 1000 terms of the Q sequence |
|||
var Q: uint16[1001]; |
|||
Q[1] := 1; |
|||
Q[2] := 1; |
|||
var n: @indexof Q := 3; |
|||
while n <= 1000 loop |
|||
Q[n] := Q[n-Q[n-1]] + Q[n-Q[n-2]]; |
|||
n := n + 1; |
|||
end loop; |
|||
# Print first 10 terms |
|||
print("The first 10 terms are: "); |
|||
n := 1; |
|||
while n <= 10 loop |
|||
print_i16(Q[n]); |
|||
print_char(' '); |
|||
n := n + 1; |
|||
end loop; |
|||
print_nl(); |
|||
# Print 1000th term |
|||
print("The 1000th term is: "); |
|||
print_i16(Q[1000]); |
|||
print_nl();</syntaxhighlight> |
|||
{{out}} |
|||
<pre>The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502</pre> |
|||
=={{header|D}}== |
=={{header|D}}== |
||
< |
<syntaxhighlight lang="d">import std.stdio, std.algorithm, std.functional, std.range; |
||
int Q(in int n) nothrow |
int Q(in int n) nothrow |
||
Line 433: | Line 1,325: | ||
writefln("Q(i) is less than Q(i-1) for i [2..100_000] %d times.", |
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))); |
iota(2, 100_001).count!(i => Q(i) < Q(i - 1))); |
||
} |
|||
}</lang> |
|||
</syntaxhighlight> |
|||
Output: |
|||
{{out}} |
|||
<pre>Q(n) for n = [1..10] is: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
<pre>Q(n) for n = [1..10] is: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
||
Q(1000) = 502 |
Q(1000) = 502 |
||
Q(i) is less than Q(i-1) for i [2..100_000] 49798 times. |
Q(i) is less than Q(i-1) for i [2..100_000] 49798 times. |
||
</pre> |
|||
===Faster Version=== |
===Faster Version=== |
||
{{trans|Python}} |
{{trans|Python}} |
||
Same output. |
Same output. |
||
< |
<syntaxhighlight lang="d">import std.stdio, std.algorithm, std.range, std.array; |
||
uint Q(in int n) nothrow |
|||
struct Q { |
|||
in { |
|||
__gshared static Appender!(uint[]) s; |
|||
assert(n > 0); |
|||
} body { |
|||
__gshared static Appender!(int[]) s = [0, 1, 1]; |
|||
foreach (immutable i; s.data.length .. n + 1) |
|||
nothrow static this() { |
|||
s ~= [ |
s ~= s.data[i - s.data[i - 1]] + s.data[i - s.data[i - 2]]; |
||
return s.data[n]; |
|||
} |
|||
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]; |
|||
} |
|||
} |
} |
||
Line 466: | Line 1,354: | ||
writefln("Q(i) is less than Q(i-1) for i [2..100_000] %d times.", |
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))); |
iota(2, 100_001).count!(i => Q(i) < Q(i - 1))); |
||
} |
|||
}</lang> |
|||
</syntaxhighlight> |
|||
===Even Faster Version=== |
|||
This code is here to show that you don't have to use all fancy features of D. Straightforward simple code is often clearer, and faster. |
|||
<syntaxhighlight lang="d"> |
|||
import std.stdio; |
|||
int[100_000] Q; |
|||
void main() { |
|||
Q[0] = 1; |
|||
Q[1] = 1; |
|||
for (int i = 2; i < 100_000; i++) |
|||
{ |
|||
Q[i] = Q[i - Q[i - 1]] + Q[i - Q[i - 2]]; |
|||
} |
|||
write("Q(1..10) : "); |
|||
for (int i = 0; i < 10; i++) |
|||
{ |
|||
write(" ", Q[i]); |
|||
} |
|||
writeln; |
|||
write("Q(1000) : "); |
|||
writeln(Q[999]); |
|||
int lt = 0; |
|||
for (int i = 1; i < 100_000; i++) |
|||
{ |
|||
if( Q[i-1] > Q[i] ) lt++; |
|||
} |
|||
writefln("Q(i) is less than Q(i-1) for i [2..100_000] %d times.", lt); |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|Dart}}== |
=={{header|Dart}}== |
||
Naive version using only recursion (Q(1000) fails due to browser script runtime restrictions) |
Naive version using only recursion (Q(1000) fails due to browser script runtime restrictions) |
||
< |
<syntaxhighlight lang="dart">int Q(int n) => n>2 ? Q(n-Q(n-1))+Q(n-Q(n-2)) : 1; |
||
main() { |
main() { |
||
Line 477: | Line 1,403: | ||
} |
} |
||
print("Q(1000)=${Q(1000)}"); |
print("Q(1000)=${Q(1000)}"); |
||
}</ |
}</syntaxhighlight> |
||
Version featuring caching. |
Version featuring caching. |
||
< |
<syntaxhighlight lang="dart">class Q { |
||
Map<int,int> _table; |
Map<int,int> _table; |
||
Line 521: | Line 1,447: | ||
} |
} |
||
print("value is smaller than previous $count times"); |
print("value is smaller than previous $count times"); |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre>Q(1)=1 |
<pre>Q(1)=1 |
||
Q(2)=1 |
Q(2)=1 |
||
Line 537: | Line 1,463: | ||
If the maximum number is known, filling an array is probably the fastest solution. |
If the maximum number is known, filling an array is probably the fastest solution. |
||
< |
<syntaxhighlight lang="dart">main() { |
||
List<int> q=new List<int>(100001); |
List<int> q=new List<int>(100001); |
||
q[1]=q[2]=1; |
q[1]=q[2]=1; |
||
Line 553: | Line 1,479: | ||
print("Q(1000)=${q[1000]}"); |
print("Q(1000)=${q[1000]}"); |
||
print("value is smaller than previous $count times"); |
print("value is smaller than previous $count times"); |
||
}</ |
}</syntaxhighlight> |
||
=={{header|Draco}}== |
|||
<syntaxhighlight lang="draco">proc nonrec make_Q([*] word q) void: |
|||
word n; |
|||
q[1] := 1; |
|||
q[2] := 1; |
|||
for n from 3 upto dim(q,1)-1 do |
|||
q[n] := q[n-q[n-1]] + q[n-q[n-2]] |
|||
od |
|||
corp |
|||
proc nonrec main() void: |
|||
word MAX = 1000; |
|||
word i; |
|||
[MAX+1] word q; |
|||
make_Q(q); |
|||
write("The first 10 terms are:"); |
|||
for i from 1 upto 10 do write(" ", q[i]) od; |
|||
writeln(); |
|||
writeln("The 1000th term is: ", q[1000]) |
|||
corp</syntaxhighlight> |
|||
{{out}} |
|||
<pre>The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502</pre> |
|||
=={{header|EasyLang}}== |
|||
{{trans|Lua}} |
|||
<syntaxhighlight lang=text> |
|||
proc hofstadter limit . q[] . |
|||
q[] = [ 1 1 ] |
|||
for n = 3 to limit |
|||
q[] &= q[n - q[n - 1]] + q[n - q[n - 2]] |
|||
. |
|||
. |
|||
proc count . q[] cnt . |
|||
for i = 2 to len q[] |
|||
if q[i] < q[i - 1] |
|||
cnt += 1 |
|||
. |
|||
. |
|||
. |
|||
hofstadter 100000 hofq[] |
|||
for i = 1 to 10 |
|||
write hofq[i] & " " |
|||
. |
|||
print "" |
|||
print hofq[1000] |
|||
count hofq[] cnt |
|||
print cnt |
|||
</syntaxhighlight> |
|||
=={{header|EchoLisp}}== |
|||
<syntaxhighlight lang="scheme"> |
|||
(define RECURSE_BUMP 500) ;; minimum of chrome:500 safari:1000 firefox:2000 |
|||
;; count flips |
|||
(define (flips N) |
|||
(for/sum ((n (in-range 2 (1+ N)))) |
|||
#:when (< (Q n) (Q (1- n))) 1)) |
|||
(cache-size 120000) |
|||
(define (Q n) |
|||
;; prevent browser stack overflow at low-cost |
|||
(when (zero? (modulo n RECURSE_BUMP)) (for ((i (in-range 0 n RECURSE_BUMP ))) (Q i))) |
|||
(+ (Q (- n (Q (1- n)))) (Q (- n (Q (- n 2)))))) |
|||
(remember 'Q #(1 1 1)) ;; memoize and init |
|||
;; first call : check stack OK |
|||
(Q 100000) → 48157 |
|||
(for ((i 11)) (write (Q i))) |
|||
1 1 1 2 3 3 4 5 5 6 6 |
|||
(Q 1000) → 502 |
|||
(flips 100000) → 49798 |
|||
</syntaxhighlight> |
|||
=={{header|Eiffel}}== |
|||
<syntaxhighlight lang="eiffel"> |
|||
class |
|||
APPLICATION |
|||
create |
|||
make |
|||
feature |
|||
make |
|||
-- Test output of the feature hofstadter_q_sequence. |
|||
local |
|||
count, i: INTEGER |
|||
test: ARRAY [INTEGER] |
|||
do |
|||
io.put_string ("%NFirst ten numbers: %N") |
|||
test := hofstadter_q_sequence (10) |
|||
across |
|||
test as ar |
|||
loop |
|||
io.put_string (ar.item.out + "%T") |
|||
end |
|||
test := hofstadter_q_sequence (100000) |
|||
io.put_string ("1000th:%N") |
|||
io.put_integer (test [1000]) |
|||
io.put_string ("%NNumber of Flips:%N") |
|||
from |
|||
i := 2 |
|||
until |
|||
i > 100000 |
|||
loop |
|||
if test [i] < test [i - 1] then |
|||
count := count + 1 |
|||
end |
|||
i := i + 1 |
|||
end |
|||
io.put_integer (count) |
|||
end |
|||
hofstadter_q_sequence (lim: INTEGER): ARRAY [INTEGER] |
|||
-- Hofstadter Q Sequence up to 'lim'. |
|||
require |
|||
lim_positive: lim > 0 |
|||
local |
|||
q: ARRAY [INTEGER] |
|||
i: INTEGER |
|||
do |
|||
create Result.make_filled (1, 1, lim) |
|||
Result [1] := 1 |
|||
Result [2] := 1 |
|||
from |
|||
i := 3 |
|||
until |
|||
i > lim |
|||
loop |
|||
Result [i] := Result [i - Result [i - 1]] + Result [i - Result [i - 2]] |
|||
i := i + 1 |
|||
end |
|||
end |
|||
end |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
First ten numbers: |
|||
1 1 2 3 3 4 5 5 6 6 |
|||
1000th: |
|||
502 |
|||
Number of Flips: |
|||
49798 |
|||
</pre> |
|||
=={{header|Elixir}}== |
|||
{{trans|Erlang}} |
|||
changed collection (Erlang array => Map) |
|||
<syntaxhighlight lang="elixir">defmodule Hofstadter do |
|||
defp flip(v2, v1) when v1 > v2, do: 1 |
|||
defp flip(_v2, _v1), do: 0 |
|||
defp list_terms(max, n, acc), do: Enum.map_join(n..max, ", ", &acc[&1]) |
|||
defp hofstadter(n, n, acc, flips) do |
|||
IO.puts "The first ten terms are: #{list_terms(10, 1, acc)}" |
|||
IO.puts "The 1000'th term is #{acc[1000]}" |
|||
IO.puts "Number of flips: #{flips}" |
|||
end |
|||
defp hofstadter(max, n, acc, flips) do |
|||
qn1 = acc[n-1] |
|||
qn = acc[n - qn1] + acc[n - acc[n-2]] |
|||
hofstadter(max, n+1, Map.put(acc, n, qn), flips + flip(qn, qn1)) |
|||
end |
|||
def main(max \\ 100_000) do |
|||
acc = %{1 => 1, 2 => 1} |
|||
hofstadter(max+1, 3, acc, 0) |
|||
end |
|||
end |
|||
Hofstadter.main</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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 |
|||
</pre> |
|||
=={{header|Erlang}}== |
=={{header|Erlang}}== |
||
< |
<syntaxhighlight lang="erlang">%% @author Jan Willem Luiten <jwl@secondmove.com> |
||
%% Hofstadter Q Sequence for Rosetta Code |
%% Hofstadter Q Sequence for Rosetta Code |
||
Line 587: | Line 1,699: | ||
Acc = array:set(1, 1, Tmp), |
Acc = array:set(1, 1, Tmp), |
||
hofstadter(?MAX, 2, Acc, 0). |
hofstadter(?MAX, 2, Acc, 0). |
||
</syntaxhighlight> |
|||
</lang>'''Output:''' |
|||
{{out}} |
|||
<pre> |
<pre> |
||
The first ten terms are: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 |
The first ten terms are: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 |
||
Line 594: | Line 1,707: | ||
</pre> |
</pre> |
||
=={{header| |
=={{header|ERRE}}== |
||
{{output|ERRE}} |
|||
<lang fsharp>let memoize f = |
|||
<syntaxhighlight lang="erre"> |
|||
let cache = System.Collections.Generic.Dictionary<_,_>() |
|||
PROGRAM HOFSTADER_Q |
|||
fun x -> |
|||
match cache.TryGetValue(x) with |
|||
| (true, v) -> v |
|||
| (_, _) -> |
|||
let v = f x |
|||
cache.[x] <- v |
|||
v |
|||
! |
|||
let rec q = memoize (fun i -> |
|||
! for rosettacode.org |
|||
if i < 3I then 1I |
|||
! |
|||
else q (i - q (i - 1I)) + q (i - q(i - 2I))) |
|||
DIM Q%[10000] |
|||
printf "q(1 .. 10) ="; List.iter (q >> (printf " %A")) [1I .. 10I] |
|||
printfn "" |
|||
PROCEDURE QSEQUENCE(Q,FLAG%->SEQ$) |
|||
printfn "q(1000) = %A" (q 1000I) |
|||
! if FLAG% is true accumulate sequence in SEQ$ |
|||
printfn "descents(100000) = %A" (Seq.sum (Seq.init 100000 (fun i -> if q(bigint(i)) > q(bigint(i+1)) then 1 else 0)))</lang> |
|||
! (attention to string var lenght=255) |
|||
Output |
|||
! otherwise calculate values in Q%[] only |
|||
<pre>q(1 .. 10) = 1 1 2 3 3 4 5 5 6 6 |
|||
q(1000) = 502 |
|||
LOCAL N |
|||
descents(100000) = 49798</pre> |
|||
Q%[1]=1 |
|||
Q%[2]=1 |
|||
SEQ$="1 1" |
|||
IF NOT FLAG% THEN Q=NUM END IF |
|||
FOR N=3 TO Q DO |
|||
Q%[N]=Q%[N-Q%[N-1]]+Q%[N-Q%[N-2]] |
|||
IF FLAG% THEN SEQ$=SEQ$+STR$(Q%[N]) END IF |
|||
END FOR |
|||
END PROCEDURE |
|||
BEGIN |
|||
NUM=10000 |
|||
QSEQUENCE(10,TRUE->SEQ$) |
|||
PRINT("Q-sequence(1..10) : ";SEQ$) |
|||
QSEQUENCE(1000,FALSE->SEQ$) |
|||
PRINT("1000th number of Q sequence : ";Q%[1000]) |
|||
FOR N=2 TO NUM DO |
|||
IF Q%[N]<Q%[N-1] THEN NN+=1 END IF |
|||
END FOR |
|||
PRINT("Number of Q(n)<Q(n+1) for n<=10000 : ";NN) |
|||
END PROGRAM |
|||
</syntaxhighlight> |
|||
Note: The extra credit was limited to 10000 because memory addressable range is limited to 64K. |
|||
If you want to implement extra credit for 100,000 you must use external file for array Q%[]. |
|||
=={{header|Delphi}}== |
|||
{{works with|Delphi|6.0}} |
|||
{{libheader|SysUtils,StdCtrls}} |
|||
<syntaxhighlight lang="Delphi"> |
|||
type TIntArray = array of integer; |
|||
procedure FillHofstadterArray(var HA: TIntArray); |
|||
{Fill array with Hofstader numbers} |
|||
{Preset array size to the number of terms you want} |
|||
var I: integer; |
|||
begin |
|||
{Starting condition} |
|||
HA[1]:=1; HA[2]:=1; |
|||
{Fill array up to last item} |
|||
for I:=3 to High(HA) do HA[I]:=HA[I-HA[I-1]]+HA[I-HA[I-2]]; |
|||
end; |
|||
procedure ShowHofstadterNumbers(Memo: TMemo); |
|||
{Fill array with a } |
|||
var I, LessCount: integer; |
|||
var QArray: TIntArray; |
|||
begin |
|||
{Select the number of items we want} |
|||
SetLength(QArray,100000); |
|||
{Fill array} |
|||
FillHofstadterArray(QArray); |
|||
{Display first 10} |
|||
for I:=1 to 10 do Memo.Lines.Add(Format('%4d: %4d',[I,QArray[I]])); |
|||
Memo.Lines.Add(Format('%4d: %4d',[1000,QArray[1000]])); |
|||
{Count number the number of times Q(n)<Q(n-1)} |
|||
LessCount:=0; |
|||
for I:=1 to High(QArray) do |
|||
if QArray[I]>QArray[I-1] then Inc(LessCount); |
|||
Memo.Lines.Add('Count of Q(n)<Q(n-1) = '+IntToStr(LessCount)); |
|||
end; |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1: 1 |
|||
2: 1 |
|||
3: 2 |
|||
4: 3 |
|||
5: 3 |
|||
6: 4 |
|||
7: 5 |
|||
8: 5 |
|||
9: 6 |
|||
10: 6 |
|||
1000: 502 |
|||
Count of Q(n)<Q(n-1) = 49997 |
|||
</pre> |
|||
=={{header|F_Sharp|F#}}== |
|||
===The function=== |
|||
<syntaxhighlight lang="fsharp"> |
|||
// Populate an array with values of Hofstadter Q sequence. Nigel Galloway: August 26th., 2020 |
|||
let fQ N=let g=Array.length N in N.[0]<-1; N.[1]<-1;(for g in 2..g-1 do N.[g]<-N.[g-N.[g-1]]+N.[g-N.[g-2]]) |
|||
</syntaxhighlight> |
|||
===The Tasks=== |
|||
<syntaxhighlight lang="fsharp"> |
|||
let Q=Array.zeroCreate<int>10 in fQ Q; printfn "%A" Q |
|||
let Q=Array.zeroCreate<int>1000 in fQ Q; printfn "%d" (Array.last Q) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[|1; 1; 2; 3; 3; 4; 5; 5; 6; 6|] |
|||
502 |
|||
</pre> |
|||
===Extra Credit=== |
|||
<syntaxhighlight lang="fsharp"> |
|||
let Q=Array.zeroCreate<int>100000 in fQ Q; printfn "%d" (Q|>Seq.pairwise|>Seq.sumBy(fun(n,g)->if n>g then 1 else 0)) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
49798 |
|||
</pre> |
|||
;What is a large number? |
|||
<syntaxhighlight lang="fsharp"> |
|||
let Q=Array.zeroCreate<int>2500000000 in fQ Q; printfn "%d" (Array.last Q) |
|||
let Q=Array.zeroCreate<int>5000000000 in fQ Q; printfn "%d" (Array.last Q) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
121648520 (in 0m14.347s) |
|||
247777817 (in 0m37.757s) |
|||
</pre> |
|||
=={{header|Factor}}== |
=={{header|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 <code>{ 1 1 }</code> and show the first 10 and 999th (because the list is zero-indexed) elements. |
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 <code>{ 1 1 }</code> and show the first 10 and 999th (because the list is zero-indexed) elements. |
||
< |
<syntaxhighlight lang="factor">( scratchpad ) : next ( seq -- newseq ) |
||
dup 2 tail* over length [ swap - ] curry map |
dup 2 tail* over length [ swap - ] curry map |
||
[ dupd swap nth ] map 0 [ + ] reduce suffix ; |
[ dupd swap nth ] map 0 [ + ] reduce suffix ; |
||
Line 626: | Line 1,850: | ||
( scratchpad ) { 1 1 } 1000 [ next ] times dup 10 head . 999 swap nth . |
( scratchpad ) { 1 1 } 1000 [ next ] times dup 10 head . 999 swap nth . |
||
{ 1 1 2 3 3 4 5 5 6 6 } |
{ 1 1 2 3 3 4 5 5 6 6 } |
||
502</ |
502</syntaxhighlight> |
||
=={{header|Fermat}}== |
|||
<syntaxhighlight lang="text">Func Hq(n) = if n<2 then 1 else |
|||
Array qq[n+1]; |
|||
qq[1] := 1; |
|||
qq[2] := 1; |
|||
for i = 3, n do |
|||
qq[i]:=qq[i-qq[i-1]]+qq[i-qq[i-2]] |
|||
od; |
|||
Return(qq[n]); |
|||
fi; |
|||
. |
|||
for i=1 to 10 do !Hq(i);!' ' od; |
|||
Hq(1000)</syntaxhighlight> |
|||
{{out}}<pre> |
|||
1 1 2 3 3 4 5 5 6 6 |
|||
502</pre> |
|||
=={{header|Forth}}== |
|||
{{trans|C}} |
|||
<syntaxhighlight lang="forth">100000 constant N |
|||
: q ( n -- addr ) cells here + ; |
|||
: qinit |
|||
1 0 q ! |
|||
1 1 q ! |
|||
N 2 do |
|||
i i 1- q @ - q @ |
|||
i i 2 - q @ - q @ |
|||
+ i q ! |
|||
loop ; |
|||
: flips |
|||
." flips: " |
|||
0 N 1 do |
|||
i q @ i 1- q @ < if 1+ then |
|||
loop . cr ; |
|||
: qprint ( n -- ) |
|||
0 do i q @ . loop cr ; |
|||
qinit |
|||
10 qprint |
|||
999 q @ . cr |
|||
flips |
|||
bye</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 1 2 3 3 4 5 5 6 6 |
|||
502 |
|||
flips: 49798 |
|||
</pre> |
|||
=={{header|Fortran}}== |
|||
The latter-day function COUNT(''logical expression'') could easily be replaced by a simple test-and-count in the DO-loop preparing the array. One hopes that the compiler produces sensible code rather than creating an auxiliary array of boolean results then counting the ''true'' values. Rather more clunky is the need to employ odd structure for the input loop so as to handle possible bad input (text, rather than a valid number, for example) and who knows, end-of-file might happen also. |
|||
<syntaxhighlight lang="fortran"> |
|||
Calculate the Hofstadter Q-sequence, using a big array rather than recursion. |
|||
INTEGER ENUFF |
|||
PARAMETER (ENUFF = 100000) |
|||
INTEGER Q(ENUFF) !Lots of memory these days. |
|||
Q(1) = 1 !Initial values as per the definition. |
|||
Q(2) = 1 |
|||
Q(3:) = -123456789!This will surely cause trouble! |
|||
DO I = 3,ENUFF !For values beyond the second, |
|||
Q(I) = Q(I - Q(I - 1)) + Q(I - Q(I - 2)) !Reach back according to the last two values. |
|||
END DO |
|||
Cast forth results as per the specification. |
|||
WRITE (6,1) Q(1:10) !Should be 1 1 2 3 3 4 5 5 6 6... |
|||
1 FORMAT ("First ten values:",10I2) !Known to be one-digit numbers. |
|||
WRITE (6,*) "Q(1000) =",Q(1000) !Should be 502. |
|||
WRITE (6,3) ENUFF,COUNT(Q(2:ENUFF) < Q(1:ENUFF - 1)) !Please don't create a temporary array! |
|||
3 FORMAT ("Count of those elements 2:",I0, |
|||
1 " which are less than their predecessor: ",I0) !Should be 49798. |
|||
Curry favour by allowing enquiries. |
|||
10 WRITE (6,11) ENUFF |
|||
11 FORMAT ("Nominate an index (in 1:",I0,"): ",$) !Obviously, the $ says don't start a new line. |
|||
READ (5,*,END = 999, ERR = 999) I !Ask for a number, with precautions. |
|||
IF (I.GT.0 .AND. I.LE.ENUFF) THEN !A good number, but, within range? |
|||
WRITE (6,12) I,Q(I) !Yes. Reveal the requested value. |
|||
12 FORMAT ("Q(",I0,") = ",I0) !This should do. |
|||
GO TO 10 !And ask again. |
|||
END IF ! WHILE read(5,*) i & i > 0 & i < enuff DO write(6,*) "Q(",i,")=",Q(i); |
|||
Closedown. |
|||
999 WRITE (6,*) "Bye." |
|||
END |
|||
</syntaxhighlight> |
|||
Output: |
|||
<pre> |
|||
First ten values: 1 1 2 3 3 4 5 5 6 6 |
|||
Q(1000) = 502 |
|||
Count of those elements 2:100000 which are less than their predecessor: 49798 |
|||
Nominate an index (in 1:100000): 100000 |
|||
Q(100000) = 48157 |
|||
Nominate an index (in 1:100000): 0 |
|||
Bye. |
|||
</pre> |
|||
=={{header|FreeBASIC}}== |
|||
<syntaxhighlight lang="freebasic"> |
|||
Const limite = 100000 |
|||
Dim As Long Q(limite), i, cont = 0 |
|||
Q(1) = 1 |
|||
Q(2) = 1 |
|||
For i = 3 To limite |
|||
Q(i) = Q(i-Q(i-1)) + Q(i-Q(i-2)) |
|||
If Q(i) < Q(i-1) Then cont += 1 |
|||
Next i |
|||
Print "Primeros 10 terminos: "; |
|||
For i = 1 To 10 |
|||
Print Q(i) &" "; |
|||
Next i |
|||
Print |
|||
Print "Termino numero 1000: "; Q(1000) |
|||
Print "Terminos menores que los anteriores: " &cont |
|||
End |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Primeros 10 terminos: 1 1 2 3 3 4 5 5 6 6 |
|||
Termino numero 1000: 502 |
|||
Terminos menores que los anteriores: 49798 |
|||
</pre> |
|||
=={{header|Fōrmulæ}}== |
|||
{{FormulaeEntry|page=https://formulae.org/?script=examples/Hofstadter_Q_sequence}} |
|||
'''Solution''' |
|||
The following function calculate the given number of terms of the Hofstadter Q sequence: |
|||
[[File:Fōrmulæ - Hofstadter Q sequence 01.png]] |
|||
'''Case 1''' First 10 terms |
|||
[[File:Fōrmulæ - Hofstadter Q sequence 02.png]] |
|||
[[File:Fōrmulæ - Hofstadter Q sequence 03.png]] |
|||
'''Case 2''' Confirm and display that the 1000th term is 502 |
|||
[[File:Fōrmulæ - Hofstadter Q sequence 04.png]] |
|||
[[File:Fōrmulæ - Hofstadter Q sequence 05.png]] |
|||
'''Case 3''' 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,000th term. |
|||
[[File:Fōrmulæ - Hofstadter Q sequence 06.png]] |
|||
[[File:Fōrmulæ - Hofstadter Q sequence 07.png]] |
|||
=={{header|Go}}== |
=={{header|Go}}== |
||
Sure there are ways that run faster or handle larger numbers; for the task though, maps and recursion work just fine. |
Sure there are ways that run faster or handle larger numbers; for the task though, maps and recursion work just fine. |
||
< |
<syntaxhighlight lang="go">package main |
||
import "fmt" |
import "fmt" |
||
Line 675: | Line 2,060: | ||
func showQ(n int) { |
func showQ(n int) { |
||
fmt.Printf("Q(%d) = %d\n", n, q(n)) |
fmt.Printf("Q(%d) = %d\n", n, q(n)) |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
Q(1) = 1 |
Q(1) = 1 |
||
Line 692: | Line 2,077: | ||
Q(1000000) = 512066 |
Q(1000000) = 512066 |
||
</pre> |
</pre> |
||
=={{header|GW-BASIC}}== |
|||
<syntaxhighlight lang="gwbasic">10 DIM Q!(1000) |
|||
20 Q(1) = 1: Q(2) = 1 |
|||
30 FOR N = 3 TO 1000 |
|||
40 Q(N) = Q(N - Q(N - 1)) + Q(N - Q(N - 2)) |
|||
50 NEXT N |
|||
60 FOR N = 1 TO 10 |
|||
70 PRINT Q(N) |
|||
80 NEXT N |
|||
90 PRINT Q(1000)</syntaxhighlight> |
|||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
Line 697: | Line 2,093: | ||
The basic task: |
The basic task: |
||
< |
<syntaxhighlight lang="haskell">qSequence = tail qq where |
||
qq = 0 : 1 : 1 : map g [3..] |
qq = 0 : 1 : 1 : map g [3..] |
||
g n = qq !! (n - qq !! (n-1)) + qq !! (n - qq !! (n-2)) |
g n = qq !! (n - qq !! (n-1)) + qq !! (n - qq !! (n-2)) |
||
Line 704: | Line 2,100: | ||
*Main> (take 10 qSequence, qSequence !! (1000-1)) |
*Main> (take 10 qSequence, qSequence !! (1000-1)) |
||
([1,1,2,3,3,4,5,5,6,6],502) |
([1,1,2,3,3,4,5,5,6,6],502) |
||
(0.00 secs, 525044 bytes)</ |
(0.00 secs, 525044 bytes)</syntaxhighlight> |
||
Extra credit task: |
Extra credit task: |
||
< |
<syntaxhighlight lang="haskell">import Data.Array |
||
qSequence n = arr |
qSequence n = arr |
||
Line 728: | Line 2,124: | ||
. _S (zipWith (-)) tail . take n . elems $ arr ) |
. _S (zipWith (-)) tail . take n . elems $ arr ) |
||
_S f g x = f x (g x)</ |
_S f g x = f x (g x)</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<syntaxhighlight lang="haskell">Prelude Main> qSeqTest 1000 100000 -- reversals in 100,000 |
|||
<lang Haskell>Prelude Main> qSeqTest 1000 100000 -- reversals in 100,000 |
|||
([1,1,2,3,3,4,5,5,6,6],502,49798) |
([1,1,2,3,3,4,5,5,6,6],502,49798) |
||
(0.09 secs, 18879708 bytes) |
(0.09 secs, 18879708 bytes) |
||
Line 738: | Line 2,133: | ||
Prelude Main> qSeqTest 1000000 100000 -- 1,000,000-th item |
Prelude Main> qSeqTest 1000000 100000 -- 1,000,000-th item |
||
([1,1,2,3,3,4,5,5,6,6],512066,49798) |
([1,1,2,3,3,4,5,5,6,6],512066,49798) |
||
(2.80 secs, 87559640 bytes)</ |
(2.80 secs, 87559640 bytes)</syntaxhighlight> |
||
Using a list (more or less) seemlessly backed up by a double resizing array: |
Using a list (more or less) seemlessly backed up by a double resizing array: |
||
<syntaxhighlight lang="haskell">q = qq (listArray (1,2) [1,1]) 1 where |
|||
<lang haskell>import Data.Array |
|||
qq ar n = (arr!n) : qq arr (n+1) where |
|||
l = snd (bounds ar) |
|||
q = qq (listArray (1,2) [1,1]) 1 where |
|||
step n =arr!(n - (fromIntegral (arr!(n - 1)))) + |
|||
arr!(n - (fromIntegral (arr!(n - 2)))) |
|||
l = snd (bounds ar) |
|||
arr :: Array Int Integer |
|||
step n =arr!(n - (fromIntegral (arr!(n - 1)))) + |
|||
arr | n <= l = ar |
|||
arr!(n - (fromIntegral (arr!(n - 2)))) |
|||
| otherwise = listArray (1, l*2)$ |
|||
arr :: Array Int Integer |
|||
([ar!i | i <- [1..l]] ++ |
|||
arr | n <= l = ar |
|||
[step i | i <- [l+1..l*2]]) |
|||
| otherwise = listArray (1, l*2)$ |
|||
([ar!i | i <- [1..l]] ++ |
|||
[step i | i <- [l+1..l*2]]) |
|||
main = do |
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))</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 767: | Line 2,160: | ||
List backed up by a list of arrays, with nominal constant lookup time. ''Somehow'' faster than the previous method. |
List backed up by a list of arrays, with nominal constant lookup time. ''Somehow'' faster than the previous method. |
||
< |
<syntaxhighlight lang="haskell">import Data.Array |
||
import Data.Int (Int64) |
import Data.Int (Int64) |
||
q = qq [listArray (1,2) [1,1]] 1 where |
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 |
-- Only a perf test. Task can be done exactly the same as above |
||
main = print $ sum qqq |
main = print $ sum qqq |
||
where |
|||
where qqq :: [Int64] |
|||
qqq :: [Int64] |
|||
qqq = map fromIntegral $ take 3000000 q</lang> |
|||
qqq = map fromIntegral $ take 3000000 q</syntaxhighlight> |
|||
=={{header|Icon}} and {{header|Unicon}}== |
=={{header|Icon}} and {{header|Unicon}}== |
||
< |
<syntaxhighlight lang="icon">link printf |
||
procedure main() |
procedure main() |
||
Line 827: | Line 2,221: | ||
runerr(500,n) |
runerr(500,n) |
||
} |
} |
||
end</ |
end</syntaxhighlight> |
||
{{libheader|Icon Programming Library}} |
{{libheader|Icon Programming Library}} |
||
[http://www.cs.arizona.edu/icon/library/src/procs/printf.icn printf.icn provides formatting] |
[http://www.cs.arizona.edu/icon/library/src/procs/printf.icn printf.icn provides formatting] |
||
{{out}} |
|||
Output:<pre>Q(1 to 10) - verified. |
|||
<pre>Q(1 to 10) - verified. |
|||
Q[1000]=502 - verified. |
Q[1000]=502 - verified. |
||
Q(16)=9 < Q(15)=10 |
Q(16)=9 < Q(15)=10 |
||
Line 844: | Line 2,239: | ||
There were 49798 inversions in Q up to 100000</pre> |
There were 49798 inversions in Q up to 100000</pre> |
||
=={{header|IS-BASIC}}== |
|||
<syntaxhighlight lang="is-basic">100 PROGRAM "QSequen.bas" |
|||
110 LET LIMIT=1000 |
|||
120 NUMERIC Q(1 TO LIMIT) |
|||
130 LET Q(1),Q(2)=1 |
|||
140 FOR I=3 TO LIMIT |
|||
150 LET Q(I)=Q(I-Q(I-1))+Q(I-Q(I-2)) |
|||
160 NEXT |
|||
170 PRINT "First 10 terms:" |
|||
180 FOR I=1 TO 10 |
|||
190 PRINT Q(I); |
|||
200 NEXT |
|||
210 PRINT :PRINT "Term 1000:";Q(1000)</syntaxhighlight> |
|||
=={{header|J}}== |
=={{header|J}}== |
||
'''Solution''' (''bottom-up''):< |
'''Solution''' (''bottom-up''):<syntaxhighlight lang="j"> Qs=:0 1 1 |
||
Q=: verb define |
Q=: verb define |
||
n=. >./,y |
n=. >./,y |
||
Line 853: | Line 2,261: | ||
end. |
end. |
||
y{Qs |
y{Qs |
||
)</ |
)</syntaxhighlight> |
||
'''Solution''' (''top-down''):< |
'''Solution''' (''top-down''):<syntaxhighlight lang="j"> Q=: 1:`(+&$:/@:- $:@-& 1 2)@.(>&2)"0 M.</syntaxhighlight> |
||
'''Example''':< |
'''Example''':<syntaxhighlight lang="j"> Q 1+i.10 |
||
1 1 2 3 3 4 5 5 6 6 |
1 1 2 3 3 4 5 5 6 6 |
||
Q 1000 |
Q 1000 |
||
502 |
502 |
||
+/2>/\ Q 1+i.100000 |
+/2>/\ Q 1+i.100000 |
||
49798</ |
49798</syntaxhighlight> |
||
'''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). |
'''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). We use the bottom up version for the extra credit part of this task (the expression which compares adjacent numbers and gave us the result 49798). |
||
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. |
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. |
||
Line 873: | Line 2,281: | ||
[[Category:Memoization]]{{works with|Java|1.5+}} |
[[Category:Memoization]]{{works with|Java|1.5+}} |
||
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. |
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. |
||
< |
<syntaxhighlight lang="java5">import java.util.HashMap; |
||
import java.util.Map; |
import java.util.Map; |
||
Line 918: | Line 2,326: | ||
System.out.println("Q(" + maxN + ") was called the most with " + maxUses + " calls"); |
System.out.println("Q(" + maxN + ") was called the most with " + maxUses + " calls"); |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre>Q(1) = 1 |
<pre>Q(1) = 1 |
||
Q(2) = 1 |
Q(2) = 1 |
||
Line 935: | Line 2,343: | ||
=={{header|JavaScript}}== |
=={{header|JavaScript}}== |
||
===ES5=== |
|||
Based on memoization example from 'JavaScript: The Good Parts'. |
Based on memoization example from 'JavaScript: The Good Parts'. |
||
< |
<syntaxhighlight lang="javascript">var hofstadterQ = function() { |
||
var memo = [1,1,1]; |
var memo = [1,1,1]; |
||
var Q = function (n) { |
var Q = function (n) { |
||
Line 954: | Line 2,363: | ||
console.log('Q(1000) = ' + hofstadterQ(1000)); |
console.log('Q(1000) = ' + hofstadterQ(1000)); |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
Q(1) = 1 |
Q(1) = 1 |
||
Line 968: | Line 2,377: | ||
Q(10) = 6 |
Q(10) = 6 |
||
Q(1000) = 502</pre> |
Q(1000) = 502</pre> |
||
===ES6=== |
|||
Memoising with the accumulator of a fold |
|||
<syntaxhighlight lang="javascript">(() => { |
|||
'use strict'; |
|||
// hofQSeq :: Int -> [Int] |
|||
const hofQSeq = x => |
|||
x > 2 ? tail(foldl((Q, n) => |
|||
n < 3 ? Q : Q.concat( |
|||
Q[n - Q[n - 1]] + Q[n - Q[n - 2]] |
|||
), [0, 1, 1], |
|||
range(1, x))) : (x > 0 ? take(x, [1, 1]) : undefined); |
|||
// GENERIC FUNCTIONS ------------------------------------------- |
|||
// foldl :: (b -> a -> b) -> b -> [a] -> b |
|||
const foldl = (f, a, xs) => xs.reduce(f, a), |
|||
// range :: Int -> Int -> [Int] |
|||
range = (m, n) => |
|||
Array.from({ |
|||
length: Math.floor(n - m) + 1 |
|||
}, (_, i) => m + i), |
|||
// tail :: [a] -> [a] |
|||
tail = xs => xs.length ? xs.slice(1) : undefined, |
|||
// last :: [a] -> a |
|||
last = xs => xs.length ? xs.slice(-1)[0] : undefined, |
|||
// Int -> [a] -> [a] |
|||
take = (n, xs) => xs.slice(0, n); |
|||
// TEST -------------------------------------------------------- |
|||
return { |
|||
firstTen: hofQSeq(10), |
|||
thousandth: last(hofQSeq(1000)), |
|||
'Q<Q-1UpTo10E5': hofQSeq(100000) |
|||
.reduce((a, x, i, xs) => x < xs[i - 1] ? a + 1 : a, 0) |
|||
}; |
|||
})();</syntaxhighlight> |
|||
{{Out}} |
|||
<syntaxhighlight lang="javascript">{"firstTen":[1, 1, 2, 3, 3, 4, 5, 5, 6, 6], |
|||
"thousandth":502, |
|||
"Q<Q-1UpTo10E5":49798}</syntaxhighlight> |
|||
=={{header|jq}}== |
=={{header|jq}}== |
||
For the tasks related to evaluating Q(n) directy, a recursive implementation is used, firstly because the task requirements refer to "recursion limits", and secondly to demonstrate one way to handle a cache in a functional language. To count the number of inversions, a non-recursive approach is used as it is faster and scales linearly. |
|||
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 |
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 |
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. |
n-th position of an array with index origin 0. |
||
<syntaxhighlight lang="jq"> |
|||
<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)) |
# For n>=2, Q(n) = Q(n - Q(n-1)) + Q(n - Q(n-2)) |
||
def Q: |
|||
def Q: . as $n | null | Q($n) | .[$n]; |
|||
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 ; |
|||
. as $n | null | Q($n) | .[$n]; |
|||
# count the number of times Q(i) > Q(i+1) for 0 < i < n |
# count the number of times Q(i) > Q(i+1) for 0 < i < n |
||
def flips(n): |
def flips(n): |
||
reduce range( |
(reduce range(3; n) as $n |
||
( |
([1,1,1]; . + [ .[$n - .[$n-1]] + .[$n - .[$n - 2 ]] ] )) as $q |
||
| reduce range(0; n) as $i |
|||
(0; . + (if $q[$i] > $q[$i + 1] then 1 else 0 end)) ; |
|||
| $r | Q($i + 1) as $s |
|||
# The three tasks: |
|||
| (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)"), |
((range(0;11), 1000) | "Q(\(.)) = \( . | Q)"), |
||
( |
(100000 | "flips(\(.)) = \(flips(.))")</syntaxhighlight> |
||
===Transcript=== |
===Transcript=== |
||
< |
<syntaxhighlight lang="bash"> |
||
$ uname -a |
$ 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 |
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 |
||
Line 1,035: | Line 2,481: | ||
flips(100000) = 49798 |
flips(100000) = 49798 |
||
real |
real 0m0.562s |
||
user |
user 0m0.541s |
||
sys |
sys 0m0.011s</syntaxhighlight> |
||
=={{header|Julia}}== |
=={{header|Julia}}== |
||
The following implementation accepts an argument that is a single integer, an array of integers, or a range: |
The following implementation accepts an argument that is a single integer, an array of integers, or a range: |
||
< |
<syntaxhighlight lang="julia">function hofstQseq(n, typerst::Type=Int) |
||
nmax = maximum(n) |
|||
r = Vector{typerst}(nmax) |
|||
r[1] = 1 |
|||
if nmax ≥ 2 r[2] = 1 end |
|||
for i = 3:N |
|||
for i in 3:nmax |
|||
q[i] = q[i - q[i-1]] + q[i - q[i-2]] |
|||
r[i] = r[i - r[i - 1]] + r[i - r[i - 2]] |
|||
end |
|||
end |
|||
return r[n] |
|||
end</lang> |
|||
end |
|||
println("First ten elements of sequence: ", join(hofstQseq(1:10), ", ")) |
|||
Output: |
|||
println("1000-th element: ", hofstQseq(1000)) |
|||
<lang julia>julia> Q(1:10) |
|||
</syntaxhighlight> |
|||
10-element Array{Int64,1}: |
|||
1 |
|||
{{out}} |
|||
1 |
|||
<pre>First ten elements of sequence: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 |
|||
2 |
|||
1000-th element: 502</pre> |
|||
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: |
And we can also count the number of times a value is less than its predecessor by, for example: |
||
<lang |
<syntaxhighlight lang="julia">seq = hofstQseq(1:100_000) |
||
cnt = count(diff(seq) .< 0) |
|||
49798</lang> |
|||
println("$cnt elements are less than the preceding one.")</syntaxhighlight> |
|||
{{out}} |
|||
<pre>49798 elements are less than the preceding one.</pre> |
|||
Since the implementation is non-recursive, there is no issue with recursion limits. |
Since the implementation is non-recursive, there is no issue with recursion limits. |
||
=={{header|Kotlin}}== |
|||
<syntaxhighlight lang="scala">// version 1.1.4 |
|||
fun main(args: Array<String>) { |
|||
val q = IntArray(100_001) |
|||
q[1] = 1 |
|||
q[2] = 1 |
|||
for (n in 3..100_000) q[n] = q[n - q[n - 1]] + q[n - q[n - 2]] |
|||
print("The first 10 terms are : ") |
|||
for (i in 1..10) print("${q[i]} ") |
|||
println("\n\nThe 1000th term is : ${q[1000]}") |
|||
val flips = (2..100_000).count { q[it] < q[it - 1] } |
|||
println("\nThe number of flips for the first 100,000 terms is : $flips") |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
The first 10 terms are : 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is : 502 |
|||
The number of flips for the first 100,000 terms is : 49798 |
|||
</pre> |
|||
=={{header|Lua}}== |
|||
Here, the whole sequence up to the 100,000th term is generated for the first task, so this is where we risk hitting the recursion limit. As it happens, we do not. The function is called using 'pcall' so that any error would be caught. By increasing the argument on line 19 from 1e5 to 1e8, we can cause LuaJIT to run out of memory, but that is not necessary for this task. |
|||
<syntaxhighlight lang="lua">function hofstadter (limit) |
|||
local Q = {1, 1} |
|||
for n = 3, limit do |
|||
Q[n] = Q[n - Q[n - 1]] + Q[n - Q[n - 2]] |
|||
end |
|||
return Q |
|||
end |
|||
function countDescents (t) |
|||
local count = 0 |
|||
for i = 2, #t do |
|||
if t[i] < t[i - 1] then |
|||
count = count + 1 |
|||
end |
|||
end |
|||
return count |
|||
end |
|||
local noError, hofSeq = pcall(hofstadter, 1e5) |
|||
if noError == false then |
|||
print("The sequence could not be calculated up to the specified limit.") |
|||
os.exit() |
|||
end |
|||
for i = 1, 10 do |
|||
io.write(hofSeq[i] .. " ") |
|||
end |
|||
print("\n" .. hofSeq[1000]) |
|||
print(countDescents(hofSeq))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1 1 2 3 3 4 5 5 6 6 |
|||
502 |
|||
49798</pre> |
|||
=={{header|MAD}}== |
|||
<syntaxhighlight lang="mad"> NORMAL MODE IS INTEGER |
|||
VECTOR VALUES FMT = $2HQ(,I4,3H) =,I4*$ |
|||
DIMENSION Q(1000) |
|||
Q(1) = 1 |
|||
Q(2) = 1 |
|||
THROUGH FILL, FOR N=3, 1, N.G.1000 |
|||
FILL Q(N) = Q(N-Q(N-1)) + Q(N-Q(N-2)) |
|||
THROUGH SHOW, FOR N=1, 1, N.G.10 |
|||
SHOW PRINT FORMAT FMT, N, Q(N) |
|||
PRINT FORMAT FMT, 1000, Q(1000) |
|||
END OF PROGRAM</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|Maple}}== |
=={{header|Maple}}== |
||
We use automatic memoisation ("option remember") in the following. The use of "option system" assures that memoised values can be garbage collected. |
We use automatic memoisation ("option remember") in the following. The use of "option system" assures that memoised values can be garbage collected. |
||
< |
<syntaxhighlight lang="maple">Q := proc( n ) |
||
option remember, system; |
option remember, system; |
||
if n = 1 or n = 2 then |
if n = 1 or n = 2 then |
||
Line 1,081: | Line 2,617: | ||
thisproc( n - thisproc( n - 1 ) ) + thisproc( n - thisproc( n - 2 ) ) |
thisproc( n - thisproc( n - 1 ) ) + thisproc( n - thisproc( n - 2 ) ) |
||
end if |
end if |
||
end proc:</ |
end proc:</syntaxhighlight> |
||
From this we get: |
From this we get: |
||
< |
<syntaxhighlight lang="maple">> seq( Q( i ), i = 1 .. 10 ); |
||
1, 1, 2, 3, 3, 4, 5, 5, 6, 6 |
1, 1, 2, 3, 3, 4, 5, 5, 6, 6 |
||
> Q( 1000 ); |
> Q( 1000 ); |
||
502</ |
502</syntaxhighlight> |
||
To determine the number of "flips", we proceed as follows. |
To determine the number of "flips", we proceed as follows. |
||
< |
<syntaxhighlight lang="maple">> flips := 0: |
||
> for i from 2 to 100000 do |
> for i from 2 to 100000 do |
||
> if L[ i ] < L[ i - 1 ] then |
> if L[ i ] < L[ i - 1 ] then |
||
Line 1,096: | Line 2,632: | ||
> end do: |
> end do: |
||
> flips; |
> flips; |
||
49798</ |
49798</syntaxhighlight> |
||
Alternatively, we can build the sequence in an array. |
Alternatively, we can build the sequence in an array. |
||
< |
<syntaxhighlight lang="maple">Qflips := proc( n ) |
||
local a := Array( 1 .. n ); |
local a := Array( 1 .. n ); |
||
a[ 1 ] := 1; |
a[ 1 ] := 1; |
||
Line 1,112: | Line 2,648: | ||
end do; |
end do; |
||
flips |
flips |
||
end proc:</ |
end proc:</syntaxhighlight> |
||
This gives the same result. |
This gives the same result. |
||
< |
<syntaxhighlight lang="maple">> Qflips( 10^5 ); |
||
49798</ |
49798</syntaxhighlight> |
||
=={{header|Mathematica}}== |
=={{header|Mathematica}} / {{header|Wolfram Language}}== |
||
< |
<syntaxhighlight lang="mathematica">Hofstadter[1] = Hofstadter[2] = 1; |
||
Hofstadter[n_Integer?Positive] := Hofstadter[n] = Block[{$RecursionLimit = Infinity}, |
Hofstadter[n_Integer?Positive] := Hofstadter[n] = Block[{$RecursionLimit = Infinity}, |
||
Hofstadter[n - Hofstadter[n - 1]] + Hofstadter[n - Hofstadter[n - 2]] |
Hofstadter[n - Hofstadter[n - 1]] + Hofstadter[n - Hofstadter[n - 2]] |
||
]</ |
]</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
< |
<syntaxhighlight lang="mathematica">Hofstadter /@ Range[10] |
||
{1,1,2,3,3,4,5,5,6,6} |
{1,1,2,3,3,4,5,5,6,6} |
||
Hofstadter[1000] |
Hofstadter[1000] |
||
502 |
502 |
||
Count[Differences[Hofstadter /@ Range[100000]], _?Negative] |
Count[Differences[Hofstadter /@ Range[100000]], _?Negative] |
||
49798</ |
49798</syntaxhighlight> |
||
=={{header|MATLAB}} / {{header|Octave}}== |
=={{header|MATLAB}} / {{header|Octave}}== |
||
This solution pre-allocates memory and is an iterative solution, so caching or recursion limits do not apply. |
This solution pre-allocates memory and is an iterative solution, so caching or recursion limits do not apply. |
||
< |
<syntaxhighlight 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 |
%% 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)]; |
Q = [1,1,zeros(1,N-2)]; |
||
Line 1,138: | Line 2,674: | ||
Q(n) = Q(n-Q(n-1))+Q(n-Q(n-2)); |
Q(n) = Q(n-Q(n-1))+Q(n-Q(n-2)); |
||
end; |
end; |
||
end; </ |
end; </syntaxhighlight> |
||
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 first ten terms of the sequence are: 1, 1, 2, 3, 3, 4, 5, 5, 6, and 6 |
||
<pre>>> Qsequence(10) |
<pre>>> Qsequence(10) |
||
Line 1,151: | Line 2,687: | ||
<pre>>> sum(diff(Qsequence(100000))<0) |
<pre>>> sum(diff(Qsequence(100000))<0) |
||
ans = 49798 |
ans = 49798 |
||
</pre> |
|||
=={{header|Maxima}}== |
|||
<syntaxhighlight lang="maxima"> |
|||
/* Function that return the terms of the Hofstadter Q sequence */ |
|||
hofstadter(n):=block( |
|||
if member(n,[1,2]) then L[n]:1 else L[n]:L[n-L[n-1]]+L[n-L[n-2]], |
|||
L[n])$ |
|||
/* Test cases */ |
|||
/* First ten terms */ |
|||
makelist(hofstadter(i),i,1,10); |
|||
/* 1000th term */ |
|||
last(makelist(hofstadter(i),i,1,1000)); |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[1,1,2,3,3,4,5,5,6,6] |
|||
502 |
|||
</pre> |
|||
=={{header|Modula-2}}== |
|||
<syntaxhighlight lang="modula2">MODULE QSequence; |
|||
FROM InOut IMPORT WriteString, WriteCard, WriteLn; |
|||
VAR n: CARDINAL; |
|||
Q: ARRAY [1..1000] OF CARDINAL; |
|||
BEGIN |
|||
Q[1] := 1; |
|||
Q[2] := 1; |
|||
FOR n := 3 TO 1000 DO |
|||
Q[n] := Q[n-Q[n-1]] + Q[n-Q[n-2]]; |
|||
END; |
|||
WriteString("The first 10 terms are:"); |
|||
FOR n := 1 TO 10 DO |
|||
WriteCard(Q[n],2); |
|||
END; |
|||
WriteLn(); |
|||
WriteString("The 1000th term is:"); |
|||
WriteCard(Q[1000],4); |
|||
WriteLn(); |
|||
END QSequence.</syntaxhighlight> |
|||
{{out}} |
|||
<pre>The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502</pre> |
|||
=={{header|MiniScript}}== |
|||
<syntaxhighlight lang="miniscript">cache = {1:1, 2:1} |
|||
Q = function(n) |
|||
if not cache.hasIndex(n) then |
|||
q = Q(n - Q(n-1)) + Q(n - Q(n-2)) |
|||
cache[n] = q |
|||
end if |
|||
return cache[n] |
|||
end function |
|||
for i in range(1,10) |
|||
print "Q(" + i + ") = " + Q(i) |
|||
end for |
|||
print "Q(1000) = " + Q(1000)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|Miranda}}== |
|||
<syntaxhighlight lang="miranda">main :: [sys_message] |
|||
main = [Stdout (lay (map showq ([1..10] ++ [1000])))] |
|||
where showq n = "q!" ++ show n ++ " = " ++ show (q!n) |
|||
q :: [num] |
|||
q = 0 : 1 : 1 : map f [3..] where f n = q!(n - q!(n-1)) + q!(n - q!(n-2))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|Nim}}== |
|||
<syntaxhighlight lang="nim">var q = @[1, 1] |
|||
for n in 2 ..< 100_000: q.add q[n-q[n-1]] + q[n-q[n-2]] |
|||
echo q[0..9] |
|||
assert q[0..9] == @[1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
|||
echo q[999] |
|||
assert q[999] == 502 |
|||
var lessCount = 0 |
|||
for n in 1 ..< 100_000: |
|||
if q[n] < q[n-1]: |
|||
inc lessCount |
|||
echo lessCount</syntaxhighlight> |
|||
{{out}} |
|||
<pre>@[1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
|||
502 |
|||
49798</pre> |
|||
=={{header|Oberon-2}}== |
|||
Works with oo2c version 2 |
|||
<syntaxhighlight lang="oberon2"> |
|||
MODULE Hofstadter; |
|||
IMPORT |
|||
Out; |
|||
VAR |
|||
i,count,q,prev: LONGINT; |
|||
founds: ARRAY 100001 OF LONGINT; |
|||
PROCEDURE Q(n: LONGINT): LONGINT; |
|||
BEGIN |
|||
IF founds[n] = 0 THEN |
|||
CASE n OF |
|||
1 .. 2: |
|||
founds[n] := 1 |
|||
ELSE founds[n] := Q(n - Q(n - 1)) + Q(n - Q(n - 2)) |
|||
END |
|||
END; |
|||
RETURN founds[n] |
|||
END Q; |
|||
BEGIN |
|||
(* first ten numbers in the sequence *) |
|||
FOR i := 1 TO 10 DO |
|||
Out.String("At ");Out.LongInt(i,0);Out.String(":> ");Out.LongInt(Q(i),4);Out.Ln |
|||
END; |
|||
Out.String("1000th value: ");Out.LongInt(Q(1000),4);Out.Ln; |
|||
prev := 1; |
|||
FOR i := 2 TO 100000 DO |
|||
q := Q(i); |
|||
IF q < prev THEN INC(count) END; |
|||
prev := q |
|||
END; |
|||
Out.String("terms less than the previous: ");Out.LongInt(count,4);Out.Ln |
|||
END Hofstadter. |
|||
</syntaxhighlight> |
|||
Output: |
|||
<pre> |
|||
At 1:> 1 |
|||
At 2:> 1 |
|||
At 3:> 2 |
|||
At 4:> 3 |
|||
At 5:> 3 |
|||
At 6:> 4 |
|||
At 7:> 5 |
|||
At 8:> 5 |
|||
At 9:> 6 |
|||
At 10:> 6 |
|||
1000th value: 502 |
|||
terms less than the previous: 49798 |
|||
</pre> |
|||
=={{header|OCaml}}== |
|||
<syntaxhighlight lang="ocaml">(* valid results for n in 0..119628 *) |
|||
let seq_hofstadter_q n = |
|||
let a = Bigarray.(Array1.create int16_unsigned c_layout n) in |
|||
let () = |
|||
for i = 0 to pred n do |
|||
a.{i} <- if i < 2 then 1 else a.{i - a.{pred i}} + a.{i - a.{i - 2}} |
|||
done |
|||
in |
|||
Seq.init n (Bigarray.Array1.get a) |
|||
let () = |
|||
let count_backflip (a, c) b = b, if b < a then succ c else c |
|||
and hq = seq_hofstadter_q 100_000 in |
|||
let () = Seq.(hq |> take 10 |> iter (Printf.printf " %u")) in |
|||
let () = Seq.(hq |> drop 999 |> take 1 |> iter (Printf.printf "\n%u\n")) in |
|||
hq |> Seq.fold_left count_backflip (0, 0) |> snd |> Printf.printf "%u\n"</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 1 2 3 3 4 5 5 6 6 |
|||
502 |
|||
49798 |
|||
</pre> |
|||
=={{header|Oforth}}== |
|||
<syntaxhighlight lang="oforth">: QSeqTask |
|||
| q i | |
|||
ListBuffer newSize(100000) dup add(1) dup add(1) ->q |
|||
0 3 100000 for: i [ |
|||
q add(q at(i q at(i 1-) -) q at(i q at(i 2 -) -) +) |
|||
q at(i) q at(i 1-) < ifTrue: [ 1+ ] |
|||
] |
|||
q left(10) println q at(1000) println println ; </syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
|||
502 |
|||
49798 |
|||
</pre> |
</pre> |
||
=={{header|PARI/GP}}== |
=={{header|PARI/GP}}== |
||
Straightforward, unoptimized version; about 1 ms. |
Straightforward, unoptimized version; about 1 ms. |
||
< |
<syntaxhighlight 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"); |
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("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)"));</ |
print("1000-th term: "Q[1000],if(Q[1000]==502," (as expected)"," (in error)"));</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre>First 10 terms: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] (as expected) |
<pre>First 10 terms: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] (as expected) |
||
1000-th term: 502 (as expected)</pre> |
1000-th term: 502 (as expected)</pre> |
||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
< |
<syntaxhighlight lang="pascal">Program HofstadterQSequence (output); |
||
const |
const |
||
Line 1,188: | Line 2,938: | ||
inc(flips); |
inc(flips); |
||
writeln('Flips: ', flips); |
writeln('Flips: ', flips); |
||
end.</ |
end.</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre>:> ./HofstadterQSequence |
<pre>:> ./HofstadterQSequence |
||
1 1 2 3 3 4 5 5 6 6 |
1 1 2 3 3 4 5 5 6 6 |
||
Line 1,197: | Line 2,947: | ||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
<lang Perl>#!/usr/bin/perl |
|||
<syntaxhighlight lang="perl">my @Q = (0,1,1); |
|||
push @Q, $Q[-$Q[-1]] + $Q[-$Q[-2]] for 1..100_000; |
|||
say "First 10 terms: [@Q[1..10]]"; |
|||
say "Term 1000: $Q[1000]"; |
|||
say "Terms less than preceding in first 100k: ",scalar(grep { $Q[$_] < $Q[$_-1] } 2..100000);</syntaxhighlight> |
|||
{{out}} |
|||
<pre>First 10 terms: [1 1 2 3 3 4 5 5 6 6] |
|||
Term 1000: 502 |
|||
Terms less than preceding in first 100k: 49798</pre> |
|||
A more verbose and less idiomatic solution: |
|||
<syntaxhighlight lang="perl">#!/usr/bin/perl |
|||
use warnings; |
use warnings; |
||
use strict; |
use strict; |
||
Line 1,218: | Line 2,980: | ||
print "Up to and including the 100000'th term, $less_than_preceding terms are less " . |
print "Up to and including the 100000'th term, $less_than_preceding terms are less " . |
||
"than their preceding terms!\n"; |
"than their preceding terms!\n"; |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
Output: |
|||
<pre>1 |
<pre>1 |
||
1 |
1 |
||
Line 1,234: | Line 2,996: | ||
</pre> |
</pre> |
||
This different 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. |
|||
< |
<syntaxhighlight lang="perl">#!perl |
||
use strict; |
use strict; |
||
use warnings; |
use warnings; |
||
Line 1,271: | Line 3,035: | ||
} |
} |
||
print "Extra credit: $count\n"; |
print "Extra credit: $count\n"; |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
1 1 2 3 3 4 5 5 6 6 |
1 1 2 3 3 4 5 5 6 6 |
||
Line 1,279: | Line 3,043: | ||
</pre> |
</pre> |
||
=={{header| |
=={{header|Phix}}== |
||
Just to be flash, I also (on the desktop only) calculated the 100 millionth term - the only limiting factor here is the length of Q |
|||
===OO solution=== |
|||
(theoretically 402,653,177 on 32 bit). |
|||
{{works with|Rakudo/JVM|2013-10-19}} |
|||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span> |
|||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">Q</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}</span> |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">q</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #004080;">integer</span> <span style="color: #000000;">l</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">Q</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">while</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">></span><span style="color: #000000;">l</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #000000;">l</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span> |
|||
<span style="color: #000000;">Q</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">Q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">l</span><span style="color: #0000FF;">-</span><span style="color: #000000;">Q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">l</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]]+</span><span style="color: #000000;">Q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">l</span><span style="color: #0000FF;">-</span><span style="color: #000000;">Q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">l</span><span style="color: #0000FF;">-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]]</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span> |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">Q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">n</span><span style="color: #0000FF;">]</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">q</span><span style="color: #0000FF;">(</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (or collect one by one)</span> |
|||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"First ten terms: %v\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">Q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">10</span><span style="color: #0000FF;">]})</span> |
|||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"1000th: %d\n"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1000</span><span style="color: #0000FF;">))</span> |
|||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"100,000th: %,d\n"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">q</span><span style="color: #0000FF;">(</span><span style="color: #000000;">100_000</span><span style="color: #0000FF;">))</span> |
|||
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #000000;">100_000</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #000000;">n</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">Q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]<</span><span style="color: #000000;">Q</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Flips up to 100,000: %,d\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">n</span><span style="color: #0000FF;">})</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()!=</span><span style="color: #004600;">JS</span> <span style="color: #008080;">then</span> |
|||
<span style="color: #004080;">atom</span> <span style="color: #000000;">t0</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">time</span><span style="color: #0000FF;">()</span> |
|||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"100,000,000th: %,d (%3.2fs)\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">q</span><span style="color: #0000FF;">(</span><span style="color: #000000;">100_000_000</span><span style="color: #0000FF;">),</span><span style="color: #7060A8;">time</span><span style="color: #0000FF;">()-</span><span style="color: #000000;">t0</span><span style="color: #0000FF;">})</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<!--</syntaxhighlight>--> |
|||
{{out}} |
|||
<pre> |
|||
First ten terms: {1,1,2,3,3,4,5,5,6,6} |
|||
1000th: 502 |
|||
100,000th: 48,157 |
|||
Flips up to 100,000: 49,798 |
|||
100,000,000th: 50,166,508 (8.52s) |
|||
</pre> |
|||
The last line shows fine under pwa/p2js, but would take about 20s. |
|||
=={{header|Picat}}== |
|||
Similar concept as the perl5 solution, except that the cache is only filled on demand. |
|||
<syntaxhighlight lang="picat">go => |
|||
println([q(I) : I in 1..10]), |
|||
println(q1000=q(1000)), |
|||
Q = {q(I) : I in 1..100_000}, |
|||
println(flips=sum({1 : I in 2..100_000, Q[I-1] > Q[I]})), |
|||
nl. |
|||
table |
|||
<lang perl6>class Hofstadter { |
|||
q(1) = 1. |
|||
q(2) = 1. |
|||
method at_pos ($me: Int $i) { |
|||
q(N) = q(N-q(N-1)) + q(N-q(N-2)).</syntaxhighlight> |
|||
@!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> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre>[1,1,2,3,3,4,5,5,6,6] |
||
q1000 = 502 |
|||
flips = 49798</pre> |
|||
In the first 100_000 terms, 49798 terms are less than their preceding terms</pre> |
|||
===Idiomatic solution=== |
|||
{{works with|niecza|2012-09-08}} |
|||
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.) |
|||
=={{header|PicoLisp}}== |
=={{header|PicoLisp}}== |
||
< |
<syntaxhighlight lang="picolisp">(de q (N) |
||
(cache '(NIL) N |
(cache '(NIL) N |
||
(if (>= 2 N) |
(if (>= 2 N) |
||
Line 1,329: | Line 3,108: | ||
(+ |
(+ |
||
(q (- N (q (dec N)))) |
(q (- N (q (dec N)))) |
||
(q (- N (q (- N 2)))) ) ) ) )</ |
(q (- N (q (- N 2)))) ) ) ) )</syntaxhighlight> |
||
Test: |
Test: |
||
< |
<syntaxhighlight lang="picolisp">: (mapcar q (range 1 10)) |
||
-> (1 1 2 3 3 4 5 5 6 6) |
-> (1 1 2 3 3 4 5 5 6 6) |
||
Line 1,339: | Line 3,118: | ||
: (let L (mapcar q (range 1 100000)) |
: (let L (mapcar q (range 1 100000)) |
||
(cnt < (cdr L) L) ) |
(cnt < (cdr L) L) ) |
||
-> 49798</ |
-> 49798</syntaxhighlight> |
||
=={{header|PL/I}}== |
=={{header|PL/I}}== |
||
<syntaxhighlight lang="pl/i"> |
|||
<lang PL/I> |
|||
/* Hofstrader Q sequence for any "n". */ |
/* Hofstrader Q sequence for any "n". */ |
||
Line 1,363: | Line 3,142: | ||
end; |
end; |
||
end H; |
end H; |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
How many values do you want? : |
How many values do you want? : |
||
Line 1,390: | Line 3,169: | ||
n=1000 502 |
n=1000 502 |
||
</pre> |
</pre> |
||
{{out}} for n=100,000 |
|||
<pre> |
<pre> |
||
n=100000 48157 |
n=100000 48157 |
||
</pre> |
</pre> |
||
Bonus to produce the count of unordered values: |
Bonus to produce the count of unordered values: |
||
<lang> |
<syntaxhighlight lang="text"> |
||
declare tally fixed binary (31) initial (0); |
declare tally fixed binary (31) initial (0); |
||
Line 1,402: | Line 3,181: | ||
end; |
end; |
||
put skip data (tally); |
put skip data (tally); |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
n=100000 48157 |
n=100000 48157 |
||
TALLY= 49798; |
TALLY= 49798; |
||
</pre> |
</pre> |
||
=={{header|PL/M}}== |
|||
<syntaxhighlight lang="plm">100H: |
|||
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS; |
|||
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT; |
|||
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT; |
|||
PRINT$NUMBER: PROCEDURE (N); |
|||
DECLARE S (7) BYTE INITIAL ('..... $'); |
|||
DECLARE (N, P) ADDRESS, C BASED P BYTE; |
|||
P = .S(5); |
|||
DIGIT: |
|||
P = P - 1; |
|||
C = N MOD 10 + '0'; |
|||
N = N / 10; |
|||
IF N > 0 THEN GO TO DIGIT; |
|||
CALL PRINT(P); |
|||
END PRINT$NUMBER; |
|||
DECLARE Q (1001) ADDRESS; |
|||
DECLARE N ADDRESS; |
|||
Q(1)=1; |
|||
Q(2)=1; |
|||
DO N=3 TO LAST(Q); |
|||
Q(N) = Q(N-Q(N-1)) + Q(N-Q(N-2)); |
|||
END; |
|||
CALL PRINT(.'THE FIRST 10 TERMS ARE: $'); |
|||
DO N=1 TO 10; |
|||
CALL PRINT$NUMBER(Q(N)); |
|||
END; |
|||
CALL PRINT(.(13,10,'THE 1000TH TERM IS: $')); |
|||
CALL PRINT$NUMBER(Q(1000)); |
|||
CALL EXIT; |
|||
EOF</syntaxhighlight> |
|||
{{out}} |
|||
<pre>THE FIRST 10 TERMS ARE: 1 1 2 3 3 4 5 5 6 6 |
|||
THE 1000TH TERM IS: 502</pre> |
|||
=={{header|PureBasic}}== |
|||
<syntaxhighlight lang="purebasic">If Not OpenConsole("Hofstadter Q sequence") |
|||
End 1 |
|||
EndIf |
|||
#N = 100000 |
|||
Define i.i, flip.i = 0 |
|||
Dim q.i(#N) |
|||
q(1) = 1 |
|||
q(2) = 1 |
|||
For i = 3 To #N |
|||
q(i) = q(i - q(i - 1)) + q(i - q(i - 2)) |
|||
Next |
|||
For i = 1 To #N - 1 |
|||
flip + Bool(q(i) > q(i + 1)) |
|||
Next |
|||
Print(~"First ten:\t") |
|||
For i = 1 To 10 : Print(LSet(Str(q(i)), 3)) : Next |
|||
PrintN(~"\n1000th:\t\t" + Str(q(1000))) |
|||
PrintN(~"Flips:\t\t" + Str(flip)) |
|||
Input() |
|||
End</syntaxhighlight> |
|||
{{out}} |
|||
<pre>First ten: 1 1 2 3 3 4 5 5 6 6 |
|||
1000th: 502 |
|||
Flips: 49798</pre> |
|||
=={{header|Python}}== |
=={{header|Python}}== |
||
< |
<syntaxhighlight lang="python">def q(n): |
||
if n < 1 or type(n) != int: raise ValueError("n must be an int >= 1") |
if n < 1 or type(n) != int: raise ValueError("n must be an int >= 1") |
||
try: |
try: |
||
Line 1,425: | Line 3,272: | ||
print("Q(n) for n = [1..10] is:", ', '.join(str(i) for i in first10)) |
print("Q(n) for n = [1..10] is:", ', '.join(str(i) for i in first10)) |
||
assert q(1000) == 502, "Q(1000) value error" |
assert q(1000) == 502, "Q(1000) value error" |
||
print("Q(1000) =", q(1000))</ |
print("Q(1000) =", q(1000))</syntaxhighlight> |
||
;Extra credit: |
;Extra credit: |
||
Line 1,433: | Line 3,280: | ||
The following code is to be concatenated to the code above: |
The following code is to be concatenated to the code above: |
||
< |
<syntaxhighlight lang="python">from sys import getrecursionlimit |
||
def q1(n): |
def q1(n): |
||
Line 1,451: | Line 3,298: | ||
tmp = q1(100000) |
tmp = q1(100000) |
||
print("Q(i+1) < Q(i) for i [1..100000] is true %i times." % |
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:])))</ |
sum(k1 < k0 for k0, k1 in zip(q.seq[1:], q.seq[2:])))</syntaxhighlight> |
||
{{out|Combined output}} |
|||
<pre>Q(n) for n = [1..10] is: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 |
<pre>Q(n) for n = [1..10] is: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 |
||
Q(1000) = 502 |
Q(1000) = 502 |
||
Q(i+1) < Q(i) for i [1..10000] is true 49798 times.</pre> |
Q(i+1) < Q(i) for i [1..10000] is true 49798 times.</pre> |
||
===Alternative=== |
===Alternative=== |
||
< |
<syntaxhighlight lang="python">def q(n): |
||
l = len(q.seq) |
l = len(q.seq) |
||
while l <= n: |
while l <= n: |
||
Line 1,470: | Line 3,318: | ||
q(100000) |
q(100000) |
||
print("Q(i+1) < Q(i) for i [1..100000] is true %i times." % |
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)]))</ |
sum([q.seq[i] > q.seq[i + 1] for i in range(1, 100000)]))</syntaxhighlight> |
||
=={{header|Quackery}}== |
|||
<syntaxhighlight lang="quackery">[ 2dup swap size dup negate swap within |
|||
not if |
|||
[ drop size 1+ number$ |
|||
$ "Term " swap join |
|||
$ " of the Q sequence is not defined." |
|||
join message put bail ] |
|||
peek ] is qpeek ( [ n --> x ) |
|||
[ dup dup -1 qpeek negate qpeek |
|||
dip [ dup dup -2 qpeek negate qpeek ] |
|||
+ join ] is next-q ( [ --> [ ) |
|||
[ dup size 2 < iff |
|||
[ drop 0 ] done |
|||
0 swap behead swap |
|||
witheach |
|||
[ tuck > if [ dip 1+ ] ] |
|||
drop ] is drops ( [ --> n ) |
|||
0 backup |
|||
[ ' [ 1 1 ] |
|||
998 times next-q |
|||
dup |
|||
-1 split swap 10 split drop |
|||
witheach [ echo sp ] |
|||
say "... " |
|||
0 peek echo cr |
|||
99000 times next-q |
|||
drops echo |
|||
say " decreasing terms" ] |
|||
bailed if |
|||
[ message take cr echo$ cr ]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1 1 2 3 3 4 5 5 6 6 ... 502 |
|||
49798 decreasing terms</pre> |
|||
=={{header|R}}== |
|||
<syntaxhighlight lang="rsplus"> |
|||
cache <- vector("integer", 0) |
|||
cache[1] <- 1 |
|||
cache[2] <- 1 |
|||
Q <- function(n) { |
|||
if (is.na(cache[n])) { |
|||
value <- Q(n-Q(n-1)) + Q(n-Q(n-2)) |
|||
cache[n] <<- value |
|||
} |
|||
cache[n] |
|||
} |
|||
for (i in 1:1e5) { |
|||
Q(i) |
|||
} |
|||
for (i in 1:10) { |
|||
cat(Q(i)," ",sep = "") |
|||
} |
|||
cat("\n") |
|||
cat(Q(1000),"\n") |
|||
count <- 0 |
|||
for (i in 2:1e5) { |
|||
if (Q(i) < Q(i-1)) count <- count + 1 |
|||
} |
|||
cat(count,"terms is less than its preceding term\n") |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 1 2 3 3 4 5 5 6 6 |
|||
502 |
|||
49798 terms is less than its preceding term |
|||
</pre> |
|||
=={{header|Racket}}== |
=={{header|Racket}}== |
||
< |
<syntaxhighlight lang="racket"> |
||
#lang racket |
#lang racket |
||
Line 1,490: | Line 3,415: | ||
;; extra credit |
;; extra credit |
||
(for/sum ([i 100000]) (if (< (Q (add1 i)) (Q i)) 1 0)) |
(for/sum ([i 100000]) (if (< (Q (add1 i)) (Q i)) 1 0)) |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
Line 1,498: | Line 3,423: | ||
49798 |
49798 |
||
</pre> |
</pre> |
||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
===OO solution=== |
|||
{{Works with|rakudo|2016.03}} |
|||
Similar concept as the perl5 solution, except that the cache is only filled on demand. |
|||
<syntaxhighlight lang="raku" line>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]; |
|||
} |
|||
} |
|||
# Testing: |
|||
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";</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
===Idiomatic solution=== |
|||
{{Works with|rakudo|2015-11-22}} |
|||
With a lazily generated array, we automatically get caching. |
|||
<syntaxhighlight lang="raku" line>my @Q = 1, 1, -> $a, $b { |
|||
(state $n = 1)++; |
|||
@Q[$n - $a] + @Q[$n - $b] |
|||
} ... *; |
|||
# Testing: |
|||
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";</syntaxhighlight> |
|||
(Same output.) |
|||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
===non-recursive=== |
===non-recursive=== |
||
The REXX language doesn't allow expressions for stemmed array indices, so a temporary variable must be used. |
The REXX language doesn't allow expressions for stemmed array indices, so a temporary variable must be used. |
||
< |
<syntaxhighlight lang="rexx">/*REXX program generates the Hofstadter Q sequence for any specified N. */ |
||
parse arg a b c d . /*obtain optional arguments from the CL*/ |
|||
if a=='' | a=="," then a= 10 /*Not specified? Then use the default.*/ |
|||
call HofstadterQ 10 |
|||
if b=='' | b=="," then b= -1000 /* " " " " " " */ |
|||
if c=='' | c=="," then c= -100000 /* " " " " " " */ |
|||
call HofstadterQ -100000 |
|||
if d=='' | d=="," then d= -1000000 /* " " " " " " */ |
|||
@.= 1; ac= abs(c) /* [↑] negative #'s don't show values.*/ |
|||
call HofstadterQ a; say |
|||
end /*j*/ |
|||
call HofstadterQ b; say 'HofstadterQ ' commas(abs(b))th(b) " term is: " commas(result) |
|||
call HofstadterQ c; say |
|||
downs= 0; do j=2 for ac-1; jm= j - 1 |
|||
downs= downs + (@.j<@.jm) |
|||
end /*j*/ |
|||
say downs 'terms are less |
say commas(downs) ' HofstatdterQ terms are less then the previous term,' , |
||
' HofstatdterQ('commas(ac) || th(ac)") term is: " commas(@.ac) |
|||
call HofstadterQ d; ad= abs(d); say |
|||
/*──────────────────────────────────HofstadterQ subroutine──────────────*/ |
|||
say 'The ' commas(ad) || th(ad) ' HofstatdterQ term is: ' commas(@.ad) |
|||
HofstadterQ: procedure expose q.; arg x 1 ox /*get the # to gen through*/ |
|||
/* |
exit /*stick a fork in it, we're all done. */ |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
x=abs(x) /*use the absolute value for X. */ |
|||
HofstadterQ: procedure expose @.; parse arg x 1 ox /*get number to generate through.*/ |
|||
/* [↑] OX is the same as X. */ |
|||
do j=1 for x |
|||
x= abs(x); w= length( commas(x) ) /*use absolute value; get length.*/ |
|||
do j=1 for x /* [↓] use short─circuit IF test*/ |
|||
if j>2 then if @.j==1 then do; jm1= j - 1; jm2= j - 2 |
|||
one= j - @.jm1; two= j - @.jm2 |
|||
@.j= @.one + @.two |
|||
end |
|||
if ox>0 then say 'HofstadterQ('right(j, w)"): " right(@.j,max(w,length(@.j))) |
|||
return q.x /*return the Xth term to caller.*/</lang> |
|||
end /*j*/ |
|||
'''output''' |
|||
return @.x /*return the │X│th term to caller*/ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
commas: parse arg _; do ?=length(_)-3 to 1 by -3; _=insert(',', _, ?); end; return _ |
|||
th: procedure; #=abs(arg(1)); return word('th st nd rd',1+#//10*(#//100%10\==1)*(#//10<4))</syntaxhighlight> |
|||
{{out|output|text= when using the internal default inputs:}} |
|||
<pre> |
<pre> |
||
HofstadterQ( 1): 1 |
|||
1 1 |
|||
HofstadterQ( 2): 1 |
|||
2 1 |
|||
HofstadterQ( 3): 2 |
|||
3 2 |
|||
HofstadterQ( 4): 3 |
|||
4 3 |
|||
HofstadterQ( 5): 3 |
|||
5 3 |
|||
HofstadterQ( 6): 4 |
|||
6 4 |
|||
HofstadterQ( 7): 5 |
|||
7 5 |
|||
HofstadterQ( 8): 5 |
|||
8 5 |
|||
HofstadterQ( 9): 6 |
|||
9 6 |
|||
10 6 |
HofstadterQ(10): 6 |
||
HofstadterQ 1,000th term is: 502 |
|||
1000th value=502 |
|||
49,798 HofstatdterQ terms are less then the previous term, HofstatdterQ(100,000th) term is: 48,157 |
|||
The 1,000,000th HofstatdterQ term is: 512,066 |
|||
</pre> |
</pre> |
||
===non-recursive, simpler=== |
===non-recursive, simpler=== |
||
This REXX example is identical to the first version |
This REXX example is identical to the first version |
||
except that it uses a function to retrieve array elements which may have index expressions. |
|||
<lang rexx>/*REXX program to generate Hofstadter Q sequence for any N. */ |
|||
<syntaxhighlight lang="rexx">/*REXX program generates the Hofstadter Q sequence for any specified N. */ |
|||
q.=1 /*negative #s won't have values displayed.*/ |
|||
parse arg a b c d . /*obtain optional arguments from the CL*/ |
|||
call HofstadterQ 10 |
|||
if a=='' | a=="," then a= 10 /*Not specified? Then use the default.*/ |
|||
call HofstadterQ -1000; say; say '1000th value='result; say |
|||
if b=='' | b=="," then b= -1000 /* " " " " " " */ |
|||
call HofstadterQ -100000 |
|||
if c=='' | c=="," then c= -100000 /* " " " " " " */ |
|||
if d=='' | d=="," then d= -1000000 /* " " " " " " */ |
|||
@.= 1; ac= abs(c) /* [↑] negative #'s don't show values.*/ |
|||
call HofstadterQ a; say |
|||
call HofstadterQ b; say 'HofstadterQ ' commas(abs(b))th(b) " term is: " commas(result) |
|||
call HofstadterQ c; say |
|||
downs= 0; do j=2 for ac-1; jm= j - 1 |
|||
downs= downs + (@.j<@.jm) |
|||
end /*j*/ |
|||
say downs 'terms are less |
say commas(downs) ' HofstatdterQ terms are less then the previous term,' , |
||
' HofstatdterQ('commas(ac) || th(ac)") term is: " commas(@.ac) |
|||
call HofstadterQ d; ad= abs(d); say |
|||
/*──────────────────────────────────HofstadterQ subroutine──────────────*/ |
|||
say 'The ' commas(ad) || th(ad) ' HofstatdterQ term is: ' commas(@.ad) |
|||
HofstadterQ: procedure expose q.; arg x 1 ox /*get the # to gen through*/ |
|||
/* |
exit /*stick a fork in it, we're all done. */ |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
x=abs(x) /*use the absolute value for X. */ |
|||
HofstadterQ: procedure expose @.; parse arg x 1 ox /*get number to generate through.*/ |
|||
/* [↑] OX is the same as X. */ |
|||
do j=1 for x |
|||
x= abs(x); w= length( commas(x) ) /*use absolute value; get length.*/ |
|||
do j=1 for x |
|||
if j>2 then if @.j==1 then @.j= @(j - @(j-1)) + @(j - @(j-2)) |
|||
if ox>0 then say 'HofstadterQ('right(j, w)"): " right(@.j,max(w,length(@.j))) |
|||
return q.x /*return the Xth term to caller.*/ |
|||
end /*j*/ |
|||
/*──────────────────────────────────Q subroutine────────────────────────*/ |
|||
return @.x /*return the │X│th term to caller*/ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
'''output''' is identical to the first version. |
|||
@: parse arg ?; return @.? /*return value of @.? to invoker.*/ |
|||
<br><br> |
|||
th: procedure; #=abs(arg(1)); return word('th st nd rd',1+#//10*(#//100%10\==1)*(#//10<4)) |
|||
commas: parse arg _; do ?=length(_)-3 to 1 by -3; _=insert(',', _, ?); end; return _</syntaxhighlight> |
|||
{{out|output|text= is identical to the 1<sup>st</sup> REXX version.}} |
|||
Because of the additional subroutine (function) invokes, this REXX version is about half as fast as the 1<sup>st</sup> REXX version. |
|||
===recursive=== |
===recursive=== |
||
< |
<syntaxhighlight lang="rexx">/*REXX program generates the Hofstadter Q sequence for any specified N. */ |
||
parse arg a b c d . /*obtain optional arguments from the CL*/ |
|||
if a=='' | a=="," then a= 10 /*Not specified? Then use the default.*/ |
|||
call HofstadterQ 10 |
|||
if b=='' | b=="," then b= -1000 /* " " " " " " */ |
|||
if c=='' | c=="," then c= -100000 /* " " " " " " */ |
|||
call HofstadterQ -100000 |
|||
if d=='' | d=="," then d= -1000000 /* " " " " " " */ |
|||
@.= 0; @.1= 1; @.2= 1; ac= abs(c) /* [↑] negative #'s don't show values.*/ |
|||
call HofstadterQ a; say |
|||
end |
|||
call HofstadterQ b; say 'HofstadterQ ' commas(abs(b))th(b) " term is: " commas(result) |
|||
call HofstadterQ c; say |
|||
downs= 0; do j=2 for ac-1; jm= j - 1 |
|||
downs= downs + (@.j<@.jm) |
|||
end /*j*/ |
|||
say downs 'terms are less |
say commas(downs) ' HofstatdterQ terms are less then the previous term,' , |
||
' HofstatdterQ('commas(ac) || th(ac)") term is: " commas(@.ac) |
|||
call HofstadterQ d; ad= abs(d); say |
|||
/*──────────────────────────────────HofstadterQ subroutine──────────────*/ |
|||
say 'The ' commas(ad) || th(ad) ' HofstatdterQ term is: ' commas(@.ad) |
|||
HofstadterQ: procedure expose q.; arg x 1 ox /*get the # to gen through*/ |
|||
/* |
exit /*stick a fork in it, we're all done. */ |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
x=abs(x) /*use the absolute value for X. */ |
|||
HofstadterQ: procedure expose @.; parse arg x 1 ox /*get number to generate through.*/ |
|||
/* [↑] OX is the same as X. */ |
|||
do j=1 for x |
|||
x= abs(x); w= length( commas(x) ) /*use absolute value; get length.*/ |
|||
do j=1 for x |
|||
if @.j==0 then @.j= QR(j) /*Not defined? Then define it.*/ |
|||
if ox>0 then say 'HofstadterQ('right(j, w)"): " right(@.j,max(w,length(@.j))) |
|||
return q.x /*return the Xth term to caller.*/ |
|||
end /*j*/ |
|||
/*──────────────────────────────────QR subroutine───────────────────────*/ |
|||
return @.x /*return the │X│th term to caller*/ |
|||
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*/ |
|||
QR: procedure expose @.; parse arg n /*this QR function is recursive.*/ |
|||
if @.n==0 then @.n= QR(n-QR(n-1)) + QR(n-QR(n-2)) /*Not defined? Then define it.*/ |
|||
'''output''' is identical to the first version. |
|||
return @.n /*return the value to the invoker*/ |
|||
<br><br>The recursive version took over five times longer than the non-recursive version. |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
<br><br> |
|||
th: procedure; #=abs(arg(1)); return word('th st nd rd',1+#//10*(#//100%10\==1)*(#//10<4)) |
|||
commas: parse arg _; do ?=length(_)-3 to 1 by -3; _=insert(',', _, ?); end; return _</syntaxhighlight> |
|||
{{out|output|text= is identical to the 1<sup>st</sup> REXX version.}} |
|||
The recursive version is almost ten times slower than the (1<sup>st</sup>) non-recursive version.<br><br> |
|||
=={{header|Ring}}== |
|||
<syntaxhighlight lang="ring"> |
|||
n = 20 |
|||
aList = list(n) |
|||
aList[1] = 1 |
|||
aList[2] = 1 |
|||
for i = 1 to n |
|||
if i >= 3 aList[i] = ( aList[i - aList[i-1]] + aList[i - aList[i-2]] ) ok |
|||
if i <= 20 see "n = " + string(i) + " : "+ aList[i] + nl ok |
|||
next |
|||
</syntaxhighlight> |
|||
=={{header|RPL}}== |
|||
{{works with|Halcyon Calc|4.2.7}} |
|||
{| class="wikitable" |
|||
! RPL code |
|||
! Comment |
|||
|- |
|||
| |
|||
≪ |
|||
{ 1 1 } 3 |
|||
WHILE '''DUP''' 4 PICK ≤ '''REPEAT''' |
|||
DUP2 2 - GETI ROT ROT GET → n q2 q1 |
|||
≪ DUP n q1 - GET |
|||
OVER n q2 - GET + + |
|||
n 1 + SWAP |
|||
≫ |
|||
'''END''' DROP |
|||
≫ ''''HOFST'''' STO |
|||
| |
|||
'''HOFST''' ''( m -- { Q(1)..Q(m) } ) '' |
|||
initialize stack with Q1, Q2 and loop index n |
|||
loop |
|||
store n, Q(n-2) and Q(n-1) |
|||
get Q(n-Q(n-1)) |
|||
add Q(n-Q(n-2)) and add result to list |
|||
put back n+1 in stack |
|||
|} |
|||
{{in}} |
|||
<pre> |
|||
10 HOFST |
|||
1000 HOSFT DUP SIZE GET |
|||
</pre> |
|||
{{out}} |
|||
<pre> |
|||
2: { 1 1 2 3 3 4 5 5 6 6 } |
|||
1: 502 |
|||
</pre> |
|||
=={{header|Ruby}}== |
=={{header|Ruby}}== |
||
< |
<syntaxhighlight lang="ruby">@cache = [] |
||
def Q(n) |
def Q(n) |
||
if @cache[n].nil? |
if @cache[n].nil? |
||
Line 1,624: | Line 3,682: | ||
prev = q |
prev = q |
||
end |
end |
||
puts "number of times in the first 100,000 terms where Q(i)<Q(i-1): #{count}"</ |
puts "number of times in the first 100,000 terms where Q(i)<Q(i-1): #{count}"</syntaxhighlight> |
||
{{out}} |
|||
output |
|||
<pre>first 10 numbers in the sequence: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
<pre>first 10 numbers in the sequence: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
||
1000'th term: 502 |
1000'th term: 502 |
||
number of times in the first 100,000 terms where Q(i)<Q(i-1): 49798</pre> |
number of times in the first 100,000 terms where Q(i)<Q(i-1): 49798</pre> |
||
=={{header|Run BASIC}}== |
=={{header|Run BASIC}}== |
||
< |
<syntaxhighlight lang="runbasic">input "How many values do you want? :";n |
||
dim Q(n) |
dim Q(n) |
||
Q(1) = 1 |
Q(1) = 1 |
||
Line 1,642: | Line 3,699: | ||
if i > 20 then print "n=";using("####",i);using("####",Q(i)) |
if i > 20 then print "n=";using("####",i);using("####",Q(i)) |
||
end |
end |
||
</syntaxhighlight> |
|||
</lang><pre> |
|||
{{out}} |
|||
<pre> |
|||
How many values do you want? :?1000 |
How many values do you want? :?1000 |
||
n= 1 1 |
n= 1 1 |
||
Line 1,665: | Line 3,724: | ||
n= 20 12 |
n= 20 12 |
||
n=1000 502 |
n=1000 502 |
||
</pre> |
|||
=={{header|Rust}}== |
|||
Rust doesn't allow static Vec's (but there's lazy_static crate), thus memoization storage is allocated in <code>main</code>. |
|||
<syntaxhighlight lang="rust">fn hofq(q: &mut Vec<u32>, x : u32) -> u32 { |
|||
let cur_len=q.len()-1; |
|||
let i=x as usize; |
|||
if i>cur_len { |
|||
// extend storage |
|||
q.reserve(i+1); |
|||
for j in (cur_len+1)..(i+1) { |
|||
let qj=(q[j-q[j-1] as usize]+q[j-q[j-2] as usize]) as u32; |
|||
q.push(qj); |
|||
} |
|||
} |
|||
q[i] |
|||
} |
|||
fn main() { |
|||
let mut q_memo: Vec<u32>=vec![0,1,1]; |
|||
let mut q=|i| {hofq(&mut q_memo, i)}; |
|||
for i in 1..11 { |
|||
println!("Q({})={}", i, q(i)); |
|||
} |
|||
println!("Q(1000)={}", q(1000)); |
|||
let q100001=q(100_000); // precompute all |
|||
println!("Q(100000)={}", q100000); |
|||
let nless=(1..100_000).fold(0,|s,i|{if q(i+1)<q(i) {s+1} else {s}}); |
|||
println!("Term is less than preceding term {} times", nless); |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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(100001)=53471 |
|||
Term is less than preceding term 49798 times |
|||
</pre> |
</pre> |
||
=={{header|Scala}}== |
=={{header|Scala}}== |
||
{{works with|Scala|2.9.1}} |
{{works with|Scala|2.9.1}} |
||
Naive but elegant version using only recursion doesn't work |
Naive but elegant version using only recursion doesn't work |
||
because runtime is excessive increasing ... |
|||
<lang scala>object HofstadterQseq extends App { |
|||
<syntaxhighlight lang="scala">object HofstadterQseq extends App { |
|||
val Q: Int => Int = n => { |
val Q: Int => Int = n => { |
||
if (n <= 2) 1 |
if (n <= 2) 1 |
||
Line 1,677: | Line 3,785: | ||
(1 to 10).map(i=>(i,Q(i))).foreach(t=>println("Q("+t._1+") = "+t._2)) |
(1 to 10).map(i=>(i,Q(i))).foreach(t=>println("Q("+t._1+") = "+t._2)) |
||
println("Q("+1000+") = "+Q(1000)) |
println("Q("+1000+") = "+Q(1000)) |
||
}</ |
}</syntaxhighlight> |
||
Unfortunately the function Q isn't tail recursiv, |
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. |
|||
< |
<syntaxhighlight lang="scala">object HofstadterQseq extends App { |
||
val HofQ = scala.collection.mutable.Map((1->1),(2->1)) |
val HofQ = scala.collection.mutable.Map((1->1),(2->1)) |
||
Line 1,700: | Line 3,810: | ||
println("Q("+1000+") = "+Q(1000)) |
println("Q("+1000+") = "+Q(1000)) |
||
println((3 to 100000).filter(i=>Q(i)<Q(i-1)).size) |
println((3 to 100000).filter(i=>Q(i)<Q(i-1)).size) |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
|||
<pre>Q(1) = 1 |
<pre>Q(1) = 1 |
||
Q(2) = 1 |
Q(2) = 1 |
||
Line 1,716: | Line 3,826: | ||
=={{header|Scheme}}== |
=={{header|Scheme}}== |
||
I wish there were a portable way to <code>define-syntax</code>, |
I wish there were a portable way to <code>define-syntax</code>, |
||
or to resize arrays, or to do formated output--anything to make the code |
|||
<lang lisp>(define qc '#(0 1 1)) |
|||
less silly looking while still run under more than one interpreter. |
|||
<syntaxhighlight lang="lisp">(define qc '#(0 1 1)) |
|||
(define filled 3) |
(define filled 3) |
||
(define len 3) |
(define len 3) |
||
Line 1,763: | Line 3,875: | ||
(if (>= i 100000) s |
(if (>= i 100000) s |
||
(loop (+ s (if (> (q i) (q (+ 1 i))) 1 0)) (+ 1 i))))) |
(loop (+ s (if (> (q i) (q (+ 1 i))) 1 0)) (+ 1 i))))) |
||
(newline)</syntaxhighlight> |
|||
(newline)</lang>output<lang>Q(1 .. 10): 1 1 2 3 3 4 5 5 6 6 |
|||
{{out}} |
|||
<pre>Q(1 .. 10): 1 1 2 3 3 4 5 5 6 6 |
|||
Q(1000): 502 |
Q(1000): 502 |
||
bumps up to 100000: 49798</ |
bumps up to 100000: 49798</pre> |
||
=={{header|Seed7}}== |
=={{header|Seed7}}== |
||
< |
<syntaxhighlight lang="seed7">$ include "seed7_05.s7i"; |
||
const type: intHash is hash [integer] integer; |
const type: intHash is hash [integer] integer; |
||
Line 1,805: | Line 3,919: | ||
end for; |
end for; |
||
writeln("q(n) < q(n-1) for n = 2 .. 100000: " <& less_than_preceding); |
writeln("q(n) < q(n-1) for n = 2 .. 100000: " <& less_than_preceding); |
||
end func;</ |
end func;</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
q(n) for n = 1 .. 10: |
q(n) for n = 1 .. 10: |
||
Line 1,813: | Line 3,927: | ||
q(1000)=502 |
q(1000)=502 |
||
q(n) < q(n-1) for n = 2 .. 100000: 49798 |
q(n) < q(n-1) for n = 2 .. 100000: 49798 |
||
</pre> |
|||
=={{header|SETL}}== |
|||
<syntaxhighlight lang="setl">program hofstadter_q; |
|||
q := [1,1]; |
|||
loop for n in [3..100000] do |
|||
q(n) := q(n-q(n-1)) + q(n-q(n-2)); |
|||
end loop; |
|||
print("First 10 terms: " + q(1..10)); |
|||
print("1000th term: " + q(1000)); |
|||
print("q(x) < q(x-1): " + #[x : x in [2..#q] | q(x) < q(x-1)]); |
|||
end program;</syntaxhighlight> |
|||
{{out}} |
|||
<pre>First 10 terms: [1 1 2 3 3 4 5 5 6 6] |
|||
1000th term: 502 |
|||
q(x) < q(x-1): 49798</pre> |
|||
=={{header|Sidef}}== |
|||
Using a memoized function: |
|||
<syntaxhighlight lang="ruby">func Q(n) is cached { |
|||
n <= 2 ? 1 |
|||
: Q(n - Q(n-1))+Q(n-Q(n-2)) |
|||
} |
|||
say "First 10 terms: #{ {|n| Q(n) }.map(1..10) }" |
|||
say "Term 1000: #{Q(1000)}" |
|||
say "Terms less than preceding in first 100k: #{2..100000->count{|i|Q(i)<Q(i-1)}}"</syntaxhighlight> |
|||
Using an array: |
|||
<syntaxhighlight lang="ruby">var Q = [0, 1, 1] |
|||
100_000.times { |
|||
Q << (Q[-Q[-1]] + Q[-Q[-2]]) |
|||
} |
|||
say "First 10 terms: #{Q.slice(1).first(10)}" |
|||
say "Term 1000: #{Q[1000]}" |
|||
say "Terms less than preceding in first 100k: #{2..100000->count{|i|Q[i]<Q[i-1]}}"</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
First 10 terms: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
|||
Term 1000: 502 |
|||
Terms less than preceding in first 100k: 49798 |
|||
</pre> |
|||
=={{header|Swift}}== |
|||
{{trans|C}} |
|||
<syntaxhighlight lang="swift">let n = 100000 |
|||
var q = Array(repeating: 0, count: n) |
|||
q[0] = 1 |
|||
q[1] = 1 |
|||
for i in 2..<n { |
|||
q[i] = q[i - q[i - 1]] + q[i - q[i - 2]] |
|||
} |
|||
print("First 10 elements of the sequence: \(q[0..<10])") |
|||
print("1000th element of the sequence: \(q[999])") |
|||
var count = 0 |
|||
for i in 1..<n { |
|||
if q[i] < q[i - 1] { |
|||
count += 1 |
|||
} |
|||
} |
|||
print("Number of times a member of the sequence is less than the preceding term for terms up to and including the 100,000th term: \(count)")</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
First 10 elements of the sequence: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
|||
1000th element of the sequence: 502 |
|||
Number of times a member of the sequence is less than the preceding term for terms up to and including the 100,000th term: 49798 |
|||
</pre> |
|||
=={{header|Tailspin}}== |
|||
<syntaxhighlight lang="tailspin"> |
|||
templates q |
|||
def outputFrom: $(1); |
|||
def until: $(2); |
|||
@: [1,1]; |
|||
1..$until -> # |
|||
when <$@::length~..> do |
|||
..|@: $@($ - $@($ - 1)) + $@($ - $@($ - 2)); |
|||
$ -> # |
|||
when <$outputFrom..> do |
|||
$@($) ! |
|||
end q |
|||
[1,10] -> q -> '$; ' -> !OUT::write |
|||
' |
|||
' -> !OUT::write |
|||
[1000,1000] -> q -> '$; |
|||
' -> !OUT::write |
|||
templates countDownSteps |
|||
@: 0; |
|||
def qs: $; |
|||
2..$qs::length -> # |
|||
$@ ! |
|||
when <?($qs($) <..~$qs($-1)>)> do @: $@ + 1; |
|||
end countDownSteps |
|||
[[1, 100000] -> q] -> countDownSteps -> 'Less than previous $; times' -> !OUT::write |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 1 2 3 3 4 5 5 6 6 |
|||
502 |
|||
Less than previous 49798 times |
|||
</pre> |
</pre> |
||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
< |
<syntaxhighlight lang="tcl">package require Tcl 8.5 |
||
# Index 0 is not used, but putting it in makes the code a bit shorter |
# Index 0 is not used, but putting it in makes the code a bit shorter |
||
Line 1,839: | Line 4,064: | ||
incr count [expr {$q > [set q [expr {Q($i)}]]}] |
incr count [expr {$q > [set q [expr {Q($i)}]]}] |
||
} |
} |
||
puts "Q(i)<Q(i-1) for i \[2..100000\] is true $count times"</ |
puts "Q(i)<Q(i-1) for i \[2..100000\] is true $count times"</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
Q(1) == 1 |
Q(1) == 1 |
||
Line 1,854: | Line 4,079: | ||
Q(1000) == 502 |
Q(1000) == 502 |
||
Q(i)<Q(i-1) for i [2..100000] is true 49798 times |
Q(i)<Q(i-1) for i [2..100000] is true 49798 times |
||
</pre> |
|||
=={{header|uBasic/4tH}}== |
|||
{{trans|BBC BASIC}} |
|||
uBasic/4tH simply lacks the memory to make it through to the 1000th term. 256 is the best it can do. |
|||
<syntaxhighlight lang="text">Print "First 10 terms of Q = " ; |
|||
For i = 1 To 10 : Print FUNC(_q(i));" "; : Next : Print |
|||
Print "256th term = ";FUNC(_q(256)) |
|||
End |
|||
_q Param(1) |
|||
Local(2) |
|||
If a@ < 3 Then Return (1) |
|||
If a@ = 3 Then Return (2) |
|||
@(0) = 1 : @(1) = 1 : @(2) = 2 |
|||
c@ = 0 |
|||
For b@ = 3 To a@-1 |
|||
@(b@) = @(b@ - @(b@-1)) + @(b@ - @(b@-2)) |
|||
If @(b@) < @(b@-1) Then c@ = c@ + 1 |
|||
Next |
|||
Return (@(a@-1))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>First 10 terms of Q = 1 1 2 3 3 4 5 5 6 6 |
|||
256th term = 123 |
|||
0 OK, 0:320</pre> |
|||
=={{header|VBA}}== |
|||
<syntaxhighlight lang="vb">Public Q(100000) As Long |
|||
Public Sub HofstadterQ() |
|||
Dim n As Long, smaller As Long |
|||
Q(1) = 1 |
|||
Q(2) = 1 |
|||
For n = 3 To 100000 |
|||
Q(n) = Q(n - Q(n - 1)) + Q(n - Q(n - 2)) |
|||
If Q(n) < Q(n - 1) Then smaller = smaller + 1 |
|||
Next n |
|||
Debug.Print "First ten terms:" |
|||
For i = 1 To 10 |
|||
Debug.Print Q(i); |
|||
Next i |
|||
Debug.print |
|||
Debug.Print "The 1000th term is:"; Q(1000) |
|||
Debug.Print "Number of times smaller:"; smaller |
|||
End Sub</syntaxhighlight>{{out}} |
|||
<pre>First ten terms: |
|||
1 1 2 3 3 4 5 5 6 6 |
|||
The 1000th term is: 502 |
|||
Number of times smaller: 49798 </pre> |
|||
=={{header|VBScript}}== |
|||
<syntaxhighlight lang="vb"> |
|||
Sub q_sequence(n) |
|||
Dim Q() |
|||
ReDim Q(n) |
|||
Q(1)=1 : Q(2)=1 : Q(3)=2 |
|||
less_precede = 0 |
|||
For i = 4 To n |
|||
Q(i)=Q(i-Q(i-1))+Q(i-Q(i-2)) |
|||
If Q(i) < Q(i-1) Then |
|||
less_precede = less_precede + 1 |
|||
End If |
|||
Next |
|||
WScript.StdOut.Write "First 10 terms of the sequence: " |
|||
For j = 1 To 10 |
|||
If j < 10 Then |
|||
WScript.StdOut.Write Q(j) & ", " |
|||
Else |
|||
WScript.StdOut.Write "and " & Q(j) |
|||
End If |
|||
Next |
|||
WScript.StdOut.WriteLine |
|||
WScript.StdOut.Write "1000th term of the sequence: " & Q(1000) |
|||
WScript.StdOut.WriteLine |
|||
WScript.StdOut.Write "Number of times the member of the sequence is less than its preceding term: " &_ |
|||
less_precede |
|||
End Sub |
|||
q_sequence(100000) |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
First 10 terms of the sequence: 1, 1, 2, 3, 3, 4, 5, 5, 6, and 6 |
|||
1000th term of the sequence: 502 |
|||
Number of times the member of the sequence is less than its preceding term: 49798 |
|||
</pre> |
|||
=={{header|Visual FoxPro}}== |
|||
<syntaxhighlight lang="vfp"> |
|||
LOCAL p As Integer, i As Integer |
|||
CLEAR |
|||
p = 0 |
|||
? "Hofstadter Q Sequence" |
|||
? "First 10 terms:" |
|||
FOR i = 1 TO 10 |
|||
?? Q(i, @p) |
|||
ENDFOR |
|||
? "1000th term:", Q(1000, @p) |
|||
? "100000th term:", q(100000, @p) |
|||
? "Number of terms less than the preceding term:", p |
|||
FUNCTION Q(n As Integer, k As Integer) As Integer |
|||
LOCAL i As Integer |
|||
LOCAL ARRAY aq[n] |
|||
aq[1] = 1 |
|||
IF n > 1 |
|||
aq[2] = 1 |
|||
ENDIF |
|||
k = 0 |
|||
FOR i = 3 TO n |
|||
aq[i] = aq[i - aq[i-1]] + aq[i-aq[i-2]] |
|||
IF aq(i) < aq(i-1) |
|||
k = k + 1 |
|||
ENDIF |
|||
ENDFOR |
|||
RETURN aq[n] |
|||
ENDFUNC |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Hofstadter Q Sequence |
|||
First 10 terms: 1 1 2 3 3 4 5 5 6 6 |
|||
1000th term: 502 |
|||
100000th term: 48157 |
|||
Number of terms less than the preceding term: 49798 |
|||
</pre> |
|||
=={{header|Wren}}== |
|||
<syntaxhighlight lang="wren">var N = 1e5 |
|||
var q = List.filled(N + 1, 0) |
|||
q[1] = 1 |
|||
q[2] = 1 |
|||
for (n in 3..N) q[n] = q[n - q[n-1]] + q[n - q[n-2]] |
|||
System.print("The first ten terms of the Hofstadter Q sequence are:") |
|||
System.print(q[1..10]) |
|||
System.print("\nThe thousandth term is %(q[1000]).") |
|||
var flips = 0 |
|||
for (n in 2..N) { |
|||
if (q[n] < q[n-1]) flips = flips + 1 |
|||
} |
|||
System.print("\nThere are %(flips) flips in the first %(N) terms.")</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
The first ten terms of the Hofstadter Q sequence are: |
|||
[1, 1, 2, 3, 3, 4, 5, 5, 6, 6] |
|||
The thousandth term is 502. |
|||
There are 49798 flips in the first 100000 terms. |
|||
</pre> |
</pre> |
||
=={{header|XPL0}}== |
=={{header|XPL0}}== |
||
< |
<syntaxhighlight lang="xpl0">code ChOut=8, CrLf=9, IntOut=11; |
||
int N, C, Q(100_001); |
int N, C, Q(100_001); |
||
[Q(1):= 1; Q(2):= 1; C:= 0; |
[Q(1):= 1; Q(2):= 1; C:= 0; |
||
Line 1,869: | Line 4,251: | ||
IntOut(0, Q(1000)); CrLf(0); |
IntOut(0, Q(1000)); CrLf(0); |
||
IntOut(0, C); CrLf(0); |
IntOut(0, C); CrLf(0); |
||
]</ |
]</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 1,880: | Line 4,262: | ||
=={{header|zkl}}== |
=={{header|zkl}}== |
||
{{trans|ALGOL 68}} |
{{trans|ALGOL 68}} |
||
< |
<syntaxhighlight lang="zkl">const n = 0d100_000; |
||
q:=(n+1).pump(List.createLong(n+1).write); // (0,1,2,...,n) base 1 |
q:=(n+1).pump(List.createLong(n+1).write); // (0,1,2,...,n) base 1 |
||
q[1] = q[2] = 1; |
q[1] = q[2] = 1; |
||
Line 1,891: | Line 4,273: | ||
flip := 0; |
flip := 0; |
||
foreach i in (n){ flip += (q[i] > q[i + 1]) } |
foreach i in (n){ flip += (q[i] > q[i + 1]) } |
||
println("flips: ",flip);</ |
println("flips: ",flip);</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,898: | Line 4,280: | ||
flips: 49798 |
flips: 49798 |
||
</pre> |
</pre> |
||
=={{header|ZX Spectrum Basic}}== |
|||
{{trans|BBC_BASIC}} |
|||
Extra credit 100000 is not implemented because of memory limitations. |
|||
<syntaxhighlight lang="zxbasic">10 PRINT "First 10 terms of Q = " |
|||
20 FOR i=1 TO 10: GO SUB 1000: PRINT s;" ";: NEXT i: PRINT |
|||
30 LET i=1000 |
|||
40 PRINT "1000th term = ";: GO SUB 1000: PRINT s |
|||
50 PRINT "Term is less than preceding term ";c;" times" |
|||
100 STOP |
|||
1000 REM Qsequence subroutine |
|||
1010 IF i<3 THEN LET s=1: RETURN |
|||
1020 IF i=3 THEN LET s=2: RETURN |
|||
1030 DIM q(i) |
|||
1040 LET q(1)=1: LET q(2)=1: LET q(3)=2 |
|||
1050 LET c=0 |
|||
1060 FOR j=3 TO i |
|||
1070 LET q(j)=q(j-q(j-1))+q(j-q(j-2)) |
|||
1080 IF q(j)<q(j-1) THEN LET c=c+1 |
|||
1090 NEXT j |
|||
1100 LET s=q(i) |
|||
1110 RETURN</syntaxhighlight> |
Latest revision as of 08:44, 23 July 2024
![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,000th term.
- Ensure that the extra credit solution safely handles being initially asked for an nth term where n is large.
(This point is to ensure that caching and/or recursion limits, if it is a concern, is correctly handled).
11l
V qseq = [0] * 100001
qseq[1] = 1
qseq[2] = 1
L(i) 3 .< qseq.len
qseq[i] = qseq[i - qseq[i-1]] + qseq[i - qseq[i-2]]
print(‘The first 10 terms are: ’qseq[1..10].map(q -> String(q)).join(‘, ’))
print(‘The 1000'th term is ’qseq[1000])
V less_than_preceding = 0
L(i) 2 .< qseq.len
I qseq[i] < qseq[i-1]
less_than_preceding++
print(‘Times a member of the sequence is less than its preceding term: ’less_than_preceding)
- Output:
The first 10 terms are: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 The 1000'th term is 502 Times a member of the sequence is less than its preceding term: 49798
360 Assembly
* Hofstrader q sequence for any n - 18/10/2015
HOFSTRAD CSECT
USING HOFSTRAD,R15 set base register
MVC Q,=F'1' q(1)=1
MVC Q+4,=F'1' q(2)=1
LA R4,1 i=1
LOOPI C R4,N do i=1 to n
BH ELOOPI
C R4,=F'3' if i>=3 then
BL NOTREC
LR R1,R4 i
SLA R1,2 i*4
L R2,Q-8(R1) q(i-1)
LR R1,R4 i
SR R1,R2 i-q(i-1)
SLA R1,2 *4
L R2,Q-4(R1) r2=q(i-q(i-1))
LR R1,R4 i
SLA R1,2 i*4
L R3,Q-12(R1) q(i-2)
LR R1,R4 i
SR R1,R3 i-q(i-2)
SLA R1,2 *4
L R3,Q-4(R1) r3=q(i-q(i-2))
AR R2,R3 r2=r2+r3
LR R1,R4 i
SLA R1,2 i*4
ST R2,Q-4(R1) q(i)=q(i-q(i-1))+q(i-q(i-2))
NOTREC C R4,=F'10' if i<=10
BNH PRT
C R4,N or i=n then
BNE NOPRT
PRT XDECO R4,XD edit i
MVC PG+2(4),XD+8 output i
LR R1,R4 i
SLA R1,2 i*4
L R2,Q-4(R1) q(i)
XDECO R2,XD edit q(i)
MVC PG+10(4),XD+8 output q(i)
XPRNT PG,80 print buffer
NOPRT LA R4,1(R4) i=i+1
B LOOPI
ELOOPI XR R15,R15 set return code
BR R14 return to caller
PG DC CL80'n=...., q=....' buffer
XD DS CL12 temporary variable
LTORG insert literals for addressability
N DC F'1000' n=1000
Q DS 1000F array q(1000)
YREGS
END HOFSTRAD
- Output:
n= 1, q= 1 n= 2, q= 1 n= 3, q= 2 n= 4, q= 3 n= 5, q= 3 n= 6, q= 4 n= 7, q= 5 n= 8, q= 5 n= 9, q= 6 n= 10, q= 6 n=1000, q= 502
8080 Assembly
puts: equ 9 ; CP/M call to print a string
org 100h
;;; Generate the first 1000 members of the Q sequence
lxi b,3 ; Start at 3rd element (1 and 2 already defined)
genq: dcx b ; BC = N-1
call q
mov e,m ; DE = Q(N-1)
inx h
mov d,m
inx b ; BC = (N-1)+1 = N
xchg ; HL = Q(N-1)
call neg ; HL = -Q(N-1)
dad b ; HL = N-Q(N-1)
push b ; Keep N
mov b,h ; BC = N-Q(N-1)
mov c,l
call q ; HL = *Q(N-Q(N-1))
mov e,m ; DE = Q(N-Q(N-1))
inx h
mov d,m
pop b ; Restore N
push d ; push Q(N-Q(N-1))
dcx b ; BC = N-2
dcx b
call q ; DE = Q(N-2)
mov e,m
inx h
mov d,m
inx b ; BC = (N-2)+2 = N
inx b
xchg ; HL = Q(N-2)
call neg ; HL = -Q(N-2)
dad b ; HL = N-Q(N-2)
push b ; Keep N
mov b,h ; BC = N-Q(N-2)
mov c,l
call q ; HL = *Q(N-Q(N-2))
mov a,m ; HL = Q(N-Q(N-2))
inx h
mov h,m
mov l,a
pop b ; Restore N
pop d ; pop Q(N-Q(N-1))
dad d ; HL = Q(N-Q(N-1))+Q(N-Q(N-2))
xchg ; DE = Q(N-Q(N-1))+Q(N-Q(N-2))
call q ; HL = *Q(N)
mov m,e ; Store Q(N)
inx h
mov m,d
inx b ; N = N+1
lxi h,-1001
dad b ; Are we there yet?
jnc genq
;;; Print first 10 terms
lxi d,m10
mvi c,puts
call 5
lxi b,1 ; Start at term 1
mvi d,10 ; 10 terms
p10: push b ; Save counters
push d
call prterm ; Print current term
pop d ; Restore counters
pop b
inx b ; Next term
dcr d ; Repeat 10 times
jnz p10
;;; Print 1000th term
lxi d,m1000
mvi c,puts
call 5
lxi b,1000 ; 1000th term
;;; Print Q(BC)
prterm: call q ; Load term into HL
mov a,m
inx h
mov h,m
mov l,a
lxi b,num ; Push pointer to end of number buffer
push b
lxi b,-10 ; Divisor
dgt: lxi d,-1 ; Quotient
divlp: inx d
dad b
jc divlp
mvi a,'0'+10
add l ; Make ASCII digit
pop h ; Get pointer
dcx h
mov m,a ; Store digit
push h
xchg ; HL = next quotient
mov a,h ; More digits?
ora l
jnz dgt
pop d ; Print string
mvi c,puts
jmp 5
;;; Set HL = -HL
neg: dcx h
mov a,h
cma
mov h,a
mov a,l
cma
mov l,a
ret
;;; Set HL to memory location of Q(BC)
q: push d ; Keep DE
mov h,b ; HL = 2*(BC-1)
mov l,c
dcx h
dad h
lxi d,qq ; Add to start of sequence
dad d
pop d
ret
m10: db 'The first 10 terms are: $'
m1000: db 13,10,'The 1000th term is: $'
db '*****' ; Placeholder for number
num: db ' $'
qq: dw 1,1 ; Q sequence stored here, starting with 1, 1
- Output:
The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502
8086 Assembly
puts: equ 9 ; MS-DOS syscall to print a string
cpu 8086
org 100h
section .text
;;; Generate first 1000 elements of Q sequence
mov dx,3 ; DX = N
mov di,Q+4 ; DI = place to store elements
mov cx,998 ; Generate 998 more terms
genq: mov si,dx ; SI = N
sub si,[di-2] ; SI -= Q[N-1]
mov bp,dx ; BP = N
sub bp,[di-4] ; BP -= Q[N-2]
dec si ; SI = 2*(SI-1) (0-indexed, 2 bytes/term)
shl si,1
dec bp ; Same for BP
shl bp,1
mov ax,[si+Q] ; Load Q[n-Q[n-1]]
add ax,[bp+Q] ; Add Q[n-Q[n-2]]
stosw ; Store as Q[n]
inc dx ; Increment N
loop genq
;;; Print first 10 elements
mov ah,puts
mov dx,m10
int 21h
mov cx,10
mov bx,1
p10: call prterm
inc bx
loop p10
;;; Print 1000th element
mov ah,puts
mov dx,m1000
int 21h
mov bx,1000
;;; Print the term in BX
prterm: push bx ; Save term
dec bx
shl bx,1
mov ax,[bx+Q] ; Load term into AX
mov bp,10 ; Divisor
mov bx,num ; Number buffer pointer
.dgt: xor dx,dx
div bp ; Divide number by 10
dec bx
add dl,'0' ; DX = remainder, add '0'
mov [bx],dl ; Stored digit
test ax,ax ; Done yet?
jnz .dgt ; If not, find next digit
mov dx,bx ; Print the number
mov ah,puts
int 21h
pop bx ; Restore term
ret
section .data
m10: db 'First 10 terms are: $'
m1000: db 13,10,'1000th term is: $'
db '*****' ; Number placeholder
num: db ' $'
Q: dw 1,1
- Output:
First 10 terms are: 1 1 2 3 3 4 5 5 6 6 1000th term is: 502
Action!
PROC Main()
DEFINE MAX="1000"
INT ARRAY q(MAX+1)
INT i
q(1)=1 q(2)=1
FOR i=3 TO MAX
DO
q(i)=q(i-q(i-1))+q(i-q(i-2))
OD
FOR i=1 TO 10
DO
PrintF("%I: %I%E",i,q(i))
OD
PrintF("%I: %I%E",MAX,q(MAX))
RETURN
- Output:
Screenshot from Atari 8-bit computer
1: 1 2: 1 3: 2 4: 3 5: 3 6: 4 7: 5 8: 5 9: 6 10: 6 1000: 502
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;
- 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
#!/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))
)
- Output:
1 1 2 3 3 4 5 5 6 6 502 flips: 49798
ALGOL-M
begin
integer array Q[1:1000];
integer n;
Q[1] := Q[2] := 1;
for n := 3 step 1 until 1000 do
Q[n] := Q[n-Q[n-1]] + Q[n-Q[n-2]];
write("The first 10 terms are:");
write("");
for n := 1 step 1 until 10 do writeon(Q[n]);
write("The 1000th term is:", Q[1000]);
end
- Output:
The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502
ALGOL W
begin % find elements of the Hofstader Q sequence Q(1) = Q(2) = 1 %
% Q(n) = Q( n - Q( n - 1 ) ) + Q( n - Q( n - 2 ) ) for n > 2 %
integer MAX_Q;
max_Q := 100000;
begin
integer array Q ( 1 :: MAX_Q );
integer array xQ ( 1 :: 10 );
integer ltCount;
logical valuesOk;
% expected values of the first 10 elements %
xQ( 1 ) := xQ( 2 ) := 1;
xQ( 3 ) := 2; xQ( 4 ) := xQ( 5 ) := 3; xQ( 6 ) := 4;
xQ( 7 ) := xQ( 8 ) := 5; xQ( 9 ) := xQ( 10 ) := 6;
% calculate the sequence and count how often Q( n ) < Q( n - 1 ) %
ltCount := 0;
Q( 1 ) := Q( 2 ) := 1;
for n := 3 until MAX_Q do begin
Q( n ) := Q( n - Q( n - 1 ) ) + Q( n - Q( n - 2 ) );
if Q( n ) < Q( n - 1 ) then ltCount := ltCount + 1
end for_n ;
valuesOk := true;
write( "The first 10 terms of the Hofstader Q sequence:" );
for i := 1 until 10 do begin
writeon( i_w := 1, s_w := 0, " ", Q( i ) );
if Q( i ) not = xQ( i ) then begin
writeon( i_w := 1, s_w := 0, "-EXPECTED-", xQ( i ) );
valuesOk := false
end if_Q_i_ne_xQ_i
end for_i ;
write( i_w := 1, s_w := 0, "The 1000th term is: ", Q( 1000 ) );
if Q( 1000 ) not = 502 then begin
writeon( "-EXPECTED-502" );
valuesOk := false
end if_Q_100_ne_502 ;
if valuesOk then write( " (Computed values are as expected)" )
else write( "Values NOT as expected" );
write( i_w := 1, s_w := 0, "Q(n) < Q(n-1) ", ltCount," times for n up to ", MAX_Q )
end
end.
- Output:
The first 10 terms of the Hofstader Q sequence: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502 (Computed values are as expected) Q(n) < Q(n-1) 49798 times for n up to 100000
APL
∇ Q_sequence;seq;size
size←100000
seq←{⍵,+/⍵[(1+⍴⍵)-¯2↑⍵]}⍣(size-2)⊢1 1
⎕←'The first 10 terms are:', seq[⍳10]
⎕←'The 1000th term is:', seq[1000]
⎕←(+/ 2>/seq),'terms were preceded by a larger term.'
∇
- Output:
The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502 49798 terms were preceded by a larger term.
ARM Assembly
.text
.global _start
_start: ldr r6,=qs @ R6 = base register for Q array
@@@ Write first 2 elements
mov r0,#1 @ Q(1) and Q(2) are 1
strh r0,[r6,#4]
strh r0,[r6,#8]
@@@ Generate 100 thousand elements
mov r1,#0x86A0
movt r1,#1 @ 0x186A0 = 100.000
mov r0,#3 @ Starting at element 3
1: sub r2,r0,#1 @ r2 = n-1
ldr r2,[r6,r2,lsl#2] @ r2 = Q[r2]
sub r2,r0,r2 @ r2 = n-Q[r2]
ldr r2,[r6,r2,lsl#2] @ r2 = Q[r2]
sub r3,r0,#2 @ r3 = n-2
ldr r3,[r6,r3,lsl#2] @ r3 = Q[r3]
sub r3,r0,r3 @ r3 = n-Q[r3]
ldr r3,[r6,r3,lsl#2] @ r3 = Q[r3]
add r2,r2,r3 @ r2 += r3
str r2,[r6,r0,lsl#2] @ Q[n] = r2
add r0,r0,#1 @ n++
cmp r0,r1
bls 1b @ If r0<=r1, generate next
@@@ Print first 10 elements
ldr r1,=f10m
bl pstr
mov r8,#1 @ Start at element 1
1: ldr r0,[r6,r8,lsl#2] @ Grab current element
bl pnum @ Print it
ldr r1,=space @ Print a space
bl pstr
add r8,r8,#1
cmp r8,#10 @ Keep going until 10 elements printed
bls 1b
ldr r1,=nl @ Print newline
bl pstr
@@@ Print 1000th element
ldr r1,=f1000m
bl pstr
mov r8,#1000 @ Grab 1000th element
ldr r0,[r6,r8,lsl#2]
bl pnum
ldr r1,=nl @ Print newline
bl pstr
@@@ Find how many times a member is less than its preceding term
mov r0,#0 @ counter
mov r1,#0x86A0 @ max element
movt r1,#1
mov r2,#1 @ value of previous element
mov r3,#2 @ number of current element
2: ldr r4,[r6,r3,lsl#2] @ get value of current element
cmp r2,r4 @ if previous more than current
addhi r0,r0,#1 @ then increment counter
mov r2,r4 @ current el is now prevous el
add r3,r3,#1 @ increment element index
cmp r3,r1 @ are we there yet?
bls 2b @ if not, keep going
bl pnum @ otherwise, print the number
ldr r1,=ltermm @ and the corresponding message
bl pstr
mov r0,#0 @ and then exit
mov r7,#1
swi #0
@@@ Print a length-prefixed string (in r1)
pstr: push {r7,lr} @ Save syscall and link registers
mov r0,#1 @ 1 = stdout
ldrb r2,[r1],#1 @ Get length and advance r1
mov r7,#4 @ Write
swi #0
pop {r7,pc}
@@@ Print unsigned number in r0 using Linux
pnum: push {r7,lr} @ Save syscall and link registers
ldr r7,=qs @ May as well use R7 as buffer pointer
1: mov r1,#10 @ Div-mod by 10
bl divmod
add r1,r1,#'0 @ This makes an ASCII digit
strb r1,[r7,#-1]! @ Store it in the buffer
tst r0,r0 @ Are there more digits?
bne 1b @ If so, calculate them
mov r0,#1 @ 1 = stdout
mov r1,r7 @ Start of number in R1
ldr r2,=qs @ Calculate length
sub r2,r2,r1
mov r7,#4 @ 4 = write
swi #0
pop {r7,pc}
@@@ Division routine: r0=r0/r1, r1=r0%r1
divmod: mov r2,#0 @ R2 = counter
1: cmp r1,r0 @ Double R1 until R1>R0
lslls r1,r1,#1
addls r2,r2,#1
bls 1b
mov r3,#0
2: lsl r3,r3,#1
subs r0,r0,r1 @ Trial subtraction
addhs r3,r3,#1 @ If it worked, mark
addlo r0,r0,r1 @ If it didn't, undo
lsr r1,r1,#1 @ Halve R1
subs r2,r2,#1 @ Decrement counter
bhs 2b @ Keep going until zero
mov r1,r0 @ R1 = modulus
mov r0,r3 @ R0 = quotient
bx lr
.data
space: .ascii "\x1 "
nl: .ascii "\x1\n"
f10m: .ascii "\x18The first 10 terms are: "
f1000m: .ascii "\x14The 1000th term is: "
ltermm: .ascii "' terms were preceded by a larger term.\n"
.bss
.align 4
.space 8 @ Buffer for number output
qs: .space 4 * 100001 @ One word per term
- Output:
The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502 49798 terms were preceded by a larger term.
Arturo
q: new [1 1]
n: 2
while [n<1001][
'q ++ (get q n-q\[n-1]) + get q n-q\[n-2]
n: n+1
]
print ["First ten items:" first.n: 10 q]
print ["1000th item:" q\[999]]
- Output:
First ten items: [1 1 2 3 3 4 5 5 6 6] 1000th item: 502
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
}
- Output:
First ten: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6, 1000th: 502 Flips: 49798
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
}
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
BASIC
BASIC256
limite = 100000
dim Q[limite+1]
cont = 0
Q[1] = 1
Q[2] = 1
for i = 3 to limite
Q[i] = Q[i-Q[i-1]] + Q[i-Q[i-2]]
if Q[i] < Q[i-1] then cont += 1
next i
print "Primeros 10 términos: ";
for i = 1 to 10
print Q[i] + " ";
next i
print "Término número 1000: "; Q[1000]
print "Términos menores que los anteriores: "; cont
- Output:
Igual que la entrada de FreeBASIC.
BBC BASIC
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%)
- 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
QBasic
CONST limite = 10000
DIM Q(limite)
Q(1) = 1
Q(2) = 1
cont = 0
FOR i = 3 TO limite
Q(i) = Q(i - Q(i - 1)) + Q(i - Q(i - 2))
IF Q(i) < Q(i-1) THEN cont = cont + 1
NEXT i
PRINT "First 10 terms: ";
FOR i = 1 TO 10
PRINT Q(i); " ";
NEXT i
PRINT
PRINT "Term 1000: "; Q(1000)
PRINT "Terms less than preceding in first 100k: "; cont
True BASIC
LET limite = 100000
DIM q(0)
MAT REDIM q(limite)
LET q(1) = 1
LET q(2) = 1
LET count = 0
FOR i = 3 TO limite
LET q(i) = q(i-q(i-1))+q(i-q(i-2))
IF q(i) < q(i-1) THEN
LET count = count + 1
END IF
NEXT i
PRINT "First 10 terms: ";
FOR i = 1 TO 10
PRINT q(i);
NEXT i
PRINT
PRINT "Term 1000: "; q(1000)
PRINT "Terms less than preceding in first 100k: "; count
END
- Output:
Same as FreeBASIC entry.
XBasic
PROGRAM "Hofstadter Q sequence"
VERSION "0.0000"
DECLARE FUNCTION Entry ()
FUNCTION Entry ()
limite = 1e5
DIM q[limite]
q[1] = 1
q[2] = 1
count = 0
FOR i = 3 TO limite
q[i] = q[i-q[i-1]] + q[i-q[i-2]]
IF q[i] < q[i-1] THEN
INC count
END IF
NEXT i
PRINT "First 10 terms: ";
FOR i = 1 TO 10
PRINT q[i];
NEXT i
PRINT "\nTerm 1000: "; q[1000]
PRINT "Terms less than preceding in first 100k: "; count
END FUNCTION
END PROGRAM
- Output:
Same as FreeBASIC entry.
Yabasic
limite = 1e5
dim q(limite)
q(1) = 1
q(2) = 1
count = 0
for i = 3 to limite
q(i) = q(i-q(i-1)) + q(i-q(i-2))
if q(i) < q(i-1) count = count + 1
next i
print "First 10 terms: ";
for i = 1 to 10
print q(i), " ";
next i
print "\nTerm 1000: ", q(1000)
print "Terms less than preceding in first 100k: ", count
end
- Output:
Same as FreeBASIC entry.
Bracmat
( 0:?memocells
& tbl$(memo,!memocells+1) { allocate array }
& ( Q
=
. !arg:(1|2)&1
| !arg:>2
& ( !arg:>!memocells:?memocells { Array is too small. }
& tbl$(memo,!memocells+1) { Let array grow to needed size. }
| { Array is not too small. }
)
& ( !(!arg$memo):>0 { Set index to !arg. Return value at index if > 0 }
| Q$(!arg+-1*Q$(!arg+-1))+Q$(!arg+-1*Q$(!arg+-2))
: ?(!arg$?memo) { Set index to !arg. Store value just found. }
)
)
& 0:?i
& whl
' (1+!i:~>10:?i&put$(str$(Q$!i " ")))
& put$\n
& whl'(1+!i:~>1000:?i&Q$!i)
& out$(Q$1000)
& 0:?previous:?lessThan:?i
& whl
' ( 1+!i:~>100000:?i
& Q$!i
: ( <!previous&1+!lessThan:?lessThan
| ?
)
: ?previous
)
& out$!lessThan
);
Output:
1 1 2 3 3 4 5 5 6 6 502 49798
BCPL
get "libhdr"
let start() be
$( let Q = vec 1000
Q!1 := 1
Q!2 := 1
for n = 3 to 1000 do
Q!n := Q!(n-Q!(n-1)) + Q!(n-Q!(n-2))
writes("The first 10 terms are:")
for n = 1 to 10 do writef(" %N", Q!n)
writef("*NThe 1000th term is: %N*N", Q!1000)
$)
- Output:
The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502
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;
}
- Output:
1 1 2 3 3 4 5 5 6 6 502 flips: 49798
C#
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;
}
}
}
- 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.
C++
solution modeled after Perl solution
#include <iostream>
int main() {
const int size = 100000;
int hofstadters[size] = { 1, 1 };
for (int i = 3 ; i < size; 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: ";
for (int i = 0; i < 10; i++)
std::cout << hofstadters[ i ] << ' ';
std::cout << std::endl << "The 1000'th term is " << hofstadters[ 999 ] << " !" << std::endl;
int less_than_preceding = 0;
for (int i = 0; i < size - 1; i++)
if (hofstadters[ i + 1 ] < hofstadters[ i ])
less_than_preceding++;
std::cout << "In array of size: " << size << ", ";
std::cout << less_than_preceding << " times a number was preceded by a greater number!" << std::endl;
return 0;
}
- Output:
The first 10 numbers are: 1 1 2 3 3 4 5 5 6 6 The 1000'th term is 502 ! In array of size: 100000, 49798 times a number was preceded by a greater number!
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].
(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))
- Output:
first 10: [1 1 2 3 3 4 5 5 6 6]
1000th: 502
extra credit: 49798
CLU
q_seq = proc (n: int) returns (sequence[int])
q: array[int] := array[int]$[1,1]
for i: int in int$from_to(3,n) do
array[int]$addh(q, q[i-q[i-1]] + q[i-q[i-2]])
end
return(sequence[int]$a2s(q))
end q_seq
start_up = proc ()
po: stream := stream$primary_output()
q: sequence[int] := q_seq(100000)
stream$puts(po, "First 10 terms:")
for i: int in int$from_to(1,10) do
stream$puts(po, " " || int$unparse(q[i]))
end
stream$puts(po, "\n1000th term: " || int$unparse(q[1000]))
flips: int := 0
for i: int in int$from_to(2, sequence[int]$size(q)) do
if q[i-1]>q[i] then flips := flips + 1 end
end
stream$putl(po, "\nflips: " || int$unparse(flips))
end start_up
- Output:
First 10 terms: 1 1 2 3 3 4 5 5 6 6 1000th term: 502 flips: 49798
CoffeeScript
hofstadterQ = do ->
memo = [ 1 ,1, 1]
Q = (n) ->
result = memo[n]
if typeof result != 'number'
result = memo[n] = Q(n - Q(n - 1)) + Q(n - Q(n - 2))
result
# some results:
console.log 'Q(' + i + ') = ' + hofstadterQ(i) for i in [1..10]
console.log 'Q(1000) = ' + hofstadterQ(1000)
- 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
COBOL
IDENTIFICATION DIVISION.
PROGRAM-ID. Q-SEQ.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SEQ.
02 Q PIC 9(3) OCCURS 1000 TIMES.
02 Q-TMP1 PIC 9(3).
02 Q-TMP2 PIC 9(3).
02 N PIC 9(4).
01 DISPLAYING.
02 ITEM PIC Z(3).
02 IX PIC Z(4).
PROCEDURE DIVISION.
MAIN-PROGRAM.
PERFORM GENERATE-SEQUENCE.
PERFORM SHOW-ITEM
VARYING N FROM 1 BY 1
UNTIL N IS GREATER THAN 10.
SET N TO 1000.
PERFORM SHOW-ITEM.
STOP RUN.
GENERATE-SEQUENCE.
SET Q(1) TO 1.
SET Q(2) TO 1.
PERFORM GENERATE-ITEM
VARYING N FROM 3 BY 1
UNTIL N IS GREATER THAN 1000.
GENERATE-ITEM.
COMPUTE Q-TMP1 = N - Q(N - 1).
COMPUTE Q-TMP2 = N - Q(N - 2).
COMPUTE Q(N) = Q(Q-TMP1) + Q(Q-TMP2).
SHOW-ITEM.
MOVE N TO IX.
MOVE Q(N) TO ITEM.
DISPLAY 'Q(' IX ') = ' ITEM.
- 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
Common 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)))
- Output:
First of Q: (1 1 2 3 3 4 5 5 6 6) Q(1000): 502 Bumps up to 100000: 49798
Although the above definition of q
is more general, for this specific problem the following is faster:
(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)))
Cowgol
include "cowgol.coh";
# Generate 1000 terms of the Q sequence
var Q: uint16[1001];
Q[1] := 1;
Q[2] := 1;
var n: @indexof Q := 3;
while n <= 1000 loop
Q[n] := Q[n-Q[n-1]] + Q[n-Q[n-2]];
n := n + 1;
end loop;
# Print first 10 terms
print("The first 10 terms are: ");
n := 1;
while n <= 10 loop
print_i16(Q[n]);
print_char(' ');
n := n + 1;
end loop;
print_nl();
# Print 1000th term
print("The 1000th term is: ");
print_i16(Q[1000]);
print_nl();
- Output:
The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502
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)));
}
- 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.
import std.stdio, std.algorithm, std.range, std.array;
uint Q(in int n) nothrow
in {
assert(n > 0);
} body {
__gshared static Appender!(int[]) s = [0, 1, 1];
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)));
}
Even Faster Version
This code is here to show that you don't have to use all fancy features of D. Straightforward simple code is often clearer, and faster.
import std.stdio;
int[100_000] Q;
void main() {
Q[0] = 1;
Q[1] = 1;
for (int i = 2; i < 100_000; i++)
{
Q[i] = Q[i - Q[i - 1]] + Q[i - Q[i - 2]];
}
write("Q(1..10) : ");
for (int i = 0; i < 10; i++)
{
write(" ", Q[i]);
}
writeln;
write("Q(1000) : ");
writeln(Q[999]);
int lt = 0;
for (int i = 1; i < 100_000; i++)
{
if( Q[i-1] > Q[i] ) lt++;
}
writefln("Q(i) is less than Q(i-1) for i [2..100_000] %d times.", lt);
}
Dart
Naive version using only recursion (Q(1000) fails due to browser script runtime restrictions)
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)}");
}
Version featuring caching.
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");
}
- 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.
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");
}
Draco
proc nonrec make_Q([*] word q) void:
word n;
q[1] := 1;
q[2] := 1;
for n from 3 upto dim(q,1)-1 do
q[n] := q[n-q[n-1]] + q[n-q[n-2]]
od
corp
proc nonrec main() void:
word MAX = 1000;
word i;
[MAX+1] word q;
make_Q(q);
write("The first 10 terms are:");
for i from 1 upto 10 do write(" ", q[i]) od;
writeln();
writeln("The 1000th term is: ", q[1000])
corp
- Output:
The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502
EasyLang
proc hofstadter limit . q[] .
q[] = [ 1 1 ]
for n = 3 to limit
q[] &= q[n - q[n - 1]] + q[n - q[n - 2]]
.
.
proc count . q[] cnt .
for i = 2 to len q[]
if q[i] < q[i - 1]
cnt += 1
.
.
.
hofstadter 100000 hofq[]
for i = 1 to 10
write hofq[i] & " "
.
print ""
print hofq[1000]
count hofq[] cnt
print cnt
EchoLisp
(define RECURSE_BUMP 500) ;; minimum of chrome:500 safari:1000 firefox:2000
;; count flips
(define (flips N)
(for/sum ((n (in-range 2 (1+ N))))
#:when (< (Q n) (Q (1- n))) 1))
(cache-size 120000)
(define (Q n)
;; prevent browser stack overflow at low-cost
(when (zero? (modulo n RECURSE_BUMP)) (for ((i (in-range 0 n RECURSE_BUMP ))) (Q i)))
(+ (Q (- n (Q (1- n)))) (Q (- n (Q (- n 2))))))
(remember 'Q #(1 1 1)) ;; memoize and init
;; first call : check stack OK
(Q 100000) → 48157
(for ((i 11)) (write (Q i)))
1 1 1 2 3 3 4 5 5 6 6
(Q 1000) → 502
(flips 100000) → 49798
Eiffel
class
APPLICATION
create
make
feature
make
-- Test output of the feature hofstadter_q_sequence.
local
count, i: INTEGER
test: ARRAY [INTEGER]
do
io.put_string ("%NFirst ten numbers: %N")
test := hofstadter_q_sequence (10)
across
test as ar
loop
io.put_string (ar.item.out + "%T")
end
test := hofstadter_q_sequence (100000)
io.put_string ("1000th:%N")
io.put_integer (test [1000])
io.put_string ("%NNumber of Flips:%N")
from
i := 2
until
i > 100000
loop
if test [i] < test [i - 1] then
count := count + 1
end
i := i + 1
end
io.put_integer (count)
end
hofstadter_q_sequence (lim: INTEGER): ARRAY [INTEGER]
-- Hofstadter Q Sequence up to 'lim'.
require
lim_positive: lim > 0
local
q: ARRAY [INTEGER]
i: INTEGER
do
create Result.make_filled (1, 1, lim)
Result [1] := 1
Result [2] := 1
from
i := 3
until
i > lim
loop
Result [i] := Result [i - Result [i - 1]] + Result [i - Result [i - 2]]
i := i + 1
end
end
end
- Output:
First ten numbers: 1 1 2 3 3 4 5 5 6 6 1000th: 502 Number of Flips: 49798
Elixir
changed collection (Erlang array => Map)
defmodule Hofstadter do
defp flip(v2, v1) when v1 > v2, do: 1
defp flip(_v2, _v1), do: 0
defp list_terms(max, n, acc), do: Enum.map_join(n..max, ", ", &acc[&1])
defp hofstadter(n, n, acc, flips) do
IO.puts "The first ten terms are: #{list_terms(10, 1, acc)}"
IO.puts "The 1000'th term is #{acc[1000]}"
IO.puts "Number of flips: #{flips}"
end
defp hofstadter(max, n, acc, flips) do
qn1 = acc[n-1]
qn = acc[n - qn1] + acc[n - acc[n-2]]
hofstadter(max, n+1, Map.put(acc, n, qn), flips + flip(qn, qn1))
end
def main(max \\ 100_000) do
acc = %{1 => 1, 2 => 1}
hofstadter(max+1, 3, acc, 0)
end
end
Hofstadter.main
- 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
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).
- 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
ERRE
- ERRE:
PROGRAM HOFSTADER_Q
!
! for rosettacode.org
!
DIM Q%[10000]
PROCEDURE QSEQUENCE(Q,FLAG%->SEQ$)
! if FLAG% is true accumulate sequence in SEQ$
! (attention to string var lenght=255)
! otherwise calculate values in Q%[] only
LOCAL N
Q%[1]=1
Q%[2]=1
SEQ$="1 1"
IF NOT FLAG% THEN Q=NUM END IF
FOR N=3 TO Q DO
Q%[N]=Q%[N-Q%[N-1]]+Q%[N-Q%[N-2]]
IF FLAG% THEN SEQ$=SEQ$+STR$(Q%[N]) END IF
END FOR
END PROCEDURE
BEGIN
NUM=10000
QSEQUENCE(10,TRUE->SEQ$)
PRINT("Q-sequence(1..10) : ";SEQ$)
QSEQUENCE(1000,FALSE->SEQ$)
PRINT("1000th number of Q sequence : ";Q%[1000])
FOR N=2 TO NUM DO
IF Q%[N]<Q%[N-1] THEN NN+=1 END IF
END FOR
PRINT("Number of Q(n)<Q(n+1) for n<=10000 : ";NN)
END PROGRAM
Note: The extra credit was limited to 10000 because memory addressable range is limited to 64K. If you want to implement extra credit for 100,000 you must use external file for array Q%[].
Delphi
type TIntArray = array of integer;
procedure FillHofstadterArray(var HA: TIntArray);
{Fill array with Hofstader numbers}
{Preset array size to the number of terms you want}
var I: integer;
begin
{Starting condition}
HA[1]:=1; HA[2]:=1;
{Fill array up to last item}
for I:=3 to High(HA) do HA[I]:=HA[I-HA[I-1]]+HA[I-HA[I-2]];
end;
procedure ShowHofstadterNumbers(Memo: TMemo);
{Fill array with a }
var I, LessCount: integer;
var QArray: TIntArray;
begin
{Select the number of items we want}
SetLength(QArray,100000);
{Fill array}
FillHofstadterArray(QArray);
{Display first 10}
for I:=1 to 10 do Memo.Lines.Add(Format('%4d: %4d',[I,QArray[I]]));
Memo.Lines.Add(Format('%4d: %4d',[1000,QArray[1000]]));
{Count number the number of times Q(n)<Q(n-1)}
LessCount:=0;
for I:=1 to High(QArray) do
if QArray[I]>QArray[I-1] then Inc(LessCount);
Memo.Lines.Add('Count of Q(n)<Q(n-1) = '+IntToStr(LessCount));
end;
- Output:
1: 1 2: 1 3: 2 4: 3 5: 3 6: 4 7: 5 8: 5 9: 6 10: 6 1000: 502 Count of Q(n)<Q(n-1) = 49997
F#
The function
// Populate an array with values of Hofstadter Q sequence. Nigel Galloway: August 26th., 2020
let fQ N=let g=Array.length N in N.[0]<-1; N.[1]<-1;(for g in 2..g-1 do N.[g]<-N.[g-N.[g-1]]+N.[g-N.[g-2]])
The Tasks
let Q=Array.zeroCreate<int>10 in fQ Q; printfn "%A" Q
let Q=Array.zeroCreate<int>1000 in fQ Q; printfn "%d" (Array.last Q)
- Output:
[|1; 1; 2; 3; 3; 4; 5; 5; 6; 6|] 502
Extra Credit
let Q=Array.zeroCreate<int>100000 in fQ Q; printfn "%d" (Q|>Seq.pairwise|>Seq.sumBy(fun(n,g)->if n>g then 1 else 0))
- Output:
49798
- What is a large number?
let Q=Array.zeroCreate<int>2500000000 in fQ Q; printfn "%d" (Array.last Q)
let Q=Array.zeroCreate<int>5000000000 in fQ Q; printfn "%d" (Array.last Q)
- Output:
121648520 (in 0m14.347s) 247777817 (in 0m37.757s)
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.
( 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
Fermat
Func Hq(n) = if n<2 then 1 else
Array qq[n+1];
qq[1] := 1;
qq[2] := 1;
for i = 3, n do
qq[i]:=qq[i-qq[i-1]]+qq[i-qq[i-2]]
od;
Return(qq[n]);
fi;
.
for i=1 to 10 do !Hq(i);!' ' od;
Hq(1000)
- Output:
1 1 2 3 3 4 5 5 6 6
502
Forth
100000 constant N
: q ( n -- addr ) cells here + ;
: qinit
1 0 q !
1 1 q !
N 2 do
i i 1- q @ - q @
i i 2 - q @ - q @
+ i q !
loop ;
: flips
." flips: "
0 N 1 do
i q @ i 1- q @ < if 1+ then
loop . cr ;
: qprint ( n -- )
0 do i q @ . loop cr ;
qinit
10 qprint
999 q @ . cr
flips
bye
- Output:
1 1 2 3 3 4 5 5 6 6 502 flips: 49798
Fortran
The latter-day function COUNT(logical expression) could easily be replaced by a simple test-and-count in the DO-loop preparing the array. One hopes that the compiler produces sensible code rather than creating an auxiliary array of boolean results then counting the true values. Rather more clunky is the need to employ odd structure for the input loop so as to handle possible bad input (text, rather than a valid number, for example) and who knows, end-of-file might happen also.
Calculate the Hofstadter Q-sequence, using a big array rather than recursion.
INTEGER ENUFF
PARAMETER (ENUFF = 100000)
INTEGER Q(ENUFF) !Lots of memory these days.
Q(1) = 1 !Initial values as per the definition.
Q(2) = 1
Q(3:) = -123456789!This will surely cause trouble!
DO I = 3,ENUFF !For values beyond the second,
Q(I) = Q(I - Q(I - 1)) + Q(I - Q(I - 2)) !Reach back according to the last two values.
END DO
Cast forth results as per the specification.
WRITE (6,1) Q(1:10) !Should be 1 1 2 3 3 4 5 5 6 6...
1 FORMAT ("First ten values:",10I2) !Known to be one-digit numbers.
WRITE (6,*) "Q(1000) =",Q(1000) !Should be 502.
WRITE (6,3) ENUFF,COUNT(Q(2:ENUFF) < Q(1:ENUFF - 1)) !Please don't create a temporary array!
3 FORMAT ("Count of those elements 2:",I0,
1 " which are less than their predecessor: ",I0) !Should be 49798.
Curry favour by allowing enquiries.
10 WRITE (6,11) ENUFF
11 FORMAT ("Nominate an index (in 1:",I0,"): ",$) !Obviously, the $ says don't start a new line.
READ (5,*,END = 999, ERR = 999) I !Ask for a number, with precautions.
IF (I.GT.0 .AND. I.LE.ENUFF) THEN !A good number, but, within range?
WRITE (6,12) I,Q(I) !Yes. Reveal the requested value.
12 FORMAT ("Q(",I0,") = ",I0) !This should do.
GO TO 10 !And ask again.
END IF ! WHILE read(5,*) i & i > 0 & i < enuff DO write(6,*) "Q(",i,")=",Q(i);
Closedown.
999 WRITE (6,*) "Bye."
END
Output:
First ten values: 1 1 2 3 3 4 5 5 6 6 Q(1000) = 502 Count of those elements 2:100000 which are less than their predecessor: 49798 Nominate an index (in 1:100000): 100000 Q(100000) = 48157 Nominate an index (in 1:100000): 0 Bye.
FreeBASIC
Const limite = 100000
Dim As Long Q(limite), i, cont = 0
Q(1) = 1
Q(2) = 1
For i = 3 To limite
Q(i) = Q(i-Q(i-1)) + Q(i-Q(i-2))
If Q(i) < Q(i-1) Then cont += 1
Next i
Print "Primeros 10 terminos: ";
For i = 1 To 10
Print Q(i) &" ";
Next i
Print
Print "Termino numero 1000: "; Q(1000)
Print "Terminos menores que los anteriores: " &cont
End
- Output:
Primeros 10 terminos: 1 1 2 3 3 4 5 5 6 6 Termino numero 1000: 502 Terminos menores que los anteriores: 49798
Fōrmulæ
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation —i.e. XML, JSON— they are intended for storage and transfer purposes more than visualization and edition.
Programs in Fōrmulæ are created/edited online in its website.
In this page you can see and run the program(s) related to this task and their results. You can also change either the programs or the parameters they are called with, for experimentation, but remember that these programs were created with the main purpose of showing a clear solution of the task, and they generally lack any kind of validation.
Solution
The following function calculate the given number of terms of the Hofstadter Q sequence:
Case 1 First 10 terms
Case 2 Confirm and display that the 1000th term is 502
Case 3 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,000th term.
Go
Sure there are ways that run faster or handle larger numbers; for the task though, maps and recursion work just fine.
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))
}
- 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
GW-BASIC
10 DIM Q!(1000)
20 Q(1) = 1: Q(2) = 1
30 FOR N = 3 TO 1000
40 Q(N) = Q(N - Q(N - 1)) + Q(N - Q(N - 2))
50 NEXT N
60 FOR N = 1 TO 10
70 PRINT Q(N)
80 NEXT N
90 PRINT Q(1000)
Haskell
The basic task:
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)
Extra credit task:
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)
- Output:
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)
Using a list (more or less) seemlessly backed up by a double resizing 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))
- 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.
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
Icon and Unicon
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
IS-BASIC
100 PROGRAM "QSequen.bas"
110 LET LIMIT=1000
120 NUMERIC Q(1 TO LIMIT)
130 LET Q(1),Q(2)=1
140 FOR I=3 TO LIMIT
150 LET Q(I)=Q(I-Q(I-1))+Q(I-Q(I-2))
160 NEXT
170 PRINT "First 10 terms:"
180 FOR I=1 TO 10
190 PRINT Q(I);
200 NEXT
210 PRINT :PRINT "Term 1000:";Q(1000)
J
Solution (bottom-up):
Qs=:0 1 1
Q=: verb define
n=. >./,y
while. n>:#Qs do.
Qs=: Qs,+/(-_2{.Qs){Qs
end.
y{Qs
)
Solution (top-down):
Q=: 1:`(+&$:/@:- $:@-& 1 2)@.(>&2)"0 M.
Example:
Q 1+i.10
1 1 2 3 3 4 5 5 6 6
Q 1000
502
+/2>/\ Q 1+i.100000
49798
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). We use the bottom up version for the extra credit part of this task (the expression which compares adjacent numbers and gave us the result 49798).
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.
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");
}
}
- 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
ES5
Based on memoization example from 'JavaScript: The Good Parts'.
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));
- 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
ES6
Memoising with the accumulator of a fold
(() => {
'use strict';
// hofQSeq :: Int -> [Int]
const hofQSeq = x =>
x > 2 ? tail(foldl((Q, n) =>
n < 3 ? Q : Q.concat(
Q[n - Q[n - 1]] + Q[n - Q[n - 2]]
), [0, 1, 1],
range(1, x))) : (x > 0 ? take(x, [1, 1]) : undefined);
// GENERIC FUNCTIONS -------------------------------------------
// foldl :: (b -> a -> b) -> b -> [a] -> b
const foldl = (f, a, xs) => xs.reduce(f, a),
// range :: Int -> Int -> [Int]
range = (m, n) =>
Array.from({
length: Math.floor(n - m) + 1
}, (_, i) => m + i),
// tail :: [a] -> [a]
tail = xs => xs.length ? xs.slice(1) : undefined,
// last :: [a] -> a
last = xs => xs.length ? xs.slice(-1)[0] : undefined,
// Int -> [a] -> [a]
take = (n, xs) => xs.slice(0, n);
// TEST --------------------------------------------------------
return {
firstTen: hofQSeq(10),
thousandth: last(hofQSeq(1000)),
'Q<Q-1UpTo10E5': hofQSeq(100000)
.reduce((a, x, i, xs) => x < xs[i - 1] ? a + 1 : a, 0)
};
})();
- Output:
{"firstTen":[1, 1, 2, 3, 3, 4, 5, 5, 6, 6],
"thousandth":502,
"Q<Q-1UpTo10E5":49798}
jq
For the tasks related to evaluating Q(n) directy, a recursive implementation is used, firstly because the task requirements refer to "recursion limits", and secondly to demonstrate one way to handle a cache in a functional language. To count the number of inversions, a non-recursive approach is used as it is faster and scales linearly.
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.
# For n>=2, Q(n) = Q(n - Q(n-1)) + Q(n - Q(n-2))
def Q:
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 ;
. 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(3; n) as $n
([1,1,1]; . + [ .[$n - .[$n-1]] + .[$n - .[$n - 2 ]] ] )) as $q
| reduce range(0; n) as $i
(0; . + (if $q[$i] > $q[$i + 1] then 1 else 0 end)) ;
# The three tasks:
((range(0;11), 1000) | "Q(\(.)) = \( . | Q)"),
(100000 | "flips(\(.)) = \(flips(.))")
Transcript
$ 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 0m0.562s
user 0m0.541s
sys 0m0.011s
Julia
The following implementation accepts an argument that is a single integer, an array of integers, or a range:
function hofstQseq(n, typerst::Type=Int)
nmax = maximum(n)
r = Vector{typerst}(nmax)
r[1] = 1
if nmax ≥ 2 r[2] = 1 end
for i in 3:nmax
r[i] = r[i - r[i - 1]] + r[i - r[i - 2]]
end
return r[n]
end
println("First ten elements of sequence: ", join(hofstQseq(1:10), ", "))
println("1000-th element: ", hofstQseq(1000))
- Output:
First ten elements of sequence: 1, 1, 2, 3, 3, 4, 5, 5, 6, 6 1000-th element: 502
And we can also count the number of times a value is less than its predecessor by, for example:
seq = hofstQseq(1:100_000)
cnt = count(diff(seq) .< 0)
println("$cnt elements are less than the preceding one.")
- Output:
49798 elements are less than the preceding one.
Since the implementation is non-recursive, there is no issue with recursion limits.
Kotlin
// version 1.1.4
fun main(args: Array<String>) {
val q = IntArray(100_001)
q[1] = 1
q[2] = 1
for (n in 3..100_000) q[n] = q[n - q[n - 1]] + q[n - q[n - 2]]
print("The first 10 terms are : ")
for (i in 1..10) print("${q[i]} ")
println("\n\nThe 1000th term is : ${q[1000]}")
val flips = (2..100_000).count { q[it] < q[it - 1] }
println("\nThe number of flips for the first 100,000 terms is : $flips")
}
- Output:
The first 10 terms are : 1 1 2 3 3 4 5 5 6 6 The 1000th term is : 502 The number of flips for the first 100,000 terms is : 49798
Lua
Here, the whole sequence up to the 100,000th term is generated for the first task, so this is where we risk hitting the recursion limit. As it happens, we do not. The function is called using 'pcall' so that any error would be caught. By increasing the argument on line 19 from 1e5 to 1e8, we can cause LuaJIT to run out of memory, but that is not necessary for this task.
function hofstadter (limit)
local Q = {1, 1}
for n = 3, limit do
Q[n] = Q[n - Q[n - 1]] + Q[n - Q[n - 2]]
end
return Q
end
function countDescents (t)
local count = 0
for i = 2, #t do
if t[i] < t[i - 1] then
count = count + 1
end
end
return count
end
local noError, hofSeq = pcall(hofstadter, 1e5)
if noError == false then
print("The sequence could not be calculated up to the specified limit.")
os.exit()
end
for i = 1, 10 do
io.write(hofSeq[i] .. " ")
end
print("\n" .. hofSeq[1000])
print(countDescents(hofSeq))
- Output:
1 1 2 3 3 4 5 5 6 6 502 49798
MAD
NORMAL MODE IS INTEGER
VECTOR VALUES FMT = $2HQ(,I4,3H) =,I4*$
DIMENSION Q(1000)
Q(1) = 1
Q(2) = 1
THROUGH FILL, FOR N=3, 1, N.G.1000
FILL Q(N) = Q(N-Q(N-1)) + Q(N-Q(N-2))
THROUGH SHOW, FOR N=1, 1, N.G.10
SHOW PRINT FORMAT FMT, N, Q(N)
PRINT FORMAT FMT, 1000, Q(1000)
END OF PROGRAM
- 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
Maple
We use automatic memoisation ("option remember") in the following. The use of "option system" assures that memoised values can be garbage collected.
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:
From this we get:
> seq( Q( i ), i = 1 .. 10 );
1, 1, 2, 3, 3, 4, 5, 5, 6, 6
> Q( 1000 );
502
To determine the number of "flips", we proceed as follows.
> 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
Alternatively, we can build the sequence in an array.
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:
This gives the same result.
> Qflips( 10^5 );
49798
Mathematica / Wolfram Language
Hofstadter[1] = Hofstadter[2] = 1;
Hofstadter[n_Integer?Positive] := Hofstadter[n] = Block[{$RecursionLimit = Infinity},
Hofstadter[n - Hofstadter[n - 1]] + Hofstadter[n - Hofstadter[n - 2]]
]
- Output:
Hofstadter /@ Range[10]
{1,1,2,3,3,4,5,5,6,6}
Hofstadter[1000]
502
Count[Differences[Hofstadter /@ Range[100000]], _?Negative]
49798
MATLAB / Octave
This solution pre-allocates memory and is an iterative solution, so caching or recursion limits do not apply.
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;
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
Maxima
/* Function that return the terms of the Hofstadter Q sequence */
hofstadter(n):=block(
if member(n,[1,2]) then L[n]:1 else L[n]:L[n-L[n-1]]+L[n-L[n-2]],
L[n])$
/* Test cases */
/* First ten terms */
makelist(hofstadter(i),i,1,10);
/* 1000th term */
last(makelist(hofstadter(i),i,1,1000));
- Output:
[1,1,2,3,3,4,5,5,6,6] 502
Modula-2
MODULE QSequence;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
VAR n: CARDINAL;
Q: ARRAY [1..1000] OF CARDINAL;
BEGIN
Q[1] := 1;
Q[2] := 1;
FOR n := 3 TO 1000 DO
Q[n] := Q[n-Q[n-1]] + Q[n-Q[n-2]];
END;
WriteString("The first 10 terms are:");
FOR n := 1 TO 10 DO
WriteCard(Q[n],2);
END;
WriteLn();
WriteString("The 1000th term is:");
WriteCard(Q[1000],4);
WriteLn();
END QSequence.
- Output:
The first 10 terms are: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502
MiniScript
cache = {1:1, 2:1}
Q = function(n)
if not cache.hasIndex(n) then
q = Q(n - Q(n-1)) + Q(n - Q(n-2))
cache[n] = q
end if
return cache[n]
end function
for i in range(1,10)
print "Q(" + i + ") = " + Q(i)
end for
print "Q(1000) = " + Q(1000)
- 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
Miranda
main :: [sys_message]
main = [Stdout (lay (map showq ([1..10] ++ [1000])))]
where showq n = "q!" ++ show n ++ " = " ++ show (q!n)
q :: [num]
q = 0 : 1 : 1 : map f [3..] where f n = q!(n - q!(n-1)) + q!(n - q!(n-2))
- 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
Nim
var q = @[1, 1]
for n in 2 ..< 100_000: q.add q[n-q[n-1]] + q[n-q[n-2]]
echo q[0..9]
assert q[0..9] == @[1, 1, 2, 3, 3, 4, 5, 5, 6, 6]
echo q[999]
assert q[999] == 502
var lessCount = 0
for n in 1 ..< 100_000:
if q[n] < q[n-1]:
inc lessCount
echo lessCount
- Output:
@[1, 1, 2, 3, 3, 4, 5, 5, 6, 6] 502 49798
Oberon-2
Works with oo2c version 2
MODULE Hofstadter;
IMPORT
Out;
VAR
i,count,q,prev: LONGINT;
founds: ARRAY 100001 OF LONGINT;
PROCEDURE Q(n: LONGINT): LONGINT;
BEGIN
IF founds[n] = 0 THEN
CASE n OF
1 .. 2:
founds[n] := 1
ELSE founds[n] := Q(n - Q(n - 1)) + Q(n - Q(n - 2))
END
END;
RETURN founds[n]
END Q;
BEGIN
(* first ten numbers in the sequence *)
FOR i := 1 TO 10 DO
Out.String("At ");Out.LongInt(i,0);Out.String(":> ");Out.LongInt(Q(i),4);Out.Ln
END;
Out.String("1000th value: ");Out.LongInt(Q(1000),4);Out.Ln;
prev := 1;
FOR i := 2 TO 100000 DO
q := Q(i);
IF q < prev THEN INC(count) END;
prev := q
END;
Out.String("terms less than the previous: ");Out.LongInt(count,4);Out.Ln
END Hofstadter.
Output:
At 1:> 1 At 2:> 1 At 3:> 2 At 4:> 3 At 5:> 3 At 6:> 4 At 7:> 5 At 8:> 5 At 9:> 6 At 10:> 6 1000th value: 502 terms less than the previous: 49798
OCaml
(* valid results for n in 0..119628 *)
let seq_hofstadter_q n =
let a = Bigarray.(Array1.create int16_unsigned c_layout n) in
let () =
for i = 0 to pred n do
a.{i} <- if i < 2 then 1 else a.{i - a.{pred i}} + a.{i - a.{i - 2}}
done
in
Seq.init n (Bigarray.Array1.get a)
let () =
let count_backflip (a, c) b = b, if b < a then succ c else c
and hq = seq_hofstadter_q 100_000 in
let () = Seq.(hq |> take 10 |> iter (Printf.printf " %u")) in
let () = Seq.(hq |> drop 999 |> take 1 |> iter (Printf.printf "\n%u\n")) in
hq |> Seq.fold_left count_backflip (0, 0) |> snd |> Printf.printf "%u\n"
- Output:
1 1 2 3 3 4 5 5 6 6 502 49798
Oforth
: QSeqTask
| q i |
ListBuffer newSize(100000) dup add(1) dup add(1) ->q
0 3 100000 for: i [
q add(q at(i q at(i 1-) -) q at(i q at(i 2 -) -) +)
q at(i) q at(i 1-) < ifTrue: [ 1+ ]
]
q left(10) println q at(1000) println println ;
- Output:
[1, 1, 2, 3, 3, 4, 5, 5, 6, 6] 502 49798
PARI/GP
Straightforward, unoptimized version; about 1 ms.
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)"));
- Output:
First 10 terms: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] (as expected) 1000-th term: 502 (as expected)
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.
- Output:
:> ./HofstadterQSequence 1 1 2 3 3 4 5 5 6 6 502 Flips: 49798
Perl
my @Q = (0,1,1);
push @Q, $Q[-$Q[-1]] + $Q[-$Q[-2]] for 1..100_000;
say "First 10 terms: [@Q[1..10]]";
say "Term 1000: $Q[1000]";
say "Terms less than preceding in first 100k: ",scalar(grep { $Q[$_] < $Q[$_-1] } 2..100000);
- Output:
First 10 terms: [1 1 2 3 3 4 5 5 6 6] Term 1000: 502 Terms less than preceding in first 100k: 49798
A more verbose and less idiomatic solution:
#!/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";
- 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!
This different 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.
#!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";
- Output:
1 1 2 3 3 4 5 5 6 6 502 Extra credit: 49798
Phix
Just to be flash, I also (on the desktop only) calculated the 100 millionth term - the only limiting factor here is the length of Q (theoretically 402,653,177 on 32 bit).
with javascript_semantics sequence Q = {1,1} function q(integer n) integer l = length(Q) while n>l do l += 1 Q &= Q[l-Q[l-1]]+Q[l-Q[l-2]] end while return Q[n] end function {} = q(10) -- (or collect one by one) printf(1,"First ten terms: %v\n",{Q[1..10]}) printf(1,"1000th: %d\n",q(1000)) printf(1,"100,000th: %,d\n",q(100_000)) integer n = 0 for i=2 to 100_000 do n += Q[i]<Q[i-1] end for printf(1,"Flips up to 100,000: %,d\n",{n}) if platform()!=JS then atom t0 = time() printf(1,"100,000,000th: %,d (%3.2fs)\n",{q(100_000_000),time()-t0}) end if
- Output:
First ten terms: {1,1,2,3,3,4,5,5,6,6} 1000th: 502 100,000th: 48,157 Flips up to 100,000: 49,798 100,000,000th: 50,166,508 (8.52s)
The last line shows fine under pwa/p2js, but would take about 20s.
Picat
go =>
println([q(I) : I in 1..10]),
println(q1000=q(1000)),
Q = {q(I) : I in 1..100_000},
println(flips=sum({1 : I in 2..100_000, Q[I-1] > Q[I]})),
nl.
table
q(1) = 1.
q(2) = 1.
q(N) = q(N-q(N-1)) + q(N-q(N-2)).
- Output:
[1,1,2,3,3,4,5,5,6,6] q1000 = 502 flips = 49798
PicoLisp
(de q (N)
(cache '(NIL) N
(if (>= 2 N)
1
(+
(q (- N (q (dec N))))
(q (- N (q (- N 2)))) ) ) ) )
Test:
: (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
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;
- 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
- Output:
for n=100,000
n=100000 48157
Bonus to produce the count of unordered values:
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);
- Output:
n=100000 48157 TALLY= 49798;
PL/M
100H:
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
PRINT$NUMBER: PROCEDURE (N);
DECLARE S (7) BYTE INITIAL ('..... $');
DECLARE (N, P) ADDRESS, C BASED P BYTE;
P = .S(5);
DIGIT:
P = P - 1;
C = N MOD 10 + '0';
N = N / 10;
IF N > 0 THEN GO TO DIGIT;
CALL PRINT(P);
END PRINT$NUMBER;
DECLARE Q (1001) ADDRESS;
DECLARE N ADDRESS;
Q(1)=1;
Q(2)=1;
DO N=3 TO LAST(Q);
Q(N) = Q(N-Q(N-1)) + Q(N-Q(N-2));
END;
CALL PRINT(.'THE FIRST 10 TERMS ARE: $');
DO N=1 TO 10;
CALL PRINT$NUMBER(Q(N));
END;
CALL PRINT(.(13,10,'THE 1000TH TERM IS: $'));
CALL PRINT$NUMBER(Q(1000));
CALL EXIT;
EOF
- Output:
THE FIRST 10 TERMS ARE: 1 1 2 3 3 4 5 5 6 6 THE 1000TH TERM IS: 502
PureBasic
If Not OpenConsole("Hofstadter Q sequence")
End 1
EndIf
#N = 100000
Define i.i, flip.i = 0
Dim q.i(#N)
q(1) = 1
q(2) = 1
For i = 3 To #N
q(i) = q(i - q(i - 1)) + q(i - q(i - 2))
Next
For i = 1 To #N - 1
flip + Bool(q(i) > q(i + 1))
Next
Print(~"First ten:\t")
For i = 1 To 10 : Print(LSet(Str(q(i)), 3)) : Next
PrintN(~"\n1000th:\t\t" + Str(q(1000)))
PrintN(~"Flips:\t\t" + Str(flip))
Input()
End
- Output:
First ten: 1 1 2 3 3 4 5 5 6 6 1000th: 502 Flips: 49798
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))
- 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:
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:])))
- 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
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)]))
Quackery
[ 2dup swap size dup negate swap within
not if
[ drop size 1+ number$
$ "Term " swap join
$ " of the Q sequence is not defined."
join message put bail ]
peek ] is qpeek ( [ n --> x )
[ dup dup -1 qpeek negate qpeek
dip [ dup dup -2 qpeek negate qpeek ]
+ join ] is next-q ( [ --> [ )
[ dup size 2 < iff
[ drop 0 ] done
0 swap behead swap
witheach
[ tuck > if [ dip 1+ ] ]
drop ] is drops ( [ --> n )
0 backup
[ ' [ 1 1 ]
998 times next-q
dup
-1 split swap 10 split drop
witheach [ echo sp ]
say "... "
0 peek echo cr
99000 times next-q
drops echo
say " decreasing terms" ]
bailed if
[ message take cr echo$ cr ]
- Output:
1 1 2 3 3 4 5 5 6 6 ... 502 49798 decreasing terms
R
cache <- vector("integer", 0)
cache[1] <- 1
cache[2] <- 1
Q <- function(n) {
if (is.na(cache[n])) {
value <- Q(n-Q(n-1)) + Q(n-Q(n-2))
cache[n] <<- value
}
cache[n]
}
for (i in 1:1e5) {
Q(i)
}
for (i in 1:10) {
cat(Q(i)," ",sep = "")
}
cat("\n")
cat(Q(1000),"\n")
count <- 0
for (i in 2:1e5) {
if (Q(i) < Q(i-1)) count <- count + 1
}
cat(count,"terms is less than its preceding term\n")
- Output:
1 1 2 3 3 4 5 5 6 6 502 49798 terms is less than its preceding term
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))
- Output:
'(1 1 2 3 3 4 5 5 6 6) 502 49798
Raku
(formerly Perl 6)
OO solution
Similar concept as the perl5 solution, except that the cache is only filled on demand.
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];
}
}
# Testing:
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";
- 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
With a lazily generated array, we automatically get caching.
my @Q = 1, 1, -> $a, $b {
(state $n = 1)++;
@Q[$n - $a] + @Q[$n - $b]
} ... *;
# Testing:
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";
(Same output.)
REXX
non-recursive
The REXX language doesn't allow expressions for stemmed array indices, so a temporary variable must be used.
/*REXX program generates the Hofstadter Q sequence for any specified N. */
parse arg a b c d . /*obtain optional arguments from the CL*/
if a=='' | a=="," then a= 10 /*Not specified? Then use the default.*/
if b=='' | b=="," then b= -1000 /* " " " " " " */
if c=='' | c=="," then c= -100000 /* " " " " " " */
if d=='' | d=="," then d= -1000000 /* " " " " " " */
@.= 1; ac= abs(c) /* [↑] negative #'s don't show values.*/
call HofstadterQ a; say
call HofstadterQ b; say 'HofstadterQ ' commas(abs(b))th(b) " term is: " commas(result)
call HofstadterQ c; say
downs= 0; do j=2 for ac-1; jm= j - 1
downs= downs + (@.j<@.jm)
end /*j*/
say commas(downs) ' HofstatdterQ terms are less then the previous term,' ,
' HofstatdterQ('commas(ac) || th(ac)") term is: " commas(@.ac)
call HofstadterQ d; ad= abs(d); say
say 'The ' commas(ad) || th(ad) ' HofstatdterQ term is: ' commas(@.ad)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
HofstadterQ: procedure expose @.; parse arg x 1 ox /*get number to generate through.*/
/* [↑] OX is the same as X. */
x= abs(x); w= length( commas(x) ) /*use absolute value; get length.*/
do j=1 for x /* [↓] use short─circuit IF test*/
if j>2 then if @.j==1 then do; jm1= j - 1; jm2= j - 2
one= j - @.jm1; two= j - @.jm2
@.j= @.one + @.two
end
if ox>0 then say 'HofstadterQ('right(j, w)"): " right(@.j,max(w,length(@.j)))
end /*j*/
return @.x /*return the │X│th term to caller*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg _; do ?=length(_)-3 to 1 by -3; _=insert(',', _, ?); end; return _
th: procedure; #=abs(arg(1)); return word('th st nd rd',1+#//10*(#//100%10\==1)*(#//10<4))
- output when using the internal default inputs:
HofstadterQ( 1): 1 HofstadterQ( 2): 1 HofstadterQ( 3): 2 HofstadterQ( 4): 3 HofstadterQ( 5): 3 HofstadterQ( 6): 4 HofstadterQ( 7): 5 HofstadterQ( 8): 5 HofstadterQ( 9): 6 HofstadterQ(10): 6 HofstadterQ 1,000th term is: 502 49,798 HofstatdterQ terms are less then the previous term, HofstatdterQ(100,000th) term is: 48,157 The 1,000,000th HofstatdterQ term is: 512,066
non-recursive, simpler
This REXX example is identical to the first version except that it uses a function to retrieve array elements which may have index expressions.
/*REXX program generates the Hofstadter Q sequence for any specified N. */
parse arg a b c d . /*obtain optional arguments from the CL*/
if a=='' | a=="," then a= 10 /*Not specified? Then use the default.*/
if b=='' | b=="," then b= -1000 /* " " " " " " */
if c=='' | c=="," then c= -100000 /* " " " " " " */
if d=='' | d=="," then d= -1000000 /* " " " " " " */
@.= 1; ac= abs(c) /* [↑] negative #'s don't show values.*/
call HofstadterQ a; say
call HofstadterQ b; say 'HofstadterQ ' commas(abs(b))th(b) " term is: " commas(result)
call HofstadterQ c; say
downs= 0; do j=2 for ac-1; jm= j - 1
downs= downs + (@.j<@.jm)
end /*j*/
say commas(downs) ' HofstatdterQ terms are less then the previous term,' ,
' HofstatdterQ('commas(ac) || th(ac)") term is: " commas(@.ac)
call HofstadterQ d; ad= abs(d); say
say 'The ' commas(ad) || th(ad) ' HofstatdterQ term is: ' commas(@.ad)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
HofstadterQ: procedure expose @.; parse arg x 1 ox /*get number to generate through.*/
/* [↑] OX is the same as X. */
x= abs(x); w= length( commas(x) ) /*use absolute value; get length.*/
do j=1 for x
if j>2 then if @.j==1 then @.j= @(j - @(j-1)) + @(j - @(j-2))
if ox>0 then say 'HofstadterQ('right(j, w)"): " right(@.j,max(w,length(@.j)))
end /*j*/
return @.x /*return the │X│th term to caller*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
@: parse arg ?; return @.? /*return value of @.? to invoker.*/
th: procedure; #=abs(arg(1)); return word('th st nd rd',1+#//10*(#//100%10\==1)*(#//10<4))
commas: parse arg _; do ?=length(_)-3 to 1 by -3; _=insert(',', _, ?); end; return _
- output is identical to the 1st REXX version.
Because of the additional subroutine (function) invokes, this REXX version is about half as fast as the 1st REXX version.
recursive
/*REXX program generates the Hofstadter Q sequence for any specified N. */
parse arg a b c d . /*obtain optional arguments from the CL*/
if a=='' | a=="," then a= 10 /*Not specified? Then use the default.*/
if b=='' | b=="," then b= -1000 /* " " " " " " */
if c=='' | c=="," then c= -100000 /* " " " " " " */
if d=='' | d=="," then d= -1000000 /* " " " " " " */
@.= 0; @.1= 1; @.2= 1; ac= abs(c) /* [↑] negative #'s don't show values.*/
call HofstadterQ a; say
call HofstadterQ b; say 'HofstadterQ ' commas(abs(b))th(b) " term is: " commas(result)
call HofstadterQ c; say
downs= 0; do j=2 for ac-1; jm= j - 1
downs= downs + (@.j<@.jm)
end /*j*/
say commas(downs) ' HofstatdterQ terms are less then the previous term,' ,
' HofstatdterQ('commas(ac) || th(ac)") term is: " commas(@.ac)
call HofstadterQ d; ad= abs(d); say
say 'The ' commas(ad) || th(ad) ' HofstatdterQ term is: ' commas(@.ad)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
HofstadterQ: procedure expose @.; parse arg x 1 ox /*get number to generate through.*/
/* [↑] OX is the same as X. */
x= abs(x); w= length( commas(x) ) /*use absolute value; get length.*/
do j=1 for x
if @.j==0 then @.j= QR(j) /*Not defined? Then define it.*/
if ox>0 then say 'HofstadterQ('right(j, w)"): " right(@.j,max(w,length(@.j)))
end /*j*/
return @.x /*return the │X│th term to caller*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
QR: procedure expose @.; parse arg n /*this QR function is recursive.*/
if @.n==0 then @.n= QR(n-QR(n-1)) + QR(n-QR(n-2)) /*Not defined? Then define it.*/
return @.n /*return the value to the invoker*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
th: procedure; #=abs(arg(1)); return word('th st nd rd',1+#//10*(#//100%10\==1)*(#//10<4))
commas: parse arg _; do ?=length(_)-3 to 1 by -3; _=insert(',', _, ?); end; return _
- output is identical to the 1st REXX version.
The recursive version is almost ten times slower than the (1st) non-recursive version.
Ring
n = 20
aList = list(n)
aList[1] = 1
aList[2] = 1
for i = 1 to n
if i >= 3 aList[i] = ( aList[i - aList[i-1]] + aList[i - aList[i-2]] ) ok
if i <= 20 see "n = " + string(i) + " : "+ aList[i] + nl ok
next
RPL
RPL code | Comment |
---|---|
≪ { 1 1 } 3 WHILE DUP 4 PICK ≤ REPEAT DUP2 2 - GETI ROT ROT GET → n q2 q1 ≪ DUP n q1 - GET OVER n q2 - GET + + n 1 + SWAP ≫ END DROP ≫ 'HOFST' STO |
HOFST ( m -- { Q(1)..Q(m) } ) initialize stack with Q1, Q2 and loop index n loop store n, Q(n-2) and Q(n-1) get Q(n-Q(n-1)) add Q(n-Q(n-2)) and add result to list put back n+1 in stack |
- Input:
10 HOFST 1000 HOSFT DUP SIZE GET
- Output:
2: { 1 1 2 3 3 4 5 5 6 6 } 1: 502
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}"
- 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
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
- Output:
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
Rust
Rust doesn't allow static Vec's (but there's lazy_static crate), thus memoization storage is allocated in main
.
fn hofq(q: &mut Vec<u32>, x : u32) -> u32 {
let cur_len=q.len()-1;
let i=x as usize;
if i>cur_len {
// extend storage
q.reserve(i+1);
for j in (cur_len+1)..(i+1) {
let qj=(q[j-q[j-1] as usize]+q[j-q[j-2] as usize]) as u32;
q.push(qj);
}
}
q[i]
}
fn main() {
let mut q_memo: Vec<u32>=vec![0,1,1];
let mut q=|i| {hofq(&mut q_memo, i)};
for i in 1..11 {
println!("Q({})={}", i, q(i));
}
println!("Q(1000)={}", q(1000));
let q100001=q(100_000); // precompute all
println!("Q(100000)={}", q100000);
let nless=(1..100_000).fold(0,|s,i|{if q(i+1)<q(i) {s+1} else {s}});
println!("Term is less than preceding term {} times", nless);
}
- 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(100001)=53471 Term is less than preceding term 49798 times
Scala
Naive but elegant version using only recursion doesn't work because runtime is excessive increasing ...
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))
}
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.
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)
}
- 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 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.
(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)
- Output:
Q(1 .. 10): 1 1 2 3 3 4 5 5 6 6 Q(1000): 502 bumps up to 100000: 49798
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;
- 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
SETL
program hofstadter_q;
q := [1,1];
loop for n in [3..100000] do
q(n) := q(n-q(n-1)) + q(n-q(n-2));
end loop;
print("First 10 terms: " + q(1..10));
print("1000th term: " + q(1000));
print("q(x) < q(x-1): " + #[x : x in [2..#q] | q(x) < q(x-1)]);
end program;
- Output:
First 10 terms: [1 1 2 3 3 4 5 5 6 6] 1000th term: 502 q(x) < q(x-1): 49798
Sidef
Using a memoized function:
func Q(n) is cached {
n <= 2 ? 1
: Q(n - Q(n-1))+Q(n-Q(n-2))
}
say "First 10 terms: #{ {|n| Q(n) }.map(1..10) }"
say "Term 1000: #{Q(1000)}"
say "Terms less than preceding in first 100k: #{2..100000->count{|i|Q(i)<Q(i-1)}}"
Using an array:
var Q = [0, 1, 1]
100_000.times {
Q << (Q[-Q[-1]] + Q[-Q[-2]])
}
say "First 10 terms: #{Q.slice(1).first(10)}"
say "Term 1000: #{Q[1000]}"
say "Terms less than preceding in first 100k: #{2..100000->count{|i|Q[i]<Q[i-1]}}"
- Output:
First 10 terms: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] Term 1000: 502 Terms less than preceding in first 100k: 49798
Swift
let n = 100000
var q = Array(repeating: 0, count: n)
q[0] = 1
q[1] = 1
for i in 2..<n {
q[i] = q[i - q[i - 1]] + q[i - q[i - 2]]
}
print("First 10 elements of the sequence: \(q[0..<10])")
print("1000th element of the sequence: \(q[999])")
var count = 0
for i in 1..<n {
if q[i] < q[i - 1] {
count += 1
}
}
print("Number of times a member of the sequence is less than the preceding term for terms up to and including the 100,000th term: \(count)")
- Output:
First 10 elements of the sequence: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] 1000th element of the sequence: 502 Number of times a member of the sequence is less than the preceding term for terms up to and including the 100,000th term: 49798
Tailspin
templates q
def outputFrom: $(1);
def until: $(2);
@: [1,1];
1..$until -> #
when <$@::length~..> do
..|@: $@($ - $@($ - 1)) + $@($ - $@($ - 2));
$ -> #
when <$outputFrom..> do
$@($) !
end q
[1,10] -> q -> '$; ' -> !OUT::write
'
' -> !OUT::write
[1000,1000] -> q -> '$;
' -> !OUT::write
templates countDownSteps
@: 0;
def qs: $;
2..$qs::length -> #
$@ !
when <?($qs($) <..~$qs($-1)>)> do @: $@ + 1;
end countDownSteps
[[1, 100000] -> q] -> countDownSteps -> 'Less than previous $; times' -> !OUT::write
- Output:
1 1 2 3 3 4 5 5 6 6 502 Less than previous 49798 times
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"
- 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
uBasic/4tH
uBasic/4tH simply lacks the memory to make it through to the 1000th term. 256 is the best it can do.
Print "First 10 terms of Q = " ;
For i = 1 To 10 : Print FUNC(_q(i));" "; : Next : Print
Print "256th term = ";FUNC(_q(256))
End
_q Param(1)
Local(2)
If a@ < 3 Then Return (1)
If a@ = 3 Then Return (2)
@(0) = 1 : @(1) = 1 : @(2) = 2
c@ = 0
For b@ = 3 To a@-1
@(b@) = @(b@ - @(b@-1)) + @(b@ - @(b@-2))
If @(b@) < @(b@-1) Then c@ = c@ + 1
Next
Return (@(a@-1))
- Output:
First 10 terms of Q = 1 1 2 3 3 4 5 5 6 6 256th term = 123 0 OK, 0:320
VBA
Public Q(100000) As Long
Public Sub HofstadterQ()
Dim n As Long, smaller As Long
Q(1) = 1
Q(2) = 1
For n = 3 To 100000
Q(n) = Q(n - Q(n - 1)) + Q(n - Q(n - 2))
If Q(n) < Q(n - 1) Then smaller = smaller + 1
Next n
Debug.Print "First ten terms:"
For i = 1 To 10
Debug.Print Q(i);
Next i
Debug.print
Debug.Print "The 1000th term is:"; Q(1000)
Debug.Print "Number of times smaller:"; smaller
End Sub
- Output:
First ten terms: 1 1 2 3 3 4 5 5 6 6 The 1000th term is: 502 Number of times smaller: 49798
VBScript
Sub q_sequence(n)
Dim Q()
ReDim Q(n)
Q(1)=1 : Q(2)=1 : Q(3)=2
less_precede = 0
For i = 4 To n
Q(i)=Q(i-Q(i-1))+Q(i-Q(i-2))
If Q(i) < Q(i-1) Then
less_precede = less_precede + 1
End If
Next
WScript.StdOut.Write "First 10 terms of the sequence: "
For j = 1 To 10
If j < 10 Then
WScript.StdOut.Write Q(j) & ", "
Else
WScript.StdOut.Write "and " & Q(j)
End If
Next
WScript.StdOut.WriteLine
WScript.StdOut.Write "1000th term of the sequence: " & Q(1000)
WScript.StdOut.WriteLine
WScript.StdOut.Write "Number of times the member of the sequence is less than its preceding term: " &_
less_precede
End Sub
q_sequence(100000)
- Output:
First 10 terms of the sequence: 1, 1, 2, 3, 3, 4, 5, 5, 6, and 6 1000th term of the sequence: 502 Number of times the member of the sequence is less than its preceding term: 49798
Visual FoxPro
LOCAL p As Integer, i As Integer
CLEAR
p = 0
? "Hofstadter Q Sequence"
? "First 10 terms:"
FOR i = 1 TO 10
?? Q(i, @p)
ENDFOR
? "1000th term:", Q(1000, @p)
? "100000th term:", q(100000, @p)
? "Number of terms less than the preceding term:", p
FUNCTION Q(n As Integer, k As Integer) As Integer
LOCAL i As Integer
LOCAL ARRAY aq[n]
aq[1] = 1
IF n > 1
aq[2] = 1
ENDIF
k = 0
FOR i = 3 TO n
aq[i] = aq[i - aq[i-1]] + aq[i-aq[i-2]]
IF aq(i) < aq(i-1)
k = k + 1
ENDIF
ENDFOR
RETURN aq[n]
ENDFUNC
- Output:
Hofstadter Q Sequence First 10 terms: 1 1 2 3 3 4 5 5 6 6 1000th term: 502 100000th term: 48157 Number of terms less than the preceding term: 49798
Wren
var N = 1e5
var q = List.filled(N + 1, 0)
q[1] = 1
q[2] = 1
for (n in 3..N) q[n] = q[n - q[n-1]] + q[n - q[n-2]]
System.print("The first ten terms of the Hofstadter Q sequence are:")
System.print(q[1..10])
System.print("\nThe thousandth term is %(q[1000]).")
var flips = 0
for (n in 2..N) {
if (q[n] < q[n-1]) flips = flips + 1
}
System.print("\nThere are %(flips) flips in the first %(N) terms.")
- Output:
The first ten terms of the Hofstadter Q sequence are: [1, 1, 2, 3, 3, 4, 5, 5, 6, 6] The thousandth term is 502. There are 49798 flips in the first 100000 terms.
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);
]
- Output:
1 1 2 3 3 4 5 5 6 6 502 49798
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);
- Output:
1 1 2 3 3 4 5 5 6 6 502 flips: 49798
ZX Spectrum Basic
Extra credit 100000 is not implemented because of memory limitations.
10 PRINT "First 10 terms of Q = "
20 FOR i=1 TO 10: GO SUB 1000: PRINT s;" ";: NEXT i: PRINT
30 LET i=1000
40 PRINT "1000th term = ";: GO SUB 1000: PRINT s
50 PRINT "Term is less than preceding term ";c;" times"
100 STOP
1000 REM Qsequence subroutine
1010 IF i<3 THEN LET s=1: RETURN
1020 IF i=3 THEN LET s=2: RETURN
1030 DIM q(i)
1040 LET q(1)=1: LET q(2)=1: LET q(3)=2
1050 LET c=0
1060 FOR j=3 TO i
1070 LET q(j)=q(j-q(j-1))+q(j-q(j-2))
1080 IF q(j)<q(j-1) THEN LET c=c+1
1090 NEXT j
1100 LET s=q(i)
1110 RETURN
- Programming Tasks
- Solutions by Programming Task
- 11l
- 360 Assembly
- 8080 Assembly
- 8086 Assembly
- Action!
- Ada
- ALGOL 68
- ALGOL-M
- ALGOL W
- APL
- ARM Assembly
- Arturo
- AutoHotkey
- AWK
- BASIC
- BASIC256
- BBC BASIC
- QBasic
- True BASIC
- XBasic
- Yabasic
- Bracmat
- BCPL
- C
- C sharp
- C++
- Clojure
- CLU
- CoffeeScript
- COBOL
- Common Lisp
- Cowgol
- D
- Dart
- Draco
- EasyLang
- EchoLisp
- Eiffel
- Elixir
- Erlang
- ERRE
- Delphi
- SysUtils,StdCtrls
- F Sharp
- Factor
- Fermat
- Forth
- Fortran
- FreeBASIC
- Fōrmulæ
- Go
- GW-BASIC
- Haskell
- Icon
- Unicon
- Icon Programming Library
- IS-BASIC
- J
- Java
- Memoization
- JavaScript
- Jq
- Julia
- Kotlin
- Lua
- MAD
- Maple
- Mathematica
- Wolfram Language
- MATLAB
- Octave
- Maxima
- Modula-2
- MiniScript
- Miranda
- Nim
- Oberon-2
- OCaml
- Oforth
- PARI/GP
- Pascal
- Perl
- Phix
- Picat
- PicoLisp
- PL/I
- PL/M
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- REXX
- Ring
- RPL
- Ruby
- Run BASIC
- Rust
- Scala
- Scheme
- Seed7
- SETL
- Sidef
- Swift
- Tailspin
- Tcl
- UBasic/4tH
- VBA
- VBScript
- Visual FoxPro
- Wren
- XPL0
- Zkl
- ZX Spectrum Basic
- Pages with too many expensive parser function calls