VPF::Деление больших чисел. Пмогите найти ошибку!

garis

Дата 8.7.2006, 16:22 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 5
Регистрация: 8.7.2006

Репутация: нет
Всего: нет

Ребят, прога как-то странно себя ведёт. Помгите найти ошибку. Программа основывается на последовательном вычитании. Некоторые числа делит нормально, например 124/4 или 98765432199/123456789, а вот если ввести 12345678900987654321/918273645, то выдает абракадабру smile

Код


Program Delenie;
Uses
  Crt;
Const
  Max=1000;
Type
  Mas=Array[1..Max] Of ShortInt;
Var
  S:Boolean;
  M1,M2:String;
  A1,A2,Mm1,Mm2,P:Mas;
  Cod:Integer;
  f,k,l,i,j,z,C,q:Integer;
  M,N1,N2:Integer;
Function Sravn(M:Integer;A1,Mm2:Mas):Boolean;
  Var
    k:Integer;
  Begin
    If M>N2 Then Sravn:=True;
    If M<N2 Then Sravn:=False;
    If M=N2 Then
      For k:=1 To M Do
        Begin
          If A1[k]<Mm2[k]
            Then
              Begin
                k:=M;
                Sravn:=False;
              End;
          If A1[k]>Mm2[k]
            Then
              Begin
                Sravn:=True;
                k:=M;
              End;
          If A1[k]=Mm2[k] Then Sravn:=True;
        End;
  End;
Begin
  ClrScr;
  WriteLn(' Vvedite delimoe');
   Write(' -> ');
    ReadLn(M1);
     N1:=LengTh(M1);
      For i:=1 To N1 Do Val(M1[i],Mm1[i],Cod);
  WriteLn(' Vvedite delitel');
   Write(' -> ');
    ReadLn(M2);
     N2:=LengTh(M2);
      For i:=1 To N2 Do Val(M2[i],Mm2[i],Cod);
  For i:=1 To N2-1 Do A1[i]:=Mm1[i];
  M:=N2-1;
  i:=M;
  While(i<N1)Do
    Begin
      for q:=1 to M do write(A1[q]);write(' ');
      While ((Sravn(M,A1,Mm2)=False) And (i<N1)) Do  
        Begin                                    
          M:=M+1;                                
          i:=i+1;                                
          A1[M]:=Mm1[i];
          for q:= 1 to M do write(A1[q]);write(' ');                        
        End;                                     
      j:=0;
      While(Sravn(M,A1,Mm2)=True)Do
        Begin
          f:=N2+1;
          For k:=M DownTo M-N2 Do
            Begin
              f:=f-1;
              If A1[k]>=Mm2[f]
                Then
                  A2[k]:=A1[k]-Mm2[f]
                Else
                  Begin
                    A1[k]:=A1[k]+10;
                    A1[k-1]:=A1[k-1]-1;
                    For l:=k DownTo 1 Do
                      If A1[l]<0 Then
                        Begin
                          A1[l-1]:=A1[l-1]-1;
                          A1[l]:=A1[l]+10;
                        End;
                    A2[k]:=A1[k]-Mm2[f];
                  End;
             End;
          For l:=M-N2-1 DownTo 1 Do A2[l]:=A1[l];
          j:=j+1;
          P[i-N2+1]:=j;
          While((A2[1]=0)And(M>0))Do
            Begin
              For z:=1 To M-1 Do A2[z]:=A2[z+1];
              M:=M-1;
              A2[M+1]:=0;
            End;
          For z:=1 To M Do A1[z]:=A2[z];
        End;
      While((A1[1]=0)And(M>0))Do
        Begin
          For z:=1 To M-1 Do A1[z]:=A1[z+1];
          M:=M-1;
          A1[M+1]:=0;
        End;
    End;
  WriteLn(' Chastnoe: ');
   Write(' -> ');
    j:=1;
     While ((P[j]=0)And(j>=N1-N2)) Do j:=j+1;
      For i:=j To N1-N2+1 Do Write(P[i]);
  WriteLn;
  If M=0 Then
    Begin
      M:=1;
      A1[M]:=0;
    End;
  WriteLn(' Ostatok');
   Write(' -> ');
    For i:=1 To M Do Write(A1[i]);
  ReadLn;
End.

volvo877

Дата 8.7.2006, 18:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Исправляешь функцию Sravn:

Код


Function Sravn(M:Integer;A1,Mm2:Mas):Boolean;
Var
  k:Integer;
Begin
  if M <> N2 Then Sravn := (M > N2)
  Else Begin
    Sravn := True; k := 1;
    While (k <= M) and (A1[k] = Mm2[k]) Do inc(k);

    If (k <= M) Then Sravn := (A1[k] > Mm2[k])
  End;
End;

и добавляешь условие:

Код


  While(i<N1)Do
    Begin
      for q:=1 to M do write(A1[q]);write(' ');
      While ((Sravn(M,A1,Mm2)=False) And (i<N1)) Do  
        Begin                                    
          if ((M > 0) and (a1[M] <> 0)) or (M = 0) then M:=M+1; { <-- Добавь это условие }
          i:=i+1;                                
          A1[M]:=Mm1[i];
          for q:= 1 to M do write(A1[q]);write(' ');                        
        End;
  { Далее - все без изменений ... }

Теперь программа будет работать правильно...

Это сообщение отредактировал(а) volvo877 - 8.7.2006, 19:05

garis

Дата 8.7.2006, 19:25 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 5
Регистрация: 8.7.2006

Репутация: нет
Всего: нет

Спаибо тебе огромнейшее! Я весь день сегодня искал эту ошибку! Респект, друк!

Тему можно закрыть.

garis

Дата 8.7.2006, 19:43 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 5
Регистрация: 8.7.2006

Репутация: нет
Всего: нет

поторопился я с закрытием. Всё равно глючит прога. Например 1234567890/9999 нехочет правильно делить.
И ещё, как убрать в ответе лишний ноль в начале?

volvo877

Дата 8.7.2006, 22:45 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Может, кому-нибудь понадобится (автор уже получил ответ на параллельном форуме, но все же...)
Переписываем условие вот так:

Код

var sum: integer;
...
      While ((Sravn(M,A1,Mm2)=False) And (i<N1)) Do
        Begin
          sum := 0;
          for q := 1 to M do begin
            sum := sum + a1[q]; if sum <> 0 then break;
          end;

          if ((M > 0) and (sum <> 0)) or (M = 0) then M:=M+1; { <--- }
          i:=i+1;
          A1[M]:=Mm1[i];
          for q:= 1 to M do write(A1[q]);write(' ');
        End;

Цитата(garis @ 8.7.2006, 19:43

)

как убрать в ответе лишний ноль в начале?

Код

  WriteLn(' Chastnoe: ');
  Write(' -> ');
  j:=1;
  While ((P[j]=0)And(j>=N1-N2)) Do j:=j+1;

  while p[j]=0 do inc(j); { <--- Вот так }

  For i:=j To N1-N2+1 Do Write(P[i]);
  WriteLn;

garis

Дата 9.7.2006, 14:33 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 5
Регистрация: 8.7.2006

Репутация: нет
Всего: нет

Ещё раз спасибо Volvo877! Пока вроде ошибок нет smile

А может это кто-нибудь в MatLAB перегнать?

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »