Деление многоразрядных чисел Опции

[Art87]

Уважаемые,
Сегодня задали задачу.
Выполнить деление двух многоразрядных чисел (свои придумать). Я в ауте .
Помогите плз.

[volvo]

Отсюда FAQ: Длинная арифметика
процедуру

procedure DivLongTwo(a,b,res,ost:Plong);

использовать нельзя уже? Чем не деление длинных чисел?

[Art87]

volvo
То есть эта программа?

function FindBin(ost,b:Plong;const sp:integer):longint;
var up,down:word;
   c:Plong;
begin
  new©;
  down:=0;up:=_osn;
  while up-1>down do
     begin
        MulLongShort(b,(up+down) div 2,c);
        case MoreSdvigLong(ost,c,sp) of
         0:down:=(up+down) div 2;
         1:up:=(up+down) div 2;
         2:begin
              up:=(up+down) div 2;
              down:=up;
           end;
        end;
     end;
  MulLongShort(b,(up+down) div 2,c);
  if MoreSdvigLong(ost,c,0)=0 then SubLongTwo(ost,c,sp) else
     begin
        SubLongTwo(c,ost,sp);
        ost:=c;
     end;
  FindBin:=(up+down) div 2;
  dispose©;
end;



procedure MakeDel(a,b,res,ost:Plong);
var sp:integer;
begin
  ost^:=a^;
  sp:=a^[0]-b^[0];
  if MoreSdvigLong(a,b,sp)=1 then dec(sp);{!!!!!!!!!}
  res^[0]:=sp+1;
  while sp>=0 do
     begin
        res^[sp+1]:=FindBin(ost,b,sp);
        dec(sp);
     end;
end;



procedure DivLongTwo(a,b,res,ost:Plong);
begin
  fillchar(res^,sizeof(res^),0);res^[0]:=1;
  fillchar(ost^,sizeof(ost^),0);ost^[0]:=1;
  case MoreSdvigLong(a,b,0) of
   0:MakeDel(a,b,res,ost);
   1:ost^:=a^;
   2:res^[1]:=1;
  end;
end;

В ней ошибка.

[klem4]

Начнем с того, что ты привел не программу а 2 процедуры и одну функцию (из FAQ) без описания типов и основной части, малоли что ты там написал ? А у нас штатный телепат форума в отпуске до 3-го числа, так что с этим проблемы, кстати, эти процедуры из FAQ проверены сотни раз и ошибок в них нету.

Сообщение отредактировано: klem4 - 27.12.2005 10:32

[Art87]

klem4,
А как сделать правильно?

[volvo]

во-первых, описать все типы, которые нужны, во-вторых, включмть в программу также функцию MoreSdvigLong (она у тебя вызывается, но не описана), и написать основную часть (примеры есть там же, в FAQ-е, и в Поиске)...

А потом, если не сработает, присоединить ФАЙЛ с программой сюда, и привести исходные данные/номера ошибок/строки, в которых они возникают, потому что все проверено, и НЕ работать (если программа написана правильно) не может, а еще раз отлаживать уже отлаженное никому не интересно...

[Art87]

Уважаемый volvo,
сильно не пинайте
но это хоть как-то похоже на то что надо?
(ЗЫ После двух рефератных защит за день сознание гаснет )

procedure WriteLong(var f:text;a:Plong);
var ls,s:string;
   i:integer;
begin
  str(_osn div 10,ls);
  write(f,a^[a^[0]]);
  for i:=a^[0]-1 downto 1 do
     begin
	str(a^[i],s);
	while length(s)<length(ls) do s:='0'+s;
	write(f,s);
     end;
  writeln(f);
end;



function MoreSdvigLong(a,b:Plong;const sdvig:integer):byte;


var i:integer;
begin
if a^[0]>(b^[0]+sdvig) then MoreSdvigLong:=0 else
     if a^[0]<(b^[0]+sdvig) then MoreSdvigLong:=1 else
	begin
	   i:=a^[0];
	   while (i>sdvig) and (a^[i]=b^[i-sdvig]) do dec(i);
	   if i=sdvig then
	      begin
		 MoreSdvigLong:=0;
		 for i:=1 to sdvig do
		    if a^[i]>0 then exit;
		 MoreSdvigLong:=2;
	      end else
		 MoreSdvigLong:=byte(a^[i]<b^[i-sdvig]);
	end;
end;



function FindBin(ost,b:Plong;const sp:integer):longint;
var up,down:word;
   c:Plong;
begin
  new©;
  down:=0;up:=_osn;
  while up-1>down do
     begin
	MulLongShort(b,(up+down) div 2,c);
	case MoreSdvigLong(ost,c,sp) of
	 0:down:=(up+down) div 2;
	 1:up:=(up+down) div 2;
	 2:begin
	      up:=(up+down) div 2;
	      down:=up;
	   end;
	end;
     end;
  MulLongShort(b,(up+down) div 2,c);
  if MoreSdvigLong(ost,c,0)=0 then SubLongTwo(ost,c,sp) else
     begin
	SubLongTwo(c,ost,sp);
	ost:=c;
     end;
  FindBin:=(up+down) div 2;
  dispose©;
end;



procedure MakeDel(a,b,res,ost:Plong);
var sp:integer;
begin
  ost^:=a^;
  sp:=a^[0]-b^[0];
  if MoreSdvigLong(a,b,sp)=1 then dec(sp);
  res^[0]:=sp+1;
  while sp>=0 do
     begin
	res^[sp+1]:=FindBin(ost,b,sp);
	dec(sp);
     end;
end;



procedure DivLongTwo(a,b,res,ost:Plong);
begin
  fillchar(res^,sizeof(res^),0);res^[0]:=1;
  fillchar(ost^,sizeof(ost^),0);ost^[0]:=1;
  case MoreSdvigLong(a,b,0) of
   0:MakeDel(a,b,res,ost);
   1:ost^:=a^;
   2:res^[1]:=1;
  end;
end;

[volvo]

После двух рефератных защит за день сознание гаснет

Способность читать по-русски тоже?

во-первых, описать все типы, которые нужны, <...>, и написать основную часть

Ничего из этого ты не сделал... Как хочешь, я больше повторять не буду...

[Art87]

Возможно я не разучился юзать поиск
volvo скажите, это же то что мне нужно?

uses crt;
function sum(x,y:string):string;
var i:integer;
   lx,ly,yy,s:byte;
   res:string;
   mem:byte;
begin
 if length(x)<length(y) then
 begin
   res:=x;
   x:=y;
   y:=res;
 end;
 lx:=length(x);
 ly:=length(y);
 mem:=0;
 res:='';
 for i:=0 to lx-1 do
 begin
    if ly-i<1 then yy:=0
    else yy:=ord(y[ly-i])-48;
    s:=(ord(x[lx-i])-48)+yy+mem;
    res:=chr((s mod 10)+48)+res;
    mem:= s div 10;
 end;
 if mem>0 then res:=chr(mem+48)+res;
 sum:=res;
end;

function rasn(x,y:string):string;
var j,i:integer;
   lx,ly,xx,yy,s:byte;
   res:string;
   mem:byte;
begin
 lx:=length(x);
 ly:=length(y);
 mem:=0;
 res:='';
 for i:=0 to lx-1 do
 begin
    if ly-i<1 then yy:=0
    else yy:=ord(y[ly-i])-48;
    xx:=ord(x[lx-i])-48;
    if xx>=yy then res:=chr(xx-yy+48)+res
    else
    begin
      j:=lx-i-1;
      while (x[j]='0')and(j>0) do
      begin
	x[j]:='9';
	dec(j);
      end;
      dec(x[j]);
      res:=chr(10+xx-yy+48)+res;
    end;
 end;
 while (res[1]='0')and(length(res)>1)  do delete(res,1,1);
 rasn:=res;
end;

procedure chas(x, y :string; var res, ost:string);
begin
 res:='0';
 ost:=x;
 while (length(ost)>length(y)) or (ost>=y) do
 begin
   ost:=rasn(ost,y);
   res:=sum(res,'1');
 end;
end;

var
   sx, sy :string;
   key:char;
   r,o:string;
begin
  sx:='';
  sy:='';

  write('Введите первое число: ');
  repeat
  key:= readkey;
  if(key>='0')and(key<='9')then
  begin
     sx:=sx+key;
     write(key);
  end;
  until key=#13;
  writeln;
  write('Введите второе число: ');
  repeat
  key:= readkey;
  if(key>='0')and(key<='9')then
  begin
     sy:=sy+key;
     write(key);
  end;
  until key=#13;
  writeln;
  chas(sx,sy,r,o);
  writeln('Частное = ',r,' остаток = ',o);
  readln;
end.

[virt]

оно же работать будет долго

[Art87]

virt
В каком смысле долго?