aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

32
Task/Hofstadter-Q-sequence/Bracmat/hofstadter-q-sequence.bracmat Normal file
View file

@ -0,0 +1,32 @@
( 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
);

15
Task/Hofstadter-Q-sequence/Common-Lisp/hofstadter-q-sequence-2.lisp
View file

@ -1,3 +1,12 @@
First of Q: (1 1 2 3 3 4 5 5 6 6)
Q(1000): 502
Bumps up to 100000: 49798
(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)))

22
Task/Hofstadter-Q-sequence/D/hofstadter-q-sequence-2.d
View file

@ -1,20 +1,14 @@
import std.stdio, std.algorithm, std.range, std.array;
struct Q {
__gshared static Appender!(uint[]) s;
uint Q(in int n) nothrow
in {
assert(n > 0);
} body {
__gshared static Appender!(int[]) s = [0, 1, 1];
nothrow static this() {
s ~= [0, 1, 1];
}
static uint opCall(in int n) nothrow
in {
assert(n > 0);
} body {
foreach (immutable i; s.data.length .. n + 1)
s ~= s.data[i - s.data[i - 1]] + s.data[i - s.data[i - 2]];
return s.data[n];
}
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() {

51
Task/Hofstadter-Q-sequence/Eiffel/hofstadter-q-sequence.e Normal file
View file

@ -0,0 +1,51 @@
class
APPLICATION
inherit
ARGUMENTS
create
make
feature
make
local
count,i: INTEGER
do
io.put_string ("%NFirst ten numbers: %N")
test:=seq (10)
across test as ar loop io.put_string (ar.item.out + "%T") end
test:= seq (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
test: ARRAY[INTEGER]
seq(lim: INTEGER): ARRAY[INTEGER]
require
lim_positive: lim>0
local
q: ARRAY[INTEGER]
i: INTEGER
do
create q.make_filled(1, 1, lim)
q[1]:= 1
q[2]:= 1
from
i:= 3
until
i> lim
loop
q[i]:= q[i-q[i-1]]+q[i-q[i-2]]
i:= i+1
end
Result:= q
end
end

36
Task/Hofstadter-Q-sequence/Oberon-2/hofstadter-q-sequence.oberon-2 Normal file
View file

@ -0,0 +1,36 @@
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.

4
Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-1.rexx
View file

@ -12,9 +12,9 @@ exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────HofstadterQ subroutine──────────────*/
HofstadterQ: procedure expose q.; arg x 1 ox /*get the # to gen through*/
/*(above) OX is the same as X.*/
x=abs(x) /*use the absolute value for X. */
x=abs(x) /*use the absolute value for X. */
L=length(x) /*use for right justified output.*/
do j=1 for x
do j=1 for x
if j>2 then if q.j==1 then do; jm1=j-1; jm2=j-2
_1=j-q.jm1; _2=j-q.jm2
q.j=q._1+q._2

2
Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-2.rexx
View file

@ -14,7 +14,7 @@ HofstadterQ: procedure expose q.; arg x 1 ox /*get the # to gen through*/
/*(above) OX is the same as X.*/
x=abs(x) /*use the absolute value for X. */
L=length(x) /*use for right justified output.*/
do j=1 for x
do j=1 for x
if j>2 then if q.j==1 then q.j=q(j-q(j-1)) + q(j-q(j-2))
if ox>0 then say right(j,L) right(q.j,L) /*if X>0, tell*/
end /*j*/

47
Task/Hofstadter-Q-sequence/Scheme/hofstadter-q-sequence.ss Normal file
View file

@ -0,0 +1,47 @@
(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)