Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Длинная арифметика. Деление длинного числа на короткое.
Автор: Gordey 18.06.2011 19:19
Нашел программу, которая должна считать частное от деления длинного числа на короткое, но она не работает, помогите найти ошибку пожалуйста.
В общем вот текст программы:
const osn = 10000;.
max = 2502;
type
Tlong = array[0..max] of longint;
procedure swap( var a,b;
size: integer);
var
p: pointer;
begin
getmem(p,size);
move(a, p^, size);
move(b,a, size);
move(p^, b, size);
freemem(p, size);
end;
procedure delenie( a:Tlong;
b:longint;
var c:Tlong);
var
p:longint;
i, j, ost: integer;
begin
fillchar(c, sizeof©, 0);
p:=0;
i:=1;
j:=a[0];
while i<j do
begin
swap (a[i], a[j], sizeof(a[i]));
inc(i);
dec(j);
end;
ost:=0;
for i:=1 to a[0] do
begin
c[i]:=(longint(ost)*osn + a[i]) div b;
ost:=(longint(ost)*osn + a[i]) mod b;
end;
if c[1]=0 then
begin
c[0]:=a[0]-1;
for i:=1 to c[0] do c[i]:=c[i+1];
c[c[0]+1]:=0;
end;
if c[1]<>0 then c[0]:=a[0];
i:=1;
j:=c[0];
while i<j do
begin
swap(c[i],c[j], sizeof(a[i]));
inc(i);
dec(j);
end;
end;
Автор: Unconnected 18.06.2011 19:41
А где описание TLong?
Автор: Gordey 18.06.2011 19:44
Да, забыл. Поправил. Также добавил процедуру swap.
Автор: Unconnected 18.06.2011 20:10
Загляни http://inf.1september.ru/2000/1/art/okul1.htm, процедура, похожая на твою, там.
Интересный swap, экономичный)
Автор: Gordey 18.06.2011 20:20
Так, можно сказать, оттуда и брал)) 
Не понимаю в чем ошибка, при делении вообще ничего не выдает, глючит.
Автор: Gordey 18.06.2011 22:47
Можно задать и другой вопрос. Помогите написать другую программу, также вычисляющую частное от деления.
Автор: Unconnected 19.06.2011 0:16
То, что у тебя, и что по ссылке - немного различается, по-моему..
Автор: Gordey 19.06.2011 0:20
Да, поскольку там нету деления длинного на короткое, а только длинное на длинное, мне это не совсем подходит(
Автор: Unconnected 19.06.2011 0:23
Для короткого точно так же сработает) (надо только подать короткое в формате длинного, т.е. в массиве)
Автор: Gordey 19.06.2011 0:28
Я понимаю, что там точно также работает, только процедура деления по ссылке использует процедуру вычитания, которая неправильно там написана, как следствие - неправильная процедура деления.
Насчет моей программы. Может все дело в процедуре swap? Николай, не поможете ли нормально ее написать, чтобы она меняла местами элементы массива?
Добавлено через 
мин.
Хотя, если честно, я не знаю... Программа вроде правильно работает, если число делится на короткое без остатка...(
Добавлено через 
мин.
Как и следовало ожидать неправильна процедура swap..
Автор: Unconnected 19.06.2011 0:48
Первая ссылка гугла:
const base = 10;
Function divlong(a: TLong, b: integer): TLong;
Var i, ost: integer;
Begin
ost := 0;
fillchar(result, sizeof(rezult), 0);
For i := a[0] downto 1 do
begin
Result[i] := (a[i] + ost * base);
ost := result[i] mod b;
result[i] := result[i] div b;
end;
result[0] := a[0];
while result[result[0]] = 0 do dec(result[0]);
End;
, как раз длинное на короткое, TLong тот же самый (в нулевом элементе хранится длина числа). И ещё массив заполняется числом с конца, то есть в первом элементе единицы, во втором - десятки..
Автор: Gordey 19.06.2011 0:59
У меня выдает ошибку, что неправильный тип результата( 
Автор: Unconnected 19.06.2011 1:41
const base = 10;
type tlong=array[0..5] of longint;
Function divlong(a: TLong; b: integer): TLong;
Var i, ost: integer;
Begin
ost := 0;
fillchar(result, sizeof(result), 0);
For i := a[0] downto 1 do
begin
Result[i] := (a[i] + ost * base);
ost := result[i] mod b;
result[i] := result[i] div b;
end;
result[0] := a[0];
while result[result[0]] = 0 do dec(result[0]);
End;
var m,r:TLong;
begin
m[0]:=3;
m[1]:=222;
m[2]:=222;
m[3]:=222;
r:=divlong(m,2);
readln;
end.
Отработало правильно..
Автор: Gordey 19.06.2011 2:33
При попытке посчитать выдает "error34:Invalid function result type" 
Да, кстати, у меня прописаны процедуры, считывающая, выписывающая длинные числа.
Автор: Unconnected 19.06.2011 2:37
Что за паскаль? Приложи весь код.
Автор: Gordey 19.06.2011 13:46
Turbo Pascal 7.0.
{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 65384,0,655360}
program Pi;
const osn = 10000;
max = 2502;
type
Tlong = array[0..max] of longint;
var p, z, m, a, summa1: Tlong;
q, x, y, n: longint;
procedure readlong(var a:Tlong);
var ch:char;
i: longint;
begin
fillchar(a, sizeof(a), 0);
{3apoln9em massiv nul9mi}
read(ch);
while not (ch in ['0'..'9']) do read(ch);
{propuskaem ne simvoli}
while ch in ['0'..'9'] do
begin
for i:=a[0] downto 1 do
begin
a[i+1]:=a[i+1] + (longint(a[i])*10) div osn;
{dobavl9em odnu cifru iz tekushego r9da v sleduushii}
a[i]:=(longint(a[i])*10) mod osn;
{ubiraem odnu cifru iz tekushego}
end;
a[1]:=a[1] + ord(ch) - ord('0');
{v konec 1 r9da zapisivaem polu4ennuu cifru}
if a[a[0]+1]> 0 then inc(a[0]);
{esli mi zan9li eshe 1 eleement massiva, to uveli4ivaem nulevoi element}
read(ch);
{4itaem o4erednoy simvol}
end;
end;
procedure writelong( Var a: Tlong);
var
ls, s : string;
i:longint;
begin
str(osn div 10,ls);
write(a[a[0]]);
{vivodim starshie 4isla}
for i:=a[0]-1 downto 1 do
begin
str(a[i],s);
while length(s)<length(ls) do s:='0'+s;
write(s);
end;
writeln;
end;
procedure summa(a, b: Tlong;
var c: Tlong);
var i, k: longint;
begin
fillchar(c, sizeof©, 0);
if a[0] > b[0] then k:= a[0] else k:=b[0];
for i:=1 to k do
begin
c[i+1]:=(c[i] + a[i] + b[i]) div osn;
c[i]:=(c[i] + a[i] + b[i]) mod osn;
end;
if c[k+1]=0 then c[0]:=k else c[0]:= k+1;
end;
procedure vi4itanie ( var a, b: Tlong;
var c: Tlong);
var k,i,p: longint;
begin
fillchar(c,sizeof©,0);
if a[0]>b[0] then k:=a[0] else k:=b[0];
p:=0;
for i:=1 to k do
begin
c[i]:=a[i]-b[i]-p;
if c[i]<0 then
begin
p:=1;
inc(c[i],osn);
end;
if c[i]>0 then p:=0;
end;
for i:=k downto 1 do
if c[i]<>0 then break;
c[0]:=i;
end;
procedure umnojenie( const a:Tlong;
const k: longint;
var c: Tlong);
var i: longint;
{nujnoe 4islo - c}
begin
fillchar(c, sizeof©, 0);
if k=0 then inc(c[0]){umnojenie na 0}
else begin
for i:=1 to a[0] do
begin
c[i+1]:=(longint(a[i])*k + c[i]) div osn;
c[i]:=(longint(a[i])*k + c[i]) mod osn;
end;
if c[a[0]+1]>0 then c[0]:=a[0]+1
else c[0]:=a[0]; {smotrim na dlinu polu4ivshegos9 4isla}
end;
end;
procedure swap( var a,b;
size: integer);
var
p: pointer;
begin
getmem(p,size);
move(a, p^, size);
move(b,a, size);
move(p^, b, size);
freemem(p, size);
end;
{function delenie(a: Tlong; b:integer): Tlong;
var i, ost: integer;
const base :10;
begin
ost:=0;
fillchar(result, sizeof(result), 0);
for i:= a[0] downto 1 do
begin
result[i]:=(a[i] +ost*base);
ost:= result[i] mod b;
result[i]:= result[i] div b;
end;
result[0]:=a[0];
while result[result[0]] = 0 do dec (result[0]);
end;}
begin
for q:=0 to 2502 do
begin
if q=0 then a[q]:=2502;
if q=2502 then a[q]:=1;
if (q<>0) and (q<>2502) then a[q]:=0;
end;
writelong(a);
readln;
end.
На основную программу не смотри, она мне не нужна.
Автор: IUnknown 19.06.2011 13:57
Турбо-Паскаль не позволяет возвращать значения типа "массив". Поменяй функцию на процедуру:
procedure delenie(a: Tlong; b:integer; var result : TLong);
var i, ost: integer;
const base = 10;
begin
ost:=0;
fillchar(result, sizeof(result), 0);
for i:= a[0] downto 1 do
begin
result[i]:=(a[i] +ost*base);
ost:= result[i] mod b;
result[i]:= result[i] div b;
end;
result[0]:=a[0];
while result[result[0]] = 0 do dec (result[0]);
end;
Автор: Gordey 19.06.2011 14:15
При подстановке 666666666666 и 6 дает ответ 111111111111, но при подстановке 123456789123456789 и 10 выдает 10347079502350683, что явно не правильно, мне же надо , чтобы процедура умела делить 10^10000 на 239, или типа того. Спасибо всем, кто помогает) 
Автор: IUnknown 19.06.2011 15:35
Так а кто сказал, что у тебя base = 10? У тебя данные в типе TLong хранятся в каком основании? 10000? Вот и работай с ним:
{ A - делимое, B - делитель, Result - частное, результат функции - остаток от деления }
function delenie(const a : TLong; b : integer; var result : TLong) : integer;
var
i, r : longint;
begin
result := a;
r := 0;
for i := a[0] downto 1 do
begin
r := r * osn + result[i];
result[i] := r div b;
r := r mod b;
end;
while (result[0] > 1) and (result[result[0]] = 0) do
begin
dec(result[0]);
end;
delenie := r;
end;
Ты чего, в столбик никогда не делил?
Автор: Gordey 19.06.2011 16:48
Я все исправил, Владимир, я исправил base на 10000 и ost на longint. Все Работает! Всем спасбо!)