[PhoeniX]

Накидал модуль, для преобразования чисел между системами счисления с основаниями 2 и 10.

Работает хорошо, но очень медленно... Как можно его оптимизировать?
И ещё, если я что-то упустил, поправьте места, где могут возникать ошибки...

Код:

unit uDecBinConvert;

interface

type
  TBit = 0..1;
  TDecimal = 0..9;
  TBitArray = array of TBit;
  TDecArray = array of TDecimal;

function Dec2Bin (dec: string): string;
function Bin2Dec (bin: string): string;

implementation

uses Classes, SysUtils;

procedure StrToBinArr(s: string; var bar: TBitArray);
  function CharToBit (c: char): TBit;
  begin
    if c = '0' then Result:=0 else
    if c = '1' then Result:=1 else
    raise (Exception.Create('Invalid character: '''+c+''''));
  end;
var
  i:integer;
begin
  while (Length(s)>0)and(s[1] in [#10,#13,#32,#9]) do Delete(s,1,1);
  while (Length(s)>0)and(s[Length(s)] in [#10,#13,#32,#9]) do Delete(s,Length(s),1);
  SetLength(bar,Length(s));
  for i:=1 to Length(s) do
    bar[Length(s)-i]:=CharToBit(s[i]);
end;

procedure StrToDecArr(s: string; var bar: TDecArray);
  function CharToDec (c: char): TDecimal;
  begin
    if (c>=#48) and (c<=#58) then
      Result:=ord(c)-48
    else
      raise (Exception.Create('Invalid character: '''+c+''''));
  end;
var
  i:integer;
begin
  while (Length(s)>0)and(s[1] in [#10,#13,#32,#9]) do Delete(s,1,1);
  while (Length(s)>0)and(s[Length(s)] in [#10,#13,#32,#9]) do Delete(s,Length(s),1);
  SetLength(bar,Length(s));
  for i:=1 to Length(s) do
    bar[Length(s)-i]:=CharToDec(s[i]);
end;

procedure DecArrToStr(dar: TDecArray; var s: string);
  function DecToChar (d: TDecimal): char;
  begin
    Result:=chr(48+d);
  end;
var
  i:integer;
begin
  s:='';
  for i:=1 to Length(dar) do
    s:=s+DecToChar(dar[Length(dar)-i]);
end;

procedure BinArrToStr(bar: TBitArray; var s: string);
  function BinToChar (d: TBit): char;
  begin
    Result:=chr(48+d);
  end;
var
  i:integer;
begin
  s:='';
  for i:=1 to Length(bar) do
    s:=s+BinToChar(bar[Length(bar)-i]);
end;

procedure IncDecimal(var d: TDecArray);
var
  flag: boolean;
  index: integer;
begin
  flag:=false;
  index:=0;
  while not flag do begin
    if Length(d)<index+1 then begin
      SetLength(d,Length(d)+1);
      d[index]:=0;
    end;
    if d[index]=9 then begin
      d[index]:=0;
      inc(index)
    end else begin
      inc(d[index]);
      flag:=true;
    end;
  end;
end;

procedure DecDecimal(var d: TDecArray);
var
  flag: boolean;
  index: integer;
begin
  flag:=false;
  index:=0;
  while not flag do begin
    if d[index]=0 then begin
      d[index]:=9;
      inc(index)
    end else begin
      dec(d[index]);
      flag:=true;
    end;
  end;
  while (Length(d)>0)and(d[Length(d)-1]=0) do SetLength(d,Length(d)-1);
end;

procedure IncBinary(var b: TBitArray);
var
  flag: boolean;
  index: integer;
begin
  flag:=false;
  index:=0;
  while not flag do begin
    if Length(b)<index+1 then begin
      SetLength(b,Length(b)+1);
      b[index]:=0;
    end;
    if b[index]=0 then begin
      b[index]:=1;
      flag:=true;
    end else begin
      b[index]:=0;
      inc(index);
    end;
  end;
end;

procedure DecBinary(var b: TBitArray);
var
  flag: boolean;
  index: integer;
begin
  flag:=false;
  index:=0;
  while not flag do begin
    if b[index]=1 then begin
      b[index]:=0;
      flag:=true;
    end else begin
      b[index]:=1;
      inc(index);
    end;
  end;
  while (Length(b)>0)and(b[Length(b)-1]=0) do SetLength(b,Length(b)-1);
end;

function Dec2Bin (dec: string): string;
var
  BinArr: TBitArray;
  DecArr: TDecArray;
begin
  SetLength(BinArr,0);
  SetLength(DecArr,0);
  StrToDecArr(dec,DecArr);
  while Length(DecArr)>0 do begin
    DecDecimal(DecArr);
    IncBinary(BinArr);
  end;
  BinArrToStr(BinArr,Result);
end;

function Bin2Dec (bin: string): string;
var
  BinArr: TBitArray;
  DecArr: TDecArray;
begin
  SetLength(BinArr,0);
  SetLength(DecArr,0);
  StrToBinArr(bin,BinArr);
  while Length(BinArr)>0 do begin
    IncDecimal(DecArr);
    DecBinary(BinArr);
  end;
  DecArrToStr(DecArr,Result);
end;

end.

Прилагаю исходник, и пример пользования...

[Rokuell]

Эмм.. если честно, то лень сейчас разбирать чужой код, но если тебе интересна эта тема, то выкладываю исходник для преобразования чисел из одной системы счисления в другую, исходная и конечная система счисления должны находиться в диапазоне [2..36].
Написано в далёком 2006 и имеет пару ошибок, вроде переполнения...

[lmikle]

Думаю:
Код

Код:

  while (Length(s)>0)and(s[1] in [#10,#13,#32,#9]) do Delete(s,1,1);
  while (Length(s)>0)and(s[Length(s)] in [#10,#13,#32,#9]) do Delete(s,Length(s),1);

можно заменить на:

Код:

for i := Length(s) DownTo 1 Do
  If Not (s[i] In ['0'..'9']) Then Delete(s,i,1);

По ощущениям должно быть быстрее и работать правильнее.
Тогда функция CharToDec примет вид:

Код:

function CharToDec (c: char): TDecimal;
begin
   Result:=ord(c)-48
end;

и ее можно сделать inline (или просто перенести код в место вызова), что еще убыстрит в конкретном месте.

И вообще, кому-то я тут писал код, который некоторое число конвертит в битовую строку и обратно. Кстати, даже с некоторой упаковкой по сравнению с твоим кодом. Правда, это была не честная конвертация, а для передачи данных в битовом образе.

[PhoeniX]

Я уже сказал, что это мне не подходит.

Про замечания знаю, но это не особо ускорит сам процесс преобразования. Мне надо бы как-либо ускорить код функций IncBinary, IncDecimal, DecBinary и DecDecimal... Я уже думал просмотреть код в ассемблере, и переписать функцию на нём...

[dr. F.I.N.]

DJ PhoeniX, а зачем ты так заморачиваешься с типами TBit, TDec? Один хрен размер = 1 байт И работать проще. Суть конечно ясна, но ведь есть и готовые методы решения твоей задачи. Поясни суть и нюансы твоей, если я чего-то не понимаю

[PhoeniX]

Мне нужна быстрая работа с числами ЛЮБЫХ размеров, а всё готовые методы ограничены в пределах Integer, максимум Int64...