Imaginary base numbers are a non-standard positional numeral system which uses an imaginary number as its radix. The most common is quater-imaginary with radix 2i.

The quater-imaginary numeral system was first proposed by Donald Knuth in 1955 as a submission for a high school science talent search. [Ref.]

Other imaginary bases are possible too but are not as widely discussed and aren't specifically named.

Task: Write a set of procedures (functions, subroutines, however they are referred to in your language) to convert base 10 numbers to an imaginary base and back.

At a minimum, support quater-imaginary (base 2i).

For extra kudos, support positive or negative bases 2i through 6i (or higher).

As a stretch goal, support converting non-integer numbers ( E.G. 227.65625+10.859375i ) to an imaginary base.

See Wikipedia: Quater-imaginary_base for more details.

For reference, here are some some decimal and complex numbers converted to quater-imaginary.






Base 10
Base 2i


1
 1


2
 2


3
 3


4
 10300


5
 10301


6
 10302


7
 10303


8
 10200


9
 10201


10
 10202


11
 10203


12
 10100


13
 10101


14
 10102


15
 10103


16
 10000






Base 10
Base 2i


−1
 103


−2
 102


−3
 101


−4
 100


−5
 203


−6
 202


−7
 201


−8
 200


−9
 303


−10
 302


−11
 301


−12
 300


−13
 1030003


−14
 1030002


−15
 1030001


−16
 1030000






Base 10
Base 2i


1i
10.2


2i
10.0


3i
20.2


4i
20.0


5i
30.2


6i
30.0


7i
103000.2


8i
103000.0


9i
103010.2


10i
103010.0


11i
103020.2


12i
103020.0


13i
103030.2


14i
103030.0


15i
102000.2


16i
102000.0






Base 10
Base 2i


−1i
0.2


−2i
1030.0


−3i
1030.2


−4i
1020.0


−5i
1020.2


−6i
1010.0


−7i
1010.2


−8i
1000.0


−9i
1000.2


−10i
2030.0


−11i
2030.2


−12i
2020.0


−13i
2020.2


−14i
2010.0


−15i
2010.2


−16i
2000.0





MODULE ImaginaryBase;
FROM FormatString IMPORT FormatString;
FROM RealMath IMPORT round;   
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;
 
(* Helper *)
TYPE
    String = ARRAY[0..10] OF CHAR;
    StringBuilder = RECORD
        buf : String;
        ptr : CARDINAL;
    END;
 
PROCEDURE ToChar(n : INTEGER) : CHAR;
BEGIN
    CASE n OF
        0 : RETURN '0' |
        1 : RETURN '1' |
        2 : RETURN '2' |
        3 : RETURN '3' |
        4 : RETURN '4' |
        5 : RETURN '5' |
        6 : RETURN '6' |
        7 : RETURN '7' |
        8 : RETURN '8' |
        9 : RETURN '9'
    ELSE
        RETURN '-'
    END
END ToChar;
 
PROCEDURE AppendChar(VAR sb : StringBuilder; c : CHAR);
BEGIN        
    sb.buf[sb.ptr] := c;
    INC(sb.ptr);
    sb.buf[sb.ptr] := 0C
END AppendChar;
 
PROCEDURE AppendInt(VAR sb : StringBuilder; n : INTEGER);
BEGIN        
    sb.buf[sb.ptr] := ToChar(n);
    INC(sb.ptr);
    sb.buf[sb.ptr] := 0C
END AppendInt;
 
PROCEDURE Ceil(r : REAL) : REAL;
VAR t : REAL;
BEGIN       
    t := FLOAT(INT(r));    
    IF r - t > 0.0 THEN
        t := t + 1.0
    END;
    RETURN t
END Ceil;
 
PROCEDURE Modulus(q,d : INTEGER) : INTEGER;
VAR t : INTEGER;
BEGIN
    t := q / d;
    RETURN q - d * t
END Modulus;
 
PROCEDURE PrependInt(VAR sb : StringBuilder; n : INTEGER);
VAR i : CARDINAL;
BEGIN
    i := sb.ptr;
    INC(sb.ptr);
    sb.buf[sb.ptr] := 0C;
    WHILE i > 0 DO
        sb.buf[i] := sb.buf[i-1];
        DEC(i)
    END;       
    sb.buf[0] := ToChar(n)
END PrependInt;
 
PROCEDURE Reverse(VAR str : String);
VAR
    i,j : CARDINAL;
    c : CHAR;
BEGIN
    IF str[0] = 0C THEN RETURN END;
    i := 0;
    WHILE str[i] # 0C DO INC(i) END;
    DEC(i);
    j := 0;
    WHILE i > j DO
        c := str[i];
        str[i] := str[j];
        str[j] := c;
 
        DEC(i);
        INC(j)
    END
END Reverse;
 
PROCEDURE TrimStart(VAR str : String; c : CHAR);
VAR i : CARDINAL;
BEGIN            
    WHILE str[0] = c DO
        i := 0;
        WHILE str[i] # 0C DO
            str[i] := str[i+1];
            INC(i)
        END
    END
END TrimStart;
 
PROCEDURE WriteInteger(n : INTEGER);
VAR buf : ARRAY[0..15] OF CHAR;
BEGIN
    FormatString("%i", buf, n);
    WriteString(buf)
END WriteInteger;
 
(* Imaginary *)
TYPE
    Complex = RECORD
        real,imag : REAL; 
    END;
    QuaterImaginary = RECORD
        b2i : String;
    END;
 
PROCEDURE ComplexMul(lhs,rhs : Complex) : Complex;
BEGIN         
    RETURN Complex{
        rhs.real * lhs.real - rhs.imag * lhs.imag,
        rhs.real * lhs.imag + rhs.imag * lhs.real
    }                            
END ComplexMul;
 
PROCEDURE ComplexMulR(lhs : Complex; rhs : REAL) : Complex;
BEGIN         
    RETURN Complex{lhs.real * rhs, lhs.imag * rhs}                            
END ComplexMulR;
 
PROCEDURE ComplexInv(c : Complex) : Complex;
VAR denom : REAL;
BEGIN
    denom := c.real * c.real + c.imag * c.imag;
    RETURN Complex{c.real / denom, -c.imag / denom}
END ComplexInv;
 
PROCEDURE ComplexDiv(lhs,rhs : Complex) : Complex;
BEGIN                                     
    RETURN ComplexMul(lhs, ComplexInv(rhs))
END ComplexDiv;
 
PROCEDURE ComplexNeg(c : Complex) : Complex;
BEGIN
    RETURN Complex{-c.real, -c.imag}
END ComplexNeg;
 
PROCEDURE ComplexSum(lhs,rhs : Complex) : Complex;
BEGIN                                     
    RETURN Complex{lhs.real + rhs.real, lhs.imag + rhs.imag}
END ComplexSum;
 
PROCEDURE WriteComplex(c : Complex);
VAR buf : ARRAY[0..15] OF CHAR;
BEGIN                    
    IF c.imag = 0.0 THEN      
        WriteInteger(INT(c.real))
    ELSIF c.real = 0.0 THEN
        WriteInteger(INT(c.imag));
        WriteString("i")
    ELSIF c.imag > 0.0 THEN
        WriteInteger(INT(c.real));
        WriteString(" + ");
        WriteInteger(INT(c.imag));
        WriteString("i")
    ELSE
        WriteInteger(INT(c.real));
        WriteString(" - ");
        WriteInteger(INT(-c.imag));
        WriteString("i")
    END
END WriteComplex;
 
PROCEDURE ToQuaterImaginary(c : Complex) : QuaterImaginary;
VAR
    re,im,fi,rem,index : INTEGER;
    f : REAL;
    t : Complex;
    sb : StringBuilder;
BEGIN
    IF (c.real = 0.0) AND (c.imag = 0.0) THEN RETURN QuaterImaginary{"0"} END;
    re := INT(c.real);
    im := INT(c.imag);
    fi := -1;
    sb := StringBuilder{"", 0};    
    WHILE re # 0 DO
        rem := Modulus(re, -4);
        re := re / (-4);
        IF rem < 0 THEN
            rem := 4 + rem;
            INC(re)
        END;
        AppendInt(sb, rem);
        AppendInt(sb, 0)
    END;
    IF im # 0 THEN
        t := ComplexDiv(Complex{0.0, c.imag}, Complex{0.0, 2.0});
        f := t.real;
        im := INT(Ceil(f));
        f := -4.0 * (f - FLOAT(im));
        index := 1;
        WHILE im # 0 DO
            rem := Modulus(im, -4);
            im := im / (-4);
            IF rem < 0 THEN
                rem := 4 + rem;
                INC(im)
            END;
            IF index < INT(sb.ptr) THEN
                sb.buf[index] := ToChar(rem)
            ELSE
                AppendInt(sb, 0);
                AppendInt(sb, rem)
            END;
            index := index + 2;
        END;
        fi := INT(f)
    END;
    Reverse(sb.buf);
    IF fi # -1 THEN
        AppendChar(sb, '.');
        AppendInt(sb, fi)
    END;
    TrimStart(sb.buf, '0');
    IF sb.buf[0] = '.' THEN
        PrependInt(sb, 0)
    END;
 
    RETURN QuaterImaginary{sb.buf}
END ToQuaterImaginary;
 
PROCEDURE ToComplex(qi : QuaterImaginary) : Complex;
VAR
    j,pointPos,posLen,b2iLen : INTEGER;
    k : REAL;
    sum,prod : Complex;
BEGIN       
    pointPos := 0;
    WHILE (qi.b2i[pointPos] # 0C) AND (qi.b2i[pointPos] # '.') DO
        INC(pointPos)
    END;            
    IF qi.b2i[pointPos] # '.' THEN
        pointPos := -1;
        posLen := 0;
        WHILE qi.b2i[posLen] # 0C DO
            INC(posLen)
        END
    ELSE
        posLen := pointPos
    END;
 
    sum := Complex{0.0, 0.0};
    prod := Complex{1.0, 0.0};
 
    FOR j:=0 TO posLen - 1 DO
        k := FLOAT(ORD(qi.b2i[posLen - 1 - j]) - ORD('0'));
        IF k > 0.0 THEN
            sum := ComplexSum(sum, ComplexMulR(prod, k))
        END;
        prod := ComplexMul(prod, Complex{0.0, 2.0})
    END;
 
    IF pointPos # -1 THEN
        prod := ComplexInv(Complex{0.0, 2.0});
        b2iLen := 0;
        WHILE qi.b2i[b2iLen] # 0C DO INC(b2iLen) END;
        FOR j:=posLen + 1 TO b2iLen - 1 DO
            k := FLOAT(ORD(qi.b2i[j]) - ORD('0'));
            IF k > 0.0 THEN
                sum := ComplexSum(sum, ComplexMulR(prod, k))
            END;
            prod := ComplexMul(prod, ComplexInv(Complex{0.0, 2.0}))
        END
    END;
 
    RETURN sum
END ToComplex;
 
(* Main *)
VAR 
    c1,c2 : Complex;
    qi : QuaterImaginary;
    i : INTEGER;
BEGIN
    FOR i:=1 TO 16 DO
        c1 := Complex{FLOAT(i), 0.0};
        WriteComplex(c1);
        WriteString(" -> ");
        qi := ToQuaterImaginary(c1);
        WriteString(qi.b2i);
        WriteString(" -> ");
        c2 := ToComplex(qi);
        WriteComplex(c2);
        WriteString("   ");
 
        c1 := ComplexNeg(c1);
        WriteComplex(c1);
        WriteString(" -> ");
        qi := ToQuaterImaginary(c1);
        WriteString(qi.b2i);
        WriteString(" -> ");
        c2 := ToComplex(qi);
        WriteComplex(c2);
        WriteLn
    END;
    WriteLn;
 
    FOR i:=1 TO 16 DO
        c1 := Complex{0.0, FLOAT(i)};
        WriteComplex(c1);
        WriteString(" -> ");
        qi := ToQuaterImaginary(c1);
        WriteString(qi.b2i);
        WriteString(" -> ");
        c2 := ToComplex(qi);
        WriteComplex(c2);
        WriteString("   ");
 
        c1 := ComplexNeg(c1);
        WriteComplex(c1);
        WriteString(" -> ");
        qi := ToQuaterImaginary(c1);
        WriteString(qi.b2i);
        WriteString(" -> ");
        c2 := ToComplex(qi);
        WriteComplex(c2);
        WriteLn
    END;
 
    ReadChar
END ImaginaryBase.