операции над сист счисления Опции

[AlexSt]

есть отличный программный код для умножения и сложения двух чисел в разл системах(целых через строковый тип) помогите реализовать такие же функции для вычитания и деления(это самое главное!))), ещё желательно чтобы все функции решали задачи и для вещественных чисел, сдавать через неделю( вот код:

Code:
 
// Модуль для работы с натуральными числами в различных системах исчисления

// Далее, если говорится, что Система Исчисления (СИ) задается строкой (CharSet)

// то имеется в виду, что эта строка содержит символы требуемой СИ, начиная с нуля

// Примеры CharSet (стандартный вид)

// Двоичная          - '01'

// Восьмиричная      - '01234567'

// Десятичная        - '0123456789'

// Шестнадцатиричная - '0123456789ABCDEF'

// Можно использовать и нестандартные виды, например для двоичной 'ab', а для

// троичной 'abc' - данному модулю все равно.

 

// "-Ричность" СИ ограничена только наличием доступных различных символов.

// Работа с числами в определенной СИ производится как со строками, потому величина

// чисел значения почти не имеет, но это отрицательно сказывается на времени работы

// функций (особенно на умножении).

unit MyUnit;

 

interface

 

function Convert(Num, SetIn, SetOut: String): String;

function MySum (Num1, Num2, CharSet: String): String;

function MyMulti (Num1, Num2, CharSet: String): String;

function MyOrd(A: Char; CharSet: String): Integer;

function MyChr(Num: Integer; CharSet: String): Char;

 

implementation

 

// Функция возвращает позицию символа A в строке CharSet (начиная с 0)

function MyOrd(A: Char; CharSet: String): Integer;

var

i: Integer;

begin

Result := 0;

for i := 1 to Length(CharSet) do

begin

   if CharSet[i] = A then begin

     Result := i-1;

     exit;

   end

end;

end;

 

// Функция возвращает символ из строки CharSet по номеру Num (~CharSet[Num+1])

function MyChr(Num: Integer; CharSet: String): Char;

begin
Result := CharSet[Num mod Length(CharSet) + 1];
end;

// Функция возвращает число без ведущих нулей, то есть ShortNum('0000123')='123'
function ShortNum(Num, CharSet: String): String;
var
k, j: Integer;
begin
Result := '';
k := 1;
while Num[k] = MyChr(0, CharSet) do
   k := k + 1;
for j := k to Length(Num) do Result := Result + Num[j];
end;

// Функция выполняет сложение двух чисел Num1 и Num2 в СИ, задаваемой CharSet
function MySum (Num1, Num2, CharSet: String): String;
var
i, Pos, Add, L, L_CharSet: Integer;
N1 , N2 , O, Res: String;
begin
// Далее потребуется что бы первое число по длине было не менее второго,
// если не так, то меняем местами
if Length(Num1)>=Length(Num2) then
begin
   N1 := Num1;
   N2 := Num2;
end
else
begin
   N1 := Num2;
   N2 := Num1;
end;
L:= Length(N1);
L_CharSet := Length(CharSet);
O:=MyChr(0, CharSet); // 0 - в СИ, определяемой CharSet
//Уравнняем второе до длины первого нулями справа: 10 = 010
for i := Length(N2) to L-1 do
   N2 := O + N2;
Add:=0;
//Суммирование с младших разрядов, Add - добавка от предыдущих разрядов
// для следующего. Напр. для 10-чной СИ: 9+7 - Add = 1, 4+5 - Add=0
for i := L downto 1 do
begin
   Pos := MyOrd(N1[i], CharSet)+MyOrd(N2[i], CharSet) + Add;
   Add := 0;
   while Pos >= L_CharSet do
    begin
    Pos := Pos mod L_CharSet;
    Add := Add + 1;
    end;
Res := MyChr(Pos, CharSet) + Res;
end;
If Add<>0
  then Result := MyChr(Add, CharSet) + Res
  else Result := Res;
end;
// Функция выполняет умножение двух чисел Num1 и Num2 в СИ, задаваемой CharSet
function MyMulti (Num1, Num2, CharSet: String): String;
var
i, e, Res, N1, N2: String;
begin
N1 := ShortNum(Num1, CharSet);
N2 := ShortNum(Num2, CharSet);
i :='';
Res := '';
//e - единица СИ, определяемая CharSet
e := MyChr(1,CharSet);
//Умножение Num1 на Num2 - это Num1 сложеное Num2 раз в СИ, определяемой CharSet
while (i <> N2) do
begin
   Res := MySum(Res, N1, CharSet);
   i := MySum(i, e, CharSet);
end;
Result := Res;
end;

// Функция выполняет преобразование одноразрядного числа A, заданного
// в СИ, определяемой SetIn, в число в СИ, определяемой SetOut

function f0(A: Char; SetIn, SetOut: String): String;

var
Pos, j, L: Integer;
Res: String;
begin
L := Length(SetOut);
Pos := MyOrd(A, SetIn);
for j := 1 To Pos div (L-1) do
   Res := MySum(Res, MyChr(L-1, SetOut), SetOut);
Result := MySum(Res, MyChr(Pos mod (L-1), SetOut), SetOut);
end;
// Функция выполняет преобразование числа Num, заданного
// в СИ, определяемой SetIn, в число в СИ, определяемой SetOut
function Convert(Num, SetIn, SetOut: String): String;
var
Base, Multiplier, N, Res: String;
i: Integer;
begin
// Num = MultilplierN * Base^N + ... + Multiplier0 * Base^0
// Base - основание СИ, это всегда <последний символ CharSet>+<нулевой символ> ~ 10
// MultiplierI - множитель при соответствующей степени
// Напр. для 10-чной СИ  -  123 = 1 * 10^2 + 2 * 10^1 + 3 * 10^0
// Тут Base = 10, Multiplier = {1, 2, 3}
Base := MySum(f0(MyChr(Length(SetIn)-1, SetIn), SetIn, SetOut), MyChr(1, SetOut), SetOut);
N := MyChr(1, SetOut); // = Base^0, потом будем домножать на Base (в соотв. СИ)
Res := '';

// Обрабатываем входящее число с хвоста
for i := Length(Num) downto 1 do
begin
   Multiplier := f0(Num[i], SetIn, SetOut);
   Res := MySum(Res, MyMulti(Multiplier, N, SetOut), SetOut);
   N := MyMulti(Base, N, SetOut);
end;
Result := Res;
end;
end.
 

[Lapp]

Выкладываю.
Предупреждаю:
1. решение не оптимизировано;
2. могут быть ошибки;
3. все действия должны выполняться над числами в одной СС (автоматического контроля за этим нету).

const
  L=6;

type
  tNum= record
    m: array[1..L]of integer;
    e,b: integer;
    n: boolean;
  end;

const
{младшие разряды слева, точка сдвинута на величину e от правого края}
  a: tNum= (m:(0,2,1,1,0,0); e:3; b:10; n:false); {это 1.12}
  b: tNum= (m:(0,6,5,0,0,0); e:1; b:10; n:true);  {это -0.0056}
  nill: tNum= (m:(0,0,0,0,0,0); e:0; b:10; n:false);  {это 0}
  
var
  c: tNum;

{ Number output }
procedure WrNum(a:tNum);
var
  i,k:integer;
begin
  with a do begin
    if n then Write('-.') else Write(' .');
    for i:=L downto 1 do begin
      if m[i]<10 then k:=48 else k:=55;
      Write(Chr(m[i]+k))
    end;
    Write('_e',e,'_b',b)
  end
end;

procedure Norm(var a:tNum; s:integer);
var
  i,j,k:integer;
begin
  k:=0;
  with a do begin
    while (k<L)and(m[L-k]=0) do Inc(k);
    if k=L then e:=0
    else begin
      Dec(k,s);
      if k>0 then for i:=L-s downto 1 do begin
        j:=i-k;
        if j>0 then m[i]:=m[j] else m[i]:=0
      end
      else if k<0 then for i:=1 to L do begin
        j:=i-k;
        if j<=L then m[i]:=m[j] else m[i]:=0
      end;
      Dec(e,k)
    end
  end
end;

{ Addition, no sign }
procedure  Ad(a,b:tNum; var c:tNum);
var
  i,d:integer;
begin
  Norm(a,1);
  Norm(b,1);
  if a.m[L-1]=0 then c:=b
  else if b.m[L-1]=0 then c:=a
  else begin
    if a.e>b.e then Norm(b,a.e-b.e+1) else Norm(a,b.e-a.e+1);
    d:=0;
    for i:=1 to L-1 do begin
      d:=a.m[i]+b.m[i]+d;
      c.m[i]:=d mod a.b;
      d:=d div a.b
    end;
    c.e:=a.e;
    c.b:=a.b
  end
end;

{ Substruction, no sign }
procedure  Sb(a,b:tNum; var c:tNum);
var
  i,d: integer;
  f: boolean;
begin
  Norm(a,0);
  Norm(b,0);
  if a.m[L]=0 then begin
    c:=b;
    c.n:=not b.n
  end
  else if b.m[L]=0 then begin
    c:=a;
    c.n:=not a.n
  end
  else begin
    if a.e>b.e then Norm(b,a.e-b.e) else Norm(a,b.e-a.e);
    d:=0;
    i:=L;
    while (i>1)and(a.m[i]=b.m[i]) do Dec(i);
    f:=a.m[i]<b.m[i];
    for i:=1 to L do begin
      if f then d:=b.m[i]-a.m[i]+d+a.b else d:=a.m[i]-b.m[i]+d+a.b;
      c.m[i]:=d mod a.b;
      d:=d div a.b-1
    end;
    c.e:=a.e;
    c.b:=a.b;
    c.n:=f
  end
end;

{ Multiplication }
procedure Mul(a,b:tNum; var c:tNum);
var
  i,j,s,x: integer;
  d: tNum;
  f: boolean;
begin
  Norm(a,1);
  Norm(b,0);
  c.n:=a.n xor b.n;
  f:=false;
  s:=0;
  d.b:=a.b;
  for j:=1 to L do begin
    x:=0;
    for i:=1 to L-1 do begin
      x:=b.m[j]*a.m[i]+x;
      d.m[i]:=x mod a.b;
      x:=x div a.b
    end;
    d.m[L]:=x;
    d.e:=s;
    Inc(s);
    if f then Ad(c,d,c) else begin
      c:=d;
      f:=true
    end
  end;
  if x>0 then Norm(c,0) else Norm(c,1);
  c.e:=a.e+b.e-1
end;

{ Division }
procedure Dv(a,b:tNum; var c:tNum);
var
  i,j,k,expa,expb:integer;
  d,d0: tNum;
begin
  Norm(a,0);
  Norm(b,0);
  expa:=a.e;
  expb:=b.e;
  c.n:=a.n xor b.n;
  a.e:=0;
  b.e:=0;
  a.n:=false;
  b.n:=false;
  for j:=L downto 1 do begin
    k:=0;
    repeat
      Sb(a,b,d);
      if d.n then break;
      a:=d;
      Inc(k);
    until false;
    c.m[j]:=k;
    Dec(b.e)
  end;
  c.e:=expa-expb+1;
  c.b:=a.b
end;

{ Addition, with sign }
procedure Add(a,b:tNum; var c:tNum);
begin
  if a.n then if b.n then begin
    Ad(a,b,c);
    c.n:=true
  end
  else Sb(b,a,c)
  else if b.n then Sb(a,b,c)
  else Ad(a,b,c)
end;

{ Substruction, with sign }
procedure Sub(a,b:tNum; var c:tNum);
begin
  if a.n then if b.n then Sb(b,a,c)
  else begin
    Ad(a,b,c);
    c.n:=true
  end
  else if b.n then Ad(a,b,c)
  else Sb(a,b,c)
end;

begin
  Dv(a,b,c);
  WrNum(a); WriteLn;
  WrNum(b); WriteLn;
  WrNum©; WriteLn;
  ReadLn
end.