Source code in the clu programming language

% This program assumes a 64-bit system.
% On a 32-bit system, the main task (show Kaprekar numbers < 10,000)
% will run correctly, but the extra credit part will crash with
% an overflow exception.

% Yield all positive splits of a number
splits = iter (n, base: int) yields (int,int)
    step: int := base
    while n >= step do
        left: int := n / step
        right: int := n // step 
        if left ~= 0 & right ~= 0 then
            yield(left, right)
        end
        step := step * base
    end
end splits

% Check whether a number is a Kaprekar number, and if so,
% return the proper split.
kap_split = struct[left, right: int]
maybe_kap = oneof[yes: kap_split, no: null]  
kaprekar = proc (n, base: int) returns (maybe_kap)
    for left, right: int in splits(n**2, base) do
        if left + right = n then 
            return(maybe_kap$make_yes(
                kap_split${left:left, right:right})) 
        end
    end
    return(maybe_kap$make_no(nil))
end kaprekar

% Format a number in a given base
to_base = proc (n, base: int) returns (string)
    own digits: string := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    if n=0 then return("0") end
    ds: array[char] := array[char]$[]
    while n>0 do
        array[char]$addl(ds,digits[n // base + 1])
        n := n / base
    end
    return(string$ac2s(ds))
end to_base

% If a number is a Kaprekar number, show it, its square, and the split
display = proc (o: stream, n, base: int)
    tagcase kaprekar(n, base)
        tag yes (s: kap_split):
            stream$putright(o, to_base(n, 10), 6)
            if base ~= 10 then
                stream$putright(o, to_base(n, base), 7)
            end
            stream$putright(o, to_base(n**2, base), 13)
            stream$putl(o, "  " || 
                        to_base(s.left, base) || " + " ||
                        to_base(s.right, base))
       tag no:
    end
end display

start_up = proc ()
    po: stream := stream$primary_output()
    
    % Find and output all the Kaprekar numbers under 10,000.
    stream$putl(po, "Kaprekar numbers < 10,000:")
    for i: int in int$from_to(1, 9999) do
        display(po, i, 10)
    end
    
    % Count all the Kaprekar numbers under 1,000,000.
    kaps: int := 0
    for i: int in int$from_to(1, 999999) do
        tagcase kaprekar(i, 10)
            tag yes (s: kap_split): kaps := kaps + 1
            tag no:
        end
    end
    stream$putl(po, "\nThere are " || int$unparse(kaps) || 
                " Kaprekar numbers under 1,000,000.\n")
                
    % Find and output all base-17 Kaprekar numbers under 1,000,000.
    stream$putl(po, "Base-17 Kaprekar numbers < 1,000,000:")
    for i: int in int$from_to(1, 999999) do
        display(po, i, 17)
    end
end start_up