Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Не могу найти ошибку.


Автор: Svit 19.10.2004, 17:37
Задача: разбить число на 1коп, 5коп, 10коп, ... ,5000руб всеми возможными способами. Алгоритм вроде правильный, а в коде где-то ошибка. Посмотрите пожалуйста З.Ы:мне здавать завтра...

Код

program SumProg;

uses crt;

const Rurs: array [0..12] of LongInt = (1, 5, 10, 50, 100, 200, 500, 1000, 5000, 10000, 50000, 100000, 500000);

Type TResult = array[0..12] of integer;

var Result, MResult, TmpResult: TResult;
   Sum, TempSum: Integer;
   InputSum: Real;
   GlobI: Integer;
   GlobJ: Integer;

   F: Text;

   SolvesNum: integer;

Procedure MResultCreate;
var i: integer;
Begin
For i := 0 to 12 do
 Begin
 MResult[i] := Sum div Rurs[i];
 end;
end;

procedure TmpResultCreate;
 var i: integer;
 Begin
 For i := 0 to 12 do TmpResult[i] := MResult[i];
 end;

Procedure ClearResult;
 var i: integer;
 Begin
 For i := 0 to 12 do
   Begin
   Result[i] := 0;
   end;
 end;

Procedure WriteResult;
var i: integer;
   R: Real;
Begin
WriteLn(F, 'Result #', SolvesNum);
For i := 12 downto 0 do
 Begin
 R := Rurs[i] / 100;
 If R < 1 then
 Write(F, Rurs[i], 'cop:', Result[i], ' ')
 else
 Write(F, Rurs[i] div 100, 'rub:', Result[i], ' ');
 end;
WriteLn(F, '');
end;


procedure Proc1;


 Procedure GlobJChange;
 Begin
 If GlobJ > 0 then
   Begin
   GlobJ := GlobJ - 1;
   TmpResult[GlobJ] := Result[GlobJ] - 1;
   If TmpResult[GlobJ] >= 0 then
     Begin
     ClearResult;
     TempSum := Sum;
     GlobI := 12;
     Proc1;
     end
   else GlobJChange;
   end;
 end;

 Begin
 while true do
   Begin
   if (TmpResult[GlobI] <= 0) or (TempSum - Rurs[Globi] < 0) then
     Begin
       If (Globi > 0) then
         Begin
         GlobI := GlobI - 1;
         Proc1;
         Break;
         end
       else
         Begin
         SolvesNum := SolvesNum + 1;
         WriteResult;
         TmpResult[GlobJ] := Result[GlobJ] - 1;
         If TmpResult[GlobJ] >= 0 then
           Begin
           Clearresult;
           TempSum := Sum;
           GlobI := 12;
           Proc1;
           Break;
           end
         else
           Begin
           GlobJChange;
           Break;
           end;
         end;
     end
   else
     Begin
     Result[GlobI] := Result[GlobI] + 1;
     TempSum := TempSum - Rurs[GlobI];
     If Result[GlobI] < TmpResult[GlobI] then
       Begin
       Proc1;
       Break;
       end;

     end;

     end;
   end;

Procedure TextFileCreate;
 Begin
 Assign(F, 'Solves.txt');
 Rewrite(F);
 end;

Begin
ClrScr;

Write('Please, input the sum:');
Read(InputSum);
Sum := Trunc(InputSum * 100);

TextFileCreate;

MResultCreate;
TmpResultCreate;

GlobI := 12;
GlobJ := 12;
TempSum := Sum;
Proc1;

Close(F);

Repeat until Keypressed;
end.

Автор: podval 19.10.2004, 20:18
Перенесено из раздела "Алгоритмы".

Автор: Girder 20.10.2004, 01:14
Мдя... ну да ладно... :)
Надеюсь что правильно понял смысл задания и что ты утром просмотришь :)

Код
program SumProg;

uses crt;

const Cop:array [0..3] of LongInt=(1,5,10,50);
const Rub:array [0..8] of Longint=(1,2,5,10,50,100,500,1000,5000);

var InputSum:Real;
     F:Text;
     i,Sum:integer;

begin
ClrScr;
Write('Please, input the sum:');
Read(InputSum);
Sum:=Trunc(InputSum*100);
if Sum<0 then Sum:=(-1)*Sum;
Assign(F, 'Solves.txt');
Rewrite(F);
i:=8;
WriteLn(F, 'Результат по сумме: ', Sum);
repeat
 if Sum>=Rub[i]*100 then
  begin
    Sum:=Sum-Rub[i]*100;
    if Sum>0 then Write(F,Rub[i],'руб.+') else Write(F,Rub[i],'руб.');
  end else i:=i-1;
until (i<0)or(Sum=0);
if Sum>0 then
 begin
   i:=3;
   repeat
    if Sum>=Cop[i] then
     begin
       Sum:=Sum-Cop[i];
       if Sum>0 then Write(F,Cop[i],'коп.+') else Write(F,Cop[i],'коп.');
     end else i:=i-1;
   until (i<0)or(Sum=0);
 end;
WriteLn(F,'');
Close(F);
writeln('Press a key to continue...');
readkey;
end.


Удачи.

Автор: p0s0l 20.10.2004, 01:58
Имхо, надо вывести все возможные варианты получения заданной суммы. Вот только не понятно, до какой степени вариантизировать ?
Можно же и миллион рублей сложить копейками...

Автор: Girder 20.10.2004, 08:34
p0s0l я думаю человек хочет для любой суммы денег, узнать из каких купюр можно её собрать :)
Т.в. можно просто добавить запрос количества вариантов сумм купюр... а далее просто. Вначале задать для рублей(перед циклом) i:=8... потом i:=7 или i:=6(в зависимости от первого вхождения). При достижении i:=0 и если счетчик еще не равен 0 то, использовать только массив по копейкам. А если количество вариантов превышает сумму размеров массивов под рубли и копейки, то можно вообще перейти к произвольной выборки из массивов.

:offtopic
PS: А что планируется выпуск 5000 купюр? :)

Автор: Alex101 20.10.2004, 15:23
Вот, попытался написать, проверьте, компилера нет.
Нужно подправить под конкретные условия.
Код

program SumProg;

uses crt;

const Rub:array [0..8] of Longint=(1,2,5,10,50,100,500,1000,5000);
var
Sum:LongInt;
Res_Rub :Array[0..8] of Integer;

Procedure Out_Sum;
{Процедура вывода результата}
Var
i:Integer;
begin
for i:=0 to 8 do {Интересно, а правильно ли я начал цикл? (синтаксис)}
    if Res_Rub[i] then
         Write(Rub[i],' рублей ', Res_Rub[i], 'купюр ');
WriteLn;
end;

Procedure Gen_Sum(sum_find, pos:Integer);
var
  i:Integer;
begin

if pos>8 then Exit;

if sum_find=Sum then
begin
      Out_Sum;
      Exit
end;
{Пробуем брать текущую купюру по 1й, по 2 и так далее - сколько можно}
for i:=1 to (Sum-sum_find) div Rub[pos] do
begin
  Res_Rub[pos]:=i;
  Gen_Sum(sum_find+Rub[pos]*i , pos+1);
end;
{Или вообще не используем эту купюру}
Rub[pos]:=0;
Gen_Sum(sum_find , pos+1);
end;

begin
ClrScr;
Write('Please, input the sum:');
Read(Sum);
if Sum<0 then Sum:=(-1)*Sum;
Assign(output, 'Solves.txt');
Rewrite(output);
Gen_Sum(0,0);
Close(output);
readkey;
end.

Программа написана "навскидку", так что сорри, но идея, думаю, понятна.
P.S.
А почему эту тему убрали из раздела "Алгоритмы"?
Там ей самое место, ИМХО.

Автор: p0s0l 20.10.2004, 15:54
Alex101, вместо if Res_Rub[i] then надо if Res_Rub[i] <> 0 then, остальное - всё правильно (по синтаксису).
Только при запуске вываливается ошибка деления на нуль в строке:
for i:=1 to (Sum-sum_find) div Rub[pos]*i do
Если поставить перед этой строкой проверку:
if Rup[pos] <> 0 then
то ошибки не возникает, но опять же, проверил числа 7 и 10, в файле получаются странные варианты:
7 =
1 рублей 1купюр 2 рублей 3купюр
1 рублей 7купюр 0 рублей 3купюр

10 =
1 рублей 10купюр 0 рублей 4купюр 0 рублей 1купюр

Автор: Alex101 20.10.2004, 16:16
Может массив Rub неправильно инициализируется?
Мне просто вообще не на чем проверить сейчас.
P.S.
А в Паскале не прокатывает такое:
if value then...
Не тоже самое, что и
if value<>0 then... ?
Да! Надо поменять местами:
Код

if sum_find=Sum then
begin
  Out_Sum;
  Exit
end;
{Это потом}
if pos>8 then Exit;

Автор: Ptica 20.10.2004, 16:26
Alex101
Если в Паскале написано
if value then...
то это значит, что value - логическая (boolean) переменная (или функция).
Вот это было бы правильно (но это просто умозрительный пример):
Код

var
  uslovie: boolean;
  value: integer;
...
uslovie := (value=1);

if uslovie then
  begin
    ...

Автор: p0s0l 20.10.2004, 16:34
Допёрло: там описка Rub[pos]:=0; надо Res_Rub[pos]:=0;
А проверку if pos>8... надо оставить где была...

Если это исправить, то будут выданы все варианты (не проверял, но их для 100 выдаёт много = 2499 вариантов)

Автор: Alex101 20.10.2004, 17:26
Цитата(p0s0l @ 20.10.2004, 13:34)
Допёрло: там описка Rub[pos]:=0; надо Res_Rub[pos]:=0;

Ну да, именно это я и имел в виду (то есть не испольуем вообще эту купюру), извините.
Лучше проверить для чего-то небольшого, например для 10 - вручную подсчитать можно.
Цитата

А проверку if pos>8... надо оставить где была...

А мне что-то показалось, что надо менять местами. Это не тестировался случай, когда одно из решений получается при добавлении самой большой купюры.

Автор: maxim1000 20.10.2004, 17:30
Цитата
А почему эту тему убрали из раздела "Алгоритмы"?
Там ей самое место, ИМХО.

скорее всего, потому, что человек не просил решенияч задачки :)
он просил только проверить, правильная ли у него программа...

Автор: Svit 3.11.2004, 21:04
Спасибо всем, особенно Alex101! :)

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)