Imaginary base numbers: Difference between revisions
→{{header|Perl 6}}
Thundergnat (talk | contribs) m (→{{header|D}}: Output is suspect) |
|||
Line 1,484:
16i -> 102000.0 -> 16i -16i -> 2000.0 -> -16i
</pre>
=={{header|Modula-2}}==
{{trans|C#}}
<lang modula2>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.</lang>
{{out}}
<pre>1 -> 1 -> 1 -1 -> 103 -> -1
2 -> 2 -> 2 -2 -> 102 -> -2
3 -> 3 -> 3 -3 -> 101 -> -3
4 -> 10300 -> 4 -4 -> 100 -> -4
5 -> 10301 -> 5 -5 -> 203 -> -5
6 -> 10302 -> 6 -6 -> 202 -> -6
7 -> 10303 -> 7 -7 -> 201 -> -7
8 -> 10200 -> 8 -8 -> 200 -> -8
9 -> 10201 -> 9 -9 -> 303 -> -9
10 -> 10202 -> 10 -10 -> 302 -> -10
11 -> 10203 -> 11 -11 -> 301 -> -11
12 -> 10100 -> 12 -12 -> 300 -> -12
13 -> 10101 -> 13 -13 -> 1030003 -> -13
14 -> 10102 -> 14 -14 -> 1030002 -> -14
15 -> 10103 -> 15 -15 -> 1030001 -> -15
16 -> 10000 -> 16 -16 -> 1030000 -> -16
1i -> 10.2 -> 1i -1i -> 0.2 -> -1i
2i -> 10.0 -> 2i -2i -> 1030.0 -> -2i
3i -> 20.2 -> 3i -3i -> 1030.2 -> -3i
4i -> 20.0 -> 4i -4i -> 1020.0 -> -4i
5i -> 30.2 -> 5i -5i -> 1020.2 -> -5i
6i -> 30.0 -> 6i -6i -> 1010.0 -> -6i
7i -> 103000.2 -> 7i -7i -> 1010.2 -> -7i
8i -> 103000.0 -> 8i -8i -> 1000.0 -> -8i
9i -> 103010.2 -> 9i -9i -> 1000.2 -> -9i
10i -> 103010.0 -> 10i -10i -> 2030.0 -> -10i
11i -> 103020.2 -> 11i -11i -> 2030.2 -> -11i
12i -> 103020.0 -> 12i -12i -> 2020.0 -> -12i
13i -> 103030.2 -> 13i -13i -> 2020.2 -> -13i
14i -> 103030.0 -> 14i -14i -> 2010.0 -> -14i
15i -> 102000.2 -> 15i -15i -> 2010.2 -> -15i
16i -> 102000.0 -> 16i -16i -> 2000.0 -> -16i</pre>
=={{header|Perl 6}}==
| |||