REBOL [
    Title:   "Ackermann"
    Author:  "Aldo Calpini"
    Date:    03-Jul-2001
    File:    %ackermann.r
]

Ack: func [M N] [
    return either M > 0  
        [ either N > 0 
            [ Ack M - 1 Ack M N - 1 ]
            [ Ack M - 1 1 ]
        ]
        [ N + 1 ]
]

NUM: to-integer to-string first system/script/args
NUM: either NUM < 1 [ 1 ] [ NUM ]
R: Ack 3 NUM
print rejoin [ "Ack(3," NUM "): " R ]

REBOL [
    Title:   "Fibonacci"
    Author:  "Aldo Calpini"
    Date:    03-Jul-2001
    File:    %fibo.r
]

Fib: func [N] [
    return either N < 2  [ 1 ] [ (Fib N - 2) + (Fib N - 1) ]
]

NUM: to-integer to-string system/script/args
NUM: either NUM < 1 [ 1 ] [ NUM ]
R: Fib NUM
write %output.rebol rejoin [ R ]

REBOL [
    Title:   "Hash"
    Author:  "Aldo Calpini"
    Date:    05-Jul-2001
    File:    %hash.r
]

NUM: to-integer to-string system/script/args
NUM: either NUM < 1 [ 1 ] [ NUM ]

myhex: func [ N /local k flag c r ] [
    k: to-hex N
    k: to-string k
    flag: 0
    r: copy ""
    forall k [
        c: first k
        if (c <> #"0") or (flag = 1) [
            append r c
            flag: 1
        ]
    ]
    return r
]

X: make hash! []
c: 0
for i 1 NUM 1 [
    append X myhex i
    append X i
]

for i NUM 1 -1 [
    s: to-string i
    if select/skip X s 2 [
        c: c + 1
    ]
]
print c

write %output.rebol c

REBOL [
    Title:   "Hash2"
    Author:  "Aldo Calpini"
    Date:    05-Jul-2001
    File:    %hash2.r
]

NUM: to-integer to-string system/script/args
NUM: either NUM < 1 [ 1 ] [ NUM ]

hash1: make [] 9999

for i 0 9999 1 [
    append hash1 rejoin [ "foo_" i ]
    append hash1 i
]

hash2: make [] 9999

for i 1 NUM 1 [

    hash1: head hash1
    forskip hash1 2 [
        k: first hash1
        hash2: head hash2
        k2: select/skip hash2 k 2 
        either k2 == none [
            append hash2 k
            append hash2 0
            v: 0
            hash2: head hash2
            hash2: find/skip hash2 k 2
        ] [
            hash2: find/skip hash2 k 2
            v: second hash2
        ]
        v1: first select/skip hash1 k 2        
        v2: (v + v1)
        comment [
            hash2: head hash2
            hash2: find/skip hash2 k 2         
            hash2: next hash2
        ]
        hash2: next hash2
        change hash2 v2
        comment [        
            if error? try [ change hash2 v2 ] [ 
                print [ "error in change hash2 (k=" k ")" ]
                probe hash2 
            ]
        ]
    ]
    hash2: head hash2
]

hash1: head hash1
hash2: head hash2

write %output.rebol [ 
    select/skip hash1 "foo_1" 2
    select/skip hash1 "foo_9999" 2
    select/skip hash2 "foo_1" 2
    select/skip hash2 "foo_9999" 2
]

REBOL [
    Title:   "Heapsort"
    Author:  "Aldo Calpini"
    Date:    03-Jul-2001
    File:    %heapsort.r
]

IM: 139968
IA:   3877
IC:  29573

LAST: 42

gen_random: func [N] [
    LAST: (LAST * IA + IC) // IM
    return N * LAST / IM
]

heapsort: func [
    n ra
    /local 
        rra [decimal!]
        l [integer!]
        ir [integer!]
        j [integer!]
        k [integer!]
] [
    l: n / 2 + 1
    ir: n
    while [1] [
    
        either l > 1 [
            l: l - 1
            rra: pick ra l
        ] [
            rra: pick ra ir
            v: pick ra 1
            change at ra ir v
            ir: ir - 1
            if [ir = 1] [
                change at ra 1 rra
                return
            ]
        ]
        i: l
        j: l * 2
        
        while [ j <= ir ] [
            if j < ir [
                v1: pick ra j
                v2: pick ra (j + 1)
                if v1 < v2 [
                    j: j + 1
                ]
            ]
            v: pick ra j
            either rra < v [
                change at ra i v
                i: j
                j: j + i
            ] [
                j: ir + 1
            ]
        ]
        change at ra i rra
    ]
]

                

NUM: to-integer to-string system/script/args
NUM: either NUM < 1 [ 1 ] [ NUM ]

ary: copy []
for i 1 NUM 1 [
    insert tail ary gen_random 1
]

heapsort NUM ary

probe ary

v: pick ary NUM

print v
write %output.rebol v

REBOL [
    Title:   "Lists"
    Author:  "Aldo Calpini"
    Date:    03-Jul-2001
    File:    %lists.r
]

SIZE: 10000

ITER: to-integer to-string system/script/args
ITER: either ITER < 1 [ 1 ] [ ITER ]

test_lists: func [ /local A Li1 Li2 Li3 ] [
    comment [
        create a list of integers (Li1) from 1 to SIZE
    ]
    Li1: copy []
    for A 1 SIZE 1 [
        insert tail Li1 A
    ]

    comment[
        copy the list to Li2 (not by individual items)
    ]
    Li2: copy Li1

    comment [
        remove each individual item from left side of Li2 and
        append to right side of Li3 (preserving order)
    ]
    Li3: copy []
    Li2: head Li2
    while[not tail? Li2] [
        insert tail Li3 Li2/1
        remove Li2        
    ]

    comment [ 
        Li2 must now be empty
        remove each individual item from right side of Li3 and
        append to right side of Li2 (reversing list)
    ]

    Li3: head Li3
    while[not tail? Li3] [
        last Li3
        insert Li2 Li3/1
        remove Li3
    ]
    
    comment [        
        Li3 must now be empty
        reverse Li1 in place
    ]
    reverse Li1

    comment [
        check that first item is now SIZE
    ]
    
    if Li1/1  <> SIZE [
        return -1
    ]

    Li1: head Li1
    Li2: head Li2

    while [not tail? Li1] [
        if Li1/1 <> Li2/1 [
            return 0
        ]
        Li1: next Li1
        Li2: next Li2
    ]
    Li1: head Li1
    return length? Li1
]

result: 0
while [ ITER > 0 ] [
    result: test_lists
    ITER: ITER - 1
]

write %output.rebol rejoin [ result ]

REBOL [
    Title:   "Sieve of Erathostenes"
    Author:  "Aldo Calpini"
    Date:    03-Jul-2001
    File:    %sieve.r
]

NUM: to-integer to-string system/script/args
NUM: either NUM < 1 [ 1 ] [ NUM ]

while [ NUM > 0 ] [
    count: 0
    comment [
        flags: array/initial 1 8192
    ]

    flags: copy []
    for i 0 8192 1 [
        insert tail flags 1
    ]
    flags: head flags

    for i 2 8192 1 [
        p: pick flags i
        if p = 1 [
            k: i + i            
            while [ k <= 8192 ] [
                change at flags k 0
                k: k + i
            ]
            count: count + 1
        ]
    ]
    NUM: NUM - 1
]

write %output.rebol rejoin [ "Count: " count ]