Задача: разбить число на 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.

Перенесено из раздела "Алгоритмы".

Мдя... ну да ладно...
Надеюсь что правильно понял смысл задания и что ты утром просмотришь

Код

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 я думаю человек хочет для любой суммы денег, узнать из каких купюр можно её собрать
Т.в. можно просто добавить запрос количества вариантов сумм купюр... а далее просто. Вначале задать для рублей(перед циклом) i:=8... потом i:=7 или i:=6(в зависимости от первого вхождения). При достижении i:=0 и если счетчик еще не равен 0 то, использовать только массив по копейкам. А если количество вариантов превышает сумму размеров массивов под рубли и копейки, то можно вообще перейти к произвольной выборки из массивов.


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

Это сообщение отредактировал(а) Girder - 20.10.2004, 11:00

Вот, попытался написать, проверьте, компилера нет.
Нужно подправить под конкретные условия.

Код

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.
А почему эту тему убрали из раздела "Алгоритмы"?
Там ей самое место, ИМХО.

Это сообщение отредактировал(а) Alex101 - 20.10.2004, 15:35

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купюр

Может массив 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;

Это сообщение отредактировал(а) Alex101 - 20.10.2004, 16:22

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

Код

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

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

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

Цитата(p0s0l @ 20.10.2004, 13:34)

Допёрло: там описка Rub[pos]:=0; надо Res_Rub[pos]:=0;

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

Цитата

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

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

Это сообщение отредактировал(а) Alex101 - 20.10.2004, 17:26

Цитата

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

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

Спасибо всем, особенно Alex101!