parse arg n
If n < 1 Then Do
    n = 1
End

R = Ack(3,N)

say "Ack(3,"n"): "R
exit

Ack:
    PROCEDURE
    PARSE ARG M,N
    IF M<1 THEN RETURN N+1
    IF N<1 THEN RETURN Ack(M-1, 1)
    R1 = Ack(M, N-1)
    RETURN Ack(M-1, R1)    
    

parse arg n
If n < 1 Then Do
    n = 1
End

last = n - 1

Y.0 = 0
Do i = 0 To last
    X.i = i + 1
    Y.i = 0
End

Do k = 0 To 999
    Do i = last To 0 By -1
        Y.i = Y.i + X.i
    End
End

say Y.0" "Y.last

nl = 0
nw = 0
nc = 0
DO UNTIL LINES() = 0
    PARSE LINEIN L
    nw = nw + WORDS(L)
    nc = nc + LENGTH(L) + 1
    nl = nl + 1
END
nc = nc - 1
nl = nl - 1
SAY nl nw nc

parse arg n
If n < 1 Then Do
    n = 1
End

R = fib(N)

say R
exit

fib:
    PROCEDURE
    PARSE ARG N
    IF N<2 THEN RETURN 1
    RETURN fib(N-2) + fib(N-1)

parse arg n
If n < 1 Then Do
    n = 1
End

Do i = 1 To n
    xx = d2x(i)
    X.xx = i
End

c = 0

Do i = n To 1 By -1
    if X.i <> "X."i Then Do
        c = c + 1
    End
End
Say c

parse arg n
If n < 1 Then Do
    n = 1
End

keys.0 = 10000
Do i = 0 To 9999
    k = "FOO_"i
    hash1.k = i
    ki = i + 1
    keys.ki = k
End

hash2. = 0
Do i = 1 To n
    Do j = 1 To keys.0
        k = keys.j
        hash2.k = hash2.k + hash1.k    
    End
End

Say hash1.FOO_1" "hash1.FOO_9999" "hash2.FOO_1" "hash2.FOO_9999

NUMERIC DIGITS 10

vIM=139968
vIA=3877
vIC=29573

LAST=42

parse arg n
If n < 1 Then Do
    n = 1
End

Do i = 1 TO N
    ary.i = gen_random(1)
End

CALL heapsort N

SAY ary.N

EXIT

gen_random:
    PROCEDURE EXPOSE LAST vIM vIA vIC
    PARSE ARG n
    LAST = (LAST * vIA + vIC) // vIM
    return n * LAST / vIM

heapsort:
    PARSE ARG n
    rra = 0
    i = 0
    j = 0
    l = (n % 2) + 1
    ir = n
    
    Do While 1
        If l > 1 Then Do
            l = l - 1
            rra = ary.l
        End
        Else Do
            rra = ary.ir
            ary.ir = ary.1
            ir = ir - 1
            If ir = 1 Then Do
                ary.1 = rra
                return
            End
        End
        
        i = l
        j = l * 2

        Do While  j <= ir
            If j < ir Then Do
                jj = j+1
                If ary.j < ary.jj Then Do
                    j = j + 1
                End
            End
            
            If rra < ary.j Then Do
                ary.i = ary.j
                i = j
                j = j + i
            End
            Else Do
                j = ir + 1
            End
        End
        ary.i = rra
    End    

say "hello world"

SIZE = 10000

parse arg ITER
If ITER < 1 Then Do
    ITER = 1
End

result = 0
Do While ITER > 0
    result = test_lists()
    ITER = ITER - 1
End
Say result
exit

test_lists

test_lists:
    
    Do A = 0 To SIZE
        Li1.A = A
    End
    
    
    /* [dada] this should work, but does not:
     * Li2. = Li1.
     */
    Do A = 0 To SIZE
        Li2.A = Li1.A
    End
    
    
    
    Do A = 0 To SIZE
        B = SIZE - A
        Li3.A = Li2.B
    End
    
    
    
    
    
    Do A = 0 To SIZE
        Li2.A = Li3.A
    End
        
    
    
    
    Do A = 0 To SIZE
        B = SIZE-A
        Li4.A = Li1.B
    End
    Do A = 0 To SIZE
        Li1.A = Li4.A
    End
    
    
    If Li1.0 <> SIZE Then Do
        return -1
    End
    
    
    Do i = 0 To SIZE
        
        If Li1.i <> Li2.i Then Do
            return 0
        End
    End
    return SIZE

size = 30

parse arg n
If n < 1 Then Do
    n = 1
End

call mkmatrix size, size, "m1"
call mkmatrix size, size, "m2"
Do While n > 0
    call mmult(size, size, "m1", "m2", "mm")
    n = n - 1
End
say mm.0.0" "mm.2.3" "mm.3.2" "mm.4.4

exit

mkmatrix:
    parse arg rows, cols, mx
    rows = rows - 1
    cols = cols - 1
    count = 1
    Do r = 0 To rows
        Do c = 0 To cols
            interpret mx || ".r.c = " count
            count = count + 1
        End
    End
    return mx

mmult:
    parse arg rows, cols, m1, m2, m3
    rows = rows - 1
    cols = cols - 1
    Do i = 0 To rows
        Do j = 0 To cols
            val = 0
            Do k = 0 To cols
                interpret "val = val + " || m1 || ".i.k * " || m2 || ".k.j"
            End
            interpret m3 || ".i.j = " val
        End
    End

parse arg n
If n < 1 Then Do
    n = 1
End

x = 0

Do A = 1 To n
    Do B = 1 To n
        Do C = 1 To n
            Do D = 1 To n
                Do E = 1 To n
                    Do F = 1 To n
                        x = x + 1
                    End
                End
            End
        End
    End
End

say x

NUMERIC DIGITS 10

vIM=139968
vIA=3877
vIC=29573

LAST=42

parse arg n
If n < 1 Then Do
    n = 1
End

Do i = 1 TO N
    result = gen_random(100)
End

SAY result

EXIT

gen_random:
    PROCEDURE EXPOSE LAST vIM vIA vIC
    PARSE ARG n
    LAST = (LAST * vIA + vIC) // vIM
    return n * LAST / vIM

A = 1
DO UNTIL LINES() = 0
    PARSE LINEIN L
    PUSH L
    A = A + 1
END
PULL
DO B = A-2 TO 1 BY -1
    PARSE PULL L
    SAY L
END

parse arg n
If n < 1 Then Do
    n = 1
End


Do While n > 0
    count = 0
    Do j = 0 To 8192
        flags.j = 1
    End
    Do i = 2 To 8192
        If flags.i <> 0 Then Do
            Do k = i+i To 8192 By i
                flags.k = 0
            End
            count = count + 1
        End
    End
    n = n - 1
End

say "Count: "count

NUMERIC DIGITS 10

n = 1
nums. = 0
sum = 0
DO WHILE LINES() <> 0
    PARSE LINEIN L
    IF L <> "" THEN DO
        INTERPRET "sum = sum + " L
        INTERPRET "nums." || n || "=" || L
        n = n + 1
    END
END

n = n - 1
nums.0 = n
mean = sum/n
average_deviation = 0
standard_deviation = 0
variance = 0
skew = 0
kurtosis = 0
DO I = 1 TO nums.0
    deviation = nums.I - mean
    average_deviation = average_deviation + ABS(deviation)
    variance = variance + deviation ** 2
    skew = skew + deviation ** 3
    kurtosis = kurtosis + deviation ** 4
END
average_deviation = average_deviation / n
variance = variance / (n-1)
standard_deviation = SQRT(variance)

IF variance <> 0 THEN DO
    skew = skew / (n * variance * standard_deviation)
    kurtosis = kurtosis / (n * variance * variance) - 3
END

call qqsort 1, n

mid = n%2+1
if n//2 <> 0 then do
    median = nums.mid
end 
else do
    pmid = mid - 1
    median = (nums.mid + nums.pmid) / 2
end

SAY sprintf("n:                  %d", n)
SAY sprintf("median:             %-.6f", median)
SAY sprintf("mean:               %-.6f", mean)
SAY sprintf("average_deviation:  %-.6f", average_deviation)
SAY sprintf("standard_deviation: %-.6f", standard_deviation)
SAY sprintf("variance:           %-.6f", variance)
SAY sprintf("skew:               %-.6f", skew)
SAY sprintf("kurtosis:           %-.6f", kurtosis)

EXIT

SQRT: PROCEDURE
  ARG n
        
        
  ans = n / 2                   
  prevans = n                   
  do until prevans = ans        
     prevans = ans              
     ans = ( prevans + ( n / prevans ) ) / 2
  end
return ans




SQRTOLD:
    PROCEDURE
    PARSE ARG n
    parse value format(n,,,,0) with mant "E" exp
    if exp = "" then exp = 0
    if exp//2 < > 0 then do
       mant = mant * 10
       exp = exp -1
    end
    root = 0
    do 10
       do digit = 9 by -1 to 0,
          while,
          (root + digit) ** 2 > mant
       end
       root = root + digit
       if root**2 = mant then leave
       root = root * 10
       mant = mant * 100
       exp = exp -2
    end
return root * 10**(exp/2)
    
    









































































sprintf: procedure
  argno = 1                     
  string = ""
  start = 1                     
  len = length(arg(1))

  do until(p >= len)
    s = ""
    argno = argno + 1
    p = pos("%", arg(1), start)
    if p = 0 then
    do
      p = len + 1
    end
    if substr(arg(1), p, 1) == "%" then
    do
      s = "%"
    end
    string = string || substr(arg(1), start, p - start)
    start = p + 1
    p = verify(arg(1), "%cdfsx", "M", start)
    if p = 0 then
      leave
    spec = substr(arg(1), start, p - start + 1)
    start = p + 1
    r = right(spec, 1)
    spec = delstr(spec, length(spec), 1)
    if left(spec,1) == "-" then
    do                          
      left = 1
      spec = substr(spec, 2)
    end
    else
    do
      left = 0
      spec = substr(spec, 1)
    end
    if spec \== "" then                 
      parse var spec width "." prec
    else
    do
      width = 0
      prec = 0
    end
    if \datatype(width, "W") then
      width = 0
    if \datatype(prec, "W") then
      prec = 0
    pad = " "

    select

      when r == "s" then
      do
        if width = 0 then
          width = length(arg(argno))
        if prec \= 0 then
          s = left(arg(argno), prec)     
        else
          s = arg(argno)
      end

      when r == "d" then
      do
        if width = 0 then
          width = length(arg(argno))
        s = format(arg(argno), length(arg(argno)), 0)
      end

      when r == "f" then
      do
        if arg(argno) > -1 & arg(argno) < 1 then
          pad = "0"
        parse value arg(argno) with int "." frac
        if width = 0 & prec = 0 then
        do
          d = 1
          if arg(argno) < 0 then d = 2
          width = digits() + d
          prec = digits() - (length(int)) + d - 1
        end
        if width = 0 then
          width = len - prec
        s = format(arg(argno), width, prec, 0)
      end

      when r == "x" then
      do
        if width = 0 then
          width = length(arg(argno))
        s = d2x(arg(argno))
        if prec \= 0 then
          s = left(s, prec)     
      end

      when r == "%" then
      do
        argno = argno - 1
      end

      otherwise
        nop

    end 

    if r \== "%" then
    do
      if left then
        s = left(strip(s), width, pad)      
      else
        s = right(strip(s), width, pad)
    end
    string = string || s
  end 
return string




Fast Quick sort



/*
This is a fast quick sort routine. 

Author: Ruediger Wilke 
*/
 











qqsort: procedure expose nums.

  arg lf, re

  if re -lf < 9 then
    do lf = lf to re -1

      m = lf

      do j = lf +1 to re
        if nums.j < nums.m then
          m = j
      end 

      t = nums.m; nums.m = nums.lf; nums.lf = t

    end 
    else
    do
      i = lf
      j = re
      k = (lf + re)%2
      t = nums.k

      do until i > j

        do while nums.i < t
          i = i + 1
        end 

        do while nums.j > t
          j = j - 1
        end 

        if i <= j then
        do
          xchg = nums.i
          nums.i = nums.j
          nums.j = xchg
          i = i + 1
          j = j - 1
        end 

      end 

      call qqsort lf, j
      call qqsort i, re
    end 

return




  
    

parse arg n
If n < 1 Then Do
    n = 1
End

str = ""
Do I=1 to N
    str = str || "hello" || D2C(13)
End
say length(str)

NUMERIC FORM SCIENTIFIC
TOT = 0
DO WHILE LINES() <> 0
    PARSE LINEIN L
    IF L <> "" THEN DO
        INTERPRET "TOT = TOT + " L
    END
END
SAY TOT

count. = 0
ws = ''
transtab = XRANGE('A', 'Z') || XRANGE('a', 'z')
transin  = XRANGE('A', 'Z')
transout = XRANGE('a', 'z')
notword  = XRANGE('00'x, D2C(C2D('a')-1)) || XRANGE(D2C(C2D('z')+1), 'FF'x)
DO UNTIL LINES() = 0
    PARSE LINEIN L

    L = TRANSLATE(TRANSLATE(L, transout, transin), '', notword, ' ')

    DO i = 1 TO WORDS(L)
        w = STRIP(WORD(L, i))
        count.w = count.w + 1
        IF count.w = 1 THEN ws = ws w
    END    
END

STREAM('rexx_tmp', 'C', 'CREATE')

DO i = 1 to WORDS(ws)
    w = WORD(ws, i)
    IF count.w > 0 THEN DO
        line = format(count.w, 7) || '09'x || w
        CALL LINEOUT('rexx_tmp', line)
    END
END

'c:\cygwin\bin\sort -nr rexx_tmp >rexx_sorted'

DO WHILE LINES('rexx_sorted') > 0
    SAY LINEIN('rexx_sorted')
END

/*
STREAM('rexx_tmp', 'C', 'CLOSE')
STREAM('rexx_sorted', 'C', 'CLOSE')

'del rexx_tmp'
'del rexx_sorted'
*/